Re: patch: add-log.el: changelog find file under poin

[martin rudalics <rudalics@gmx.at>]

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

> Based on that I checked this original patch in (Thanks Jan!).
> And I made it a bit more robust in finding the correct file name.
> If someone can figure out a way to use ffap that is at least as
> reliable, then we can replace the current code.

Based on what you wrote and Imenu I added support to find the "tag"
within the file with C-c C-t.  Rudimentary and largely untested!
If anyone is interested I can refine that though.

[-- Attachment #2: add-log.patch --]
[-- Type: text/plain, Size: 4947 bytes --]

*** add-log.el	Sun Jan 27 22:30:56 2008
--- add-log.el	Mon Jan 28 11:16:12 2008
***************
*** 328,338 ****
--- 328,456 ----
  	(find-file file)
        (message "No such file or directory: %s" file))))
  
+ (defconst change-log-tag-re "(\\(\\(?:\\sw\\|\\s_\\)+\\(?:,[ \t]+\\(?:\\sw\\|\\s_\\)+\\)*\\))")
+ 
+ (defun change-log-search-tag (&optional at)
+   "Search for something qualifying as tag."
+   (save-excursion
+     (goto-char (setq at (or at (point))))
+     (save-restriction
+       (widen)
+       (or (condition-case nil
+ 	      ;; Test for AT within list containing tags.
+ 	      (save-excursion
+ 		(backward-up-list)
+ 		(when (looking-at change-log-tag-re)
+ 		  (goto-char at)
+ 		  (save-restriction
+ 		    (narrow-to-region (match-beginning 1) (match-end 1))
+ 		    (find-tag-default))))
+ 	    (error nil))
+ 	  (condition-case nil
+ 	      ;; Test for AT before list containing tags.
+ 	      (save-excursion
+ 		(when (and (skip-chars-forward " \t") ; syntax goes to far
+ 			   (looking-at change-log-tag-re))
+ 		  (save-restriction
+ 		    (narrow-to-region (match-beginning 1) (match-end 1))
+ 		    (goto-char (point-min))
+ 		    (find-tag-default))))
+ 	    (error nil))
+ 	  (condition-case nil
+ 	      ;; Test for AT near filename.
+ 	      (save-excursion
+ 		(when (and (progn
+ 			     (beginning-of-line)
+ 			     (looking-at change-log-file-names-re))
+ 			   (goto-char (match-end 0))
+ 			   (skip-syntax-forward " ")
+ 			   (looking-at change-log-tag-re))
+ 		  (save-restriction
+ 		    (narrow-to-region (match-beginning 1) (match-end 1))
+ 		    (goto-char (point-min))
+ 		    (find-tag-default))))
+ 	    (error nil))
+ 	  (condition-case nil
+ 	      ;; Test for AT before filename.
+ 	      (save-excursion
+ 		(when (and (progn
+ 			     (skip-syntax-backward " ")
+ 			     (beginning-of-line)
+ 			     (looking-at change-log-file-names-re))
+ 			   (goto-char (match-end 0))
+ 			   (skip-syntax-forward " ")
+ 			   (looking-at change-log-tag-re))
+ 		  (save-restriction
+ 		    (narrow-to-region (match-beginning 1) (match-end 1))
+ 		    (goto-char (point-min))
+ 		    (find-tag-default))))
+ 	    (error nil))
+ 	  (condition-case nil
+ 	      ;; Test for AT near start entry.
+ 	      (save-excursion
+ 		(when (and (progn
+ 			     (beginning-of-line)
+ 			     (looking-at change-log-start-entry-re))
+ 			   (forward-line) ; Won't work for multiple
+ 					  ; names, etc.
+ 			   (skip-syntax-forward " ")
+ 			   (progn
+ 			     (beginning-of-line)
+ 			     (looking-at change-log-file-names-re))
+ 			   (goto-char (match-end 0))
+ 			   (re-search-forward change-log-tag-re))
+ 		  (save-restriction
+ 		    (narrow-to-region (match-beginning 1) (match-end 1))
+ 		    (goto-char (point-min))
+ 		    (find-tag-default))))
+ 	    (error nil))
+ 	  (condition-case nil
+ 	      ;; Test for AT after tag list.
+ 	      (when (re-search-backward change-log-tag-re)
+ 		(save-restriction
+ 		  (narrow-to-region (match-beginning 1) (match-end 1))
+ 		  (goto-char (point-max))
+ 		  (find-tag-default)))
+ 	    (error nil))))))
+ 
+ (defun change-log-find-tag ()
+   "Find tag using Imenu."
+   (interactive)
+   (let ((file (change-log-search-file-name (point)))
+ 	(tag (change-log-search-tag (point))))
+     (cond
+      ((and tag file (file-exists-p file))
+       (let ((buffer (find-file-noselect file))
+ 	    position)
+ 	(if buffer
+ 	    (with-current-buffer buffer
+ 	      (require 'imenu)
+ 	      (save-excursion
+ 		(save-restriction
+ 		  (widen)
+ 		  (condition-case nil
+ 		      (let* (imenu-use-markers element ; don't use markers.
+ 			     (tags (funcall imenu-create-index-function)))
+ 			;; TODO: Handle case of more than one
+ 			;; association for tag.
+ 			(if (setq element (assoc tag tags))
+ 			    (setq position (cdr element))
+ 			  (message "Not found tag: %s" tag)))
+ 		    (error nil))))
+ 	      (when position
+ 		(goto-char position)
+ 		(display-buffer buffer)))
+ 	  (message "Cannot find file: %s" file))))
+      ((not tag) (message "No such tag: %s" tag))
+      (t (message "No such file or directory: %s" file)))))
+ 
+ 
  (defvar change-log-mode-map
    (let ((map (make-sparse-keymap)))
      (define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment)
      (define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment)
      (define-key map [?\C-c ?\C-f] 'change-log-find-file)
+     (define-key map [?\C-c ?\C-t] 'change-log-find-tag)
      map)
    "Keymap for Change Log major mode.")
  
***************
*** 938,944 ****
  		       having-next-defun
  		       previous-defun-end
  		       next-defun-beginning)
! 		     
  		   (save-excursion
  		     (setq having-previous-defun
  			   (c-beginning-of-defun))
--- 1056,1062 ----
  		       having-next-defun
  		       previous-defun-end
  		       next-defun-beginning)
! 
  		   (save-excursion
  		     (setq having-previous-defun
  			   (c-beginning-of-defun))

[-- Attachment #3: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel