A librep patch, binary incompatible.

[Teika Kazura <teika lavabit com>]

Hi. I've written a librep patch. (Attached, but don't commit it yet,
since the doc doesn't accompany. A commit looks self explanatory
if it comes with a doc. Actually, it's a combination of three commits.)

The main goal is the improvement in 'documentation' function which
returns the docstring of a variable or function. The current one does
not always work well with a subr or macro, and broken for pager
functions (more precisely, files byte-compiled by users.)
The fix benefits "sawfish.el", an emacs major mode, whose update will
be released soon by me. (Also, subr commands' doc is not shown in the
configurator without the patch.)

It looks like a minor patch, but it's binary incompatible; you have to
compile rep-gtk and sawfish again, in this order. So I think enough
testing period is necessary. Do you think it's good to merge it now?

If merged now, I think it's better to put off the Sawfish release a
bit; test Librep for a month, and release two weeks before Sawfish.
That's the schedule I imagine. (It's correct it's not the period,
but the quality of the test, but I don't know how to test. ;| It seems
to be running ok, though, on my PC.)

At the same time, it'll be good to "bump big" both Librep and Sawfish;
binary incompatible Librep shouldn't be 0.90.7, but 0.91.0, but it's a
good occasion, since the next Sawfish will be 1.7.0, not 1.6.x.

Thank anyway for reading,
Teika (Teika kazura)

