First build an abstract tree, then convert it to output format

git-svn-id: file:///svnroot/gsc/trunk@52 d2de0444-eb31-0410-8365-af798a554d48

1 files changed, 186 insertions, 85 deletions

diff --git a/elisp/links-mode.el b/elisp/links-mode.el
index a8620b5..282cc8f 100644
--- a/elisp/links-mode.el
+++ b/elisp/links-mode.el
@@ -21,50 +21,70 @@
 ;; along with this program; if not, write to the Free Software Foundation,
 ;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
-(defun link-paragraph-begin ()
-  (save-excursion
-    (set-buffer link-output-buffer)
-    (insert "\n<p>\n")))
+;; Tree node structure:
+;;
+;;  (vector title ref text subtree toc)
+;;
+;;   title   string
+;;   ref     nil or string
+;;   text    list of string
+;;   subtree list of nodes
+;;   tok     nil or number
 
-(defun link-paragraph-end ()
-  (save-excursion
-    (set-buffer link-output-buffer)
-    (insert "\n</p>\n")))
+(defmacro node-create (title ref)
+  (` (vector (, title) (, ref) nil nil nil)))
 
-(defun link-paragraph-line (text)
-  (save-excursion
-    (set-buffer link-output-buffer)
-    (insert text "\n")))
+(defmacro node-title (n)
+  (` (aref (, n) 0)))
 
-(defun link-node-begin (level)
-  (save-excursion
-    (set-buffer link-output-buffer)
-    (insert "<ul>\n")))
+(defmacro node-set-title (n val)
+  (` (aset (, n) 0 (, val))))
 
-(defun link-node-end (level)
-  (save-excursion
-    (set-buffer link-output-buffer)
-    (insert "</ul>\n")))
+(defmacro node-ref (n)
+  (` (aref (, n) 1)))
 
