;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers
-;; Copyright (C) 1992, 1994, 1997, 2000-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 1997, 2000-2016 Free Software Foundation,
+;; Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 14 Jul 1992
;; Keywords: docs
;; X-Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out!
;; ;; Dave Brennan <brennan@hal.com>
;; ;; Eric Raymond <esr@snark.thyrsus.com>
;;
-;; This field may have some special values; notably "FSF", meaning
-;; "Free Software Foundation".
-;;
;; * Maintainer line --- should be a single name/address as in the Author
-;; line, or an address only, or the string "FSF". If there is no maintainer
+;; line, or an address only. If there is no maintainer
;; line, the person(s) in the Author field are presumed to be it.
;; The idea behind these two fields is to be able to write a Lisp function
;; that does "send mail to the author" without having to mine the name out by
;; at a different version of the file than the one they're accustomed to. This
;; may be an RCS or SCCS header.
;;
-;; * Adapted-By line --- this is for FSF's internal use. The person named
-;; in this field was the one responsible for installing and adapting the
-;; package for the distribution. (This file doesn't have one because the
-;; author *is* one of the maintainers.)
+;; * Adapted-By line --- this was used historically when some files
+;; were added to Emacs. The person named in this field installed and
+;; (possibly adapted) the package in the Emacs distribution.
;;
;; * Keywords line --- used by the finder code for finding Emacs
;; Lisp code related to a topic.
The HEADER is the section string marking the beginning of the
section. If the given section does not exist, return nil.
-The end of the section is defined as the beginning of the next
-section of the same level or lower. The function
-`lisp-outline-level' is used to compute the level of a section.
-If no such section exists, return the end of the buffer."
+The section ends before the first non-comment text or the next
+section of the same level or lower; whatever comes first. The
+function `lisp-outline-level' is used to compute the level of
+a section."
(require 'outline) ;; for outline-regexp.
(let ((start (lm-section-start header)))
(when start
(beginning-of-line)
(lisp-outline-level))
level)))
- (if next-section-found
- (line-beginning-position)
- (point-max)))))))
+ (min (if next-section-found
+ (progn (beginning-of-line 0)
+ (unless (looking-at "\f")
+ (beginning-of-line 2))
+ (point))
+ (point-max))
+ (progn (goto-char start)
+ (while (forward-comment 1))
+ (point))))))))
(defsubst lm-code-start ()
"Return the buffer location of the `Code' start marker."
(defun lm-header (header)
"Return the contents of the header named HEADER."
- (goto-char (point-min))
- (let ((case-fold-search t))
- (when (and (re-search-forward (lm-get-header-re header) (lm-code-mark) t)
- ;; RCS ident likes format "$identifier: data$"
- (looking-at
- (if (save-excursion
- (skip-chars-backward "^$" (match-beginning 0))
- (= (point) (match-beginning 0)))
- "[^\n]+" "[^$\n]+")))
- (match-string-no-properties 0))))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (when (and (re-search-forward (lm-get-header-re header) (lm-code-mark) t)
+ ;; RCS ident likes format "$identifier: data$"
+ (looking-at
+ (if (save-excursion
+ (skip-chars-backward "^$" (match-beginning 0))
+ (= (point) (match-beginning 0)))
+ "[^\n]+" "[^$\n]+")))
+ (match-string-no-properties 0)))))
(defun lm-header-multiline (header)
"Return the contents of the header named HEADER, with continuation lines.
(when res
(setq res (list res))
(forward-line 1)
- (while (and (or (looking-at (concat lm-header-prefix "[\t ]+"))
- (and (not (looking-at
- (lm-get-header-re "\\sw\\(\\sw\\|\\s_\\)*")))
- (looking-at lm-header-prefix)))
- (goto-char (match-end 0))
- (looking-at ".+"))
- (setq res (cons (match-string-no-properties 0) res))
+ (while (looking-at "^;+\\(\t\\|[\t\s]\\{2,\\}\\)\\(.+\\)")
+ (push (match-string-no-properties 2) res)
(forward-line 1)))
(nreverse res))))
(emacs-lisp-mode)
,@body)
(save-excursion
- ;; Switching major modes is too drastic, so just switch
- ;; temporarily to the Emacs Lisp mode syntax table.
- (with-syntax-table emacs-lisp-mode-syntax-table
- ,@body))))))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ ;; Switching major modes is too drastic, so just switch
+ ;; temporarily to the Emacs Lisp mode syntax table.
+ (with-syntax-table emacs-lisp-mode-syntax-table
+ ,@body)))))))
;; Fixme: Probably this should be amalgamated with copyright.el; also
;; we need a check for ranges in copyright years.
;; Look for an SCCS header
((re-search-forward
(concat
- (regexp-quote "@(#)")
- (regexp-quote (file-name-nondirectory (buffer-file-name)))
+ "@(#)"
+ (if buffer-file-name
+ (regexp-quote (file-name-nondirectory buffer-file-name))
+ "[^\t\n]+")
"\t\\([012345679.]*\\)")
header-max t)
(match-string-no-properties 1)))))))
(let ((keywords (lm-keywords file)))
(if keywords
(if (string-match-p "," keywords)
- (split-string keywords ",[ \t\n]*" t)
- (split-string keywords "[ \t\n]+" t)))))
+ (split-string keywords ",[ \t\n]*" t "[ ]+")
+ (split-string keywords "[ \t\n]+" t "[ ]+")))))
(defvar finder-known-keywords)
(defun lm-keywords-finder-p (&optional file)
(when start
(buffer-substring-no-properties start (lm-commentary-end))))))
+(defun lm-homepage (&optional file)
+ "Return the homepage in file FILE, or current buffer if FILE is nil."
+ (let ((page (lm-with-file file
+ (lm-header "\\(?:x-\\)?\\(?:homepage\\|url\\)"))))
+ (if (and page (string-match "^<.+>$" page))
+ (substring page 1 -1)
+ page)))
+
;;; Verification and synopses
(defun lm-insert-at-column (col &rest strings)
((not (lm-keywords-finder-p))
"`Keywords:' has no valid finder keywords (see `finder-known-keywords')")
((not (lm-commentary-mark))
- "Can't find a 'Commentary' section marker")
+ "Can't find a `Commentary' section marker")
((not (lm-history-mark))
- "Can't find a 'History' section marker")
+ "Can't find a `History' section marker")
((not (lm-code-mark))
- "Can't find a 'Code' section marker")
+ "Can't find a `Code' section marker")
((progn
(goto-char (point-max))
(not