(provide (quote rcs)) (defvar rcs-use-other-win t "\ *If non-nil, pop to a separate window when doing two-window things (log entries and displaying diffs).") (defvar rcs-use-directories t "\ *If non-nil, checkin will make a RCS directory if none exists.") (defvar rcs-diff-options "-qc" "\ *If non-nil, any additional options rcsdiff will be given.") (defvar rcs-ci-buffer-kills-buffer nil "\ *If non-nil, when a rcs-ci-buffer is done with no prefix arg, that buffer is killed.") (defvar rcs-executable-path nil "\ *If non-nil, the default path to find an RCS command on.") (defvar rcs-edit-mode nil "\ *If non-nil, the log buffer will be placed in this mode. Otherwise, the log buffer will be in default-major-mode.") (defvar rcs-use-login-name t "\ *If non-nil, checkins will use the name you're currently logged in under, instead of the name for your current UID (eg, if you su to root and use emacs to check in a file, the RCS log will have your user name in it instead of 'root').") (defvar rcs-make-backup-files t "\ *If non-nil, backups of checked-in files are made according to the make-backup-files variable. Otherwise, prevents backups being made.") (defvar rcs-initial-branch "1" "\ *If non-nil, branch number to assign an initial checkin.") (defvar rcs-initial-rev "0" "\ *If non-nil, revision number to assign an initial checkin.") (defvar rcs-initial-access nil "\ If non-nil, access list to assign to an initial checkin.") (defvar rcs-keep-log nil "\ *If non-nil, keeps old log. Otherwise gives user blank log message for each checkin.") (defvar rcs-force-checkin nil "\ *If non-nil, force a checkin even if the file has not changed.") (defvar rcs-error-time 3 "\ *The length of time the rcs package will wait after an error message has been displayed before proceeding.") (defvar rcs-hook nil "\ *Hooks run at the end of this file.") (defvar rcs-new-dir-hook nil "\ *Hooks run when a new ./RCS directory is created.") (defvar rcs-new-file-hook nil "\ *Hooks run when a file has been checked in for the first time.") (defvar rcs-log-buffer "#rcs log#") (defvar rcs-temp-buffer "#rcs temp#") (defvar rcs-exec-path nil "\ Path rcs searches to find executables. Built from rcs-executable-path and exec-path.") (defvar rcs-shell-path "/bin/sh" "\ *If non-nil, the file name to load inferior shells for RCS commands from. If nil, shell-file-name's value is used instead.") (defvar rcs-use-prev-log nil "\ *If non-nil, rcs-ci-file will not prompt for new log but simply use old log buffer.") (defun buf-kill-and-reload (fn) "\ Given FILE, cause the current version of that file to be loaded into a buffer. If the file was already in a buffer already, the buffer will be refreshed to contain the latest version of the file. If the buffer has been modified, the file will NOT be saved. Makes some attempt to keep the mark and point the same if the buffer was around before." (byte-code " !'!` !! ! ! b** !)" [buf fn curp curm nil get-file-buffer switch-to-buffer mark set-buffer-modified-p kill-buffer find-file set-mark] 9)) (defun make-rcs-name (fn) "\ Make the name for an RCS file from the normal file name." (byte-code "\"?P" [fn string-match ",v$" ",v"] 3)) (defun make-normal-name (fn) "\ Make a normal file name from an RCS file name." (byte-code "\"!O\"&!O!OP" [fn string-match ",v$" 0 match-beginning "RCS/" match-end nil] 9)) (defun is-rcs-file-p (fn) "\ Return t if FILE is an RCS file." (byte-code "O\"" [fn string= -2 nil ",v"] 4)) (defun has-rcs-file-p (fn) "\ Return t if FILE has an RCS file." (byte-code "!!!Q!!!‡" [fn t nil file-exists-p file-name-directory "RCS/" make-rcs-name file-name-nondirectory] 7)) (defun find-exec-command (cmd paths) "\ Return the full path to CMD from PATHS or just CMD if not found." (byte-code "? @ Q!@ Q A\"" [paths cmd t file-exists-p "/" find-exec-command] 4)) (defun get-rcs-log (banner buf) "\ Prompting with BANNER, get a RCS log entry into the given BUFFER." (byte-code "ŋ)" [rcs-use-other-win buf rcs-keep-log rcs-edit-mode banner ((byte-code "? ! ! ?  ! P!! !" [rcs-use-other-win buf rcs-keep-log rcs-edit-mode banner switch-to-buffer switch-to-buffer-other-window erase-buffer funcall message substitute-command-keys " entry; \\[exit-recursive-edit] to end, \\[abort-recursive-edit] to abort." recursive-edit "Finished entry"] 9))] 1)) (defun buffer-to-list (buffer-name) "\ Return a list, each line in BUFFER-NAME." (byte-code "qebd#8!!\"Cd#4!!\"C \" !" [buffer-name t buf-list re-search-forward "^.+$" buffer-substring match-beginning 0 match-end append reverse] 12)) (defun list-to-string (list-of-strings) "\ Take LIST-OF-STRINGS and return a string composed of all the elements of the list with spaces between each." (byte-code "K#" [list-of-strings mapconcat identity " "] 5)) (defun string-to-list (string-of-lists) "\ Given a STRING-OF-LISTS, (characters separated by whitespace), returns a list with the string elements." (byte-code " #) !!O B!T !+" [i is list-all nil string-of-lists 0 string-match "[ ]*\\([^ ]+\\)[ ]*" match-beginning 1 match-end reverse] 7)) (defun list-loc (list target) "\ Given LIST, find TARGET in the list, and return its index (0=first). If not found, return nil" (byte-code "" [match-found (byte-code " # @ \"\" A\\)Ç" [i list target nil 0 equal throw match-found 1] 5)] 2)) (defun rcs-list-files (&optional directory-name) "\ Returns a list of RCS files in current directory, or optional DIRECTORY-NAME." (byte-code "!?ĉ!P!' #,#" [directory-name rcs-directory t file-directory-p "./" file-name-as-directory "RCS" directory-files ",v$"] 8)) (defun rcs-co-file (fn) "\ Check out and visit a file. If the file is already in a buffer, it is refreshed with the latest version from disk. If the file is in a buffer and the buffer has been modified, it will not be saved (the ice is thin here). If no RCS file exists for the file, it will go through an initial checkin." (interactive "FFile to check out: ") (byte-code "" [nil co-error (byte-code "! !!?'\"?'! !\"!1!SQ!K!&S!\"\" !! \"!&&!!" [fn t rcs-error-time nil rcs-shell-path rcs-exec-path is-rcs-file-p make-normal-name has-rcs-file-p rcs-ci-file message "Cannot create initial file." sit-for throw co-error file-exists-p file-writable-p y-or-n-p "File " " is writeable; overwrite? " call-process "rm" "-f" expand-file-name " " "Checking out %s..." "-c" concat "cd " file-name-directory "; " find-exec-command "co" " -l " file-name-nondirectory buf-kill-and-reload "Checkout done"] 32)] 2)) (defun rcs-co-buffer nil "\ Check out the current buffer." (interactive) (byte-code "  !!" [nil buffer-file-name rcs-co-file message "No file associated with current buffer"] 5)) (defun rcs-co-tags (&optional use-1st-log) "\ Perform rcs checkout of current tag table. If no prefix argument is given, get initial log file for each newly checked-in tag file; with prefix, use 1st initial log entry for all new RCS files." (interactive "P") (byte-code "ƈɋ)" [next-file-list old-keep-log rcs-keep-log t old-use-prev-log rcs-use-prev-log nil fn use-1st-log ((byte-code " 0@!!A,É  !-" [next-file-list old-keep-log rcs-keep-log t old-use-prev-log rcs-use-prev-log nil fn use-1st-log tag-table-files find-file rcs-co-file message "All files processed."] 6))] 1)) (defun rcs-ci-file (fn &optional locked) "\ Use RCS to check back in FILE, with a given comment. If a prefix argument is given, the file is left locked; otherwise, it is left unlocked. The file will always still exist. A checkin is forced if the variable rcs-force-checkin is t; otherwise, if the file is unchanged, it is simply left locked or unlocked. If the file is in a buffer and has been modified, it will be saved first. rcs-ci-file returns nil if it detected an error. The hook rcs-new-dir-hook is run after a new RCS directory is created; the hook rcs-new-file-hook is run after a file is checked in the first time. When this happens, 'fn' is the file being checked in, and 'dir' is the just-created directory." (interactive "fFile to check in: P") (byte-code "! !ō" [fn nil is-rcs-file-p make-normal-name ci-error (byte-code "!?\" !\"! !!3 ?/!‰!!! !!!P  !? !?a  \" % !~͂ \" !\"!? \"͉? \"‰q q\"d!!\" Q@ABC%D!& &?3E !)ebFG#SځH\" !\"?ebFI#ځJyK|L# !? !!M\"ND!&&O! !q !!P\"QD!&&ebFG#ځR!\"E!))&S!ځT!)-" [fn rcs-error-time nil rcs-make-backup-files make-backup-files log rcs-log-buffer buf buftmp rcs-temp-buffer dir inital rcs-use-directories t rcs-use-prev-log initial rcs-shell-path rcs-exec-path rcs-force-checkin rcs-use-login-name locked rcs-initial-branch rcs-initial-rev rcs-keep-log rcs-initial-access file-exists-p message "File %s doesn't exist to check in." sit-for throw ci-error get-file-buffer buffer-modified-p make-local-variable write-file get-buffer-create expand-file-name file-name-directory "RCS" has-rcs-file-p file-directory-p "Creating RCS directory %s..." call-process "mkdir" "Cannot create RCS directory %s" run-hooks rcs-new-dir-hooks get-rcs-log "General descriptive text" "Description of changes" erase-buffer "Checking in %s..." call-process-region 1 "-c" concat "cd " "; " find-exec-command "ci" " -f " " " user-login-name " -w" "-l " "-u " "-r" "." file-name-nondirectory kill-buffer re-search-forward "error:" "Cannot check in RCS file %s" "unchanged with respect" "RCS file %s unchanged; left %s" "locked." "unlocked." "co" " -f -u " rcs-new-file-hook "rcs" " -a" "Cannot set access list on RCS file" buf-kill-and-reload "Checkin done"] 73)] 4)) (defun rcs-ci-buffer (&optional flag) "\ Check back in and unlock the current buffer. Saves the current buffer first. If prefix argument given, inverts the sense of rcs-ci-buffer-kills-buffer." (interactive "P") (byte-code " ' \"$  ?  ?$p!*!" [nil rcs-ci-buffer-kills-buffer flag buffer-file-name rcs-ci-file kill-buffer message "No file associated with the current buffer"] 6)) (defun rcs-log-buffer nil "\ Record a change to the current buffer, but keep on editing it. Saves the current buffer first." (interactive) (byte-code "  \"!" [nil buffer-file-name rcs-ci-file t message "No file associated with the current buffer"] 5)) (defun rcs-ci-tags (&optional use-1st-log) "\ Perform rcs checkin of current tag table. If no prefix argument is given, get log file for each tag file; with prefix, use 1st log entry for all tag files." (interactive "P") (byte-code "ƈɋ)" [next-file-list old-keep-log rcs-keep-log t old-use-prev-log rcs-use-prev-log nil fn use-1st-log ((byte-code " 0@!!A,É  !-" [next-file-list old-keep-log rcs-keep-log t old-use-prev-log rcs-use-prev-log nil fn use-1st-log tag-table-files find-file rcs-ci-file message "All files processed."] 6))] 1)) (defun rcs-diff-file (fn) "\ Run an rcsdiff on FILE and display the differences in another buffer." (interactive "fFile to diff: ") (byte-code "È!?P!f!?\"fQ! q )\" !! \" !&&[ !^ !eb!)" [fn buf rcs-shell-path nil rcs-exec-path rcs-diff-options rcs-use-other-win has-rcs-file-p message "No RCS file exists for " file-exists-p "File %s has not been checked out" get-buffer-create "# rcs diff : " " #" erase-buffer "Diffing %s..." call-process "-c" concat "cd " expand-file-name file-name-directory "; " find-exec-command "rcsdiff" " " file-name-nondirectory switch-to-buffer-other-window switch-to-buffer "Done"] 26)) (defun rcs-diff-buffer nil "\ Run an rcsdiff on the current buffer. The file will not be saved first." (interactive) (byte-code "  !!" [nil buffer-file-name rcs-diff-file message "No file associated with the current buffer."] 5)) (defun rcs-revert-file (fn) "\ Unlock and revert FILE to its last RCS'd version. Handy when you locked a file that you later decided not to change. If the file was in a buffer, reload the buffer with the reverted version; otherwise, the file is not loaded." (interactive "fFile to revert: ") (byte-code "ň ! ! !? P!M \" !! ! !\" !& &I !!*" [inbuf fn buf rcs-temp-buffer rcs-shell-path nil rcs-exec-path get-file-buffer get-buffer-create has-rcs-file-p message "No RCS file exists for " "Reverting RCS file %s..." call-process "-c" concat "cd " expand-file-name file-name-directory "; rcs -u " file-name-nondirectory " ; rm -f " " ; " find-exec-command "co" " " buf-kill-and-reload "Done"] 28)) (defun rcs-revert-buffer nil "\ Unlock and revert the current buffer to its last RCS'd version. Does not save any changes." (interactive) (byte-code " ?! !" [nil buffer-file-name message "No file associated with the current buffer." not-modified rcs-revert-file] 6)) (defun rcs-show-log-file (fn) "\ Show the RCS log for FILE." (interactive "FFile to show log of: ") (byte-code "È!?P!^Q! q )\" !! \"!&& J !M !eb Y !!)" [fn buf rcs-shell-path nil rcs-exec-path rcs-use-other-win has-rcs-file-p message "No RCS file exists for " get-buffer-create "# rcs log : " " #" erase-buffer "Getting log for %s..." call-process "-c" concat "cd " expand-file-name file-name-directory "; " find-exec-command "rlog" " " file-name-nondirectory switch-to-buffer-other-window switch-to-buffer select-window previous-window "Done"] 22)) (defun rcs-show-log-buffer nil "\ Show the current buffer's RCS log." (interactive) (byte-code "  !!" [nil buffer-file-name rcs-show-log-file message "No file associated with the current buffer."] 5)) (defun rcs-refresh-buffer nil "\ Reload the current buffer." (interactive) (byte-code "  !!" [nil buffer-file-name buf-kill-and-reload message "No file associated with current buffer"] 5)) (defun rcs-try-file nil "\ Function to check out automatically a RCS file when a find-file fails. Checks out the file, but does not lock it. Put this on your find-file-not-found-hooks hook." (byte-code " !?6\" !! \"!&&!\")" [fn nil rcs-shell-path rcs-exec-path t buffer-file-name has-rcs-file-p message "Checking out %s..." call-process "-c" concat "cd " expand-file-name file-name-directory "; " find-exec-command "co" " " file-name-nondirectory "Checkout done" insert-file-contents] 20)) (defun rcs-match-lockers-forward (list-to-date) "\ Adjunct to rcs-list-of-lockers; recursively builds the list of lockers." (byte-code "d#? !b!!\" B!" [t list-to-date re-search-forward "[ ]*\\([^:;]*\\): [0-9]*\\.[0-9]*" match-end 0 rcs-match-lockers-forward buffer-substring match-beginning 1] 8)) (defun rcs-list-of-lockers (fn) "\ Returns a list (of strings) of the people who have FILE locked under RCS, or nil if there are no lockers or the file is not under RCS." (byte-code "!? b ! q ) !! \"!&& qebd#?F`!b ` `\"))!))" [fn nil buf rcs-temp-buffer rcs-shell-path rcs-exec-path t beg has-rcs-file-p get-buffer-create erase-buffer call-process "-c" concat "cd " expand-file-name file-name-directory "; " find-exec-command "rlog" " -h " file-name-nondirectory re-search-forward "^locks:[ ]*" match-end 0 forward-line end-of-buffer delete-region rcs-match-lockers-forward] 20)) (defun rcs-file-is-locked-by-you-p (fn) "\ Returns T if FILE is locked by you under RCS, and NIL otherwise." (byte-code " ! ƍ*" [lockers-list fn your-name rcs-list-of-lockers user-login-name match-found (byte-code "@ \"\"AÇ" [lockers-list your-name t nil equal throw match-found] 5)] 4)) (defun rcs-hack-modeline nil "\ Modify the current modeline to tell whether the file is under RCS, and who the lockers are. Can be called interactively if you really want to." (interactive) (byte-code "Ĉ !=! lj! ?, \"< ! QC\"*" [buffer-file-name global-mode-string locker-list l-string nil has-rcs-file-p make-local-variable ("") rcs-list-of-lockers append (" [unlocked]") list-to-string " [locked by " "]"] 10)) (if rcs-executable-path (setq rcs-exec-path (cons rcs-executable-path exec-path)) (setq rcs-exec-path exec-path)) (if (not rcs-shell-path) (setq rcs-shell-path shell-file-name)) (run-hooks (quote rcs-hook))