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:
parent
e430810c89
commit
d4eb88c7ab
10
etc/NEWS
10
etc/NEWS
@ -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
|
||||
|
||||
---
|
||||
|
@ -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.
|
||||
|
@ -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)
|
||||
|
@ -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))))
|
||||
|
Loading…
Reference in New Issue
Block a user