X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6652b0bc0ab3eb055f64f819fdb3c2329d7400b3..96794d2f97cd064e4c2bf4f71459b42558cc8c79:/lisp/vc/log-edit.el diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 4ef2732382..d59549772c 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -1,6 +1,6 @@ ;;; log-edit.el --- Major mode for editing CVS commit messages -*- lexical-binding: t -*- -;; Copyright (C) 1999-2012 Free Software Foundation, Inc. +;; Copyright (C) 1999-2015 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: pcl-cvs cvs commit log vc @@ -29,10 +29,10 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'add-log) ; for all the ChangeLog goodies (require 'pcvs-util) (require 'ring) +(require 'message) ;;;; ;;;; Global Variables @@ -56,6 +56,8 @@ ("\C-c\C-a" . log-edit-insert-changelog) ("\C-c\C-d" . log-edit-show-diff) ("\C-c\C-f" . log-edit-show-files) + ("\C-c\C-k" . log-edit-kill-buffer) + ("\C-a" . log-edit-beginning-of-line) ("\M-n" . log-edit-next-comment) ("\M-p" . log-edit-previous-comment) ("\M-r" . log-edit-comment-search-backward) @@ -105,13 +107,7 @@ If 'changed, only request confirmation if the list of files has :group 'log-edit :type 'boolean) -(defvar cvs-commit-buffer-require-final-newline t) -(make-obsolete-variable 'cvs-commit-buffer-require-final-newline - 'log-edit-require-final-newline - "21.1") - -(defcustom log-edit-require-final-newline - cvs-commit-buffer-require-final-newline +(defcustom log-edit-require-final-newline t "Enforce a newline at the end of commit log messages. Enforce it silently if t, query if non-nil and don't do anything if nil." :group 'log-edit @@ -123,15 +119,29 @@ If SETUP is 'force, this variable has no effect." :group 'log-edit :type 'boolean) -(defcustom log-edit-hook '(log-edit-insert-cvs-template - log-edit-show-files - log-edit-insert-changelog) +(defcustom log-edit-setup-add-author nil + "Non-nil means `log-edit' may add the `Author:' header. +This applies when its SETUP argument is non-nil." + :version "24.4" + :group 'log-edit + :type 'boolean + :safe 'booleanp) + +(defcustom log-edit-hook '(log-edit-insert-message-template + log-edit-insert-cvs-template + log-edit-insert-changelog + log-edit-show-files) "Hook run at the end of `log-edit'." + ;; Added log-edit-insert-message-template, moved log-edit-show-files. + :version "24.4" :group 'log-edit - :type '(hook :options (log-edit-insert-changelog - log-edit-insert-cvs-rcstemplate - log-edit-insert-cvs-template - log-edit-insert-filenames))) + :type '(hook :options (log-edit-insert-message-template + log-edit-insert-cvs-rcstemplate + log-edit-insert-cvs-template + log-edit-insert-changelog + log-edit-insert-filenames + log-edit-insert-filenames-without-changelog + log-edit-show-files))) (defcustom log-edit-mode-hook (if (boundp 'vc-log-mode-hook) vc-log-mode-hook) "Hook run when entering `log-edit-mode'." @@ -155,14 +165,9 @@ can be obtained from `log-edit-files'." :group 'log-edit :version "24.1") -(defvar cvs-changelog-full-paragraphs t) -(make-obsolete-variable 'cvs-changelog-full-paragraphs - 'log-edit-changelog-full-paragraphs - "21.1") - -(defvar log-edit-changelog-full-paragraphs cvs-changelog-full-paragraphs - "*If non-nil, include full ChangeLog paragraphs in the log. -This may be set in the ``local variables'' section of a ChangeLog, to +(defvar log-edit-changelog-full-paragraphs t + "If non-nil, include full ChangeLog paragraphs in the log. +This may be set in the \"local variables\" section of a ChangeLog, to indicate the policy for that ChangeLog. A ChangeLog paragraph is a bunch of log text containing no blank lines; @@ -191,11 +196,17 @@ when this variable is set to nil.") (defvar log-edit-parent-buffer nil) +(defvar log-edit-vc-backend nil + "VC fileset corresponding to the current log.") + ;;; Originally taken from VC-Log mode (defconst log-edit-maximum-comment-ring-size 32 "Maximum number of saved comments in the comment ring.") +(define-obsolete-variable-alias 'vc-comment-ring 'log-edit-comment-ring "22.1") (defvar log-edit-comment-ring (make-ring log-edit-maximum-comment-ring-size)) +(define-obsolete-variable-alias 'vc-comment-ring-index + 'log-edit-comment-ring-index "22.1") (defvar log-edit-comment-ring-index nil) (defvar log-edit-last-comment-match "") @@ -262,7 +273,7 @@ WHOAMI (interactive prefix) non-nil means prompt for user name and site. FILE-NAME is the name of the change log; if nil, use `change-log-default-name'. -This may be useful as a `log-edit-checkin-hook' to update change logs +This may be useful as a `vc-checkin-hook' to update change logs automatically." (interactive (if current-prefix-arg (list current-prefix-arg @@ -301,8 +312,6 @@ automatically." (insert "\n")))) ;; Compatibility with old names. -(define-obsolete-variable-alias 'vc-comment-ring 'log-edit-comment-ring "22.1") -(define-obsolete-variable-alias 'vc-comment-ring-index 'log-edit-comment-ring-index "22.1") (define-obsolete-function-alias 'vc-previous-comment 'log-edit-previous-comment "22.1") (define-obsolete-function-alias 'vc-next-comment 'log-edit-next-comment "22.1") (define-obsolete-function-alias 'vc-comment-search-reverse 'log-edit-comment-search-backward "22.1") @@ -327,7 +336,9 @@ automatically." "AList of known headers and the face to use to highlight them.") (defconst log-edit-header-contents-regexp - "[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n?") + "[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n?" + "Regular expression matching a header field. +The first subexpression is the actual text of the field.") (defun log-edit-match-to-eoh (_limit) ;; FIXME: copied from message-match-to-eoh. @@ -346,54 +357,115 @@ automatically." (set-match-data (list start (point))) (point)))) +(defun log-edit-goto-eoh () ;FIXME: Almost rfc822-goto-eoh! + (goto-char (point-min)) + (when (re-search-forward + "^\\([^[:alpha:]]\\|[[:alnum:]-]+[^[:alnum:]-:]\\)" nil 'move) + (goto-char (match-beginning 0)))) + +(defun log-edit--match-first-line (limit) + (let ((start (point))) + (log-edit-goto-eoh) + (skip-chars-forward "\n") + (and (< start (line-end-position)) + (< (point) limit) + (save-excursion + (not (re-search-backward "^Summary:[ \t]*[^ \t\n]" nil t))) + (looking-at ".+") + (progn + (goto-char (match-end 0)) + (put-text-property (point-min) (point) + 'jit-lock-defer-multiline t) + (point))))) + (defvar log-edit-font-lock-keywords ;; Copied/inspired by message-font-lock-keywords. `((log-edit-match-to-eoh - (,(concat "^\\(\\([a-z]+\\):\\)" log-edit-header-contents-regexp) + (,(concat "^\\(\\([[:alpha:]-]+\\):\\)" log-edit-header-contents-regexp) (progn (goto-char (match-beginning 0)) (match-end 0)) nil - (1 (if (assoc (match-string 2) log-edit-headers-alist) + (1 (if (assoc-string (match-string 2) log-edit-headers-alist t) 'log-edit-header 'log-edit-unknown-header) nil lax) ;; From `log-edit-header-contents-regexp': - (3 (or (cdr (assoc (match-string 2) log-edit-headers-alist)) + (3 (or (cdr (assoc-string (match-string 2) log-edit-headers-alist t)) 'log-edit-header) - nil lax))))) - -;; Used in Emacs 24.3+, and in Emacs's .dir-locals.el file. -;; This is a convenience setting so that people committing files -;; to Emacs trunk with Emacs 24point2 do not always get queried -;; about this variable being potentially unsafe. + nil lax)) + ("^\n" + (progn (goto-char (match-end 0)) (1+ (match-end 0))) nil + (0 '(:height 0.1 :inverse-video t)))) + (log-edit--match-first-line (0 'log-edit-summary)))) + +(defvar log-edit-font-lock-gnu-style nil + "If non-nil, highlight common failures to follow the GNU coding standards.") (put 'log-edit-font-lock-gnu-style 'safe-local-variable 'booleanp) +(defconst log-edit-font-lock-gnu-keywords + ;; Use + ;; * foo.el (bla, bli) + ;; (blo, blu): Toto. + ;; Rather than + ;; * foo.el (bla, bli, + ;; blo, blu): Toto. + '(("^[ \t]*\\(?:\\* .*\\)?\\(([^\n)]*,\\s-*\\)$" + (1 '(face font-lock-warning-face + help-echo "Continue function lists with \")\\n(\".") t)) + ;; Don't leave a lone word on a single line. + ;;("^\\s-*\\(\\S-*[^\n:)]\\)\\s-*$" (1 font-lock-warning-face t)) + ;; Don't cut a sentence right after the first word (better to move + ;; the sentence on the next line, then). + ;;("[.:]\\s-+\\(\\sw+\\)\\s-*$" (1 font-lock-warning-face t)) + ;; Change Log entries should use present tense. + ("):[ \t\n]*[[:alpha:]]+\\(ed\\)\\>" + (1 '(face font-lock-warning-face help-echo "Use present tense.") t)) + ;; Change log entries start with a capital letter. + ("): [a-z]" (0 '(face font-lock-warning-face help-echo "Capitalize.") t)) + ("[^[:upper:]]\\(\\. [[:upper:]]\\)" + (1 '(face font-lock-warning-face + help-echo "Use two spaces to end a sentence") t)) + ("^(" + (0 (let ((beg (max (point-min) (- (match-beginning 0) 2)))) + (put-text-property beg (match-end 0) 'font-lock-multiline t) + (if (eq (char-syntax (char-after beg)) ?w) + '(face font-lock-warning-face + help-echo "Punctuate previous line."))) + t)) + )) + +(defun log-edit-font-lock-keywords () + (if log-edit-font-lock-gnu-style + (append log-edit-font-lock-keywords + log-edit-font-lock-gnu-keywords) + log-edit-font-lock-keywords)) + ;;;###autoload (defun log-edit (callback &optional setup params buffer mode &rest _ignore) "Setup a buffer to enter a log message. -\\The buffer will be put in mode MODE or `log-edit-mode' -if MODE is nil. -If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run. -Mark and point will be set around the entire contents of the buffer so -that it is easy to kill the contents of the buffer with \\[kill-region]. -Once you're done editing the message, pressing \\[log-edit-done] will call -`log-edit-done' which will end up calling CALLBACK to do the actual commit. - -PARAMS if non-nil is an alist. Possible keys and associated values: +The buffer is put in mode MODE or `log-edit-mode' if MODE is nil. +\\ +If SETUP is non-nil, erase the buffer and run `log-edit-hook'. +Set mark and point around the entire contents of the buffer, so +that it is easy to kill the contents of the buffer with +\\[kill-region]. Once the user is done editing the message, +invoking the command \\[log-edit-done] (`log-edit-done') will +call CALLBACK to do the actual commit. + +PARAMS if non-nil is an alist of variables and buffer-local +values to give them in the Log Edit buffer. Possible keys and +associated values: `log-edit-listfun' -- function taking no arguments that returns the list of files that are concerned by the current operation (using relative names); `log-edit-diff-function' -- function taking no arguments that displays a diff of the files concerned by the current operation. + `vc-log-fileset' -- the VC fileset to be committed (if any). -If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the -log message and go back to the current buffer when done. Otherwise, it -uses the current buffer." +If BUFFER is non-nil `log-edit' will jump to that buffer, use it +to edit the log message and go back to the current buffer when +done. Otherwise, it uses the current buffer." (let ((parent (current-buffer))) (if buffer (pop-to-buffer buffer)) (when (and log-edit-setup-invert (not (eq setup 'force))) (setq setup (not setup))) - (when setup - (erase-buffer) - (insert "Summary: \nAuthor: ") - (save-excursion (insert "\n\n"))) (if mode (funcall mode) (log-edit-mode)) @@ -407,8 +479,10 @@ uses the current buffer." (if buffer (set (make-local-variable 'log-edit-parent-buffer) parent)) (set (make-local-variable 'log-edit-initial-files) (log-edit-files)) - (when setup (run-hooks 'log-edit-hook)) - (goto-char (point-min)) (push-mark (point-max)) + (when setup + (erase-buffer) + (run-hooks 'log-edit-hook)) + (push-mark (point-max)) (message "%s" (substitute-command-keys "Press \\[log-edit-done] when you are done editing.")))) @@ -422,15 +496,27 @@ commands (under C-x v for VC, for example). \\{log-edit-mode-map}" (set (make-local-variable 'font-lock-defaults) - '(log-edit-font-lock-keywords t t)) + '(log-edit-font-lock-keywords t)) + (setq-local jit-lock-contextually t) ;For the "first line is summary". (make-local-variable 'log-edit-comment-ring-index) + (add-hook 'kill-buffer-hook 'log-edit-remember-comment nil t) (hack-dir-local-variables-non-file-buffer)) (defun log-edit-hide-buf (&optional buf where) (when (setq buf (get-buffer (or buf log-edit-files-buf))) - (let ((win (get-buffer-window buf where))) - (if win (ignore-errors (delete-window win)))) - (bury-buffer buf))) + ;; FIXME: Should use something like `quit-windows-on' here, but + ;; that function never deletes this buffer's window because it + ;; was created using `cvs-pop-to-buffer-same-frame'. + (save-selected-window + (let ((win (get-buffer-window buf where))) + (if win (ignore-errors (delete-window win)))) + (bury-buffer buf)))) + +(defun log-edit-remember-comment (&optional comment) + (unless comment (setq comment (buffer-string))) + (when (or (ring-empty-p log-edit-comment-ring) + (not (equal comment (ring-ref log-edit-comment-ring 0)))) + (ring-insert log-edit-comment-ring comment))) (defun log-edit-done () "Finish editing the log message and commit the files. @@ -463,10 +549,7 @@ If you want to abort the commit, simply delete the buffer." (save-excursion (goto-char (point-max)) (insert ?\n))) - (let ((comment (buffer-string))) - (when (or (ring-empty-p log-edit-comment-ring) - (not (equal comment (ring-ref log-edit-comment-ring 0)))) - (ring-insert log-edit-comment-ring comment))) + (log-edit-remember-comment) (let ((win (get-buffer-window log-edit-files-buf))) (if (and log-edit-confirm (not (and (eq log-edit-confirm 'changed) @@ -482,6 +565,16 @@ If you want to abort the commit, simply delete the buffer." (cvs-bury-buffer (current-buffer) log-edit-parent-buffer)) (call-interactively log-edit-callback)))) +(defun log-edit-kill-buffer () + "Kill the current buffer. +Also saves its contents in the comment history and hides +`log-edit-files-buf'." + (interactive) + (log-edit-hide-buf) + (let ((buf (current-buffer))) + (quit-windows-on buf) + (kill-buffer buf))) + (defun log-edit-files () "Return the list of files that are about to be committed." (ignore-errors (funcall log-edit-listfun))) @@ -535,17 +628,38 @@ If you want to abort the commit, simply delete the buffer." (save-selected-window (cvs-pop-to-buffer-same-frame buf) (shrink-window-if-larger-than-buffer) + (set-window-dedicated-p (selected-window) t) (selected-window))))) +(defun log-edit-beginning-of-line (&optional n) + "Move point to beginning of header value or to beginning of line. + +It works the same as `message-beginning-of-line', but it uses a +different header separator appropriate for `log-edit-mode'." + (interactive "p") + (let ((mail-header-separator "")) + (message-beginning-of-line n))) + (defun log-edit-empty-buffer-p () "Return non-nil if the buffer is \"empty\"." (or (= (point-min) (point-max)) (save-excursion (goto-char (point-min)) - (while (and (looking-at "^\\([a-zA-Z]+: \\)?$") + (while (and (looking-at "^\\([a-zA-Z]+: ?\\)?$") (zerop (forward-line 1)))) (eobp)))) +(defun log-edit-insert-message-template () + "Insert the default template with Summary and Author." + (interactive) + (when (or (called-interactively-p 'interactive) + (log-edit-empty-buffer-p)) + (insert "Summary: ") + (when log-edit-setup-add-author + (insert "\nAuthor: ")) + (insert "\n\n") + (message-position-point))) + (defun log-edit-insert-cvs-template () "Insert the template specified by the CVS administrator, if any. This simply uses the local CVS/Template file." @@ -577,12 +691,25 @@ can thus take some time." (insert "Affected files: \n" (mapconcat 'identity (log-edit-files) " \n"))) +(defun log-edit-insert-filenames-without-changelog () + "Insert the list of files that have no ChangeLog message." + (interactive) + (let ((files + (delq nil + (mapcar + (lambda (file) + (unless (or (cdr-safe (log-edit-changelog-entries file)) + (equal (file-name-nondirectory file) "ChangeLog")) + file)) + (log-edit-files))))) + (when files + (goto-char (point-max)) + (insert (mapconcat 'identity files ", ") ": ")))) + (defun log-edit-add-to-changelog () "Insert this log message into the appropriate ChangeLog file." (interactive) - ;; Yuck! - (unless (string= (buffer-string) (ring-ref log-edit-comment-ring 0)) - (ring-insert log-edit-comment-ring (buffer-string))) + (log-edit-remember-comment) (dolist (f (log-edit-files)) (let ((buffer-file-name (expand-file-name f))) (save-excursion @@ -590,6 +717,9 @@ can thus take some time." (defvar log-edit-changelog-use-first nil) +(defvar log-edit-rewrite-tiny-change t + "Non-nil means rewrite (tiny change).") + (defvar log-edit-rewrite-fixes nil "Rule to rewrite bug numbers into Fixes: headers. The value should be of the form (REGEXP . REPLACEMENT) @@ -623,39 +753,45 @@ If the optional prefix arg USE-FIRST is given (via \\[universal-argument]), or if the command is repeated a second time in a row, use the first log entry regardless of user name or time." (interactive "P") - (let ((eoh (save-excursion (rfc822-goto-eoh) (point)))) - (when (<= (point) eoh) - (goto-char eoh) - (if (looking-at "\n") (forward-char 1)))) - (let ((author - (let ((log-edit-changelog-use-first - (or use-first (eq last-command 'log-edit-insert-changelog)))) - (log-edit-insert-changelog-entries (log-edit-files))))) - (log-edit-set-common-indentation) - ;; Add an Author: field if appropriate. - (when author (log-edit-add-field "Author" author)) - ;; Add a Fixes: field if applicable. - (when (consp log-edit-rewrite-fixes) - (rfc822-goto-eoh) - (when (re-search-forward (car log-edit-rewrite-fixes) nil t) - (let ((start (match-beginning 0)) - (end (match-end 0)) - (fixes (match-substitute-replacement - (cdr log-edit-rewrite-fixes)))) - (delete-region start end) - (log-edit-add-field "Fixes" fixes)))) - (and log-edit-strip-single-file-name - (progn (rfc822-goto-eoh) - (if (looking-at "\n") (forward-char 1)) - (looking-at "\\*\\s-+")) - (let ((start (point))) - (forward-line 1) - (when (not (re-search-forward "^\\*\\s-+" nil t)) - (goto-char start) - (skip-chars-forward "^():") - (skip-chars-forward ": ") - (delete-region start (point))))) - (goto-char (point-min)))) + (save-excursion + (let ((eoh (save-excursion (rfc822-goto-eoh) (point)))) + (when (<= (point) eoh) + (goto-char eoh) + (if (looking-at "\n") (forward-char 1)))) + (let ((author + (let ((log-edit-changelog-use-first + (or use-first (eq last-command 'log-edit-insert-changelog)))) + (log-edit-insert-changelog-entries (log-edit-files))))) + (log-edit-set-common-indentation) + ;; Add an Author: field if appropriate. + (when author (log-edit-add-field "Author" (car author))) + ;; Add a Fixes: field if applicable. + (when (consp log-edit-rewrite-fixes) + (rfc822-goto-eoh) + (when (re-search-forward (car log-edit-rewrite-fixes) nil t) + (let ((start (match-beginning 0)) + (end (match-end 0)) + (fixes (match-substitute-replacement + (cdr log-edit-rewrite-fixes)))) + (delete-region start end) + (log-edit-add-field "Fixes" fixes)))) + (and log-edit-strip-single-file-name + (progn (rfc822-goto-eoh) + (if (looking-at "\n") (forward-char 1)) + (looking-at "\\*\\s-+")) + (let ((start (point))) + (forward-line 1) + (when (not (re-search-forward "^\\*\\s-+" nil t)) + (goto-char start) + (skip-chars-forward "^():") + (skip-chars-forward ": ") + (delete-region start (point))))) + ;; FIXME also add "Co-authored-by" when appropriate. + ;; Bzr accepts multiple --author arguments, others (?) don't. + (and log-edit-rewrite-tiny-change + (eq 'tiny (cdr author)) + (goto-char (point-max)) + (insert "\nCopyright-paperwork-exempt: yes\n"))))) ;;;; ;;;; functions for getting commit message from ChangeLog a file... @@ -741,19 +877,26 @@ Return non-nil if it is." (if (null log-edit-changelog-use-first) (looking-at (regexp-quote (format "%s %s <%s>" time name mail))) ;; Check the author, to potentially add it as a "Author: " header. + ;; FIXME This accumulates multiple authors, but only when there + ;; are multiple ChangeLog files. It should also check for + ;; multiple authors in each individual entry. (when (looking-at "[^ \t]") (when (and (boundp 'log-edit-author) (not (looking-at (format ".+ .+ <%s>" (regexp-quote mail)))) - (looking-at ".+ \\(.+ <.+>\\)")) + (looking-at ".+ \\(.+ <.+>\\) *\\((tiny change)\\)?")) (let ((author (replace-regexp-in-string " " " " (match-string 1)))) (unless (and log-edit-author - (string-match (regexp-quote author) log-edit-author)) - (setq log-edit-author - (if log-edit-author - (concat log-edit-author ", " author) - author))))) + (string-match (regexp-quote author) + (car log-edit-author))) + (if (not log-edit-author) + (setq log-edit-author + (cons author (if (match-string 2) 'tiny))) + (setcar log-edit-author + (concat (car log-edit-author) ", " author)) + (and (match-string 2) (not (cdr log-edit-author)) + (setcdr log-edit-author 'tiny)))))) t)))) (defun log-edit-changelog-entries (file) @@ -775,47 +918,55 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each change-log-default-name) ;; `find-change-log' uses `change-log-default-name' if set ;; and sets it before exiting, so we need to work around - ;; that memoizing which is undesired here + ;; that memoizing which is undesired here. (setq change-log-default-name nil) (find-change-log))))) - (with-current-buffer (find-file-noselect changelog-file-name) - (unless (eq major-mode 'change-log-mode) (change-log-mode)) - (goto-char (point-min)) - (if (looking-at "\\s-*\n") (goto-char (match-end 0))) - (if (not (log-edit-changelog-ours-p)) - (list (current-buffer)) - (save-restriction - (log-edit-narrow-changelog) - (goto-char (point-min)) - - ;; Search for the name of FILE relative to the ChangeLog. If that - ;; doesn't occur anywhere, they're not using full relative - ;; filenames in the ChangeLog, so just look for FILE; we'll accept - ;; some false positives. - (let ((pattern (file-relative-name - file (file-name-directory changelog-file-name)))) - (if (or (string= pattern "") - (not (save-excursion - (search-forward pattern nil t)))) - (setq pattern (file-name-nondirectory file))) - - (setq pattern (concat "\\(^\\|[^[:alnum:]]\\)" - (regexp-quote pattern) - "\\($\\|[^[:alnum:]]\\)")) - - (let (texts - (pos (point))) - (while (and (not (eobp)) (re-search-forward pattern nil t)) - (let ((entry (log-edit-changelog-entry))) - (if (< (elt entry 1) (max (1+ pos) (point))) - ;; This is not relevant, actually. - nil - (push entry texts)) - ;; Make sure we make progress. - (setq pos (max (1+ pos) (elt entry 1))) - (goto-char pos))) - - (cons (current-buffer) texts)))))))) + (when (or (find-buffer-visiting changelog-file-name) + (file-exists-p changelog-file-name)) + (with-current-buffer (find-file-noselect changelog-file-name) + (unless (eq major-mode 'change-log-mode) (change-log-mode)) + (goto-char (point-min)) + (if (looking-at "\\s-*\n") (goto-char (match-end 0))) + (if (not (log-edit-changelog-ours-p)) + (list (current-buffer)) + (save-restriction + (log-edit-narrow-changelog) + (goto-char (point-min)) + + (let ((pattern (log-edit-changelog--pattern file + changelog-file-name))) + (let (texts + (pos (point))) + (while (and (not (eobp)) (re-search-forward pattern nil t)) + (let ((entry (log-edit-changelog-entry))) + (if (< (elt entry 1) (max (1+ pos) (point))) + ;; This is not relevant, actually. + nil + (push entry texts)) + ;; Make sure we make progress. + (setq pos (max (1+ pos) (elt entry 1))) + (goto-char pos))) + + (cons (current-buffer) texts))))))))) + +(defun log-edit-changelog--pattern (file changelog-file-name) + (if (eq (aref file (1- (length file))) ?/) + ;; Match any files inside this directory. + (concat "^\t\\* " (unless (string= file "./") file)) + ;; Search for the name of FILE relative to the ChangeLog. If that + ;; doesn't occur anywhere, they're not using full relative + ;; filenames in the ChangeLog, so just look for FILE; we'll accept + ;; some false positives. + (let ((pattern (file-relative-name + file (file-name-directory changelog-file-name)))) + ;; FIXME: When can the above return an empty string? + (if (or (string= pattern "") + (not (save-excursion + (search-forward pattern nil t)))) + (setq pattern (file-name-nondirectory file))) + (setq pattern (concat "\\(^\\|[^[:alnum:]]\\)" + (regexp-quote pattern) + "\\($\\|[^[:alnum:]]\\)"))))) (defun log-edit-changelog-insert-entries (buffer beg end &rest files) "Insert the text from BUFFER between BEG and END. @@ -828,6 +979,8 @@ Rename relative filenames in the ChangeLog entry as FILES." (setq bound (point-marker)) (when log-name (dolist (f files) + ;; FIXME: f can be a directory, a (possibly indirect) parent + ;; of the ChangeLog file. (save-excursion (goto-char opoint) (when (re-search-forward @@ -863,16 +1016,53 @@ Rename relative filenames in the ChangeLog entry as FILES." (apply 'log-edit-changelog-insert-entries (append (car log-entry) (cdr log-entry))) (insert "\n")) + ;; No newline after the last entry. + (when log-entries + (delete-char -1)) log-edit-author)) +(defun log-edit-toggle-header (header value) + "Toggle a boolean-type header in the current buffer. +See `log-edit-set-header' for details." + (log-edit-set-header header value t)) + +(defun log-edit-set-header (header value &optional toggle) + "Set the value of HEADER to VALUE in the current buffer. +If TOGGLE is non-nil, and the value of HEADER already is VALUE, +clear it. Make sure there is an empty line after the headers. +Return t if toggled on (or TOGGLE is nil), otherwise nil." + (let ((val t) + (line (concat header ": " value "\n"))) + (save-excursion + (save-restriction + (rfc822-goto-eoh) + (narrow-to-region (point-min) (point)) + (goto-char (point-min)) + (if (re-search-forward (concat "^" header ":" + log-edit-header-contents-regexp) + nil t) + (if (setq val (not (and toggle (string= (match-string 1) value)))) + (replace-match line t t) + (replace-match "" t t nil 1)) + (insert line))) + (rfc822-goto-eoh) + (delete-horizontal-space) + (unless (looking-at "\n") + (insert "\n"))) + val)) + (defun log-edit-extract-headers (headers comment) "Extract headers from COMMENT to form command line arguments. -HEADERS should be an alist with elements of the form (HEADER . CMDARG) -associating header names to the corresponding cmdline option name and the -result is then a list of the form (MSG CMDARG1 HDRTEXT1 CMDARG2 HDRTEXT2...). -where MSG is the remaining text from STRING. -If \"Summary\" is not in HEADERS, then the \"Summary\" header is extracted -anyway and put back as the first line of MSG." +HEADERS should be an alist with elements (HEADER . CMDARG) +or (HEADER . FUNCTION) associating headers to command line +options and the result is then a list of the form (MSG ARGUMENTS...) +where MSG is the remaining text from COMMENT. +FUNCTION should be a function of one argument that takes the +header value and returns the list of strings to be appended to +ARGUMENTS. CMDARG will be added to ARGUMENTS followed by the +header value. If \"Summary\" is not in HEADERS, then the +\"Summary\" header is extracted anyway and put back as the first +line of MSG." (with-temp-buffer (insert comment) (rfc822-goto-eoh) @@ -886,17 +1076,20 @@ anyway and put back as the first line of MSG." (while (re-search-forward (concat "^" (car header) ":" log-edit-header-contents-regexp) nil t) - (if (eq t (cdr header)) - (setq summary (match-string 1)) - (push (match-string 1) res) - (push (or (cdr header) (car header)) res)) - (replace-match "" t t))) + (let ((txt (match-string 1))) + (replace-match "" t t) + (if (eq t (cdr header)) + (setq summary txt) + (if (functionp (cdr header)) + (setq res (nconc res (funcall (cdr header) txt))) + (push txt res) + (push (or (cdr header) (car header)) res)))))) ;; Remove header separator if the header is empty. (widen) (goto-char (point-min)) (when (looking-at "\\([ \t]*\n\\)+") (delete-region (match-beginning 0) (match-end 0))) - (if summary (insert summary "\n")) + (if summary (insert summary "\n\n")) (cons (buffer-string) res)))) (provide 'log-edit)