diff --git a/lisp/rep/lang/doc.jl b/lisp/rep/lang/doc.jl
index 193a17c..6bb4a31 100644
--- a/lisp/rep/lang/doc.jl
+++ b/lisp/rep/lang/doc.jl
@@ -142,11 +142,19 @@ NAME is true, then it should be the symbol that is associated with VALUE."
       'documentation))
 
   (defun documentation (symbol #!optional structure value)
-    "Returns the documentation-string for SYMBOL."
+    "Returns the documentation-string for SYMBOL which should be the name
+of one of a special variable, function, macro, or a special form.
+If it's not a variable, then VALUE should be the function etc.
+
+STRUCTURE is a compatibility argument, and can be nil."
     (catch 'exit
-      (when (and (not structure) (closurep value))
-	(let ((tem (closure-structure value)))
-	  (when (structure-name tem)
+      (when (and (not structure) value)
+	(let (tem)
+	  (if (closurep value)
+	      (setq tem (closure-structure value))
+	    (if (subrp value) ;; t for subr and special form
+		(setq tem (subr-structure value))))
+	  (when (and tem (structure-name tem))
 	    (setq structure (structure-name tem)))))
 
       ;; First check for in-core documentation
diff --git a/lisp/rep/vm/compiler/rep.jl b/lisp/rep/vm/compiler/rep.jl
index 4d7a49a..15c8b92 100644
--- a/lisp/rep/vm/compiler/rep.jl
+++ b/lisp/rep/vm/compiler/rep.jl
@@ -107,7 +107,20 @@
 			       (memq (car out) top-level-compiled))))))
       (case (car form)
 	((defun)
-	 (remember-function (nth 1 form) (nth 2 form) (nthcdr 3 form)))
+	 (remember-function (nth 1 form) (nth 2 form) (nthcdr 3 form))
+	 (let* ((body (cdddr form))
+		(doc (car body))
+		prop-name)
+	   (when (and (not *compiler-write-docs*)
+		      (stringp doc))
+	     (setq prop-name
+		   (intern
+		    (concat "documentation#"
+			    (symbol-name (fluid current-module)))))
+	     (format standard-error "prop-name: %s\n" prop-name)
+	     (setq form
+		   `(progn (put ',(cadr form) ',prop-name ,doc)
+			   ,form)))))
 
 	((defmacro)
 	 (remember-function (nth 1 form) (nth 2 form))
diff --git a/src/rep_lisp.h b/src/rep_lisp.h
index 33fb8c5..64a85d1 100644
--- a/src/rep_lisp.h
+++ b/src/rep_lisp.h
@@ -564,6 +564,7 @@ typedef struct {
     } fun;
     repv name;
     repv int_spec;
+    repv structrue;
 } rep_subr;
 
 typedef struct {
@@ -571,6 +572,7 @@ typedef struct {
     repv (*fun)();
     repv name;
     repv int_spec;			/* put this in plist? */
+    repv structure;
 } rep_xsubr;
 
 /* If set in rep_SubrN types, it'll be passed a vector of args,
@@ -775,7 +777,7 @@ typedef struct rep_gc_n_roots {
     extern repv fsym args;						\
     rep_ALIGN_CELL(rep_xsubr ssym) = { type, (repv (*)()) fsym,		\
 				       rep_VAL(&rep_CONCAT(ssym, __name)), \
-				       rep_NULL };			\
+				       rep_NULL, rep_NULL };		\
     repv fsym args
 
 /* Same as above but with an extra arg -- an interactive-spec string. */
@@ -785,7 +787,8 @@ typedef struct rep_gc_n_roots {
     extern repv fsym args;						\
     rep_ALIGN_CELL(rep_xsubr ssym) = { type, (repv (*)()) fsym,		\
 				       rep_VAL(&rep_CONCAT(ssym, __name)), \
-				       rep_VAL(&rep_CONCAT(ssym, __int)) };\
+				       rep_VAL(&rep_CONCAT(ssym, __int)), \
+				       rep_NULL};			\
     repv fsym args
 
 /* Add a subroutine */    
diff --git a/src/structures.c b/src/structures.c
index c4d83f4..6631df6 100644
--- a/src/structures.c
+++ b/src/structures.c
@@ -1542,6 +1542,7 @@ rep_add_subr(rep_xsubr *subr, rep_bool export)
 	rep_struct_node *n = lookup_or_add (s, sym);
 	n->binding = rep_VAL (subr);
 	n->is_exported = export;
+	subr->structure = rep_structure;
     }
     return sym;
 }
diff --git a/src/symbols.c b/src/symbols.c
index 9b879d2..ad9eea7 100644
--- a/src/symbols.c
+++ b/src/symbols.c
@@ -417,7 +417,7 @@ Set the function value in the closure FUNARG to FUNCTION.
 DEFUN("closure-structure", Fclosure_structure,
       Sclosure_structure, (repv funarg), rep_Subr1) /*
 ::doc:rep.structures#closure-function::
-closure-function FUNARG
+closure-structure FUNARG
 
 Return the structure associated with the closure FUNARG.
 ::end:: */
@@ -426,6 +426,30 @@ Return the structure associated with the closure FUNARG.
     return rep_FUNARG(funarg)->structure;
 }
 
+DEFUN("subr-structure", Fsubr_structure,
+      Ssubr_structure, (repv arg), rep_Subr1) /*
+::doc:rep.structures#closure-function::
+subr-structure SUBR
+
+Return the structure associated with the subr SUBR.
+::end:: */
+{
+  /* Simple rep_DECLARE1 can't be used. Borrow rep_DECLARE1 macro
+     definition. */
+  do{
+    if(Fsubrp(arg) == Qnil){
+      rep_signal_arg_error(arg, 1);
+      return rep_NULL;
+    }
+  }while(0);
+
+  if(rep_XSUBR(arg)->structure != rep_NULL){
+    return rep_XSUBR(arg)->structure;
+  }else{
+    return Qnil;
+  }
+}
+
 DEFUN ("set-closure-structure", Fset_closure_structure,
        Sset_closure_structure, (repv closure, repv structure), rep_Subr2)
 {
@@ -1494,6 +1518,7 @@ rep_symbols_init(void)
     rep_ADD_SUBR(Sset_closure_function);
     rep_ADD_SUBR(Sclosure_name);
     rep_ADD_SUBR(Sclosurep);
+    rep_ADD_SUBR(Ssubr_structure);
     rep_pop_structure (tem);
 
     tem = rep_push_structure ("rep.structures");