Mercurial > hg > xemacs-beta

comparison lisp/lisp-mnt.el @ 4631:866681a74bd9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Improve lisp-mnt documentation.
author Stephen J. Turnbull <stephen@xemacs.org>
date Wed, 01 Apr 2009 20:46:58 +0900
parents 64e5e393f15d
children 199ecf2503c8
comparison
equal deleted inserted replaced
4630:64e5e393f15d 4631:866681a74bd9
31 31
32 ;;; Commentary: 32 ;;; Commentary:
33 33
34 ;; This minor mode adds some services to Emacs-Lisp editing mode. 34 ;; This minor mode adds some services to Emacs-Lisp editing mode.
35 ;; 35 ;;
36 ;; First, it knows about the header conventions for library packages. 36 ;; It provides knowledge about the header conventions for library packages.
37 ;; One entry point supports generating synopses from a library directory. 37 ;; `lm-synopsis' supports generating synopses from a library directory.
38 ;; Another can be used to check for missing headers in library files. 38 ;; `lm-verify' can be used to check for missing headers in library files.
39 ;; 39 ;;
40 ;; Another entry point automatically addresses bug mail to a package's 40 ;; `lm-report-bug' automatically addresses bug mail to a package's
41 ;; maintainer or author. 41 ;; maintainer or author.
42 42
43 ;; This file can be loaded by your lisp-mode-hook. Have it (require 'lisp-mnt) 43 ;; This file can be loaded by your lisp-mode-hook with `(require 'lisp-mnt)'.
44 44
45 ;; This file is an example of the header conventions. Note the following 45 ;; This file is an example of the header conventions. Note the following
46 ;; features: 46 ;; features:
47 ;; 47 ;;
48 ;; * Header line --- makes it possible to extract a one-line summary of 48 ;; * Header line --- makes it possible to extract a one-line summary of
88 ;; * Adapted-By line --- this is for FSF's internal use. The person named 88 ;; * Adapted-By line --- this is for FSF's internal use. The person named
89 ;; in this field was the one responsible for installing and adapting the 89 ;; in this field was the one responsible for installing and adapting the
90 ;; package for the distribution. (This file doesn't have one because the 90 ;; package for the distribution. (This file doesn't have one because the
91 ;; author *is* one of the maintainers.) 91 ;; author *is* one of the maintainers.)
92 ;; 92 ;;
93 ;; * Keywords line --- used by the finder code (now under construction) 93 ;; * Keywords line --- used by the finder code (now direly bit-rotted)
94 ;; for finding Emacs Lisp code related to a topic. 94 ;; for finding Emacs Lisp code related to a topic.
95 ;; 95 ;;
96 ;; * X-Bogus-Bureaucratic-Cruft line --- this is a joke and an example 96 ;; * X-Bogus-Bureaucratic-Cruft line --- this is a joke and an example
97 ;; of a comment header. Headers starting with `X-' should never be used 97 ;; of a comment header. Headers starting with `X-' should never be used
98 ;; for any real purpose; this is the way to safely add random headers 98 ;; for any real purpose; this is the way to safely add random headers
116 ;; * Created. 116 ;; * Created.
117 117
118 ;;; Code: 118 ;;; Code:
119 119
120 (require 'picture) ; provides move-to-column-force 120 (require 'picture) ; provides move-to-column-force
121 ;(require 'emacsbug) ; XEmacs, not needed for bytecompilation
122 121
123 ;;; Variables: 122 ;;; Variables:
124 123
125 (defvar lm-header-prefix "^;;*[ \t]+\\(@\(#\)\\)?[ \t]*\\([\$]\\)?" 124 (defvar lm-header-prefix "^;;*[ \t]+\\(@\(#\)\\)?[ \t]*\\([\$]\\)?"
126 "Prefix that is ignored before the tag. 125 "Prefix that is ignored before the tag.
245 (buffer-substring (match-beginning 1) (match-end 1))) 244 (buffer-substring (match-beginning 1) (match-end 1)))
246 (if file 245 (if file
247 (kill-buffer (current-buffer))) 246 (kill-buffer (current-buffer)))
248 ))) 247 )))
249 248
249 ;; #### This should be replaced by a call into mail-lib.
250 (defun lm-crack-address (x) 250 (defun lm-crack-address (x)
251 "Split up an email address into full name and real email address. 251 "Split up an email address into full name and real email address.
252 The value is a cons of the form (FULLNAME . ADDRESS)." 252 The value is a cons of the form (FULLNAME . ADDRESS)."
253 (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x) 253 (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x)
254 (cons (substring x (match-beginning 1) (match-end 1)) 254 (cons (substring x (match-beginning 1) (match-end 1))
420 (and commentary end (buffer-substring commentary end))))) 420 (and commentary end (buffer-substring commentary end)))))
421 (if file 421 (if file
422 (kill-buffer (current-buffer))) 422 (kill-buffer (current-buffer)))
423 ))) 423 )))
424 424
425 ;;; Verification and synopses 425 ;;; Utilities
426 426
427 (defun lm-insert-at-column (col &rest strings) 427 (defun lm-insert-at-column (col &rest strings)
428 "Insert list of STRINGS, at column COL." 428 "Insert list of STRINGS, at column COL."
429 (if (> (current-column) col) (insert "\n")) 429 (if (> (current-column) col) (insert "\n"))
430 (move-to-column-force col) 430 (move-to-column-force col)
431 (apply 'insert strings)) 431 (apply 'insert strings))
432
433 ;;; Entry points: verification, synopses, and bug reporting
432 434
433 (defun lm-verify (&optional file showok &optional verb) 435 (defun lm-verify (&optional file showok &optional verb)
434 "Check that the current buffer (or FILE if given) is in proper format. 436 "Check that the current buffer (or FILE if given) is in proper format.
435 If FILE is a directory, recurse on its files and generate a report in 437 If FILE is a directory, recurse on its files and generate a report in
436 a temporary buffer." 438 a temporary buffer."
513 (message ret)) 515 (message ret))
514 ret 516 ret
515 )) 517 ))
516 518
517 (defun lm-synopsis (&optional file showall) 519 (defun lm-synopsis (&optional file showall)
518 "Generate a synopsis listing for the buffer or the given FILE if given. 520 "Generate a synopsis listing for FILE, defaulting to the visited file.
519 If FILE is a directory, recurse on its files and generate a report in 521 If FILE is a directory, recurse on its files and generate a report in
520 a temporary buffer. If SHOWALL is non-nil, also generate a line for files 522 a temporary buffer. If optional SHOWALL is non-nil, also generate a line
521 which do not include a recognizable synopsis." 523 for files which do not include a recognizable synopsis. Interactively,
522 (interactive 524 to specify the current directory, remove the trailing slash from the default
523 (list 525 string. Interactively, SHOWALL is taken from the prefix argument."
524 (read-file-name "Synopsis for (file or dir): "))) 526 (interactive "FSynopsis for (file or dir): \nP")
525 527
526 (if (and file (file-directory-p file)) 528 (if (and file (file-directory-p file))
527 (progn 529 (progn
528 (switch-to-buffer (get-buffer-create "*lm-verify*")) 530 (switch-to-buffer (get-buffer-create "*lm-verify*"))
529 (erase-buffer) 531 (erase-buffer)
548 (lm-summary) 550 (lm-summary)
549 (if file 551 (if file
550 (kill-buffer (current-buffer))) 552 (kill-buffer (current-buffer)))
551 )))) 553 ))))
552 554
555 ;; #### This should call out to `report-xemacs-bug'.
553 (defun lm-report-bug (topic) 556 (defun lm-report-bug (topic)
554 "Report a bug in the package currently being visited to its maintainer. 557 "Report a bug in the package currently being visited to its maintainer.
555 Prompts for bug subject. Leaves you in a mail buffer." 558 Prompts for bug subject. Leaves you in a mail buffer."
556 (interactive "sBug Subject: ") 559 (interactive "sBug Subject: ")
557 (let ((package (lm-get-package-name)) 560 (let ((package (lm-get-package-name))