]> gitweb.factorcode.org Git - factor.git/commitdiff
FUEL: Help system overhaul.
authorJose A. Ortega Ruiz <jao@gnu.org>
Sat, 3 Jan 2009 15:37:28 +0000 (16:37 +0100)
committerJose A. Ortega Ruiz <jao@gnu.org>
Sat, 3 Jan 2009 15:37:28 +0000 (16:37 +0100)
extra/fuel/fuel.factor
misc/fuel/README
misc/fuel/fuel-autodoc.el
misc/fuel/fuel-font-lock.el
misc/fuel/fuel-help.el
misc/fuel/fuel-markup.el [new file with mode: 0644]
misc/fuel/fuel-xref.el

index c1d90ebbccda77c13ae52c74aefdae8136bd98b5..a3cb6a9a2281a24ef48eaf481098dfa70eade46a 100644 (file)
@@ -1,11 +1,12 @@
-! Copyright (C) 2008 Jose Antonio Ortega Ruiz.
+! Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz.
 ! See http://factorcode.org/license.txt for BSD license.
 
 USING: accessors arrays assocs classes.tuple combinators
-compiler.units continuations debugger definitions io io.pathnames
-io.streams.string kernel lexer math math.order memoize namespaces
-parser prettyprint sequences sets sorting source-files strings summary
-tools.vocabs vectors vocabs vocabs.parser words ;
+compiler.units continuations debugger definitions help help.crossref
+help.markup help.topics io io.pathnames io.streams.string kernel lexer
+make math math.order memoize namespaces parser prettyprint sequences
+sets sorting source-files strings summary tools.vocabs vectors vocabs
+vocabs.parser words ;
 
 IN: fuel
 
@@ -56,6 +57,12 @@ GENERIC: fuel-pprint ( obj -- )
 
 M: object fuel-pprint pprint ; inline
 
+: fuel-maybe-scape ( ch -- seq )
+    dup "?#()[]'`" member? [ CHAR: \ swap 2array ] [ 1array ] if ;
+
+M: word fuel-pprint
+    name>> V{ } clone [ fuel-maybe-scape append ] reduce >string write ;
+
 M: f fuel-pprint drop "nil" write ; inline
 
 M: integer fuel-pprint pprint ; inline
@@ -144,8 +151,8 @@ SYMBOL: :uses
 : fuel-run-file ( path -- )
     [ fuel-set-use-hook run-file ] curry with-scope ; inline
 
-: fuel-with-autouse ( quot -- )
-    [ auto-use? on fuel-set-use-hook call ] curry with-scope ;
+: fuel-with-autouse ( quot --  )
+    [ auto-use? on fuel-set-use-hook call ] curry with-scope ; inline
 
 : (fuel-get-uses) ( lines -- )
     [ parse-fresh drop ] curry with-compilation-unit ; inline
@@ -218,6 +225,69 @@ MEMO: (fuel-vocab-words) ( name -- seq )
 : fuel-get-words ( prefix names -- )
     (fuel-get-words) fuel-eval-set-result ; inline
 
+! Help support
+
+MEMO: fuel-articles-seq ( -- seq )
+    articles get values ;
+
+: fuel-find-articles ( title -- seq )
+    [ [ article-title ] dip = ] curry fuel-articles-seq swap filter ;
+
+MEMO: fuel-find-article ( title -- article/f )
+    fuel-find-articles dup empty? [ drop f ] [ first ] if ;
+
+MEMO: fuel-article-title ( name -- title/f )
+    articles get at [ article-title ] [ f ] if* ;
+
+: fuel-get-article ( name -- )
+    article fuel-eval-set-result ;
+
+: fuel-value-str ( word -- str )
+    [ pprint-short ] with-string-writer ; inline
+
+: fuel-definition-str ( word -- str )
+    [ see ] with-string-writer ; inline
+
+: fuel-methods-str ( word -- str )
+    methods dup empty? not [
+        [ [ see nl ] each ] with-string-writer
+    ] [ drop f ] if ; inline
+
+: fuel-related-words ( word -- seq )
+    dup "related" word-prop remove ; inline
+
+: fuel-parent-topics ( word -- seq )
+    help-path [ dup article-title swap 2array ] map ; inline
+
+: (fuel-word-help) ( word -- element )
+    dup \ article swap article-title rot
+    [
+        {
+            [ fuel-parent-topics [ \ $doc-path prefix , ] unless-empty ]
+            [ \ $vocabulary swap vocabulary>> 2array , ]
+            [ word-help % ]
+            [ fuel-related-words [ \ $related swap 2array , ] unless-empty ]
+            [ get-global [ \ $value swap fuel-value-str 2array , ] when* ]
+            [ \ $definition swap fuel-definition-str 2array , ]
+            [ fuel-methods-str [ \ $methods swap 2array , ] when* ]
+        } cleave
+    ] { } make 3array ;
+
+MEMO: fuel-find-word ( name -- word/f )
+    [ [ name>> ] dip = ] curry all-words swap filter
+    dup empty? not [ first ] [ drop f ] if ;
+
+: fuel-word-help ( name -- )
+    fuel-find-word [ [ auto-use? on (fuel-word-help) ] with-scope ] [ f ] if*
+    fuel-eval-set-result ; inline
+
+: (fuel-word-see) ( word -- elem )
+    [ name>> \ article swap ]
+    [ [ see ] with-string-writer \ $code swap 2array ] bi 3array ; inline
+
+: fuel-word-see ( name -- )
+    fuel-find-word [ [ auto-use? on (fuel-word-see) ] with-scope ] [ f ] if*
+    fuel-eval-set-result ; inline
 
 ! -run=fuel support
 
