FUEL: Edit article command in help buffers.

extra/fuel/fuel.factor

@@ -165,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 )

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 <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 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))))
+
+
+;;; 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

misc/fuel/fuel-help.el

@@ -14,6 +14,7 @@
 
 ;;; Code:
 
+(require 'fuel-edit)
 (require 'fuel-eval)
 (require 'fuel-markup)
 (require 'fuel-autodoc)
@@ -269,6 +270,15 @@ With prefix, the current page is deleted from history."
     (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:
 
@@ -281,6 +291,7 @@ With prefix, the current page is deleted from history."
     (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)

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."