New system for help.

This is only the first cut. It is not well tested.

src/ChangeLog

+2002-05-26  David Byers  <david.byers@swipnet.se>
+
+	* help-compile.el: New file.
+
+	* help.el: New file.
+
+	* help.sv: New file.
+
+	* vars.el.in (lyskom-help-data): New variable.
+	(lyskom-maybe-setq-default): Removed eval since eval will be done
+	after macro expansion.
+	(lyskom-maybe-setq): Same here.
+
+	* swedish-strings.el (sv): Load swedish help strings.
+
+	* Makefile (SOURCES): Added help.el.
+
+	* macros.el (defmacro): New macro (only exists during compile).
+
 2002-05-25  David Byers  <david.byers@swipnet.se>
 
 	Fix bug 528:

src/Makefile

@@ -60,7 +60,9 @@ HEADER = 	header.el \
 		$(VARS-EL) \
 		macros.el \
 		compatibility.el \
-		language.el
+		language.el \
+		help.el
+
 
 # Next come the language definitions.
 LANGUAGE-EL := $(LANGUAGES:=-strings.el)
@@ -169,7 +171,7 @@ verbose-el: $(HEADER) $(LANGUAGE-EL) $(SOURCES)
 	$(EMACS-BATCH) -l lpath.el -l _header.el -f batch-byte-compile $<
 
 $(TARGET): $(TARGET-EL)
-	$(EMACS-BATCH) -l lpath.el -f batch-byte-compile $<
+	$(EMACS-BATCH) -l lpath.el -l help-compile.el -f batch-byte-compile $<
 
 HEADER-ELC = $(HEADER:%.el=%.elc)
 LANGUAGE-ELC = $(LANGUAGE-EL:.el%.elc)

src/commands2.el