index b670eef84d84dd6dabb23f0f3204e7b0ec82b828..36415bc2255e25282dd50e6cf4629649677b1566 100644 (file)
@@ -94,10 +94,12 @@ C-cC-eC-r is the same as C-cC-er)).
 
 * In the Help browser:
 
- - RET : help for word at point
+ - h : help for word at point
  - f/b : next/previous page
  - SPC/S-SPC : scroll up/down
- - TAB/S-TAB : next/previous headline
+ - TAB/S-TAB : next/previous link
+ - c : clean browsing history
+ - M-. : edit word at point in Emacs
  - C-cz : switch to listener
  - q : bury buffer
 
index 151631eea19784600fee59ee38bb0904c5f6371b..53b522896537cdcd291b828fa5973a55a6ad6711 100644 (file)
@@ -1,6 +1,6 @@
 ;;; fuel-autodoc.el -- doc snippets in the echo area
 
-;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
 ;; See http://factorcode.org/license.txt for BSD license.
 
 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
   :type 'boolean)
 
 
-\f
-;;; Highlighting for autodoc messages:
-
-(defvar fuel-autodoc--font-lock-buffer
-  (let ((buffer (get-buffer-create " *fuel help minibuffer messages*")))
-    (set-buffer buffer)
-    (set-syntax-table fuel-syntax--syntax-table)
-    (fuel-font-lock--font-lock-setup)
-    buffer))
-
-(defun fuel-autodoc--font-lock-str (str)
-  (set-buffer fuel-autodoc--font-lock-buffer)
-  (erase-buffer)
-  (insert str)
-  (let ((font-lock-verbose nil)) (font-lock-fontify-buffer))
-  (buffer-string))
-
 \f
 ;;; Eldoc function:
 
@@ -65,7 +48,7 @@
              (res (fuel-eval--retort-result ret)))
         (when (and ret (not (fuel-eval--retort-error ret)) (stringp res))
           (if fuel-autodoc-minibuffer-font-lock
-              (fuel-autodoc--font-lock-str res)
+              (fuel-font-lock--factor-str res)
             res))))))
 
 (make-variable-buffer-local
index 1c37de7b188a1ed9b0ee7ecb8a55b892d55b8915..d4ce88cf2027025975c63ac25c96da9b3bcf6910 100644 (file)
@@ -1,6 +1,6 @@
 ;;; fuel-font-lock.el -- font lock for factor code
 
-;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
 ;; See http://factorcode.org/license.txt for BSD license.
 
 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
                          fuel-syntax--syntactic-keywords))))))
 
 \f