-(defun link-reference-begin (level title &optional ref)
-  (save-excursion
-    (set-buffer link-output-buffer)
-    (insert "<li>")
-    (if ref
-	(insert "<a href=\"" ref "\">" title "</a>\n")
-      (insert "<h3>" title "</h3>"))))
+(defmacro node-set-ref (n val)
+  (` (aset (, n) 1 (, val))))
 
-(defun link-reference-end (level)
-  (save-excursion
-    (set-buffer link-output-buffer)
-    (insert "</li>\n")))
+(defmacro node-text (n)
+  (` (aref (, n) 2)))
+
+(defmacro node-set-text (n val)
+  (` (aset (, n) 2 (, val))))
+
+(defmacro node-add-text (n val)
+  (` (node-set-text (, n) (append (node-text (, n)) (list (, val))))))
+
+(defmacro node-subtree (n)
+  (` (aref (, n) 3)))
+
+(defmacro node-set-subtree (n val)
+  (` (aset (, n) 3 (, val))))
+
+(defmacro node-add-subtree (n val)
+  (` (node-set-subtree (, n) (append (node-subtree (, n)) (list (, val))))))
+
+(defmacro node-toc (n)
+  (` (aref (, n) 4)))
+
+(defmacro node-set-toc (n val)
+  (` (aset (, n) 4 (, val))))
 
 
 
 (defun get-token ()
+  "Get a single token from the buffer. Returns list whose car is the type of
+the token ('reference, 'newline or 'text). Rest of list elements depend on
+the token type:
+
+    (list 'reference level title [ref])
+    (list 'text string)
+    (list 'newline)
+"
   (cond
    ((looking-at "^\\(\\*+\\)\\s *\\(.*\\)\\s *::\\s *\\(.*\\)$")
-    (list 'reference (length (match-string 1)) (match-string 3) (match-string 2)))
+    (list 'reference (length (match-string 1))
+	  (match-string 3) (match-string 2)))
    ((looking-at "^\\(\\*+\\)\\s *\\(.*\\)$")
     (list 'reference (length (match-string 1)) (match-string 2)))
    ((or (looking-at "^\\s *$") (looking-at "^\\s *;.*$"))
@@ -75,8 +95,8 @@
 							   (forward-line)
 							   (point)))))))))
    
-
-(defun scan-reference (tok)
+(defun scan-reference (root tok)
+  "Scan a reference"
   (let ((level (nth 1 tok))
 	(title (list (nth 2 tok)))
 	(ref (and (= (length tok) 4) (nth 3 tok))))
@@ -84,74 +104,155 @@
     (while (and (not (eobp)) (eq (car (setq tok (get-token))) 'text))
       (setq title (cons (cadr tok) (cons " " title)))
       (forward-line))
-    
-    (link-reference-begin level (apply 'concat (nreverse title)) ref)
-    
-    (while (and (not (eobp)) (eq (car (setq tok (get-token))) 'newline))
-      (forward-line))
 
-    (when (and (not (eobp))
-	       (eq (car tok) 'text))
-      (scan-buffer (1+ level))
+    (let ((tree (cons
+		 (node-create (apply 'concat (nreverse title)) ref)
+		 root)))
+    
       (while (and (not (eobp)) (eq (car (setq tok (get-token))) 'newline))
-	(forward-line)))
+	(forward-line))
+
+      (when (and (not (eobp))
+		 (eq (car tok) 'text))
+	(scan-text tree tok)
+	(while (and (not (eobp)) (eq (car (setq tok (get-token))) 'newline))
+	  (forward-line)))
       
-    (when (and
-	   (not (eobp))
-	   (eq (car tok) 'reference)
-	   (> (nth 1 tok) level))
-      (let ((lev (nth 1 tok)))
-	(link-node-begin lev)
-	(scan-buffer lev)
-	(link-node-end lev)))
-
-    (link-reference-end level)))
-    
+      (when (and
+	     (not (eobp))
+	     (eq (car tok) 'reference)
+	     (> (nth 1 tok) level))
+	(let ((lev (nth 1 tok)))
+	  (node-set-subtree (car tree)
+			    (scan-buffer (node-subtree (car tree)) lev))))
+      tree)))
       
-(defun scan-text (tok)
-  (link-paragraph-begin)
-  (link-paragraph-line (cadr tok))
-  (while (and (not (eobp)) (eq (car (setq tok (get-token))) 'text))
-    (link-paragraph-line (cadr tok))
-    (forward-line))
-  (link-paragraph-end))
-
-(defun scan-buffer (level)
+(defun scan-text (root tok)
+  "Scan a paragraph of text"
+  (let ((tree (or root (list (node-create nil nil))))
+	para)
+    (while (and (not (eobp)) (eq (car (setq tok (get-token))) 'text))
+      (setq para (cons (cadr tok) (cons "\n" para)))
+      (forward-line))
+    (node-add-text (car tree) (apply 'concat (nreverse para)))
+    tree))
+
+(defun scan-buffer (tree level)
+  "Scan buffer contents within the given LEVEL."
   (let (tok)
     (while (and (not (eobp))
 		(or (not (eq (car (setq tok (get-token))) 'reference))
 		    (= (nth 1 tok) level)))
       (let ((tok-type (car tok)))
 	(forward-line)
-	(cond
-	 ((eq tok-type 'reference)
-	  (scan-reference tok))
-	 ((eq tok-type 'text)
-	  (scan-text tok)))))))
-  
-(defun scan-links (&optional buffer-name)
-  (interactive "p")
+	(setq tree (cond
+		    ((eq tok-type 'reference)
+		     (scan-reference tree tok))
+		    ((eq tok-type 'text)
+		     (scan-text tree tok)))))))
+  tree)
+
+(defun fixup-tree (tree)
+  (mapcar (function (lambda (node)
+		      (node-set-subtree node (fixup-tree (node-subtree node)))
+		      (when (not (node-ref node))
+			(node-set-toc node toc)
+			(setq toc (1+ toc)))
+		      node))
+	  (nreverse tree)))
+
+(defun scan-links ()
   (save-excursion
     (beginning-of-buffer)
-    (let ((link-output-buffer (get-buffer-create
-			       (or buffer-name links-output-file)))
-	  (template links-template-file))
-      (save-excursion
-	(set-buffer link-output-buffer)
-	(erase-buffer)
-	(when template
-	  (insert-file template)
-	  (beginning-of-buffer)
-	  (unless (search-forward "$$" nil t)
-	    (error "Template file without $$"))
-	  (delete-region (point) (- (point) 2))))
-      (scan-buffer 1))))
+    (let ((toc 1))
+      (fixup-tree (scan-buffer nil 1)))))
 
 
 
+(defun out-index-tree (tree)
+  (mapc (function (lambda (node)
+		    (when (not (node-ref node))
+		      (let ((s (number-to-string (node-toc node)))
+			    (subtree (node-subtree node)))
+			(insert "<li><a name=\"TOK" s
+				"\" href=\"#REF" s
+				"\">" (node-title node) "</a>")
+			
+			(when subtree
+			  (out-index subtree))
+
+		      (insert "</li>\n")))))
+	tree))
+
+(defun out-index (tree)
+  (insert "<ul>\n")
+  (out-index-tree tree)
+  (insert "</ul>\n"))
+
+(defun out-tree (tree)
+  (mapc (function (lambda (node)
+		    (let ((ref (node-ref node))
+			  (text (node-text node))
+			  (subtree (node-subtree node)))
+		      (insert "<li>")
+		      (cond
+		       (ref
+			(insert "<a href=\"" ref "\">"
+				(node-title node) "</a>\n"))
+		       (has-index
+			(let ((s (number-to-string (node-toc node))))
+			  (insert "<a name=\"REF" s
+				  "\" href=\"#TOK" s
+				  "\"><h3>" (node-title node) "</h3></a>")))
+		       (t
+			(insert "<h3>" (node-title node) "</h3>\n")))
+		      
+		      (mapc
+		       (function (lambda (para)
+				   (insert "<p>" para "</p>\n")))
+		       text)
+
+		      (when subtree
+			(out-contents subtree))
+
+		      (insert "</li>\n"))))
+	tree))
+
+(defun out-contents (tree)
+  (insert "<ul>\n")
+  (out-tree tree)
+  (insert "</ul>\n"))
+
 (defun links-compile (arg)
+  "Scans current buffer and converts its contents into bookmark file. 
+The value of the variable LINKS-OUTPUT-FILE gives the name of the output
+buffer.
+
+Variable LINKS-TEMPLATE-FILE specifies name of template file.
+"
   (interactive "p")
-  (scan-links))
+  (let ((tree (scan-links))
+	(link-output-buffer (get-buffer-create links-output-file))
+	(template links-template-file)
+	has-index)
+    (save-excursion
+      (set-buffer link-output-buffer)
+      (erase-buffer)
+      (when template
+	(insert-file template)
+	(beginning-of-buffer)
+	(while (not (eobp))
+	  (when (search-forward-regexp "\\$[^\\$]+\\$" nil t)
+	    (save-excursion
+	      (cond
+	       ((string= (match-string 0) "$contents$")
+		(delete-region (match-beginning 0) (match-end 0))
+		(out-contents tree))
+	       ((string= (match-string 0) "$index$")
+		(setq has-index t)
+		(delete-region (match-beginning 0) (match-end 0))
+		(out-index tree)))))
+	  (forward-line))))))
   
 ;;;###autoload
 (define-derived-mode links-mode outline-mode "Links"