@@ -1898,8 +1898,7 @@ Return-value: 'no-session if there is no suitable session to switch to
 
 (def-kom-emacs-command kom-where-is (cmd)
   "Show on which key a LysKOM command is"
-  (interactive
-   (list (lyskom-read-extended-command)))
+  (interactive (list (lyskom-read-extended-command)))
   (let ((w (where-is-internal cmd))
         (msg nil))
     (cond ((null cmd)
@@ -2447,29 +2446,58 @@ The variable kom-keep-alive-interval controls the frequency of the request."
 	  (lyskom-format-insert 'pers-is-member-of-conf pers-no conf-no))
       (lyskom-format-insert 'pers-is-not-member-of-conf pers-no conf-no))))
 
+;; (def-kom-command kom-help ()
+;;   "Get some help with LysKOM"
+;;   (interactive)
+;;   (let* ((completion-ignore-case t)
+;;          (table (mapcar (lambda (x)
+;;                           (cons (lyskom-get-string (car x) 'lyskom-help-strings)
+;;                                 (car x)))
+;;                         lyskom-help-categories))
+;;          (category nil))
+;; 
+;;     (while (null category)
+;;       (setq category
+;;             (lyskom-string-assoc
+;;              (lyskom-completing-read (lyskom-get-string 'help-with-what)
+;;                                      table
+;;                                      nil
+;;                                      t
+;;                                      nil
+;;                                      'lyskom-help-history)
+;;              table)))
+;;     (lyskom-format-insert "Hjlp fr %#1s\n\n" 
+;;                           (car category))
+;;     (lyskom-display-help-category (cdr category))))
+
 (def-kom-command kom-help ()
-  "Get some help with LysKOM"
+  "Get some help with LysKOM."
   (interactive)
-  (let* ((completion-ignore-case t)
-         (table (mapcar (lambda (x)
-                          (cons (lyskom-get-string (car x) 'lyskom-help-strings)
-                                (car x)))
-                        lyskom-help-categories))
-         (category nil))
-
-    (while (null category)
-      (setq category
+  (let* ((alternatives (delq nil
+                             (mapcar (lambda (section)
+                                       (unless (string= "" (elt section 1))
+                                         (cons (elt section 1) 
+                                               (elt section 0))))
+                                     lyskom-help-data)))
+         (completion-ignore-case t)
+         (section nil))
+    (while (null section)
+      (setq section
             (lyskom-string-assoc
              (lyskom-completing-read (lyskom-get-string 'help-with-what)
-                                     table
+                                     alternatives
                                      nil
                                      t
                                      nil
                                      'lyskom-help-history)
-             table)))
-    (lyskom-format-insert "Hjlp fr %#1s\n\n" 
-                          (car category))
-    (lyskom-display-help-category (cdr category))))
+             alternatives)))
+    (lyskom-format-insert 'help-for (car section))
+    (lyskom-help-format-section (cdr section))))
+
+
+
+
+
 
 (defun lyskom-display-help-category (category &optional flags)
   "Display help category CATEGORY."

src/english-strings.el

@@ -1639,6 +1639,7 @@ You must become an active member of the conference to enter it.\n")
     ;; Help stuff
 
     (help-with-what . "What do you want help with? ")
+    (help-for . "Help for \"%#1s\"\n")
 
     ;; Button actions
 
@@ -3831,6 +3832,8 @@ be saved in the server. Otherwise it will be saved in your .emacs.")
 (lyskom-language-var global lyskom-unread-title-format en
   (lyskom-make-lyskom-unread-title-format))
 
+(lyskom-language-var local lyskom-help-data en nil)
+
 
 (provide 'lyskom-strings)
 

src/help-compile.el

+;;;;; -*-coding: iso-8859-1;-*-
+;;;;;
+;;;;; $Id$
+;;;;; Copyright (C) 1991-2002  Lysator Academic Computer Association.
+;;;;;
+;;;;; This file is part of the LysKOM Emacs LISP client.
+;;;;; 
+;;;;; LysKOM 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 2, or (at your option) 
+;;;;; any later version.
+;;;;; 
+;;;;; LysKOM 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 LysKOM; see the file COPYING.  If not, write to
+;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN,
+;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
+;;;;; MA 02139, USA.
+;;;;;
+;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. 
+;;;;;
+;;;; ================================================================
+;;;; ================================================================
+;;;;
+;;;; File: help-compile.el
+;;;;
+;;;; Compiler for elisp-client help files. This file is only used for
+;;;; compilation and is currently not linked into the runtime.
+;;;;
+
+
+;;; Note that these are duplicated in help.el. Change one and change both!
+
+(defsubst lyskom-help-create-data (tag attr data)
+  (list tag attr data))
+
+(defsubst lyskom-help-data-get-tag (data)
+  (elt data 0))
+
+(defsubst lyskom-help-data-get-attr (attr data)
+  (cdr (assq attr (elt data 1))))
+
+(defsubst lyskom-help-data-get-attrs (data)
+  (elt data 1))
+
+(defsubst lyskom-help-data-get-data (data)
+  (elt data 2))
+
+(defmacro lyskom-help-traverse (atom sequence &rest body)
+  "Bind ATOM to each element in SEQUENCE and execute BODY.
+Value returned is always nil."
+  `(let* ((__i__ 0)
+          (__sequence__ ,sequence)
+          (__len__ (or (listp __sequence__ )
+                       (length __sequence__)))
+          (,atom nil)
+          (__result__ nil))
+     (setq __result__ __result__)       ; Get rid of compiler warnings
+     (if (listp __sequence__)
+         (while __sequence__
+           (setq ,atom (car __sequence__))
+           ,@body
+           (setq __sequence__ (cdr __sequence__)))
+       (while (< __i__ __len__)
+         (setq ,atom (aref __sequence__ __i__))
+         ,@body
+         (setq __i__ (1+ __i__))))
+     __result__))
+
+(defvar lyskom-help-syntax
+  '((help (language) (section) lyskom-help-parse-process-finish)
+    (section (id prompt) (p list h1 h2 h3 inline refer) lyskom-help-parse-process-section)
+    (h1 nil (cref TEXT) nil)
+    (h2 nil (cref TEXT) nil)
+    (h3 nil (cref TEXT) nil)
+    (p nil (b i cref TEXT) nil)
+    (b nil (cref TEXT) nil)
+    (i nil (cref TEXT) nil)
+    (list nil (item) nil)
+    (item nil (b i cref TEXT) nil)
+    (inline (id) nil lyskom-help-parse-process-section-ref)
+    (refer (id) nil lyskom-help-parse-process-section-ref)
+    (cref (id) nil lyskom-help-parse-process-command-ref)
+    )
+  "Syntax of the help language.
+Each element is the syntax for a single tag. Each list consists of
+TAG ATTRS CONTENTS")
+
+(defun lyskom-help-syntax-attrs (syntax)
+  "Return the required attributes of a syntax element"
+  (elt syntax 1))
+
+(defun lyskom-help-syntax-contents (syntax)
+  "Return the allowed content types of a syntax element"
+  (elt syntax 2))
+
+(defun lyskom-help-syntax-postprocess (syntax)
+  "Return the allowed content types of a syntax element"
+  (elt syntax 3))
+
+
+(defvar lyskom-help-parse-section-list nil)
+(defvar lyskom-help-parse-section-ref-list nil)
+(defvar lyskom-help-parse-command-ref-list nil)
+(defvar lyskom-help-parse-unresolved-section-references nil)
+
+(defun lyskom-help-parse-process-section (parse)
+  (setq lyskom-help-parse-section-list
+        (cons (intern (lyskom-help-data-get-attr 'id parse))
+              lyskom-help-parse-section-list)))
+
+(defun lyskom-help-parse-process-section-ref (parse)
+  (setq lyskom-help-parse-section-ref-list
+        (cons (intern (lyskom-help-data-get-attr 'id parse))
+              lyskom-help-parse-section-ref-list)))
+
+(defun lyskom-help-parse-process-command-ref (parse)
+  (setq lyskom-help-parse-command-ref-list
+        (cons (intern (lyskom-help-data-get-attr 'id parse))
+              lyskom-help-parse-command-ref-list)))
+
+(defun lyskom-help-parse-process-finish (parse)
+  (lyskom-help-traverse id lyskom-help-parse-section-list
+    (setq lyskom-help-parse-section-ref-list 
+          (delq id lyskom-help-parse-section-ref-list)))
+  (when lyskom-help-parse-section-ref-list
+    (setq lyskom-help-parse-unresolved-section-references
+          lyskom-help-parse-section-ref-list)
+    (error "Unresolved help section references: %s"
+           lyskom-help-parse-section-ref-list)))
+
+
+
+
+
+(defun lyskom-non-matching-regexp (string)
+  "Compute a regexp that will match anything but STRING."
+  (let ((alternatives nil)
+        (i 0))
+    (while (< i (length string))
+      (setq alternatives (cons (concat (substring string 0 i)
+                                       "[^" 
+                                       (substring string i (1+ i))
+                                       "]")
+                               alternatives)
+            i (1+ i)))
+    (concat "\\("
+            (mapconcat 'identity (nreverse alternatives) "\\|")
+            "\\)*")))
+
+
+(defun lyskom-help-parse-attrs (string)
+  (save-match-data 
+    (let ((result nil)
+          (start 0))
+      (while (string-match "\\s-*\\([a-z]+\\)=\"\\([^\"]*\\)\"\\s-*" string start)
+        (setq result (cons (cons (intern (match-string 1 string))
+                                 (match-string 2 string))
+                           result)
+              start (match-end 0)))
+      (nreverse result))))
+
+(defun lyskom-help-parse-string (string &optional containing-syntax)
+  "Convert a help string STRING to a tree, checking it as we go.
+CONTAINING-SYNTAX is the syntax specification for the containing tag."
+  (let ((result nil)
+        (collect-data (memq 'TEXT
+                            (lyskom-help-syntax-contents containing-syntax)))
+        (start 0))
+
+    ;; Loop over the string, looking for tags
+
+    (while (string-match
+            "<\\([a-z0-9]+\\)\\(\\(\\s-+[a-z0-9]+=\"[^\"]*\"\\)*\\)\\s-*\\(/*\\)>"
+            string start)
+      (let* ((tag (match-string 1 string))
+             (tag-symbol (intern tag))
+             (attrs (lyskom-help-parse-attrs (match-string 2 string)))
+             (tag-start (match-beginning 0))
+             (tag-end (match-end 0))
+             (end (string= "/" (match-string 4 string)))
+             (syntax (assq tag-symbol lyskom-help-syntax))
+             (contents nil))
+
+        ;; Check that the tag is known
+
+        (unless syntax (error "Unknown tag %s" tag))
+
+        ;; Check that the tag is permitted in this context
+
+        (unless (memq tag-symbol 
+                      (lyskom-help-syntax-contents containing-syntax))
+          (error "Tag %s not permitted in %s" tag (car containing-syntax)))
+
+        ;; Check that the attributes are OK
+
+        (unless (equal (mapcar 'car attrs)
+                       (lyskom-help-syntax-attrs syntax))
+          (error "Invalid attribute list %s to tag %s"
+                 (mapcar 'car attrs) tag))
+
+        ;; Found a tag, but there is intervening text
+        ;; If we were called with instructions to save this data,
+        ;; save it. If not, ensure that the intervening text only
+        ;; consists of whitespace.
+
+        (when (> tag-start start)
+          (let ((text (substring string start tag-start)))
+            (cond (collect-data (setq result (cons (cons 'TEXT text) result)))
+                  ((string-match "\\`\\s-*\\'" text))
+                  (t (error "Text data \"%s\" inside %s tag" text tag)))))
+
+        ;; Find the position of the end tag
+
+        (let ((end-tag-start nil)
+              (end-tag-end nil))
+          (if end
+              (setq end-tag-start tag-end end-tag-end tag-end)
+            (let ((re (concat (lyskom-non-matching-regexp
+                               (concat "</" tag ">"))
+                              "\\(</" tag ">\\)")))
+              (if (eq tag-end (string-match re string tag-end))
+                  (setq end-tag-start (match-beginning 1)
+                        end-tag-end (match-end 0))
+                (error "Unterminated tag: %s %s" tag string))))
+
+          ;; Have the position of the end tag
+          ;; Put the element we found into result
+
+          (setq result
+                (cons (lyskom-help-create-data
+                       tag-symbol
+                       attrs
+                       (if (eq end-tag-start tag-end)
+                           nil
+                         (lyskom-help-parse-string
+                          (substring string tag-end (1+ end-tag-start))
+                          syntax)))
+                      result)
+                start end-tag-end)
+
+          ;; Postprocess the parsed element
+          (when (lyskom-help-syntax-postprocess syntax)
+            (funcall (lyskom-help-syntax-postprocess syntax) (car result))))))
+
+    ;; No more tags
+    ;; There's just text left. Record it.
+
+    (unless (eq start (length string))
+      (let ((text (substring string start)))
+        (cond (collect-data (setq result (cons (cons 'TEXT text) result)))
+              ((string-match "\\`\\s-*\\'" text))
+              (t (error "Unexpected text \"%s\" at end of document" text)))))
+
+    ;; Done. The result is, as usual, in reverse order.
+
+    (nreverse result)))
+
+(defun lyskom-help-replace-regexp (regexp to-string)
+  (goto-char (point-min))
+  (while (re-search-forward regexp nil t)
+    (replace-match to-string nil nil)))
+
+(defun lyskom-help-parse-help-file (filename)
+  (save-excursion
+    (let ((buffer (get-buffer-create "*Help*-parse"))
+          (lyskom-help-parse-section-list nil)
+          (lyskom-help-parse-section-ref-list nil)
+          (lyskom-help-parse-command-ref-list nil))
+      (set-buffer buffer)
+      (erase-buffer)
+      (insert-file-contents filename)
+      (lyskom-help-replace-regexp "[\r\n]" "")
+      (lyskom-help-replace-regexp "<!--[^>]*-->" "")
+      (lyskom-help-replace-regexp "\\s-+" " ")
+      (let ((parse (lyskom-help-parse-string (buffer-string)
+                                             '(nil nil (help)))))
+        parse))))
+
+(defun lyskom-help-parse-extract (parse tag)
+  (let ((result nil))
+    (lyskom-help-traverse toplevel parse
+      (when (eq (lyskom-help-data-get-tag toplevel) tag)
+        (setq result
+              (cons (list (intern (lyskom-help-data-get-attr 'id toplevel))
+                          (lyskom-help-data-get-attr 'prompt toplevel)
+                          (lyskom-help-data-get-data toplevel))
+                    result))))
+    (nreverse result)))
+
+(defmacro lyskom-help-compile (language)
+  `(quote ,(lyskom-help-parse-extract
+            (lyskom-help-data-get-data
+             (car (lyskom-help-parse-help-file (format "help.%s" language))))
+            'section)))
+

src/help.el

+;;;;; -*-coding: iso-8859-1;-*-
+;;;;;
+;;;;; $Id$
+;;;;; Copyright (C) 1991-2002  Lysator Academic Computer Association.
+;;;;;
+;;;;; This file is part of the LysKOM Emacs LISP client.
+;;;;; 
+;;;;; LysKOM 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 2, or (at your option) 
+;;;;; any later version.
+;;;;; 
+;;;;; LysKOM 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 LysKOM; see the file COPYING.  If not, write to
+;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN,
+;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
+;;;;; MA 02139, USA.
+;;;;;
+;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. 
+;;;;;
+;;;; ================================================================
+;;;; ================================================================
+;;;;
+;;;; File: help.el
+;;;;
+;;;; Functions for formatting help strings in the client
+;;;;
+
+
+(setq lyskom-clientversion-long 
+      (concat lyskom-clientversion-long
+	      "$Id$\n"))
+
+
+
+(defgroup lyskom-faces nil
+  "Faces for use in the LysKOM elisp client."
+  :group 'lyskom)
+
+(defgroup lyskom nil
+  "Faces for use in the LysKOM elisp client."
+  :group 'default)
+
+(defface lyskom-help-h1-face '((t (:weight bold :underline t :height 2.0)))
+  "First level header in LysKOM help."
+  :group 'lyskom-faces)
+
+(defface lyskom-help-h2-face '((t (:weight bold :underline t :height 1.5)))
+  "Second level header in LysKOM help."
+  :group 'lyskom-faces)
+
+(defface lyskom-help-h3-face '((t (:weight bold :underline t)))
+  "Third level header in LysKOM help."
+  :group 'lyskom-faces)
+
+;;; Note that these are duplicated in help-compile.el. Change one and change both!
+
+(defsubst lyskom-help-create-data (tag attr data)
+  (list tag attr data))
+
+(defsubst lyskom-help-data-get-tag (data)
+  (elt data 0))
+
+(defsubst lyskom-help-data-get-attr (attr data)
+  (cdr (assq attr (elt data 1))))
+
+(defsubst lyskom-help-data-get-attrs (data)
+  (elt data 1))
+
+(defsubst lyskom-help-data-get-data (data)
+  (elt data 2))
+
+
+(defvar lyskom-help-format-handlers
+  '((h1 . lyskom-help-format-h1)
+    (h2 . lyskom-help-format-h2)
+    (h3 . lyskom-help-format-h3)
+    (p  . lyskom-help-format-p)
+    (b  . lyskom-help-format-b)
+    (i  . lyskom-help-format-i)
+    (list . lyskom-help-format-list)
+    (item . lyskom-help-format-item)
+    (inline . lyskom-help-format-inline)
+    (refer . lyskom-help-format-refer)
+    (cref . lyskom-help-format-cref)
+    (TEXT . lyskom-help-format-TEXT))
+  )
+
+(defun lyskom-help-get-section (section)
+  (elt (assq section lyskom-help-data) 2))
+
+(defun lyskom-help-format-section (section)
+  "Format and insert section SECTION."
+  (lyskom-do-help-format (lyskom-help-get-section section)))
+
+(defun lyskom-do-help-format (data)
+  "Format ant insert help data DATA."
+  (let ((inhibit-read-only t))
+    (cond ((symbolp (car data))
+           (funcall (cdr (assq (car data) lyskom-help-format-handlers)) data))
+          (t (lyskom-traverse el data
+                              (let ((tag (lyskom-help-data-get-tag el))
+                                    (data (lyskom-help-data-get-data el)))
+                                (funcall (cdr (assq tag lyskom-help-format-handlers))
+                                         el)))))))
+
+(defun lyskom-help-format-text-properties (data props)
+  (let ((start (point-marker)))
+    (lyskom-traverse el (lyskom-help-data-get-data data)
+      (lyskom-do-help-format el))
+    (add-text-properties start (point) props)
+    (set-marker start nil)))
+
+(defun lyskom-help-format-h1 (data)
+  (lyskom-insert "\n\n")
+  (lyskom-help-format-text-properties data '(face lyskom-help-h1-face))
+  (lyskom-insert "\n\n"))
+
+(defun lyskom-help-format-h2 (data)
+  (lyskom-help-format-text-properties data '(face lyskom-help-h2-face))
+  (lyskom-insert "\n"))
+
+(defun lyskom-help-format-h3 (data)
+  (lyskom-help-format-text-properties data '(face lyskom-help-h3-face))
+  (lyskom-insert "\n"))
+
+(defun lyskom-help-format-i (data)
+  (lyskom-help-format-text-properties data '(face italic)))
+
+(defun lyskom-help-format-b (data)
+  (lyskom-help-format-text-properties data '(face bold)))
+
+(defun lyskom-help-format-TEXT (data)
+  (lyskom-insert (cdr data)))
+
+(defun lyskom-help-format-list (data)
+  (lyskom-insert "\n")
+  (lyskom-traverse el data (lyskom-do-help-format el))
+  (lyskom-insert "\n"))
+
+(defun lyskom-help-format-item (data)
+  (lyskom-insert "  * ")
+  (lyskom-traverse el data (lyskom-do-help-format el))
+  (lyskom-insert "\n"))
+
+(defun lyskom-help-format-refer (data)
+  (let* ((id (intern (lyskom-help-data-get-attr 'id data)))
+         (section (lyskom-help-get-section id)))
+    (cond (section (lyskom-insert 
+                    (lyskom-help-data-get-attr 'prompt section)))
+          (t (lyskom-insert (format "%s" id))))))
+
+(defun lyskom-help-format-cref (data)
+  (let* ((command (intern (lyskom-help-data-get-attr 'id data)))
+         (command-name (lyskom-command-name command))
+         (keys (delq nil
+                     (mapcar (lambda (x)
+                               (if (and (arrayp x)
+                                        (eq (elt x 0) 'menu-bar))
+                                   nil
+                                 x))
+                             (where-is-internal command))))
+         (heading (lyskom-format "%#1@%[%#2s%]%#3?b%[ (%#3s)%]%[%]\n"
+                                 '(face italic)
+                                 command-name
+                                 (and keys 
+                                      (mapconcat 'key-description
+                                                 keys
+                                                 "; ")))))
+    (lyskom-insert heading)))
+
+(defun lyskom-help-format-inline (data)
+  (let* ((id (intern (lyskom-help-data-get-attr 'id data)))
+         (section (lyskom-help-get-section id)))
+    (cond (section (lyskom-do-help-format section))
+          (t (lyskom-insert (format "[%S]" id))))))