1 ;;; add-log.el --- change log maintenance commands for Emacs
3 ;; Copyright (C) 1985, 86, 88, 93, 94, 97, 98, 2000, 03, 2004
4 ;; Free Software Foundation, Inc.
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 ;; This facility is documented in the Emacs Manual.
35 (defgroup change-log nil
36 "Change log maintenance"
38 :link
'(custom-manual "(emacs)Change Log")
43 (defcustom change-log-default-name nil
44 "*Name of a change log file for \\[add-change-log-entry]."
45 :type
'(choice (const :tag
"default" nil
)
49 (defcustom change-log-mode-hook nil
50 "Normal hook run by `change-log-mode'."
54 ;; Many modes set this variable, so avoid warnings.
56 (defcustom add-log-current-defun-function nil
57 "*If non-nil, function to guess name of surrounding function.
58 It is used by `add-log-current-defun' in preference to built-in rules.
59 Returns function's name as a string, or nil if outside a function."
60 :type
'(choice (const nil
) function
)
64 (defcustom add-log-full-name nil
65 "*Full name of user, for inclusion in ChangeLog daily headers.
66 This defaults to the value returned by the function `user-full-name'."
67 :type
'(choice (const :tag
"Default" nil
)
72 (defcustom add-log-mailing-address nil
73 "*Electronic mail addresses of user, for inclusion in ChangeLog headers.
74 This defaults to the value of `user-mail-address'. In addition to
75 being a simple string, this value can also be a list. All elements
76 will be recognized as referring to the same user; when creating a new
77 ChangeLog entry, one element will be chosen at random."
78 :type
'(choice (const :tag
"Default" nil
)
79 (string :tag
"String")
80 (repeat :tag
"List of Strings" string
))
83 (defcustom add-log-time-format
'add-log-iso8601-time-string
84 "*Function that defines the time format.
85 For example, `add-log-iso8601-time-string', which gives the
86 date in international ISO 8601 format,
87 and `current-time-string' are two valid values."
88 :type
'(radio (const :tag
"International ISO 8601 format"
89 add-log-iso8601-time-string
)
90 (const :tag
"Old format, as returned by `current-time-string'"
92 (function :tag
"Other"))
95 (defcustom add-log-keep-changes-together nil
96 "*If non-nil, normally keep day's log entries for one file together.
98 Log entries for a given file made with \\[add-change-log-entry] or
99 \\[add-change-log-entry-other-window] will only be added to others \
101 today if this variable is non-nil or that file comes first in today's
102 entries. Otherwise another entry for that file will be started. An
106 * bar (...): change 1
108 in the latter case, \\[add-change-log-entry-other-window] in a \
109 buffer visiting `bar', yields:
113 * bar (...): change 1
118 * bar (...): change 1
121 The NEW-ENTRY arg to `add-change-log-entry' can override the effect of
127 (defcustom add-log-always-start-new-record nil
128 "*If non-nil, `add-change-log-entry' will always start a new record."
133 (defcustom add-log-buffer-file-name-function nil
134 "*If non-nil, function to call to identify the full filename of a buffer.
135 This function is called with no argument. If this is nil, the default is to
136 use `buffer-file-name'."
137 :type
'(choice (const nil
) function
)
140 (defcustom add-log-file-name-function nil
141 "*If non-nil, function to call to identify the filename for a ChangeLog entry.
142 This function is called with one argument, the value of variable
143 `buffer-file-name' in that buffer. If this is nil, the default is to
144 use the file's name relative to the directory of the change log file."
145 :type
'(choice (const nil
) function
)
149 (defcustom change-log-version-info-enabled nil
150 "*If non-nil, enable recording version numbers with the changes."
155 (defcustom change-log-version-number-regexp-list
156 (let ((re "\\([0-9]+\.[0-9.]+\\)"))
158 ;; (defconst ad-version "2.15"
159 (concat "^(def[^ \t\n]+[ \t]+[^ \t\n][ \t]\"" re
)
160 ;; Revision: pcl-cvs.el,v 1.72 1999/09/05 20:21:54 monnier Exp
161 (concat "^;+ *Revision: +[^ \t\n]+[ \t]+" re
)))
162 "*List of regexps to search for version number.
163 The version number must be in group 1.
164 Note: The search is conducted only within 10%, at the beginning of the file."
166 :type
'(repeat regexp
)
169 (defface change-log-date-face
170 '((t (:inherit font-lock-string-face
)))
171 "Face used to highlight dates in date lines."
175 (defface change-log-name-face
176 '((t (:inherit font-lock-constant-face
)))
177 "Face for highlighting author names."
181 (defface change-log-email-face
182 '((t (:inherit font-lock-variable-name-face
)))
183 "Face for highlighting author email addresses."
187 (defface change-log-file-face
188 '((t (:inherit font-lock-function-name-face
)))
189 "Face for highlighting file names."
193 (defface change-log-list-face
194 '((t (:inherit font-lock-keyword-face
)))
195 "Face for highlighting parenthesized lists of functions or variables."
199 (defface change-log-conditionals-face
200 '((t (:inherit font-lock-variable-name-face
)))
201 "Face for highlighting conditionals of the form `[...]'."
205 (defface change-log-function-face
206 '((t (:inherit font-lock-variable-name-face
)))
207 "Face for highlighting items of the form `<....>'."
211 (defface change-log-acknowledgement-face
212 '((t (:inherit font-lock-comment-face
)))
213 "Face for highlighting acknowledgments."
217 (defvar change-log-font-lock-keywords
219 ;; Date lines, new and old styles.
220 ("^\\sw.........[0-9:+ ]*"
221 (0 'change-log-date-face
)
222 ;; Name and e-mail; some people put e-mail in parens, not angles.
223 ("\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)[>)]" nil nil
224 (1 'change-log-name-face
)
225 (2 'change-log-email-face
)))
228 ("^\t\\* \\([^ ,:([\n]+\\)"
229 (1 'change-log-file-face
)
230 ;; Possibly further names in a list:
231 ("\\=, \\([^ ,:([\n]+\\)" nil nil
(1 'change-log-file-face
))
232 ;; Possibly a parenthesized list of names:
233 ("\\= (\\([^() ,\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
234 nil nil
(1 'change-log-list-face
))
235 ("\\=, *\\([^() ,\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
236 nil nil
(1 'change-log-list-face
)))
238 ;; Function or variable names.
239 ("^\t(\\([^() ,\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
240 (1 'change-log-list-face
)
241 ("\\=, *\\([^() ,\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" nil nil
242 (1 'change-log-list-face
)))
245 ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 'change-log-conditionals-face
))
247 ;; Function of change.
248 ("<\\([^>\n]+\\)>\\(:\\| (\\)" (1 'change-log-function-face
))
251 ("\\(^\t\\| \\)\\(From\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
252 2 'change-log-acknowledgement-face
))
253 "Additional expressions to highlight in Change Log mode.")
255 (defvar change-log-mode-map
256 (let ((map (make-sparse-keymap)))
257 (define-key map
[?\C-c ?\C-p
] 'add-log-edit-prev-comment
)
258 (define-key map
[?\C-c ?\C-n
] 'add-log-edit-next-comment
)
260 "Keymap for Change Log major mode.")
262 (defvar change-log-time-zone-rule nil
263 "Time zone used for calculating change log time stamps.
264 It takes the same format as the TZ argument of `set-time-zone-rule'.
265 If nil, use local time.")
267 (defun add-log-iso8601-time-zone (time)
268 (let* ((utc-offset (or (car (current-time-zone time
)) 0))
269 (sign (if (< utc-offset
0) ?- ?
+))
270 (sec (abs utc-offset
))
275 (format (cond ((not (zerop ss
)) "%c%02d:%02d:%02d")
276 ((not (zerop mm
)) "%c%02d:%02d")
280 (defun add-log-iso8601-time-string ()
281 (if change-log-time-zone-rule
282 (let ((tz (getenv "TZ"))
283 (now (current-time)))
286 (set-time-zone-rule change-log-time-zone-rule
)
288 (format-time-string "%Y-%m-%d " now
)
289 (add-log-iso8601-time-zone now
)))
290 (set-time-zone-rule tz
)))
291 (format-time-string "%Y-%m-%d")))
293 (defun change-log-name ()
294 "Return (system-dependent) default name for a change log file."
295 (or change-log-default-name
296 (if (eq system-type
'vax-vms
)
300 (defun add-log-edit-prev-comment (arg)
301 "Cycle backward through Log-Edit mode comment history.
302 With a numeric prefix ARG, go back ARG comments."
305 (narrow-to-region (point)
306 (if (memq last-command
'(add-log-edit-prev-comment
307 add-log-edit-next-comment
))
309 (when (fboundp 'log-edit-previous-comment
)
310 (log-edit-previous-comment arg
)
311 (indent-region (point-min) (point-max))
312 (goto-char (point-min))
313 (unless (save-restriction (widen) (bolp))
314 (delete-region (point) (progn (skip-chars-forward " \t\n") (point))))
315 (set-mark (point-min))
316 (goto-char (point-max))
317 (delete-region (point) (progn (skip-chars-backward " \t\n") (point))))))
319 (defun add-log-edit-next-comment (arg)
320 "Cycle forward through Log-Edit mode comment history.
321 With a numeric prefix ARG, go back ARG comments."
323 (add-log-edit-prev-comment (- arg
)))
326 (defun prompt-for-change-log-name ()
327 "Prompt for a change log name."
328 (let* ((default (change-log-name))
329 (name (expand-file-name
330 (read-file-name (format "Log file (default %s): " default
)
332 ;; Handle something that is syntactically a directory name.
333 ;; Look for ChangeLog or whatever in that directory.
334 (if (string= (file-name-nondirectory name
) "")
335 (expand-file-name (file-name-nondirectory default
)
337 ;; Handle specifying a file that is a directory.
338 (if (file-directory-p name
)
339 (expand-file-name (file-name-nondirectory default
)
340 (file-name-as-directory name
))
343 (defun change-log-version-number-search ()
344 "Return version number of current buffer's file.
345 This is the value returned by `vc-workfile-version' or, if that is
346 nil, by matching `change-log-version-number-regexp-list'."
347 (let* ((size (buffer-size))
349 ;; The version number can be anywhere in the file, but
350 ;; restrict search to the file beginning: 10% should be
351 ;; enough to prevent some mishits.
353 ;; Apply percentage only if buffer size is bigger than
355 (if (> size
(* 100 80)) (+ (point) (/ size
10)))))
356 (or (and buffer-file-name
(vc-workfile-version buffer-file-name
))
359 (let ((regexps change-log-version-number-regexp-list
)
363 (goto-char (point-min))
364 (when (re-search-forward (pop regexps
) limit t
)
365 (setq version
(match-string 1)
371 (defun find-change-log (&optional file-name buffer-file
)
372 "Find a change log file for \\[add-change-log-entry] and return the name.
374 Optional arg FILE-NAME specifies the file to use.
375 If FILE-NAME is nil, use the value of `change-log-default-name'.
376 If 'change-log-default-name' is nil, behave as though it were 'ChangeLog'
377 \(or whatever we use on this operating system).
379 If 'change-log-default-name' contains a leading directory component, then
380 simply find it in the current directory. Otherwise, search in the current
381 directory and its successive parents for a file so named.
383 Once a file is found, `change-log-default-name' is set locally in the
384 current buffer to the complete file name.
385 Optional arg BUFFER-FILE overrides `buffer-file-name'."
386 ;; If user specified a file name or if this buffer knows which one to use,
389 (setq file-name
(and change-log-default-name
390 (file-name-directory change-log-default-name
)
391 change-log-default-name
))
393 ;; Chase links in the source file
394 ;; and use the change log in the dir where it points.
395 (setq file-name
(or (and (or buffer-file buffer-file-name
)
398 (or buffer-file buffer-file-name
))))
400 (if (file-directory-p file-name
)
401 (setq file-name
(expand-file-name (change-log-name) file-name
)))
402 ;; Chase links before visiting the file.
403 ;; This makes it easier to use a single change log file
404 ;; for several related directories.
405 (setq file-name
(file-chase-links file-name
))
406 (setq file-name
(expand-file-name file-name
))
407 ;; Move up in the dir hierarchy till we find a change log file.
408 (let ((file1 file-name
)
410 (while (and (not (or (get-file-buffer file1
) (file-exists-p file1
)))
411 (progn (setq parent-dir
414 (file-name-directory file1
))))
415 ;; Give up if we are already at the root dir.
416 (not (string= (file-name-directory file1
)
418 ;; Move up to the parent dir and try again.
419 (setq file1
(expand-file-name
420 (file-name-nondirectory (change-log-name))
422 ;; If we found a change log in a parent, use that.
423 (if (or (get-file-buffer file1
) (file-exists-p file1
))
424 (setq file-name file1
)))))
425 ;; Make a local variable in this buffer so we needn't search again.
426 (set (make-local-variable 'change-log-default-name
) file-name
)
429 (defun add-log-file-name (buffer-file log-file
)
430 ;; Never want to add a change log entry for the ChangeLog file itself.
431 (unless (or (null buffer-file
) (string= buffer-file log-file
))
432 (if add-log-file-name-function
433 (funcall add-log-file-name-function buffer-file
)
436 (concat "^" (regexp-quote (file-name-directory log-file
)))
438 (substring buffer-file
(match-end 0))
439 (file-name-nondirectory buffer-file
)))
440 ;; If we have a backup file, it's presumably because we're
441 ;; comparing old and new versions (e.g. for deleted
442 ;; functions) and we'll want to use the original name.
443 (if (backup-file-name-p buffer-file
)
444 (file-name-sans-versions buffer-file
)
448 (defun add-change-log-entry (&optional whoami file-name other-window new-entry
)
449 "Find change log file, and add an entry for today and an item for this file.
450 Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
451 name and email (stored in `add-log-full-name' and `add-log-mailing-address').
453 Second arg FILE-NAME is file name of the change log.
454 If nil, use the value of `change-log-default-name'.
456 Third arg OTHER-WINDOW non-nil means visit in other window.
458 Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
459 never append to an existing entry. Option `add-log-keep-changes-together'
460 otherwise affects whether a new entry is created.
462 Option `add-log-always-start-new-record' non-nil means always create a
463 new record, even when the last record was made on the same date and by
466 The change log file can start with a copyright notice and a copying
467 permission notice. The first blank line indicates the end of these
470 Today's date is calculated according to `change-log-time-zone-rule' if
471 non-nil, otherwise in local time."
472 (interactive (list current-prefix-arg
473 (prompt-for-change-log-name)))
474 (or add-log-full-name
475 (setq add-log-full-name
(user-full-name)))
476 (or add-log-mailing-address
477 (setq add-log-mailing-address user-mail-address
))
480 (setq add-log-full-name
(read-input "Full name: " add-log-full-name
))
481 ;; Note that some sites have room and phone number fields in
482 ;; full name which look silly when inserted. Rather than do
483 ;; anything about that here, let user give prefix argument so that
484 ;; s/he can edit the full name field in prompter if s/he wants.
485 (setq add-log-mailing-address
486 (read-input "Mailing address: " add-log-mailing-address
))))
488 (let* ((defun (add-log-current-defun))
489 (version (and change-log-version-info-enabled
490 (change-log-version-number-search)))
491 (buf-file-name (if add-log-buffer-file-name-function
492 (funcall add-log-buffer-file-name-function
)
494 (buffer-file (if buf-file-name
(expand-file-name buf-file-name
)))
495 (file-name (expand-file-name (find-change-log file-name buffer-file
)))
496 ;; Set ITEM to the file name to use in the new item.
497 (item (add-log-file-name buffer-file file-name
))
500 (unless (equal file-name buffer-file-name
)
501 (if (or other-window
(window-dedicated-p (selected-window)))
502 (find-file-other-window file-name
)
503 (find-file file-name
)))
504 (or (eq major-mode
'change-log-mode
)
507 (goto-char (point-min))
509 ;; If file starts with a copyright and permission notice, skip them.
510 ;; Assume they end at first blank line.
511 (when (looking-at "Copyright")
512 (search-forward "\n\n")
513 (skip-chars-forward "\n"))
515 ;; Advance into first entry if it is usable; else make new one.
516 (let ((new-entries (mapcar (lambda (addr)
517 (concat (funcall add-log-time-format
)
518 " " add-log-full-name
520 (if (consp add-log-mailing-address
)
521 add-log-mailing-address
522 (list add-log-mailing-address
)))))
523 (if (and (not add-log-always-start-new-record
)
525 (dolist (entry new-entries hit
)
526 (when (looking-at (regexp-quote entry
))
529 (insert (nth (random (length new-entries
))
534 ;; Determine where we should stop searching for a usable
535 ;; item to add to, within this entry.
538 (if (looking-at "\n*[^\n* \t]")
539 (skip-chars-forward "\n")
540 (if add-log-keep-changes-together
541 (forward-page) ; page delimits entries for date
542 (forward-paragraph))) ; paragraph delimits entries for file
545 ;; Now insert the new line for this item.
546 (cond ((re-search-forward "^\\s *\\*\\s *$" bound t
)
547 ;; Put this file name into the existing empty item.
550 ((and (not new-entry
)
551 (let (case-fold-search)
553 (concat (regexp-quote (concat "* " item
))
554 ;; Don't accept `foo.bar' when
555 ;; looking for `foo':
556 "\\(\\s \\|[(),:]\\)")
558 ;; Add to the existing item for the same file.
559 (re-search-forward "^\\s *$\\|^\\s \\*")
560 (goto-char (match-beginning 0))
561 ;; Delete excess empty lines; make just 2.
562 (while (and (not (eobp)) (looking-at "^\\s *$"))
563 (delete-region (point) (line-beginning-position 2)))
566 (indent-relative-maybe))
569 (while (looking-at "\\sW")
571 (while (and (not (eobp)) (looking-at "^\\s *$"))
572 (delete-region (point) (line-beginning-position 2)))
575 (indent-to left-margin
)
577 (if item
(insert item
))))
578 ;; Now insert the function name, if we have one.
579 ;; Point is at the item for this file,
580 ;; either at the end of the line or at the first blank line.
582 ;; No function name, so put in a colon unless we have just a star.
583 (unless (save-excursion
584 (beginning-of-line 1)
585 (looking-at "\\s *\\(\\*\\s *\\)?$"))
587 (if version
(insert version ?\
)))
588 ;; Make it easy to get rid of the function name.
590 (unless (save-excursion
591 (beginning-of-line 1)
592 (looking-at "\\s *$"))
594 ;; See if the prev function name has a message yet or not.
595 ;; If not, merge the two items.
596 (let ((pos (point-marker)))
597 (skip-syntax-backward " ")
598 (skip-chars-backward "):")
599 (if (and (looking-at "):")
600 (let ((pos (save-excursion (backward-sexp 1) (point))))
601 (when (equal (buffer-substring pos
(point)) defun
)
602 (delete-region pos
(point)))
603 (> fill-column
(+ (current-column) (length defun
) 4))))
604 (progn (skip-chars-backward ", ")
605 (delete-region (point) pos
)
606 (unless (memq (char-before) '(?\
()) (insert ", ")))
607 (if (looking-at "):")
608 (delete-region (+ 1 (point)) (line-end-position)))
611 (set-marker pos nil
))
613 (if version
(insert version ?\
)))))
616 (defun add-change-log-entry-other-window (&optional whoami file-name
)
617 "Find change log file in other window and add entry and item.
618 This is just like `add-change-log-entry' except that it displays
619 the change log file in another window."
620 (interactive (if current-prefix-arg
621 (list current-prefix-arg
622 (prompt-for-change-log-name))))
623 (add-change-log-entry whoami file-name t
))
624 ;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
626 (defvar add-log-indent-text
0)
628 (defun add-log-indent ()
632 (skip-chars-forward " \t")
634 ((and (looking-at "\\(.*\\) [^ \n].*[^ \n] <.*>$")
635 ;; Matching the output of add-log-time-format is difficult,
636 ;; but I'll get it has at least two adjacent digits.
637 (string-match "[[:digit:]][[:digit:]]" (match-string 1)))
639 ((looking-at "[^*(]")
640 (+ (current-left-margin) add-log-indent-text
))
641 (t (current-left-margin)))))
642 (pos (save-excursion (indent-line-to indent
) (point))))
643 (if (> pos
(point)) (goto-char pos
))))
646 (defvar smerge-resolve-function
)
649 (define-derived-mode change-log-mode text-mode
"Change Log"
650 "Major mode for editing change logs; like Indented Text Mode.
651 Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
652 New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
653 Each entry behaves as a paragraph, and the entries for one day as a page.
654 Runs `change-log-mode-hook'.
655 \\{change-log-mode-map}"
660 (set (make-local-variable 'fill-paragraph-function
)
661 'change-log-fill-paragraph
)
662 (set (make-local-variable 'indent-line-function
) 'add-log-indent
)
663 (set (make-local-variable 'tab-always-indent
) nil
)
664 ;; We really do want "^" in paragraph-start below: it is only the
665 ;; lines that begin at column 0 (despite the left-margin of 8) that
666 ;; we are looking for. Adding `* ' allows eliding the blank line
667 ;; between entries for different files.
668 (set (make-local-variable 'paragraph-start
) "\\s *$\\|\f\\|^\\<")
669 (set (make-local-variable 'paragraph-separate
) paragraph-start
)
670 ;; Match null string on the date-line so that the date-line
671 ;; is grouped with what follows.
672 (set (make-local-variable 'page-delimiter
) "^\\<\\|^\f")
673 (set (make-local-variable 'version-control
) 'never
)
674 (set (make-local-variable 'smerge-resolve-function
)
675 'change-log-resolve-conflict
)
676 (set (make-local-variable 'adaptive-fill-regexp
) "\\s *")
677 (set (make-local-variable 'font-lock-defaults
)
678 '(change-log-font-lock-keywords t nil nil backward-paragraph
)))
680 ;; It might be nice to have a general feature to replace this. The idea I
681 ;; have is a variable giving a regexp matching text which should not be
682 ;; moved from bol by filling. change-log-mode would set this to "^\\s *\\s(".
683 ;; But I don't feel up to implementing that today.
684 (defun change-log-fill-paragraph (&optional justify
)
685 "Fill the paragraph, but preserve open parentheses at beginning of lines.
686 Prefix arg means justify as well."
688 (let ((end (progn (forward-paragraph) (point)))
689 (beg (progn (backward-paragraph) (point)))
690 (paragraph-start (concat paragraph-start
"\\|\\s *\\s(")))
691 (fill-region beg end justify
)
694 (defcustom add-log-current-defun-header-regexp
695 "^\\([[:upper:]][[:upper:]_ ]*[[:upper:]_]\\|[-_[:alpha:]]+\\)[ \t]*[:=]"
696 "*Heuristic regexp used by `add-log-current-defun' for unknown major modes."
701 (defvar add-log-lisp-like-modes
702 '(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode
)
703 "*Modes that look like Lisp to `add-log-current-defun'.")
706 (defvar add-log-c-like-modes
707 '(c-mode c
++-mode c
++-c-mode objc-mode
)
708 "*Modes that look like C to `add-log-current-defun'.")
711 (defvar add-log-tex-like-modes
712 '(TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode
)
713 "*Modes that look like TeX to `add-log-current-defun'.")
716 (defun add-log-current-defun ()
717 "Return name of function definition point is in, or nil.
719 Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
720 Texinfo (@node titles) and Perl.
722 Other modes are handled by a heuristic that looks in the 10K before
723 point for uppercase headings starting in the first column or
724 identifiers followed by `:' or `='. See variables
725 `add-log-current-defun-header-regexp' and
726 `add-log-current-defun-function'.
728 Has a preference of looking backwards."
731 (let ((location (point)))
732 (cond (add-log-current-defun-function
733 (funcall add-log-current-defun-function
))
734 ((memq major-mode add-log-lisp-like-modes
)
735 ;; If we are now precisely at the beginning of a defun,
736 ;; make sure beginning-of-defun finds that one
737 ;; rather than the previous one.
738 (or (eobp) (forward-char 1))
740 ;; Make sure we are really inside the defun found,
742 (when (and (looking-at "\\s(")
743 (progn (end-of-defun)
744 (< location
(point)))
745 (progn (forward-sexp -
1)
746 (>= location
(point))))
747 (if (looking-at "\\s(")
749 ;; Skip the defining construct name, typically "defun"
752 ;; The second element is usually a symbol being defined.
753 ;; If it is not, use the first symbol in it.
754 (skip-chars-forward " \t\n'(")
755 (buffer-substring-no-properties (point)
756 (progn (forward-sexp 1)
758 ((and (memq major-mode add-log-c-like-modes
)
761 ;; Use eq instead of = here to avoid
762 ;; error when at bob and char-after
764 (while (eq (char-after (- (point) 2)) ?
\\)
766 (looking-at "[ \t]*#[ \t]*define[ \t]")))
767 ;; Handle a C macro definition.
769 (while (eq (char-after (- (point) 2)) ?
\\) ;not =; note above
771 (search-forward "define")
772 (skip-chars-forward " \t")
773 (buffer-substring-no-properties (point)
774 (progn (forward-sexp 1)
776 ((memq major-mode add-log-c-like-modes
)
778 ;; See if we are in the beginning part of a function,
779 ;; before the open brace. If so, advance forward.
780 (while (not (looking-at "{\\|\\(\\s *$\\)"))
785 (when (progn (end-of-defun)
786 (< location
(point)))
791 ;; Skip back over typedefs of arglist.
792 (while (and (not (bobp))
793 (looking-at "[ \t\n]"))
795 ;; See if this is using the DEFUN macro used in Emacs,
796 ;; or the DEFUN macro used by the C library.
797 (if (condition-case nil
800 (while (= (preceding-char) ?
\\)
805 (looking-at "DEFUN\\b"))
811 (if (= (char-after (point)) ?
\")
814 (skip-chars-forward " ,")))
815 (buffer-substring-no-properties
817 (progn (forward-sexp 1)
819 (if (looking-at "^[+-]")
820 (change-log-get-method-definition)
821 ;; Ordinary C function syntax.
824 ;; Protect against "Unbalanced parens" error.
827 (down-list 1) ; into arglist
829 (skip-chars-backward " \t")
832 ;; Verify initial pos was after
833 ;; real start of function.
836 ;; For this purpose, include the line
837 ;; that has the decl keywords. This
838 ;; may also include some of the
839 ;; comments before the function.
840 (while (and (not (bobp))
843 (looking-at "[^\n\f]")))
845 (>= location
(point)))
846 ;; Consistency check: going down and up
847 ;; shouldn't take us back before BEG.
850 ;; Don't include any final whitespace
851 ;; in the name we use.
852 (skip-chars-backward " \t\n")
855 ;; Now find the right beginning of the name.
856 ;; Include certain keywords if they
858 (setq middle
(point))
860 ;; Ignore these subparts of a class decl
861 ;; and move back to the class name itself.
862 (while (looking-at "public \\|private ")
863 (skip-chars-backward " \t:")
866 (setq middle
(point))
870 "enum \\|struct \\|union \\|class ")
871 (setq middle
(point)))
873 (when (eq (preceding-char) ?
=)
875 (skip-chars-backward " \t")
877 (buffer-substring-no-properties
879 ((memq major-mode add-log-tex-like-modes
)
880 (if (re-search-backward
881 "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)"
884 (goto-char (match-beginning 0))
885 (buffer-substring-no-properties
886 (1+ (point)) ; without initial backslash
887 (line-end-position)))))
888 ((eq major-mode
'texinfo-mode
)
889 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t
)
890 (match-string-no-properties 1)))
891 ((memq major-mode
'(perl-mode cperl-mode
))
892 (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t
)
893 (match-string-no-properties 1)))
894 ;; Emacs's autoconf-mode installs its own
895 ;; `add-log-current-defun-function'. This applies to
896 ;; a different mode apparently for editing .m4
898 ((eq major-mode
'autoconf-mode
)
899 (if (re-search-backward
900 "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t
)
901 (match-string-no-properties 3)))
903 ;; If all else fails, try heuristics
904 (let (case-fold-search
907 (when (re-search-backward
908 add-log-current-defun-header-regexp
911 (setq result
(or (match-string-no-properties 1)
912 (match-string-no-properties 0)))
913 ;; Strip whitespace away
914 (when (string-match "\\([^ \t\n\r\f].*[^ \t\n\r\f]\\)"
916 (setq result
(match-string-no-properties 1 result
)))
920 (defvar change-log-get-method-definition-md
)
922 ;; Subroutine used within change-log-get-method-definition.
923 ;; Add the last match in the buffer to the end of `md',
924 ;; followed by the string END; move to the end of that match.
925 (defun change-log-get-method-definition-1 (end)
926 (setq change-log-get-method-definition-md
927 (concat change-log-get-method-definition-md
930 (goto-char (match-end 0)))
932 (defun change-log-get-method-definition ()
933 "For objective C, return the method name if we are in a method."
934 (let ((change-log-get-method-definition-md "["))
936 (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t
)
937 (change-log-get-method-definition-1 " ")))
940 ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t
)
941 (change-log-get-method-definition-1 "")
942 (while (not (looking-at "[{;]"))
944 "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*")
945 (change-log-get-method-definition-1 ""))
946 (concat change-log-get-method-definition-md
"]"))))))
948 (defun change-log-sortable-date-at ()
949 "Return date of log entry in a consistent form for sorting.
950 Point is assumed to be at the start of the entry."
952 (if (looking-at "^\\sw.........[0-9:+ ]*")
953 (let ((date (match-string-no-properties 0)))
955 (if (string-match "\\(....\\)-\\(..\\)-\\(..\\)\\s-+" date
)
956 (concat (match-string 1 date
) (match-string 2 date
)
957 (match-string 3 date
))
959 (timezone-make-date-sortable date
)
963 (defun change-log-resolve-conflict ()
964 "Function to be used in `smerge-resolve-function'."
965 (let ((buf (current-buffer)))
967 (insert-buffer-substring buf
(match-beginning 1) (match-end 1))
968 (save-match-data (change-log-mode))
969 (let ((other-buf (current-buffer)))
970 (with-current-buffer buf
973 (narrow-to-region (match-beginning 0) (match-end 0))
974 (replace-match (match-string 3) t t
)
975 (change-log-merge other-buf
))))))))
978 (defun change-log-merge (other-log)
979 "Merge the contents of ChangeLog file OTHER-LOG with this buffer.
980 Both must be found in Change Log mode (since the merging depends on
981 the appropriate motion commands). OTHER-LOG can be either a file name
984 Entries are inserted in chronological order. Both the current and
985 old-style time formats for entries are supported."
986 (interactive "*fLog file name to merge: ")
987 (if (not (eq major-mode
'change-log-mode
))
988 (error "Not in Change Log mode"))
989 (let ((other-buf (if (bufferp other-log
) other-log
990 (find-file-noselect other-log
)))
991 (buf (current-buffer))
994 (goto-char (point-min))
995 (set-buffer other-buf
)
996 (goto-char (point-min))
997 (if (not (eq major-mode
'change-log-mode
))
998 (error "%s not found in Change Log mode" other-log
))
999 ;; Loop through all the entries in OTHER-LOG.
1001 (setq date1
(change-log-sortable-date-at))
1003 end
(progn (forward-page) (point)))
1004 ;; Look for an entry in original buffer that isn't later.
1005 (with-current-buffer buf
1006 (while (and (not (eobp))
1007 (string< date1
(change-log-sortable-date-at)))
1010 (insert-buffer-substring other-buf start end
)
1011 ;; At the end of the original buffer, insert a newline to
1012 ;; separate entries and then the rest of the file being
1015 (and (= ?
\n (char-before))
1016 (or (<= (1- (point)) (point-min))
1017 (= ?
\n (char-before (1- (point)))))))
1019 ;; Move to the end of it to terminate outer loop.
1020 (with-current-buffer other-buf
1021 (goto-char (point-max)))
1022 (insert-buffer-substring other-buf start
)))))))
1025 (defun change-log-redate ()
1026 "Fix any old-style date entries in the current log file to default format."
1030 (goto-char (point-min))
1031 (while (re-search-forward "^\\sw.........[0-9:+ ]*" nil t
)
1032 (unless (= 12 (- (match-end 0) (match-beginning 0)))
1033 (let* ((date (save-match-data
1034 (timezone-fix-time (match-string 0) nil nil
)))
1035 (zone (if (consp (aref date
6))
1036 (nth 1 (aref date
6)))))
1037 (replace-match (format-time-string
1039 (encode-time (aref date
5)
1049 ;;; arch-tag: 81eee6fc-088f-4372-a37f-80ad9620e762
1050 ;;; add-log.el ends here