Re: defface location in describe-face

[drkm <darkman_spam@yahoo.fr>]

  [ Gmane seems to have problems.  So I use my web mail
    interface.  I'm sorry if this mail is posted twice, and
    for broken Reference:. ]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>   Why `describe-face' does not show a "Defined in `_file_'." button
?

> Oversight.  `defface' doesn't record the definition in load-history.
> Patches welcome.

  I tried to follow the same way `describe-variable' do this,
and adapt it to `describe-face'.

  The difficult point is that `find-func' library doesn't handle
symbols but functions and variables.  So I defined there a new
variable, `find-face-regexp', and a new function,
`find-face-noselect'.

  `find-face-noselect' is a copy of `find-variable-noselect', with:

    (let ((library (or file (symbol-file variable 'defvar))))
      (find-function-search-for-symbol variable 'variable library)))

replaced by (locally binding `find-variable-regexp'):

    (let ((library (or file (symbol-file face 'defface)))
          (find-variable-regexp find-face-regexp))
      (find-function-search-for-symbol face 'variable library)))

  But I think `find-func' library should be fixed to handle arbitrary
kind of symbol (or at least other standard things than functions and
variables).

  Follow the patches, generated individualy by "diff -c".  It's
important to point out that I didn't test it so much, because I can't
install a more recent CVS version than :

    (emacs-version)
       ==> "GNU Emacs 21.3.50.1 (i386-mingw-windows98.3000)
            of 2004-12-23 on FARIBA"

  To resume the changes:

    - cus-face.el: `custom-declare-face' adds face to
      `current-load-list'

    - faces.el: `describe-face' adds the string "Defined in ...", with
      the ad-hoc button to go to the face definition

    - help-mode.el: define the button type `help-face-def'

    - emacs-lisp/find-func.el: new variable `find-face-regexp', new
      function `find-face-noselect', and a minor docstring fix in
      `find-variable-noselect'

--drkm

*** cus-face.el.orig	Thu Dec 23 07:01:56 2004
--- cus-face.el	Tue Jan  4 01:25:46 2005
***************
*** 53,58 ****
--- 53,59 ----
      (when (and doc (null (face-documentation face)))
        (set-face-documentation face (purecopy doc)))
      (custom-handle-all-keywords face args 'custom-face)
+     (push (cons 'defface face) current-load-list)
      (run-hooks 'custom-define-hook))
    face)

*** faces.el.orig	Thu Dec 23 07:01:58 2004
--- faces.el	Tue Jan  4 02:38:50 2005
***************
*** 1244,1255 ****
  	      (insert "Documentation: "
  		      (or (face-documentation f)
  			  "Not documented as a face.")
! 		      "\n\n")
  	      (with-current-buffer standard-output
  		(save-excursion
  		  (re-search-backward
  		   (concat "\\(" customize-label "\\)") nil t)
! 		  (help-xref-button 1 'help-customize-face f)))
  	      (dolist (a attrs)
  		(let ((attr (face-attribute f (car a) frame)))
  		  (insert (make-string (- max-width (length (cdr a))) ?\ )
--- 1244,1279 ----
  	      (insert "Documentation: "
  		      (or (face-documentation f)
  			  "Not documented as a face.")
! 		      "\n")
  	      (with-current-buffer standard-output
  		(save-excursion
  		  (re-search-backward
  		   (concat "\\(" customize-label "\\)") nil t)
! 		  (help-xref-button 1 'help-customize-face f))
!                 ;; Make a hyperlink to the library if appropriate.
!                 (let ((file-name (symbol-file (cons 'defface f))))
!                   (when (equal file-name "loaddefs.el")
!                     ;; Find the real def site of the preloaded face.
!                     (let ((location
!                            (condition-case nil
!                                (find-face-noselect f file-name)
!                              (error nil))))
!                       (when location
!                         (with-current-buffer (car location)
!                           (goto-char (cdr location))
!                           (when (re-search-backward
!                                  "^;;; Generated autoloads from
\\(.*\\)" nil t)
!                             (setq file-name (match-string 1)))))))
!                   (when file-name
!                     (princ "Defined in `")
!                     (princ file-name)
!                     (princ "'.\n")
!                     (with-current-buffer standard-output
!                       (save-excursion
!                         (re-search-backward "`\\([^`']+\\)'" nil t)
!                         (help-xref-button 1 'help-face-def
!                                           f file-name))))
!                   (trepri)))
  	      (dolist (a attrs)
  		(let ((attr (face-attribute f (car a) frame)))
  		  (insert (make-string (- max-width (length (cdr a))) ?\ )

*** help-mode.el.orig	Thu Dec 23 07:01:58 2004
--- help-mode.el	Tue Jan  4 02:16:48 2005
***************
*** 169,174 ****
--- 169,182 ----
  		     (goto-char (cdr location))))
    'help-echo (purecopy"mouse-2, RET: find variable's definition"))
  
+ (define-button-type 'help-face-def
+   :supertype 'help-xref
+   'help-function (lambda (face &optional file)
+                    (let ((location (find-face-noselect face file)))
+ 		     (pop-to-buffer (car location))
+ 		     (goto-char (cdr location))))
+   'help-echo (purecopy "mouse-2, RET: find face's definition"))
+ 
  \f
  ;;;###autoload
  (defun help-mode ()

*** emacs-lisp/find-func.el.orig	Tue Jan  4 02:31:44 2005
--- emacs-lisp/find-func.el	Tue Jan  4 02:14:22 2005
***************
*** 86,91 ****
--- 86,102 ----
    :group 'find-function
    :version "21.1")
  
+ (defcustom find-face-regexp
+   (concat"^\\s-*(defface" find-function-space-re "%s\\(\\s-\\|$\\)")
+   "The regexp used by `find-face' to search for a face definition.
+ It should match right up to the face name.  The default value
+ matches `defface'.
+ 
+ Please send improvements and fixes to the maintainer."
+   :type 'regexp
+   :group 'find-function
+   :version "21.3")
+ 
  (defcustom find-function-source-path nil
    "The default list of directories where `find-function' searches.
  
***************
*** 337,345 ****
  
  ;;;###autoload
  (defun find-variable-noselect (variable &optional file)
!   "Return a pair `(BUFFER . POINT)' pointing to the definition of
SYMBOL.
  
! Finds the Emacs Lisp library containing the definition of SYMBOL
  in a buffer and the point of the definition.  The buffer is
  not selected.
  
--- 348,356 ----
  
  ;;;###autoload
  (defun find-variable-noselect (variable &optional file)
!   "Return a pair `(BUFFER . POINT)' pointing to the definition of
VARIABLE.
  
! Finds the Emacs Lisp library containing the definition of VARIABLE
  in a buffer and the point of the definition.  The buffer is
  not selected.
  
***************
*** 382,387 ****
--- 393,414 ----
    (find-function-do-it variable t 'switch-to-buffer-other-frame))
  
  ;;;###autoload
+ (defun find-face-noselect (face &optional file)
+   "Return a pair `(BUFFER . POINT)' pointing to the definition of
FACE.
+ 
+ Finds the Emacs Lisp library containing the definition of FACE
+ in a buffer and the point of the definition.  The buffer is
+ not selected.
+ 
+ The library where FACE is defined is searched for in FILE or
+ `find-function-source-path', if non nil, otherwise in `load-path'."
+   (if (not face)
+       (error "You didn't specify a face"))
+   (let ((library (or file (symbol-file face 'defface)))
+         (find-variable-regexp find-face-regexp))
+     (find-function-search-for-symbol face 'variable library)))
+ 
+ ;;;###autoload
  (defun find-function-on-key (key)
    "Find the function that KEY invokes.  KEY is a string.
  Point is saved if FUNCTION is in the current buffer."



	

	
		
Découvrez le nouveau Yahoo! Mail : 250 Mo d'espace de stockage pour vos mails ! 
Créez votre Yahoo! Mail sur http://fr.mail.yahoo.com/