diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 80d8cde654..60420b3c39 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -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 diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index f1ca394e80..2feea39169 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -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 ; diff --git a/misc/fuel/README b/misc/fuel/README index 6c03c7aa01..14a9ca8b5d 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -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 diff --git a/misc/fuel/fuel-connection.el b/misc/fuel/fuel-connection.el index 05ddad4b1e..09d1ddfb51 100644 --- a/misc/fuel/fuel-connection.el +++ b/misc/fuel/fuel-connection.el @@ -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 @@ -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)))))) diff --git a/misc/fuel/fuel-edit.el b/misc/fuel/fuel-edit.el new file mode 100644 index 0000000000..e5988d1392 --- /dev/null +++ b/misc/fuel/fuel-edit.el @@ -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 +;; 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 diff --git a/misc/fuel/fuel-eval.el b/misc/fuel/fuel-eval.el index 078a7005f8..149e608964 100644 --- a/misc/fuel/fuel-eval.el +++ b/misc/fuel/fuel-eval.el @@ -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 @@ -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))) diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el index 12091ea399..705d1469a2 100644 --- a/misc/fuel/fuel-help.el +++ b/misc/fuel/fuel-help.el @@ -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)) diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el index a2c94d4f4a..69d1de8814 100644 --- a/misc/fuel/fuel-markup.el +++ b/misc/fuel/fuel-markup.el @@ -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))) diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index df06584fab..651cc323d0 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -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." diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 036ac7cbd0..2c3de32d4f 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -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 @@ -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)) diff --git a/misc/fuel/fuel-table.el b/misc/fuel/fuel-table.el new file mode 100644 index 0000000000..a00b21bf2f --- /dev/null +++ b/misc/fuel/fuel-table.el @@ -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 +;; 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 diff --git a/misc/fuel/fuel-xref.el b/misc/fuel/fuel-xref.el index 31f8bcb69b..470c2a8762 100644 --- a/misc/fuel/fuel-xref.el +++ b/misc/fuel/fuel-xref.el @@ -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 ()