diff options
Diffstat (limited to 'lisp/add-log.el')
| -rw-r--r-- | lisp/add-log.el | 389 |
1 files changed, 253 insertions, 136 deletions
diff --git a/lisp/add-log.el b/lisp/add-log.el index e492077e7ef..a52aa519819 100644 --- a/lisp/add-log.el +++ b/lisp/add-log.el @@ -27,6 +27,15 @@ ;; This facility is documented in the Emacs Manual. +;; Todo: + +;; - Find/use/create _MTN/log if there's a _MTN directory. +;; - Find/use/create ++log.* if there's an {arch} directory. +;; - Use an open *VC-Log* or *cvs-commit* buffer if it's related to the +;; source file. +;; - Don't add TAB indents (and username?) if inserting entries in those +;; special places. + ;;; Code: (eval-when-compile @@ -41,7 +50,7 @@ (defcustom change-log-default-name nil - "*Name of a change log file for \\[add-change-log-entry]." + "Name of a change log file for \\[add-change-log-entry]." :type '(choice (const :tag "default" nil) string) :group 'change-log) @@ -55,7 +64,7 @@ ;; Many modes set this variable, so avoid warnings. ;;;###autoload (defcustom add-log-current-defun-function nil - "*If non-nil, function to guess name of surrounding function. + "If non-nil, function to guess name of surrounding function. It is used by `add-log-current-defun' in preference to built-in rules. Returns function's name as a string, or nil if outside a function." :type '(choice (const nil) function) @@ -63,7 +72,7 @@ Returns function's name as a string, or nil if outside a function." ;;;###autoload (defcustom add-log-full-name nil - "*Full name of user, for inclusion in ChangeLog daily headers. + "Full name of user, for inclusion in ChangeLog daily headers. This defaults to the value returned by the function `user-full-name'." :type '(choice (const :tag "Default" nil) string) @@ -148,7 +157,7 @@ use the file's name relative to the directory of the change log file." (defcustom change-log-version-info-enabled nil - "*If non-nil, enable recording version numbers with the changes." + "If non-nil, enable recording version numbers with the changes." :version "21.1" :type 'boolean :group 'change-log) @@ -160,7 +169,7 @@ use the file's name relative to the directory of the change log file." (concat "^(def[^ \t\n]+[ \t]+[^ \t\n][ \t]\"" re) ;; Revision: pcl-cvs.el,v 1.72 1999/09/05 20:21:54 monnier Exp (concat "^;+ *Revision: +[^ \t\n]+[ \t]+" re))) - "*List of regexps to search for version number. + "List of regexps to search for version number. The version number must be in group 1. Note: The search is conducted only within 10%, at the beginning of the file." :version "21.1" @@ -370,7 +379,7 @@ With a numeric prefix ARG, go back ARG comments." (defun change-log-version-number-search () "Return version number of current buffer's file. -This is the value returned by `vc-workfile-version' or, if that is +This is the value returned by `vc-working-revision' or, if that is nil, by matching `change-log-version-number-regexp-list'." (let* ((size (buffer-size)) (limit @@ -381,7 +390,7 @@ nil, by matching `change-log-version-number-regexp-list'." ;; Apply percentage only if buffer size is bigger than ;; approx 100 lines. (if (> size (* 100 80)) (+ (point) (/ size 10))))) - (or (and buffer-file-name (vc-workfile-version buffer-file-name)) + (or (and buffer-file-name (vc-working-revision buffer-file-name)) (save-restriction (widen) (let ((regexps change-log-version-number-regexp-list) @@ -460,11 +469,7 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'." (if add-log-file-name-function (funcall add-log-file-name-function buffer-file) (setq buffer-file - (if (string-match - (concat "^" (regexp-quote (file-name-directory log-file))) - buffer-file) - (substring buffer-file (match-end 0)) - (file-name-nondirectory buffer-file))) + (file-relative-name buffer-file (file-name-directory log-file))) ;; If we have a backup file, it's presumably because we're ;; comparing old and new versions (e.g. for deleted ;; functions) and we'll want to use the original name. @@ -508,117 +513,111 @@ non-nil, otherwise in local time." (buffer-file (if buf-file-name (expand-file-name buf-file-name))) (file-name (expand-file-name (find-change-log file-name buffer-file))) ;; Set ITEM to the file name to use in the new item. - (item (add-log-file-name buffer-file file-name)) - bound full-name mailing-address) - - (if whoami - (progn - (setq full-name (read-string "Full name: " - (or add-log-full-name (user-full-name)))) - ;; Note that some sites have room and phone number fields in - ;; full name which look silly when inserted. Rather than do - ;; anything about that here, let user give prefix argument so that - ;; s/he can edit the full name field in prompter if s/he wants. - (setq mailing-address - (read-string "Mailing address: " - (or add-log-mailing-address user-mail-address))))) + (item (add-log-file-name buffer-file file-name))) (unless (equal file-name buffer-file-name) (if (or other-window (window-dedicated-p (selected-window))) (find-file-other-window file-name) (find-file file-name))) - (or (eq major-mode 'change-log-mode) + (or (derived-mode-p 'change-log-mode) (change-log-mode)) (undo-boundary) (goto-char (point-min)) - (or full-name - (setq full-name (or add-log-full-name (user-full-name)))) - (or mailing-address - (setq mailing-address (or add-log-mailing-address user-mail-address))) - - ;; If file starts with a copyright and permission notice, skip them. - ;; Assume they end at first blank line. - (when (looking-at "Copyright") - (search-forward "\n\n") - (skip-chars-forward "\n")) - - ;; Advance into first entry if it is usable; else make new one. - (let ((new-entries - (mapcar (lambda (addr) - (concat - (if (stringp add-log-time-zone-rule) - (let ((tz (getenv "TZ"))) - (unwind-protect - (progn - (set-time-zone-rule add-log-time-zone-rule) - (funcall add-log-time-format)) - (set-time-zone-rule tz))) - (funcall add-log-time-format)) - " " full-name - " <" addr ">")) - (if (consp mailing-address) - mailing-address - (list mailing-address))))) - (if (and (not add-log-always-start-new-record) - (let ((hit nil)) - (dolist (entry new-entries hit) - (when (looking-at (regexp-quote entry)) - (setq hit t))))) - (forward-line 1) - (insert (nth (random (length new-entries)) - new-entries) - (if use-hard-newlines hard-newline "\n") - (if use-hard-newlines hard-newline "\n")) - (forward-line -1))) + (let ((full-name (or add-log-full-name (user-full-name))) + (mailing-address (or add-log-mailing-address user-mail-address))) + + (when whoami + (setq full-name (read-string "Full name: " full-name)) + ;; Note that some sites have room and phone number fields in + ;; full name which look silly when inserted. Rather than do + ;; anything about that here, let user give prefix argument so that + ;; s/he can edit the full name field in prompter if s/he wants. + (setq mailing-address + (read-string "Mailing address: " mailing-address))) + + ;; If file starts with a copyright and permission notice, skip them. + ;; Assume they end at first blank line. + (when (looking-at "Copyright") + (search-forward "\n\n") + (skip-chars-forward "\n")) + + ;; Advance into first entry if it is usable; else make new one. + (let ((new-entries + (mapcar (lambda (addr) + (concat + (if (stringp add-log-time-zone-rule) + (let ((tz (getenv "TZ"))) + (unwind-protect + (progn + (set-time-zone-rule add-log-time-zone-rule) + (funcall add-log-time-format)) + (set-time-zone-rule tz))) + (funcall add-log-time-format)) + " " full-name + " <" addr ">")) + (if (consp mailing-address) + mailing-address + (list mailing-address))))) + (if (and (not add-log-always-start-new-record) + (let ((hit nil)) + (dolist (entry new-entries hit) + (when (looking-at (regexp-quote entry)) + (setq hit t))))) + (forward-line 1) + (insert (nth (random (length new-entries)) + new-entries) + (if use-hard-newlines hard-newline "\n") + (if use-hard-newlines hard-newline "\n")) + (forward-line -1)))) ;; Determine where we should stop searching for a usable ;; item to add to, within this entry. - (setq bound - (save-excursion - (if (looking-at "\n*[^\n* \t]") - (skip-chars-forward "\n") - (if add-log-keep-changes-together - (forward-page) ; page delimits entries for date - (forward-paragraph))) ; paragraph delimits entries for file - (point))) - - ;; Now insert the new line for this item. - (cond ((re-search-forward "^\\s *\\*\\s *$" bound t) - ;; Put this file name into the existing empty item. - (if item - (insert item))) - ((and (not new-entry) - (let (case-fold-search) - (re-search-forward - (concat (regexp-quote (concat "* " item)) - ;; Don't accept `foo.bar' when - ;; looking for `foo': - "\\(\\s \\|[(),:]\\)") - bound t))) - ;; Add to the existing item for the same file. - (re-search-forward "^\\s *$\\|^\\s \\*") - (goto-char (match-beginning 0)) - ;; Delete excess empty lines; make just 2. - (while (and (not (eobp)) (looking-at "^\\s *$")) - (delete-region (point) (line-beginning-position 2))) - (insert (if use-hard-newlines hard-newline "\n") - (if use-hard-newlines hard-newline "\n")) - (forward-line -2) - (indent-relative-maybe)) - (t - ;; Make a new item. - (while (looking-at "\\sW") - (forward-line 1)) - (while (and (not (eobp)) (looking-at "^\\s *$")) - (delete-region (point) (line-beginning-position 2))) - (insert (if use-hard-newlines hard-newline "\n") - (if use-hard-newlines hard-newline "\n") - (if use-hard-newlines hard-newline "\n")) - (forward-line -2) - (indent-to left-margin) - (insert "* ") - (if item (insert item)))) + (let ((bound + (save-excursion + (if (looking-at "\n*[^\n* \t]") + (skip-chars-forward "\n") + (if add-log-keep-changes-together + (forward-page) ; page delimits entries for date + (forward-paragraph))) ; paragraph delimits entries for file + (point)))) + + ;; Now insert the new line for this item. + (cond ((re-search-forward "^\\s *\\*\\s *$" bound t) + ;; Put this file name into the existing empty item. + (if item + (insert item))) + ((and (not new-entry) + (let (case-fold-search) + (re-search-forward + (concat (regexp-quote (concat "* " item)) + ;; Don't accept `foo.bar' when + ;; looking for `foo': + "\\(\\s \\|[(),:]\\)") + bound t))) + ;; Add to the existing item for the same file. + (re-search-forward "^\\s *$\\|^\\s \\*") + (goto-char (match-beginning 0)) + ;; Delete excess empty lines; make just 2. + (while (and (not (eobp)) (looking-at "^\\s *$")) + (delete-region (point) (line-beginning-position 2))) + (insert (if use-hard-newlines hard-newline "\n") + (if use-hard-newlines hard-newline "\n")) + (forward-line -2) + (indent-relative-maybe)) + (t + ;; Make a new item. + (while (looking-at "\\sW") + (forward-line 1)) + (while (and (not (eobp)) (looking-at "^\\s *$")) + (delete-region (point) (line-beginning-position 2))) + (insert (if use-hard-newlines hard-newline "\n") + (if use-hard-newlines hard-newline "\n") + (if use-hard-newlines hard-newline "\n")) + (forward-line -2) + (indent-to left-margin) + (insert "* ") + (if item (insert item))))) ;; Now insert the function name, if we have one. ;; Point is at the item for this file, ;; either at the end of the line or at the first blank line. @@ -666,9 +665,45 @@ the change log file in another window." (prompt-for-change-log-name)))) (add-change-log-entry whoami file-name t)) + (defvar change-log-indent-text 0) +(defun change-log-fill-parenthesized-list () + ;; Fill parenthesized lists of names according to GNU standards. + ;; * file-name.ext (very-long-foo, very-long-bar, very-long-foobar): + ;; should be filled as + ;; * file-name.ext (very-long-foo, very-long-bar) + ;; (very-long-foobar): + (save-excursion + (end-of-line 0) + (skip-chars-backward " \t") + (when (and (equal (char-before) ?\,) + (> (point) (1+ (point-min)))) + (condition-case nil + (when (save-excursion + (and (prog2 + (up-list -1) + (equal (char-after) ?\() + (skip-chars-backward " \t")) + (or (bolp) + ;; Skip everything but a whitespace or asterisk. + (and (not (zerop (skip-chars-backward "^ \t\n*"))) + (skip-chars-backward " \t") + ;; We want one asterisk here. + (= (skip-chars-backward "*") -1) + (skip-chars-backward " \t") + (bolp))))) + ;; Delete the comma. + (delete-char -1) + ;; Close list on previous line. + (insert ")") + (skip-chars-forward " \t\n") + ;; Start list on new line. + (insert-before-markers "(")) + (error nil))))) + (defun change-log-indent () + (change-log-fill-parenthesized-list) (let* ((indent (save-excursion (beginning-of-line) @@ -699,9 +734,15 @@ Runs `change-log-mode-hook'. (setq left-margin 8 fill-column 74 indent-tabs-mode t - tab-width 8) + tab-width 8 + show-trailing-whitespace t) (set (make-local-variable 'fill-paragraph-function) 'change-log-fill-paragraph) + ;; Avoid that filling leaves behind a single "*" on a line. + (add-hook 'fill-nobreak-predicate + '(lambda () + (looking-back "^\\s *\\*\\s *" (line-beginning-position))) + nil t) (set (make-local-variable 'indent-line-function) 'change-log-indent) (set (make-local-variable 'tab-always-indent) nil) ;; We really do want "^" in paragraph-start below: it is only the @@ -718,7 +759,33 @@ Runs `change-log-mode-hook'. 'change-log-resolve-conflict) (set (make-local-variable 'adaptive-fill-regexp) "\\s *") (set (make-local-variable 'font-lock-defaults) - '(change-log-font-lock-keywords t nil nil backward-paragraph))) + '(change-log-font-lock-keywords t nil nil backward-paragraph)) + (set (make-local-variable 'isearch-buffers-next-buffer-function) + 'change-log-next-buffer) + (set (make-local-variable 'beginning-of-defun-function) + 'change-log-beginning-of-defun) + (set (make-local-variable 'end-of-defun-function) + 'change-log-end-of-defun) + (isearch-buffers-minor-mode)) + +(defun change-log-next-buffer (&optional buffer wrap) + "Return the next buffer in the series of ChangeLog file buffers. +This function is used for multiple buffers isearch. +A sequence of buffers is formed by ChangeLog files with decreasing +numeric file name suffixes in the directory of the initial ChangeLog +file were isearch was started." + (let* ((name (change-log-name)) + (files (cons name (sort (file-expand-wildcards + (concat name "[-.][0-9]*")) + (lambda (a b) + (version< (substring b (length name)) + (substring a (length name))))))) + (files (if isearch-forward files (reverse files)))) + (find-file-noselect + (if wrap + (car files) + (cadr (member (file-name-nondirectory (buffer-file-name buffer)) + files)))))) ;; It might be nice to have a general feature to replace this. The idea I ;; have is a variable giving a regexp matching text which should not be @@ -730,7 +797,11 @@ Prefix arg means justify as well." (interactive "P") (let ((end (progn (forward-paragraph) (point))) (beg (progn (backward-paragraph) (point))) - (paragraph-start (concat paragraph-start "\\|\\s *\\s("))) + ;; Add lines starting with whitespace followed by a left paren or an + ;; asterisk. + (paragraph-start (concat paragraph-start "\\|\\s *\\(?:\\s(\\|\\*\\)")) + ;; Make sure we call `change-log-indent'. + (fill-indent-according-to-mode t)) (fill-region beg end justify) t)) @@ -752,9 +823,12 @@ Prefix arg means justify as well." ;;;###autoload (defvar add-log-tex-like-modes - '(TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode) + '(TeX-mode plain-TeX-mode LaTeX-mode tex-mode) "*Modes that look like TeX to `add-log-current-defun'.") +(declare-function c-beginning-of-defun "cc-cmds" (&optional arg)) +(declare-function c-end-of-defun "cc-cmds" (&optional arg)) + ;;;###autoload (defun add-log-current-defun () "Return name of function definition point is in, or nil. @@ -774,7 +848,7 @@ Has a preference of looking backwards." (let ((location (point))) (cond (add-log-current-defun-function (funcall add-log-current-defun-function)) - ((memq major-mode add-log-lisp-like-modes) + ((apply 'derived-mode-p add-log-lisp-like-modes) ;; If we are now precisely at the beginning of a defun, ;; make sure beginning-of-defun finds that one ;; rather than the previous one. @@ -798,7 +872,7 @@ Has a preference of looking backwards." (buffer-substring-no-properties (point) (progn (forward-sexp 1) (point))))) - ((and (memq major-mode add-log-c-like-modes) + ((and (apply 'derived-mode-p add-log-c-like-modes) (save-excursion (beginning-of-line) ;; Use eq instead of = here to avoid @@ -816,7 +890,7 @@ Has a preference of looking backwards." (buffer-substring-no-properties (point) (progn (forward-sexp 1) (point)))) - ((memq major-mode add-log-c-like-modes) + ((apply 'derived-mode-p add-log-c-like-modes) ;; See whether the point is inside a defun. (let (having-previous-defun having-next-defun @@ -958,7 +1032,7 @@ Has a preference of looking backwards." (setq end (point))) (buffer-substring-no-properties middle end))))))))) - ((memq major-mode add-log-tex-like-modes) + ((apply 'derived-mode-p add-log-tex-like-modes) (if (re-search-backward "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t) @@ -967,17 +1041,17 @@ Has a preference of looking backwards." (buffer-substring-no-properties (1+ (point)) ; without initial backslash (line-end-position))))) - ((eq major-mode 'texinfo-mode) + ((derived-mode-p 'texinfo-mode) (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t) (match-string-no-properties 1))) - ((memq major-mode '(perl-mode cperl-mode)) + ((derived-mode-p 'perl-mode 'cperl-mode) (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t) (match-string-no-properties 1))) ;; Emacs's autoconf-mode installs its own ;; `add-log-current-defun-function'. This applies to ;; a different mode apparently for editing .m4 ;; autoconf source. - ((eq major-mode 'autoconf-mode) + ((derived-mode-p 'autoconf-mode) (if (re-search-backward "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t) (match-string-no-properties 3))) @@ -1027,11 +1101,13 @@ Has a preference of looking backwards." (change-log-get-method-definition-1 "")) (concat change-log-get-method-definition-md "]")))))) +(defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*") + (defun change-log-sortable-date-at () "Return date of log entry in a consistent form for sorting. Point is assumed to be at the start of the entry." (require 'timezone) - (if (looking-at "^\\sw.........[0-9:+ ]*") + (if (looking-at change-log-start-entry-re) (let ((date (match-string-no-properties 0))) (if date (if (string-match "\\(....\\)-\\(..\\)-\\(..\\)\\s-+" date) @@ -1044,17 +1120,32 @@ Point is assumed to be at the start of the entry." (defun change-log-resolve-conflict () "Function to be used in `smerge-resolve-function'." - (let ((buf (current-buffer))) - (with-temp-buffer - (insert-buffer-substring buf (match-beginning 1) (match-end 1)) - (save-match-data (change-log-mode)) - (let ((other-buf (current-buffer))) - (with-current-buffer buf - (save-excursion - (save-restriction - (narrow-to-region (match-beginning 0) (match-end 0)) - (replace-match (match-string 3) t t) - (change-log-merge other-buf)))))))) + (save-excursion + (save-restriction + (narrow-to-region (match-beginning 0) (match-end 0)) + (let ((mb1 (match-beginning 1)) + (me1 (match-end 1)) + (mb3 (match-beginning 3)) + (me3 (match-end 3)) + (tmp1 (generate-new-buffer " *changelog-resolve-1*")) + (tmp2 (generate-new-buffer " *changelog-resolve-2*"))) + (unwind-protect + (let ((buf (current-buffer))) + (with-current-buffer tmp1 + (change-log-mode) + (insert-buffer-substring buf mb1 me1)) + (with-current-buffer tmp2 + (change-log-mode) + (insert-buffer-substring buf mb3 me3) + ;; Do the merge here instead of inside `buf' so as to be + ;; more robust in case change-log-merge fails. + (change-log-merge tmp1)) + (goto-char (point-max)) + (delete-region (point-min) + (prog1 (point) + (insert-buffer-substring tmp2)))) + (kill-buffer tmp1) + (kill-buffer tmp2)))))) ;;;###autoload (defun change-log-merge (other-log) @@ -1066,7 +1157,7 @@ or a buffer. Entries are inserted in chronological order. Both the current and old-style time formats for entries are supported." (interactive "*fLog file name to merge: ") - (if (not (eq major-mode 'change-log-mode)) + (if (not (derived-mode-p 'change-log-mode)) (error "Not in Change Log mode")) (let ((other-buf (if (bufferp other-log) other-log (find-file-noselect other-log))) @@ -1076,7 +1167,7 @@ old-style time formats for entries are supported." (goto-char (point-min)) (set-buffer other-buf) (goto-char (point-min)) - (if (not (eq major-mode 'change-log-mode)) + (if (not (derived-mode-p 'change-log-mode)) (error "%s not found in Change Log mode" other-log)) ;; Loop through all the entries in OTHER-LOG. (while (not (eobp)) @@ -1103,6 +1194,32 @@ old-style time formats for entries are supported." (goto-char (point-max))) (insert-buffer-substring other-buf start))))))) +(defun change-log-beginning-of-defun () + (re-search-backward change-log-start-entry-re nil 'move)) + +(defun change-log-end-of-defun () + ;; Look back and if there is no entry there it means we are before + ;; the first ChangeLog entry, so go forward until finding one. + (unless (save-excursion (re-search-backward change-log-start-entry-re nil t)) + (re-search-forward change-log-start-entry-re nil t)) + + ;; In case we are at the end of log entry going forward a line will + ;; make us find the next entry when searching. If we are inside of + ;; an entry going forward a line will still keep the point inside + ;; the same entry. + (forward-line 1) + + ;; In case we are at the beginning of an entry, move past it. + (when (looking-at change-log-start-entry-re) + (goto-char (match-end 0)) + (forward-line 1)) + + ;; Search for the start of the next log entry. Go to the end of the + ;; buffer if we could not find a next entry. + (when (re-search-forward change-log-start-entry-re nil 'move) + (goto-char (match-beginning 0)) + (forward-line -1))) + (provide 'add-log) ;; arch-tag: 81eee6fc-088f-4372-a37f-80ad9620e762 |