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 guile-core-dir (or (getenv "GUILE_MAINTAINER_GUILE_CORE_DIR")
  61                            "~/Guile/cvs/guile-core"))
  62
  63 (defvar docstring-manual-directory (expand-file-name "doc/ref" guile-core-dir)
  64   "*The directory containing the Texinfo source for the Guile reference manual.")
  65
  66 (defvar docstring-tracking-root (expand-file-name "doc/maint" guile-core-dir)
  67   "*Root directory for docstring tracking files.  The tracking file
  68 for module (a b c) is expected to be in the file
  69 <docstring-tracking-root>/a/b/c.texi.")
  70
  71 (defvar docstring-snarfed-roots (mapcar
  72                                  #'(lambda (frag)
  73                                      (expand-file-name frag guile-core-dir))
  74                                  '("libguile" "ice-9" "oop"))
  75   "*List of possible root directories for snarfed docstring files.
  76 For each entry in this list, the snarfed docstring file for module (a
  77 b c) is looked for in the file <entry>/a/b/c.texi.")
  78
  79 (defvar docstring-manual-files
  80   (directory-files docstring-manual-directory nil "\\.texi$" t)
  81   "List of Texinfo source files that comprise the Guile reference manual.")
  82
  83 (defvar docstring-new-docstrings-file "new-docstrings.texi"
  84   "The name of a file in the Guile reference manual source directory
  85 to which new docstrings should be added.")
  86
  87 ;; Apply FN in turn to each element in the list CANDIDATES until the
  88 ;; first application that returns non-nil.
  89 (defun or-map (fn candidates args)
  90   (let ((result nil))
  91     (while candidates
  92       (setq result (apply fn (car candidates) args))
  93       (if result
  94           (setq result (cons (car candidates) result)
  95                 candidates nil)
  96         (setq candidates (cdr candidates))))
  97     result))
  98
  99 ;; Return t if the current buffer position is in the scope of the
 100 ;; specified MODULE, as determined by "@c module ..." comments in the
 101 ;; buffer.  DEFAULT-OK specifies the return value in the case that
 102 ;; there are no preceding module comments at all.
 103 (defun docstring-in-module (module default-ok)
 104   (save-excursion
 105     (if (re-search-backward "^@c module " nil t)
 106         (progn
 107           (search-forward "@c module ")
 108           (equal module (read (current-buffer))))
 109       default-ok)))
 110
 111 ;; Find a docstring in the specified FILE-NAME for the item in module
 112 ;; MODULE and with description DESCRIPTION.  MODULE should be a list
 113 ;; of symbols, Guile-style, for example: '(ice-9 session).
 114 ;; DESCRIPTION should be the string that is expected after the @deffn,
 115 ;; for example "primitive acons" or "syntax let*".
 116 (defun find-docstring (file-name module description)
 117   (and (file-exists-p file-name)
 118        (let ((buf (find-file-noselect file-name))
 119              (deffn-regexp (concat "^@deffnx? "
 120                                    (regexp-quote description)
 121                                    "[ \n\t]"))
 122              found
 123              result)
 124          (save-excursion
 125            (set-buffer buf)
 126            (goto-char (point-min))
 127            (while (and (not found)
 128                        (re-search-forward deffn-regexp nil t))
 129              (save-excursion
 130                (goto-char (match-beginning 0))
 131                (beginning-of-line)
 132                (if (docstring-in-module module t)
 133                    (setq found t))))
 134            (if found
 135                (setq result
 136                      (list (current-buffer)
 137                            (progn
 138                              (re-search-backward "^@deffn ")
 139                              (beginning-of-line)
 140                              (point))
 141                            (progn
 142                              (re-search-forward "^@end deffn")
 143                              (forward-line 1)
 144                              (point))))))
 145          result)))
 146
 147 ;; Find the reference manual version of the specified docstring.
 148 ;; MODULE and DESCRIPTION specify the docstring as per
 149 ;; `find-docstring'.  The set of files that `find-manual-docstring'
 150 ;; searches is determined by the value of the `docstring-manual-files'
 151 ;; variable.
 152 (defun find-manual-docstring (module description)
 153   (let* ((result
 154           (or-map 'find-docstring
 155                   (mapcar (function (lambda (file-name)
 156                                       (concat docstring-manual-directory
 157                                               "/"
 158                                               file-name)))
 159                           (cons docstring-new-docstrings-file
 160                                 docstring-manual-files))
 161                   (list module
 162                         description)))
 163          (matched-file-name (and (cdr result)
 164                                  (file-name-nondirectory (car result)))))
 165     (if matched-file-name
 166         (setq docstring-manual-files
 167               (cons matched-file-name
 168                     (delete matched-file-name docstring-manual-files))))
 169     (cdr result)))
 170
 171 ;; Convert MODULE to a directory subpath.
 172 (defun module-to-path (module)
 173   (mapconcat (function (lambda (component)
 174                          (symbol-name component)))
 175              module
 176              "/"))
 177
 178 ;; Find the current snarfed version of the specified docstring.
 179 ;; MODULE and DESCRIPTION specify the docstring as per
 180 ;; `find-docstring'.  The file that `find-snarfed-docstring' looks in
 181 ;; is automatically generated from MODULE.
 182 (defun find-snarfed-docstring (module description)
 183   (let ((modpath (module-to-path module)))
 184     (cdr (or-map (function (lambda (root)
 185                              (find-docstring (concat root
 186                                                      "/"
 187                                                      modpath
 188                                                      ".texi")
 189                                              module
 190                                              description)))
 191                  docstring-snarfed-roots
 192                  nil))))
 193
 194 ;; Find the tracking version of the specified docstring.  MODULE and
 195 ;; DESCRIPTION specify the docstring as per `find-docstring'.  The
 196 ;; file that `find-tracking-docstring' looks in is automatically
 197 ;; generated from MODULE.
 198 (defun find-tracking-docstring (module description)
 199   (find-docstring (concat docstring-tracking-root
 200                           "/"
 201                           (module-to-path module)
 202                           ".texi")
 203                   module
 204                   description))
 205
 206 ;; Extract an alist of modules and descriptions from the current
 207 ;; buffer.
 208 (defun make-module-description-list ()
 209   (let ((alist nil)
 210         (module '(guile)))
 211     (save-excursion
 212       (goto-char (point-min))
 213       (while (re-search-forward "^\\(@c module \\|@deffnx? \\({[^}]+}\\|[^ ]+\\) \\([^ \n]+\\)\\)"
 214                                 nil
 215                                 t)
 216         (let ((matched (buffer-substring (match-beginning 1)
 217                                          (match-end 1))))
 218           (if (string-equal matched "@c module ")
 219               (setq module (read (current-buffer)))
 220             (let ((type (buffer-substring (match-beginning 2)
 221                                           (match-end 2))))
 222               (if (string-equal type "{C Function}")
 223                   nil
 224                 (setq matched
 225                       (concat type
 226                               " "
 227                               (buffer-substring (match-beginning 3)
 228                                                 (match-end 3))))
 229                 (message "Found docstring: %S: %s" module matched)
 230                 (let ((descriptions (assoc module alist)))
 231                   (setq alist
 232                         (cons (cons module (cons matched (cdr-safe descriptions)))
 233                               (if descriptions
 234                                   (delete descriptions alist)
 235                                 alist))))))))))
 236     alist))
 237
 238 ;; Return the docstring from the specified LOCATION.  LOCATION is a
 239 ;; list of three elements: buffer, start position and end position.
 240 (defun location-to-docstring (location)
 241   (and location
 242        (save-excursion
 243          (set-buffer (car location))
 244          (buffer-substring (cadr location) (caddr location)))))
 245
 246 ;; Perform a comparison of the specified docstring.  MODULE and
 247 ;; DESCRIPTION are as per usual.
 248 (defun docstring-compare (module description)
 249   (let* ((manual-location (find-manual-docstring module description))
 250          (snarf-location (find-snarfed-docstring module description))
 251          (track-location (find-tracking-docstring module description))
 252
 253          (manual-docstring (location-to-docstring manual-location))
 254          (snarf-docstring (location-to-docstring snarf-location))
 255          (track-docstring (location-to-docstring track-location))
 256
 257          action
 258          issue)
 259
 260     ;; Decide what to do.
 261     (cond ((null snarf-location)
 262            (setq action nil
 263                  issue (if manual-location
 264                            'consider-removal
 265                          nil)))
 266
 267           ((null manual-location)
 268            (setq action 'add-to-manual issue nil))
 269
 270           ((null track-location)
 271            (setq action nil
 272                  issue (if (string-equal manual-docstring snarf-docstring)
 273                            nil
 274                          'check-needed)))
 275
 276           ((string-equal track-docstring snarf-docstring)
 277            (setq action nil issue nil))
 278
 279           ((string-equal track-docstring manual-docstring)
 280            (setq action 'auto-update-manual issue nil))
 281
 282           (t
 283            (setq action nil issue 'update-needed)))
 284
 285     ;; Return a pair indicating any automatic action that can be
 286     ;; taken, and any issue for resolution.
 287     (cons action issue)))
 288
 289 ;; Add the specified docstring to the manual.
 290 (defun docstring-add-to-manual (module description)
 291   (let ((buf (find-file-noselect (concat docstring-manual-directory
 292                                          "/"
 293                                          docstring-new-docstrings-file))))
 294     (save-excursion
 295       (set-buffer buf)
 296       (goto-char (point-max))
 297       (or (docstring-in-module module nil)
 298           (insert "\n@c module " (prin1-to-string module) "\n"))
 299       (insert "\n" (location-to-docstring (find-snarfed-docstring module
 300                                                                   description))))))
 301
 302 ;; Auto-update the specified docstring in the manual.
 303 (defun docstring-auto-update-manual (module description)
 304   (let ((manual-location (find-manual-docstring module description))
 305         (track-location (find-tracking-docstring module description)))
 306     (save-excursion
 307       (set-buffer (car manual-location))
 308       (goto-char (cadr manual-location))
 309       (delete-region (cadr manual-location) (caddr manual-location))
 310       (insert (location-to-docstring (find-snarfed-docstring module
 311                                                              description))))))
 312
 313 ;; Process an alist of modules and descriptions, and produce a summary
 314 ;; buffer describing actions taken and issues to be resolved.
 315 (defun docstring-process-alist (alist)
 316   (let (check-needed-list
 317         update-needed-list
 318         consider-removal-list
 319         added-to-manual-list
 320         auto-updated-manual-list)
 321
 322     (mapcar
 323      (function (lambda (module-list)
 324                  (let ((module (car module-list)))
 325                    (message "Module: %S" module)
 326                    (mapcar
 327                     (function (lambda (description)
 328                                 (message "Comparing docstring: %S: %s" module description)
 329                                 (let* ((ai (docstring-compare module description))
 330                                        (action (car ai))
 331                                        (issue (cdr ai)))
 332
 333                                   (cond ((eq action 'add-to-manual)
 334                                          (docstring-add-to-manual module description)
 335                                          (setq added-to-manual-list
 336                                                (cons (cons module description)
 337                                                      added-to-manual-list)))
 338
 339                                         ((eq action 'auto-update-manual)
 340                                          (docstring-auto-update-manual module description)
 341                                          (setq auto-updated-manual-list
 342                                                (cons (cons module description)
 343                                                      auto-updated-manual-list))))
 344
 345                                   (cond ((eq issue 'check-needed)
 346                                          (setq check-needed-list
 347                                                (cons (cons module description)
 348                                                      check-needed-list)))
 349
 350                                         ((eq issue 'update-needed)
 351                                          (setq update-needed-list
 352                                                (cons (cons module description)
 353                                                      update-needed-list)))
 354
 355                                         ((eq issue 'consider-removal)
 356                                          (setq consider-removal-list
 357                                                (cons (cons module description)
 358                                                      consider-removal-list)))))))
 359                     (cdr module-list)))))
 360      alist)
 361
 362     ;; Prepare a buffer describing the results.
 363     (set-buffer (get-buffer-create "*Docstring Results*"))
 364     (erase-buffer)
 365
 366     (insert "
 367 The following items have been automatically added to the manual in
 368 file `" docstring-manual-directory "/" docstring-new-docstrings-file "'.\n\n")
 369     (if added-to-manual-list
 370         (mapcar (function (lambda (moddesc)
 371                             (insert (prin1-to-string (car moddesc))
 372                                     ": "
 373                                     (cdr moddesc)
 374                                     "\n")))
 375                 added-to-manual-list)
 376       (insert "(none)\n"))
 377
 378     (insert "
 379 The following items have been automatically updated in the manual.\n\n")
 380     (if auto-updated-manual-list
 381         (mapcar (function (lambda (moddesc)
 382                             (insert (prin1-to-string (car moddesc))
 383                                     ": "
 384                                     (cdr moddesc)
 385                                     "\n")))
 386                 auto-updated-manual-list)
 387       (insert "(none)\n"))
 388
 389     (insert "
 390 The following items are already documented in the manual but are not
 391 mentioned in the reference copy of the snarfed docstrings file.
 392 You should check that the manual documentation matches the docstring
 393 in the current snarfed docstrings file.\n\n")
 394     (if check-needed-list
 395         (mapcar (function (lambda (moddesc)
 396                             (insert (prin1-to-string (car moddesc))
 397                                     ": "
 398                                     (cdr moddesc)
 399                                     "\n")))
 400                 check-needed-list)
 401       (insert "(none)\n"))
 402
 403     (insert "
 404 The following items have manual documentation that is different from
 405 the docstring in the reference copy of the snarfed docstrings file,
 406 and the snarfed docstring has changed.  You need to update the manual
 407 documentation by hand with reference to the snarfed docstring changes.\n\n")
 408     (if update-needed-list
 409         (mapcar (function (lambda (moddesc)
 410                             (insert (prin1-to-string (car moddesc))
 411                                     ": "
 412                                     (cdr moddesc)
 413                                     "\n")))
 414                 update-needed-list)
 415       (insert "(none)\n"))
 416
 417     (insert "
 418 The following items are documented in the manual but are no longer
 419 present in the snarfed docstrings file.  You should consider whether
 420 the existing manual documentation is still pertinent.  If it is, its
 421 docstring module comment may need updating, to connect it with a
 422 new snarfed docstring file.\n\n")
 423     (if consider-removal-list
 424         (mapcar (function (lambda (moddesc)
 425                             (insert (prin1-to-string (car moddesc))
 426                                     ": "
 427                                     (cdr moddesc)
 428                                     "\n")))
 429                 consider-removal-list)
 430       (insert "(none)\n"))
 431     (insert "\n")
 432
 433     (goto-char (point-min))
 434     (local-set-key "d" 'docstring-ediff-this-line)
 435
 436     ;; Popup the issues buffer.
 437     (let ((pop-up-frames t))
 438       (set-window-point (display-buffer (current-buffer))
 439                         (point-min)))))
 440
 441 (defun docstring-process-current-buffer ()
 442   (interactive)
 443   (docstring-process-alist (make-module-description-list)))
 444
 445 (defun docstring-process-current-region (beg end)
 446   (interactive "r")
 447   (narrow-to-region beg end)
 448   (unwind-protect
 449       (save-excursion
 450         (docstring-process-alist (make-module-description-list)))
 451     (widen)))
 452
 453 (defun docstring-process-module (module)
 454   (interactive "xModule: ")
 455   (let ((modpath (module-to-path module))
 456         (mdlist nil))
 457     (mapcar (function (lambda (root)
 458                         (let ((fn (concat root
 459                                           "/"
 460                                           modpath
 461                                           ".texi")))
 462                           (if (file-exists-p fn)
 463                               (save-excursion
 464                                 (find-file fn)
 465                                 (message "Getting docstring list from %s" fn)
 466                                 (setq mdlist
 467                                       (append mdlist
 468                                               (make-module-description-list))))))))
 469             docstring-snarfed-roots)
 470     (docstring-process-alist mdlist)))
 471
 472 (defun docstring-ediff-this-line ()
 473   (interactive)
 474   (let (module
 475         description)
 476     (save-excursion
 477       (beginning-of-line)
 478       (setq module (read (current-buffer)))
 479       (forward-char 2)
 480       (setq description (buffer-substring (point)
 481                                           (progn
 482                                             (end-of-line)
 483                                             (point)))))
 484
 485     (message "Ediff docstring: %S: %s" module description)
 486
 487     (let ((track-location (or (find-tracking-docstring module description)
 488                               (docstring-temp-location "No docstring in tracking file")))
 489           (snarf-location (or (find-snarfed-docstring module description)
 490                               (docstring-temp-location "No docstring in snarfed file")))
 491           (manual-location (or (find-manual-docstring module description)
 492                                (docstring-temp-location "No docstring in manual"))))
 493
 494       (setq docstring-ediff-buffers
 495             (list (car track-location)
 496                   (car snarf-location)
 497                   (car manual-location)))
 498
 499       (docstring-narrow-to-location track-location)
 500       (docstring-narrow-to-location snarf-location)
 501       (docstring-narrow-to-location manual-location)
 502
 503       (add-hook 'ediff-quit-hook 'docstring-widen-ediff-buffers)
 504
 505     (ediff-buffers3 (nth 0 docstring-ediff-buffers)
 506                     (nth 1 docstring-ediff-buffers)
 507                     (nth 2 docstring-ediff-buffers)))))
 508
 509 (defun docstring-narrow-to-location (location)
 510   (save-excursion
 511     (set-buffer (car location))
 512     (narrow-to-region (cadr location) (caddr location))))
 513
 514 (defun docstring-temp-location (str)
 515   (let ((buf (generate-new-buffer "*Docstring Temp*")))
 516     (save-excursion
 517       (set-buffer buf)
 518       (erase-buffer)
 519       (insert str "\n")
 520       (list buf (point-min) (point-max)))))
 521
 522 (require 'ediff)
 523
 524 (defvar docstring-ediff-buffers '())
 525
 526 (defun docstring-widen-ediff-buffers ()
 527   (remove-hook 'ediff-quit-hook 'docstring-widen-ediff-buffers)
 528   (save-excursion
 529     (mapcar (function (lambda (buffer)
 530                         (set-buffer buffer)
 531                         (widen)))
 532             docstring-ediff-buffers)))
 533
 534
 535 ;;; Tests:
 536
 537 ;(find-docstring "/home/neil/Guile/cvs/guile-core/doc/maint/guile.texi" nil "primitive sloppy-assq")
 538 ;(find-manual-docstring '(guile) "primitive sloppy-assq")
 539 ;(find-tracking-docstring '(guile) "primitive sloppy-assq")
 540 ;(find-snarfed-docstring '(guile) "primitive sloppy-assq")
 541
 542 (provide 'docstring)
 543
 544 ;;; docstring.el ends here