diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | elisp/geiser-compile.el | 3 | ||||
| -rw-r--r-- | elisp/geiser-edit.el | 116 | ||||
| -rw-r--r-- | elisp/geiser-mode.el | 3 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 6 | ||||
| -rw-r--r-- | elisp/geiser-syntax.el | 2 | ||||
| -rw-r--r-- | scheme/guile/geiser/emacs.scm | 1 | ||||
| -rw-r--r-- | scheme/guile/geiser/eval.scm | 4 | ||||
| -rw-r--r-- | scheme/guile/geiser/introspection.scm | 38 |
9 files changed, 162 insertions, 12 deletions
@@ -1,3 +1,4 @@ /scheme/guile/geiser/emacs.go /scheme/guile/geiser/eval.go /scheme/guile/geiser/introspection.go +/scheme/guile/geiser/file.go diff --git a/elisp/geiser-compile.el b/elisp/geiser-compile.el index 5bac3c0..ae7d43e 100644 --- a/elisp/geiser-compile.el +++ b/elisp/geiser-compile.el @@ -76,7 +76,8 @@ (msg (format "%s %s ..." msg path))) (message msg) (geiser-compile--display-result - msg (geiser-eval--send/wait `(:gs ((:ge ,op) ,path)))))) +;; msg (geiser-eval--send/wait `(:gs ((:ge ,op) ,path) (geiser eval)))))) + msg (geiser-eval--send/wait `(compile-file ,path))))) ;;; User commands: diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el new file mode 100644 index 0000000..d51246f --- /dev/null +++ b/elisp/geiser-edit.el @@ -0,0 +1,116 @@ +;; geiser-edit.el -- visiting source files + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Start date: Wed Feb 11, 2009 21:07 + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Comentary: + +;; Functions to access Scheme files and spots. + +;;; Code: + +(require 'geiser-completion) +(require 'geiser-eval) +(require 'geiser-base) + +(require 'etags) + + +;;; Customization + +(defmacro geiser-edit--define-custom-visit (var group doc) + `(defcustom ,var nil + ,doc + :group ',group + :type '(choice (const :tag "Other window" window) + (const :tag "Other frame" frame) + (const :tag "Current window" nil)))) + +(geiser-edit--define-custom-visit + geiser-edit-symbol-method geiser + "How the new buffer is opened when invoking \\[geiser-edit-symbol-at-point]") + + +;;; Auxiliar functions: + +(defun geiser-edit--visit-file (file method) + (cond ((eq method 'window) (find-file-other-window file)) + ((eq method 'frame) (find-file-other-frame file)) + (t (find-file file)))) + +(defsubst geiser-edit--location-file (loc) + (cdr (assoc 'file loc))) + +(defsubst geiser-edit--location-line (loc) + (cdr (assoc 'line loc))) + +(defconst geiser-edit--def-re + (regexp-opt '("define" "defmacro" "define-macro" "define-syntax"))) + +(defsubst geiser-edit--def-re (symbol) + (format "(%s +(?%s" geiser-edit--def-re symbol)) + +(defun geiser-edit--goto-line (symbol line) + (if (numberp line) + (goto-line line) + (goto-char (point-min)) + (when (re-search-forward (geiser-edit--def-re symbol) nil t) + (beginning-of-line)))) + +(defun geiser-edit--try-edit (symbol ret) + (let* ((loc (geiser-eval--retort-result ret)) + (file (geiser-edit--location-file loc)) + (line (geiser-edit--location-line loc))) + (unless file (error "Couldn't find edit location")) + (unless (file-readable-p file) (error "Couldn't open '%s' for read" file)) + (geiser-edit--visit-file file geiser-edit-symbol-method) + (geiser-edit--goto-line symbol line))) + + +;;; Commands: + +(defun geiser-edit-symbol () + "Asks for a symbol to edit, with completion." + (interactive) + (let* ((symbol (geiser-completion--read-symbol "Edit symbol: " + nil + geiser-edit--symbol-history)) + (cmd `(:gs ((:ge symbol-location) ',symbol)))) + (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd)))) + +(defun geiser-edit-symbol-at-point (&optional arg) + "Opens a new window visiting the definition of the symbol at point. +With prefix, asks for the symbol to edit." + (interactive "P") + (let* ((symbol (or (and (not arg) (symbol-at-point)) + (geiser-completion--read-symbol "Edit symbol: "))) + (cmd `(:gs ((:ge symbol-location) ',symbol))) + (marker (point-marker))) + (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd)) + (when marker (ring-insert find-tag-marker-ring marker)))) + +(defun geiser-edit-pop-edit-symbol-stack () + "Pop back to where \\[geiser-edit-symbol-at-point] was last invoked." + (interactive) + (condition-case nil + (pop-tag-mark) + (error "No previous location for find symbol invocation"))) + + +(provide 'geiser-edit) +;;; geiser-edit.el ends here diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el index f5798e5..aed018f 100644 --- a/elisp/geiser-mode.el +++ b/elisp/geiser-mode.el @@ -27,6 +27,7 @@ (require 'geiser-compile) (require 'geiser-completion) +(require 'geiser-edit) (require 'geiser-autodoc) (require 'geiser-eval) (require 'geiser-popup) @@ -142,6 +143,8 @@ interacting with the Geiser REPL is at your disposal. (define-key geiser-mode-map "\C-c\C-k" 'geiser-compile-current-buffer) (define-key geiser-mode-map (kbd "M-TAB") 'geiser-completion--complete-symbol) +(define-key geiser-mode-map "\M-." 'geiser-edit-symbol-at-point) +(define-key geiser-mode-map "\M-," 'geiser-edit-pop-edit-symbol-stack) (define-key geiser-mode-map "\M-\C-x" 'geiser-send-definition) (define-key geiser-mode-map "\C-x\C-e" 'geiser-send-last-sexp) diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index d757bef..80b637a 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -26,6 +26,7 @@ ;;; Code: (require 'geiser-compile) +(require 'geiser-edit) (require 'geiser-eval) (require 'geiser-connection) (require 'geiser-base) @@ -151,10 +152,9 @@ the Geiser REPL buffer." (define-key geiser-repl-mode-map "\C-c\M-n" 'comint-next-input) (define-key geiser-repl-mode-map (kbd "TAB") 'geiser-completion--complete-symbol) +(define-key geiser-repl-mode-map "\M-." 'geiser-edit-symbol-at-point) +(define-key geiser-repl-mode-map "\M-," 'geiser-edit-pop-edit-symbol-stack) -;; (define-key geiser-repl-mode-map "\C-ch" 'geiser-help) -;; (define-key geiser-repl-mode-map "\C-cp" 'geiser-apropos) -;; (define-key geiser-repl-mode-map "\M-." 'geiser-edit-word-at-point) (provide 'geiser-repl) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index 2199cc5..c192a1f 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -96,8 +96,6 @@ (while (re-search-forward "#" nil t) (replace-match "\\\\#")) (goto-char (point-min)) (skip-syntax-forward "^(")) -) - ;;; Fontify strings as Scheme code: diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm index 8f0fffd..a3212af 100644 --- a/scheme/guile/geiser/emacs.scm +++ b/scheme/guile/geiser/emacs.scm @@ -27,6 +27,7 @@ (define-module (geiser emacs) #:re-export (ge:proc-args ge:completions + ge:symbol-location ge:compile-file ge:load-file) #:use-module ((geiser introspection) diff --git a/scheme/guile/geiser/eval.scm b/scheme/guile/geiser/eval.scm index 1400566..8a7f48f 100644 --- a/scheme/guile/geiser/eval.scm +++ b/scheme/guile/geiser/eval.scm @@ -70,7 +70,9 @@ SUBR, MSG and REST." (current (getcwd))) (dynamic-wind (lambda () (chdir dest)) - (lambda () (compile-file path)) + (lambda () + (and (compile-file path) + (load-compiled (string-append dest "/" (compiled-file-name path))))) (lambda () (chdir current))))) (define (load-file path) diff --git a/scheme/guile/geiser/introspection.scm b/scheme/guile/geiser/introspection.scm index 6ac3f69..03d5796 100644 --- a/scheme/guile/geiser/introspection.scm +++ b/scheme/guile/geiser/introspection.scm @@ -25,7 +25,7 @@ ;;; Code: (define-module (geiser introspection) - #:export (proc-args completions) + #:export (proc-args completions symbol-location) #:use-module (system vm program) #:use-module (ice-9 session) #:use-module (srfi srfi-1)) @@ -81,9 +81,37 @@ (apropos-internal (string-append "^" prefix))) string<?)) -(define (proc-location proc) - (let ((prog (resolve-symbol proc))) - (and prog - (program-source )))) +(define (make-location file line) + (list (cons 'file (if (string? file) file '())) + (cons 'line (if (number? line) (+ 1 line) '())))) + +(define (program-line prog) + (let ((src (program-source prog 0))) + (and src (source:line src)))) + +(define (module-filename name) + (let* ((name (map symbol->string name)) + (reverse-name (reverse name)) + (leaf (car reverse-name)) + (dir-hint-module-name (reverse (cdr reverse-name))) + (dir-hint (apply string-append + (map (lambda (elt) + (string-append elt "/")) + dir-hint-module-name)))) + (%search-load-path (in-vicinity dir-hint leaf)))) + +(define (program-file prog) + (let* ((mod (and prog (program-module prog))) + (name (and mod (module-name mod)))) + (and name (module-filename name)))) + +(define (program-location prog) + (make-location (program-file prog) (program-line prog))) + +(define (symbol-location sym) + (let ((prog (resolve-symbol sym))) + (if (program? prog) + (program-location prog) + '()))) ;;; introspection.scm ends here |