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 vectors vocabs vocabs.parser words ;
IN: fuel
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
! 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 )
- h : help for word at point
- 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
- TAB/BACKTAB : navigate links
- RET/mouse click : follow link
+ - h : show help for word at point
- q : bury buffer
;;; 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>
(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))))))
--- /dev/null
+;;; 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)
+
+\f
+;;; 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 t 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))))
+
+\f
+;;; 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)))))))))
+
+\f
+(provide 'fuel-edit)
+;;; fuel-edit.el ends here
;;; 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>
;;; Code:
-(require 'fuel-base)
(require 'fuel-syntax)
(require 'fuel-connection)
+(require 'fuel-log)
+(require 'fuel-base)
(eval-when-compile (require 'cl))
(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)))
;;; 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)
(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))))
(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)
(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)
(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-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)
(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")))))
+
\f
;;;; Help mode map:
(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 (kbd "SPC") 'scroll-up)
(define-key map "\C-c\C-z" 'run-factor)
map))
+\f
+;;; 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)))))
+
\f
;;; Help mode definition:
(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))
(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)
(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)
(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)
- (newline)))
-
(defun fuel-markup--example (e)
- (fuel-markup--snippet (list '$snippet (cadr e))))
+ (fuel-markup--insert-newline)
+ (dolist (s (cdr e))
+ (fuel-markup--snippet (list '$snippet s))
+ (newline)))
(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))
"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))
(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"))
(require 'fuel-stack)
(require 'fuel-autodoc)
(require 'fuel-font-lock)
+(require 'fuel-edit)
(require 'fuel-syntax)
(require 'fuel-base)
(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
(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."
;;; 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>
"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:"
(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))
;;; Code:
+(require 'fuel-help)
(require 'fuel-eval)
(require 'fuel-syntax)
(require 'fuel-popup)
(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)
\f
;;; 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 ()
projects / factor.git / commitdiff