Re: [Emacs-diffs] Changes to emacs/lisp/bookmark.el,v

[martin rudalics <rudalics@gmx.at>]

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

  >> 2008-10-11  Romain Francoise  <romain@orebokech.com>
  >>
  >> 	* kmacro.el (kmacro-edit-lossage): Fix docstring, lossage is now 300 keys.
  >
  > Yes, that's what I want.  I hope you won't find this too hard to
  > implement, what with all the possible variations of this ``style'' of
  > log entries.

I attached an improved version of this.  When in a Log-View mode buffer,
type `c' to shadow/hide all (well, most) entries not related to the
current file.  Type `o' when on an object in a parenthesized list, to
only show entries for that object.  Type `y' to remove any shadowing or
hiding.  Use `log-view-shadow' to toggle shadowing (it's currently by
default on for the `c' command to find errors sooner).

Suggestions welcome, martin.

[-- Attachment #2: log-view.el.diff --]
[-- Type: text/plain, Size: 11093 bytes --]

*** log-view.el.~1.56.~	2008-11-25 07:49:21.937500000 +0100
--- log-view.el	2008-11-27 10:50:46.250000000 +0100
***************
*** 137,142 ****
--- 137,145 ----
      ([backtab] . log-view-msg-prev)
      ("N" . log-view-file-next)
      ("P" . log-view-file-prev)
+     ("o" . log-view-show-object-only)
+     ("c" . log-view-show-current-only)
+     ("y" . log-view-show-any)
      ("\M-n" . log-view-file-next)
      ("\M-p" . log-view-file-prev))
    "Log-View's keymap."
***************
*** 171,177 ****
      ["Next File"  log-view-file-next
       :help "Go to the next count'th file"]
      ["Previous File"  log-view-file-prev
!      :help "Go to the previous count'th file"]))
  
  (defvar log-view-mode-hook nil
    "Hook run at the end of `log-view-mode'.")
--- 174,187 ----
      ["Next File"  log-view-file-next
       :help "Go to the next count'th file"]
      ["Previous File"  log-view-file-prev
!      :help "Go to the previous count'th file"]
!     "-----"
!     ["Show Object Only"  log-view-show-object-only
!      :help "Show entries for object at point only"]
!     ["Show Current Only"  log-view-show-current-only
!      :help "Show entries for current file only"]
!     ["Show Any"  log-view-show-any
!      :help "Show any entry"]))
  
  (defvar log-view-mode-hook nil
    "Hook run at the end of `log-view-mode'.")
