Merge branch 'emacs' of http://git.hacks-galore.org/jao/factor
						commit
						67c37de79c
					
				| 
						 | 
				
			
			@ -4,9 +4,9 @@
 | 
			
		|||
USING: accessors arrays assocs classes.tuple combinators
 | 
			
		||||
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.crossref tools.vocabs
 | 
			
		||||
vectors vocabs vocabs.parser words ;
 | 
			
		||||
make math math.order memoize namespaces parser quotations prettyprint
 | 
			
		||||
sequences sets sorting source-files strings summary tools.crossref
 | 
			
		||||
tools.vocabs tools.vocabs.browser vectors vocabs vocabs.parser words ;
 | 
			
		||||
 | 
			
		||||
IN: fuel
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -74,6 +74,8 @@ M: sequence fuel-pprint
 | 
			
		|||
 | 
			
		||||
M: tuple fuel-pprint tuple>array fuel-pprint ; inline
 | 
			
		||||
 | 
			
		||||
M: quotation fuel-pprint pprint ; inline
 | 
			
		||||
 | 
			
		||||
M: continuation fuel-pprint drop ":continuation" write ; inline
 | 
			
		||||
 | 
			
		||||
M: restart fuel-pprint name>> fuel-pprint ; inline
 | 
			
		||||
| 
						 | 
				
			
			@ -163,18 +165,22 @@ SYMBOL: :uses
 | 
			
		|||
! Edit locations
 | 
			
		||||
 | 
			
		||||
: fuel-normalize-loc ( seq -- path line )
 | 
			
		||||
    dup length 1 > [ first2 [ (normalize-path) ] dip ] [ f ] if ; inline
 | 
			
		||||
    [ dup length 0 > [ first (normalize-path) ] [ drop f ] if ]
 | 
			
		||||
    [ dup length 1 > [ second ] [ drop 1 ] if ] bi ;
 | 
			
		||||
 | 
			
		||||
: fuel-get-edit-location ( defspec -- )
 | 
			
		||||
: fuel-get-edit-location ( word -- )
 | 
			
		||||
    where fuel-normalize-loc 2array fuel-eval-set-result ; inline
 | 
			
		||||
 | 
			
		||||
: fuel-get-vocab-location ( vocab -- )
 | 
			
		||||
    >vocab-link fuel-get-edit-location ; inline
 | 
			
		||||
 | 
			
		||||
: fuel-get-doc-location ( defspec -- )
 | 
			
		||||
: fuel-get-doc-location ( word -- )
 | 
			
		||||
    props>> "help-loc" swap at
 | 
			
		||||
    fuel-normalize-loc 2array fuel-eval-set-result ;
 | 
			
		||||
 | 
			
		||||
: fuel-get-article-location ( name -- )
 | 
			
		||||
    article loc>> fuel-normalize-loc 2array fuel-eval-set-result ;
 | 
			
		||||
 | 
			
		||||
! Cross-references
 | 
			
		||||
 | 
			
		||||
: fuel-word>xref ( word -- xref )
 | 
			
		||||
| 
						 | 
				
			
			@ -292,16 +298,49 @@ MEMO: fuel-find-word ( name -- word/f )
 | 
			
		|||
    fuel-find-word [ [ auto-use? on (fuel-word-see) ] with-scope ] [ f ] if*
 | 
			
		||||
    fuel-eval-set-result ; inline
 | 
			
		||||
 | 
			
		||||
: fuel-vocab-help-row ( vocab -- element )
 | 
			
		||||
    [ vocab-status-string ] [ vocab-name ] [ summary ] tri 3array ;
 | 
			
		||||
 | 
			
		||||
: fuel-vocab-help-root-heading ( root -- element )
 | 
			
		||||
    [ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;
 | 
			
		||||
 | 
			
		||||
SYMBOL: vocab-list
 | 
			
		||||
 | 
			
		||||
: fuel-vocab-help-table ( vocabs -- element )
 | 
			
		||||
    [ fuel-vocab-help-row ] map vocab-list prefix ;
 | 
			
		||||
 | 
			
		||||
: fuel-vocab-list ( assoc -- seq )
 | 
			
		||||
    [
 | 
			
		||||
        [ drop f ] [
 | 
			
		||||
            [ fuel-vocab-help-root-heading ]
 | 
			
		||||
            [ fuel-vocab-help-table ] bi*
 | 
			
		||||
            [ 2array ] [ drop f ] if*
 | 
			
		||||
        ] if-empty
 | 
			
		||||
    ] { } assoc>map [  ] filter ;
 | 
			
		||||
 | 
			
		||||
: fuel-vocab-children-help ( name -- element )
 | 
			
		||||
    all-child-vocabs fuel-vocab-list ; inline
 | 
			
		||||
 | 
			
		||||
: fuel-vocab-describe-words ( name -- element )
 | 
			
		||||
    [ describe-words ] with-string-writer \ describe-words swap 2array ; inline
 | 
			
		||||
 | 
			
		||||
: (fuel-vocab-help) ( name -- element )
 | 
			
		||||
    \ article swap dup >vocab-link
 | 
			
		||||
    [
 | 
			
		||||
        [ summary [ , ] [ "No summary available" , ] if* ]
 | 
			
		||||
        [ drop \ $nl , ]
 | 
			
		||||
        [ vocab-help article [ content>> % ] when* ] tri
 | 
			
		||||
        {
 | 
			
		||||
            [ vocab-authors [ \ $authors prefix , ] when* ]
 | 
			
		||||
            [ vocab-tags [ \ $tags prefix , ] when* ]
 | 
			
		||||
            [ summary [ { $heading "Summary" } swap 2array , ] when* ]
 | 
			
		||||
            [ drop \ $nl , ]
 | 
			
		||||
            [ vocab-help [ article content>> % ] when* ]
 | 
			
		||||
            [ name>> fuel-vocab-describe-words , ]
 | 
			
		||||
            [ name>> fuel-vocab-children-help % ]
 | 
			
		||||
        } cleave
 | 
			
		||||
    ] { } make 3array ;
 | 
			
		||||
 | 
			
		||||
: fuel-vocab-help ( name -- )
 | 
			
		||||
    (fuel-vocab-help) fuel-eval-set-result ; inline
 | 
			
		||||
    dup empty? [ fuel-vocab-children-help ] [ (fuel-vocab-help) ] if
 | 
			
		||||
    fuel-eval-set-result ; inline
 | 
			
		||||
 | 
			
		||||
: (fuel-index) ( seq -- seq )
 | 
			
		||||
    [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;
 | 
			
		||||
| 
						 | 
				
			
			@ -309,6 +348,21 @@ MEMO: fuel-find-word ( name -- word/f )
 | 
			
		|||
: fuel-index ( quot: ( -- seq ) -- )
 | 
			
		||||
    call (fuel-index) fuel-eval-set-result ; inline
 | 
			
		||||
 | 
			
		||||
MEMO: (fuel-get-vocabs/author) ( author -- element )
 | 
			
		||||
    [ "Vocabularies by " prepend \ $heading swap 2array ]
 | 
			
		||||
    [ authored fuel-vocab-list ] bi 2array ;
 | 
			
		||||
 | 
			
		||||
: fuel-get-vocabs/author ( author -- )
 | 
			
		||||
    (fuel-get-vocabs/author) fuel-eval-set-result ;
 | 
			
		||||
 | 
			
		||||
MEMO: (fuel-get-vocabs/tag ( tag -- element )
 | 
			
		||||
    [ "Vocabularies tagged " prepend \ $heading swap 2array ]
 | 
			
		||||
    [ tagged fuel-vocab-list ] bi 2array ;
 | 
			
		||||
 | 
			
		||||
: fuel-get-vocabs/tag ( tag -- )
 | 
			
		||||
    (fuel-get-vocabs/tag fuel-eval-set-result ;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
! -run=fuel support
 | 
			
		||||
 | 
			
		||||
: fuel-startup ( -- ) "listener" run-file ; inline
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -95,13 +95,17 @@ beast.
 | 
			
		|||
*** In the help browser:
 | 
			
		||||
 | 
			
		||||
    - h : help for word at point
 | 
			
		||||
    - v : help for a vocabulary
 | 
			
		||||
    - a : find words containing given substring (M-x fuel-apropos)
 | 
			
		||||
    - e : edit current article
 | 
			
		||||
    - ba : bookmark current page
 | 
			
		||||
    - bb : display bookmarks
 | 
			
		||||
    - bd : delete bookmark at point
 | 
			
		||||
    - n/p : next/previous page
 | 
			
		||||
    - l : previous page
 | 
			
		||||
    - SPC/S-SPC : scroll up/down
 | 
			
		||||
    - TAB/S-TAB : next/previous link
 | 
			
		||||
    - k : kill current page and go to previous or next
 | 
			
		||||
    - r : refresh page
 | 
			
		||||
    - c : clean browsing history
 | 
			
		||||
    - M-. : edit word at point in Emacs
 | 
			
		||||
| 
						 | 
				
			
			@ -112,4 +116,5 @@ beast.
 | 
			
		|||
 | 
			
		||||
    - TAB/BACKTAB : navigate links
 | 
			
		||||
    - RET/mouse click : follow link
 | 
			
		||||
    - h : show help for word at point
 | 
			
		||||
    - q : bury buffer
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,6 +1,6 @@
 | 
			
		|||
;;; fuel-connection.el -- asynchronous comms with the fuel listener
 | 
			
		||||
 | 
			
		||||
;; 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>
 | 
			
		||||
| 
						 | 
				
			
			@ -193,7 +193,7 @@
 | 
			
		|||
      (condition-case cerr
 | 
			
		||||
          (with-current-buffer (or buffer (current-buffer))
 | 
			
		||||
            (funcall cont (fuel-con--comint-buffer-form))
 | 
			
		||||
            (fuel-log--info "<%s>: processed\n\t%s" id req))
 | 
			
		||||
            (fuel-log--info "<%s>: processed" id))
 | 
			
		||||
        (error (fuel-log--error
 | 
			
		||||
                "<%s>: continuation failed %S \n\t%s" id rstr cerr))))))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -0,0 +1,104 @@
 | 
			
		|||
