Mercurial > hg > xemacs-beta
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 |