;;; links-mode.el --- major mode for editing bookmark files ;; Authors: 2005, 2006 Sergey Poznyakoff ;; Version: 1.0 ;; Keywords: links,bookmarks,html ;; $Id$ ;; Copyright (C) 2005, 2006 Sergey Poznyakoff ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software Foundation, ;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;; Tree node structure: ;; ;; (vector title ref anchor text subtree toc) ;; ;; title string ;; ref nil or string ;; anchor nil or string ;; text list of string ;; subtree list of nodes ;; tok nil or number (defmacro node-create (title ref anchor) (` (vector (, title) (, ref) (, anchor) nil nil nil))) (defmacro node-title (n) (` (aref (, n) 0))) (defmacro node-set-title (n val) (` (aset (, n) 0 (, val)))) (defmacro node-ref (n) (` (aref (, n) 1))) (defmacro node-set-ref (n val) (` (aset (, n) 1 (, val)))) (defmacro node-anchor (n) (` (aref (, n) 2))) (defmacro node-text (n) (` (aref (, n) 3))) (defmacro node-set-text (n val) (` (aset (, n) 3 (, val)))) (defmacro node-add-text (n val) (` (node-set-text (, n) (append (node-text (, n)) (list (, val)))))) (defmacro node-subtree (n) (` (aref (, n) 4))) (defmacro node-set-subtree (n val) (` (aset (, n) 4 (, val)))) (defmacro node-add-subtree (n val) (` (node-set-subtree (, n) (append (node-subtree (, n)) (list (, val)))))) (defmacro node-toc (n) (` (aref (, n) 5))) (defmacro node-set-toc (n val) (` (aset (, n) 5 (, 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] [name]) (list 'text string) (list 'newline) " (cond ((looking-at "^\\(\\*+\\)[ \t]*\\(\\[\\([^]]+\\)\\]\\)?[ \t]*\\(.*\\)[ \t]*::[ \t]*\\(.*\\)$") (list 'reference (length (match-string 1)) (match-string 5) (match-string 4) (match-string 3))) ((looking-at "^\\(\\*+\\)[ \t]*\\(\\[\\([^]]+\\)\\]\\)?[ \t]*\\(.*\\)$") (list 'reference (length (match-string 1)) (match-string 4) nil (match-string 3))) ((or (looking-at "^[ \t]*$") (looking-at "^[ \t]*;.*$")) (list 'newline)) (t (list 'text (save-excursion (let ((here (point))) (buffer-substring here (progn (forward-line) (point))))))))) (defun scan-reference (root tok) "Scan a reference" (let ((level (nth 1 tok)) (title (list (nth 2 tok))) (ref (nth 3 tok)) (anchor (nth 4 tok))) (while (and (not (eobp)) (eq (car (setq tok (get-token))) 'text)) (setq title (cons (cadr tok) (cons " " title))) (forward-line)) (let ((tree (cons (node-create (apply 'concat (nreverse title)) ref anchor) root))) (while (and (not (eobp)) (eq (car (setq tok (get-token))) 'newline)) (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))) (node-set-subtree (car tree) (scan-buffer (node-subtree (car tree)) lev)))) tree))) (defun scan-text (root tok) "Scan a paragraph of text" (let ((tree (or root (list (node-create nil 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) (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 ((toc 1)) (fixup-tree (scan-buffer nil 1))))) (defun out-index (tree) (let (ul) (mapc (function (lambda (node) (when (not (node-ref node)) (when (not ul) (insert "
" para "
\n"))) text) (when subtree (out-contents subtree)) (insert "