***************
*** 196,201 ****
--- 206,221 ----
  (put 'log-view-message-face 'face-alias 'log-view-message)
  (defvar log-view-message-face 'log-view-message)
  
+ (defcustom log-view-shadow 'current-only
+   "When non-nil, shadow entries with selective viewing.
+ That means, text normally hidden by `log-view-show-current-only'
+ is shadowed instead.  When this is t, also shadow text normally
+ hidden by `log-view-show-object-only'."
+   :type '(choice (const :tag "Never" nil)
+ 		 (const :tag "For current file only" 'current-only)
+ 		 (const :tag "Always" t))
+   :group 'log-view)
+ 
  (defvar log-view-file-re
    (concat "^\\(?:Working file: \\(?1:.+\\)"                ;RCS and CVS.
            ;; Subversion has no such thing??
***************
*** 532,537 ****
--- 552,795 ----
       (list log-view-vc-backend nil)
       to fr)))
  
+ ;;; View entries selectively.
+ (defconst log-view-entry-re "^[ \t]*\\*[ \t]+")
+ 
+ (defvar log-view-entry-or-paren-re
+   (concat "\\(?:" log-view-entry-re "\\)\\|\\(?:^[ \t]*(\\)"))
+ 
+ (defvar log-view-hide-is-shadow nil)
+ 
+ (defun log-view--hide (from to &optional before)
+   "Hide text between FROM and TO.
+ Optional arg BEFORE non-nil means hide empty lines before FROM
+ and do not hide last line before TO.  If `log-view-shadow' is
+ non-nil, shadow text instead of hiding it."
+   (when before
+     (save-excursion
+       ;; Skip empty lines preceding FROM.
+       (if (and (> from (point-min))
+ 	       (get-text-property (1- from) 'invisible))
+ 	  ;; There is invisible text, look before it.
+ 	  (progn
+ 	    (goto-char
+ 	     (previous-single-property-change from 'invisible))
+ 	    (skip-chars-backward "[ \t\n]")
+ 	    (forward-line)
+ 	    (setq from (point)))
+ 	;; No invisible text, look right here.
+ 	(goto-char from)
+ 	(skip-chars-backward "[ \t\n]")
+ 	(forward-line)
+ 	(setq from (point))))
+     ;; Do not hide last line before TO.
+     (setq to (save-excursion
+ 	       (goto-char to)
+ 	       (forward-line -1)
+ 	       (point))))
+   ;; Hide or shadow text.
+   (when (< from to)
+     (if log-view-hide-is-shadow
+ 	(let ((overlay (make-overlay from to)))
+ 	  (overlay-put overlay 'face 'shadow))
+       (put-text-property from to 'invisible t))))
+ 
+ (defun log-view--object-at-point ()
+   "Return name of object at point.
+ The object at point is the string at point preceded by a left
+ paren or a comma and followed by a right paren or a comma.
+ Return nil if there's no such string."
+   (save-excursion
+     (save-restriction
+       (narrow-to-region (line-beginning-position) (line-end-position))
+       (let ((from (save-excursion
+ 		    (when (re-search-backward "(\\|,[ ]+" nil t)
+ 		      (match-end 0))))
+ 	    (to (save-excursion
+ 		  (when (re-search-forward ")\\|," nil t)
+ 		    (match-beginning 0)))))
+ 	 (when (and from to)
+ 	   (buffer-substring-no-properties from to))))))
+ 
+ (defun log-view--prev-match (regexp &optional bound move)
+   "Return position of previous match for REGEXP.
+ Optional argument BOUND non-nil means don't search before BOUND.
+ BOUND defaults to `point-min'.  Return BOUND when nothing is
+ found.  Optional argument MOVE non-nil means also move point
+ there.  Else keep point unchanged."
+   (setq bound (or bound (point-min)))
+   (if move
+       (goto-char (if (re-search-backward regexp bound t)
+ 		     (match-beginning 0)
+ 		   bound))
+     (save-excursion
+       (if (re-search-backward regexp bound t)
+ 	  (match-beginning 0)
+ 	bound))))
+ 
+ (defun log-view--next-match(regexp &optional bound move)
+   "Return position of next match for REGEXP.
+ Optional argument BOUND non-nil means don't search before BOUND.
+ BOUND defaults to `point-max'.  Return BOUND when nothing is
+ found.  Optional argument MOVE non-nil means also move point
+ there.  Else keep point unchanged."
+   (setq bound (or bound (point-max)))
+   (if move
+       (goto-char (if (re-search-forward regexp bound t)
+ 		     (match-beginning 0)
+ 		   bound))
+     (save-excursion
+       (if (re-search-forward regexp bound t)
+ 	  (match-beginning 0)
+ 	bound))))
+ 
+ (defun log-view--collapse-comments (from to)
+   "Try to collapse entry comments between FROM and TO."
+   ;; point must be where the entry is.
+   (let (at)
+     (cond
+      ;; Handle messages like
+      ;; foo.ext (foobar):
+      ;; bar.ext (foobar): Make foobar prominent.
+      ((save-excursion
+ 	(and (re-search-forward ":[ \t\n]+" to t)
+ 	     (setq at (match-beginning 0))
+ 	     (looking-at log-view-entry-re)
+ 	     (re-search-forward ":[ \t\n]+[^*]" to t)))
+       (log-view--hide at (match-beginning 0))
+       (goto-char (match-end 0))
+       (log-view--next-match log-view-entry-re to t))
+      ;; Handle messages like
+      ;; foo.ext (foobar): Make foobar prominent.
+      ;; bar.ext (foobar): Likewise.
+      ((and (re-search-forward ":[ \t]+" to t)
+ 	   (setq at (match-beginning 0))
+ 	   (looking-at "\\(?:[Ll]ikewise\\|[Dd]itto\\)[.]*")
+ 	   (let ((string (match-string-no-properties 0))
+ 		 (display-from (match-beginning 0))
+ 		 (display-to (match-end 0)))
+ 	     (goto-char at)
+ 	     (while (and (re-search-backward "):[ \t]+" from t)
+ 			 (save-excursion
+ 			   (goto-char (match-end 0))
+ 			   (looking-at string))))
+ 	     (goto-char (match-end 0))
+ 	     (put-text-property
+ 	      display-from display-to
+ 	      'display
+ 	      (buffer-substring-no-properties
+ 	       (point)
+ 	       (save-excursion
+ 		 (log-view--next-match log-view-entry-or-paren-re at t)
+ 		 ;; Skip last newline char.
+ 		 (skip-chars-backward "[ \t\n]")
+ 		 (point))))
+ 	     (goto-char at)
+ 	     (log-view--next-match log-view-entry-re to t)))))))
+ 
+ (defun log-view-show-any ()
+   "Show any entries obscured by selective viewing.
+ Show any entries hidden by a previous `log-view-show-object-only'
+ or `log-view-show-current-only' command."
+   (interactive)
+   (let ((inhibit-read-only t))
+     ;; This must be changed as soon as people want to install their own
+     ;; invisible or display stuff.
+     (remove-text-properties (point-min) (point-max) '(invisible nil display nil))
+     (remove-overlays nil nil 'face 'shadow)))
+ 
+ (defun log-view-show-current-only ()
+   "Selectively show log entries for current file only."
+   (interactive)
+   (log-view-show-any)
+   (setq log-view-hide-is-shadow log-view-shadow)
+   (let* ((name (or (file-name-nondirectory (log-view-current-file))
+ 		   (error "No current file")))
+ 	 (name-rq (regexp-quote name))
+ 	 (name-re (concat ".*" name-rq))
+ 	 (entry-and-name-re (concat log-view-entry-re ".*" name-rq))
+ 	 (inhibit-read-only t)
+ 	 (buffer-undo-list t)
+ 	 from to)
+     (save-excursion
+       (save-restriction
+ 	(widen)
+ 	(goto-char (point-min))
+ 	;; Search for next entry.
+ 	(while (re-search-forward log-view-entry-re nil t)
+ 	  (setq from (match-beginning 0))
+ 	  (setq to (log-view--next-match log-view-message-re))
+ 	  (if (looking-at name-re)
+ 	      ;; A relevant entry, make sure it has a comment.
+ 	      (log-view--collapse-comments
+ 	       (log-view--prev-match log-view-message-re) to)
+ 	      ;; An irrelevant entry, hide it.
+ 	    (if (< (log-view--next-match log-view-entry-re to t) to)
+ 		;; There's a following entry.
+ 		(log-view--hide from (point))
+ 	    ;; No following entry.
+ 	    (log-view--hide from to t))))))))
+ 
+ (defun log-view-show-object-only ()
+   "Selectively show log entries for object at point only."
+   (interactive)
+   (log-view-show-any)
+   (setq log-view-hide-is-shadow (eq log-view-shadow t))
+   (let* ((name (or (log-view--object-at-point)
+ 		   (error "No suitable object found")))
+ 	 (name-rq (regexp-quote name))
+ 	 (name-re (concat "\\(?:(\\|,\\)[ \t\n]*\\(" name-rq
+ 			  "\\)[ \t\n]*\\(?:)\\|,\\)"))
+ 	 (inhibit-read-only t)
+ 	 (buffer-undo-list t)
+ 	 (last-from (point-min))
+ 	 from to paren-from paren-to)
+     (save-excursion
+       (save-restriction
+ 	(widen)
+ 	(goto-char (point-min))
+ 	(setq to (log-view--next-match log-view-message-re nil t))
+ 	(setq paren-to to)
+ 	(while (re-search-forward name-re nil t)
+ 	  (goto-char (match-beginning 1))
+ 	  ;; We found a relevant entry, record its message.
+ 	  (setq from (log-view--prev-match log-view-message-re))
+ 	  ;; Record its open paren, it _should_ be on this line ...
+ 	  (setq paren-from (save-excursion
+ 			     (if (re-search-backward "(" from t)
+ 				 (match-beginning 0)
+ 			       from)))
+ 	  (if (= from last-from)
+ 	      ;; We're still in the previous message.  Hide any
+ 	      ;; preceding entries.
+ 	      (log-view--hide paren-to paren-from)
+ 	    ;; We're in a new message, record that.
+ 	    (setq last-from from)
+ 	    ;; Hide any entries in previous message.
+ 	    (log-view--hide paren-to to t)
+ 	    ;; Hide any messages after previous one.
+ 	    (log-view--hide to from)
+ 	    ;; Hide everything from first entry or paren in message to
+ 	    ;; our paren.
+ 	    (log-view--hide
+ 	     (save-excursion
+ 	       (goto-char from)
+ 	       (log-view--next-match log-view-entry-or-paren-re paren-from))
+ 	     paren-from)
+ 	    (setq to (log-view--next-match log-view-message-re)))
+ 	  (setq paren-to (progn
+ 			   (re-search-forward ")" to 'move)
+ 			   (log-view--next-match
+ 			    log-view-entry-or-paren-re to)))
+ 	  (log-view--collapse-comments from to)
+ 	  (when (> (point) paren-to)
+ 	    (setq paren-to (log-view--next-match
+ 			    log-view-entry-or-paren-re to 'move))))
+ 	;; Hide any entries in previous message.
+ 	(log-view--hide paren-to to t)
+ 	;; Hide any messages left.
+ 	(log-view--hide to (point-max))))))
+ 
  (provide 'log-view)
  
  ;; arch-tag: 0d64220b-ce7e-4f62-9c2a-6b04c2f81f4f