1 ;;; add-log.el --- change log maintenance commands for Emacs
3 ;; Copyright (C) 1985, 86, 88, 93, 94, 97, 1998 Free Software Foundation, Inc.
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
26 ;; This facility is documented in the Emacs Manual.
30 (eval-when-compile (require 'fortran
))
32 (defgroup change-log nil
33 "Change log maintenance"
35 :link
'(custom-manual "(emacs)Change Log")
40 (defcustom change-log-default-name nil
41 "*Name of a change log file for \\[add-change-log-entry]."
42 :type
'(choice (const :tag
"default" nil
)
46 (defcustom add-log-current-defun-function nil
48 *If non-nil, function to guess name of current function from surrounding text.
49 \\[add-change-log-entry] calls this function (if nil, `add-log-current-defun'
50 instead) with no arguments. It returns a string or nil if it cannot guess."
55 (defcustom add-log-full-name nil
56 "*Full name of user, for inclusion in ChangeLog daily headers.
57 This defaults to the value returned by the `user-full-name' function."
58 :type
'(choice (const :tag
"Default" nil
)
63 (defcustom add-log-mailing-address nil
64 "*Electronic mail address of user, for inclusion in ChangeLog daily headers.
65 This defaults to the value of `user-mail-address'."
66 :type
'(choice (const :tag
"Default" nil
)
70 (defcustom add-log-time-format
'add-log-iso8601-time-string
71 "*Function that defines the time format.
72 For example, `add-log-iso8601-time-string', which gives the
73 date in international ISO 8601 format,
74 and `current-time-string' are two valid values."
75 :type
'(radio (const :tag
"International ISO 8601 format"
76 add-log-iso8601-time-string
)
77 (const :tag
"Old format, as returned by `current-time-string'"
79 (function :tag
"Other"))
82 (defcustom add-log-keep-changes-together nil
83 "*If non-nil, normally keep day's log entries for one file together.
85 Log entries for a given file made with \\[add-change-log-entry] or
86 \\[add-change-log-entry-other-window] will only be added to others \
88 today if this variable is non-nil or that file comes first in today's
89 entries. Otherwise another entry for that file will be started. An
95 in the latter case, \\[add-change-log-entry-other-window] in a \
96 buffer visiting `bar', yields:
100 * bar (...): change 1
105 * bar (...): change 1
108 The NEW-ENTRY arg to `add-change-log-entry' can override the effect of
114 (defvar change-log-font-lock-keywords
116 ;; Date lines, new and old styles.
117 ("^\\sw.........[0-9:+ ]*"
118 (0 font-lock-string-face
)
119 ("\\([^<]+\\)<\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)>" nil nil
120 (1 font-lock-constant-face
)
121 (2 font-lock-variable-name-face
)))
124 ("^\t\\* \\([^ ,:([\n]+\\)"
125 (1 font-lock-function-name-face
)
126 ("\\=, \\([^ ,:([\n]+\\)" nil nil
(1 font-lock-function-name-face
)))
128 ;; Function or variable names.
130 (1 font-lock-keyword-face
)
131 ("\\=, *\\([^) ,:\n]+\\)" nil nil
(1 font-lock-keyword-face
)))
134 ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 font-lock-variable-name-face
))
137 ("^\t\\(From\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
138 1 font-lock-comment-face
)
139 (" \\(From\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
140 1 font-lock-comment-face
))
141 "Additional expressions to highlight in Change Log mode.")
143 (defvar change-log-mode-map nil
144 "Keymap for Change Log major mode.")
145 (if change-log-mode-map
147 (setq change-log-mode-map
(make-sparse-keymap)))
149 (defvar change-log-time-zone-rule nil
150 "Time zone used for calculating change log time stamps.
151 It takes the same format as the TZ argument of `set-time-zone-rule'.
152 If nil, use local time.")
154 (defun add-log-iso8601-time-zone (time)
155 (let* ((utc-offset (or (car (current-time-zone time
)) 0))
156 (sign (if (< utc-offset
0) ?- ?
+))
157 (sec (abs utc-offset
))
162 (format (cond ((not (zerop ss
)) "%c%02d:%02d:%02d")
163 ((not (zerop mm
)) "%c%02d:%02d")
167 (defun add-log-iso8601-time-string ()
168 (if change-log-time-zone-rule
169 (let ((tz (getenv "TZ"))
170 (now (current-time)))
174 change-log-time-zone-rule
)
176 (format-time-string "%Y-%m-%d " now
)
177 (add-log-iso8601-time-zone now
)))
178 (set-time-zone-rule tz
)))
179 (format-time-string "%Y-%m-%d")))
181 (defun change-log-name ()
182 (or change-log-default-name
183 (if (eq system-type
'vax-vms
)
188 (defun prompt-for-change-log-name ()
189 "Prompt for a change log name."
190 (let* ((default (change-log-name))
191 (name (expand-file-name
192 (read-file-name (format "Log file (default %s): " default
)
194 ;; Handle something that is syntactically a directory name.
195 ;; Look for ChangeLog or whatever in that directory.
196 (if (string= (file-name-nondirectory name
) "")
197 (expand-file-name (file-name-nondirectory default
)
199 ;; Handle specifying a file that is a directory.
200 (if (file-directory-p name
)
201 (expand-file-name (file-name-nondirectory default
)
202 (file-name-as-directory name
))
206 (defun find-change-log (&optional file-name
)
207 "Find a change log file for \\[add-change-log-entry] and return the name.
209 Optional arg FILE-NAME specifies the file to use.
210 If FILE-NAME is nil, use the value of `change-log-default-name'.
211 If 'change-log-default-name' is nil, behave as though it were 'ChangeLog'
212 \(or whatever we use on this operating system).
214 If 'change-log-default-name' contains a leading directory component, then
215 simply find it in the current directory. Otherwise, search in the current
216 directory and its successive parents for a file so named.
218 Once a file is found, `change-log-default-name' is set locally in the
219 current buffer to the complete file name."
220 ;; If user specified a file name or if this buffer knows which one to use,
223 (setq file-name
(and change-log-default-name
224 (file-name-directory change-log-default-name
)
225 change-log-default-name
))
227 ;; Chase links in the source file
228 ;; and use the change log in the dir where it points.
229 (setq file-name
(or (and buffer-file-name
231 (file-chase-links buffer-file-name
)))
233 (if (file-directory-p file-name
)
234 (setq file-name
(expand-file-name (change-log-name) file-name
)))
235 ;; Chase links before visiting the file.
236 ;; This makes it easier to use a single change log file
237 ;; for several related directories.
238 (setq file-name
(file-chase-links file-name
))
239 (setq file-name
(expand-file-name file-name
))
240 ;; Move up in the dir hierarchy till we find a change log file.
241 (let ((file1 file-name
)
243 (while (and (not (or (get-file-buffer file1
) (file-exists-p file1
)))
244 (progn (setq parent-dir
247 (file-name-directory file1
))))
248 ;; Give up if we are already at the root dir.
249 (not (string= (file-name-directory file1
)
251 ;; Move up to the parent dir and try again.
252 (setq file1
(expand-file-name
253 (file-name-nondirectory (change-log-name))
255 ;; If we found a change log in a parent, use that.
256 (if (or (get-file-buffer file1
) (file-exists-p file1
))
257 (setq file-name file1
)))))
258 ;; Make a local variable in this buffer so we needn't search again.
259 (set (make-local-variable 'change-log-default-name
) file-name
)
263 (defun add-change-log-entry (&optional whoami file-name other-window new-entry
)
264 "Find change log file and add an entry for today.
265 Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
268 Second arg is FILE-NAME of change log. If nil, uses `change-log-default-name'.
269 Third arg OTHER-WINDOW non-nil means visit in other window.
270 Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
271 never append to an existing entry. Option `add-log-keep-changes-together'
272 otherwise affects whether a new entry is created.
274 Today's date is calculated according to `change-log-time-zone-rule' if
275 non-nil, otherwise in local time."
276 (interactive (list current-prefix-arg
277 (prompt-for-change-log-name)))
278 (or add-log-full-name
279 (setq add-log-full-name
(user-full-name)))
280 (or add-log-mailing-address
281 (setq add-log-mailing-address user-mail-address
))
284 (setq add-log-full-name
(read-input "Full name: " add-log-full-name
))
285 ;; Note that some sites have room and phone number fields in
286 ;; full name which look silly when inserted. Rather than do
287 ;; anything about that here, let user give prefix argument so that
288 ;; s/he can edit the full name field in prompter if s/he wants.
289 (setq add-log-mailing-address
290 (read-input "Mailing address: " add-log-mailing-address
))))
291 (let ((defun (funcall (or add-log-current-defun-function
292 'add-log-current-defun
)))
295 (setq file-name
(expand-file-name (find-change-log file-name
)))
297 ;; Set ENTRY to the file name to use in the new entry.
298 (and buffer-file-name
299 ;; Never want to add a change log entry for the ChangeLog file itself.
300 (not (string= buffer-file-name file-name
))
301 (setq entry
(if (string-match
302 (concat "^" (regexp-quote (file-name-directory
305 (substring buffer-file-name
(match-end 0))
306 (file-name-nondirectory buffer-file-name
))))
308 (if (and other-window
(not (equal file-name buffer-file-name
)))
309 (find-file-other-window file-name
)
310 (find-file file-name
))
311 (or (eq major-mode
'change-log-mode
)
314 (goto-char (point-min))
315 (let ((new-entry (concat (funcall add-log-time-format
)
316 " " add-log-full-name
317 " <" add-log-mailing-address
">")))
318 (if (looking-at (regexp-quote new-entry
))
320 (insert new-entry
"\n\n")))
324 (if (looking-at "\n*[^\n* \t]")
325 (skip-chars-forward "\n")
326 (if add-log-keep-changes-together
327 (forward-page) ; page delimits entries for date
328 (forward-paragraph))) ; paragraph delimits entries for file
330 (goto-char (point-min))
331 ;; Now insert the new line for this entry.
332 (cond ((re-search-forward "^\\s *\\*\\s *$" bound t
)
333 ;; Put this file name into the existing empty entry.
336 ((and (not new-entry
)
337 (let (case-fold-search)
339 (concat (regexp-quote (concat "* " entry
))
340 ;; Don't accept `foo.bar' when
341 ;; looking for `foo':
342 "\\(\\s \\|[(),:]\\)")
344 ;; Add to the existing entry for the same file.
345 (re-search-forward "^\\s *$\\|^\\s \\*")
346 (goto-char (match-beginning 0))
347 ;; Delete excess empty lines; make just 2.
348 (while (and (not (eobp)) (looking-at "^\\s *$"))
349 (delete-region (point) (save-excursion (forward-line 1) (point))))
352 (indent-relative-maybe))
356 (while (looking-at "\\sW")
358 (while (and (not (eobp)) (looking-at "^\\s *$"))
359 (delete-region (point) (save-excursion (forward-line 1) (point))))
362 (indent-to left-margin
)
363 (insert "* " (or entry
""))))
364 ;; Now insert the function name, if we have one.
365 ;; Point is at the entry for this file,
366 ;; either at the end of the line or at the first blank line.
369 ;; Make it easy to get rid of the function name.
371 (insert (if (save-excursion
372 (beginning-of-line 1)
373 (looking-at "\\s *$"))
377 ;; No function name, so put in a colon unless we have just a star.
378 (if (not (save-excursion
379 (beginning-of-line 1)
380 (looking-at "\\s *\\(\\*\\s *\\)?$")))
384 (defun add-change-log-entry-other-window (&optional whoami file-name
)
385 "Find change log file in other window and add an entry for today.
386 Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
388 Second optional arg FILE-NAME is file name of change log.
389 If nil, use `change-log-default-name'.
391 Affected by the same options as `add-change-log-entry'."
392 (interactive (if current-prefix-arg
393 (list current-prefix-arg
394 (prompt-for-change-log-name))))
395 (add-change-log-entry whoami file-name t
))
396 ;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
399 (defun change-log-mode ()
400 "Major mode for editing change logs; like Indented Text Mode.
401 Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
402 New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
403 Each entry behaves as a paragraph, and the entries for one day as a page.
404 Runs `change-log-mode-hook'."
406 (kill-all-local-variables)
408 (setq major-mode
'change-log-mode
409 mode-name
"Change Log"
414 (use-local-map change-log-mode-map
)
415 (set (make-local-variable 'fill-paragraph-function
)
416 'change-log-fill-paragraph
)
417 ;; Let each entry behave as one paragraph:
418 ;; We really do want "^" in paragraph-start below: it is only the lines that
419 ;; begin at column 0 (despite the left-margin of 8) that we are looking for.
420 (set (make-local-variable 'paragraph-start
) "\\s *$\\|\f\\|^\\<")
421 (set (make-local-variable 'paragraph-separate
) "\\s *$\\|\f\\|^\\<")
422 ;; Let all entries for one day behave as one page.
423 ;; Match null string on the date-line so that the date-line
424 ;; is grouped with what follows.
425 (set (make-local-variable 'page-delimiter
) "^\\<\\|^\f")
426 (set (make-local-variable 'version-control
) 'never
)
427 (set (make-local-variable 'adaptive-fill-regexp
) "\\s *")
428 (set (make-local-variable 'font-lock-defaults
)
429 '(change-log-font-lock-keywords t
))
430 (run-hooks 'change-log-mode-hook
))
432 ;; It might be nice to have a general feature to replace this. The idea I
433 ;; have is a variable giving a regexp matching text which should not be
434 ;; moved from bol by filling. change-log-mode would set this to "^\\s *\\s(".
435 ;; But I don't feel up to implementing that today.
436 (defun change-log-fill-paragraph (&optional justify
)
437 "Fill the paragraph, but preserve open parentheses at beginning of lines.
438 Prefix arg means justify as well."
440 (let ((end (progn (forward-paragraph) (point)))
441 (beg (progn (backward-paragraph) (point)))
442 (paragraph-start (concat paragraph-start
"\\|\\s *\\s(")))
443 (fill-region beg end justify
)
446 (defcustom add-log-current-defun-header-regexp
447 "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[-_a-zA-Z]+\\)[ \t]*[:=]"
448 "*Heuristic regexp used by `add-log-current-defun' for unknown major modes."
453 (defvar add-log-lisp-like-modes
454 '(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode
)
455 "*Modes that look like Lisp to `add-log-current-defun'.")
458 (defvar add-log-c-like-modes
459 '(c-mode c
++-mode c
++-c-mode objc-mode
)
460 "*Modes that look like C to `add-log-current-defun'.")
463 (defvar add-log-tex-like-modes
464 '(TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode
)
465 "*Modes that look like TeX to `add-log-current-defun'.")
468 (defun add-log-current-defun ()
469 "Return name of function definition point is in, or nil.
471 Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
472 Texinfo (@node titles), Perl, and Fortran.
474 Other modes are handled by a heuristic that looks in the 10K before
475 point for uppercase headings starting in the first column or
476 identifiers followed by `:' or `=', see variable
477 `add-log-current-defun-header-regexp'.
479 Has a preference of looking backwards."
482 (let ((location (point)))
483 (cond ((memq major-mode add-log-lisp-like-modes
)
484 ;; If we are now precisely at the beginning of a defun,
485 ;; make sure beginning-of-defun finds that one
486 ;; rather than the previous one.
487 (or (eobp) (forward-char 1))
489 ;; Make sure we are really inside the defun found, not after it.
490 (if (and (looking-at "\\s(")
491 (progn (end-of-defun)
492 (< location
(point)))
493 (progn (forward-sexp -
1)
494 (>= location
(point))))
496 (if (looking-at "\\s(")
499 (skip-chars-forward " '")
500 (buffer-substring (point)
501 (progn (forward-sexp 1) (point))))))
502 ((and (memq major-mode add-log-c-like-modes
)
505 ;; Use eq instead of = here to avoid
506 ;; error when at bob and char-after
508 (while (eq (char-after (- (point) 2)) ?
\\)
510 (looking-at "[ \t]*#[ \t]*define[ \t]")))
511 ;; Handle a C macro definition.
513 (while (eq (char-after (- (point) 2)) ?
\\) ;not =; note above
515 (search-forward "define")
516 (skip-chars-forward " \t")
517 (buffer-substring (point)
518 (progn (forward-sexp 1) (point))))
519 ((memq major-mode add-log-c-like-modes
)
521 ;; See if we are in the beginning part of a function,
522 ;; before the open brace. If so, advance forward.
523 (while (not (looking-at "{\\|\\(\\s *$\\)"))
528 (if (progn (end-of-defun)
529 (< location
(point)))
535 ;; Skip back over typedefs of arglist.
536 (while (and (not (bobp))
537 (looking-at "[ \t\n]"))
539 ;; See if this is using the DEFUN macro used in Emacs,
540 ;; or the DEFUN macro used by the C library.
541 (if (condition-case nil
544 (while (= (preceding-char) ?
\\)
549 (looking-at "DEFUN\\b"))
555 (if (= (char-after (point)) ?
\")
558 (skip-chars-forward " ,")))
559 (buffer-substring (point)
560 (progn (forward-sexp 1) (point))))
561 (if (looking-at "^[+-]")
562 (change-log-get-method-definition)
563 ;; Ordinary C function syntax.
565 (if (and (condition-case nil
566 ;; Protect against "Unbalanced parens" error.
568 (down-list 1) ; into arglist
570 (skip-chars-backward " \t")
573 ;; Verify initial pos was after
574 ;; real start of function.
577 ;; For this purpose, include the line
578 ;; that has the decl keywords. This
579 ;; may also include some of the
580 ;; comments before the function.
581 (while (and (not (bobp))
584 (looking-at "[^\n\f]")))
586 (>= location
(point)))
587 ;; Consistency check: going down and up
588 ;; shouldn't take us back before BEG.
591 ;; Don't include any final newline
592 ;; in the name we use.
593 (if (= (preceding-char) ?
\n)
597 ;; Now find the right beginning of the name.
598 ;; Include certain keywords if they
600 (setq middle
(point))
602 ;; Ignore these subparts of a class decl
603 ;; and move back to the class name itself.
604 (while (looking-at "public \\|private ")
605 (skip-chars-backward " \t:")
608 (setq middle
(point))
611 (looking-at "struct \\|union \\|class ")
612 (setq middle
(point)))
613 (buffer-substring middle end
)))))))))
614 ((memq major-mode add-log-tex-like-modes
)
615 (if (re-search-backward
616 "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t
)
618 (goto-char (match-beginning 0))
619 (buffer-substring (1+ (point));; without initial backslash
623 ((eq major-mode
'texinfo-mode
)
624 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t
)
625 (buffer-substring (match-beginning 1)
627 ((eq major-mode
'perl-mode
)
628 (if (re-search-backward "^sub[ \t]+\\([^ \t\n]+\\)" nil t
)
629 (buffer-substring (match-beginning 1)
631 ((or (eq major-mode
'fortran-mode
)
632 ;; Needs work for f90, but better than nothing.
633 (eq major-mode
'f90-mode
))
634 ;; must be inside function body for this to work
635 (beginning-of-fortran-subprogram)
636 (let ((case-fold-search t
)) ; case-insensitive
637 ;; search for fortran subprogram start
638 (if (re-search-forward
639 "^[ \t]*\\(program\\|subroutine\\|function\
640 \\|[ \ta-z0-9*()]*[ \t]+function\\|\\(block[ \t]*data\\)\\)"
641 (progn (end-of-fortran-subprogram)
646 ;; move to EOL or before first left paren
647 (if (re-search-forward "[(\n]" nil t
)
648 (progn (backward-char)
649 (skip-chars-backward " \t"))
651 ;; Use the name preceding that.
652 (buffer-substring (point)
653 (progn (backward-sexp)
657 ;; If all else fails, try heuristics
658 (let (case-fold-search)
660 (if (re-search-backward add-log-current-defun-header-regexp
663 (buffer-substring (match-beginning 1)
667 (defvar change-log-get-method-definition-md
)
669 ;; Subroutine used within change-log-get-method-definition.
670 ;; Add the last match in the buffer to the end of `md',
671 ;; followed by the string END; move to the end of that match.
672 (defun change-log-get-method-definition-1 (end)
673 (setq change-log-get-method-definition-md
674 (concat change-log-get-method-definition-md
675 (buffer-substring (match-beginning 1) (match-end 1))
677 (goto-char (match-end 0)))
679 ;; For objective C, return the method name if we are in a method.
680 (defun change-log-get-method-definition ()
681 (let ((change-log-get-method-definition-md "["))
683 (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t
)
684 (change-log-get-method-definition-1 " ")))
687 ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t
)
688 (change-log-get-method-definition-1 "")
689 (while (not (looking-at "[{;]"))
691 "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*")
692 (change-log-get-method-definition-1 ""))
693 (concat change-log-get-method-definition-md
"]"))))))
698 ;;; add-log.el ends here