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

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

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

revision 1.32 by spiegel, Fri Jan 11 21:09:39 2002 UTC revision 1.33 by spiegel, Thu Feb 21 20:16:47 2002 UTC
# Line 83  of a repository; then VC only stays loca Line 83  of a repository; then VC only stays loca
83    :version "21.1"    :version "21.1"
84    :group 'vc)    :group 'vc)
85    
86    (defcustom vc-cvs-sticky-date-format-string "%c"
87      "*Format string for mode-line display of sticky date.
88    Format is according to `format-time-string'.  Only used if
89    `vc-cvs-sticky-tag-display' is t."
90      :type '(string)
91      :version "21.3"
92      :group 'vc)
93    
94    (defcustom vc-cvs-sticky-tag-display t
95      "*Specify the mode-line display of sticky tags.
96    Value t means default display, nil means no display at all.  If the
97    value is a function or macro, it is called with the sticky tag and
98    its' type as parameters, in that order.  TYPE can have three different
99    values: `symbolic-name' (TAG is a string), `revision-number' (TAG is a
100    string) and `date' (TAG is a date as returned by `encode-time').  The
101    return value of the function or macro will be displayed as a string.
102    
103    Here's an example that will display the formatted date for sticky
104    dates and the word \"Sticky\" for sticky tag names and revisions.
105    
106      (lambda (tag type)
107        (cond ((eq type 'date) (format-time-string
108                                  vc-cvs-sticky-date-format-string tag))
109              ((eq type 'revision-number) \"Sticky\")
110              ((eq type 'symbolic-name) \"Sticky\")))
111    
112    Here's an example that will abbreviate to the first character only,
113    any text before the first occurence of `-' for sticky symbolic tags.
114    If the sticky tag is a revision number, the word \"Sticky\" is
115    displayed.  Date and time is displayed for sticky dates.
116    
117       (lambda (tag type)
118         (cond ((eq type 'date) (format-time-string \"%Y%m%d %H:%M\" tag))
119               ((eq type 'revision-number) \"Sticky\")
120               ((eq type 'symbolic-name)
121                (condition-case nil
122                    (progn
123                      (string-match \"\\\\([^-]*\\\\)\\\\(.*\\\\)\" tag)
124                      (concat (substring (match-string 1 tag) 0 1) \":\"
125                              (substring (match-string 2 tag) 1 nil)))
126                  (error tag)))))       ; Fall-back to given tag name.
127    
128    See also variable `vc-cvs-sticky-date-format-string'."
129      :type '(choice boolean function)
130      :version "21.3"
131      :group 'vc)
132    
133  ;;;  ;;;
134  ;;; Internal variables  ;;; Internal variables
# Line 187  of a repository; then VC only stays loca Line 233  of a repository; then VC only stays loca
233    
234  (defun vc-cvs-mode-line-string (file)  (defun vc-cvs-mode-line-string (file)
235    "Return string for placement into the modeline for FILE.    "Return string for placement into the modeline for FILE.
236  Compared to the default implementation, this function handles the  Compared to the default implementation, this function does two things:
237  special case of a CVS file that is added but not yet committed."  Handle the special case of a CVS file that is added but not yet
238    (let ((state   (vc-state file))  committed and support display of sticky tags."
239          (rev     (vc-workfile-version file)))    (let* ((state   (vc-state file))
240             (rev     (vc-workfile-version file))
241             (sticky-tag (vc-file-getprop file 'vc-cvs-sticky-tag))
242             (sticky-tag-printable (and sticky-tag
243                                        (not (string= sticky-tag ""))
244                                        (concat "[" sticky-tag "]"))))
245      (cond ((string= rev "0")      (cond ((string= rev "0")
246             ;; A file that is added but not yet committed.             ;; A file that is added but not yet committed.
247             "CVS @@")             "CVS @@")
248            ((or (eq state 'up-to-date)            ((or (eq state 'up-to-date)
249                 (eq state 'needs-patch))                 (eq state 'needs-patch))
250             (concat "CVS-" rev))             (concat "CVS-" rev sticky-tag-printable))
251            ((stringp state)            ((stringp state)
252             (concat "CVS:" state ":" rev))             (concat "CVS:" state ":" rev sticky-tag-printable))
253            (t            (t
254             ;; Not just for the 'edited state, but also a fallback             ;; Not just for the 'edited state, but also a fallback
255             ;; for all other states.  Think about different symbols             ;; for all other states.  Think about different symbols
256             ;; for 'needs-patch and 'needs-merge.             ;; for 'needs-patch and 'needs-merge.
257             (concat "CVS:" rev)))))             (concat "CVS:" rev sticky-tag-printable)))))
258    
259  (defun vc-cvs-dired-state-info (file)  (defun vc-cvs-dired-state-info (file)
260    "CVS-specific version of `vc-dired-state-info'."    "CVS-specific version of `vc-dired-state-info'."
# Line 260  This is only possible if CVS is responsi Line 311  This is only possible if CVS is responsi
311                        (list vc-checkin-switches)                        (list vc-checkin-switches)
312                      vc-checkin-switches))                      vc-checkin-switches))
313          status)          status)
314      ;; explicit check-in to the trunk requires a double check-in (first      (if (not rev)
315      ;; unexplicit) (CVS-1.3)          (setq status (apply 'vc-do-command nil 1 "cvs" file
316      (if (and rev (vc-trunk-p rev))                              "ci" (if rev (concat "-r" rev))
317          (apply 'vc-do-command nil 1 "cvs" file                              (concat "-m" comment)
318                 "ci" "-m" "intermediate"                              switches))
319                 switches))        (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
320      (setq status (apply 'vc-do-command nil 1 "cvs" file            (error "%s is not a valid symbolic tag name")
321                          "ci" (if rev (concat "-r" rev))          ;; If the input revison is a valid symbolic tag name, we create it
322                          (concat "-m" comment)          ;; as a branch, commit and switch to it.      
323                          switches))          (apply 'vc-do-command nil 0 "cvs" file "tag" "-b" (list rev))
324            (apply 'vc-do-command nil 0 "cvs" file "update" "-r" (list rev))
325            (setq status (apply 'vc-do-command nil 1 "cvs" file
326                                "ci"
327                                (concat "-m" comment)
328                                switches))
329            (vc-file-setprop file 'vc-cvs-sticky-tag rev)))
330      (set-buffer "*vc*")      (set-buffer "*vc*")
331      (goto-char (point-min))      (goto-char (point-min))
332      (when (not (zerop status))      (when (not (zerop status))
# Line 294  This is only possible if CVS is responsi Line 351  This is only possible if CVS is responsi
351      ;; tell it from the permissions of the file (see      ;; tell it from the permissions of the file (see
352      ;; vc-cvs-checkout-model).      ;; vc-cvs-checkout-model).
353      (vc-file-setprop file 'vc-checkout-model nil)      (vc-file-setprop file 'vc-checkout-model nil)
354      ;; if this was an explicit check-in, remove the sticky tag  
355      (if rev (vc-do-command nil 0 "cvs" file "update" "-A"))))      ;; if this was an explicit check-in (does not include creation of
356        ;; a branch), remove the sticky tag.
357        (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev)))
358            (vc-do-command nil 0 "cvs" file "update" "-A"))))
359    
360  (defun vc-cvs-checkout (file &optional editable rev workfile)  (defun vc-cvs-checkout (file &optional editable rev workfile)
361    "Retrieve a revision of FILE into a WORKFILE.    "Retrieve a revision of FILE into a WORKFILE.
# Line 602  workspace is immediately moved to that n Line 662  workspace is immediately moved to that n
662  NAME is the name of the snapshot; if it is empty, do a `cvs update'.  NAME is the name of the snapshot; if it is empty, do a `cvs update'.
663  If UPDATE is non-nil, then update (resynch) any affected buffers."  If UPDATE is non-nil, then update (resynch) any affected buffers."
664    (with-current-buffer (get-buffer-create "*vc*")    (with-current-buffer (get-buffer-create "*vc*")
665      (let ((default-directory dir))      (let ((default-directory dir)
666              (sticky-tag))
667        (erase-buffer)        (erase-buffer)
668        (if (or (not name) (string= name ""))        (if (or (not name) (string= name ""))
669            (vc-do-command t 0 "cvs" nil "update")            (vc-do-command t 0 "cvs" nil "update")
670          (vc-do-command t 0 "cvs" nil "update" "-r" name))          (vc-do-command t 0 "cvs" nil "update" "-r" name)
671            (setq sticky-tag name))
672        (when update        (when update
673          (goto-char (point-min))          (goto-char (point-min))
674          (while (not (eobp))          (while (not (eobp))
# Line 627  If UPDATE is non-nil, then update (resyn Line 689  If UPDATE is non-nil, then update (resyn
689                      (vc-file-setprop file 'vc-state 'edited)                      (vc-file-setprop file 'vc-state 'edited)
690                      (vc-file-setprop file 'vc-workfile-version nil)                      (vc-file-setprop file 'vc-workfile-version nil)
691                      (vc-file-setprop file 'vc-checkout-time 0)))                      (vc-file-setprop file 'vc-checkout-time 0)))
692                      (vc-file-setprop file 'vc-cvs-sticky-tag sticky-tag)
693                    (vc-resynch-buffer file t t))))                    (vc-resynch-buffer file t t))))
694            (forward-line 1))))))            (forward-line 1))))))
695    
# Line 721  essential information." Line 784  essential information."
784              (vc-cvs-parse-entry file t))))              (vc-cvs-parse-entry file t))))
785        (forward-line 1))))        (forward-line 1))))
786    
787    
788    (defun vc-cvs-valid-symbolic-tag-name-p (tag)
789      "Return non-nil if TAG is a valid symbolic tag name."
790      ;; According to the CVS manual, a valid symbolic tag must start with
791      ;; an uppercase or lowercase letter and can contain uppercase and
792      ;; lowercase letters, digits, `-', and `_'.
793      (and (string-match "^[a-zA-Z]" tag)
794           (not (string-match "[^a-z0-9A-Z-_]" tag))))
795          
796    
797    (defun vc-cvs-parse-sticky-tag (match-type match-tag)
798      "Parse and return the sticky tag as a string.  
799    `match-data' is protected."
800      (let ((data (match-data))
801            (tag)
802            (type (cond ((string= match-type "D") 'date)
803                        ((string= match-type "T")
804                         (if (vc-cvs-valid-symbolic-tag-name-p match-tag)
805                             'symbolic-name
806                           'revision-number))
807                        (t nil))))
808        (unwind-protect
809            (progn
810              (cond
811               ;; Sticky Date tag.  Convert to to a proper date value (`encode-time')
812               ((eq type 'date)
813                (string-match
814                 "\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)"
815                 match-tag)
816                (let* ((year-tmp (string-to-number (match-string 1 match-tag)))
817                       (month    (string-to-number (match-string 2 match-tag)))
818                       (day      (string-to-number (match-string 3 match-tag)))
819                       (hour     (string-to-number (match-string 4 match-tag)))
820                       (min      (string-to-number (match-string 5 match-tag)))
821                       (sec      (string-to-number (match-string 6 match-tag)))
822                       ;; Years 0..68 are 2000..2068.
823                       ;; Years 69..99 are 1969..1999.
824                       (year (+ (cond ((> 69 year-tmp) 2000)
825                                      ((> 100 year-tmp) 1900)
826                                      (t 0))
827                                year-tmp)))
828                  (setq tag (encode-time sec min hour day month year))))
829               ;; Sticky Tag name or revision number
830               ((eq type 'symbolic-name) (setq tag match-tag))
831               ((eq type 'revision-number) (setq tag match-tag))
832               ;; Default is no sticky tag at all
833               (t nil))
834              (cond ((eq vc-cvs-sticky-tag-display nil) nil)
835                    ((eq vc-cvs-sticky-tag-display t)
836                     (cond ((eq type 'date) (format-time-string
837                                             vc-cvs-sticky-date-format-string
838                                             tag))
839                           ((eq type 'symbolic-name) tag)
840                           ((eq type 'revision-number) tag)
841                           (t nil)))
842                    ((functionp vc-cvs-sticky-tag-display)
843                     (funcall vc-cvs-sticky-tag-display tag type))
844                    (t nil)))
845    
846          (set-match-data data))))
847    
848  (defun vc-cvs-parse-entry (file &optional set-state)  (defun vc-cvs-parse-entry (file &optional set-state)
849    "Parse a line from CVS/Entries.    "Parse a line from CVS/Entries.
850  Compare modification time to that of the FILE, set file properties  Compare modification time to that of the FILE, set file properties
# Line 738  is non-nil." Line 862  is non-nil."
862               ;; revision               ;; revision
863               "/\\([^/]*\\)"               "/\\([^/]*\\)"
864               ;; timestamp               ;; timestamp
865               "/\\([^/]*\\)"))               "/\\([^/]*\\)"
866                 ;; optional conflict field
867                 "\\(+[^/]*\\)?/"
868                 ;; options
869                 "\\([^/]*\\)/"
870                 ;; sticky tag
871                 "\\(.\\|\\)" ;Sticky tag type (date or tag name, could be empty)
872                 "\\(.*\\)"))               ;Sticky tag
873      (vc-file-setprop file 'vc-workfile-version (match-string 1))      (vc-file-setprop file 'vc-workfile-version (match-string 1))
874        (vc-file-setprop file 'vc-cvs-sticky-tag
875                         (vc-cvs-parse-sticky-tag (match-string 5) (match-string 6)))
876      ;; compare checkout time and modification time      ;; compare checkout time and modification time
877      (let ((mtime (nth 5 (file-attributes file)))      (let ((mtime (nth 5 (file-attributes file)))
878            (system-time-locale "C"))            (system-time-locale "C"))

Legend:
Removed from v.1.32  
changed lines
  Added in v.1.33

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