;;; pcvs-info.el --- internal representation of a fileinfo entry
-;; Copyright (C) 1991-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2016 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'pcvs-util)
;;(require 'pcvs-defs)
(t (:weight bold)))
"PCL-CVS face used to highlight directory changes."
:group 'pcl-cvs)
-(define-obsolete-face-alias 'cvs-header-face 'cvs-header "22.1")
(defface cvs-filename
'((((class color) (background dark))
(t ()))
"PCL-CVS face used to highlight file names."
:group 'pcl-cvs)
-(define-obsolete-face-alias 'cvs-filename-face 'cvs-filename "22.1")
(defface cvs-unknown
'((((class color) (background dark))
(t (:slant italic)))
"PCL-CVS face used to highlight unknown file status."
:group 'pcl-cvs)
-(define-obsolete-face-alias 'cvs-unknown-face 'cvs-unknown "22.1")
(defface cvs-handled
'((((class color) (background dark))
(t ()))
"PCL-CVS face used to highlight handled file status."
:group 'pcl-cvs)
-(define-obsolete-face-alias 'cvs-handled-face 'cvs-handled "22.1")
(defface cvs-need-action
'((((class color) (background dark))
(t (:slant italic)))
"PCL-CVS face used to highlight status of files needing action."
:group 'pcl-cvs)
-(define-obsolete-face-alias 'cvs-need-action-face 'cvs-need-action "22.1")
(defface cvs-marked
'((((min-colors 88) (class color) (background dark))
(t (:weight bold)))
"PCL-CVS face used to highlight marked file indicator."
:group 'pcl-cvs)
-(define-obsolete-face-alias 'cvs-marked-face 'cvs-marked "22.1")
(defface cvs-msg
- '((t (:slant italic)))
+ '((t :slant italic))
"PCL-CVS face used to highlight CVS messages."
:group 'pcl-cvs)
-(define-obsolete-face-alias 'cvs-msg-face 'cvs-msg "22.1")
(defvar cvs-fi-up-to-date-face 'cvs-handled)
(defvar cvs-fi-unknown-face 'cvs-unknown)
(easy-mmode-defmap cvs-status-map
'(([(mouse-2)] . cvs-mode-toggle-mark))
- "Local keymap for text properties of status")
+ "Local keymap for text properties of status.")
;; Constructor:
-(defstruct (cvs-fileinfo
+(cl-defstruct (cvs-fileinfo
(:constructor nil)
(:copier nil)
(:constructor -cvs-create-fileinfo (type dir file full-log
(string= file (file-name-nondirectory file)))
(setq check 'type) (symbolp type)
(setq check 'consistency)
- (case type
- (DIRCHANGE (and (null subtype) (string= "." file)))
- ((NEED-UPDATE ADDED MISSING DEAD MODIFIED MESSAGE UP-TO-DATE
- REMOVED NEED-MERGE CONFLICT UNKNOWN MESSAGE)
+ (pcase type
+ (`DIRCHANGE (and (null subtype) (string= "." file)))
+ ((or `NEED-UPDATE `ADDED `MISSING `DEAD `MODIFIED `MESSAGE
+ `UP-TO-DATE `REMOVED `NEED-MERGE `CONFLICT `UNKNOWN)
t)))
fi
(error "Invalid :%s in cvs-fileinfo %s" check fi))))
(DEAD )
(MESSAGE))
"Fileinfo state descriptions for pcl-cvs.
-This is an assoc list. Each element consists of (STATE . FUNS)
-- STATE (described in `cvs-create-fileinfo') is the key
+This is an assoc list. Each element consists of (STATE . FUNS):
+- STATE (described in `cvs-create-fileinfo') is the key.
- FUNS is the list of applicable operations.
The first one (if any) should be the \"default\" action.
Most of the actions have the obvious meaning.
(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)
+ (setq props `(keymap ,keymap ,@props)))
+ (setq props `(mouse-face highlight ,@props)))
+ (add-text-properties 0 (length str) `(font-lock-face ,face ,@props) str)
str)
(defun cvs-fileinfo-pp (fileinfo)
"Pretty print FILEINFO. Insert a printed representation in current buffer.
-For use by the cookie package."
+For use by the ewoc package."
(cvs-check-fileinfo fileinfo)
(let ((type (cvs-fileinfo->type fileinfo))
(subtype (cvs-fileinfo->subtype fileinfo)))
(insert
- (case type
- (DIRCHANGE (concat "In directory "
- (cvs-add-face (cvs-fileinfo->full-name fileinfo)
- 'cvs-header t 'cvs-goal-column t)
- ":"))
- (MESSAGE
+ (pcase type
+ (`DIRCHANGE (concat "In directory "
+ (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))
- (t
+ (_
(let* ((status (if (cvs-fileinfo->marked fileinfo)
(cvs-add-face "*" 'cvs-marked)
" "))
(base (or (cvs-fileinfo->base-rev fileinfo) ""))
(head (cvs-fileinfo->head-rev fileinfo))
(type
- (let ((str (case type
+ (let ((str (pcase type
;;(MOD-CONFLICT "Not Removed")
- (DEAD "")
- (t (capitalize (symbol-name type)))))
- (face (let ((sym (intern
+ (`DEAD "")
+ (_ (capitalize (symbol-name type)))))
+ (face (let ((sym (intern-soft
(concat "cvs-fi-"
(downcase (symbol-name type))
"-face"))))
(defun cvs-fileinfo-from-entries (dir &optional all)
"List of fileinfos for DIR, extracted from CVS/Entries.
-Unless ALL is optional, returns only the files that are not up-to-date.
+Unless ALL is non-nil, returns only the files that are not up-to-date.
DIR can also be a file."
(let* ((singlefile
(cond
((equal date "Result of merge") (setq subtype 'MERGED))
((let ((mtime (nth 5 (file-attributes (concat dir f))))
(system-time-locale "C"))
- (setq timestamp (format-time-string "%c" mtime 'utc))
+ (setq timestamp (format-time-string "%c" mtime t))
;; 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)