unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Noam Postavsky <npostavs@gmail.com>
To: Daniel Dehennin <daniel.dehennin@baby-gnu.org>
Cc: 16301@debbugs.gnu.org
Subject: bug#16301: 24.3.50; [Feature] Split add-change-log-entry to make it reusable
Date: Thu, 04 Jul 2019 21:57:44 -0400	[thread overview]
Message-ID: <874l415jl3.fsf@gmail.com> (raw)
In-Reply-To: <87bnzyv7aj.fsf@hati.baby-gnu.org> (Daniel Dehennin's message of "Mon, 30 Dec 2013 13:43:00 +0100")

[-- Attachment #1: Type: text/plain, Size: 713 bytes --]

Daniel Dehennin <daniel.dehennin@baby-gnu.org> writes:

> I just start to use magit in complement[1] of vc-git and was wondering
> why there is no feature like “add-change-log-entry(-other-window)” that
> insert in the commit log instead of creating/adding to a plain
> ChangeLog.
>
> I finally found[2] the “magit-commit-add-log” which behave like what I
> had in DVC[3].
>
> All these functions do near the same thing but code is duplicated.
>
> I propose to split the “add-change-log-entry” function to make parts
> usable by third parties.

I've started working on this, patch attached below.  It's not entirely
baked, but I thought I'd post it now to let people know about it.


[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 13884 bytes --]

From 00b2e60143b9ecfbe86e993d2c29b76514368fb4 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 4 Jul 2019 20:32:39 -0400
Subject: [PATCH] Improved ChangeLog generation for vc log (Bug#16301)

* lisp/vc/add-log.el (change-log-unindented-file-names-re)
(change-log-read-entries, change-log-read-defuns)
(change-log-insert-entries): New functions.
* lisp/vc/diff-mode.el (diff-find-source-location): Fix docstring.
(diff-add-log-current-defuns): New function.
* lisp/vc/log-edit.el (log-edit-generate-changelog): New command.
(log-edit-mode-map): Bind it to C-c C-a.
(log-edit-fill-entry): New function.
(log-edit-mode): Set it as fill-paragraph-function.
(log-edit-insert-filled-defuns):
(change-log-no-margin-fill-forward-paragraph): New functions.
---
 lisp/vc/add-log.el   |  18 ++++++++
 lisp/vc/diff-mode.el | 115 +++++++++++++++++++++++++++++++++++++++++++++++++--
 lisp/vc/log-edit.el  |  81 +++++++++++++++++++++++++++++++++++-
 3 files changed, 209 insertions(+), 5 deletions(-)

diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index f9efd44c5c..4810c0dbe9 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -309,6 +309,24 @@ change-log-search-file-name
 	  (re-search-forward change-log-file-names-re nil t)
 	  (match-string-no-properties 2))))))
 
