1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-20 18:17:20 +00:00

Bind RET in Log View mode to a command that toggles a more detailed display.

* lisp/vc/log-view.el: New command log-view-toggle-entry-display for
toggling log entries between concise and detailed forms.
(log-view-toggle-entry-display): New command.
(log-view-mode-map): Bind RET to it.
(log-view-expanded-log-entry-function): New variable.
(log-view-current-entry, log-view-inside-comment-p)
(log-view-current-tag): New functions.
(log-view-toggle-mark-entry): Use log-view-current-entry and
log-view-end-of-defun instead of searching directly with
log-view-message-re.
(log-view-end-of-defun): Likewise.  Add optional ARG for
compatibility with end-of-defun.
(log-view-end-of-defun): Ignore comments and VC buttons.

* lisp/vc/vc-bzr.el (vc-bzr-expanded-log-entry): New function.
(vc-bzr-log-view-mode): Use log-view-expanded-log-entry-function.
This commit is contained in:
Chong Yidong 2011-02-13 15:04:33 -05:00
parent e430810c89
commit d4eb88c7ab
4 changed files with 163 additions and 72 deletions

View File

@ -608,6 +608,16 @@ the user for specifics, e.g. a merge source.
**** Currently supported by Bzr, Git, and Mercurial.
*** Log entries in some Log View buffers can be toggled to display a
longer description by typing RET (log-view-toggle-entry-display).
In the Log View buffers made by `C-x v L' (vc-print-root-log), you can
use this to display the full log entry for the revision at point.
**** Currently supported by Bzr.
**** Packages using Log View mode can enable this functionality by
binding `log-view-expanded-log-entry-function' to a suitable function.
** Miscellaneous
---

View File

@ -1,3 +1,22 @@
2011-02-13 Chong Yidong <cyd@stupidchicken.com>
* vc/log-view.el: New command log-view-toggle-entry-display for
toggling log entries between concise and detailed forms.
(log-view-toggle-entry-display): New command.
(log-view-mode-map): Bind RET to it.
(log-view-expanded-log-entry-function): New variable.
(log-view-current-entry, log-view-inside-comment-p)
(log-view-current-tag): New functions.
(log-view-toggle-mark-entry): Use log-view-current-entry and
log-view-end-of-defun instead of searching directly with
log-view-message-re.
(log-view-end-of-defun): Likewise. Add optional ARG for
compatibility with end-of-defun.
(log-view-end-of-defun): Ignore comments and VC buttons.
* vc/vc-bzr.el (vc-bzr-expanded-log-entry): New function.
(vc-bzr-log-view-mode): Use log-view-expanded-log-entry-function.
2011-02-13 Teodor Zlatanov <tzz@lifelogs.com>
* net/imap.el: Remove file. All the functionality is in nnimap.el.

View File

