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

[martin rudalics]

 >> 2008-10-11  Romain Francoise  <address@hidden>
 >>
 >>       * 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.

*** 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