X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9d4b302723512d1a5cd079338057ae70eca3a46d..f720b30e1123ca3549436b0a5b8ea65b4473329b:/lisp/pcvs-info.el diff --git a/lisp/pcvs-info.el b/lisp/pcvs-info.el index 04368643e5..291e4ae85c 100644 --- a/lisp/pcvs-info.el +++ b/lisp/pcvs-info.el @@ -1,10 +1,10 @@ ;;; pcvs-info.el --- internal representation of a fileinfo entry -;; Copyright (C) 1991, 92, 93, 94, 95, 96, 97, 98, 99, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: pcl-cvs -;; Revision: $Id: pcvs-info.el,v 1.12 2002/06/18 23:03:55 monnier Exp $ ;; This file is part of GNU Emacs. @@ -20,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -41,11 +41,13 @@ ;;;; config variables ;;;; -(defcustom cvs-display-full-path t - "*Specifies how the filenames should look like in the listing. -If t, their full path name will be displayed, else only the filename." +(defcustom cvs-display-full-name t + "*Specifies how the filenames should be displayed in the listing. +If non-nil, their full filename name will be displayed, else only the +non-directory part." :group 'pcl-cvs :type '(boolean)) +(define-obsolete-variable-alias 'cvs-display-full-path 'cvs-display-full-name) (defcustom cvs-allow-dir-commit nil "*Allow `cvs-mode-commit' on directories. @@ -59,7 +61,7 @@ to confuse some users sometimes." ;;;; Faces for fontification ;;;; -(defface cvs-header-face +(defface cvs-header '((((class color) (background dark)) (:foreground "lightyellow" :weight bold)) (((class color) (background light)) @@ -67,8 +69,10 @@ to confuse some users sometimes." (t (:weight bold))) "PCL-CVS face used to highlight directory changes." :group 'pcl-cvs) +;; backward-compatibility alias +(put 'cvs-header-face 'face-alias 'cvs-header) -(defface cvs-filename-face +(defface cvs-filename '((((class color) (background dark)) (:foreground "lightblue")) (((class color) (background light)) @@ -76,8 +80,10 @@ to confuse some users sometimes." (t ())) "PCL-CVS face used to highlight file names." :group 'pcl-cvs) +;; backward-compatibility alias +(put 'cvs-filename-face 'face-alias 'cvs-filename) -(defface cvs-unknown-face +(defface cvs-unknown '((((class color) (background dark)) (:foreground "red")) (((class color) (background light)) @@ -85,8 +91,10 @@ to confuse some users sometimes." (t (:slant italic))) "PCL-CVS face used to highlight unknown file status." :group 'pcl-cvs) +;; backward-compatibility alias +(put 'cvs-unknown-face 'face-alias 'cvs-unknown) -(defface cvs-handled-face +(defface cvs-handled '((((class color) (background dark)) (:foreground "pink")) (((class color) (background light)) @@ -94,8 +102,10 @@ to confuse some users sometimes." (t ())) "PCL-CVS face used to highlight handled file status." :group 'pcl-cvs) +;; backward-compatibility alias +(put 'cvs-handled-face 'face-alias 'cvs-handled) -(defface cvs-need-action-face +(defface cvs-need-action '((((class color) (background dark)) (:foreground "orange")) (((class color) (background light)) @@ -103,23 +113,31 @@ to confuse some users sometimes." (t (:slant italic))) "PCL-CVS face used to highlight status of files needing action." :group 'pcl-cvs) +;; backward-compatibility alias +(put 'cvs-need-action-face 'face-alias 'cvs-need-action) -(defface cvs-marked-face - '((((class color) (background dark)) +(defface cvs-marked + '((((min-colors 88) (class color) (background dark)) + (:foreground "green1" :weight bold)) + (((class color) (background dark)) (:foreground "green" :weight bold)) (((class color) (background light)) (:foreground "green3" :weight bold)) (t (:weight bold))) "PCL-CVS face used to highlight marked file indicator." :group 'pcl-cvs) +;; backward-compatibility alias +(put 'cvs-marked-face 'face-alias 'cvs-marked) -(defface cvs-msg-face +(defface cvs-msg '((t (:slant italic))) "PCL-CVS face used to highlight CVS messages." :group 'pcl-cvs) +;; backward-compatibility alias +(put 'cvs-msg-face 'face-alias 'cvs-msg) -(defvar cvs-fi-up-to-date-face 'cvs-handled-face) -(defvar cvs-fi-unknown-face 'cvs-unknown-face) +(defvar cvs-fi-up-to-date-face 'cvs-handled) +(defvar cvs-fi-unknown-face 'cvs-unknown) (defvar cvs-fi-conflict-face 'font-lock-warning-face) ;; There is normally no need to alter the following variable, but if @@ -130,7 +148,7 @@ to confuse some users sometimes." "The prefix that CVS prepends to files when rcsmerge'ing.") (easy-mmode-defmap cvs-status-map - '(([(mouse-2)] . cvs-mouse-toggle-mark)) + '(([(mouse-2)] . cvs-mode-toggle-mark)) "Local keymap for text properties of status") ;; Constructor: @@ -163,14 +181,14 @@ to confuse some users sometimes." ;; In addition to the above, the following values can be extracted: ;; handled ;; t if this file doesn't require further action. - ;; full-path ;; The complete relative filename. + ;; full-name ;; The complete relative filename. ;; pp-name ;; The printed file name ;; backup-file;; For MERGED and CONFLICT files after a \"cvs update\", ;; this is a full path to the backup file where the ;; untouched version resides. ;; The meaning of the type field: - + ;; Value ---Used by--- Explanation ;; update status ;; NEED-UPDATE x file needs update @@ -199,7 +217,7 @@ to confuse some users sometimes." ;; Fake selectors: -(defun cvs-fileinfo->full-path (fileinfo) +(defun cvs-fileinfo->full-name (fileinfo) "Return the full path for the file that is described in FILEINFO." (let ((dir (cvs-fileinfo->dir fileinfo))) (if (eq (cvs-fileinfo->type fileinfo) 'DIRCHANGE) @@ -207,11 +225,12 @@ to confuse some users sometimes." ;; Here, I use `concat' rather than `expand-file-name' because I want ;; the resulting path to stay relative if `dir' is relative. (concat dir (cvs-fileinfo->file fileinfo))))) +(define-obsolete-function-alias 'cvs-fileinfo->full-path 'cvs-fileinfo->full-name) (defun cvs-fileinfo->pp-name (fi) "Return the filename of FI as it should be displayed." - (if cvs-display-full-path - (cvs-fileinfo->full-path fi) + (if cvs-display-full-name + (cvs-fileinfo->full-name fi) (cvs-fileinfo->file fi))) (defun cvs-fileinfo->backup-file (fileinfo) @@ -220,13 +239,14 @@ to confuse some users sometimes." (file (cvs-fileinfo->file fileinfo)) (default-directory (file-name-as-directory (expand-file-name dir))) (files (directory-files "." nil - (concat "^" (regexp-quote cvs-bakprefix) - (regexp-quote file) "\\."))) + (concat "\\`" (regexp-quote cvs-bakprefix) + (regexp-quote file) "\\(\\.[0-9]+\\.[0-9]+\\)+\\'"))) bf) - (dolist (f files bf) + (dolist (f files) (when (and (file-readable-p f) (or (null bf) (file-newer-than-file-p f bf))) - (setq bf (concat dir f)))))) + (setq bf f))) + (concat dir bf))) ;; (defun cvs-fileinfo->handled (fileinfo) ;; "Tell if this requires further action" @@ -269,12 +289,12 @@ to confuse some users sometimes." (error "Invalid :%s in cvs-fileinfo %s" check fi)))) -;;;; +;;;; ;;;; State table to indicate what you can do when. -;;;; +;;;; (defconst cvs-states - `((NEED-UPDATE update diff) + `((NEED-UPDATE update diff ignore) (UP-TO-DATE update nil remove diff safe-rm revert) (MODIFIED update commit undo remove diff merge diff-base) (ADDED update commit remove) @@ -325,20 +345,18 @@ For use by the cookie package." (insert (case type (DIRCHANGE (concat "In directory " - (cvs-add-face (cvs-fileinfo->full-path fileinfo) - 'cvs-header-face t - 'cvs-goal-column t) + (cvs-add-face (cvs-fileinfo->full-name fileinfo) + 'cvs-header t 'cvs-goal-column t) ":")) (MESSAGE (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo)) - 'cvs-msg-face)) + 'cvs-msg)) (t (let* ((status (if (cvs-fileinfo->marked fileinfo) - (cvs-add-face "*" 'cvs-marked-face) + (cvs-add-face "*" 'cvs-marked) " ")) (file (cvs-add-face (cvs-fileinfo->pp-name fileinfo) - 'cvs-filename-face t - 'cvs-goal-column t)) + 'cvs-filename t 'cvs-goal-column t)) (base (or (cvs-fileinfo->base-rev fileinfo) "")) (head (cvs-fileinfo->head-rev fileinfo)) (type @@ -351,7 +369,7 @@ For use by the cookie package." (downcase (symbol-name type)) "-face")))) (or (and (boundp sym) (symbol-value sym)) - 'cvs-need-action-face)))) + 'cvs-need-action)))) (cvs-add-face str face cvs-status-map))) (side (or ;; maybe a subtype @@ -452,8 +470,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))) @@ -466,4 +489,5 @@ DIR can also be a file." (provide 'pcvs-info) +;; arch-tag: d85dde07-bdc2-400a-882f-92f398c7b0ba ;;; pcvs-info.el ends here