@ -130,6 +130,7 @@
("z" . kill-this-buffer)
("q" . quit-window)
("g" . revert-buffer)
("\C-m" . log-view-toggle-entry-display)
("m" . log-view-toggle-mark-entry)
("e" . log-view-modify-change-comment)
@ -180,6 +181,12 @@
(defvar log-view-mode-hook nil
"Hook run at the end of `log-view-mode'.")
(defvar log-view-expanded-log-entry-function nil
"Function returning the detailed description of a Log View entry.
It is called by the command `log-view-toggle-entry-display' with
one arg, the revision tag (a string), and should return a string.
If it is nil, `log-view-toggle-entry-display' does nothing.")
(defface log-view-file
'((((class color) (background light))
(:background "grey70" :weight bold))
@ -299,15 +306,36 @@ The match group number 1 should match the revision number itself.")
(when cvsdir (setq dir (expand-file-name cvsdir dir))))
(expand-file-name file dir))))
(defun log-view-current-tag (&optional where)
(save-excursion
(when where (goto-char where))
(forward-line 1)
(let ((pt (point)))
(when (re-search-backward log-view-message-re nil t)
(let ((rev (match-string-no-properties 1)))
(unless (re-search-forward log-view-file-re pt t)
rev))))))
(defun log-view-current-entry (&optional pos move)
"Return the position and revision tag of the Log View entry at POS.
This is a list (BEG TAG), where BEG is a buffer position and TAG
is a string. If POS is nil or omitted, it defaults to point.
If there is no entry at POS, return nil.
If optional arg MOVE is non-nil, move point to BEG if found.
Otherwise, don't move point."
(let ((looping t)
result)
(save-excursion
(when pos (goto-char pos))
(forward-line 1)
(while looping
(setq pos (re-search-backward log-view-message-re nil 'move)
looping (and pos (log-view-inside-comment-p (point)))))
(when pos
(setq result
(list pos (match-string-no-properties 1)))))
(and move result (goto-char pos))
result))
(defun log-view-inside-comment-p (pos)
"Return non-nil if POS lies inside an expanded log entry."
(eq (get-text-property pos 'log-view-comment) t))
(defun log-view-current-tag (&optional pos)
"Return the revision tag (a string) of the Log View entry at POS.
if POS is omitted or nil, it defaults to point."
(cadr (log-view-current-entry pos)))
(defun log-view-toggle-mark-entry ()
"Toggle the marked state for the log entry at point.
@ -317,29 +345,24 @@ entries are denoted by changing their background color.
log entries."
(interactive)
(save-excursion
(forward-line 1)
(let ((pt (point)))
(when (re-search-backward log-view-message-re nil t)
(let ((beg (match-beginning 0))
end ov ovlist found tag)
(unless (re-search-forward log-view-file-re pt t)
;; Look to see if the current entry is marked.
(setq found (get-char-property (point) 'log-view-self))
(if found
(delete-overlay found)
;; Create an overlay that covers this entry and change
;; its color.
(setq tag (log-view-current-tag (point)))
(forward-line 1)
(setq end
(if (re-search-forward log-view-message-re nil t)
(match-beginning 0)
(point-max)))
(setq ov (make-overlay beg end))
(overlay-put ov 'face 'log-view-file)
;; This is used to check if the overlay is present.
(overlay-put ov 'log-view-self ov)
(overlay-put ov 'log-view-marked tag))))))))
(let* ((entry (log-view-current-entry nil t))
(beg (car entry))
found)
(when entry
;; Look to see if the current entry is marked.
(setq found (get-char-property beg 'log-view-self))
(if found
(delete-overlay found)
;; Create an overlay covering this entry and change its color.
(let* ((end (if (get-text-property beg 'log-view-entry-expanded)
(next-single-property-change beg 'log-view-comment)
(log-view-end-of-defun)
(point)))
(ov (make-overlay beg end)))
(overlay-put ov 'face 'log-view-file)
;; This is used to check if the overlay is present.
(overlay-put ov 'log-view-self ov)
(overlay-put ov 'log-view-marked (nth 1 entry))))))))
(defun log-view-get-marked ()
"Return the list of tags for the marked log entries."
@ -352,50 +375,74 @@ log entries."
(setq pos (overlay-end ov))))
marked-list)))
(defun log-view-beginning-of-defun ()
;; This assumes that a log entry starts with a line matching
;; `log-view-message-re'. Modes that derive from `log-view-mode'
;; for which this assumption is not valid will have to provide
;; another implementation of this function. `log-view-msg-prev'
;; does a similar job to this function, we can't use it here
;; directly because it prints messages that are not appropriate in
;; this context and it does not move to the beginning of the buffer
;; when the point is before the first log entry.
(defun log-view-toggle-entry-display ()
(interactive)
;; Don't do anything unless `log-view-expanded-log-entry-function'
;; is defined in this mode.
(when (functionp log-view-expanded-log-entry-function)
(let* ((opoint (point))
(entry (log-view-current-entry nil t))
(beg (car entry))
(buffer-read-only nil))
(when entry
(if (get-text-property beg 'log-view-entry-expanded)
;; If the entry is expanded, collapse it.
(let ((pos (next-single-property-change beg 'log-view-comment)))
(unless (and pos (log-view-inside-comment-p pos))
(error "Broken markup in `log-view-toggle-entry-display'"))
(delete-region pos
(next-single-property-change pos 'log-view-comment))
(put-text-property beg (1+ beg) 'log-view-entry-expanded nil)
(if (< opoint pos)
(goto-char opoint)))
;; Otherwise, expand the entry.
(let ((long-entry (funcall log-view-expanded-log-entry-function
(nth 1 entry))))
(when long-entry
(put-text-property beg (1+ beg) 'log-view-entry-expanded t)
(log-view-end-of-defun)
(setq beg (point))
(insert long-entry "\n")
(add-text-properties
beg (point)
'(font-lock-face font-lock-comment-face log-view-comment t))
(goto-char opoint))))))))
;; `log-view-beginning-of-defun' and `log-view-end-of-defun' have
;; been checked to work with logs produced by RCS, CVS, git,
;; mercurial and subversion.
(defun log-view-beginning-of-defun (&optional arg)
"Move backward to the beginning of a Log View entry.
With ARG, do it that many times. Negative ARG means move forward
to the beginning of the ARGth following entry.
(re-search-backward log-view-message-re nil 'move))
This is Log View mode's default `beginning-of-defun-function'.
It assumes that a log entry starts with a line matching
`log-view-message-re'."
(if (or (null arg) (zerop arg))
(setq arg 1))
(if (< arg 0)
(dotimes (n (- arg))
(log-view-end-of-defun))
(catch 'beginning-of-buffer
(dotimes (n arg)
(or (log-view-current-entry nil t)
(throw 'beginning-of-buffer nil)))
(point))))
(defun log-view-end-of-defun ()
;; The idea in this function is to search for the beginning of the
;; next log entry using `log-view-message-re' and then go back one
;; line when finding it. Modes that derive from `log-view-mode' for
;; which this assumption is not valid will have to provide another
;; implementation of this function.
;; Look back and if there is no entry there it means we are before
;; the first log entry, so go forward until finding one.
(unless (save-excursion (re-search-backward log-view-message-re nil t))
(re-search-forward log-view-message-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 log-view-message-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 log-view-message-re nil 'move)
(goto-char (match-beginning 0))
(forward-line -1)))
"Move forward to the next Log View entry."
(let ((looping t))
(if (looking-at log-view-message-re)
(goto-char (match-end 0)))
(while looping
(cond
((re-search-forward log-view-message-re nil 'move)
(unless (log-view-inside-comment-p (point))
(setq looping nil)
(goto-char (match-beginning 0))))
;; Don't advance past the end buttons inserted by
;; `vc-print-log-setup-buttons'.
((looking-back "Show 2X entries Show unlimited entries")
(setq looping nil)
(forward-line -1))))))
(defvar cvs-minor-current-files)
(defvar cvs-branch-prefix)

View File

@ -590,6 +590,7 @@ REV non-nil gets an error."
(defvar log-view-font-lock-keywords)
(defvar log-view-current-tag-function)
(defvar log-view-per-file-logs)
(defvar log-view-expanded-log-entry-function)
(define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View"
(remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack.
@ -600,6 +601,10 @@ REV non-nil gets an error."
(if (eq vc-log-view-type 'short)
"^ *\\([0-9.]+\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( \\[merge\\]\\)?"
"^ *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)"))
;; Allow expanding short log entries
(when (eq vc-log-view-type 'short)
(set (make-local-variable 'log-view-expanded-log-entry-function)
'vc-bzr-expanded-log-entry))
(set (make-local-variable 'log-view-font-lock-keywords)
;; log-view-font-lock-keywords is careful to use the buffer-local
;; value of log-view-message-re only since Emacs-23.
@ -637,6 +642,16 @@ REV non-nil gets an error."
(list vc-bzr-log-switches)
vc-bzr-log-switches)))))
(defun vc-bzr-expanded-log-entry (revision)
(with-temp-buffer
(apply 'vc-bzr-command "log" t nil nil
(list (format "-r%s" revision)))
(goto-char (point-min))
(when (looking-at "^-+\n")
;; Indent the expanded log entry.
(indent-region (match-end 0) (point-max) 2)
(buffer-substring (match-end 0) (point-max)))))
(defun vc-bzr-log-incoming (buffer remote-location)
(apply 'vc-bzr-command "missing" buffer 'async nil
(list "--theirs-only" (unless (string= remote-location "") remote-location))))