Re: building directory

[Masatake YAMATO <jet@gyve.org>]

Romain FRANCOISE <romain@orebokech.com> 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;
   };
 
 \f
@@ -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)
+
 \f
 ;; 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)