+(defconst change-log-unindented-file-names-re "^[*] \\([^ ,:([\n]+\\)")
+
+(defun change-log-read-entries (&optional end)
+  (cl-loop while (re-search-forward change-log-unindented-file-names-re end t)
+           collect (cons (match-string-no-properties 1)
+                         (change-log-read-defuns end))))
+
+(defun change-log-read-defuns (&optional end)
+  (cl-loop while (re-search-forward change-log-tag-re end t)
+           nconc (split-string (match-string-no-properties 1)
+                               ",[[:blank:]]*" t)))
+
+(defun change-log-insert-entries (changelogs)
+  (cl-loop for (file . defuns) in changelogs do
+           (insert "* " file " ")
+           (cl-loop for def in defuns
+                    do (insert "(" def "):\n"))))
+
 (defun change-log-find-file ()
   "Visit the file for the change under point."
   (interactive)
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 0d5dc0e1c0..229e901e0a 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -54,6 +54,7 @@
 
 ;;; Code:
 (eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
 
 (autoload 'vc-find-revision "vc")
 (autoload 'vc-find-revision-no-save "vc")
@@ -1773,15 +1774,22 @@ diff-find-approx-text
 (defsubst diff-xor (a b) (if a (if (not b) a) b))
 
 (defun diff-find-source-location (&optional other-file reverse noprompt)
-  "Find out (BUF LINE-OFFSET POS SRC DST SWITCHED).
+  "Find current diff location within the source file.
+OTHER-FILE, if non-nil, means to look at the diff's name and line
+  numbers for the old file.  Furthermore, use `diff-vc-revisions'
+  if it's available.  If `diff-jump-to-old-file' is non-nil, the
+  sense of this parameter is reversed.  If the prefix argument is
+  8 or more, `diff-jump-to-old-file' is set to OTHER-FILE.
+REVERSE, if non-nil, switches the sense of SRC and DST (see below).
+NOPROMPT, if non-nil, means not to prompt the user.
+Return a list (BUF LINE-OFFSET (BEG . END) SRC DST SWITCHED).
 BUF is the buffer corresponding to the source file.
 LINE-OFFSET is the offset between the expected and actual positions
   of the text of the hunk or nil if the text was not found.
-POS is a pair (BEG . END) indicating the position of the text in the buffer.
+\(BEG . END) is a pair indicating the position of the text in the buffer.
 SRC and DST are the two variants of text as returned by `diff-hunk-text'.
   SRC is the variant that was found in the buffer.
-SWITCHED is non-nil if the patch is already applied.
-NOPROMPT, if non-nil, means not to prompt the user."
+SWITCHED is non-nil if the patch is already applied."
   (save-excursion
     (let* ((other (diff-xor other-file diff-jump-to-old-file))
 	   (char-offset (- (point) (diff-beginning-of-hunk t)))
@@ -2210,6 +2218,105 @@ diff-undo
   (let ((inhibit-read-only t))
     (undo arg)))
 
+(defun diff-add-log-current-defuns ()
+  "Return an alist of defun names for the current diff.
+The elements of the alist are of the form (FILE . (DEFUN...)),
+where DEFUN... is a list of function names found in FILE."
+  (save-excursion
+    (goto-char (point-min))
+    (let ((defuns nil)
+          (hunk-end nil)
+          (make-defun-context-follower
+           (lambda (goline)
+             (let ((eodefun nil)
+                   (defname nil))
+               (list
+                (lambda () ;; Check for end of current defun.
+                  (when (and eodefun
+                             (funcall goline)
+                             (>= (point) eodefun))
+                    (setq defname nil)
+                    (setq eodefun nil)))
+                (lambda (&optional get-current) ;; Check for new defun.
+                  (if get-current
+                      defname
+                    (when-let* ((def (and (not eodefun)
+                                          (funcall goline)
+                                          (add-log-current-defun)))
+                                (eof (save-excursion (end-of-defun) (point))))
+                      (setq eodefun eof)
+                      (setq defname def)))))))))
+      (while
+          ;; Might need to skip over file headers between diff
+          ;; hunks (e.g., "diff --git ..." etc).
+          (re-search-forward diff-hunk-header-re nil t)
+        (setq hunk-end (save-excursion (diff-end-of-hunk)))
+        (pcase-let* ((filename (substring-no-properties (diff-find-file-name)))
+                     (=lines 0)
+                     (+lines 0)
+                     (-lines 0)
+                     (`(,buf ,_line-offset (,beg . ,end)
+                             (,old-text . ,_old-offset)
+                             (,new-text . ,_new-offset)
+                             ,applied)
+                      (diff-find-source-location t))
+                     (new-buf nil)
+                     (goto-newbuf
+                      ;; If APPLIED, we have NEW-TEXT in BUF, so we
+                      ;; need to a buffer with OLD-TEXT to follow
+                      ;; -lines.
+                      (lambda ()
+                        (if new-buf (set-buffer new-buf)
+                          (set-buffer (generate-new-buffer " *diff-new-text*"))
+                          (insert (if applied old-text new-text))
+                          (funcall (buffer-local-value 'major-mode buf))
+                          (setq new-buf (current-buffer)))
+                        (goto-char (point-min))
+                        (forward-line (+ =lines -1
+                                         (if applied -lines +lines)))))
+                     (gotobuf (lambda ()
+                                (set-buffer buf)
+                                (goto-char beg)
+                                (forward-line (+ =lines -1
+                                                 (if applied +lines -lines)))))
+                     (`(,=ck-eodefun ,=ck-defun)
+                      (funcall make-defun-context-follower gotobuf))
+                     (`(,-ck-eodefun ,-ck-defun)
+                      (funcall make-defun-context-follower
+                               (if applied goto-newbuf gotobuf)))
+                     (`(,+ck-eodefun ,+ck-defun)
+                      (funcall make-defun-context-follower
+                               (if applied gotobuf goto-newbuf))))
+          (unwind-protect
+              (while (progn (forward-line)
+                            (< (point) hunk-end))
+                (let ((patch-char (char-after)))
+                  (pcase patch-char
+                    (?+ (cl-incf +lines))
+                    (?- (cl-incf -lines))
+                    (?\s (cl-incf =lines)))
+                  (save-current-buffer
+                    (funcall =ck-eodefun)
+                    (funcall +ck-eodefun)
+                    (funcall -ck-eodefun)
+                    (when-let* ((def (cond
+                                      ((eq patch-char ?\s)
+                                       ;; Just updating context defun.
+                                       (ignore (funcall =ck-defun)))
+                                      ;; + or - in existing defun.
+                                      ((funcall =ck-defun t))
+                                      ;; Check added or removed defun.
+                                      (t (funcall (if (eq ?+ patch-char)
+                                                      +ck-defun -ck-defun))))))
+                      (cl-pushnew def (alist-get filename defuns
+                                                 nil nil #'equal)
+                                  :test #'equal)))))
+            (when (buffer-live-p new-buf)
+              (kill-buffer new-buf)))))
+      (dolist (file-defuns defuns)
+        (cl-callf nreverse (cdr file-defuns)))
+      (nreverse defuns))))
+
 (defun diff-add-change-log-entries-other-window ()
   "Iterate through the current diff and create ChangeLog entries.
 I.e. like `add-change-log-entry-other-window' but applied to all hunks."
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 91e18c1ec5..736bcaf0fa 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -53,7 +53,8 @@ cvs-buffer
 
 (easy-mmode-defmap log-edit-mode-map
   '(("\C-c\C-c" . log-edit-done)
-    ("\C-c\C-a" . log-edit-insert-changelog)
+    ;;("\C-c\C-a" . log-edit-insert-changelog)
+    ("\C-c\C-a" . log-edit-generate-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)
@@ -488,10 +489,73 @@ log-edit-mode
   (set (make-local-variable 'font-lock-defaults)
        '(log-edit-font-lock-keywords t))
   (setq-local jit-lock-contextually t)  ;For the "first line is summary".
+  (setq-local fill-paragraph-function #'log-edit-fill-entry)
   (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-insert-filled-defuns (defuns)
+  (cl-loop for def in defuns do
+           (when (> (+ (current-column) (string-width def)) fill-column)
+             (insert (if (memq (char-before) '(?\n ?\s))
+                         "\n" ")\n")))
+           (insert (if (memq (char-before) '(?\n ?\s))
+                       "(" ", ")
+                   def))
+  (insert "): "))
+
+(defun log-edit-fill-entry (&optional _justify _region)
+  ;; TODO: Use arguments!
+  (pcase-let ((`(,beg ,entry-end) (log-edit-changelog-subparagraph)))
+    (if (= beg entry-end)
+        ;; Not a ChangeLog entry, fill as normal.
+        nil
+      (cl-callf copy-marker entry-end)
+      (cl-loop
+       do (goto-char beg)
+       (let ((end (if (re-search-forward "): ?\\(\\).*[^:[:blank:]\n].*$"
+                                         entry-end t)
+                      (match-beginning 1)
+                    entry-end)))
+         (goto-char beg)
+         (re-search-forward (concat "\\(?1:" change-log-unindented-file-names-re
+                                    " \\)\\|^\\(?1:\\)(")
+                            entry-end)
+         (goto-char (setq beg (match-end 1)))
+         (log-edit-insert-filled-defuns
+          (prog1 (change-log-read-defuns end)
+            (delete-region beg end))))
+       while (setq beg (and (re-search-forward "^(" entry-end t)
+                            (match-beginning 0))))
+      (set-marker entry-end nil)
+      t)))
+
+(defun change-log-no-margin-fill-forward-paragraph (n)
+  "Move N change log entries forward.
+Delete redundant parens along the way."
+  (let ((end-marker (make-marker))
+        (dir (cl-signum n)))
+    (cl-callf abs n)
+    (catch 'paragraphs-left
+      (dotimes (i n)
+        (pcase-let ((`(,beg ,end) (log-edit-changelog-subparagraph)))
+          (when (= end beg)
+            (throw 'paragraphs-left (- n i)))
+          (goto-char beg)
+          (set-marker end-marker end)
+          (cl-loop
+           do (progn (when (and (re-search-forward "):?$" (line-end-position) 'move)
+                                (eq ?\( (char-after (1+ (match-end 0)))))
+                       (replace-match "," t t))
+                     (forward-line 1))
+           while (< (point) end-marker)
+           do (when (looking-at "^(")
+                (replace-match "" t t)))
+          (goto-char (if (< dir 0) beg (1- end-marker)))
+          (set-marker end-marker nil)
+          ))
+      0)))
+
 (defun log-edit-hide-buf (&optional buf where)
   (when (setq buf (get-buffer (or buf log-edit-files-buf)))
     ;; FIXME: Should use something like `quit-windows-on' here, but
@@ -726,6 +790,21 @@ log-edit-add-field
       (replace-match (concat " " value) t t nil 1)
     (insert field ": " value "\n" (if (looking-at "\n") "" "\n"))))
 
+(defun log-edit-generate-changelog ()
+  (interactive)
+  (let* ((diff-buf nil)
+         ;; Unfortunately, `log-edit-show-diff' doesn't have a NO-SHOW
+         ;; option, so we try to work around it via display-buffer
+         ;; machinery.
+         (display-buffer-overriding-action
+          `(,(lambda (buf alist)
+               (setq diff-buf buf)
+               (display-buffer-no-window buf alist))
+            . ((allow-no-window . t)))))
+    (change-log-insert-entries
+     (with-current-buffer (progn (log-edit-show-diff) diff-buf)
+       (diff-add-log-current-defuns)))))
+
 (defun log-edit-insert-changelog (&optional use-first)
   "Insert a log message by looking at the ChangeLog.
 The idea is to write your ChangeLog entries first, and then use this
-- 
2.11.0


  parent reply	other threads:[~2019-07-05  1:57 UTC|newest]

Thread overview: 6+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2013-12-30 12:43 bug#16301: 24.3.50; [Feature] Split add-change-log-entry to make it reusable Daniel Dehennin
2014-01-02  4:12 ` Stefan Monnier
2019-07-05  1:57 ` Noam Postavsky [this message]
2019-07-16 23:47   ` Noam Postavsky
2019-07-28 14:13     ` Noam Postavsky
2019-08-04  0:16       ` Noam Postavsky

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=874l415jl3.fsf@gmail.com \
    --to=npostavs@gmail.com \
    --cc=16301@debbugs.gnu.org \
    --cc=daniel.dehennin@baby-gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).