>From c9a79155d00e48a282d7fce1b6d21838c9fa5a90 Mon Sep 17 00:00:00 2001
From: Jonas Bernoulli <jonas@bernoul.li>
Date: Mon, 17 Dec 2012 17:03:41 +0100
Subject: [PATCH] lisp/emacs-lisp/lisp-mnt.el: new function lm-homepage
 (lm-section-end): the end is now always before the following non-comment text
 (lm-header): save-match-data (lm-header-multiline): save-match-data,
 continuation lines now need to be intended more than the first line
 (lm-with-file): widen and goto beginning of buffer before reusing current
 buffer

---
 lisp-mnt.el | 75 ++++++++++++++++++++++++++++++++++++-------------------------
 1 file changed, 44 insertions(+), 31 deletions(-)

diff --git a/lisp-mnt.el b/lisp-mnt.el
index f9a1c5d..7bbc033 100644
--- a/lisp-mnt.el
+++ b/lisp-mnt.el
@@ -208,10 +208,10 @@ If the given section does not exist, return nil."
 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
@@ -229,9 +229,15 @@ If no such section exists, return the end of the buffer."
                            (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 "")
+			    (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."
@@ -262,35 +268,32 @@ If no such section exists, return the end of the buffer."
 
 (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-match-data
+    (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.
 The returned value is a list of strings, one per line."
   (save-excursion
-    (goto-char (point-min))
-    (let ((res (lm-header header)))
-      (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))
-	  (forward-line 1)))
-      (nreverse res))))
+    (save-match-data
+      (goto-char (point-min))
+      (let ((res (lm-header header)))
+	(when res
+	  (setq res (list res))
+	  (forward-line 1)
+	  (while (looking-at "^;+\\(\t\\|[\t\s]\\{2,\\}\\)\\(.+\\)")
+	    (push (match-string-no-properties 2) res)
+	    (forward-line 1)))
+	(nreverse res)))))
 
 ;; These give us smart access to the header fields and commentary
 
@@ -306,6 +309,8 @@ If FILE is nil, execute BODY in the current buffer."
 	     (emacs-lisp-mode)
 	     ,@body)
 	 (save-excursion
+	   (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
@@ -489,6 +494,14 @@ absent, return nil."
       (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)
-- 
1.8.0.1