Re: building directory

[Masatake YAMATO]

Romain FRANCOISE <address@hidden> tells me the way to find
the emacs C source directory. Thank you, Romain.

With following patch, you can jump to the definition of built-in
function from *Help* created by M-x describe-function.

If you approve my patch, let me know. I'll write ChangeLog entry.

Masatake YAMATO
Index: src/lisp.h
===================================================================
RCS file: /cvsroot/emacs/emacs/src/lisp.h,v
retrieving revision 1.449
diff -u -r1.449 lisp.h
--- src/lisp.h  23 Mar 2003 02:08:04 -0000      1.449
+++ src/lisp.h  4 Apr 2003 10:22:54 -0000
@@ -856,6 +856,8 @@
     char *symbol_name;
     char *prompt;
     char *doc;
+    const char *src_file;
+    short src_line;
   };
 
 
@@ -1611,9 +1613,9 @@
   Lisp_Object fnname ();                                               \
   struct Lisp_Subr sname =                                             \
     { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)),    \
-      fnname, minargs, maxargs, lname, prompt, 0};                     \
+      fnname, minargs, maxargs, lname, prompt, 0, __FILE__, (short)__LINE__}; \
   Lisp_Object fnname
-
+                                                                       
 #else
 
 /* This version of DEFUN declares a function prototype with the right
@@ -1622,7 +1624,7 @@
   Lisp_Object fnname DEFUN_ARGS_ ## maxargs ;                          \
   struct Lisp_Subr sname =                                             \
     { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)),    \
-      fnname, minargs, maxargs, lname, prompt, 0};                     \
+      fnname, minargs, maxargs, lname, prompt, 0, __FILE__, (short)__LINE__}; \
   Lisp_Object fnname
 
 /* Note that the weird token-substitution semantics of ANSI C makes
@@ -3003,6 +3005,8 @@
 /* defined in doc.c */
 extern Lisp_Object Vdoc_file_name;
 EXFUN (Fsubstitute_command_keys, 1);
+EXFUN (Fsource_line, 1);
+EXFUN (Fsource_file, 1);
 EXFUN (Fdocumentation, 2);
 EXFUN (Fdocumentation_property, 3);
 extern Lisp_Object read_doc_string P_ ((Lisp_Object));
Index: src/doc.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/doc.c,v
retrieving revision 1.99
diff -u -r1.99 doc.c
--- src/doc.c   4 Feb 2003 14:03:12 -0000       1.99
+++ src/doc.c   4 Apr 2003 10:22:54 -0000
@@ -360,6 +360,32 @@
   return 1;
 }
 
+DEFUN ("source-line", Fsource_line, Ssource_line, 1, 1, 0,
+       doc: /* The line number of the function definition in its source C 
file.  */)
+     (object)
+     Lisp_Object object;
+{
+  Lisp_Object fun;
+  fun = Findirect_function (object);
+  if (SUBRP (fun))
+    return make_number((EMACS_INT)XSUBR(fun)->src_line);
+  else
+    return Qnil;
+}
+
+DEFUN ("source-file", Fsource_file, Ssource_file, 1, 1, 0,
+       doc: /* The file name of the function definition of its source C file.  
*/)
+     (object)
+     Lisp_Object object;
+{
+  Lisp_Object fun;
+  fun = Findirect_function (object);
+  if (SUBRP (fun) && (EMACS_INT)XSUBR(fun)->src_file)
+    return build_string(XSUBR(fun)->src_file);
+  else
+    return Qnil;
+}
+
 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
        doc: /* Return the documentation string of FUNCTION.
 Unless a non-nil second argument RAW is given, the
@@ -923,6 +949,8 @@
               doc: /* Name of file containing documentation strings of 
built-in symbols.  */);
   Vdoc_file_name = Qnil;
 
+  defsubr (&Ssource_line);
+  defsubr (&Ssource_file);
   defsubr (&Sdocumentation);
   defsubr (&Sdocumentation_property);
   defsubr (&Ssnarf_documentation);
Index: lisp/help-mode.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/help-mode.el,v
retrieving revision 1.15
diff -u -r1.15 help-mode.el
--- lisp/help-mode.el   10 Feb 2003 21:52:30 -0000      1.15
+++ lisp/help-mode.el   4 Apr 2003 10:22:54 -0000
@@ -64,6 +64,14 @@
   "Hook run by `help-mode'."
   :type 'hook
   :group 'help)
+
+(defcustom help-mode-emacs-source-directory source-directory
+  "Path specifying the place where emacs C source files are.
+`source-directory' is used as the default value. Specify
+the top source directory. Don't include `src'."
+  :type 'directory
+  :group 'help)
+
 
 ;; Button types used by help
 
@@ -155,6 +163,17 @@
                     (pop-to-buffer (car location))
                     (goto-char (cdr location))))
   'help-echo (purecopy "mouse-2, RET: find function's definition"))
+
+(define-button-type 'help-subr-def
+  :supertype 'help-xref
+  'help-function (lambda (fun file line)
+                  (let ((buf (find-file-noselect 
+                              (concat help-mode-emacs-source-directory "/src/" 
file))))
+                  (pop-to-buffer buf)
+                  (with-current-buffer buf
+                    (widen)
+                    (goto-line line))))
+  'help-echo (purecopy "mouse-2, RET: find subr's definition"))
 
 (define-button-type 'help-variable-def
   :supertype 'help-xref
Index: lisp/help-fns.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/help-fns.el,v
retrieving revision 1.30
diff -u -r1.30 help-fns.el
--- lisp/help-fns.el    12 Feb 2003 23:13:43 -0000      1.30
+++ lisp/help-fns.el    4 Apr 2003 10:22:55 -0000
@@ -217,7 +217,8 @@
                  (symbol-function function)
                function))
         file-name string
-        (beg (if (commandp def) "an interactive " "a ")))
+        (beg (if (commandp def) "an interactive " "a "))
+        line)
     (setq string
          (cond ((or (stringp def)
                     (vectorp def))
@@ -225,7 +226,9 @@
                ((subrp def)
                 (if (eq 'unevalled (cdr (subr-arity def)))
                     (concat beg "special form")
-                  (concat beg "built-in function")))
+                  (concat beg "built-in function"))
+                (setq file-name (source-file function)
+                      line      (source-line function)))
                ((byte-code-function-p def)
                 (concat beg "compiled Lisp function"))
                ((symbolp def)
@@ -287,7 +290,9 @@
       (with-current-buffer standard-output
        (save-excursion
          (re-search-backward "`\\([^`']+\\)'" nil t)
-         (help-xref-button 1 'help-function-def function file-name)))))
+         (if line
+             (help-xref-button 1 'help-subr-def function file-name line)
+           (help-xref-button 1 'help-function-def function file-name))))))
     (princ ".")
     (terpri)
     (when (commandp function)