comparison lisp/packages/add-log.el @ 70:131b0175ea99 r20-0b30

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