emacs_el/tiny-tools/tiny/tinyvc.el

   1 ;;; tinyvc.el --- CVS and RCS log minor mode. Checkout, Check-in...
   2
   3 ;; This file is not part of Emacs
   4
   5 ;;{{{ Id
   6
   7 ;; Copyright (C)    1996-2007 Jari Aalto
   8 ;; Keywords:        tools
   9 ;; Author:          Jari Aalto
  10 ;; Maintainer:      Jari Aalto
  11 ;;
  12 ;; To get information on this program, call M-x tinyvc-version.
  13 ;; Look at the code with folding.el.
  14
  15 ;; COPYRIGHT NOTICE
  16 ;;
  17 ;; This program is free software; you can redistribute it and/or modify it
  18 ;; under the terms of the GNU General Public License as published by the Free
  19 ;; Software Foundation; either version 2 of the License, or (at your option)
  20 ;; any later version.
  21 ;;
  22 ;; This program is distributed in the hope that it will be useful, but
  23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  24 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  25 ;; for more details.
  26 ;;
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with program; see the file COPYING. If not, write to the
  29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  30 ;; Boston, MA 02110-1301, USA.
  31 ;;
  32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  33
  34 ;;}}}
  35 ;;{{{ Install
  36
  37 ;;; Install:
  38
  39 ;; ....................................................... &t-install ...
  40 ;; Put this file on your Emacs-Lisp load path, add following into your
  41 ;; ~/.emacs startup file. Before doing require see tinyvc-:load-hook.
  42 ;;
  43 ;;      (require 'tinyvc)
  44 ;;
  45 ;; Or prefer autoload: your emacs loads this package only when you
  46 ;; need it. This is for 19.30+
  47 ;;
  48 ;;      (eval-after-load "vc" '(progn (require 'tinyvc)))
  49 ;;
  50 ;; In very old Emacs releases which have different `eval-after-load' or none
  51 ;; at all, use this code:
  52 ;;
  53 ;;      (defadvice vc-print-log (after tirl act)
  54 ;;        "Run hook tinyvc-:vc-print-log-hook."
  55 ;;        (require 'tinyvc)
  56 ;;        (run-hooks 'tinyvc-:vc-print-log-hook))
  57 ;;
  58 ;; If you define your own bindings and use menu, Update following variable
  59 ;; and call M-x `tinyvc-install-mode'.
  60 ;;
  61 ;;     tinyvc-:mode-menu-main
  62 ;;
  63 ;; If you have any questions, use this function
  64 ;;
  65 ;;      M-x tinyvc-submit-bug-report
  66
  67 ;;}}}
  68
  69 ;;{{{ Documentation
  70
  71 ;; ..................................................... &t-commentary ...
  72
  73 ;;; Commentary:
  74
  75 ;;  Preface, Dec 1996
  76 ;;
  77 ;;      In work there may be very complex RCS revision numbers, multiple
  78 ;;      branches and I may have several branches CheckedOut for testing,
  79 ;;      correcting, and developing new features. It seemed natural to
  80 ;;      handle this "multiversioning" control from the log output.
  81 ;;
  82 ;;  Overview of features
  83 ;;
  84 ;;      o   Companion to *vc.el*, Minor mode for the log buffer (C-x v l)
  85 ;;      o   Highlighing supported in Windowed emacs's.
  86 ;;      o   You can 1) Lock a file 2) unclock file
  87 ;;          3) show status 4) pop to buffer where log belongs and more
  88 ;;          5) ChekOut multiple revisions for viewing purposes
  89 ;;          6) (un/mark viewed versions) and more..
  90 ;;
  91 ;;  Do you need this package
  92 ;;
  93 ;;      If you don't use RCS/CVS don't load this package, it only works for
  94 ;;      `log' output and expects to parse buffers in that format. If you
  95 ;;      don't use many branches and thusly vc's log output much, this
  96 ;;      package may not be essential to you. This pacakge uses colors if
  97 ;;      window system is detected, but it partially copes with non-window
  98 ;;      system too, so that e.g. marks appear in the buffer as charaxter
  99 ;;      codes.
 100 ;;
 101 ;;          revision 1.25       locked by: xx;
 102 ;;          date: 1997/11/10 17:20:45;  author: xx;  state: Exp;  lines: +3
 103 ;;
 104 ;;      In the above lines the first line, starting from "1.25" is
 105 ;;      highlighted (version number). In next line: 97/11/10
 106 ;;      (the YY year is significant), "xx" and "Exp" are highlighted.
 107
 108 ;;}}}
 109 ;;{{{ history
 110
 111 ;;; Change Log:
 112
 113 ;;; Code:
 114
 115 ;;{{{ setup: library
 116
 117 (require 'tinylibm)
 118
 119 (eval-and-compile
 120   (ti::package-use-dynamic-compilation)
 121   (autoload 'font-lock-mode "font-lock" t t))
 122
 123 (ti::package-defgroup-tiny TinyVc tinyvc-: tools
 124   "Version control rlog minor mode. ChecOut, CheckIn.
 125   Overview of features
 126         o   Companion to vc.el, Minor mode forlog buffer (C-x v l)
 127         o   Highlighing supported in windowed Emacs.
 128         o   You can do CheckOut, Lock a file, unclock file(s), show status
 129             for current rcs file in emacs and ChekOut multiple revision
 130             for viewing purposes (un/marking viewed versions)")
 131
 132 ;;}}}
 133 ;;{{{ setup: mode
 134
 135 (defcustom tinyvc-:menu-use-p t
 136   "*Should we use echo-area menu?."
 137   :type  'boolean
 138   :group 'TinyVc)
 139
 140 ;;;###autoload (autoload 'tinyvc-mode          "tinyvc" "" t)
 141 ;;;###autoload (autoload 'turn-on-tinyvc-mode  "tinyvc" "" t)
 142 ;;;###autoload (autoload 'turn-off-tinyvc-mode "tinyvc" "" t)
 143 ;;;###autoload (autoload 'tinyvc-commentary    "tinyvc" "" t)
 144 ;;;###autoload (autoload 'tinyvc-version       "tinyvc" "" t)
 145
 146 (eval-and-compile
 147
 148   (ti::macrof-minor-mode-wizard
 149    "tinyvc-" " Rlog" "'" "Rlog" 'TinyVc "tinyvc-:" ;1-6
 150
 151    "RCS Log minor mode.
 152 With this mode you can CheckOut, Lock, unlock the file whose version
 153 log your're looking at. You can also 'find file' some specific version
 154 to temporary buffer e.g. to look at some changes in that version.
 155
 156 By default the commands are accessed through guided echo menu. You
 157 can use the normal Emacs keymap choice too by settings
 158 `tinyvc-:menu-use-p' to nil and calling `tinyvc-install-mode'.
 159
 160 Mode description:
 161
 162 \\{tinyvc-:mode-prefix-map}"
 163
 164    "RCS rlog "
 165    nil
 166    "RCS Rlog minor mode menu."
 167    (list
 168     tinyvc-:mode-easymenu-name
 169     ["Do CheckOut at point"           tinyvc-do-co                    t]
 170     ["Do CheckOut at point (lock) "   tinyvc-do-co-l                  t]
 171     ["Do CheckOut head "              tinyvc-do-co-head               t]
 172     ["Unlock version"                 tinyvc-cancel-co                t]
 173     ["Unlock unsafely version"        tinyvc-unlock-unsafely          t]
 174     "----"
 175     ["Find (show) this revision"      tinyvc-find-file-tmp            t]
 176     ["Mark 'find' versions"           tinyvc-mark                     t]
 177     ["Pop to RCS buffer"              tinyvc-pop-to-buffer            t]
 178     ["Kill temporary files (flush)"   tinyvc-kill-tmp                 t]
 179     ["Reload rlog"                    tinyvc-reload                   t]
 180     "----"
 181     ["Package version"                tinyvc-version                  t]
 182     ["Package commentary"             tinyvc-commentary               t]
 183     ["Mode help"                      tinyvc-mode-help                t]
 184     ["Mode off"                       tinyvc-mode                     t])
 185    (progn
 186      (define-key map  "h" 'tinyvc-do-co-head)
 187      (define-key map  "k" 'tinyvc-kill-tmp)
 188      (define-key map  "l" 'tinyvc-do-co-l)
 189      (define-key map  "m" 'tinyvc-mark)
 190      (define-key map  "f" 'tinyvc-find-file-tmp)
 191      (define-key map  "o" 'tinyvc-do-co)
 192      (define-key map  "p" 'tinyvc-pop-to-buffer)
 193      (define-key map  "r" 'tinyvc-reload)
 194      (define-key map  "u" 'tinyvc-cancel-co)
 195      (define-key map  "U" 'tinyvc-unlock-unsafely)
 196      (define-key map  "?"  'tinyvc-mode-help)
 197      (define-key map  "Hm" 'tinyvc-mode-help)
 198      (define-key map  "Hc" 'tinyvc-commentary)
 199      (define-key map  "Hv" 'tinyvc-version))))
 200
 201 ;;; ......................................................... &v-hooks ...
 202
 203 (defcustom tinyvc-:load-hook nil
 204   "*Hook that is run when package is loaded."
 205   :type  'hook
 206   :group 'TinyVc)
 207
 208 (defcustom tinyvc-:vc-print-log-hook
 209   '(turn-on-tinyvc-mode
 210     tinyvc-rename-buffer
 211     tinyvc-select-backend
 212     turn-on-font-lock-mode-maybe)
 213   "*Hook run after `vc-print-log' command.
 214 See also `tinyvc-:invoked-buffer' what the functions in this hook
 215 can examine."
 216   :type  'hook
 217   :group 'TinyVc)
 218
 219 ;;}}}
 220 ;;{{{ setup: public, user configurable
 221
 222 (defcustom tinyvc-:cmd-function 'tinyvc-cmd-get-rcs
 223   "*Return RCS executable shell command.
 224 See `tinyvc-cmd-get' source code. Input parameters are symbols:
 225
 226   'co 'ci 'rcs 'rcsdiff.
 227
 228 Predefined functions you coud assign to this variable:
 229
 230   `tinyvc-cmd-get-rcs'
 231   `tinyvc-cmd-get-vcs'
 232
 233 Note:
 234
 235   This variable is set to buffer local and one of the above choices is
 236   set if `tinyvc-select-backend' function, which is installed in
 237   `tinyvc-:vc-print-log-hook' recognized the backend."
 238   :type  'hook
 239   :group 'TinyVc)
 240
 241 (defcustom tinyvc-:locker-name (user-login-name)
 242   "*Your RCS locker ID that apperas in the lock statement."
 243   :type  'string
 244   :group 'TinyVc)
 245
 246 (defcustom tinyvc-:font-lock-keywords
 247   '((".*file:[ \t]+\\([^\n]+\\)"    1 'region)
 248     ("^head:.*"                     0 font-lock-reference-face)
 249     ("^locks:[ \t]+\\([^\n]+\\)"    1 font-lock-keyword-face)
 250     ("^total revisions:[ \t0-9]+"   0 font-lock-keyword-face)
 251     ("revision[ \t]+\\([^\n]+\\)"   1 font-lock-type-face)
 252
 253     ("date: +..\\([^ \t\n]+\\)"     1 font-lock-reference-face)
 254     ("author: +\\([^ \t\n]+\\)"     1 font-lock-keyword-face)
 255     ("state: +\\([^ \t\n]+\\)"      1 font-lock-reference-face))
 256   "Font lock keywords."
 257   :type  'sexp
 258   :group 'TinyVc)
 259
 260 ;;}}}
 261 ;;{{{ setup: private
 262
 263 (defvar tinyvc-:invoked-buffer nil
 264   "When you call `vc-print-log', the buffer-pointer is recored here.")
 265 (put 'tinyvc-:invoked-buffer 'permanent-local t)
 266
 267 (defvar tinyvc-:shell-buffer "*tinyvc-tmp*"
 268   "Shell buffer.")
 269
 270 ;;}}}
 271 ;;{{{ version
 272
 273 (eval-and-compile
 274   (ti::macrof-version-bug-report
 275    "tinyvc.el"
 276    "tinyvc"
 277    tinyvc-:version-id
 278    "$Id: tinyvc.el,v 2.47 2007/05/01 17:21:01 jaalto Exp $"
 279    '(tinyvc-:version-id
 280      tinyvc-:load-hook
 281      tinyvc-:mode-name
 282      tinyvc-:mode-prefix-key)))
 283
 284 ;;}}}
 285 ;;{{{ Minor mode
 286
 287 (defvar tinyvc-:mode-menu-main
 288   '("\
 289 uU)nlock l)ock o=co l=co-l h=co-head  p)op f)ind  m)ark k)ill r)eload [scM]"
 290     ((?u  . ( (call-interactively 'tinyvc-cancel-co)))
 291      (?U  . ( (tinyvc-unlock-unsafely ti::menu-:prefix-arg 'verb)))
 292      (?o  . ( (call-interactively 'tinyvc-do-co)))
 293      (?l  . ( (call-interactively 'tinyvc-do-co-l)))
 294      (?h  . ( (call-interactively 'tinyvc-do-co-head)))
 295      (?f  . ( (tinyvc-find-file-tmp ti::menu-:prefix-arg 'verb)))
 296      (?p  . ( (call-interactively 'tinyvc-pop-to-buffer)))
 297      (?k  . ( (call-interactively 'tinyvc-kill-tmp)))
 298      (?m  . ( (tinyvc-mark ti::menu-:prefix-arg 'verb)))
 299      (?r  . ( (call-interactively 'tinyvc-reload)))
 300      (?s  . ( (call-interactively 'tinyvc-status)))
 301      (?c  . ( (call-interactively 'tinyvc-chmod-toggle)))
 302      (?M  . ( (tinyurl-mode-help)))))
 303   "RCS Log browsing minor mode commands.
 304
 305 In alphabetical order.
 306
 307 c  = Toggle chmod in the file underneath for this buffer.
 308      You need this eg if you main version is locked. But you have
 309      made a branch where you want to continue.
 310 f  = `find-file'. Load the version in the line to temporary buffer
 311 h  = go to the head: string in the log buffer
 312 k  = Kill all temporary version files that have been loaded with 'f' command
 313      above.
 314 l  = lock the current version found in the line
 315 m  = Mark this line.
 316 p  = `pop-to-buffer'. Go to to buffer where this Log belongs to.
 317 r  = Reload Rlog buffer (it may be old if you have deposited new versions)
 318 s  = Status. Show some of the file's status information.
 319 uU = Cancel Checkout with 'co'")
 320
 321 ;;; ----------------------------------------------------------------------
 322 ;;;
 323 (defun tinyvc-mode-menu (&optional arg)
 324   "Call Echo area mode menu with ARG."
 325   (interactive "P")
 326   (ti::menu-menu 'tinyvc-:mode-menu-main arg))
 327
 328 ;;; ----------------------------------------------------------------------
 329 ;;;
 330 (defun tinyvc-install-to-emacs (&optional off)
 331   "Turn on `tinyvc-mode' in appropriate buffers."
 332   (interactive "P")
 333   ;;  User may have multiple logs, loop through all buffers.
 334   (dolist (buffer (buffer-list))
 335     (when buffer-file-name
 336       (with-current-buffer buffer
 337         (save-excursion
 338           (ti::pmin)
 339           ;;  CVS log is similar to RCS
 340           ;;
 341           ;;  RCS file: /users/foo/RCS/file.txt,v
 342           ;;  Working file: file.txt
 343           ;;  head: 1.23
 344           ;;  branch:
 345           ;;  locks: strict
 346           (when (looking-at "^RCS file: .*,v")
 347             (if off
 348                 (when tinyvc-mode
 349                   (message "TinyVc: Mode turned off, %s" (buffer-name))
 350                   (turn-off-tinyvc-mode))
 351               (unless tinyvc-mode
 352                 (message "TinyVc: Mode turned on, %s" (buffer-name))
 353                 (turn-on-tinyvc-mode)))))))))
 354
 355 ;;}}}
 356 ;;{{{ Macros
 357
 358 ;;; ----------------------------------------------------------------------
 359 ;;;
 360 (put 'tinyvc-do-macro 'lisp-indent-function 0)
 361 (defmacro tinyvc-do-macro (&rest body)
 362   "Store info to variables 'ver' and 'file'. Variable VERB must e also bound.
 363 If 'ver' of 'file' cannot be set, print message and do nothing with BODY."
 364   (`
 365    (when (and (or (setq ver (tinyvc-get-version))
 366                   (error "No version found on the line."))
 367               (or (setq file (tinyvc-get-filename))
 368                   (error "Can't find rcs file name from buffer.")))
 369      ;;  We must find absolute path; this isn't enough
 370      ;;
 371      ;;  Working file: tm-view.el
 372      (unless (string-match "/" file)
 373        (let (buffer)
 374          (cond
 375           ((setq buffer (get-buffer file))
 376            (save-excursion
 377              (set-buffer buffer)
 378              (setq file buffer-file-name)))
 379           (t
 380            (error "Can't find absolute filename %s" file)))))
 381      (,@ body))))
 382
 383 ;;; ----------------------------------------------------------------------
 384 ;;;
 385 (put 'tinyvc-file-confirm-macro 'lisp-indent-function 2)
 386 (defmacro tinyvc-file-confirm-macro (file verb &rest body)
 387   "Make sure FILE is read-only before continuing.
 388 If VERB is nil, don't do any checkings or ask from user when
 389 executing BODY."
 390   (`
 391    (when (or (null (, verb))
 392              (and (, verb)
 393                   (or (ti::file-read-only-p (, file))
 394                       (y-or-n-p
 395                        (format "Writable %s exist, are you sure "
 396                                (file-name-nondirectory (, file)))))))
 397      (,@ body))))
 398
 399 ;;; ----------------------------------------------------------------------
 400 ;;;
 401 (defsubst tinyvc-lock-listed-p ()
 402   "See if there is locks in listing."
 403   (save-excursion
 404     (ti::pmin)
 405     ;;    locks: strict
 406     ;;  jaalto: 1.1
 407     (re-search-forward "^locks:")
 408     (forward-line 1)
 409     (looking-at "^[ \t]+")))
 410
 411 ;;; ----------------------------------------------------------------------
 412 ;;;
 413 (defsubst tinyvc-get-tmp-list (file)
 414   "Return used temporary buffers matching FILE."
 415   (when file
 416     (setq file (file-name-nondirectory file))
 417     (ti::dolist-buffer-list
 418      (string-match (format "\\*%s.*[0-9]+\\*" file) (buffer-name))
 419      'map-temporary-buffers-too)))
 420
 421 ;;; ----------------------------------------------------------------------
 422 ;;;
 423 (put 'tinyvc-do-over-locks-macro 'lisp-indent-function 2)
 424 (defmacro tinyvc-do-over-locks-macro (user ver &rest body)
 425   "USER and VER is currently unused. Execute BODY over 'locks:' keyword.
 426
 427 While the macro loops each line; the variables 'user' and 'ver'
 428 are updated. If you want to terminate macro, move point away from the
 429 lock lines: eg by (goto-char (point-min)))."
 430   (`
 431    (save-excursion
 432      (ti::pmin) (re-search-forward "^locks:") (forward-line 1)
 433      (while (looking-at "^[ \t]+\\([^:]+\\):[ \t]\\([.0-9]+\\)")
 434        (setq user (match-string 1) ver (match-string 2))
 435        (,@ body)
 436        (forward-line 1)))))
 437
 438 ;;}}}
 439 ;;{{{ Rcs interface
 440
 441 ;;; ----------------------------------------------------------------------
 442 ;;;
 443 (defsubst tinyvc-cmd-cd-template (file &optional options)
 444   "Create 'cd' command template: \"cd DIR; %s FILE OPTIONS\"."
 445   (interactive)
 446   (concat  "cd " (file-name-directory file) "; "
 447            "%s " (or options "") " " (file-name-nondirectory file)))
 448
 449 ;;; ----------------------------------------------------------------------
 450 ;;;
 451 (defun tinyvc-cmd-get-cvs (sym)
 452   "Return RCS executable according to SYM."
 453   ;; This is default function. User may return "my-co" for 'co
 454   ;; command in certain situations etc in his own function.
 455   ;;
 456   ;;  "cvs co" is for
 457   ;;  the initial checkout of a file only, after that,
 458   ;;  "cvs update" is used.
 459   (cond
 460    ((eq 'co sym)        "cvs update")
 461    ((eq 'ci sym)        "cvs commit")
 462    ((eq 'rcs sym)       "cvs rcs")
 463    ((eq 'rlog sym)      "cvs log")
 464    ((eq 'rcsdiff sym)   "cvs diff") ;; -j<old-rev> -j<new-rev>"
 465    (t
 466     (error "No cmd %s " sym))))
 467
 468 ;;; ----------------------------------------------------------------------
 469 ;;;
 470 (defun tinyvc-cmd-get-rcs (sym)
 471   "Return RCS executable according to SYM."
 472   ;; This is default function. User may return "my-co" for 'co
 473   ;; command in certain situations etc in his own function.
 474   (cond
 475    ((eq 'co sym)        (symbol-name sym))
 476    ((eq 'ci sym)        (symbol-name sym))
 477    ((eq 'rcs sym)       (symbol-name sym))
 478    ((eq 'rlog sym)      (symbol-name sym))
 479    ((eq 'rcsdiff sym)   (symbol-name sym))
 480    (t
 481     (error "No cmd %s " sym))))
 482
 483 ;;; ----------------------------------------------------------------------
 484 ;;;
 485 (defun tinyvc-cmd-exec (sym shell-cmd &optional buffer noerr)
 486   "Execute shell command. If error, show result buffer.
 487
 488 Input:
 489
 490   SYM           Command symbol like 'co
 491   SHELL-CMD     Full shell command. If this command has %s in
 492                 a string, then RCS-SH-EXE is sprintf'd into that position.
 493                 Normally the rcs exe is prepended to the command.
 494   BUFFER        where to put shell command results
 495   NOERR         ignore errors
 496
 497 References:
 498
 499   `tinyvc-:cmd-function'"
 500   (let* ((exe    (funcall tinyvc-:cmd-function sym))
 501          (send   (if (string-match "%s" shell-cmd)
 502                      (format shell-cmd exe sym)
 503                    (format "%s %s" exe shell-cmd)))
 504          (out   (or buffer (ti::temp-buffer tinyvc-:shell-buffer 'clear))))
 505     (shell-command send out)))
 506
 507 ;;; ----------------------------------------------------------------------
 508 ;;;
 509 (defun tinyvc-cmd-diff-p (file &optional options)
 510   "Return t if there is diff for FILE with diff OPTIONS."
 511   (if (zerop
 512        (tinyvc-cmd-exec
 513         'rcsdiff
 514         (tinyvc-cmd-cd-template file (or options "-q"))
 515         nil
 516         'noerr))
 517       nil
 518     t))
 519
 520 ;;; ----------------------------------------------------------------------
 521 ;;;
 522 (defun tinyvc-cmd-rcs (file &optional options)
 523   "Run rcs command on FILE with OPTIONS."
 524   (tinyvc-cmd-exec 'rcs (tinyvc-cmd-cd-template file options)))
 525
 526 ;;}}}
 527 ;;{{{ Misc
 528
 529 ;;; ----------------------------------------------------------------------
 530 ;;;
 531 (defun tinyvc-lock-list ()
 532   "Return lock list. '((USER . LOCK-VER) ..)."
 533   (let (list
 534         user
 535         ver)
 536     (tinyvc-do-over-locks-macro user ver
 537                                 (push (cons user ver) list))
 538     (nreverse list)))
 539
 540 ;;; ----------------------------------------------------------------------
 541 ;;;
 542 (defun tinyvc-load-to-buffer (dest &optional noerr)
 543   "Examine `tinyvc-:shell-buffer' and copy the output to DEST buffer.
 544 If DEST does not exist, it is created. NOERR ignores errors."
 545   (interactive)
 546   (let ((shell tinyvc-:shell-buffer)
 547         point)
 548     (with-current-buffer shell
 549       (ti::pmin)
 550       (cond                             ; -p switch
 551        ((looking-at ".*-->[ \t]+stdout")
 552         (forward-line 2) (setq point (point)))
 553        ((save-excursion                 ; rlog
 554           (forward-line 1)
 555           (looking-at "RCS file:")
 556           (setq point (point)))))
 557       (when point                       ;Only if start point set
 558         (if (not (get-buffer dest))
 559             (setq dest (ti::temp-buffer dest 'clear))
 560           (ti::erase-buffer dest))
 561         (append-to-buffer dest point (point-max))))
 562     (when (and (null noerr)
 563                (null point))
 564       (pop-to-buffer shell)
 565       (error "Nothing to load  from shell buffer."))
 566
 567     ;; return success status
 568     point))
 569
 570 ;;; ----------------------------------------------------------------------
 571 ;;;
 572 (defun tinyvc-reload (&optional verb)
 573   "Replace buffer with current log. VERB."
 574   (interactive)
 575   (let ((file (tinyvc-get-filename)))
 576     (ti::verb)
 577     (tinyvc-cmd-exec 'rlog file nil 'noerr)
 578     (erase-buffer)
 579     (tinyvc-load-to-buffer (current-buffer))
 580     (run-hook-with-args-until-success 'tinyvc-:vc-print-log-hook)
 581     (if verb
 582         (message "Updated."))))
 583
 584 ;;; ----------------------------------------------------------------------
 585 ;;;
 586 (defun tinyvc-status ()
 587   "Show file status."
 588   (interactive)
 589   (let* ((file   (tinyvc-get-filename))
 590          (buffer (get-file-buffer file))
 591          str
 592          fn
 593          ver)
 594     (if buffer
 595         (setq ver (ti::vc-rcs-buffer-version buffer)))
 596     (setq fn  (file-name-nondirectory file)
 597           str (ti::file-access-mode-to-string
 598                (file-modes file)))
 599     (message "%s%s has modes %s " (if ver (concat ver " "))  fn str)))
 600
 601 ;;; ----------------------------------------------------------------------
 602 ;;;
 603 (defun tinyvc-chmod-toggle (&optional verb)
 604   "Toggle between =r and +w. VERB."
 605   (interactive)
 606   (let* ((file  (tinyvc-get-filename))
 607          (modes  (file-modes file)))
 608     (ti::verb)
 609     (if (ti::file-read-only-p file)
 610         (set-file-modes file (ti::file-mode-make-writable modes))
 611       (set-file-modes file (ti::file-mode-make-read-only-all modes)))
 612     (if verb
 613         (tinyvc-status))))
 614
 615 ;;; ----------------------------------------------------------------------
 616 ;;;
 617 (defun tinyvc-select-backend ()
 618   "Select RCS or CVS command for the log buffer: set `tinyvc-:cmd-function'."
 619   (interactive)
 620   (let* ((buffer  tinyvc-:invoked-buffer)
 621          file
 622          type)
 623     (when (and
 624            buffer
 625            (get-buffer buffer)
 626            (setq file
 627                  (with-current-buffer buffer (buffer-file-name))))
 628       (if (fboundp 'vc-buffer-backend)  ;19.30+
 629           (setq type (ti::funcall 'vc-buffer-backend))
 630         ;;  nope; that function does not exist. (19.28, 21.2+)
 631         (setq type (vc-file-getprop file 'vc-backend)))
 632       (make-local-variable 'tinyvc-:cmd-function)
 633       (cond
 634        ((equal type 'RCS)
 635         (setq tinyvc-:cmd-function 'tinyvc-cmd-get-rcs))
 636        ((equal type 'CVS)
 637         (setq tinyvc-:cmd-function 'tinyvc-cmd-get-rcs))))))
 638
 639 ;;; ----------------------------------------------------------------------
 640 ;;;
 641 (defun tinyvc-rename-buffer ()
 642   "Rename buffer to *Rlog* if the the previous buffer name was *vc*.
 643 Other vc commands normally destroy the log buffer, so renaming
 644 it keeps it alive until next rlog command."
 645   (interactive)
 646   (let* ((buffer (get-buffer "*Rlog*")))
 647     (when (string= "*vc*" (buffer-name))
 648       (if buffer (kill-buffer buffer)) ;  Remove old log buffer if it exists.
 649       (rename-buffer "*Rlog*"))))
 650
 651 ;;; ----------------------------------------------------------------------
 652 ;;;
 653 (defsubst tinyvc-char-mark-p (&optional remove)
 654   "Check if there is marker character at the beginning of line.
 655 Move point. Optionally REMOVE marker."
 656   (beginning-of-line)
 657   (char= (following-char) ?>))
 658
 659 ;;; ----------------------------------------------------------------------
 660 ;;;
 661 (defun tinyvc-char-mark (&optional unmark)
 662   "Mark the line, or UNMARK."
 663   (interactive)
 664   (cond
 665    ((and unmark (tinyvc-char-mark-p))
 666     (delete-char 1))
 667    ((and (null unmark) (tinyvc-char-mark-p))
 668     nil)                                ;there is already mark
 669    ((null unmark)
 670     (insert ">"))))
 671
 672 ;;; ----------------------------------------------------------------------
 673 ;;;
 674 (defun tinyvc-buffer-version (file)
 675   "If FILE is in emacs, return version number."
 676   (if (get-file-buffer file)            ;Loaded into emacs already
 677       (ti::vc-rcs-buffer-version (get-file-buffer file))))
 678
 679 ;;; ----------------------------------------------------------------------
 680 ;;;
 681 (defun tinyvc-get-filename ()
 682   "Return filename or nil."
 683   (save-excursion
 684     (ti::pmin)
 685     (cond
 686      ((re-search-forward "RCS file:[ \t]+\\([^ \n\t]+\\)")
 687       (ti::remove-properties (ti::vc-rcs-normal-file (match-string 1))))
 688      ((re-search-forward "Working file:[ \t]+\\([^ \n\t]+\\)")
 689       (ti::remove-properties (match-string 1))))))
 690
 691 ;;; ----------------------------------------------------------------------
 692 ;;;
 693 (defun tinyvc-get-version ()
 694   "Return version on current line."
 695   (let* ((line  (ti::read-current-line))
 696          (ver   (ti::string-match "[0-9]+\\.[0-9.]+" 0 line))
 697          (dots  (and ver
 698                      (count-char-in-string ?. ver))))
 699     (if (and ver
 700              ;; Must be odd count
 701              (not (eq 1 (% dots 2))))   ;odd, 1.1  or 1.1.1.1
 702         (setq ver nil))                 ;cancel
 703     ver))
 704
 705 ;;; ----------------------------------------------------------------------
 706 ;;;
 707 (defun tinyvc-file-untouched-p (file)
 708   "Check if buffer is in emacs and that FILE is not modified.
 709 If the file is not in emacs, run rcsdiff.
 710
 711 Return:
 712  str    buffer's RCS version if untouched.
 713  t      if file was not in emacs and there was no rcsdiff."
 714   (let* (buffer
 715          untouched
 716          ret)
 717     (setq buffer (get-file-buffer file))
 718     (cond
 719      ((null buffer)                     ;cond1
 720       (if (ti::file-read-only-p file) ;If it's readonly, suppose no diffs
 721           (setq ret t)
 722         (if (tinyvc-cmd-diff-p file)
 723             (setq ret t))))
 724      (buffer                            ;cond2:
 725       (save-excursion                   ;already loaded into emacs
 726         (set-buffer buffer)
 727         (unless (buffer-modified-p)
 728           (setq untouched t))
 729         (if untouched
 730             (setq ret (ti::vc-rcs-buffer-version))))))
 731     ret))
 732
 733 ;;}}}
 734 ;;{{{ interactive
 735
 736 ;;; ----------------------------------------------------------------------
 737 ;;;
 738 (defun tinyvc-mark (&optional unmark verb)
 739   "Mark revisions that were loaded by \\[tinyvc-find-file-tmp].
 740 Optionally UNMARK. VERB."
 741   (interactive "P")
 742   (let* ((list (tinyvc-get-tmp-list (tinyvc-get-filename)))
 743          (len  (if list (length list)))
 744          beg
 745          end
 746          re
 747          ver)
 748     (ti::verb)
 749     (save-excursion
 750       (dolist (elt list)
 751         (setq ver (ti::string-match "[0-9]+[.0-9]+" 0 elt))
 752         (setq re  (format "\\(revision\\)[ \t]+%s[^ \t]*$" ver))
 753         (ti::pmin)
 754         (when (re-search-forward re nil t)
 755           (cond
 756            ((ti::compat-window-system)  ;Windowed -- use colors
 757             (setq beg (match-beginning 1)  end (match-end 1))
 758             (if unmark
 759                 (put-text-property beg end 'face 'default)
 760               (put-text-property beg end 'face 'region)))
 761            (t                           ;Non-Windowed
 762             (tinyvc-char-mark unmark))))))
 763     (if verb
 764         (if (null len)
 765             (message "No temporary files.")
 766           (message "%smarked %d items" (if unmark "un" "") len)))))
 767
 768 ;;; ----------------------------------------------------------------------
 769 ;;;
 770 (defun tinyvc-kill-tmp ()
 771   "Kill all tmp buffers that were loaded from call \\[tinyvc-find-file-tmp]."
 772   (interactive)
 773   (let ((file  (tinyvc-get-filename)))
 774     (if (null file)
 775         (message "No RCS filename found.")
 776       (dolist (file (tinyvc-get-tmp-list file))
 777         (kill-buffer file)))))
 778
 779 ;;; ----------------------------------------------------------------------
 780 ;;;
 781 (defun tinyvc-pop-to-buffer ()
 782   "Pop to buffer accordig to this rlog."
 783   (interactive)
 784   (let* ((file    (tinyvc-get-filename))
 785          (buffer  (get-file-buffer file)))
 786     (if buffer
 787         (pop-to-buffer buffer)
 788       (if (y-or-n-p (format "No %s buffer, load "
 789                             (file-name-nondirectory file)))
 790           (find-file file)))))
 791
 792 ;;; ----------------------------------------------------------------------
 793 ;;;
 794 (defun tinyvc-find-file-tmp (&optional no-pop verb)
 795   "Find the current version into Emacs.
 796 The file will be Checked Out by using pipes and the created
 797 temporary buffer will not have any filename association.
 798
 799 You can use this function to e.g. get version 1.1.1.1 and 1.1.1.2 into
 800 emacs while your workfile stays somewhere else. Nice for pasting
 801 text from other versions.
 802
 803 Input:
 804  NO-POP     do not `pop-to-buffer' after rcs call.
 805  VERB       Verbose messages."
 806   (interactive "P")
 807   (let* (file
 808          ver
 809          buffer)
 810     (ti::verb)
 811     (tinyvc-do-macro
 812      (setq buffer (format "*%s %s*" (file-name-nondirectory file) ver))
 813      (if (get-buffer buffer)
 814          (if (null no-pop)
 815              (pop-to-buffer buffer))
 816        (tinyvc-cmd-exec 'co (format "-p -r%s %s" ver file))
 817        (tinyvc-load-to-buffer buffer)
 818        (if (null no-pop)
 819            (pop-to-buffer buffer))))
 820     (if (and verb no-pop)
 821         (message "Loaded %s" ver))))
 822
 823 ;;; ----------------------------------------------------------------------
 824 ;;;
 825 (defun tinyvc-unlock-unsafely (&optional all verb)
 826   "Read 'locks:' keyword and unlock first locked version in the list.
 827 If there is no locks, then do nothing. ALL unlocks all locks.
 828
 829 This is unsafe function, because no attempt is made to
 830 check if the file has changes. You may loose data is you call
 831 this fnction without checking the diffs.
 832
 833 Input:
 834
 835   ALL       Unlock all version locked.
 836   VERB      Verbose messags.
 837
 838 Notes:
 839  `tinyvc-:locker-name'  other locks are not touched ever.
 840  No buffer reverting is attempted."
 841   (interactive)
 842   (let* ((name  tinyvc-:locker-name)
 843          user
 844          ver
 845          file
 846          done)
 847     (ti::verb)
 848     (if (and verb
 849              (null (y-or-n-p "unlock: Are you absolutely sure ")))
 850         (error "Aborted."))
 851     (setq file (tinyvc-get-filename))
 852     (if (and verb
 853              (not (ti::file-read-only-p file)))
 854         (if (null (y-or-n-p (format "%s is writable, proceed "
 855                                     (file-name-nondirectory file))))
 856             (error "Aborted.")))
 857     (set-file-modes file (ti::file-mode-make-read-only-all (file-modes file)))
 858     (tinyvc-do-over-locks-macro user ver
 859                                 (when (string= user name)
 860                                   (if verb
 861                                       (message "Unlocking %s" ver))
 862                                   (tinyvc-cmd-exec 'co (format "-u%s %s" ver file))
 863                                   (setq done t)
 864                                   (if (null all)
 865                                       ;; Terminate lock macro loop
 866                                       (ti::pmin))))
 867     (when done
 868       (tinyvc-reload)
 869       (if verb
 870           (message "done.")))))
 871
 872 ;;; ----------------------------------------------------------------------
 873 ;;;
 874 (defun tinyvc-cancel-co (&optional verb)
 875   "Cancel Checkout for current revision, so that file is no more locked.
 876 Notice that the lock status is based on the buffer content. Do
 877 \\[tinyvc-reload] to update the log if needed. VERB.
 878
 879 Chmod undelying file to read-only."
 880   (interactive)
 881   (let* (buffer
 882          ver
 883          file
 884          llist)
 885     (ti::verb)
 886     (tinyvc-do-macro
 887      (setq llist  (tinyvc-lock-list))
 888      (if (null llist)
 889          (if verb
 890              (message "Lock list seems to be empty."))
 891        (if (not (rassoc ver llist))
 892            (if verb
 893                (message "%s is not locked." ver))
 894          (set-file-modes file 292)      ;444oct, rrr
 895          (tinyvc-cmd-exec 'co (format "-u%s %s" ver file))
 896          (tinyvc-reload)                ;Update
 897          (when (setq buffer (get-file-buffer file))
 898            (pop-to-buffer buffer)
 899            (call-interactively 'revert-buffer)
 900            (message ""))
 901          (if verb
 902              (message "Revision %s unlocked." ver)))))))
 903
 904 ;;; ----------------------------------------------------------------------
 905 ;;;
 906 (defun tinyvc-do-co-l ()
 907   "Do co and lock the version number on the line."
 908   (interactive)
 909   (let* (old-buffer
 910          ver
 911          file)
 912     (tinyvc-do-macro
 913      (setq old-buffer (get-file-buffer file))
 914      (if (not (tinyvc-file-untouched-p file))
 915          (error "'%s' modified or buffer not read-only." file))
 916      (if (file-writable-p file)
 917          (error "Can't lock: Underlying file is writable."))
 918      (when (or  (null (tinyvc-lock-listed-p))
 919                 (y-or-n-p "There is already lock, proceed? "))
 920        (tinyvc-cmd-exec 'co (format "-l%s %s" ver file))
 921        (tinyvc-reload)
 922        (pop-to-buffer (find-file-noselect file))
 923        (when old-buffer
 924          (call-interactively 'revert-buffer)
 925          (message ""))))))
 926
 927 ;;; ----------------------------------------------------------------------
 928 ;;;
 929 (defun tinyvc-do-co-head ()
 930   "CheckOut the HEAD revision."
 931   (interactive)
 932   (ti::pmin)
 933   (if (re-search-forward "^head: ")
 934       (call-interactively 'tinyvc-do-co)
 935     (message "Hm, Can't find the 'head:' tag anywhere? ")))
 936
 937 ;;; ----------------------------------------------------------------------
 938 ;;;
 939 (defun tinyvc-do-co (&optional replace verb)
 940   "Checkout specific revision around current point.
 941 REPLACE current emacs buffer with this version if the existing file in emacs
 942 is read-only. VERB."
 943   (interactive "P")
 944   (let* (verb
 945          ver file
 946          untouched
 947          buffer
 948          buffer-ver
 949          ret)
 950     (ti::verb)
 951     (tinyvc-do-macro
 952      (setq buffer     (find-buffer-visiting  file)
 953            untouched  (tinyvc-file-untouched-p file)
 954            buffer-ver (or (tinyvc-buffer-version file) ""))
 955      (tinyvc-file-confirm-macro file verb
 956                                 (cond
 957                                  ((string= ver buffer-ver)
 958                                   (if verb
 959                                       (message (format "%s v%s already in emacs." buffer ver)))
 960                                   (setq ret buffer))
 961                                  ((or (and
 962                                        (file-writable-p file)
 963                                        (y-or-n-p "Writable file, needs chmod, ok? ")
 964                                        (progn
 965                                          (set-file-modes
 966                                           file (ti::file-mode-make-read-only (file-modes file)))
 967                                          t))
 968                                       (null buffer)
 969                                       untouched)
 970                                   (when (or (null verb)
 971                                             (null buffer)
 972                                             (and verb
 973                                                  (y-or-n-p
 974                                                   (format "Untouched %s, replace %s with version %s ?"
 975                                                           (file-name-nondirectory file)
 976                                                           buffer-ver ver))))
 977                                     ;;  (if buffer (kill-buffer buffer))
 978                                     (tinyvc-cmd-exec 'co (format "-r%s %s " ver file))
 979                                     (with-current-buffer buffer
 980                                       (revert-buffer nil 'no-confirm)
 981                                       (setq buffer (current-buffer)))
 982                                     (if verb
 983                                         (display-buffer buffer))))
 984                                  (t
 985                                   (if verb
 986                                       (message (format "Changed buffer exist, cancelled.")))))))
 987     ret))
 988
 989 ;;}}}
 990
 991 (if (boundp 'vc-print-log-hook)         ;Not Exist in 19.34
 992     (ti::add-hooks 'vc-print-log-hook tinyvc-:vc-print-log-hook)
 993   (eval-when-compile (require 'advice))
 994   (defadvice vc-print-log (around tirl act)
 995     "Run hook `tinyvc-:vc-print-log-hook'."
 996     (let* ((BuffeR (current-buffer)))
 997       ad-do-it
 998       (make-local-variable 'tinyvc-:invoked-buffer)
 999       (put 'tinyvc-:invoked-buffer 'permanent-local t)
1000       (setq tinyvc-:invoked-buffer BuffeR)
1001       (run-hooks 'tinyvc-:vc-print-log-hook))))
1002
1003 (add-hook 'tinyvc-:mode-define-keys-hook 'tinyvc-mode-define-keys)
1004
1005 (provide   'tinyvc)
1006
1007 (tinyvc-install-to-emacs)
1008 (run-hooks 'tinyvc-:load-hook)
1009
1010 ;;; tinyvc.el ends here