home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / docstring.el < prev    next >
Encoding:
Text File  |  1992-07-27  |  18.6 KB  |  506 lines
  1. ;;; docstring.el
  2. ;;; Michael D. Ernst <mernst@theory.lcs.mit.edu>, August 1991
  3. ;;; Last modified:  July 25, 1992
  4.  
  5. ;; LCD Archive Entry:
  6. ;; docstring|Michael D. Ernst|mernst@theory.lcs.mit.edu|
  7. ;; Keep documentation consistent with Elisp code by substituting doc strings.|
  8. ;; 25-07-92|1.0|~/misc/docstring.el.Z|
  9.  
  10.  
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12. ;;; Overview
  13. ;;;
  14.  
  15. ;;; This code makes it easy to keep the documentation of Elisp code
  16. ;;; consistent with the code's documentation strings and key bindings, and
  17. ;;; to arrange that functions and variables are properly indexed.
  18.  
  19. ;;; It works by replacing special placeholders in your documentation, which
  20. ;;; are surrounded by <<<triple brockets>>>, by text such as documentation
  21. ;;; strings, key bindings, table preambles and postambles, and the results
  22. ;;; of evaluating arbitrary Elisp expressions.  It can produce output for
  23. ;;; use in texinfo documents or in ASCII documentation files; set variable
  24. ;;; ds-tex-output-p to nil to get ASCII output.
  25.  
  26. ;;; To run this, your code must be loaded (its keymaps and commands must be
  27. ;;; defined).
  28.  
  29.  
  30. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31. ;;; Commands
  32. ;;;
  33.  
  34. ;;; The top-level command is docstring-substitute, which replaces the
  35. ;;; placeholder forms after point in the current buffer with the
  36. ;;; appropriate text:
  37.  
  38. ;; <<<key:  keystroke>>>
  39. ;; <<<command:  command>>>
  40. ;;   Either of these is replaced by "key (command) description", where `key' is
  41. ;;   the printed representation of the keystroke, `command' is the name of
  42. ;;   the command, and `description' is the documentation string for
  43. ;;   command.  In `description', formal parameters are set in slanted type,
  44. ;;   and function and global variable names in typewriter font; functions
  45. ;;   and global variables are placed in the document's function and varible
  46. ;;   indices, respectively.
  47. ;; <<<variable:  variablename>>>
  48. ;;   This is replaced by "variablename documentation".
  49.  
  50. ;;; The above are appropriate for use in a table, and so must be surrounded
  51. ;;; by a table preamble and postamble:
  52.  
  53. ;; <<<table:start>>> or <<<table:begin>>>
  54. ;;   Preamble for a table of characters or M-x commands.
  55. ;;   Appropriate for a table of commands or keys.
  56. ;; <<<table:cstart>>> or <<<table:cbegin>>>
  57. ;;   Preamble for a table of variable or function names.
  58. ;; <<<table:end>>>
  59. ;;   Postamble for the above two types of table.
  60. ;; <<<table:fstart>>> or <<<table:fbegin>>>
  61. ;;   Preamble for a table of function names; table items are automatically
  62. ;;   inserted into the document's function index.
  63. ;; <<<table:fend>>>
  64. ;;   Postamble for a function table.
  65.  
  66. ;;; There are shortcuts for the above when a table only contains commands,
  67. ;;; only keys, or only variables.  Any number of items may follow the
  68. ;;; colon, but there should be no newlines between the <<< and >>>.
  69.  
  70. ;; <<<commandtable:  command, command, command>>>
  71. ;; <<<keytable:  key key key>>>
  72. ;; <<<variabletable:  var, var>>>
  73.  
  74. ;;; Key bindings (which appear in place of <<<command: >>> or <<<key: >>>)
  75. ;;; are looked up in the current local keymap.  To change it, use:
  76.  
  77. ;; <<<map:  form>>>
  78. ;;   This is removed from the buffer and replaced by the empty string; it
  79. ;;   is executed for side effect.  The local keymap is set to the result of
  80. ;;   evaluating form (which is probably a variable name).  The original
  81. ;;   local keymap is replaced when the call to docstring-substitute
  82. ;;   returns.
  83.  
  84. ;;; Finally, there is a way to insert arbitrary text in the documentation.
  85.  
  86. ;; <<<value:  form>>>
  87. ;;   This is replaced by the result of evaluating form.  This is a good way
  88. ;;   to insert a version number, today's date, etc.  You can also use it
  89. ;;   for side effect, as in the following:
  90. ;;       <<<value: (progn (require 'database) (load-database) "")>>>
  91.  
  92.  
  93.  
  94. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  95. ;;; Example
  96. ;;;
  97.  
  98. ;;; The text
  99.  
  100. ;; The usual save-file and write-file keystrokes are rebound in all
  101. ;; database modes.
  102. ;; 
  103. ;; <<<map:  database-view-mode-map>>>
  104. ;; <<<commandtable:  db-save-database, db-write-database-file>>>
  105.  
  106. ;;; becomes, after docstring-substitute is run,
  107.  
  108. ;; The usual save-file and write-file keystrokes are rebound in all
  109. ;; database modes.
  110. ;; 
  111. ;; @table @kbd
  112. ;; @item C-x C-s
  113. ;; @findex db-save-database
  114. ;; (@code{db-save-database})  Save the database to disk in the default save file.
  115. ;; Any changes to the current record are processed first.
  116. ;; The default save file is the file it was last saved to or read from.
  117. ;; 
  118. ;; @item C-x C-w
  119. ;; @findex db-write-database-file
  120. ;; (@code{db-write-database-file})  Save the database to disk in file @var{filename}, which becomes the default save file.
  121. ;; Any changes to the current record are processed first.
  122. ;; @end table
  123.  
  124.  
  125. ;;; I typically edit an unsubstituted documentation file (named, for
  126. ;;; instance, database.texi-unsub); when I want to create a new texinfo
  127. ;;; file, I execute `dostring-substitute' in its buffer and save the
  128. ;;; resulting buffer into the file database.texi.  I keep that
  129. ;;; database.texi write-protected so that I don't accidentally edit it, but
  130. ;;; override the protection when I'm saving a substituted version.
  131.  
  132.  
  133. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  134. ;;; Stylistic concerns
  135. ;;;
  136.  
  137. ;;; The documentation strings should be written in a stylized format to
  138. ;;; make recognition of formal parameters, functions, and global variables
  139. ;;; easier, and to prevent misrecognition of common words such as "insert"
  140. ;;; or "list".  This style appears to be a GNU standard for Elisp code.
  141. ;;;  * capitalize formal parameter names, that is, argument names
  142. ;;;  * suround function names (in documentation) with `'
  143. ;;;  * surround global variable names with extra whitespace
  144.  
  145. ;;; Here are the definitions of the functions in the example above.
  146. ;; (defun db-save-database ()
  147. ;;   "Save the database to disk in the default save file.
  148. ;; Any changes to the current record are processed first.
  149. ;; The default save file is the file it was last saved to or read from."
  150. ;;   ... )
  151. ;; (defun db-write-database-file (filename)
  152. ;;   "Save the database to disk in file FILENAME, which becomes the default save file.
  153. ;; Any changes to the current record are processed first."
  154. ;;   ... )
  155.  
  156.  
  157. ;;; It is worth repeating the GNU Emacs Lisp Manual's advice about the
  158. ;;; difference between a manual and documentation strings:
  159. ;;;     A collection of documentation strings is not sufficient as a manual
  160. ;;;     because a good manual is not organized in that fashion; it is
  161. ;;;     organized in terms of topics of discussion.
  162.  
  163. ;;; However, no manual is complete without the documentation of the
  164. ;;; package's commands, which complements the rest of the manual;
  165. ;;; docstring-substitute makes such tables easier to create and maintain.
  166. ;;; It has been my experience that writing documentation strings to be
  167. ;;; intelligible even in a manual is a good exercise which results in
  168. ;;; better documentation strings and better manuals.
  169.  
  170.  
  171. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  172. ;;; To do
  173. ;;;
  174.  
  175. ;;; Add lists of variables and functions not to index, even if they're
  176. ;;; marked up; for instance, `equal'.
  177.  
  178. ;;; Have option to put the original <<<...>>> in a comment instead of
  179. ;;; completely replacing it, so it's easy to see what happened.
  180.  
  181. ;;; Make push-mark in perform-replace stop saying "Mark set" all the time.
  182.  
  183. ;;; Make this more like substitute-command-keys.  I don't think I can use
  184. ;;; it directly, though.  Could make the syntax more like it (with tripled
  185. ;;; backslash or doubled [{<), if I felt like it.  I don't just now.
  186.  
  187.  
  188. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  189. ;;; Docstring-substitute
  190. ;;;
  191.  
  192.  
  193. (defvar ds-texinfo-output-p t
  194.   "Nil for ASCII substitution, t for texinfo.")
  195.  
  196.  
  197. ;; Maybe complain if didn't read the whole string in read-from-string.
  198. (defun docstring-substitute ()
  199.   "Substitute variable or function documentation into a buffer from point forward."
  200.   (interactive)
  201.   (let ((old-map (current-local-map))
  202.     command form obj-index obj docstring-errors)
  203.     (unwind-protect
  204.     (while (re-search-forward "<<<\\([a-z]+\\):[ \t]*\\(.*\\)>>>" nil t)
  205.       (setq command (ds-match-string 1)
  206.         form (ds-match-string 2)
  207.         obj-index (and (not (string-equal form ""))
  208.                    (read-from-string form))
  209.         obj (car obj-index))
  210.       (cond ((string-equal command "map")
  211.          (let ((eval-obj (eval obj)))
  212.            (if (keymapp eval-obj)
  213.                (progn
  214.              (replace-match "")
  215.              (use-local-map eval-obj)
  216.              (if (looking-at "^$")
  217.                  (delete-char 1)))
  218.              (message "`%s' (%s) isn't a keymap." obj eval-obj))))
  219.         ((string-equal command "table")
  220.          (replace-match (if ds-texinfo-output-p
  221.                     (cond ((or (eq obj 'start) (eq obj 'begin))
  222.                        "@table @kbd")
  223.                       ((or (eq obj 'cstart) (eq obj 'cbegin))
  224.                        "@table @code")
  225.                       ((or (eq obj 'fstart) (eq obj 'fbegin))
  226.                        "@ftable @code")
  227.                       ((eq obj 'end)
  228.                        "@end table")
  229.                       ((eq obj 'fend)
  230.                        "@end ftable")
  231.                       (t
  232.                        ;; no change
  233.                        (message "Bad `table' operative %s." obj)
  234.                        (ds-match-string 0)))
  235.                   "")))
  236.         ((string-equal command "command")
  237.          ;; this will err if there's trouble 
  238.          (if (and (fboundp obj) (symbol-function obj))
  239.              (progn
  240.                (replace-match "")
  241.                (ds-insert-keys-command (where-is-internal
  242.                          obj (current-local-map))
  243.                         obj))
  244.            (message "`%s' (%s) isn't a command." form obj)))
  245.         ((string-equal command "key")
  246.          (let* ((key (car (read-from-string (concat "\"" form "\""))))
  247.             (defn (key-binding key)))
  248.            (if (or (null defn) (integerp defn))
  249.                (message "%s is undefined" (key-description key))
  250.              (progn
  251.                (replace-match "")
  252.                (ds-insert-keys-command (list key) defn)))))
  253.         ((string-equal command "variable")
  254.          (let* ((var (car (read-from-string form))))
  255.            (if (boundp var)
  256.                (let ((doc-prop (documentation-property
  257.                     var 'variable-documentation)))
  258.              (if (and doc-prop (not (string-equal doc-prop ""))
  259.                   (char-equal ?* (aref doc-prop 0)))
  260.                  (setq doc-prop (substring doc-prop 1)))
  261.              ;; This appears to assume texinfo output
  262.              (replace-match (format "@item %s\n@vindex %s\n%s\n"
  263.                         var
  264.                         var
  265.                         (or (ds-massage-documentation
  266.                              doc-prop)
  267.                             "Not documented."))
  268.                     t t)
  269.              (if (looking-at "\n<<<table:end>>>")
  270.                  (delete-backward-char 1)))
  271.              (message "%s is undefined." var))))
  272.         ((string-equal command "commandtable")
  273.          ;; ftable is not appropriate here because the table items
  274.          ;; are still keys.  I do add a function index entry for
  275.          ;; the command.
  276.          (narrow-to-region (match-beginning 0) (match-end 0))
  277.          (replace-match (concat
  278.                  "<<<table:start>>>\n<<<command: "
  279.                  form
  280.                  ">>>\n<<<table:end>>>"))
  281.          (goto-char (point-min))
  282.          (ds-replace-regexp-quietly ",[ \t]+" ">>>\n\n<<<command: ")
  283.          (goto-char (point-min))
  284.          (widen))
  285.         ((string-equal command "keytable")
  286.          (narrow-to-region (match-beginning 0) (match-end 0))
  287.          ;; PROBLEM!  \ getting lost here.  Can't use replace-match.
  288.          (goto-char (point-min))
  289.          (ds-replace-regexp-quietly "<<<keytable:[ \t]*" "<<<table:start ")
  290.          ;; extra newline between table start and first key.  Oh well.
  291.          (goto-char (point-min))
  292.          (ds-replace-regexp-quietly " " ">>>\n\n<<<key:")
  293.          (goto-char (point-max))
  294.          (insert "\n<<<table:end>>>")
  295.          (goto-char (point-min))
  296.          (widen))
  297.         ((string-equal command "variabletable")
  298.          (narrow-to-region (match-beginning 0) (match-end 0))
  299.          (replace-match (concat
  300.                  "<<<table:cstart>>>\n<<<variable: "
  301.                  form
  302.                  ">>>\n<<<table:end>>>"))
  303.          (goto-char (point-min))
  304.          (ds-replace-regexp-quietly ",[ \t]*" ">>>\n\n<<<variable: ")
  305.          (goto-char (point-min))
  306.          (widen))
  307.         ((string-equal command "value")
  308.          (let ((value (eval (car (read-from-string form)))))
  309.            (replace-match (format "%s" value))))
  310.         (t
  311.          (message "Unrecognized command `%s' found with form `%s'."
  312.               command form))
  313.         ))
  314.       (progn
  315.     (use-local-map old-map)
  316.     (if (and buffer-file-name (not (string-match "-sub$" buffer-file-name)))
  317.         (setq buffer-file-name (concat buffer-file-name "-sub")))))))
  318.  
  319. (defun ds-insert-keys-command (keys command)
  320.   (if ds-texinfo-output-p
  321.       (progn
  322.     (insert "@item ")
  323.     (if keys
  324.         (insert (mapconcat (function ds-key-description)
  325.                    keys
  326.                    "\n@itemx ")
  327.             (format "\n@findex %s" command)
  328.             (format "\n(@code{%s})  " command))
  329.       (insert (format "%s%s\n" (if (commandp command) "M-x " "") command)
  330.           (format "@findex %s\n" command)))
  331.     (insert (if (documentation command)
  332.             (ds-massage-documentation (documentation command)
  333.                           (ds-command-arguments command))
  334.           "Not documented.")))
  335.     (progn
  336.       (if keys
  337.       (insert (mapconcat (function ds-key-description)
  338.                  keys
  339.                  "\n")
  340.           (format "\t(%s)" command))
  341.     (insert (format "M-x %s" command)))
  342.       (insert "\n")
  343.       (insert (or (documentation command)
  344.           "not documented")))))
  345.  
  346. (defun ds-command-arguments (command)
  347.   (let ((sym-func (symbol-function command)))
  348.     (delq '&rest (delq '&optional (car (cdr (if (eq (car sym-func) 'macro)
  349.                         (cdr sym-func)
  350.                           sym-func)))))))
  351.  
  352. (defun ds-key-description (keys)
  353.   "Like `key-description', but changes \"ESC char\" into \"M-char\"."
  354.   (ds-string-substitute-substring-general-case "M-" "ESC " (key-description keys)))
  355.  
  356. ;; DOC is a string; we want to downcase and index the function and variable
  357. ;; names that appear in it.  ARGUMENTS is a list of arguments, if this is a
  358. ;; command's documentation.
  359. (defun ds-massage-documentation (doc &optional arguments)
  360.   ;; I used to seem to need a save-excursion, for some odd reason; no more.
  361.   (let ((old-match-data (match-data)))
  362.     (save-window-excursion
  363.       (set-buffer (get-buffer-create " mapsymbol-temp-buffer"))
  364.       (emacs-lisp-mode)
  365.       (erase-buffer)
  366.       (insert doc)
  367.       (let ((case-fold-search nil))
  368.     ;; Command arguments.
  369.     (let (arg upcased-arg-regexp replacement)
  370.       (while arguments
  371.         (setq arg (symbol-name (car arguments))
  372.           upcased-arg-regexp (concat "\\<" (upcase arg) "\\(th\\)?\\>")
  373.           replacement (concat "@var{" arg "}\\1")
  374.           arguments (cdr arguments))
  375.         (goto-char (point-min))
  376.         (while (re-search-forward upcased-arg-regexp nil t)
  377.           (replace-match replacement t))))
  378.     ;; Functions.
  379.     (goto-char (point-min))
  380.     (let (function-name function-symbol)
  381.       (while (re-search-forward "`\\(\\sw\\|\\s_\\)+\\('\\)" nil t)
  382.         (setq function-name (ds-match-string 1)
  383.           function-symbol (intern-soft function-name))
  384.         (if (fboundp function-symbol)
  385.         (progn
  386.           (replace-match "@code{\\1}")
  387.           (save-excursion
  388.             (beginning-of-line)
  389.             (insert "@findex " (symbol-name function-symbol) "\n"))))))
  390.     ;; Global variables.
  391.     (goto-char (point-min))
  392.     (let (variable-name variable-symbol)
  393.       ;; Find double-whitespace, symbol, punctuation-or-double-whitespace.
  394.       ;; Recall we are using the Emacs Lisp syntax table.
  395.       (while (re-search-forward (concat "\\(  \\|\n\\)"
  396.                         "\\(\\sw\\|\\s_\\)+"
  397.                         "\\(  \\|\n\\|\\s.\\|\\s'\\)")
  398.                     nil t)
  399.         (setq variable-name (ds-match-string 2)
  400.           variable-symbol (intern-soft variable-name))
  401.  
  402.         ;; Test that the symbol has documentation (ie, is defvar'ed)
  403.         ;; rather than just that it has been interned at some point.
  404.         (if (documentation-property variable-symbol 'variable-documentation)
  405.         (progn
  406.           (replace-match "\\1@code{\\2}\\3")
  407.           (save-excursion
  408.             (beginning-of-line)
  409.             (insert "@vindex " (symbol-name variable-symbol) "\n"))))))
  410.     ;; Special constants.
  411.     (goto-char (point-min))
  412.     (while (re-search-forward "\\<\\(nil\\|t\\)\\>" nil t)
  413.       (replace-match "@code{\\1}"))
  414.      ;; Make sure indexing commands start at the beginning of the line.
  415.     (goto-char (point-min))
  416.     (if (looking-at "@")
  417.         (insert "\n"))
  418.     (store-match-data old-match-data)
  419.     (buffer-string)))
  420.     ))
  421.  
  422.  
  423. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  424. ;;; Utility functions
  425. ;;;
  426.  
  427. (defun ds-replace-regexp-quietly (regexp to-string &optional delimited)
  428.   "Like `replace-regexp', but doesn't message \"Done\" afterward."
  429.   (perform-replace regexp to-string nil t delimited))
  430.  
  431. (defun ds-match-string (n &optional source)
  432.   "Returns the string matched by parentheses number N.  If there is a
  433. SOURCE string, returns the substring of that string; else, returns
  434. substring of the current buffer."
  435.   (cond
  436.    ((stringp source)
  437.     (substring source (match-beginning n) (match-end n)))
  438.    (t (buffer-substring (match-beginning n) (match-end n)))))
  439.  
  440.  
  441. (defun ds-string-substitute-substring-general-case (new old-regexp string)
  442.   "Calls `ds-string-replace-regexp-2'.  Beware special meaning of \\!."
  443.   (ds-string-replace-regexp-2 string old-regexp new))
  444.  
  445. ;; Dies a horrible death if passed a very long string, which is why we use
  446. ;; string-replace-regexp-2 instead.
  447. (defun ds-string-substitute-substring-general-case-1 (new old-regexp string)
  448.   (if (string-match old-regexp string)
  449.       (concat (substring string 0 (match-beginning 0))
  450.           new
  451.           (ds-string-substitute-substring-general-case
  452.            new old-regexp (substring string (match-end 0))))
  453.     string))
  454.  
  455. ;; If much replacement is going to happen, this is more efficient.
  456. ;; Original version from gaynor@brushfire.rutgers.edu (Silver).
  457. (defun ds-string-replace-regexp-2 (string regexp replacement)
  458.   "Return the string resulting by replacing all of STRING's instances of REGEXP
  459. with REPLACEMENT."
  460.   (save-excursion
  461.     (set-buffer (get-buffer-create " *Temporary*"))
  462.     (erase-buffer)
  463.     (buffer-flush-undo (current-buffer))
  464.     (save-excursion (insert string))
  465.     (while (re-search-forward regexp nil t)
  466.       (replace-match replacement))
  467.     (buffer-string)
  468.     ))
  469.  
  470.  
  471. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  472. ;;; Unused
  473. ;;;
  474.  
  475. (defun ds-mapsymbol (function &optional string)
  476.   "Applies FUNCTION to each symbol in STRING if non-nil; otherwise, in buffer.
  477. Each symbol is replaced by the function call result, which must be a string!
  478. If STRING is non-nil, the result is returned."
  479.   (save-window-excursion
  480.     (if (not string)
  481.     (progn
  482.       (set-buffer (get-buffer-create " mapsymbol-temp-buffer"))
  483.       (erase-buffer)
  484.       (insert string)))
  485.     ;; The save-excursion isn't necessary if STRING was specified, but I
  486.     ;; don't want to special-case this.
  487.     (save-excursion
  488.        (goto-char (point-min))
  489.        (while (re-search-forward "\\(\\sw\\|\\s_\\)+")
  490.      (replace-match (funcall function (ds-match-string 0)))))
  491.     (if string
  492.     (buffer-string))))
  493.  
  494.  
  495. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  496. ;;; Testing
  497. ;;;
  498.  
  499. ;; Some of these usages are (intentionally) incorrect.  It's for testing.
  500. (defvar ds-test-defvar 3
  501.   "Variable affecting `ds-test-defun', which takes args FOO and BAR but not BAZ.")
  502. (defun ds-test-defun (foo &optional bar)
  503.   "Function taking FOO and BAR but not BAZ and  affected  by  ds-test-defvar."
  504.   ds-test-defvar)
  505.  
  506.