/[emacs]/emacs/lisp/vc-rcs.el
ViewVC logotype

Diff of /emacs/lisp/vc-rcs.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.24 by spiegel, Mon Mar 18 17:17:38 2002 UTC revision 1.24.2.1 by miles, Fri Apr 4 06:20:11 2003 UTC
# Line 99  For a description of possible values, se Line 99  For a description of possible values, se
99  ;;; State-querying functions  ;;; State-querying functions
100  ;;;  ;;;
101    
102  ;;;###autoload  ;;; The autoload cookie below places vc-rcs-registered directly into
103  (progn (defun vc-rcs-registered (f) (vc-default-registered 'RCS f)))  ;;; loaddefs.el, so that vc-rcs.el does not need to be loaded for
104    ;;; every file that is visited.  The definition is repeated below
105    ;;; so that Help and etags can find it.
106    
107    ;;;###autoload (defun vc-rcs-registered (f) (vc-default-registered 'RCS f))
108    (defun vc-rcs-registered (f) (vc-default-registered 'RCS f))
109    
110  (defun vc-rcs-state (file)  (defun vc-rcs-state (file)
111    "Implementation of `vc-state' for RCS."    "Implementation of `vc-state' for RCS."
# Line 116  For a description of possible values, se Line 121  For a description of possible values, se
121                                                       'vc-workfile-version))))                                                       'vc-workfile-version))))
122      (if (not (eq state 'up-to-date))      (if (not (eq state 'up-to-date))
123          state          state
       (require 'vc)  
124        (if (vc-workfile-unchanged-p file)        (if (vc-workfile-unchanged-p file)
125            'up-to-date            'up-to-date
126          (if (eq (vc-checkout-model file) 'locking)          (if (eq (vc-checkout-model file) 'locking)
# Line 139  For a description of possible values, se Line 143  For a description of possible values, se
143                (cond                (cond
144                 ((string-match ".rw..-..-." (nth 8 (file-attributes file)))                 ((string-match ".rw..-..-." (nth 8 (file-attributes file)))
145                  (vc-file-setprop file 'vc-checkout-model 'implicit)                  (vc-file-setprop file 'vc-checkout-model 'implicit)
146                  (setq state                  (setq state
147                        (if (vc-rcs-workfile-is-newer file)                        (if (vc-rcs-workfile-is-newer file)
148                            'edited                            'edited
149                          'up-to-date)))                          'up-to-date)))
150                 ((string-match ".r-..-..-." (nth 8 (file-attributes file)))                 ((string-match ".r-..-..-." (nth 8 (file-attributes file)))
151                  (vc-file-setprop file 'vc-checkout-model 'locking))))                  (vc-file-setprop file 'vc-checkout-model 'locking))))
# Line 158  For a description of possible values, se Line 162  For a description of possible values, se
162                         (if (file-ownership-preserved-p file)                         (if (file-ownership-preserved-p file)
163                             'edited                             'edited
164                           (vc-user-login-name owner-uid))                           (vc-user-login-name owner-uid))
165                       (if (vc-rcs-workfile-is-newer file)                       (if (vc-rcs-workfile-is-newer file)
166                           'edited                           'edited
167                         'up-to-date)))                         'up-to-date)))
168                    (t                    (t
# Line 239  expanded if `vc-keep-workfiles' is non-n Line 243  expanded if `vc-keep-workfiles' is non-n
243                       (if (stringp vc-rcs-register-switches)                       (if (stringp vc-rcs-register-switches)
244                       (list vc-rcs-register-switches)                       (list vc-rcs-register-switches)
245                       vc-rcs-register-switches))))                       vc-rcs-register-switches))))
246          
247        (and (not (file-exists-p subdir))        (and (not (file-exists-p subdir))
248             (not (directory-files (file-name-directory file)             (not (directory-files (file-name-directory file)
249                                   nil ".*,v$" t))                                   nil ".*,v$" t))
# Line 301  whether to remove it." Line 305  whether to remove it."
305      (and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")      (and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")
306           ;; check whether RCS dir is empty, i.e. it does not           ;; check whether RCS dir is empty, i.e. it does not
307           ;; contain any files except "." and ".."           ;; contain any files except "." and ".."
308           (not (directory-files dir nil           (not (directory-files dir nil
309                                 "^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*"))                                 "^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*"))
310           (yes-or-no-p (format "Directory %s is empty; remove it? " dir))           (yes-or-no-p (format "Directory %s is empty; remove it? " dir))
311           (delete-directory dir))))           (delete-directory dir))))
# Line 313  whether to remove it." Line 317  whether to remove it."
317                      vc-checkin-switches)))                      vc-checkin-switches)))
318      (let ((old-version (vc-workfile-version file)) new-version      (let ((old-version (vc-workfile-version file)) new-version
319            (default-branch (vc-file-getprop file 'vc-rcs-default-branch)))            (default-branch (vc-file-getprop file 'vc-rcs-default-branch)))
320        ;; Force branch creation if an appropriate        ;; Force branch creation if an appropriate
321        ;; default branch has been set.        ;; default branch has been set.
322        (and (not rev)        (and (not rev)
323             default-branch             default-branch
# Line 321  whether to remove it." Line 325  whether to remove it."
325                           default-branch)                           default-branch)
326             (setq rev default-branch)             (setq rev default-branch)
327             (setq switches (cons "-f" switches)))             (setq switches (cons "-f" switches)))
328          (if (and (not rev) old-version)
329              (setq rev (vc-branch-part old-version)))
330        (apply 'vc-do-command nil 0 "ci" (vc-name file)        (apply 'vc-do-command nil 0 "ci" (vc-name file)
331               ;; if available, use the secure check-in option               ;; if available, use the secure check-in option
332               (and (vc-rcs-release-p "5.6.4") "-j")               (and (vc-rcs-release-p "5.6.4") "-j")
# Line 345  whether to remove it." Line 351  whether to remove it."
351         ((and old-version new-version         ((and old-version new-version
352               (not (string= (vc-branch-part old-version)               (not (string= (vc-branch-part old-version)
353                             (vc-branch-part new-version))))                             (vc-branch-part new-version))))
354          (vc-rcs-set-default-branch file          (vc-rcs-set-default-branch file
355                                     (if (vc-trunk-p new-version) nil                                     (if (vc-trunk-p new-version) nil
356                                       (vc-branch-part new-version)))                                       (vc-branch-part new-version)))
357          ;; If this is an old RCS release, we might have          ;; If this is an old RCS release, we might have
# Line 356  whether to remove it." Line 362  whether to remove it."
362              (vc-do-command nil 1 "rcs" (vc-name file)              (vc-do-command nil 1 "rcs" (vc-name file)
363                             (concat "-u" old-version))))))))                             (concat "-u" old-version))))))))
364    
365  (defun vc-rcs-checkout (file &optional editable rev workfile)  (defun vc-rcs-find-version (file rev buffer)
366    "Retrieve a copy of a saved version of FILE into a workfile."    (apply 'vc-do-command
367    (let ((filename (or workfile file))           buffer 0 "co" (vc-name file)
368          (file-buffer (get-file-buffer file))           "-q" ;; suppress diagnostic output
369             (concat "-p" rev)
370             (if (stringp vc-checkout-switches)
371                 (list vc-checkout-switches)
372               vc-checkout-switches)))
373    
374    (defun vc-rcs-checkout (file &optional editable rev)
375      "Retrieve a copy of a saved version of FILE."
376      (let ((file-buffer (get-file-buffer file))
377          switches)          switches)
378      (message "Checking out %s..." filename)      (message "Checking out %s..." file)
379      (save-excursion      (save-excursion
380        ;; Change buffers to get local value of vc-checkout-switches.        ;; Change buffers to get local value of vc-checkout-switches.
381        (if file-buffer (set-buffer file-buffer))        (if file-buffer (set-buffer file-buffer))
# Line 375  whether to remove it." Line 389  whether to remove it."
389          (save-excursion          (save-excursion
390            ;; Adjust the default-directory so that the check-out creates            ;; Adjust the default-directory so that the check-out creates
391            ;; the file in the right place.            ;; the file in the right place.
392            (setq default-directory (file-name-directory filename))            (setq default-directory (file-name-directory file))
393            (if workfile  ;; RCS            (let (new-version)
394                ;; RCS can't check out into arbitrary file names directly.              ;; if we should go to the head of the trunk,
395                ;; Use `co -p' and make stdout point to the correct file.              ;; clear the default branch first
396                (let ((vc-modes (logior (file-modes (vc-name file))              (and rev (string= rev "")
397                                        (if editable 128 0)))                   (vc-rcs-set-default-branch file nil))
398                      (failed t))              ;; now do the checkout
399                  (unwind-protect              (apply 'vc-do-command
400                      (progn                     nil 0 "co" (vc-name file)
401                        (let ((coding-system-for-read 'no-conversion)                     ;; If locking is not strict, force to overwrite
402                              (coding-system-for-write 'no-conversion))                     ;; the writable workfile.
403                          (with-temp-file filename                     (if (eq (vc-checkout-model file) 'implicit) "-f")
404                            (apply 'vc-do-command                     (if editable "-l")
405                                   (current-buffer) 0 "co" (vc-name file)                     (if (stringp rev)
406                                   "-q" ;; suppress diagnostic output                         ;; a literal revision was specified
407                                   (if editable "-l")                         (concat "-r" rev)
408                                   (concat "-p" rev)                       (let ((workrev (vc-workfile-version file)))
409                                   switches)))                         (if workrev
410                        (set-file-modes filename                             (concat "-r"
411                                        (logior (file-modes (vc-name file))                                     (if (not rev)
412                                                (if editable 128 0)))                                         ;; no revision specified:
413                        (setq failed nil))                                         ;; use current workfile version
414                    (and failed (file-exists-p filename)                                         workrev
415                         (delete-file filename))))                                       ;; REV is t ...
416              (let (new-version)                                       (if (not (vc-trunk-p workrev))
417                ;; if we should go to the head of the trunk,                                           ;; ... go to head of current branch
418                ;; clear the default branch first                                           (vc-branch-part workrev)
419                (and rev (string= rev "")                                         ;; ... go to head of trunk
420                     (vc-rcs-set-default-branch file nil))                                         (vc-rcs-set-default-branch file
421                ;; now do the checkout                                                                    nil)
422                (apply 'vc-do-command                                         ""))))))
423                       nil 0 "co" (vc-name file)                     switches)
424                       ;; If locking is not strict, force to overwrite              ;; determine the new workfile version
425                       ;; the writable workfile.              (with-current-buffer "*vc*"
426                       (if (eq (vc-checkout-model file) 'implicit) "-f")                (setq new-version
427                       (if editable "-l")                      (vc-parse-buffer "^revision \\([0-9.]+\\).*\n" 1)))
428                       (if rev (concat "-r" rev)              (vc-file-setprop file 'vc-workfile-version new-version)
429                         ;; if no explicit revision was specified,              ;; if necessary, adjust the default branch
430                         ;; check out that of the working file              (and rev (not (string= rev ""))
431                         (let ((workrev (vc-workfile-version file)))                   (vc-rcs-set-default-branch
432                           (if workrev (concat "-r" workrev)                    file
433                             nil)))                    (if (vc-rcs-latest-on-branch-p file new-version)
434                       switches)                        (if (vc-trunk-p new-version) nil
435                ;; determine the new workfile version                          (vc-branch-part new-version))
436                (with-current-buffer "*vc*"                      new-version)))))
437                  (setq new-version          (message "Checking out %s...done" file)))))
                       (vc-parse-buffer "^revision \\([0-9.]+\\).*\n" 1)))  
               (vc-file-setprop file 'vc-workfile-version new-version)  
               ;; if necessary, adjust the default branch  
               (and rev (not (string= rev ""))  
                    (vc-rcs-set-default-branch  
                     file  
                     (if (vc-rcs-latest-on-branch-p file new-version)  
                         (if (vc-trunk-p new-version) nil  
                           (vc-branch-part new-version))  
                       new-version))))))  
         (message "Checking out %s...done" filename)))))  
438    
439  (defun vc-rcs-revert (file &optional contents-done)  (defun vc-rcs-revert (file &optional contents-done)
440    "Revert FILE to the version it was based on."    "Revert FILE to the version it was based on."
441    (vc-do-command nil 0 "co" (vc-name file) "-f"    (vc-do-command nil 0 "co" (vc-name file) "-f"
442                   (concat "-u" (vc-workfile-version file))))                   (concat (if (eq (vc-state file) 'edited) "-u" "-r")
443                             (vc-workfile-version file))))
444    
445  (defun vc-rcs-cancel-version (file editable)  (defun vc-rcs-cancel-version (file editable)
446    "Undo the most recent checkin of FILE.    "Undo the most recent checkin of FILE.
# Line 479  The changes are between FIRST-VERSION an Line 483  The changes are between FIRST-VERSION an
483    "Steal the lock on the current workfile for FILE and revision REV.    "Steal the lock on the current workfile for FILE and revision REV.
484  Needs RCS 5.6.2 or later for -M."  Needs RCS 5.6.2 or later for -M."
485    (vc-do-command nil 0 "rcs" (vc-name file) "-M" (concat "-u" rev))    (vc-do-command nil 0 "rcs" (vc-name file) "-M" (concat "-u" rev))
486    ;; Do a real checkout after stealing the lock, so that we see    ;; Do a real checkout after stealing the lock, so that we see
487    ;; expanded headers.    ;; expanded headers.
488    (vc-do-command nil 0 "co" (vc-name file) "-f" (concat "-l" rev)))    (vc-do-command nil 0 "co" (vc-name file) "-f" (concat "-l" rev)))
489    
# Line 493  Needs RCS 5.6.2 or later for -M." Line 497  Needs RCS 5.6.2 or later for -M."
497    "Get change log associated with FILE."    "Get change log associated with FILE."
498    (vc-do-command nil 0 "rlog" (vc-name file)))    (vc-do-command nil 0 "rlog" (vc-name file)))
499    
 (defun vc-rcs-show-log-entry (version)  
   (when (re-search-forward  
          ;; also match some context, for safety  
          (concat "----\nrevision " version  
                  "\\(\tlocked by:.*\n\\|\n\\)date: ") nil t)  
     ;; set the display window so that  
     ;; the whole log entry is displayed  
     (let (start end lines)  
       (beginning-of-line) (forward-line -1) (setq start (point))  
       (if (not (re-search-forward "^----*\nrevision" nil t))  
           (setq end (point-max))  
         (beginning-of-line) (forward-line -1) (setq end (point)))  
       (setq lines (count-lines start end))  
       (cond  
        ;; if the global information and this log entry fit  
        ;; into the window, display from the beginning  
        ((< (count-lines (point-min) end) (window-height))  
         (goto-char (point-min))  
         (recenter 0)  
         (goto-char start))  
        ;; if the whole entry fits into the window,  
        ;; display it centered  
        ((< (1+ lines) (window-height))  
         (goto-char start)  
         (recenter (1- (- (/ (window-height) 2) (/ lines 2)))))  
        ;; otherwise (the entry is too large for the window),  
        ;; display from the start  
        (t  
         (goto-char start)  
         (recenter 0))))))  
   
500  (defun vc-rcs-diff (file &optional oldvers newvers)  (defun vc-rcs-diff (file &optional oldvers newvers)
501    "Get a difference report using RCS between two versions of FILE."    "Get a difference report using RCS between two versions of FILE."
502    (if (not oldvers) (setq oldvers (vc-workfile-version file)))    (if (not oldvers) (setq oldvers (vc-workfile-version file)))
# Line 605  This function sets the properties `vc-wo Line 578  This function sets the properties `vc-wo
578  `vc-checkout-model' to their correct values, based on the master  `vc-checkout-model' to their correct values, based on the master
579  file."  file."
580    (with-temp-buffer    (with-temp-buffer
581      (vc-insert-file (vc-name file) "^[0-9]")      (if (or (not (vc-insert-file (vc-name file) "^[0-9]"))
582                (progn (goto-char (point-min))
583                       (not (looking-at "^head[ \t\n]+[^;]+;$"))))
584            (error "File %s is not an RCS master file" (vc-name file)))
585      (let ((workfile-is-latest nil)      (let ((workfile-is-latest nil)
586            (default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))            (default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))
587        (vc-file-setprop file 'vc-rcs-default-branch default-branch)        (vc-file-setprop file 'vc-rcs-default-branch default-branch)

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.24.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26