;;; fuel-edit.el -- utilities for file editing
 | 
			
		||||
 | 
			
		||||
;; 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: Mon Jan 05, 2009 21:16
 | 
			
		||||
 | 
			
		||||
;;; Comentary:
 | 
			
		||||
 | 
			
		||||
;; Locating and opening factor source and documentation files.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'fuel-completion)
 | 
			
		||||
(require 'fuel-eval)
 | 
			
		||||
(require 'fuel-base)
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; Auxiliar functions:
 | 
			
		||||
 | 
			
		||||
(defun fuel-edit--try-edit (ret)
 | 
			
		||||
  (let* ((err (fuel-eval--retort-error ret))
 | 
			
		||||
         (loc (fuel-eval--retort-result ret)))
 | 
			
		||||
    (when (or err (not loc) (not (listp loc)) (not (stringp (car loc))))
 | 
			
		||||
      (error "Couldn't find edit location"))
 | 
			
		||||
    (unless (file-readable-p (car loc))
 | 
			
		||||
      (error "Couldn't open '%s' for read" (car loc)))
 | 
			
		||||
    (find-file-other-window (car loc))
 | 
			
		||||
    (goto-line (if (numberp (cadr loc)) (cadr loc) 1))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-edit--read-vocabulary-name (refresh)
 | 
			
		||||
  (let* ((vocabs (fuel-completion--vocabs refresh))
 | 
			
		||||
         (prompt "Vocabulary name: "))
 | 
			
		||||
    (if vocabs
 | 
			
		||||
        (completing-read prompt vocabs nil nil nil fuel-edit--vocab-history)
 | 
			
		||||
      (read-string prompt nil fuel-edit--vocab-history))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-edit--edit-article (name)
 | 
			
		||||
  (let ((cmd `(:fuel* (,name fuel-get-article-location) "fuel" t)))
 | 
			
		||||
    (fuel-edit--try-edit (fuel-eval--send/wait cmd))))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; Editing commands:
 | 
			
		||||
 | 
			
		||||
(defvar fuel-edit--word-history nil)
 | 
			
		||||
(defvar fuel-edit--vocab-history nil)
 | 
			
		||||
 | 
			
		||||
(defun fuel-edit-vocabulary (&optional refresh vocab)
 | 
			
		||||
  "Visits vocabulary file in Emacs.
 | 
			
		||||
When called interactively, asks for vocabulary with completion.
 | 
			
		||||
With prefix argument, refreshes cached vocabulary list."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let* ((vocab (or vocab (fuel-edit--read-vocabulary-name refresh)))
 | 
			
		||||
         (cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t)))
 | 
			
		||||
    (fuel-edit--try-edit (fuel-eval--send/wait cmd))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-edit-word (&optional arg)
 | 
			
		||||
  "Asks for a word to edit, with completion.
 | 
			
		||||
With prefix, only words visible in the current vocabulary are
 | 
			
		||||
offered."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let* ((word (fuel-completion--read-word "Edit word: "
 | 
			
		||||
                                           nil
 | 
			
		||||
                                           fuel-edit--word-history
 | 
			
		||||
                                           arg))
 | 
			
		||||
         (cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
 | 
			
		||||
    (fuel-edit--try-edit (fuel-eval--send/wait cmd))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-edit-word-at-point (&optional arg)
 | 
			
		||||
  "Opens a new window visiting the definition of the word at point.
 | 
			
		||||
With prefix, asks for the word to edit."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point))
 | 
			
		||||
                   (fuel-completion--read-word "Edit word: ")))
 | 
			
		||||
         (cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
 | 
			
		||||
    (condition-case nil
 | 
			
		||||
        (fuel-edit--try-edit (fuel-eval--send/wait cmd))
 | 
			
		||||
      (error (fuel-edit-vocabulary nil word)))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-edit-word-doc-at-point (&optional arg word)
 | 
			
		||||
  "Opens a new window visiting the documentation file for the word at point.
 | 
			
		||||
With prefix, asks for the word to edit."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let* ((word (or word
 | 
			
		||||
                   (and (not arg) (fuel-syntax-symbol-at-point))
 | 
			
		||||
                   (fuel-completion--read-word "Edit word: ")))
 | 
			
		||||
         (cmd `(:fuel* ((:quote ,word) fuel-get-doc-location))))
 | 
			
		||||
    (condition-case nil
 | 
			
		||||
        (fuel-edit--try-edit (fuel-eval--send/wait cmd))
 | 
			
		||||
      (error
 | 
			
		||||
       (message "Documentation for '%s' not found" word)
 | 
			
		||||
       (when (and (eq major-mode 'factor-mode)
 | 
			
		||||
                  (y-or-n-p (concat "No documentation found. "
 | 
			
		||||
                                    "Do you want to open the vocab's "
 | 
			
		||||
                                    "doc file? ")))
 | 
			
		||||
         (find-file-other-window
 | 
			
		||||
          (format "%s-docs.factor"
 | 
			
		||||
                  (file-name-sans-extension (buffer-file-name)))))))))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
(provide 'fuel-edit)
 | 
			
		||||
;;; fuel-edit.el ends here
 | 
			
		||||
| 
						 | 
				
			
			@ -1,6 +1,6 @@
 | 
			
		|||
;;; fuel-eval.el --- evaluating Factor expressions
 | 
			
		||||
 | 
			
		||||
;; 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>
 | 
			
		||||
| 
						 | 
				
			
			@ -13,9 +13,10 @@
 | 
			
		|||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'fuel-base)
 | 
			
		||||
(require 'fuel-syntax)
 | 
			
		||||
(require 'fuel-connection)
 | 
			
		||||
(require 'fuel-log)
 | 
			
		||||
(require 'fuel-base)
 | 
			
		||||
 | 
			
		||||
(eval-when-compile (require 'cl))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -125,6 +126,7 @@
 | 
			
		|||
  (fuel-eval--retort-make (cons 'fuel-parse-retort-error str) nil))
 | 
			
		||||
 | 
			
		||||
(defun fuel-eval--parse-retort (ret)
 | 
			
		||||
  (fuel-log--info "RETORT: %S" ret)
 | 
			
		||||
  (if (fuel-eval--retort-p ret) ret
 | 
			
		||||
    (fuel-eval--make-parse-error-retort ret)))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -14,11 +14,12 @@
 | 
			
		|||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'fuel-edit)
 | 
			
		||||
(require 'fuel-eval)
 | 
			
		||||
(require 'fuel-markup)
 | 
			
		||||
(require 'fuel-autodoc)
 | 
			
		||||
(require 'fuel-xref)
 | 
			
		||||
(require 'fuel-completion)
 | 
			
		||||
(require 'fuel-syntax)
 | 
			
		||||
(require 'fuel-font-lock)
 | 
			
		||||
(require 'fuel-popup)
 | 
			
		||||
(require 'fuel-base)
 | 
			
		||||
| 
						 | 
				
			
			@ -67,15 +68,15 @@
 | 
			
		|||
        (setcar fuel-help--history link))))
 | 
			
		||||
  link)
 | 
			
		||||
 | 
			
		||||
(defun fuel-help--history-next ()
 | 
			
		||||
(defun fuel-help--history-next (&optional forget-current)
 | 
			
		||||
  (when (not (ring-empty-p (nth 2 fuel-help--history)))
 | 
			
		||||
    (when (car fuel-help--history)
 | 
			
		||||
    (when (and (car fuel-help--history) (not forget-current))
 | 
			
		||||
      (ring-insert (nth 1 fuel-help--history) (car fuel-help--history)))
 | 
			
		||||
    (setcar fuel-help--history (ring-remove (nth 2 fuel-help--history) 0))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-help--history-previous ()
 | 
			
		||||
(defun fuel-help--history-previous (&optional forget-current)
 | 
			
		||||
  (when (not (ring-empty-p (nth 1 fuel-help--history)))
 | 
			
		||||
    (when (car fuel-help--history)
 | 
			
		||||
    (when (and (car fuel-help--history) (not forget-current))
 | 
			
		||||
      (ring-insert (nth 2 fuel-help--history) (car fuel-help--history)))
 | 
			
		||||
    (setcar fuel-help--history (ring-remove (nth 1 fuel-help--history) 0))))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -114,10 +115,9 @@
 | 
			
		|||
  (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)))
 | 
			
		||||
    (if ask (fuel-completion--read-word prompt
 | 
			
		||||
         (ask (or (not def) fuel-help-always-ask)))
 | 
			
		||||
    (if ask
 | 
			
		||||
        (fuel-completion--read-word prompt
 | 
			
		||||
                                        def
 | 
			
		||||
                                        'fuel-help--prompt-history
 | 
			
		||||
                                        t)
 | 
			
		||||
| 
						 | 
				
			
			@ -129,7 +129,7 @@
 | 
			
		|||
      (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))
 | 
			
		||||
        (let* ((ret (fuel-eval--send/wait cmd))
 | 
			
		||||
               (res (fuel-eval--retort-result ret)))
 | 
			
		||||
          (if (not res)
 | 
			
		||||
              (message "No help for '%s'" def)
 | 
			
		||||
| 
						 | 
				
			
			@ -138,7 +138,7 @@
 | 
			
		|||
(defun fuel-help--get-article (name label)
 | 
			
		||||
  (message "Retrieving article ...")
 | 
			
		||||
  (let* ((cmd `(:fuel* ((,name fuel-get-article)) "fuel" t))
 | 
			
		||||
         (ret (fuel-eval--send/wait cmd 2000))
 | 
			
		||||
         (ret (fuel-eval--send/wait cmd))
 | 
			
		||||
         (res (fuel-eval--retort-result ret)))
 | 
			
		||||
    (if (not res)
 | 
			
		||||
        (message "Article '%s' not found" label)
 | 
			
		||||
| 
						 | 
				
			
			@ -146,15 +146,35 @@
 | 
			
		|||
      (message ""))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-help--get-vocab (name)
 | 
			
		||||
  (message "Retrieving vocabulary help ...")
 | 
			
		||||
  (message "Retrieving help vocabulary for vocabulary '%s' ..." name)
 | 
			
		||||
  (let* ((cmd `(:fuel* ((,name fuel-vocab-help)) "fuel" (,name)))
 | 
			
		||||
         (ret (fuel-eval--send/wait cmd 2000))
 | 
			
		||||
         (ret (fuel-eval--send/wait cmd))
 | 
			
		||||
         (res (fuel-eval--retort-result ret)))
 | 
			
		||||
    (if (not res)
 | 
			
		||||
        (message "No help available for vocabulary '%s'" name)
 | 
			
		||||
      (fuel-help--insert-contents (list name name 'vocab) res)
 | 
			
		||||
      (message ""))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-help--get-vocab/author (author)
 | 
			
		||||
  (message "Retrieving vocabularies by %s ..." author)
 | 
			
		||||
  (let* ((cmd `(:fuel* ((,author fuel-get-vocabs/author)) "fuel" t))
 | 
			
		||||
         (ret (fuel-eval--send/wait cmd))
 | 
			
		||||
         (res (fuel-eval--retort-result ret)))
 | 
			
		||||
    (if (not res)
 | 
			
		||||
        (message "No vocabularies by %s" author)
 | 
			
		||||
      (fuel-help--insert-contents (list author author 'author) res)
 | 
			
		||||
      (message ""))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-help--get-vocab/tag (tag)
 | 
			
		||||
  (message "Retrieving vocabularies tagged '%s' ..." tag)
 | 
			
		||||
  (let* ((cmd `(:fuel* ((,tag fuel-get-vocabs/tag)) "fuel" t))
 | 
			
		||||
         (ret (fuel-eval--send/wait cmd))
 | 
			
		||||
         (res (fuel-eval--retort-result ret)))
 | 
			
		||||
    (if (not res)
 | 
			
		||||
        (message "No vocabularies tagged '%s'" tag)
 | 
			
		||||
      (fuel-help--insert-contents (list tag tag 'tag) res)
 | 
			
		||||
      (message ""))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-help--follow-link (link label type &optional no-cache)
 | 
			
		||||
  (let* ((llink (list link label type))
 | 
			
		||||
         (cached (and (not no-cache) (fuel-help--cache-get llink))))
 | 
			
		||||
| 
						 | 
				
			
			@ -163,6 +183,8 @@
 | 
			
		|||
          (cond ((eq type 'word) (fuel-help--word-help nil link))
 | 
			
		||||
                ((eq type 'article) (fuel-help--get-article link label))
 | 
			
		||||
                ((eq type 'vocab) (fuel-help--get-vocab link))
 | 
			
		||||
                ((eq type 'author) (fuel-help--get-vocab/author label))
 | 
			
		||||
                ((eq type 'tag) (fuel-help--get-vocab/tag label))
 | 
			
		||||
                ((eq type 'bookmarks) (fuel-help-display-bookmarks))
 | 
			
		||||
                (t (error "Links of type %s not yet implemented" type))))
 | 
			
		||||
      (fuel-help--insert-contents llink cached))))
 | 
			
		||||
| 
						 | 
				
			
			@ -177,6 +199,7 @@
 | 
			
		|||
        (insert content)
 | 
			
		||||
      (fuel-markup--print content)
 | 
			
		||||
      (fuel-markup--insert-newline)
 | 
			
		||||
      (delete-blank-lines)
 | 
			
		||||
      (fuel-help--cache-insert key (buffer-string)))
 | 
			
		||||
    (fuel-help--history-push key)
 | 
			
		||||
    (setq fuel-help--buffer-link key)
 | 
			
		||||
| 
						 | 
				
			
			@ -231,20 +254,34 @@ buffer."
 | 
			
		|||
  (interactive)
 | 
			
		||||
  (fuel-help--word-help))
 | 
			
		||||
 | 
			
		||||
(defun fuel-help-next ()
 | 
			
		||||
  "Go to next page in help browser."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (let ((item (fuel-help--history-next)))
 | 
			
		||||
(defun fuel-help-vocab (vocab)
 | 
			
		||||
  "Ask for a vocabulary name and show its help page."
 | 
			
		||||
  (interactive (list (fuel-edit--read-vocabulary-name nil)))
 | 
			
		||||
  (fuel-help--get-vocab vocab))
 | 
			
		||||
 | 
			
		||||
(defun fuel-help-next (&optional forget-current)
 | 
			
		||||
  "Go to next page in help browser.
 | 
			
		||||
With prefix, the current page is deleted from history."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let ((item (fuel-help--history-next forget-current)))
 | 
			
		||||
    (unless item (error "No next page"))
 | 
			
		||||
    (apply 'fuel-help--follow-link item)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-help-previous ()
 | 
			
		||||
  "Go to previous page in help browser."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (let ((item (fuel-help--history-previous)))
 | 
			
		||||
(defun fuel-help-previous (&optional forget-current)
 | 
			
		||||
  "Go to previous page in help browser.
 | 
			
		||||
With prefix, the current page is deleted from history."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let ((item (fuel-help--history-previous forget-current)))
 | 
			
		||||
    (unless item (error "No previous page"))
 | 
			
		||||
    (apply 'fuel-help--follow-link item)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-help-kill-page ()
 | 
			
		||||
  "Kill current page if a previous or next one exists."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (condition-case nil
 | 
			
		||||
      (fuel-help-previous t)
 | 
			
		||||
    (error (fuel-help-next t))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-help-refresh ()
 | 
			
		||||
  "Refresh the contents of current page."
 | 
			
		||||
  (interactive)
 | 
			
		||||
| 
						 | 
				
			
			@ -260,6 +297,15 @@ buffer."
 | 
			
		|||
    (fuel-help-refresh))
 | 
			
		||||
  (message ""))
 | 
			
		||||
 | 
			
		||||
(defun fuel-help-edit ()
 | 
			
		||||
  "Edit the current article or word help."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (let ((link (car fuel-help--buffer-link))
 | 
			
		||||
        (type (nth 2 fuel-help--buffer-link)))
 | 
			
		||||
    (cond ((eq type 'word) (fuel-edit-word-doc-at-point nil link))
 | 
			
		||||
          ((member type '(article vocab)) (fuel-edit--edit-article link))
 | 
			
		||||
          (t (error "No document associated with this page")))))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;;; Help mode map:
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -272,10 +318,14 @@ buffer."
 | 
			
		|||
    (define-key map "bb" 'fuel-help-display-bookmarks)
 | 
			
		||||
    (define-key map "bd" 'fuel-help-delete-bookmark)
 | 
			
		||||
    (define-key map "c" 'fuel-help-clean-history)
 | 
			
		||||
    (define-key map "e" 'fuel-help-edit)
 | 
			
		||||
    (define-key map "h" 'fuel-help)
 | 
			
		||||
    (define-key map "k" 'fuel-help-kill-page)
 | 
			
		||||
    (define-key map "n" 'fuel-help-next)
 | 
			
		||||
    (define-key map "l" 'fuel-help-previous)
 | 
			
		||||
    (define-key map "p" 'fuel-help-previous)
 | 
			
		||||
    (define-key map "r" 'fuel-help-refresh)
 | 
			
		||||
    (define-key map "v" 'fuel-help-vocab)
 | 
			
		||||
    (define-key map (kbd "SPC")  'scroll-up)
 | 
			
		||||
    (define-key map (kbd "S-SPC") 'scroll-down)
 | 
			
		||||
    (define-key map "\M-." 'fuel-edit-word-at-point)
 | 
			
		||||
| 
						 | 
				
			
			@ -283,6 +333,16 @@ buffer."
 | 
			
		|||
    (define-key map "\C-c\C-z" 'run-factor)
 | 
			
		||||
    map))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; IN: support
 | 
			
		||||
 | 
			
		||||
(defun fuel-help--find-in ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (or (fuel-syntax--find-in)
 | 
			
		||||
        (and (goto-char (point-min))
 | 
			
		||||
             (re-search-forward "Vocabulary: \\(.+\\)$" nil t)
 | 
			
		||||
             (match-string-no-properties 1)))))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; Help mode definition:
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -296,6 +356,7 @@ buffer."
 | 
			
		|||
  (set-syntax-table fuel-syntax--syntax-table)
 | 
			
		||||
  (setq mode-name "FUEL Help")
 | 
			
		||||
  (setq major-mode 'fuel-help-mode)
 | 
			
		||||
  (setq fuel-syntax--current-vocab-function 'fuel-help--find-in)
 | 
			
		||||
  (setq fuel-markup--follow-link-function 'fuel-help--follow-link)
 | 
			
		||||
  (setq buffer-read-only t))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -16,9 +16,9 @@
 | 
			
		|||
(require 'fuel-eval)
 | 
			
		||||
(require 'fuel-font-lock)
 | 
			
		||||
(require 'fuel-base)
 | 
			
		||||
(require 'fuel-table)
 | 
			
		||||
 | 
			
		||||
(require 'button)
 | 
			
		||||
(require 'table)
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; Customization:
 | 
			
		||||
| 
						 | 
				
			
			@ -84,12 +84,18 @@
 | 
			
		|||
;;; Markup printers:
 | 
			
		||||
 | 
			
		||||
(defconst fuel-markup--printers
 | 
			
		||||
  '(($class-description . fuel-markup--class-description)
 | 
			
		||||
  '(($all-tags . fuel-markup--all-tags)
 | 
			
		||||
    ($all-authors . fuel-markup--all-authors)
 | 
			
		||||
    ($author . fuel-markup--author)
 | 
			
		||||
    ($authors . fuel-markup--authors)
 | 
			
		||||
    ($class-description . fuel-markup--class-description)
 | 
			
		||||
    ($code . fuel-markup--code)
 | 
			
		||||
    ($command . fuel-markup--command)
 | 
			
		||||
    ($command-map . fuel-markup--null)
 | 
			
		||||
    ($contract . fuel-markup--contract)
 | 
			
		||||
    ($curious . fuel-markup--curious)
 | 
			
		||||
    ($definition . fuel-markup--definition)
 | 
			
		||||
    ($describe-vocab . fuel-markup--describe-vocab)
 | 
			
		||||
    ($description . fuel-markup--description)
 | 
			
		||||
    ($doc-path . fuel-markup--doc-path)
 | 
			
		||||
    ($emphasis . fuel-markup--emphasis)
 | 
			
		||||
| 
						 | 
				
			
			@ -110,6 +116,7 @@
 | 
			
		|||
    ($methods . fuel-markup--methods)
 | 
			
		||||
    ($nl . fuel-markup--newline)
 | 
			
		||||
    ($notes . fuel-markup--notes)
 | 
			
		||||
    ($operation . fuel-markup--link)
 | 
			
		||||
    ($parsing-note . fuel-markup--parsing-note)
 | 
			
		||||
    ($predicate . fuel-markup--predicate)
 | 
			
		||||
    ($prettyprinting-note . fuel-markup--prettyprinting-note)
 | 
			
		||||
| 
						 | 
				
			
			@ -128,6 +135,8 @@
 | 
			
		|||
    ($synopsis . fuel-markup--synopsis)
 | 
			
		||||
    ($syntax . fuel-markup--syntax)
 | 
			
		||||
    ($table . fuel-markup--table)
 | 
			
		||||
    ($tag . fuel-markup--tag)
 | 
			
		||||
    ($tags . fuel-markup--tags)
 | 
			
		||||
    ($unchecked-example . fuel-markup--example)
 | 
			
		||||
    ($value . fuel-markup--value)
 | 
			
		||||
    ($values . fuel-markup--values)
 | 
			
		||||
| 
						 | 
				
			
			@ -138,7 +147,9 @@
 | 
			
		|||
    ($vocab-subsection . fuel-markup--vocab-subsection)
 | 
			
		||||
    ($vocabulary . fuel-markup--vocabulary)
 | 
			
		||||
    ($warning . fuel-markup--warning)
 | 
			
		||||
    (article . fuel-markup--article)))
 | 
			
		||||
    (article . fuel-markup--article)
 | 
			
		||||
    (describe-words . fuel-markup--describe-words)
 | 
			
		||||
    (vocab-list . fuel-markup--vocab-list)))
 | 
			
		||||
 | 
			
		||||
(make-variable-buffer-local
 | 
			
		||||
 (defvar fuel-markup--maybe-nl nil))
 | 
			
		||||
| 
						 | 
				
			
			@ -164,10 +175,11 @@
 | 
			
		|||
(defun fuel-markup--maybe-nl ()
 | 
			
		||||
  (setq fuel-markup--maybe-nl (point)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--insert-newline (&optional justification)
 | 
			
		||||
(defun fuel-markup--insert-newline (&optional justification nosqueeze)
 | 
			
		||||
  (fill-region (save-excursion (beginning-of-line) (point))
 | 
			
		||||
               (point)
 | 
			
		||||
               (or justification 'left))
 | 
			
		||||
               (or justification 'left)
 | 
			
		||||
               nosqueeze)
 | 
			
		||||
  (newline))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-markup--insert-nl-if-nb (&optional no-fill)
 | 
			
		||||
| 
						 | 
				
			
			@ -180,6 +192,7 @@
 | 
			
		|||
 | 
			
		||||
(defun fuel-markup--insert-heading (txt &optional no-nl)
 | 
			
		||||
  (fuel-markup--insert-nl-if-nb)
 | 
			
		||||
  (delete-blank-lines)
 | 
			
		||||
  (unless (bobp) (newline))
 | 
			
		||||
  (fuel-markup--put-face txt 'fuel-font-lock-markup-heading)
 | 
			
		||||
  (fuel-markup--insert-string txt)
 | 
			
		||||
| 
						 | 
				
			
			@ -239,7 +252,7 @@
 | 
			
		|||
    (insert (cadr e))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--snippet (e)
 | 
			
		||||
  (let ((snip (format "%s" (cdr e))))
 | 
			
		||||
  (let ((snip (format "%s" (cadr e))))
 | 
			
		||||
    (insert (fuel-font-lock--factor-str snip))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--code (e)
 | 
			
		||||
| 
						 | 
				
			
			@ -260,17 +273,15 @@
 | 
			
		|||
  (fuel-markup--print (cons '$code (cdr e)))
 | 
			
		||||
  (newline))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--examples (e)
 | 
			
		||||
  (fuel-markup--insert-heading "Examples")
 | 
			
		||||
  (dolist (ex (cdr e))
 | 
			
		||||
    (fuel-markup--print ex)
 | 
			
		||||
(defun fuel-markup--example (e)
 | 
			
		||||
  (fuel-markup--insert-newline)
 | 
			
		||||
  (dolist (s (cdr e))
 | 
			
		||||
    (fuel-markup--snippet (list '$snippet s))
 | 
			
		||||
    (newline)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--example (e)
 | 
			
		||||
  (fuel-markup--snippet (list '$snippet (cadr e))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--markup-example (e)
 | 
			
		||||
  (fuel-markup--snippet (cons '$snippet (cadr e))))
 | 
			
		||||
  (fuel-markup--insert-newline)
 | 
			
		||||
  (fuel-markup--snippet (cons '$snippet (cdr e))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--link (e)
 | 
			
		||||
  (let* ((link (nth 1 e))
 | 
			
		||||
| 
						 | 
				
			
			@ -301,7 +312,10 @@
 | 
			
		|||
                        "classes.intersection" "classes.predicate")))
 | 
			
		||||
         (subs (fuel-eval--retort-result (fuel-eval--send/wait cmd 200))))
 | 
			
		||||
    (when subs
 | 
			
		||||
      (fuel-markup--print subs))))
 | 
			
		||||
      (let ((start (point))
 | 
			
		||||
            (sort-fold-case nil))
 | 
			
		||||
        (fuel-markup--print subs)
 | 
			
		||||
        (sort-lines nil start (point))))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--vocab-link (e)
 | 
			
		||||
  (fuel-markup--insert-button (cadr e) (cadr e) 'vocab))
 | 
			
		||||
| 
						 | 
				
			
			@ -312,11 +326,119 @@
 | 
			
		|||
    (fuel-markup--vocab-link (list '$vocab-link link))
 | 
			
		||||
    (insert " ")))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--vocab-list (e)
 | 
			
		||||
  (let ((rows (mapcar '(lambda (elem)
 | 
			
		||||
                         (list (car elem)
 | 
			
		||||
                               (list '$vocab-link (cadr elem))
 | 
			
		||||
                               (caddr elem)))
 | 
			
		||||
                      (cdr e))))
 | 
			
		||||
    (fuel-markup--table (cons '$table rows))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--describe-vocab (e)
 | 
			
		||||
  (fuel-markup--insert-nl-if-nb)
 | 
			
		||||
  (let* ((cmd `(:fuel* ((,(cadr e) fuel-vocab-help)) "fuel" t))
 | 
			
		||||
         (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 | 
			
		||||
    (when res (fuel-markup--print res))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--vocabulary (e)
 | 
			
		||||
  (fuel-markup--insert-heading "Vocabulary: " t)
 | 
			
		||||
  (fuel-markup--vocab-link (cons '$vocab-link (cdr e)))
 | 
			
		||||
  (newline))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--parse-classes ()
 | 
			
		||||
  (let ((elems))
 | 
			
		||||
    (while (looking-at ".+ classes$")
 | 
			
		||||
      (let ((heading `($heading ,(match-string-no-properties 0)))
 | 
			
		||||
            (rows))
 | 
			
		||||
        (forward-line)
 | 
			
		||||
        (when (looking-at "Class *.+$")
 | 
			
		||||
          (push (split-string (match-string-no-properties 0) nil t) rows)
 | 
			
		||||
          (forward-line))
 | 
			
		||||
        (while (not (looking-at "$"))
 | 
			
		||||
          (let* ((objs (split-string (thing-at-point 'line) nil t))
 | 
			
		||||
                 (class (list '$link (car objs) (car objs) 'word))
 | 
			
		||||
                 (super (and (cadr objs)
 | 
			
		||||
                             (list (list '$link (cadr objs) (cadr objs) 'word))))
 | 
			
		||||
                 (slots (when (cddr objs)
 | 
			
		||||
                          (list (mapcar '(lambda (s) (list s " ")) (cddr objs))))))
 | 
			
		||||
            (push `(,class ,@super ,@slots) rows))
 | 
			
		||||
          (forward-line))
 | 
			
		||||
        (push `(,heading ($table ,@(reverse rows))) elems))
 | 
			
		||||
      (forward-line))
 | 
			
		||||
    (reverse elems)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--parse-words ()
 | 
			
		||||
  (let ((elems))
 | 
			
		||||
    (while (looking-at ".+ words\\|Primitives$")
 | 
			
		||||
      (let ((heading `($heading ,(match-string-no-properties 0)))
 | 
			
		||||
            (rows))
 | 
			
		||||
        (forward-line)
 | 
			
		||||
        (when (looking-at "Word *Stack effect$")
 | 
			
		||||
          (push '("Word" "Stack effect") rows)
 | 
			
		||||
          (forward-line))
 | 
			
		||||
        (while (looking-at "\\(.+?\\)\\( +\\(( .*\\)\\)?$")
 | 
			
		||||
          (let ((word `($link ,(match-string-no-properties 1)
 | 
			
		||||
                              ,(match-string-no-properties 1)
 | 
			
		||||
                              word))
 | 
			
		||||
                (se (and (match-string-no-properties 3)
 | 
			
		||||
                         `(($snippet ,(match-string-no-properties 3))))))
 | 
			
		||||
            (push `(,word ,@se) rows))
 | 
			
		||||
          (forward-line))
 | 
			
		||||
        (push `(,heading ($table ,@(reverse rows))) elems))
 | 
			
		||||
      (forward-line))
 | 
			
		||||
    (reverse elems)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--parse-words-desc (desc)
 | 
			
		||||
  (with-temp-buffer
 | 
			
		||||
    (insert desc)
 | 
			
		||||
    (goto-char (point-min))
 | 
			
		||||
    (when (re-search-forward "^Words$" nil t)
 | 
			
		||||
      (forward-line 2)
 | 
			
		||||
      (let ((elems '(($heading "Words"))))
 | 
			
		||||
        (push (fuel-markup--parse-classes) elems)
 | 
			
		||||
        (push (fuel-markup--parse-words) elems)
 | 
			
		||||
        (reverse elems)))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--describe-words (e)
 | 
			
		||||
  (when (cadr e)
 | 
			
		||||
    (fuel-markup--print (fuel-markup--parse-words-desc (cadr e)))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--tag (e)
 | 
			
		||||
  (fuel-markup--link (list '$link (cadr e) (cadr e) 'tag)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--tags (e)
 | 
			
		||||
  (when (cdr e)
 | 
			
		||||
    (fuel-markup--insert-heading "Tags: " t)
 | 
			
		||||
    (dolist (tag (cdr e))
 | 
			
		||||
      (fuel-markup--tag (list '$tag tag))
 | 
			
		||||
      (insert ", "))
 | 
			
		||||
    (delete-backward-char 2)
 | 
			
		||||
    (fuel-markup--insert-newline)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--all-tags (e)
 | 
			
		||||
  (let* ((cmd `(:fuel* (all-tags :get) "fuel" t))
 | 
			
		||||
         (tags (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 | 
			
		||||
    (fuel-markup--list
 | 
			
		||||
     (cons '$list (mapcar (lambda (tag) (list '$link tag tag 'tag)) tags)))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--author (e)
 | 
			
		||||
  (fuel-markup--link (list '$link (cadr e) (cadr e) 'author)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--authors (e)
 | 
			
		||||
  (when (cdr e)
 | 
			
		||||
    (fuel-markup--insert-heading "Authors: " t)
 | 
			
		||||
    (dolist (a (cdr e))
 | 
			
		||||
      (fuel-markup--author (list '$author a))
 | 
			
		||||
      (insert ", "))
 | 
			
		||||
    (delete-backward-char 2)
 | 
			
		||||
    (fuel-markup--insert-newline)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--all-authors (e)
 | 
			
		||||
  (let* ((cmd `(:fuel* (all-authors :get) "fuel" t))
 | 
			
		||||
         (authors (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 | 
			
		||||
    (fuel-markup--list
 | 
			
		||||
     (cons '$list (mapcar (lambda (a) (list '$link a a 'author)) authors)))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--list (e)
 | 
			
		||||
  (fuel-markup--insert-nl-if-nb)
 | 
			
		||||
  (dolist (elt (cdr e))
 | 
			
		||||
| 
						 | 
				
			
			@ -326,19 +448,10 @@
 | 
			
		|||
 | 
			
		||||
(defun fuel-markup--table (e)
 | 
			
		||||
  (fuel-markup--insert-newline)
 | 
			
		||||
  (delete-blank-lines)
 | 
			
		||||
  (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)
 | 
			
		||||
  (fuel-table--insert
 | 
			
		||||
   (mapcar '(lambda (row) (mapcar 'fuel-markup--print-str row)) (cdr e)))
 | 
			
		||||
  (newline))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--instance (e)
 | 
			
		||||
| 
						 | 
				
			
			@ -459,6 +572,9 @@
 | 
			
		|||
(defun fuel-markup--errors (e)
 | 
			
		||||
  (fuel-markup--elem-with-heading e "Errors"))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--examples (e)
 | 
			
		||||
  (fuel-markup--elem-with-heading e "Examples"))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--notes (e)
 | 
			
		||||
  (fuel-markup--elem-with-heading e "Notes"))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -471,6 +587,8 @@
 | 
			
		|||
        (fuel-markup--code (list '$code res))
 | 
			
		||||
      (fuel-markup--snippet (list '$snippet word)))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--null (e))
 | 
			
		||||
 | 
			
		||||
(defun fuel-markup--synopsis (e)
 | 
			
		||||
  (insert (format " %S " e)))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -24,6 +24,7 @@
 | 
			
		|||
(require 'fuel-stack)
 | 
			
		||||
(require 'fuel-autodoc)
 | 
			
		||||
(require 'fuel-font-lock)
 | 
			
		||||
(require 'fuel-edit)
 | 
			
		||||
(require 'fuel-syntax)
 | 
			
		||||
(require 'fuel-base)
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -80,7 +81,6 @@ With prefix argument, ask for the file to run."
 | 
			
		|||
      (message "Compiling %s ... OK!" file)
 | 
			
		||||
    (message "")))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
(defun fuel-eval-region (begin end &optional arg)
 | 
			
		||||
  "Sends region to Fuel's listener for evaluation.
 | 
			
		||||
Unless called with a prefix, switches to the compilation results
 | 
			
		||||
| 
						 | 
				
			
			@ -131,75 +131,8 @@ With prefix argument, ask for the file name."
 | 
			
		|||
  (let ((file (car (fuel-mode--read-file arg))))
 | 
			
		||||
    (when file (fuel-debug--uses-for-file file))))
 | 
			
		||||
 | 
			
		||||
(defun fuel--try-edit (ret)
 | 
			
		||||
  (let* ((err (fuel-eval--retort-error ret))
 | 
			
		||||
         (loc (fuel-eval--retort-result ret)))
 | 
			
		||||
    (when (or err (not loc) (not (listp loc)) (not (stringp (car loc))))
 | 
			
		||||
      (error "Couldn't find edit location for '%s'" word))
 | 
			
		||||
    (unless (file-readable-p (car loc))
 | 
			
		||||
      (error "Couldn't open '%s' for read" (car loc)))
 | 
			
		||||
    (find-file-other-window (car loc))
 | 
			
		||||
    (goto-line (if (numberp (cadr loc)) (cadr loc) 1))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-edit-word-at-point (&optional arg)
 | 
			
		||||
  "Opens a new window visiting the definition of the word at point.
 | 
			
		||||
With prefix, asks for the word to edit."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point))
 | 
			
		||||
                   (fuel-completion--read-word "Edit word: ")))
 | 
			
		||||
         (cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
 | 
			
		||||
    (condition-case nil
 | 
			
		||||
        (fuel--try-edit (fuel-eval--send/wait cmd))
 | 
			
		||||
      (error (fuel-edit-vocabulary nil word)))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-edit-word-doc-at-point (&optional arg)
 | 
			
		||||
  "Opens a new window visiting the documentation file for the word at point.
 | 
			
		||||
With prefix, asks for the word to edit."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point))
 | 
			
		||||
                   (fuel-completion--read-word "Edit word: ")))
 | 
			
		||||
         (cmd `(:fuel* ((:quote ,word) fuel-get-doc-location))))
 | 
			
		||||
    (condition-case nil
 | 
			
		||||
        (fuel--try-edit (fuel-eval--send/wait cmd))
 | 
			
		||||
      (error (when (y-or-n-p (concat "No documentation found. "
 | 
			
		||||
                                     "Do you want to open the vocab's "
 | 
			
		||||
                                     "doc file? "))
 | 
			
		||||
               (find-file-other-window
 | 
			
		||||
                (format "%s-docs.factor"
 | 
			
		||||
                        (file-name-sans-extension (buffer-file-name)))))))))
 | 
			
		||||
 | 
			
		||||
(defvar fuel-mode--word-history nil)
 | 
			
		||||
 | 
			
		||||
(defun fuel-edit-word (&optional arg)
 | 
			
		||||
  "Asks for a word to edit, with completion.
 | 
			
		||||
With prefix, only words visible in the current vocabulary are
 | 
			
		||||
offered."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let* ((word (fuel-completion--read-word "Edit word: "
 | 
			
		||||
                                           nil
 | 
			
		||||
                                           fuel-mode--word-history
 | 
			
		||||
                                           arg))
 | 
			
		||||
         (cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
 | 
			
		||||
    (fuel--try-edit (fuel-eval--send/wait cmd))))
 | 
			
		||||
 | 
			
		||||
(defvar fuel--vocabs-prompt-history nil)
 | 
			
		||||
 | 
			
		||||
(defun fuel--read-vocabulary-name (refresh)
 | 
			
		||||
  (let* ((vocabs (fuel-completion--vocabs refresh))
 | 
			
		||||
         (prompt "Vocabulary name: "))
 | 
			
		||||
    (if vocabs
 | 
			
		||||
        (completing-read prompt vocabs nil t nil fuel--vocabs-prompt-history)
 | 
			
		||||
      (read-string prompt nil fuel--vocabs-prompt-history))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-edit-vocabulary (&optional refresh vocab)
 | 
			
		||||
  "Visits vocabulary file in Emacs.
 | 
			
		||||
When called interactively, asks for vocabulary with completion.
 | 
			
		||||
With prefix argument, refreshes cached vocabulary list."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let* ((vocab (or vocab (fuel--read-vocabulary-name refresh)))
 | 
			
		||||
         (cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t)))
 | 
			
		||||
    (fuel--try-edit (fuel-eval--send/wait cmd))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-show-callers (&optional arg)
 | 
			
		||||
  "Show a list of callers of word at point.
 | 
			
		||||
With prefix argument, ask for word."
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,6 +1,6 @@
 | 
			
		|||
;;; fuel-syntax.el --- auxiliar definitions for factor code navigation.
 | 
			
		||||
 | 
			
		||||
;; 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>
 | 
			
		||||
| 
						 | 
				
			
			@ -48,7 +48,7 @@
 | 
			
		|||
    "DEFER:" "ERROR:" "EXCLUDE:" "FORGET:"
 | 
			
		||||
    "GENERIC#" "GENERIC:" "HEX:" "HOOK:"
 | 
			
		||||
    "IN:" "INSTANCE:" "INTERSECTION:"
 | 
			
		||||
    "M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "MEMO:" "METHOD:" "MIXIN:"
 | 
			
		||||
    "M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "MEMO:" "MEMO:" "METHOD:" "MIXIN:"
 | 
			
		||||
    "OCT:" "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"
 | 
			
		||||
    "REQUIRE:"  "REQUIRES:" "SINGLETON:" "SLOT:" "SYMBOL:" "SYMBOLS:"
 | 
			
		||||
    "TUPLE:" "t" "t?" "TYPEDEF:"
 | 
			
		||||
| 
						 | 
				
			
			@ -103,7 +103,8 @@
 | 
			
		|||
(defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--definition-starters-regex
 | 
			
		||||
  (regexp-opt '("VARS" "TUPLE" "MACRO" "MACRO:" "M" "MEMO" "METHOD" ":" "")))
 | 
			
		||||
  (regexp-opt
 | 
			
		||||
   '("VARS" "TUPLE" "MACRO" "MACRO:" "M" "MEMO" "MEMO:" "METHOD" ":" "")))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--definition-start-regex
 | 
			
		||||
  (format "^\\(%s:\\) " fuel-syntax--definition-starters-regex))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -0,0 +1,93 @@
 | 
			
		|||
;;; fuel-table.el -- table creation
 | 
			
		||||
 | 
			
		||||
;; 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: Tue Jan 06, 2009 13:44
 | 
			
		||||
 | 
			
		||||
;;; Comentary:
 | 
			
		||||
 | 
			
		||||
;; Utilities to insert ascii tables.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(defun fuel-table--col-widths (rows)
 | 
			
		||||
  (let* ((col-no (length (car rows)))
 | 
			
		||||
         (available (- (window-width) 2 (* 2 col-no)))
 | 
			
		||||
         (widths)
 | 
			
		||||
         (c 0))
 | 
			
		||||
    (while (< c col-no)
 | 
			
		||||
      (let ((width 0)
 | 
			
		||||
            (av-width (- available (* 5 (- col-no c)))))
 | 
			
		||||
        (dolist (row rows)
 | 
			
		||||
          (setq width
 | 
			
		||||
                (min av-width
 | 
			
		||||
                     (max width (length (nth c row))))))
 | 
			
		||||
        (push width widths)
 | 
			
		||||
        (setq available (- available width)))
 | 
			
		||||
      (setq c (1+ c)))
 | 
			
		||||
    (reverse widths)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-table--pad-str (str width)
 | 
			
		||||
  (let ((len (length str)))
 | 
			
		||||
    (cond ((= len width) str)
 | 
			
		||||
          ((> len width) (concat (substring str 0 (- width 3)) "..."))
 | 
			
		||||
          (t (concat str (make-string (- width (length str)) ?\ ))))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-table--str-lines (str width)
 | 
			
		||||
  (if (<= (length str) width)
 | 
			
		||||
      (list (fuel-table--pad-str str width))
 | 
			
		||||
    (with-temp-buffer
 | 
			
		||||
      (let ((fill-column width))
 | 
			
		||||
        (insert str)
 | 
			
		||||
        (fill-region (point-min) (point-max))
 | 
			
		||||
        (mapcar '(lambda (s) (fuel-table--pad-str s width))
 | 
			
		||||
                (split-string (buffer-string) "\n"))))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-table--pad-row (row)
 | 
			
		||||
  (let* ((max-ln (apply 'max (mapcar 'length row)))
 | 
			
		||||
         (result))
 | 
			
		||||
    (dolist (lines row)
 | 
			
		||||
      (let ((ln (length lines)))
 | 
			
		||||
        (if (= ln max-ln) (push lines result)
 | 
			
		||||
          (let ((lines (reverse lines))
 | 
			
		||||
                (l 0)
 | 
			
		||||
                (blank (make-string (length (car lines)) ?\ )))
 | 
			
		||||
            (while (< l ln)
 | 
			
		||||
              (push blank lines)
 | 
			
		||||
              (setq l (1+ l)))
 | 
			
		||||
            (push (reverse lines) result)))))
 | 
			
		||||
    (reverse result)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-table--format-rows (rows widths)
 | 
			
		||||
  (let ((col-no (length (car rows)))
 | 
			
		||||
        (frows))
 | 
			
		||||
    (dolist (row rows)
 | 
			
		||||
      (let ((c 0) (frow))
 | 
			
		||||
        (while (< c col-no)
 | 
			
		||||
          (push (fuel-table--str-lines (nth c row) (nth c widths)) frow)
 | 
			
		||||
          (setq c (1+ c)))
 | 
			
		||||
        (push (fuel-table--pad-row (reverse frow)) frows)))
 | 
			
		||||
    (reverse frows)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-table--insert (rows)
 | 
			
		||||
  (let* ((widths (fuel-table--col-widths rows))
 | 
			
		||||
         (rows (fuel-table--format-rows rows widths))
 | 
			
		||||
         (ls (concat "+" (mapconcat (lambda (n) (make-string n ?-)) widths "-+") "-+")))
 | 
			
		||||
    (insert ls "\n")
 | 
			
		||||
    (dolist (r rows)
 | 
			
		||||
      (let ((ln (length (car r)))
 | 
			
		||||
            (l 0))
 | 
			
		||||
        (while (< l ln)
 | 
			
		||||
          (insert (concat "|" (mapconcat 'identity
 | 
			
		||||
                                         (mapcar `(lambda (x) (nth ,l x)) r)
 | 
			
		||||
                                         " |")
 | 
			
		||||
                          " |\n"))
 | 
			
		||||
          (setq l (1+ l))))
 | 
			
		||||
      (insert ls "\n"))))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
(provide 'fuel-table)
 | 
			
		||||
;;; fuel-table.el ends here
 | 
			
		||||
| 
						 | 
				
			
			@ -13,6 +13,7 @@
 | 
			
		|||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'fuel-help)
 | 
			
		||||
(require 'fuel-eval)
 | 
			
		||||
(require 'fuel-syntax)
 | 
			
		||||
(require 'fuel-popup)
 | 
			
		||||
| 
						 | 
				
			
			@ -72,7 +73,8 @@ cursor at the first ocurrence of the used word."
 | 
			
		|||
 | 
			
		||||
(make-local-variable (defvar fuel-xref--word nil))
 | 
			
		||||
 | 
			
		||||
(defvar fuel-xref--help-string "(Press RET or click to follow crossrefs)")
 | 
			
		||||
(defvar fuel-xref--help-string
 | 
			
		||||
  "(Press RET or click to follow crossrefs, or h for help on word at point)")
 | 
			
		||||
 | 
			
		||||
(defun fuel-xref--title (word cc count)
 | 
			
		||||
  (put-text-property 0 (length word) 'font-lock-face 'bold word)
 | 
			
		||||
| 
						 | 
				
			
			@ -138,10 +140,16 @@ cursor at the first ocurrence of the used word."
 | 
			
		|||
 | 
			
		||||
;;; Xref mode:
 | 
			
		||||
 | 
			
		||||
(defun fuel-xref-show-help ()
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (let ((fuel-help-always-ask nil))
 | 
			
		||||
    (fuel-help)))
 | 
			
		||||
 | 
			
		||||
(defvar fuel-xref-mode-map
 | 
			
		||||
  (let ((map (make-sparse-keymap)))
 | 
			
		||||
    (suppress-keymap map)
 | 
			
		||||
    (set-keymap-parent map button-buffer-map)
 | 
			
		||||
    (define-key map "h" 'fuel-xref-show-help)
 | 
			
		||||
    map))
 | 
			
		||||
 | 
			
		||||
(defun fuel-xref-mode ()
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue