doc/maint/docstring.el

   1 ;;; docstring.el --- utilities for Guile docstring maintenance
   2 ;;;
   3 ;;; Copyright (C) 2001 Neil Jerram
   4 ;;;
   5 ;;; This file is not part of GNU Emacs, but the same permissions apply.
   6 ;;;
   7 ;;; GNU Emacs is free software; you can redistribute it and/or modify
   8 ;;; it under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 2, or (at your option)
  10 ;;; any later version.
  11 ;;;
  12 ;;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  19 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 ;;; Boston, MA 02111-1307, USA.
  21
  22 ;;; Commentary:
  23
  24 ;; The basic premise of these utilities is that - at least in the
  25 ;; short term - we can get a lot of reference manual mileage by
  26 ;; co-opting the docstrings that are snarfed automatically from
  27 ;; Guile's C and Scheme source code.  But this leads to problems of
  28 ;; synchronization...  How do you track when a docstring has been
  29 ;; updated in the source and so needs updating in the reference
  30 ;; manual.  What if a procedure is removed from the Guile source?  And
  31 ;; so on.  To complicate matters, the exact snarfed docstring text
  32 ;; will probably need to be modified so that it fits into the flow of
  33 ;; the manual section in which it appears.  Can we design solutions to
  34 ;; synchronization problems that continue to work even when the manual
  35 ;; text has been enhanced in this way?
  36 ;;
  37 ;; This file implements an approach to this problem that I have found
  38 ;; useful.  It involves keeping track of three copies of each
  39 ;; docstring:
  40 ;;
  41 ;; "MANUAL"   = the docstring as it appears in the reference manual.
  42 ;;
  43 ;; "SNARFED"  = the docstring as snarfed from the current C or Scheme
  44 ;;              source.
  45 ;;
  46 ;; "TRACKING" = the docstring as it appears in a tracking file whose
  47 ;;              purpose is to record the most recent snarfed docstrings
  48 ;;              that are known to be in sync with the reference manual.
  49 ;;
  50 ;; The approaches are as follows.
  51 ;;
  52 ;; 1. Comparison of MANUAL-DOC, SOURCE-DOC and TRACK-DOC, to produce a
  53 ;; summary output buffer in which keystrokes are defined to bring up
  54 ;; detailed comparisons.
  55 ;;
  56 ;; 2. Comparison of MANUAL-DOC, SOURCE-DOC and TRACK-DOC using Ediff.
  57
  58 ;;; Code:
  59
  60 (defvar docstring-manual-directory (expand-file-name "~/Guile/cvs/guile-core/doc")
  61   "*The directory containing the Texinfo source for the Guile reference manual.")
  62
  63 (defvar docstring-tracking-root (expand-file-name "~/Guile/cvs/guile-core/doc/maint")
  64   "*Root directory for docstring tracking files.  The tracking file
  65 for module (a b c) is expected to be in the file
  66 <docstring-tracking-root>/a/b/c.texi.")
  67
  68 (defvar docstring-snarfed-roots (list (expand-file-name "~/Guile/cvs/guile-core/libguile")
  69                                       (expand-file-name "~/Guile/cvs/guile-core/ice-9")
  70                                       (expand-file-name "~/Guile/cvs/guile-core/oop"))
  71   "*List of possible root directories for snarfed docstring files.
  72 For each entry in this list, the snarfed docstring file for module (a
  73 b c) is looked for in the file <entry>/a/b/c.texi.")
  74
  75 (defvar docstring-manual-files '("appendices.texi"
  76                                  "deprecated.texi"
  77                                  "expect.texi"
  78                                  "gh.texi"
  79                                  "goops.texi"
  80                                  "guile.texi"
  81                                  "indices.texi"
  82                                  "intro.texi"
  83                                  "posix.texi"
  84                                  "scheme-binding.texi"
  85                                  "scheme-control.texi"
  86                                  "scheme-data.texi"
  87                                  "scheme-debug.texi"
  88                                  "scheme-evaluation.texi"
  89                                  "scheme-ideas.texi"
  90                                  "scheme-indices.texi"
  91                                  "scheme-intro.texi"
  92                                  "scheme-io.texi"
  93                                  "scheme-memory.texi"
  94                                  "scheme-modules.texi"
  95                                  "scheme-options.texi"
  96                                  "scheme-procedures.texi"
  97                                  "scheme-reading.texi"
  98                                  "scheme-scheduling.texi"
  99                                  "scheme-translation.texi"
 100                                  "scheme-utility.texi"
 101                                  "scm.texi"
 102                                  "scripts.texi"
 103                                  "scsh.texi"
 104                                  "slib.texi"
 105                                  "tcltk.texi")
 106   "List of Texinfo source files that comprise the Guile reference manual.")
 107
 108 (defvar docstring-new-docstrings-file "new-docstrings.texi"
 109   "The name of a file in the Guile reference manual source directory
 110 to which new docstrings should be added.")
 111
 112 ;; Apply FN in turn to each element in the list CANDIDATES until the
 113 ;; first application that returns non-nil.
 114 (defun or-map (fn candidates args)
 115   (let ((result nil))
 116     (while candidates
 117       (setq result (apply fn (car candidates) args))
 118       (if result
 119           (setq result (cons (car candidates) result)
 120                 candidates nil)
 121         (setq candidates (cdr candidates))))
 122     result))
 123
 124 ;; Return t if the current buffer position is in the scope of the
 125 ;; specified MODULE, as determined by "@c module ..." comments in the
 126 ;; buffer.  DEFAULT-OK specifies the return value in the case that
 127 ;; there are no preceding module comments at all.
 128 (defun docstring-in-module (module default-ok)
 129   (save-excursion
 130     (if (re-search-backward "^@c module " nil t)
 131         (progn
 132           (search-forward "@c module ")
 133           (equal module (read (current-buffer))))
 134       default-ok)))
 135
 136 ;; Find a docstring in the specified FILE-NAME for the item in module
 137 ;; MODULE and with description DESCRIPTION.  MODULE should be a list
 138 ;; of symbols, Guile-style, for example: '(ice-9 session).
 139 ;; DESCRIPTION should be the string that is expected after the @deffn,
 140 ;; for example "primitive acons" or "syntax let*".
 141 (defun find-docstring (file-name module description)
 142   (and (file-exists-p file-name)
 143        (let ((buf (find-file-noselect file-name))
 144              (deffn-regexp (concat "^@deffnx? "
 145                                    (regexp-quote description)
 146                                    "[ \n\t]"))
 147              found
 148              result)
 149          (save-excursion
 150            (set-buffer buf)
 151            (goto-char (point-min))
 152            (while (and (not found)
 153                        (re-search-forward deffn-regexp nil t))
 154              (save-excursion
 155                (goto-char (match-beginning 0))
 156                (beginning-of-line)
 157                (if (docstring-in-module module t)
 158                    (setq found t))))
 159            (if found
 160                (setq result
 161                      (list (current-buffer)
 162                            (progn
 163                              (re-search-backward "^@deffn ")
 164                              (beginning-of-line)
 165                              (point))
 166                            (progn
 167                              (re-search-forward "^@end deffn")
 168                              (forward-line 1)
 169                              (point))))))
 170          result)))
 171
 172 ;; Find the reference manual version of the specified docstring.
 173 ;; MODULE and DESCRIPTION specify the docstring as per
 174 ;; `find-docstring'.  The set of files that `find-manual-docstring'
 175 ;; searches is determined by the value of the `docstring-manual-files'
 176 ;; variable.
 177 (defun find-manual-docstring (module description)
 178   (let* ((result
 179           (or-map 'find-docstring
 180                   (mapcar (function (lambda (file-name)
 181                                       (concat docstring-manual-directory
 182                                               "/"
 183                                               file-name)))
 184                           (cons docstring-new-docstrings-file
 185                                 docstring-manual-files))
 186                   (list module
 187                         description)))
 188          (matched-file-name (and (cdr result)
 189                                  (file-name-nondirectory (car result)))))
 190     (if matched-file-name
 191         (setq docstring-manual-files
 192               (cons matched-file-name
 193                     (delete matched-file-name docstring-manual-files))))
 194     (cdr result)))
 195
 196 ;; Convert MODULE to a directory subpath.
 197 (defun module-to-path (module)
 198   (mapconcat (function (lambda (component)
 199                          (symbol-name component)))
 200              module
 201              "/"))
 202
 203 ;; Find the current snarfed version of the specified docstring.
 204 ;; MODULE and DESCRIPTION specify the docstring as per
 205 ;; `find-docstring'.  The file that `find-snarfed-docstring' looks in
 206 ;; is automatically generated from MODULE.
 207 (defun find-snarfed-docstring (module description)
 208   (let ((modpath (module-to-path module)))
 209     (cdr (or-map (function (lambda (root)
 210                              (find-docstring (concat root
 211                                                      "/"
 212                                                      modpath
 213                                                      ".texi")
 214                                              module
 215                                              description)))
 216                  docstring-snarfed-roots
 217                  nil))))
 218
 219 ;; Find the tracking version of the specified docstring.  MODULE and
 220 ;; DESCRIPTION specify the docstring as per `find-docstring'.  The
 221 ;; file that `find-tracking-docstring' looks in is automatically
 222 ;; generated from MODULE.
 223 (defun find-tracking-docstring (module description)
 224   (find-docstring (concat docstring-tracking-root
 225                           "/"
 226                           (module-to-path module)
 227                           ".texi")
 228                   module
 229                   description))
 230
 231 ;; Extract an alist of modules and descriptions from the current
 232 ;; buffer.
 233 (defun make-module-description-list ()
 234   (let ((alist nil)
 235         (module '(guile)))
 236     (save-excursion
 237       (goto-char (point-min))
 238       (while (re-search-forward "^\\(@c module \\|@deffnx? \\({[^}]+}\\|[^ ]+\\) \\([^ \n]+\\)\\)"
 239                                 nil
 240                                 t)
 241         (let ((matched (buffer-substring (match-beginning 1)
 242                                          (match-end 1))))
 243           (if (string-equal matched "@c module ")
 244               (setq module (read (current-buffer)))
 245             (setq matched
 246                   (concat (buffer-substring (match-beginning 2)
 247                                             (match-end 2))
 248                           " "
 249                           (buffer-substring (match-beginning 3)
 250                                             (match-end 3))))
 251             (message "Found docstring: %S: %s" module matched)
 252             (let ((descriptions (assoc module alist)))
 253               (setq alist
 254                     (cons (cons module (cons matched (cdr-safe descriptions)))
 255                           (if descriptions
 256                               (delete descriptions alist)
 257                             alist))))))))
 258     alist))
 259
 260 ;; Return the docstring from the specified LOCATION.  LOCATION is a
 261 ;; list of three elements: buffer, start position and end position.
 262 (defun location-to-docstring (location)
 263   (and location
 264        (save-excursion
 265          (set-buffer (car location))
 266          (buffer-substring (cadr location) (caddr location)))))
 267
 268 ;; Perform a comparison of the specified docstring.  MODULE and
 269 ;; DESCRIPTION are as per usual.
 270 (defun docstring-compare (module description)
 271   (let* ((manual-location (find-manual-docstring module description))
 272          (snarf-location (find-snarfed-docstring module description))
 273          (track-location (find-tracking-docstring module description))
 274
 275          (manual-docstring (location-to-docstring manual-location))
 276          (snarf-docstring (location-to-docstring snarf-location))
 277          (track-docstring (location-to-docstring track-location))
 278
 279          action
 280          issue)
 281
 282     ;; Decide what to do.
 283     (cond ((null snarf-location)
 284            (setq action nil
 285                  issue (if manual-location
 286                            'consider-removal
 287                          nil)))
 288
 289           ((null manual-location)
 290            (setq action 'add-to-manual issue nil))
 291
 292           ((null track-location)
 293            (setq action nil
 294                  issue (if (string-equal manual-docstring snarf-docstring)
 295                            nil
 296                          'check-needed)))
 297
 298           ((string-equal track-docstring snarf-docstring)
 299            (setq action nil issue nil))
 300
 301           ((string-equal track-docstring manual-docstring)
 302            (setq action 'auto-update-manual issue nil))
 303
 304           (t
 305            (setq action nil issue 'update-needed)))
 306
 307     ;; Return a pair indicating any automatic action that can be
 308     ;; taken, and any issue for resolution.
 309     (cons action issue)))
 310
 311 ;; Add the specified docstring to the manual.
 312 (defun docstring-add-to-manual (module description)
 313   (let ((buf (find-file-noselect (concat docstring-manual-directory
 314                                          "/"
 315                                          docstring-new-docstrings-file))))
 316     (save-excursion
 317       (set-buffer buf)
 318       (goto-char (point-max))
 319       (or (docstring-in-module module nil)
 320           (insert "\n@c module " (prin1-to-string module) "\n"))
 321       (insert "\n" (location-to-docstring (find-snarfed-docstring module
 322                                                                   description))))))
 323
 324 ;; Auto-update the specified docstring in the manual.
 325 (defun docstring-auto-update-manual (module description)
 326   (let ((manual-location (find-manual-docstring module description))
 327         (track-location (find-tracking-docstring module description)))
 328     (save-excursion
 329       (set-buffer (car manual-location))
 330       (goto-char (cadr manual-location))
 331       (delete-region (cadr manual-location) (caddr manual-location))
 332       (insert (location-to-docstring (find-snarfed-docstring module
 333                                                              description))))))
 334
 335 ;; Process an alist of modules and descriptions, and produce a summary
 336 ;; buffer describing actions taken and issues to be resolved.
 337 (defun docstring-process-alist (alist)
 338   (let (check-needed-list
 339         update-needed-list
 340         consider-removal-list
 341         added-to-manual-list
 342         auto-updated-manual-list)
 343
 344     (mapcar
 345      (function (lambda (module-list)
 346                  (let ((module (car module-list)))
 347                    (message "Module: %S" module)
 348                    (mapcar
 349                     (function (lambda (description)
 350                                 (message "Comparing docstring: %S: %s" module description)
 351                                 (let* ((ai (docstring-compare module description))
 352                                        (action (car ai))
 353                                        (issue (cdr ai)))
 354
 355                                   (cond ((eq action 'add-to-manual)
 356                                          (docstring-add-to-manual module description)
 357                                          (setq added-to-manual-list
 358                                                (cons (cons module description)
 359                                                      added-to-manual-list)))
 360
 361                                         ((eq action 'auto-update-manual)
 362                                          (docstring-auto-update-manual module description)
 363                                          (setq auto-updated-manual-list
 364                                                (cons (cons module description)
 365                                                      auto-updated-manual-list))))
 366
 367                                   (cond ((eq issue 'check-needed)
 368                                          (setq check-needed-list
 369                                                (cons (cons module description)
 370                                                      check-needed-list)))
 371
 372                                         ((eq issue 'update-needed)
 373                                          (setq update-needed-list
 374                                                (cons (cons module description)
 375                                                      update-needed-list)))
 376
 377                                         ((eq issue 'consider-removal)
 378                                          (setq consider-removal-list
 379                                                (cons (cons module description)
 380                                                      consider-removal-list)))))))
 381                     (cdr module-list)))))
 382      alist)
 383
 384     ;; Prepare a buffer describing the results.
 385     (set-buffer (get-buffer-create "*Docstring Results*"))
 386     (erase-buffer)
 387
 388     (insert "
 389 The following items have been automatically added to the manual in
 390 file `" docstring-manual-directory "/" docstring-new-docstrings-file "'.\n\n")
 391     (if added-to-manual-list
 392         (mapcar (function (lambda (moddesc)
 393                             (insert (prin1-to-string (car moddesc))
 394                                     ": "
 395                                     (cdr moddesc)
 396                                     "\n")))
 397                 added-to-manual-list)
 398       (insert "(none)\n"))
 399
 400     (insert "
 401 The following items have been automatically updated in the manual.\n\n")
 402     (if auto-updated-manual-list
 403         (mapcar (function (lambda (moddesc)
 404                             (insert (prin1-to-string (car moddesc))
 405                                     ": "
 406                                     (cdr moddesc)
 407                                     "\n")))
 408                 auto-updated-manual-list)
 409       (insert "(none)\n"))
 410
 411     (insert "
 412 The following items are already documented in the manual but are not
 413 mentioned in the reference copy of the snarfed docstrings file.
 414 You should check that the manual documentation matches the docstring
 415 in the current snarfed docstrings file.\n\n")
 416     (if check-needed-list
 417         (mapcar (function (lambda (moddesc)
 418                             (insert (prin1-to-string (car moddesc))
 419                                     ": "
 420                                     (cdr moddesc)
 421                                     "\n")))
 422                 check-needed-list)
 423       (insert "(none)\n"))
 424
 425     (insert "
 426 The following items have manual documentation that is different from
 427 the docstring in the reference copy of the snarfed docstrings file,
 428 and the snarfed docstring has changed.  You need to update the manual
 429 documentation by hand with reference to the snarfed docstring changes.\n\n")
 430     (if update-needed-list
 431         (mapcar (function (lambda (moddesc)
 432                             (insert (prin1-to-string (car moddesc))
 433                                     ": "
 434                                     (cdr moddesc)
 435                                     "\n")))
 436                 update-needed-list)
 437       (insert "(none)\n"))
 438
 439     (insert "
 440 The following items are documented in the manual but are no longer
 441 present in the snarfed docstrings file.  You should consider whether
 442 the existing manual documentation is still pertinent.  If it is, its
 443 docstring module comment may need updating, to connect it with a
 444 new snarfed docstring file.\n\n")
 445     (if consider-removal-list
 446         (mapcar (function (lambda (moddesc)
 447                             (insert (prin1-to-string (car moddesc))
 448                                     ": "
 449                                     (cdr moddesc)
 450                                     "\n")))
 451                 consider-removal-list)
 452       (insert "(none)\n"))
 453     (insert "\n")
 454
 455     (goto-char (point-min))
 456
 457     ;; Popup the issues buffer.
 458     (let ((pop-up-frames t))
 459       (set-window-point (display-buffer (current-buffer))
 460                         (point-min)))))
 461
 462 (defun docstring-process-current-buffer ()
 463   (interactive)
 464   (docstring-process-alist (make-module-description-list)))
 465
 466 (defun docstring-process-current-region (beg end)
 467   (interactive "r")
 468   (narrow-to-region beg end)
 469   (unwind-protect
 470       (save-excursion
 471         (docstring-process-alist (make-module-description-list)))
 472     (widen)))
 473
 474 (defun docstring-process-module (module)
 475   (interactive "xModule: ")
 476   (let ((modpath (module-to-path module))
 477         (mdlist nil))
 478     (mapcar (function (lambda (root)
 479                         (let ((fn (concat root
 480                                           "/"
 481                                           modpath
 482                                           ".texi")))
 483                           (if (file-exists-p fn)
 484                               (save-excursion
 485                                 (find-file fn)
 486                                 (message "Getting docstring list from %s" fn)
 487                                 (setq mdlist
 488                                       (append mdlist
 489                                               (make-module-description-list))))))))
 490             docstring-snarfed-roots)
 491     (docstring-process-alist mdlist)))
 492
 493 (defun docstring-ediff-this-line ()
 494   (interactive)
 495   (let (module
 496         description)
 497     (save-excursion
 498       (beginning-of-line)
 499       (setq module (read (current-buffer)))
 500       (forward-char 2)
 501       (setq description (buffer-substring (point)
 502                                           (progn
 503                                             (end-of-line)
 504                                             (point)))))
 505
 506     (message "Ediff docstring: %S: %s" module description)
 507
 508     (let ((track-location (or (find-tracking-docstring module description)
 509                               (docstring-temp-location "No docstring in tracking file")))
 510           (snarf-location (or (find-snarfed-docstring module description)
 511                               (docstring-temp-location "No docstring in snarfed file")))
 512           (manual-location (or (find-manual-docstring module description)
 513                                (docstring-temp-location "No docstring in manual"))))
 514
 515       (setq docstring-ediff-buffers
 516             (list (car track-location)
 517                   (car snarf-location)
 518                   (car manual-location)))
 519
 520       (docstring-narrow-to-location track-location)
 521       (docstring-narrow-to-location snarf-location)
 522       (docstring-narrow-to-location manual-location)
 523
 524       (add-hook 'ediff-quit-hook 'docstring-widen-ediff-buffers)
 525
 526     (ediff-buffers3 (nth 0 docstring-ediff-buffers)
 527                     (nth 1 docstring-ediff-buffers)
 528                     (nth 2 docstring-ediff-buffers)))))
 529
 530 (defun docstring-narrow-to-location (location)
 531   (save-excursion
 532     (set-buffer (car location))
 533     (narrow-to-region (cadr location) (caddr location))))
 534
 535 (defun docstring-temp-location (str)
 536   (let ((buf (generate-new-buffer "*Docstring Temp*")))
 537     (save-excursion
 538       (set-buffer buf)
 539       (erase-buffer)
 540       (insert str "\n")
 541       (list buf (point-min) (point-max)))))
 542
 543 (require 'ediff)
 544
 545 (defvar docstring-ediff-buffers '())
 546
 547 (defun docstring-widen-ediff-buffers ()
 548   (remove-hook 'ediff-quit-hook 'docstring-widen-ediff-buffers)
 549   (save-excursion
 550     (mapcar (function (lambda (buffer)
 551                         (set-buffer buffer)
 552                         (widen)))
 553             docstring-ediff-buffers)))
 554
 555
 556 ;;; Tests:
 557
 558 ;(find-docstring "/home/neil/Guile/cvs/guile-core/doc/maint/guile.texi" nil "primitive sloppy-assq")
 559 ;(find-manual-docstring '(guile) "primitive sloppy-assq")
 560 ;(find-tracking-docstring '(guile) "primitive sloppy-assq")
 561 ;(find-snarfed-docstring '(guile) "primitive sloppy-assq")
 562
 563 (provide 'docstring)