comparison lisp/packages/add-log.el @ 48:56c54cf7c5b6 r19-16b90

Import from CVS: tag r19-16b90
author cvs
date Mon, 13 Aug 2007 08:56:04 +0200
parents 0293115a14e9
children 131b0175ea99
comparison
equal deleted inserted replaced
47:11c6df210d7f 48:56c54cf7c5b6
1 ;;; add-log.el --- change log maintenance commands for Emacs 1 ;;; add-log.el --- change log maintenance commands for Emacs
2 2
3 ;; Copyright (C) 1985, 1986, 1988, 1993, 1994 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985, 86, 88, 93, 94, 1997 Free Software Foundation, Inc.
4 4
5 ;; Keywords: maint 5 ;; Keywords: maint
6 6
7 ;; This file is part of XEmacs. 7 ;; This file is part of XEmacs.
8 8
19 ;; You should have received a copy of the GNU General Public License 19 ;; You should have received a copy of the GNU General Public License
20 ;; along with XEmacs; see the file COPYING. If not, write to the 20 ;; along with XEmacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA. 22 ;; Boston, MA 02111-1307, USA.
23 23
24 ;;; Synched up with: FSF 19.34. 24 ;;; Synched up with: Emacs 20.0.
25 25
26 ;;; Commentary: 26 ;;; Commentary:
27 27
28 ;; This facility is documented in the Emacs Manual. 28 ;; This facility is documented in the Emacs Manual.
29 29
51 ;;;###autoload 51 ;;;###autoload
52 (defvar add-log-mailing-address nil 52 (defvar add-log-mailing-address nil
53 "*Electronic mail address of user, for inclusion in ChangeLog daily headers. 53 "*Electronic mail address of user, for inclusion in ChangeLog daily headers.
54 This defaults to the value of `user-mail-address'.") 54 This defaults to the value of `user-mail-address'.")
55 55
56 ;; XEmacs:
56 ;; So that the dump-time value doesn't go into loaddefs.el with the autoload. 57 ;; So that the dump-time value doesn't go into loaddefs.el with the autoload.
57 (or add-log-mailing-address 58 (or add-log-mailing-address
58 (setq add-log-mailing-address user-mail-address)) 59 (setq add-log-mailing-address user-mail-address))
59 60
61
60 (defvar change-log-font-lock-keywords 62 (defvar change-log-font-lock-keywords
61 '(("^[SMTWF].+" . font-lock-function-name-face) ; Date line. 63 '(;;
62 ("^\t\\* \\([^ :\n]+\\)" 1 font-lock-comment-face) ; File name. 64 ;; Date lines, new and old styles.
63 ("(\\([^)\n]+\\)):" 1 font-lock-keyword-face)) ; Function name. 65 ("^\\sw.........[0-9: ]*"
66 (0 font-lock-string-face)
67 ("\\([^<]+\\)<\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)>" nil nil
68 (1 font-lock-reference-face)
69 (2 font-lock-variable-name-face)))
70 ;;
71 ;; File names.
72 ("^\t\\* \\([^ ,:([\n]+\\)"
73 (1 font-lock-function-name-face)
74 ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 font-lock-function-name-face)))
75 ;;
76 ;; Function or variable names.
77 ("(\\([^ ,:\n]+\\)"
78 (1 font-lock-keyword-face)
79 ("\\=, \\([^ ,:\n]+\\)" nil nil (1 font-lock-keyword-face)))
80 ;;
81 ;; Conditionals.
82 ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 font-lock-variable-name-face))
83 ;;
84 ;; Acknowledgments.
85 ("^\t\\(From\\|Reported by\\)" 1 font-lock-comment-face)
86 )
64 "Additional expressions to highlight in Change Log mode.") 87 "Additional expressions to highlight in Change Log mode.")
65 (put 'change-log-mode 'font-lock-defaults 88 (put 'change-log-mode 'font-lock-defaults
66 '(change-log-font-lock-keywords t)) 89 '(change-log-font-lock-keywords t))
67 90
68 (defvar change-log-mode-map nil 91 (defvar change-log-mode-map nil
69 "Keymap for Change Log major mode.") 92 "Keymap for Change Log major mode.")
70 (if change-log-mode-map 93 (if change-log-mode-map
71 nil 94 nil
72 (setq change-log-mode-map (make-sparse-keymap)) 95 (setq change-log-mode-map (make-sparse-keymap)))
73 (define-key change-log-mode-map "\M-q" 'change-log-fill-paragraph)) 96
97 (defvar change-log-time-zone-rule nil
98 "Time zone used for calculating change log time stamps.
99 It takes the same format as the TZ argument of `set-time-zone-rule'.
100 If nil, use local time.")
101
102 (defun iso8601-time-zone (time)
103 (let* ((utc-offset (or (car (current-time-zone time)) 0))
104 (sign (if (< utc-offset 0) ?- ?+))
105 (sec (abs utc-offset))
106 (ss (% sec 60))
107 (min (/ sec 60))
108 (mm (% min 60))
109 (hh (/ min 60)))
110 (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d")
111 ((not (zerop mm)) "%c%02d:%02d")
112 (t "%c%02d"))
113 sign hh mm ss)))
74 114
75 (defun change-log-name () 115 (defun change-log-name ()
76 (or change-log-default-name 116 (or change-log-default-name
77 (if (eq system-type 'vax-vms) 117 (if (eq system-type 'vax-vms)
78 "$CHANGE_LOG$.TXT" 118 "$CHANGE_LOG$.TXT"
79 (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt)) 119 "ChangeLog")))
80 "changelo"
81 "ChangeLog"))))
82 120
83 ;;;###autoload 121 ;;;###autoload
84 (defun prompt-for-change-log-name () 122 (defun prompt-for-change-log-name ()
85 "Prompt for a change log name." 123 "Prompt for a change log name."
86 (let* ((default (change-log-name)) 124 (let* ((default (change-log-name))
160 "Find change log file and add an entry for today. 198 "Find change log file and add an entry for today.
161 Optional arg (interactive prefix) non-nil means prompt for user name and site. 199 Optional arg (interactive prefix) non-nil means prompt for user name and site.
162 Second arg is file name of change log. If nil, uses `change-log-default-name'. 200 Second arg is file name of change log. If nil, uses `change-log-default-name'.
163 Third arg OTHER-WINDOW non-nil means visit in other window. 201 Third arg OTHER-WINDOW non-nil means visit in other window.
164 Fourth arg NEW-ENTRY non-nil means always create a new entry at the front; 202 Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
165 never append to an existing entry." 203 never append to an existing entry. Today's date is calculated according to
204 `change-log-time-zone-rule' if non-nil, otherwise in local time."
166 (interactive (list current-prefix-arg 205 (interactive (list current-prefix-arg
167 (prompt-for-change-log-name))) 206 (prompt-for-change-log-name)))
168 (or add-log-full-name 207 (or add-log-full-name
169 (setq add-log-full-name (user-full-name))) 208 (setq add-log-full-name (user-full-name)))
170 (or add-log-mailing-address 209 (or add-log-mailing-address
200 (find-file file-name)) 239 (find-file file-name))
201 (or (eq major-mode 'change-log-mode) 240 (or (eq major-mode 'change-log-mode)
202 (change-log-mode)) 241 (change-log-mode))
203 (undo-boundary) 242 (undo-boundary)
204 (goto-char (point-min)) 243 (goto-char (point-min))
205 (if (looking-at (concat (regexp-quote (substring (current-time-string) 244 (let ((new-entry (concat (if change-log-time-zone-rule
206 0 10)) 245 (let ((tz (getenv "TZ"))
207 ".* " (regexp-quote add-log-full-name) 246 (now (current-time)))
208 " <" (regexp-quote add-log-mailing-address))) 247 (unwind-protect
209 (forward-line 1) 248 (progn
210 (insert (current-time-string) 249 (set-time-zone-rule
211 " " add-log-full-name 250 change-log-time-zone-rule)
212 " <" add-log-mailing-address ">\n\n")) 251 (concat
252 (format-time-string "%Y-%m-%d " now)
253 (iso8601-time-zone now)))
254 (set-time-zone-rule tz)))
255 (format-time-string "%Y-%m-%d"))
256 " " add-log-full-name
257 " <" add-log-mailing-address ">")))
258 (if (looking-at (regexp-quote new-entry))
259 (forward-line 1)
260 (insert new-entry "\n\n")))
213 261
214 ;; Search only within the first paragraph. 262 ;; Search only within the first paragraph.
215 (if (looking-at "\n*[^\n* \t]") 263 (if (looking-at "\n*[^\n* \t]")
216 (skip-chars-forward "\n") 264 (skip-chars-forward "\n")
217 (forward-paragraph 1)) 265 (forward-paragraph 1))
280 (list current-prefix-arg 328 (list current-prefix-arg
281 (prompt-for-change-log-name)))) 329 (prompt-for-change-log-name))))
282 (add-change-log-entry whoami file-name t)) 330 (add-change-log-entry whoami file-name t))
283 ;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window) 331 ;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
284 332
285 (defvar change-log-mode-map nil
286 "Keymap for Change Log major mode.")
287 (if change-log-mode-map
288 nil
289 (setq change-log-mode-map (make-sparse-keymap))
290 (set-keymap-name change-log-mode-map 'change-log-mode-map)
291 (define-key change-log-mode-map "\M-q" 'change-log-fill-paragraph))
292
293 ;;;###autoload 333 ;;;###autoload
294 (defun change-log-mode () 334 (defun change-log-mode ()
295 "Major mode for editing change logs; like Indented Text Mode. 335 "Major mode for editing change logs; like Indented Text Mode.
296 Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74. 336 Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
297 New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window]. 337 New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
305 left-margin 8 345 left-margin 8
306 fill-column 74 346 fill-column 74
307 indent-tabs-mode t 347 indent-tabs-mode t
308 tab-width 8) 348 tab-width 8)
309 (use-local-map change-log-mode-map) 349 (use-local-map change-log-mode-map)
350 (set (make-local-variable 'fill-paragraph-function)
351 'change-log-fill-paragraph)
310 ;; Let each entry behave as one paragraph: 352 ;; Let each entry behave as one paragraph:
311 ;; We really do want "^" in paragraph-start below: it is only the lines that 353 ;; We really do want "^" in paragraph-start below: it is only the lines that
312 ;; begin at column 0 (despite the left-margin of 8) that we are looking for. 354 ;; begin at column 0 (despite the left-margin of 8) that we are looking for.
313 (set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\sw") 355 (set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\<")
314 (set (make-local-variable 'paragraph-separate) "\\s *$\\|\f\\|^\\sw") 356 (set (make-local-variable 'paragraph-separate) "\\s *$\\|\f\\|^\\<")
315 ;; Let all entries for one day behave as one page. 357 ;; Let all entries for one day behave as one page.
316 ;; Match null string on the date-line so that the date-line 358 ;; Match null string on the date-line so that the date-line
317 ;; is grouped with what follows. 359 ;; is grouped with what follows.
318 (set (make-local-variable 'page-delimiter) "^\\<\\|^\f") 360 (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
319 (set (make-local-variable 'version-control) 'never) 361 (set (make-local-variable 'version-control) 'never)
320 (set (make-local-variable 'adaptive-fill-regexp) "\\s *") 362 (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
363 ;;(set (make-local-variable 'font-lock-defaults)
364 ;;'(change-log-font-lock-keywords t))
321 (run-hooks 'change-log-mode-hook)) 365 (run-hooks 'change-log-mode-hook))
322 366
323 ;; It might be nice to have a general feature to replace this. The idea I 367 ;; It might be nice to have a general feature to replace this. The idea I
324 ;; have is a variable giving a regexp matching text which should not be 368 ;; have is a variable giving a regexp matching text which should not be
325 ;; moved from bol by filling. change-log-mode would set this to "^\\s *\\s(". 369 ;; moved from bol by filling. change-log-mode would set this to "^\\s *\\s(".
326 ;; But I don't feel up to implementing that today. 370 ;; But I don't feel up to implementing that today.
327 (defun change-log-fill-paragraph (&optional justify) 371 (defun change-log-fill-paragraph (&optional justify)
328 "Fill the paragraph, but preserve open parentheses at beginning of lines. 372 "Fill the paragraph, but preserve open parentheses at beginning of lines.
329 Prefix arg means justify as well." 373 Prefix arg means justify as well."
330 (interactive "P") 374 (interactive "P")
331 (let ((end (save-excursion (forward-paragraph) (point))) 375 (let ((end (progn (forward-paragraph) (point)))
332 (beg (save-excursion (backward-paragraph)(point))) 376 (beg (progn (backward-paragraph) (point)))
333 (paragraph-start (concat paragraph-start "\\|\\s *\\s("))) 377 (paragraph-start (concat paragraph-start "\\|\\s *\\s(")))
334 (fill-region beg end justify))) 378 (fill-region beg end justify)
379 t))
335 380
336 (defvar add-log-current-defun-header-regexp 381 (defvar add-log-current-defun-header-regexp
337 "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[-_a-zA-Z]+\\)[ \t]*[:=]" 382 "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[-_a-zA-Z]+\\)[ \t]*[:=]"
338 "*Heuristic regexp used by `add-log-current-defun' for unknown major modes.") 383 "*Heuristic regexp used by `add-log-current-defun' for unknown major modes.")
339 384
340 ;;;###autoload 385 ;;;###autoload
386 (defvar add-log-lisp-like-modes
387 '(emacs-lisp-mode lisp-mode scheme-mode lisp-interaction-mode)
388 "*Modes that look like Lisp to `add-log-current-defun'.")
389
390 ;;;###autoload
391 (defvar add-log-c-like-modes
392 '(c-mode c++-mode c++-c-mode objc-mode)
393 "*Modes that look like C to `add-log-current-defun'.")
394
395 ;;;###autoload
396 (defvar add-log-tex-like-modes
397 '(TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode)
398 "*Modes that look like TeX to `add-log-current-defun'.")
399
400 ;;;###autoload
341 (defun add-log-current-defun () 401 (defun add-log-current-defun ()
342 "Return name of function definition point is in, or nil. 402 "Return name of function definition point is in, or nil.
343 403
344 Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...), 404 Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
345 Texinfo (@node titles), Perl, and Fortran. 405 Texinfo (@node titles), Perl, and Fortran.
351 411
352 Has a preference of looking backwards." 412 Has a preference of looking backwards."
353 (condition-case nil 413 (condition-case nil
354 (save-excursion 414 (save-excursion
355 (let ((location (point))) 415 (let ((location (point)))
356 (cond ((memq major-mode '(emacs-lisp-mode lisp-mode scheme-mode 416 (cond ((memq major-mode add-log-lisp-like-modes)
357 lisp-interaction-mode))
358 ;; If we are now precisely at the beginning of a defun, 417 ;; If we are now precisely at the beginning of a defun,
359 ;; make sure beginning-of-defun finds that one 418 ;; make sure beginning-of-defun finds that one
360 ;; rather than the previous one. 419 ;; rather than the previous one.
361 (or (eobp) (forward-char 1)) 420 (or (eobp) (forward-char 1))
362 (beginning-of-defun) 421 (beginning-of-defun)
371 (forward-char 1)) 430 (forward-char 1))
372 (forward-sexp 1) 431 (forward-sexp 1)
373 (skip-chars-forward " '") 432 (skip-chars-forward " '")
374 (buffer-substring (point) 433 (buffer-substring (point)
375 (progn (forward-sexp 1) (point)))))) 434 (progn (forward-sexp 1) (point))))))
376 ((and (memq major-mode '(c-mode c++-mode c++-c-mode objc-mode)) 435 ((and (memq major-mode add-log-c-like-modes)
377 (save-excursion (beginning-of-line) 436 (save-excursion
378 ;; Use eq instead of = here to avoid 437 (beginning-of-line)
379 ;; error when at bob and char-after 438 ;; Use eq instead of = here to avoid
380 ;; returns nil. 439 ;; error when at bob and char-after
381 (while (eq (char-after (- (point) 2)) ?\\) 440 ;; returns nil.
382 (forward-line -1)) 441 (while (eq (char-after (- (point) 2)) ?\\)
383 (looking-at "[ \t]*#[ \t]*define[ \t]"))) 442 (forward-line -1))
443 (looking-at "[ \t]*#[ \t]*define[ \t]")))
384 ;; Handle a C macro definition. 444 ;; Handle a C macro definition.
385 (beginning-of-line) 445 (beginning-of-line)
386 (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above 446 (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
387 (forward-line -1)) 447 (forward-line -1))
388 (search-forward "define") 448 (search-forward "define")
389 (skip-chars-forward " \t") 449 (skip-chars-forward " \t")
390 (buffer-substring (point) 450 (buffer-substring (point)
391 (progn (forward-sexp 1) (point)))) 451 (progn (forward-sexp 1) (point))))
392 ((memq major-mode '(c-mode c++-mode c++-c-mode objc-mode)) 452 ((memq major-mode add-log-c-like-modes)
393 (beginning-of-line) 453 (beginning-of-line)
394 ;; See if we are in the beginning part of a function, 454 ;; See if we are in the beginning part of a function,
395 ;; before the open brace. If so, advance forward. 455 ;; before the open brace. If so, advance forward.
396 (while (not (looking-at "{\\|\\(\\s *$\\)")) 456 (while (not (looking-at "{\\|\\(\\s *$\\)"))
397 (forward-line 1)) 457 (forward-line 1))
482 (forward-word -1)) 542 (forward-word -1))
483 (and (bolp) 543 (and (bolp)
484 (looking-at "struct \\|union \\|class ") 544 (looking-at "struct \\|union \\|class ")
485 (setq middle (point))) 545 (setq middle (point)))
486 (buffer-substring middle end))))))))) 546 (buffer-substring middle end)))))))))
487 ((memq major-mode 547 ((memq major-mode add-log-tex-like-modes)
488 '(TeX-mode plain-TeX-mode LaTeX-mode;; tex-mode.el
489 plain-tex-mode latex-mode;; cmutex.el
490 ))
491 (if (re-search-backward 548 (if (re-search-backward
492 "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t) 549 "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
493 (progn 550 (progn
494 (goto-char (match-beginning 0)) 551 (goto-char (match-beginning 0))
495 (buffer-substring (1+ (point));; without initial backslash 552 (buffer-substring (1+ (point));; without initial backslash