Merge branch 'master' into new_ui
Slava Pestov
commit
7d3d234151
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -63,16 +63,20 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
|
|||
|
||||
: enough? ( stack word -- ? )
|
||||
dup deferred? [ 2drop f ] [
|
||||
[ [ length ] dip 1quotation infer in>> >= ]
|
||||
[ [ length ] [ 1quotation infer in>> ] bi* >= ]
|
||||
[ 3drop f ] recover
|
||||
] if ;
|
||||
|
||||
: fold-word ( stack word -- stack )
|
||||
2dup enough?
|
||||
[ 1quotation with-datastack ] [ [ % ] dip , { } ] if ;
|
||||
[ 1quotation with-datastack ] [ [ % ] [ , ] bi* { } ] if ;
|
||||
|
||||
: fold ( quot -- folded-quot )
|
||||
[ { } swap [ fold-word ] each % ] [ ] make ;
|
||||
[ { } [ fold-word ] reduce % ] [ ] make ;
|
||||
|
||||
ERROR: no-recursive-inverse ;
|
||||
|
||||
SYMBOL: visited
|
||||
|
||||
: flattenable? ( object -- ? )
|
||||
{ [ word? ] [ primitive? not ] [
|
||||
|
|
@ -80,18 +84,18 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
|
|||
[ word-prop ] with contains? not
|
||||
] } 1&& ;
|
||||
|
||||
: (flatten) ( quot -- )
|
||||
[ dup flattenable? [ def>> (flatten) ] [ , ] if ] each ;
|
||||
|
||||
: retain-stack-overflow? ( error -- ? )
|
||||
{ "kernel-error" 14 f f } = ;
|
||||
|
||||
: flatten ( quot -- expanded )
|
||||
[ [ (flatten) ] [ ] make ] [
|
||||
dup retain-stack-overflow?
|
||||
[ drop "No inverse defined on recursive word" ] when
|
||||
throw
|
||||
] recover ;
|
||||
[
|
||||
visited [ over suffix ] change
|
||||
[
|
||||
dup flattenable? [
|
||||
def>>
|
||||
[ visited get memq? [ no-recursive-inverse ] when ]
|
||||
[ flatten ]
|
||||
bi
|
||||
] [ 1quotation ] if
|
||||
] map concat
|
||||
] with-scope ;
|
||||
|
||||
ERROR: undefined-inverse ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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