]> code.delx.au - gnu-emacs/blobdiff - lisp/pcvs-info.el
New directory
[gnu-emacs] / lisp / pcvs-info.el
index ba172471930a2620306b4ef236bbb85c2d25fafa..79cee63303a58ec561d068082cee28c635ba1462 100644 (file)
@@ -4,7 +4,6 @@
 
 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
 ;; Keywords: pcl-cvs
-;; Revision: $Id: pcvs-info.el,v 1.6 2000/12/18 03:17:31 monnier Exp $
 
 ;; This file is part of GNU Emacs.
 
@@ -47,15 +46,6 @@ If t, their full path name will be displayed, else only the filename."
   :group 'pcl-cvs
   :type '(boolean))
 
-(defvar global-font-lock-mode)
-(defvar font-lock-auto-fontify)
-(defcustom cvs-highlight
-  (or (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify)
-      (and (boundp 'global-font-lock-mode) global-font-lock-mode))
-  "*Whether to use text highlighting (à la font-lock) or not."
-  :group 'pcl-cvs
-  :type '(boolean))
-
 (defcustom cvs-allow-dir-commit nil
   "*Allow `cvs-mode-commit' on directories.
 If you commit without any marked file and with the cursor positioned
@@ -70,10 +60,10 @@ to confuse some users sometimes."
 
 (defface cvs-header-face
   '((((class color) (background dark))
-     (:foreground "lightyellow" :bold t))
+     (:foreground "lightyellow" :weight bold))
     (((class color) (background light))
-     (:foreground "blue4" :bold t))
-    (t (:bold t)))
+     (:foreground "blue4" :weight bold))
+    (t (:weight bold)))
   "PCL-CVS face used to highlight directory changes."
   :group 'pcl-cvs)
 
@@ -91,7 +81,7 @@ to confuse some users sometimes."
      (:foreground "red"))
     (((class color) (background light))
      (:foreground "red"))
-    (t (:italic t)))
+    (t (:slant italic)))
   "PCL-CVS face used to highlight unknown file status."
   :group 'pcl-cvs)
 
@@ -109,21 +99,21 @@ to confuse some users sometimes."
      (:foreground "orange"))
     (((class color) (background light))
      (:foreground "orange"))
-    (t (:italic t)))
+    (t (:slant italic)))
   "PCL-CVS face used to highlight status of files needing action."
   :group 'pcl-cvs)
 
 (defface cvs-marked-face
   '((((class color) (background dark))
-     (:foreground "green" :bold t))
+     (:foreground "green" :weight bold))
     (((class color) (background light))
-     (:foreground "green3" :bold t))
-    (t (:bold t)))
+     (:foreground "green3" :weight bold))
+    (t (:weight bold)))
   "PCL-CVS face used to highlight marked file indicator."
   :group 'pcl-cvs)
 
 (defface cvs-msg-face
-  '((t (:italic t)))
+  '((t (:slant italic)))
   "PCL-CVS face used to highlight CVS messages."
   :group 'pcl-cvs)
 
@@ -179,7 +169,7 @@ to confuse some users sometimes."
                 ;; untouched version resides.
 
   ;; The meaning of the type field:
-  
+
   ;; Value           ---Used by---     Explanation
   ;;                 update status
   ;; NEED-UPDATE               x       file needs update
@@ -244,7 +234,6 @@ to confuse some users sometimes."
 \f
 ;; Predicate:
 
-(defun boolp (x) (or (eq t x) (null x)))
 (defun cvs-check-fileinfo (fi)
   "Check FI's conformance to some conventions."
   (let ((check 'none)
@@ -256,7 +245,7 @@ to confuse some users sometimes."
        (base-rev (cvs-fileinfo->base-rev fi))
        (head-rev (cvs-fileinfo->head-rev fi))
        (full-log (cvs-fileinfo->full-log fi)))
-    (if (and (setq check 'marked)      (boolp marked)
+    (if (and (setq check 'marked)      (memq marked '(t nil))
             (setq check 'base-rev)     (or (null base-rev) (stringp base-rev))
             (setq check 'head-rev)     (or (null head-rev) (stringp head-rev))
             (setq check 'full-log)     (stringp full-log)
@@ -279,9 +268,9 @@ to confuse some users sometimes."
       (error "Invalid :%s in cvs-fileinfo %s" check fi))))
 
 \f
-;;;; 
+;;;;
 ;;;; State table to indicate what you can do when.
-;;;; 
+;;;;
 
 (defconst cvs-states
   `((NEED-UPDATE       update diff)
@@ -318,15 +307,12 @@ FI-OR-TYPE can either be a symbol (a fileinfo-type) or a fileinfo."
     (and (not (eq type 'MESSAGE))
         (eq (car (memq func (cdr (assq type cvs-states)))) func))))
 
-(defun cvs-add-face (str face &optional keymap)
-  (when cvs-highlight
-    (add-text-properties 0 (length str)
-                        (list* 'face face
-                               (when keymap
-                                 (list* 'mouse-face 'highlight
-                                        (when (keymapp keymap)
-                                          (list 'keymap keymap)))))
-                        str))
+(defun cvs-add-face (str face &optional keymap &rest props)
+  (when keymap
+    (when (keymapp keymap)
+      (setq props (list* 'keymap keymap props)))
+    (setq props (list* 'mouse-face 'highlight props)))
+  (add-text-properties 0 (length str) (list* 'font-lock-face face props) str)
   str)
 
 (defun cvs-fileinfo-pp (fileinfo)
@@ -339,7 +325,8 @@ For use by the cookie package."
      (case type
        (DIRCHANGE (concat "In directory "
                          (cvs-add-face (cvs-fileinfo->full-path fileinfo)
-                                       'cvs-header-face t)
+                                       'cvs-header-face t
+                                       'cvs-goal-column t)
                          ":"))
        (MESSAGE
        (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo))
@@ -349,7 +336,8 @@ For use by the cookie package."
                           (cvs-add-face "*" 'cvs-marked-face)
                         " "))
               (file (cvs-add-face (cvs-fileinfo->pp-name fileinfo)
-                                  'cvs-filename-face t))
+                                  'cvs-filename-face t
+                                  'cvs-goal-column t))
               (base (or (cvs-fileinfo->base-rev fileinfo) ""))
               (head (cvs-fileinfo->head-rev fileinfo))
               (type
@@ -371,8 +359,8 @@ For use by the cookie package."
                      (when (and head (not (string= head base))) head)
                      ;; or nothing
                      "")))
-         (format "%-11s %s %-11s %-11s %s"
-                 side status type base file)))))))
+          (format "%-11s %s %-11s %-11s %s"
+                  side status type base file)))))))
 
 
 (defun cvs-fileinfo-update (fi fi-new)
@@ -463,8 +451,13 @@ DIR can also be a file."
               ((equal date "Result of merge") (setq subtype 'MERGED))
               ((let ((mtime (nth 5 (file-attributes (concat dir f))))
                      (system-time-locale "C"))
-                 (equal (setq timestamp (format-time-string "%c" mtime 'utc))
-                        date))
+                 (setq timestamp (format-time-string "%c" mtime 'utc))
+                 ;; Solaris sometimes uses "Wed Sep 05", not "Wed Sep  5".
+                 ;; See "grep '[^a-z_]ctime' cvs/src/*.c" for reference.
+                 (if (= (aref timestamp 8) ?0)
+                     (setq timestamp (concat (substring timestamp 0 8)
+                                             " " (substring timestamp 9))))
+                 (equal timestamp date))
                (setq type (if all 'UP-TO-DATE)))
               ((equal date (concat "Result of merge+" timestamp))
                (setq type 'CONFLICT)))