+\f
+;;; Fontify strings as Factor code:
+
+(defvar fuel-font-lock--font-lock-buffer
+  (let ((buffer (get-buffer-create " *fuel font lock*")))
+    (set-buffer buffer)
+    (set-syntax-table fuel-syntax--syntax-table)
+    (fuel-font-lock--font-lock-setup)
+    buffer))
+
+(defun fuel-font-lock--factor-str (str)
+  (save-current-buffer
+    (set-buffer fuel-font-lock--font-lock-buffer)
+    (erase-buffer)
+    (insert str)
+    (let ((font-lock-verbose nil)) (font-lock-fontify-buffer))
+    (buffer-string)))
+
+
 (provide 'fuel-font-lock)
 ;;; fuel-font-lock.el ends here
index 325e2971be49ed570e771af417f42fb7f517bd83..dc40463362e5032c3d405e39e3d48d6aa35f6594 100644 (file)
@@ -1,6 +1,6 @@
 ;;; fuel-help.el -- accessing Factor's help system
 
-;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
 ;; See http://factorcode.org/license.txt for BSD license.
 
 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
 ;;; Code:
 
 (require 'fuel-eval)
+(require 'fuel-markup)
 (require 'fuel-autodoc)
 (require 'fuel-completion)
 (require 'fuel-font-lock)
 (require 'fuel-popup)
 (require 'fuel-base)
 
+(require 'button)
+
 \f
 ;;; Customization:
 
   :type 'boolean
   :group 'fuel-help)
 
-(defcustom fuel-help-use-minibuffer t
-  "When enabled, use the minibuffer for short help messages."
-  :type 'boolean
-  :group 'fuel-help)
-
-(defcustom fuel-help-mode-hook nil
-  "Hook run by `factor-help-mode'."
-  :type 'hook
-  :group 'fuel-help)
-
 (defcustom fuel-help-history-cache-size 50
   "Maximum number of pages to keep in the help browser cache."
   :type 'integer
   :group 'fuel-help)
 
-(fuel-font-lock--defface fuel-font-lock-help-headlines
-  'bold fuel-hep "headlines in help buffers")
-
 \f
 ;;; Help browser history:
 
-(defvar fuel-help--history
+(defun fuel-help--make-history ()
   (list nil                                        ; current
         (make-ring fuel-help-history-cache-size)   ; previous
         (make-ring fuel-help-history-cache-size))) ; next
 
+(defvar fuel-help--history (fuel-help--make-history))
+
 (defun fuel-help--history-push (term)
   (when (and (car fuel-help--history)
              (not (string= (caar fuel-help--history) (car term))))
 
 (defvar fuel-help--prompt-history nil)
 
-(defun fuel-help--show-help (&optional see word)
-  (let* ((def (or word (fuel-syntax-symbol-at-point)))
+(defun fuel-help--read-word (see)
+  (let* ((def (fuel-syntax-symbol-at-point))
          (prompt (format "See%s help on%s: " (if see " short" "")
                          (if def (format " (%s)" def) "")))
          (ask (or (not (memq major-mode '(factor-mode fuel-help-mode)))
                   (not def)
-                  fuel-help-always-ask))
-         (def (if ask (fuel-completion--read-word prompt
-                                                  def
-                                                  'fuel-help--prompt-history
-                                                  t)
-                def))
-         (cmd `(:fuel* ((:quote ,def) ,(if see 'see 'help)) t)))
-    (message "Looking up '%s' ..." def)
-    (fuel-eval--send cmd `(lambda (r) (fuel-help--show-help-cont ,def r)))))
-
-(defun fuel-help--show-help-cont (def ret)
-  (let ((out (fuel-eval--retort-output ret)))
-    (if (or (fuel-eval--retort-error ret) (empty-string-p out))
-        (message "No help for '%s'" def)
-      (fuel-help--insert-contents def out))))
-
-(defun fuel-help--insert-contents (def str &optional nopush)
+                  fuel-help-always-ask)))
+    (if ask (fuel-completion--read-word prompt
+                                        def
+                                        'fuel-help--prompt-history
+                                        t)
+      def)))
+
+(defun fuel-help--word-help (&optional see word)
+  (let ((def (or word (fuel-help--read-word see))))
+    (when def
+      (let ((cmd `(:fuel* (,def ,(if see 'fuel-word-see 'fuel-word-help))
+                          "fuel" t)))
+        (message "Looking up '%s' ..." def)
+        (let* ((ret (fuel-eval--send/wait cmd 2000))
+               (res (fuel-eval--retort-result ret)))
+          (if (not res)
+              (message "No help for '%s'" def)
+            (fuel-help--insert-contents def res)))))))
+
+(defun fuel-help--get-article (name label)
+  (message "Retriving article ...")
+  (let* ((cmd `(:fuel* ((,name fuel-get-article)) "fuel" t))
+         (ret (fuel-eval--send/wait cmd 2000))
+         (res (fuel-eval--retort-result ret)))
+    (fuel-help--insert-contents label res)
+    (message "")))
+
+(defun fuel-help--follow-link (label link type)
+  (let ((fuel-help-always-ask nil))
+    (cond ((eq type 'word) (fuel-help--word-help nil link))
+          ((eq type 'article) (fuel-help--get-article link label))
+          (t (message (format "Links of type %s not yet implemented" type))))))
+
+(defun fuel-help--insert-contents (def art &optional nopush)
   (let ((hb (fuel-help--buffer))
         (inhibit-read-only t)
         (font-lock-verbose nil))
     (set-buffer hb)
     (erase-buffer)
-    (insert str)
+    (if (stringp art)
+        (insert art)
+      (fuel-markup--print art)
+      (fuel-markup--insert-newline))
     (unless nopush
-      (goto-char (point-min))
-      (when (re-search-forward (format "^%s" def) nil t)
-        (beginning-of-line)
-        (kill-region (point-min) (point))
-        (fuel-help--history-push (cons def (buffer-string)))))
+      (fuel-help--history-push (cons def (buffer-string))))
     (set-buffer-modified-p nil)
     (fuel-popup--display)
     (goto-char (point-min))
-    (message "%s" def)))
-
-\f
-;;; Help mode font lock:
-
-(defconst fuel-help--headlines
-  (regexp-opt '("Class description"
-                "Definition"
-                "Errors"
-                "Examples"
-                "Generic word contract"
-                "Inputs and outputs"
-                "Methods"
-                "Notes"
-                "Parent topics:"
-                "See also"
-                "Side effects"
-                "Syntax"
-                "Variable description"
-                "Variable value"
-                "Vocabulary"
-                "Warning"
-                "Word description")
-              t))
-
-(defconst fuel-help--headlines-regexp (format "^%s" fuel-help--headlines))
-
-(defconst fuel-help--font-lock-keywords
-  `(,@fuel-font-lock--font-lock-keywords
-    (,fuel-help--headlines-regexp . 'fuel-font-lock-help-headlines)))
-
+    (message "")))
 
 \f
 ;;; Interactive help commands:
 
-(defun fuel-help-short (&optional arg)
-  "See a help summary of symbol at point.
-By default, the information is shown in the minibuffer. When
-called with a prefix argument, the information is displayed in a
-separate help buffer."
-  (interactive "P")
-  (if (if fuel-help-use-minibuffer (not arg) arg)
-      (fuel-help--word-synopsis)
-    (fuel-help--show-help t)))
+(defun fuel-help-short ()
+  "See help summary of symbol at point."
+  (interactive)
+  (fuel-help--word-help t))
 
 (defun fuel-help ()
   "Show extended help about the symbol at point, using a help
 buffer."
   (interactive)
-  (fuel-help--show-help))
+  (fuel-help--word-help))
 
 (defun fuel-help-next ()
   "Go to next page in help browser."
@@ -193,15 +166,12 @@ buffer."
       (error "No previous page"))
     (fuel-help--insert-contents (car item) (cdr item) t)))
 
-(defun fuel-help-next-headline (&optional count)
-  (interactive "P")
-  (end-of-line)
-  (when (re-search-forward fuel-help--headlines-regexp nil t (or count 1))
-    (beginning-of-line)))
-
-(defun fuel-help-previous-headline (&optional count)
-  (interactive "P")
-  (re-search-backward fuel-help--headlines-regexp nil t count))
+(defun fuel-help-clean-history ()
+  "Clean up the help browser cache of visited pages."
+  (interactive)
+  (when (y-or-n-p "Clean browsing history? ")
+    (setq fuel-help--history (fuel-help--make-history)))
+  (message ""))
 
 \f
 ;;;; Help mode map:
@@ -209,15 +179,14 @@ buffer."
 (defvar fuel-help-mode-map
   (let ((map (make-sparse-keymap)))
     (suppress-keymap map)
-    (define-key map "\C-m" 'fuel-help)
+    (set-keymap-parent map button-buffer-map)
     (define-key map "b" 'fuel-help-previous)
+    (define-key map "c" 'fuel-help-clean-history)
     (define-key map "f" 'fuel-help-next)
+    (define-key map "h" 'fuel-help)
     (define-key map "l" 'fuel-help-previous)
     (define-key map "p" 'fuel-help-previous)
     (define-key map "n" 'fuel-help-next)
-    (define-key map (kbd "TAB") 'fuel-help-next-headline)
-    (define-key map (kbd "S-TAB") 'fuel-help-previous-headline)
-    (define-key map [(backtab)] 'fuel-help-previous-headline)
     (define-key map (kbd "SPC")  'scroll-up)
     (define-key map (kbd "S-SPC") 'scroll-down)
     (define-key map "\M-." 'fuel-edit-word-at-point)
@@ -235,16 +204,15 @@ buffer."
   (kill-all-local-variables)
   (buffer-disable-undo)
   (use-local-map fuel-help-mode-map)
+  (set-syntax-table fuel-syntax--syntax-table)
   (setq mode-name "FUEL Help")
   (setq major-mode 'fuel-help-mode)
 
-  (fuel-font-lock--font-lock-setup fuel-help--font-lock-keywords t)
+  (setq fuel-markup--follow-link-function 'fuel-help--follow-link)
 
   (setq fuel-autodoc-mode-string "")
   (fuel-autodoc-mode)
 
-  (run-mode-hooks 'fuel-help-mode-hook)
-
   (setq buffer-read-only t))
 
 \f
diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el
new file mode 100644 (file)
index 0000000..0c83c74
--- /dev/null
@@ -0,0 +1,417 @@
+;;; fuel-markup.el -- printing factor help markup
+
+;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+;; See http://factorcode.org/license.txt for BSD license.
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Keywords: languages, fuel, factor
+;; Start date: Thu Jan 01, 2009 21:43
+
+;;; Comentary:
+
+;; Utilities for printing Factor's help markup.
+
+;;; Code:
+
+(require 'fuel-eval)
+(require 'fuel-font-lock)
+(require 'fuel-base)
+
+(require 'button)
+(require 'table)
+
+\f
+;;; Customization:
+
+(fuel-font-lock--defface fuel-font-lock-markup-title
+  'bold fuel-help "article titles in help buffers")
+
+(fuel-font-lock--defface fuel-font-lock-markup-heading
+  'bold fuel-help "headlines in help buffers")
+
+(fuel-font-lock--defface fuel-font-lock-markup-link
+  'link fuel-help "links to topics in help buffers")
+
+(fuel-font-lock--defface fuel-font-lock-markup-emphasis
+  'italic fuel-help "emphasized words in help buffers")
+
+(fuel-font-lock--defface fuel-font-lock-markup-strong
+  'link fuel-help "bold words in help buffers")
+
+\f
+;;; Links:
+
+(make-variable-buffer-local
+ (defvar fuel-markup--follow-link-function 'fuel-markup--echo-link))
+
+(define-button-type 'fuel-markup--button
+  'action 'fuel-markup--follow-link
+  'face 'fuel-font-lock-markup-link
+  'follow-link t)
+
+(defun fuel-markup--follow-link (button)
+  (when fuel-markup--follow-link-function
+    (funcall fuel-markup--follow-link-function
+             (button-label button)
+             (button-get button 'markup-link)
+             (button-get button 'markup-link-type))))
+
+(defun fuel-markup--echo-link (label link type)
+  (message "Link %s pointing to %s named %s" label type link))
+
+(defun fuel-markup--insert-button (label link type)
+  (insert-text-button (format "%s" label)
+                      :type 'fuel-markup--button
+                      'markup-link (format "%s" link)
+                      'markup-link-type type))
+
+(defun fuel-markup--article-title (name)
+  (fuel-eval--retort-result
+   (fuel-eval--send/wait `(:fuel* ((,name fuel-article-title :get)) "fuel"))))
+
+\f
+;;; Markup printers:
+
+(defconst fuel-markup--printers
+  '(($class-description . fuel-markup--class-description)
+    ($code . fuel-markup--code)
+    ($contract . fuel-markup--contract)
+    ($curious . fuel-markup--curious)
+    ($definition . fuel-markup--definition)
+    ($description . fuel-markup--description)
+    ($doc-path . fuel-markup--doc-path)
+    ($emphasis . fuel-markup--emphasis)
+    ($error-description . fuel-markup--error-description)
+    ($errors . fuel-markup--errors)
+    ($example . fuel-markup--example)
+    ($examples . fuel-markup--examples)
+    ($heading . fuel-markup--heading)
+    ($instance . fuel-markup--instance)
+    ($io-error . fuel-markup--io-error)
+    ($link . fuel-markup--link)
+    ($links . fuel-markup--links)
+    ($list . fuel-markup--list)
+    ($low-level-note . fuel-markup--low-level-note)
+    ($markup-example . fuel-markup--markup-example)
+    ($maybe . fuel-markup--maybe)
+    ($methods . fuel-markup--methods)
+    ($nl . fuel-markup--newline)
+    ($notes . fuel-markup--notes)
+    ($parsing-note . fuel-markup--parsing-note)
+    ($prettyprinting-note . fuel-markup--prettyprinting-note)
+    ($quotation . fuel-markup--quotation)
+    ($references . fuel-markup--references)
+    ($related . fuel-markup--related)
+    ($see . fuel-markup--see)
+    ($see-also . fuel-markup--see-also)
+    ($shuffle . fuel-markup--shuffle)
+    ($side-effects . fuel-markup--side-effects)
+    ($slot . fuel-markup--snippet)
+    ($snippet . fuel-markup--snippet)
+    ($strong . fuel-markup--strong)
+    ($subheading . fuel-markup--subheading)
+    ($subsection . fuel-markup--subsection)
+    ($synopsis . fuel-markup--synopsis)
+    ($syntax . fuel-markup--syntax)
+    ($table . fuel-markup--table)
+    ($unchecked-example . fuel-markup--example)
+    ($value . fuel-markup--value)
+    ($values . fuel-markup--values)
+    ($values-x/y . fuel-markup--values-x/y)
+    ($var-description . fuel-markup--var-description)
+    ($vocab-link . fuel-markup--vocab-link)
+    ($vocab-links . fuel-markup--vocab-links)
+    ($vocab-subsection . fuel-markup--vocab-subsection)
+    ($vocabulary . fuel-markup--vocabulary)
+    ($warning . fuel-markup--warning)
+    (article . fuel-markup--article)))
+
+(make-variable-buffer-local
+ (defvar fuel-markup--maybe-nl nil))
+
+(defun fuel-markup--print (e)
+  (cond ((null e))
+        ((stringp e) (fuel-markup--insert-string e))
+        ((and (listp e) (symbolp (car e))
+              (assoc (car e) fuel-markup--printers))
+         (funcall (cdr (assoc (car e) fuel-markup--printers)) e))
+        ((and (symbolp e)
+              (assoc e fuel-markup--printers))
+         (funcall (cdr (assoc e fuel-markup--printers)) e))
+        ((listp e) (mapc 'fuel-markup--print e))
+        ((symbolp e) (fuel-markup--print (list '$link e)))
+        (t (insert (format "\n%S\n" e)))))
+
+(defun fuel-markup--maybe-nl ()
+  (setq fuel-markup--maybe-nl (point)))
+
+(defun fuel-markup--insert-newline (&optional justification)
+  (fill-region (save-excursion (beginning-of-line) (point))
+               (point)
+               (or justification 'left))
+  (newline))
+
+(defsubst fuel-markup--insert-nl-if-nb (&optional no-fill)
+  (unless (eq (save-excursion (beginning-of-line) (point)) (point))
+    (if no-fill (newline) (fuel-markup--insert-newline))))
+
+(defsubst fuel-markup--put-face (txt face)
+  (put-text-property 0 (length txt) 'font-lock-face face txt)
+  txt)
+
+(defun fuel-markup--insert-heading (txt &optional no-nl)
+  (fuel-markup--insert-nl-if-nb)
+  (unless (bobp) (newline))
+  (fuel-markup--put-face txt 'fuel-font-lock-markup-heading)
+  (fuel-markup--insert-string txt)
+  (unless no-nl (newline)))
+
+(defun fuel-markup--insert-string (str)
+  (when fuel-markup--maybe-nl
+    (newline 2)
+    (setq fuel-markup--maybe-nl nil))
+  (insert str))
+
+(defun fuel-markup--article (e)
+  (setq fuel-markup--maybe-nl nil)
+  (insert (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-title))
+  (newline 2)
+  (fuel-markup--print (car (cddr e))))
+
+(defun fuel-markup--heading (e)
+  (fuel-markup--insert-heading (cadr e)))
+
+(defun fuel-markup--subheading (e)
+  (fuel-markup--insert-heading (cadr e)))
+
+(defun fuel-markup--subsection (e)
+  (fuel-markup--insert-nl-if-nb)
+  (insert "  - ")
+  (fuel-markup--link (cons '$link (cdr e)))
+  (fuel-markup--maybe-nl))
+
+(defun fuel-markup--newline (e)
+  (fuel-markup--insert-newline)
+  (newline))
+
+(defun fuel-markup--doc-path (e)
+  (fuel-markup--insert-heading "Related topics")
+  (insert "  ")
+  (dolist (art (cdr e))
+    (fuel-markup--insert-button (car art) (cadr art) 'article)
+    (insert ", "))
+  (delete-backward-char 2)
+  (fuel-markup--insert-newline 'left))
+
+(defun fuel-markup--emphasis (e)
+  (when (stringp (cadr e))
+    (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-emphasis)
+    (insert (cadr e))))
+
+(defun fuel-markup--strong (e)
+  (when (stringp (cadr e))
+    (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-strong)
+    (insert (cadr e))))
+
+(defun fuel-markup--snippet (e)
+  (let ((snip (cadr e)))
+    (if (stringp snip)
+        (insert (fuel-font-lock--factor-str snip))
+      (fuel-markup--print snip))))
+
+(defun fuel-markup--code (e)
+  (fuel-markup--insert-nl-if-nb)
+  (newline)
+  (dolist (snip (cdr e))
+    (if (stringp snip)
+        (insert (fuel-font-lock--factor-str snip))
+      (fuel-markup--print snip))
+    (newline))
+  (newline))
+
+(defun fuel-markup--syntax (e)
+  (fuel-markup--insert-heading "Syntax")
+  (fuel-markup--print (cons '$code (cdr e)))
+  (newline))
+
+(defun fuel-markup--examples (e)
+  (fuel-markup--insert-heading "Examples")
+  (fuel-markup--print (cdr e)))
+
+(defun fuel-markup--example (e)
+  (fuel-markup--print (cons '$code (cdr e))))
+
+(defun fuel-markup--markup-example (e)
+  (fuel-markup--print (cons '$code (cdr e))))
+
+(defun fuel-markup--link (e)
+  (let* ((link (cadr e))
+         (type (if (symbolp link) 'word 'article))
+         (label (or (and (eq type 'article)
+                         (fuel-markup--article-title link))
+                    link)))
+    (fuel-markup--insert-button label link type)))
+
+(defun fuel-markup--links (e)
+  (dolist (link (cdr e))
+    (insert " ")
+    (fuel-markup--link (list '$link link))
+    (insert " ")))
+
+(defun fuel-markup--vocab-subsection (e)
+  (insert (format " %S " e)))
+
+(defun fuel-markup--vocab-link (e)
+  (fuel-markup--insert-button (cadr e) (cadr e) 'vocab))
+
+(defun fuel-markup--vocab-links (e)
+  (dolist (link (cdr e))
+    (insert " ")
+    (fuel-markup--vocab-link (list '$vocab-link link))
+    (insert " ")))
+
+(defun fuel-markup--vocabulary (e)
+  (fuel-markup--insert-heading "Vocabulary:" t)
+  (insert " " (cadr e))
+  (newline))
+
+(defun fuel-markup--list (e)
+  (fuel-markup--insert-nl-if-nb)
+  (dolist (elt (cdr e))
+    (insert " - ")
+    (fuel-markup--print elt)
+    (fuel-markup--insert-newline)))
+
+(defun fuel-markup--table (e)
+  (fuel-markup--insert-newline)
+  (newline)
+  (let ((start (point))
+        (col-delim "<~end-of-col~>")
+        (col-no (length (cadr e))))
+    (dolist (row (cdr e))
+      (dolist (col row)
+        (fuel-markup--print col)
+        (insert col-delim)))
+    (table-capture start (point)
+                   col-delim nil nil
+                   (/ (- (window-width) 10) col-no) col-no))
+  (goto-char (point-max))
+  (table-recognize -1)
+  (newline))
+
+(defun fuel-markup--instance (e)
+  (insert " an instance of ")
+  (fuel-markup--print (cadr e)))
+
+(defun fuel-markup--maybe (e)
+  (fuel-markup--instance (cons '$instance (cdr e)))
+  (insert " or f "))
+
+(defun fuel-markup--values (e)
+  (fuel-markup--insert-heading "Inputs and outputs")
+  (dolist (val (cdr e))
+    (insert " " (car val) " - ")
+    (fuel-markup--print (cdr val))
+    (newline)))
+
+(defun fuel-markup--side-effects (e)
+  (fuel-markup--insert-heading "Side effects")
+  (insert "Modifies ")
+  (fuel-markup--print (cdr e))
+  (fuel-markup--insert-newline))
+
+(defun fuel-markup--definition (e)
+  (fuel-markup--insert-heading "Definition")
+  (fuel-markup--code (cons '$code (cdr e))))
+
+(defun fuel-markup--methods (e)
+  (fuel-markup--insert-heading "Methods")
+  (fuel-markup--code (cons '$code (cdr e))))
+
+(defun fuel-markup--value (e)
+  (fuel-markup--insert-heading "Variable value")
+  (insert "Current value in global namespace: ")
+  (fuel-markup--snippet (cons '$snippet (cdr e)))
+  (newline))
+
+(defun fuel-markup--values-x/y (e)
+  (fuel-markup--values '($values ("x" "number") ("y" "number"))))
+
+(defun fuel-markup--curious (e)
+  (fuel-markup--insert-heading "For the curious...")
+  (fuel-markup--print (cdr e)))
+
+(defun fuel-markup--references (e)
+  (fuel-markup--insert-heading "References")
+  (fuel-markup--links (cons '$links (cdr e))))
+
+(defun fuel-markup--see-also (e)
+  (fuel-markup--insert-heading "See also")
+  (fuel-markup--links (cons '$links (cdr e))))
+
+(defun fuel-markup--shuffle (e)
+  (insert "\nShuffle word. Re-arranges the stack "
+          "according to the stack effect pattern.")
+  (fuel-markup--insert-newline))
+
+(defun fuel-markup--low-level-note (e)
+  (fuel-markup--print '($notes "Calling this word directly is not necessary "
+                               "in most cases. "
+                               "Higher-level words call it automatically.")))
+
+(defun fuel-markup--parsing-note (e)
+  (fuel-markup--insert-nl-if-nb)
+  (insert "This word should only be called from parsing words.")
+  (fuel-markup--insert-newline))
+
+(defun fuel-markup--io-error (e)
+  (fuel-markup--errors '($errors "Throws an error if the I/O operation fails.")))
+
+(defun fuel-markup--prettyprinting-note (e)
+  (fuel-markup--print '($notes ("This word should only be called within the "
+                                ($link with-pprint) " combinator."))))
+
+(defun fuel-markup--elem-with-heading (elem heading)
+  (fuel-markup--insert-heading heading)
+  (fuel-markup--print (cdr elem))
+  (fuel-markup--insert-newline))
+
+(defun fuel-markup--warning (e)
+  (fuel-markup--elem-with-heading e "Warning"))
+
+(defun fuel-markup--description (e)
+  (fuel-markup--elem-with-heading e "Word description"))
+
+(defun fuel-markup--class-description (e)
+  (fuel-markup--elem-with-heading e "Class description"))
+
+(defun fuel-markup--error-description (e)
+  (fuel-markup--elem-with-heading e "Error description"))
+
+(defun fuel-markup--var-description (e)
+  (fuel-markup--elem-with-heading e "Variable description"))
+
+(defun fuel-markup--contract (e)
+  (fuel-markup--elem-with-heading e "Generic word contract"))
+
+(defun fuel-markup--related (e)
+  (fuel-markup--elem-with-heading e "See also"))
+
+(defun fuel-markup--errors (e)
+  (fuel-markup--elem-with-heading e "Errors"))
+
+(defun fuel-markup--notes (e)
+  (fuel-markup--elem-with-heading e "Notes"))
+
+(defun fuel-markup--see (e)
+  (insert (format " %S " e)))
+
+(defun fuel-markup--synopsis (e)
+  (insert (format " %S " e)))
+
+(defun fuel-markup--quotation (e)
+  (insert (format " %S " e)))
+
+\f
+(provide 'fuel-markup)
+;;; fuel-markup.el ends here
index be976a5392fef3f9db39cce70283f15e0a2db5ad..eb57c98ce2a3fb4ea622accb7dd2c4727dd92728 100644 (file)
@@ -1,6 +1,6 @@
 ;;; fuel-xref.el -- showing cross-reference info
 
-;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
 ;; See http://factorcode.org/license.txt for BSD license.
 
 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
@@ -138,7 +138,6 @@ cursor at the first ocurrence of the used word."
   (let ((map (make-sparse-keymap)))
     (suppress-keymap map)
     (set-keymap-parent map button-buffer-map)
-    (define-key map "q" 'bury-buffer)
     map))
 
 (defun fuel-xref-mode ()