(defconst rcs-version (substring "$Revision: 1.55 $" 11 -2) "\ $Id: rcs.el,v 1.55 1992/02/10 10:29:26 sk Exp $ Report bugs to: Sebastian Kremer Available for anonymous FTP from ftp.cs.buffalo.edu:pub/Emacs/rcs.tar.Z and ftp.uni-koeln.de:/pub/gnu/emacs/rcs.tar.Z") (defvar rcs-bind-keys t "\ If nil, rcs.el will not bind any keys. Has to be set before rcs.el is loaded.") (defvar rcs-active t "\ *If non-nil, RCS controlled files are treated specially by Emacs.") (defvar rcs-ange-ftp-ignore t "\ *If non-nil, remote ange-ftp files are never considered RCS controlled. This saves a lot of time for slow connections.") (defvar rcsdiff-switches nil "\ *If non-nil, a string specifying switches to be be passed to rcsdiff. A list of strings (or nil) means that the commandline can be edited after inserting those strings.") (defvar rcs-default-co-switches nil "\ List of switches (strings) for co(1) to use on every `rcs-check-out'.") (defvar rcs-default-ci-switches nil "\ List of switches (strings) for ci(1) to use on every `rcs-check-in'. You can use the `-f' switch to force new revision with RCS 5.6 even if the file did not change.") (defvar rcs-default-rlog-switches nil "\ List of switches (strings) for rlog(1) to use on every `rcs-log'.") (defvar rcs-read-log-function nil "\ *If non-nil, function of zero args to read an RCS log message. If nil, log messages are read from the minibuffer. Possible value: 'rcs-read-log-string-with-recursive-edit.") (defvar rcs-mode nil "\ If non-nil, the current buffer's file is RCS-controlled: If the emptry string, it is unlocked, and the modeline display the head revision number. Else it is a string of lockers as returned by function `rcs-status', which is displayed in the modeline, in the format LOCKER:REV.") (defvar rcs-mode-string nil) (put (quote rcs-mode) (quote preserved) t) (put (quote rcs-mode-string) (quote preserved) t) (if (not (assoc (quote rcs-mode) minor-mode-alist)) (progn (setq minor-mode-alist (cons (quote (rcs-mode rcs-mode-string)) minor-mode-alist)) (set-default (make-variable-buffer-local (quote rcs-mode)) nil) (set-default (make-variable-buffer-local (quote rcs-mode-string)) nil))) (defun rcs-file-not-found nil (byte-code " ! !\"‡" [rcs-active buffer-file-name t rcs-status rcs-check-out y-or-n-p "Check out writable and locked for editing? " ("-l")] 5)) (or (memq (quote rcs-file-not-found) find-file-not-found-hooks) (setq find-file-not-found-hooks (cons (quote rcs-file-not-found) find-file-not-found-hooks))) (defun rcs-status (fname &optional switches) "\ Returns the locker and version of this file if it is locked, an empty string if it is not locked, and nil if it is not an RCS controlled file. If several lockers, they are returned as one string, separated by SPC. With a prefix arg, set the status instead of querying it. This works by passing the prompted-for SWITCHES to the `rcs' program." (interactive (byte-code " ‚ P!!D" [current-prefix-arg rcs-read-file-name "Set" "Query" " RCS status of: " rcs-read-switches "Switches for rcs: "] 4)) (byte-code "Ĉ ! 4 ! q D\"& V/ #)) K!K !Uĉ !\"q\"eb#!!\"eb## )eb!!!\" )t? \"\" \" # !   q\"))+" [current-prefix-arg fname switches output-buffer nil t rname status head rcs-ange-ftp-ignore buffer expand-file-name rcs-get-output-buffer apply call-process "rcs" append "-q" buffer-size 0 rcs-error fboundp ange-ftp-ftp-path rcs-data-file " *RCS-temp*" insert-file-contents re-search-forward "^locks[ ]+\\([^;]*\\)" narrow-to-region match-beginning 1 match-end "[ ]+" replace-match " " buffer-string "" "^head[ ]+\\([0-9.]+\\)" buffer-substring erase-buffer message "Not an RCS-controlled file: %s" equal "No current locker for %s" "%s -- %s" get-file-buffer rcs-set-modeline] 31)) (defun rcs-we-locked (fname &optional status) (byte-code " !\" !P\"\"!!O" [status fname rcs-status string-match regexp-quote user-login-name ":[ ]*\\([0-9.]+\\)" match-beginning 1 match-end] 9)) (defun rcs-load-postprocessor nil "\ Peeks at files after they are loaded to see if they merit special treatment by virtue of being active RCS files. You can also call this interactively to refresh the modeline, e.g. after a major mode change that killed all local variables." (interactive) (byte-code "ˆ !" [rcs-active buffer-file-name nil rcs-status] 2)) (defun rcs-set-modeline (status &optional head) (byte-code "   \"  Pǂ P" [rcs-mode status rcs-mode-string head equal "" " " " RCS"] 3)) (or (memq (quote rcs-load-postprocessor) find-file-hooks) (setq find-file-hooks (cons (quote rcs-load-postprocessor) find-file-hooks))) (defun rcs-read-switches (prompt &optional default) (byte-code " \"\" \"_ #D O!\"@ B O\"[ B !-" [answer prompt default beg end result switch read-string 0 nil equal " " rcs-read-switches-allowing-space string-match "[ ]+" match-end "" nreverse] 9)) (defun rcs-read-switches-allowing-space (prompt &optional default) (byte-code " ?. T!R!\" * B !," [answer result done count prompt nil 0 read-string "(#" int-to-string ", just RET for last) " equal "" nreverse] 7)) (defun rcs-read-file-name (prompt) (byte-code "! P \" #) !" [buffer-file-name dir prompt nil file-name-nondirectory read-file-name format "(default %s) "] 6)) (defun rcs-read-log-string (prompt) (byte-code " ! !" [rcs-read-log-function prompt funcall read-string] 3)) (defun rcs-read-log-string-with-recursive-edit nil "\ Useful as value of `rcs-read-log-function'." (byte-code "!Ë)" [buffer get-buffer-create "*RCS log message*" ((byte-code "!!! " [buffer switch-to-buffer "*Help*" princ substitute-command-keys "Enter the RCS log message. Type \\[mark-whole-buffer] \\[kill-region] to kill old entry. Type \\[exit-recursive-edit] when finished editing or \\[abort-recursive-edit] to abort." recursive-edit buffer-string] 6))] 2)) (defun rcs-revert-buffer (&optional arg no-confirm) (interactive "P") (byte-code "Ɉ ` o`d` \\^\" G\" Z W5 [b Bebj \"Ndbj #c` #b #j!." [opoint osize obobp diff context ostring l arg no-confirm nil t widen buffer-size 100 buffer-substring revert-buffer 0 equal "" search-forward - backward-char] 12)) (defun rcs-refresh-buffer (filename) (byte-code " !pŎq\")*" [output-buffer filename obuf t get-file-buffer ((byte-code "q" [obuf] 1)) rcs-revert-buffer] 4)) (defun rcs-get-output-buffer (file &optional name) (byte-code " ! q!! ) *" [default-major-mode buf name buffer-read-only nil default-directory file fundamental-mode get-buffer-create "*RCS-output*" file-name-directory expand-file-name erase-buffer] 5)) (defun rcs-error (program fname buffer) (byte-code "! #" [buffer program fname display-buffer error "RCS command `%s' failed on %s"] 5)) (defun rcs-data-file (filename) "\ Return the name of the RCS data file for FILENAME, or nil." (byte-code "!!!R !P !# )" [filename rname expand-file-name file-name-directory "RCS/" file-name-nondirectory ",v" file-readable-p] 7)) (defun rcs-working-file (filename) "\ Convert an RCS file name to a working file name. That is, convert `...foo,v' and `...RCS/foo,v' to `...foo'. If FILENAME doesn't end in `,v' it is returned unchanged." (byte-code "\"? :O! ? 9 ! !\"7 !!P8))" [filename dir dir-file string-match ",v$" 0 -2 file-name-directory directory-file-name equal "RCS" file-name-nondirectory] 9)) (defun rcs-files (directory) "\ Return list of RCS data files for all RCS controlled files in DIRECTORY." (byte-code "!\"!# !# # \" *" [directory rcs-dir rcs-files t file-name-as-directory expand-file-name "RCS" directory-files ",v$" file-directory-p append] 10)) (defun rcs-locked-files (directory) "\ Return list of RCS data file names of all RCS-locked files in DIRECTORY." (byte-code " ! ! ;qK &ebm?8`!`S\" B\" )+" [output-buffer directory rcs-files result nil t rcs-get-output-buffer apply call-process "rlog" "-L" "-R" buffer-substring forward-line 1] 12)) (defun rcs-check-out (filename &optional switches) "\ Attempt to check the specified file out using RCS. If a prefix argument is supplied, will let you edit the `co' switches used, defaulting to \"-l\" to check out locked. Use \"-rREV\" or \"-lREV\" to check out specific revisions." (interactive (byte-code "! \"D" [current-prefix-arg rcs-read-file-name "Check out file: " rcs-read-switches "Switches for co: " "-l"] 5)) (byte-code "È! ! ! ! q  D#& !?4 V< #) !)!" [current-prefix-arg filename output-buffer nil t switches rcs-default-co-switches message "Working..." expand-file-name rcs-get-output-buffer delete-windows-on apply call-process "co" append "-q" file-readable-p buffer-size 0 rcs-error rcs-refresh-buffer ""] 15)) (defun rcs-check-in (filename log &optional switches) "\ Attempt to check the specified file back in using RCS. If a prefix argument is supplied, will let you edit the `ci' switches used, with default \"-l\" switch to keep file locked. Use \"-uREV\" or \"-lREV\" to check in as specific revision." (interactive (byte-code "!!\"E" [current-prefix-arg rcs-read-file-name "Check in file: " rcs-read-log-string "Log message: " rcs-read-switches "Switches for ci: " "-l"] 7)) (byte-code "Lj ! B ! !tA A !A!3 q )?A!?A!! ! qP  E#& Vu #) !*!" [current-prefix-arg filename switches output-buffer f-buffer t log nil rcs-default-ci-switches expand-file-name "-u" rcs-get-output-buffer get-file-buffer buffer-modified-p y-or-n-p "Save buffer first? " save-buffer "Check in despite unsaved changes to file? " error "Check-in aborted" message "Working..." delete-windows-on "-m" apply call-process "ci" append "-q" buffer-size 0 rcs-error rcs-refresh-buffer ""] 22)) (defun rcs-unlock (filename) "\ Attempt to remove your RCS lock on the specified file. Requires confirmation if there are changes since the last checkin." (interactive (byte-code "!C" [rcs-read-file-name "Unlock RCS file: "] 2)) (byte-code "Ĉ!!?!!! $ ! ! q!%eb!!e`\" Wdbc\\`dW! h ! q!?w! & V #)+\"" [filename output-buffer f-buffer modified nil t expand-file-name rcs-we-locked error "File was not locked to begin with" rcs-get-output-buffer get-file-buffer buffer-modified-p delete-windows-on message "Examining file..." call-process "rcsdiff" re-search-forward "^diff +-r.*$" forward-char 1 delete-region " There are unsaved changes to the buffer itself! " "" display-buffer yes-or-no-p "Discard changes made since file locked? " "Unlock aborted" erase-buffer "rcs" "-u" "-q" buffer-size 0 rcs-error rcs-check-out ("-f")] 25)) (defun rcs-toggle-read-only nil "\ If the buffer is read-only and under RCS, adjust RCS status. That is, make buffer writable and check file out locked for editing." (interactive) (byte-code "Ĉ    \"?W!G !) !@!9 \"= \"D \"T!R T Y !" [rcs-active rcs-mode buffer-read-only buffer-file-name nil rcs-we-locked y-or-n-p "Check buffer out from RCS for edit? " file-exists-p file-writable-p yes-or-no-p "Illegally writable copy of RCS controlled file - force checkout anyway? " rcs-check-out ("-f" "-l") error "Illegally writable copy of RCS controlled file %s" ("-l") "File is RCS controlled - make buffer writable anyway? " toggle-read-only barf-if-buffer-read-only message ""] 14)) (defun rcs-log (fname &optional switches) "\ Show the RCS log of changes for the specified file. With an arg you can pass additional switches to the `rlog' program." (interactive (byte-code "! !D" [current-prefix-arg rcs-read-file-name "Show RCS log of: " rcs-read-switches "Switches for rlog: "] 4)) (byte-code "È ! !?! ! q!  C#&eb! !))" [current-prefix-arg fname output-buffer nil t switches rcs-default-rlog-switches expand-file-name rcs-status error "File is not under RCS control" rcs-get-output-buffer message "Requesting log..." apply call-process "rlog" append "" display-buffer] 15)) (defun rcs-diff (fname &optional switches) "\ Show the differences between current file and the last revision checked in. With prefix arg, edit the `rcsdiff' commandline. See also variable `rcsdiff-switches'." (interactive (byte-code "! <& ; % <$ #%\"D" [current-prefix-arg rcsdiff-switches rcs-read-file-name "Show RCS diffs for: " rcs-read-switches "Switches for rcsdiff: " mapconcat identity " " ""] 8)) (byte-code "ƈ ! !?! $ < \" C ! !t> > !>!C q! C\"&!db\"\"eb !)*" [current-prefix-arg rcsdiff-switches fname switches output-buffer f-buffer nil t expand-file-name rcs-status error "File is not under RCS control" rcs-get-output-buffer get-file-buffer buffer-modified-p y-or-n-p "Save file before comparing? " save-buffer message "Comparing files..." apply call-process "rcsdiff" append "Comparing files...done" insert make-string 67 61 " " display-buffer] 18)) (defun rcs-who (directory) "\ Display list of RCS-locked files and their lockers in DIRECTORY." (interactive "DRcswho (directory): ") (byte-code "È !!! ?&\"* \")" [directory default-directory rcs-files nil expand-file-name file-name-as-directory message "No RCS controlled files in %s" rcs-who-1] 7)) (defun rcs-who-1 (directory rcs-files) (byte-code " \"q \" &eb !?+#?5!!eb`#} `\"!c`#b `\"i!!!!bc`; d\")! \"! \"))" [output-buffer directory nil t rcs-files pos rcs-get-output-buffer "*RCS-who*" message "rcs-who %s..." apply call-process "rlog" "-L" "-h" zerop buffer-size search-forward "Working file" display-buffer error "Rlog error" re-search-forward "Working file: *" delete-region end-of-line 1 " " "locks:[ ]*\\(strict[ ]*\\)?" "Cannot parse this rlog format" ";[ ]*strict\\| access list:" match-beginning 0 " " "" /= "No files locked in %s"] 25)) (if (null rcs-bind-keys) nil (global-set-key "D" (quote rcs-diff)) (global-set-key "I" (quote rcs-check-in)) (global-set-key "L" (quote rcs-log)) (global-set-key "O" (quote rcs-check-out)) (global-set-key "S" (quote rcs-status)) (global-set-key "U" (quote rcs-unlock)) (global-set-key "W" (quote rcs-who)) (global-set-key "" (quote rcs-toggle-read-only))) (provide (quote rcs)) (provide (quote rcs-sk))