Mercurial > hg > xemacs-beta

comparison lisp/packages/add-log.el @ 161:28f395d8dc7a r20-3b7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b7
author cvs
date Mon, 13 Aug 2007 09:42:26 +0200
parents 59463afc5666
children 8eaf7971accc
comparison
equal deleted inserted replaced
160:1c55655d6702 161:28f395d8dc7a
30 ;;; Code: 30 ;;; Code:
31 31
32 (defgroup change-log nil 32 (defgroup change-log nil
33 "Change log maintenance" 33 "Change log maintenance"
34 :group 'tools 34 :group 'tools
35 :group 'maint
35 :prefix "change-log-" 36 :prefix "change-log-"
36 :prefix "add-log-") 37 :prefix "add-log-")
37 38
38 39
39 ;;;###autoload
40 (defcustom change-log-default-name nil 40 (defcustom change-log-default-name nil
41 "*Name of a change log file for \\[add-change-log-entry]." 41 "*Name of a change log file for \\[add-change-log-entry]."
42 :type '(choice (const :tag "default" nil) 42 :type '(choice (const :tag "default" nil)
43 string) 43 string)
44 :group 'change-log) 44 :group 'change-log)
45 45
46 ;;;###autoload
47 (defcustom add-log-current-defun-function nil 46 (defcustom add-log-current-defun-function nil
48 "\ 47 "\
49 *If non-nil, function to guess name of current function from surrounding text. 48 *If non-nil, function to guess name of current function from surrounding text.
50 \\[add-change-log-entry] calls this function (if nil, `add-log-current-defun' 49 \\[add-change-log-entry] calls this function (if nil, `add-log-current-defun'
51 instead) with no arguments. It returns a string or nil if it cannot guess." 50 instead) with no arguments. It returns a string or nil if it cannot guess."
52 :type 'boolean 51 :type 'boolean
53 :group 'change-log) 52 :group 'change-log)
54 53
55 ;;;###autoload
56 (defcustom add-log-full-name nil 54 (defcustom add-log-full-name nil
57 "*Full name of user, for inclusion in ChangeLog daily headers. 55 "*Full name of user, for inclusion in ChangeLog daily headers.
58 This defaults to the value returned by the `user-full-name' function." 56 This defaults to the value returned by the `user-full-name' function."
59 :type '(choice (const :tag "Default" nil) 57 :type '(choice (const :tag "Default" nil)
60 string) 58 string)
61 :group 'change-log) 59 :group 'change-log)
62 60
63 ;; XEmacs;
64 ;; So that the dump-time value doesn't go into loaddefs.el with the autoload.
65 (or add-log-full-name (setq add-log-full-name (user-full-name)))
66
67 ;;;###autoload
68 (defcustom add-log-mailing-address nil 61 (defcustom add-log-mailing-address nil
69 "*Electronic mail address of user, for inclusion in ChangeLog daily headers. 62 "*Electronic mail address of user, for inclusion in ChangeLog daily headers.
70 This defaults to the value of `user-mail-address'." 63 This defaults to the value of `user-mail-address'."
71 :type '(choice (const :tag "Default" nil) 64 :type '(choice (const :tag "Default" nil)
72 string) 65 string)
73 :group 'change-log) 66 :group 'change-log)
74 67
75 ;; XEmacs: 68 (defcustom add-log-time-format 'iso8601-time-string
76 ;; So that the dump-time value doesn't go into loaddefs.el with the autoload. 69 "*Function that defines the time format.
77 (or add-log-mailing-address 70 For example, `iso8601-time-string' (time in international ISO 8601 format)
78 (setq add-log-mailing-address (user-mail-address))) 71 and `current-time-string' are valid values."
72 :type '(radio (const :tag "International ISO 8601 format" iso8601-time-string)
73 (const :tag "Old format, as returned by `current-time-string'"
74 current-time-string)
75 (function :tag "Other"))
76 :group 'change-log)
77
79 78
80 (defvar change-log-font-lock-keywords 79 (defvar change-log-font-lock-keywords
81 '(;; 80 '(;;
82 ;; Date lines, new and old styles. 81 ;; Date lines, new and old styles.
83 ("^\\sw.........[0-9: ]*" 82 ("^\\sw.........[0-9: ]*"
127 (hh (/ min 60))) 126 (hh (/ min 60)))
128 (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d") 127 (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d")
129 ((not (zerop mm)) "%c%02d:%02d") 128 ((not (zerop mm)) "%c%02d:%02d")
130 (t "%c%02d")) 129 (t "%c%02d"))
131 sign hh mm ss))) 130 sign hh mm ss)))
131
132 (defun iso8601-time-string ()
133 (if change-log-time-zone-rule
134 (let ((tz (getenv "TZ"))
135 (now (current-time)))
136 (unwind-protect
137 (progn
138 (set-time-zone-rule
139 change-log-time-zone-rule)
140 (concat
141 (format-time-string "%Y-%m-%d " now)
142 (iso8601-time-zone now)))
143 (set-time-zone-rule tz)))
144 (format-time-string "%Y-%m-%d")))
132 145
133 (defun change-log-name () 146 (defun change-log-name ()
134 (or change-log-default-name 147 (or change-log-default-name
135 (if (eq system-type 'vax-vms) 148 (if (eq system-type 'vax-vms)
136 "$CHANGE_LOG$.TXT" 149 "$CHANGE_LOG$.TXT"
209 (setq file-name file1))))) 222 (setq file-name file1)))))
210 ;; Make a local variable in this buffer so we needn't search again. 223 ;; Make a local variable in this buffer so we needn't search again.
211 (set (make-local-variable 'change-log-default-name) file-name) 224 (set (make-local-variable 'change-log-default-name) file-name)
212 file-name) 225 file-name)
213 226
227
214 ;;;###autoload 228 ;;;###autoload
215 (defun add-change-log-entry (&optional whoami file-name other-window new-entry) 229 (defun add-change-log-entry (&optional whoami file-name other-window new-entry)
216 "Find change log file and add an entry for today. 230 "Find change log file and add an entry for today.
217 Optional arg (interactive prefix) non-nil means prompt for user name and site. 231 Optional arg (interactive prefix) non-nil means prompt for user name and site.
218 Second arg is file name of change log. If nil, uses `change-log-default-name'. 232 Second arg is file name of change log. If nil, uses `change-log-default-name'.
257 (find-file file-name)) 271 (find-file file-name))
258 (or (eq major-mode 'change-log-mode) 272 (or (eq major-mode 'change-log-mode)
259 (change-log-mode)) 273 (change-log-mode))
260 (undo-boundary) 274 (undo-boundary)
261 (goto-char (point-min)) 275 (goto-char (point-min))
262 (let ((new-entry (concat (if change-log-time-zone-rule 276 (let ((new-entry (concat (funcall add-log-time-format)
263 (let ((tz (getenv "TZ"))
264 (now (current-time)))
265 (unwind-protect
266 (progn
267 (set-time-zone-rule
268 change-log-time-zone-rule)
269 (concat
270 (format-time-string "%Y-%m-%d " now)
271 (iso8601-time-zone now)))
272 (set-time-zone-rule tz)))
273 (format-time-string "%Y-%m-%d"))
274 " " add-log-full-name 277 " " add-log-full-name
275 " <" add-log-mailing-address ">"))) 278 " <" add-log-mailing-address ">")))
276 (if (looking-at (regexp-quote new-entry)) 279 (if (looking-at (regexp-quote new-entry))
277 (forward-line 1) 280 (forward-line 1)
278 (insert new-entry "\n\n"))) 281 (insert new-entry "\n\n")))