diff options
Diffstat (limited to 'elisp')
| -rw-r--r-- | elisp/geiser-autodoc.el | 132 | ||||
| -rw-r--r-- | elisp/geiser-eval.el | 27 | ||||
| -rw-r--r-- | elisp/geiser-mode.el | 155 | ||||
| -rw-r--r-- | elisp/geiser-syntax.el | 96 | ||||
| -rw-r--r-- | elisp/geiser.el | 7 |
5 files changed, 403 insertions, 14 deletions
diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el new file mode 100644 index 0000000..cff5794 --- /dev/null +++ b/elisp/geiser-autodoc.el @@ -0,0 +1,132 @@ +;; geiser-autodoc.el -- autodoc mode + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Start date: Sun Feb 08, 2009 19:44 + +;; 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: + +;; A minor mode that echoes information about procedures and variables +;; near point at the minibuffer. + +;;; Code: + +(require 'geiser-eval) +(require 'geiser-syntax) +(require 'geiser-base) + +(require 'eldoc) + + +;;; Customization: + +(defgroup geiser-autodoc nil + "Options for displaying autodoc strings in the echo area." + :group 'geiser) + +(defface geiser-font-lock-autodoc-current-arg + '((t (:background unspecified :foreground "red" :bold t))) + "Face for highlighting current argument in autodoc messages." + :group 'faces + :group 'geiser-faces + :group 'geiser-autodoc) + +(defcustom geiser-autodoc-delay 0.2 + "Delay before autodoc messages are fetched and displayed, in seconds." + :type 'number + :group 'geiser-autodoc) + + +;;; Procedure arguments: + +(make-variable-buffer-local + (defvar geiser-autodoc--last nil)) + +(defun geiser-autodoc--function-args (fun) + (if (eq fun (car geiser-autodoc--last)) + (cdr geiser-autodoc--last) + (let* ((cmd `(:gs ((:ge proc-args) ',fun))) + (result (geiser-eval--retort-result (geiser-eval--send/wait cmd)))) + (when (and (not (eq result :f)) (listp result)) + (setq geiser-autodoc--last (cons fun result)) + result)))) + +(defun geiser-autodoc--insert (sym current pos) + (let ((str (format "%s" sym))) + (when (= current pos) + (put-text-property 0 (length str) 'face 'geiser-font-lock-autodoc-current-arg str)) + (insert str))) + +(defun geiser-autodoc--fun-args-str (fun args pos) + (save-current-buffer + (set-buffer (geiser-syntax--font-lock-buffer)) + (erase-buffer) + (let ((current 0)) + (insert "(") + (geiser-autodoc--insert fun current pos) + (dolist (arg (cdr (assoc 'required args))) + (setq current (1+ current)) + (insert " ") + (geiser-autodoc--insert arg current pos)) + (setq current (1+ current)) + (when (cdr (assoc 'optional args)) + (when (> pos current) (setq current pos)) + (insert " . ") + (geiser-autodoc--insert (cdr (assoc 'optional args)) current pos)) + (insert ")") + (buffer-string)))) + + +;;; Autodoc function: + +(defun geiser-autodoc--eldoc-function () + (let* ((f/a (geiser-syntax--enclosing-form-data)) + (fun (car f/a)) + (arg-no (cdr f/a))) + (when fun + (let ((args (geiser-autodoc--function-args fun))) + (geiser-autodoc--fun-args-str fun args arg-no))))) + + +;;; Autodoc mode: + +(make-variable-buffer-local + (defvar geiser-autodoc-mode-string " A" + "Modeline indicator for geiser-autodoc-mode")) + +(define-minor-mode geiser-autodoc-mode + "Toggle Geiser's Autodoc mode. +With no argument, this command toggles the mode. +Non-null prefix argument turns on the mode. +Null prefix argument turns off the mode. + +When Autodoc mode is enabled, a synopsis of the word at point is +displayed in the minibuffer." + :init-value nil + :lighter geiser-autodoc-mode-string + :group 'geiser-autodoc + + (set (make-local-variable 'eldoc-documentation-function) + (when geiser-autodoc-mode 'geiser-autodoc--eldoc-function)) + (set (make-local-variable 'eldoc-minor-mode-string) nil) + (set (make-local-variable 'eldoc-idle-delay) geiser-autodoc-delay) + (eldoc-mode geiser-autodoc-mode) + (message "Geiser Autodoc %s" (if geiser-autodoc-mode "enabled" "disabled"))) + + +(provide 'geiser-autodoc) +;;; geiser-autodoc.el ends here diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 68ef1ca..ee04139 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -26,6 +26,7 @@ ;;; Code: (require 'geiser-connection) +(require 'geiser-syntax) (require 'geiser-log) (require 'geiser-base) @@ -38,8 +39,10 @@ ((eq code :t) "#t") ((listp code) (cond ((eq (car code) :gs) (geiser-eval--gs (cdr code))) + ((eq (car code) :ge) (format "(@ (geiser emacs) %s)" (cadr code))) ((eq (car code) :scm) (cadr code)) (t (concat "(" (mapconcat 'geiser-eval--scheme-str code " ") ")")))) + ((symbolp code) (format "%s" code)) (t (format "%S" code)))) (defsubst geiser-eval--gs (code) @@ -48,19 +51,8 @@ ") (quote " (or (and (nth 1 code) (geiser-eval--scheme-str (nth 1 code))) - (geiser-eval--buffer-module)) + (geiser-syntax--buffer-module)) "))")) - -;;; Current module: - -(defun geiser-eval--buffer-module (&optional buffer) - (let ((buffer (or buffer (current-buffer)))) - (with-current-buffer buffer - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "(define-module +\\(([^)]+)\\)" nil t) - (match-string-no-properties 1) - "#f"))))) ;;; Code sending: @@ -116,6 +108,17 @@ (defsubst geiser-eval--error-msg (err) (cdr (assoc 'msg err))) (defsubst geiser-eval--error-rest (err) (cdr (assoc 'rest err))) +(defun geiser-eval--error-str (err) + (let* ((key (geiser-eval--error-key err)) + (subr (geiser-eval--error-subr err)) + (subr-str (if subr (format " (%s)" subr) "")) + (msg (geiser-eval--error-msg err)) + (msg-str (if msg (format ": %s" msg) "")) + (rest (geiser-eval--error-rest err)) + (rest-str (if rest (format " %s" rest) ""))) + (format "Error%s: %s%s%s" subr-str key msg-str rest-str))) + + (provide 'geiser-eval) ;;; geiser-eval.el ends here diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el new file mode 100644 index 0000000..2b6778b --- /dev/null +++ b/elisp/geiser-mode.el @@ -0,0 +1,155 @@ +;; geiser-mode.el -- minor mode for scheme buffers + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Start date: Sun Feb 08, 2009 15:13 + +;; 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: + +;; Minor mode adding Geiser REPL/Emacs interaction commands to Scheme +;; buffers. + +;;; Code: + +(require 'geiser-autodoc) +(require 'geiser-eval) +(require 'geiser-popup) +(require 'geiser-base) + + +;;; Customization: + +(defgroup geiser-mode nil + "Mode enabling Geiser abilities in Scheme buffers &co.." + :group 'geiser) + +(defcustom geiser-mode-autodoc-p t + "Whether `geiser-autodoc-mode' gets enabled by default in factor buffers." + :group 'geiser-mode + :group 'geiser-autodoc + :type 'boolean) + + + +;;; Auxiliary functions: + +(geiser-popup--define mode "*Geiser evaluation results*" scheme-mode) + +(defun geiser-eval--display-error (err output) + (if (not output) + (message (geiser-eval--error-str err)) + (geiser-mode--with-buffer + (erase-buffer) + (insert ";; " (geiser-eval--error-str err)) + (newline 2) + (insert output) + (newline)) + (geiser-mode--pop-to-buffer))) + + +;;; Evaluation commands: + +(defun geiser-send-region (start end &optional and-go) + "Send the current region to the Geiser REPL. +With prefix, goes to the REPL buffer afterwards (as +`geiser-send-region-and-go')" + (interactive "rP") + (let* ((str (buffer-substring-no-properties start end)) + (code `(:gs (:scm ,str))) + (ret (geiser-eval--send/wait code)) + (err (geiser-eval--retort-error ret))) + (when and-go + (switch-to-guile) + (push-mark) + (goto-char (point-max))) + (if (not err) + (message (format "=> %s" (geiser-eval--retort-result ret))) + (geiser-eval--display-error err (geiser-eval--retort-output ret))))) + +(defun geiser-send-region-and-go (start end) + "Send the current region to the Geiser REPL and visit it afterwads." + (interactive "r") + (geiser-send-region start end t)) + +(defun geiser-send-definition (&optional and-go) + "Send the current definition to the Geiser REPL. +With prefix, goes to the REPL buffer afterwards (as +`geiser-send-definition-and-go')" + (interactive "P") + (save-excursion + (end-of-defun) + (let ((end (point))) + (beginning-of-defun) + (geiser-send-region (point) end and-go)))) + +(defun geiser-send-definition-and-go () + "Send the current definition to the Geiser REPL and visit it afterwads." + (interactive) + (geiser-send-definition t)) + +(defun geiser-send-last-sexp () + "Send the previous sexp to the Geiser REPL." + (interactive) + (geiser-send-region (save-excursion (backward-sexp) (point)) (point))) + + +;;; Geiser mode: + +(make-variable-buffer-local + (defvar geiser-mode-string " Geiser" + "Modeline indicator for geiser-mode")) + +(defvar geiser-mode-map (make-sparse-keymap) + "Key map for geiser-mode") + +(define-minor-mode geiser-mode + "Toggle Geiser's mode. +With no argument, this command toggles the mode. +Non-null prefix argument turns on the mode. +Null prefix argument turns off the mode. + +When Geiser mode is enabled, a host of nice utilities for +interacting with the Geiser REPL is at your disposal. +\\{geiser-mode-map}" + :init-value nil + :lighter geiser-mode-string + :group 'geiser + :keymap geiser-mode-map + (setq geiser-autodoc-mode-string "/A") + (when geiser-mode-autodoc-p (geiser-autodoc-mode geiser-mode))) + + +;;; Keys: + +(define-key geiser-mode-map "\M-\C-x" 'geiser-send-definition) +(define-key geiser-mode-map "\C-c\C-a" 'geiser-autodoc-mode) +(define-key geiser-mode-map "\C-x\C-e" 'geiser-send-last-sexp) +(define-key geiser-mode-map "\C-c\C-e" 'geiser-send-definition) +(define-key geiser-mode-map "\C-c\M-e" 'geiser-send-definition-and-go) +(define-key geiser-mode-map "\C-c\C-r" 'geiser-send-region) +(define-key geiser-mode-map "\C-c\M-r" 'geiser-send-region-and-go) +(define-key geiser-mode-map "\C-c\M-c" 'geiser-compile-definition) +(define-key geiser-mode-map "\C-c\C-c" 'geiser-compile-definition-and-go) +(define-key geiser-mode-map "\C-c\C-t" 'geiser-trace-procedure) +(define-key geiser-mode-map "\C-c\C-x" 'geiser-expand-current-form) +(define-key geiser-mode-map "\C-c\C-z" 'switch-to-guile) +(define-key geiser-mode-map "\C-c\C-l" 'geiser-load-file) +(define-key geiser-mode-map "\C-c\C-k" 'geiser-compile-file) + + +(provide 'geiser-mode) +;;; geiser-mode.el ends here diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el new file mode 100644 index 0000000..07aafbb --- /dev/null +++ b/elisp/geiser-syntax.el @@ -0,0 +1,96 @@ +;; geiser-syntax.el -- guile-specific scheme syntax + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Start date: Sun Feb 08, 2009 15:03 + +;; 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: + +;; Utilities for parsing Guile-specific Scheme syntax. + +;;; Code: + +(require 'geiser-base) + +(require 'scheme) + + +;;; Modules: + +(defconst geiser-syntax--module-definition-re + "(define-module +\\(([^)]+)\\)") + +(defun geiser-syntax--buffer-module (&optional buffer) + (let ((buffer (or buffer (current-buffer)))) + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + (if (re-search-forward geiser-syntax--module-definition-re nil t) + (match-string-no-properties 1) + "#f"))))) + +;;; Indentation: + +(defun geiser-syntax--setup-scheme-indent () + (let ((defuns '(catch))) + (mapc (lambda (d) (put d 'scheme-indent-function 'defun)) defuns))) + + +;;; Code parsing: + +(defun geiser-syntax--enclosing-form-data () + (save-excursion + (let ((p (progn (ignore-errors + (unless (zerop (car (syntax-after (point)))) + (forward-sexp) + (when (= 7 (car (syntax-after (point)))) + (forward-char)))) + (point))) + (arg-no 0) + (proc)) + (condition-case nil + (progn (backward-up-list) + (forward-char) + (setq proc (symbol-at-point)) + (while (< (point) p) + (forward-sexp) + (when (< (point) p) (setq arg-no (1+ arg-no)))) + (cons proc arg-no)) + (error nil))))) + + +;;; Fontify strings as Scheme code: + +(defun geiser-syntax--font-lock-buffer () + (let ((name " *geiser font lock*")) + (or (get-buffer name) + (let ((buffer (get-buffer-create name))) + (set-buffer buffer) + (scheme-mode) + buffer)))) + +(defun geiser-syntax--scheme-str (str) + (save-current-buffer + (set-buffer (geiser-syntax--font-lock-buffer)) + (erase-buffer) + (insert str) + (let ((font-lock-verbose nil)) (font-lock-fontify-buffer)) + (buffer-string))) + + +(provide 'geiser-syntax) +;;; geiser-syntax.el ends here diff --git a/elisp/geiser.el b/elisp/geiser.el index 2ce4e82..ab3e7ff 100644 --- a/elisp/geiser.el +++ b/elisp/geiser.el @@ -46,10 +46,13 @@ ;;; Autoloads: (autoload 'run-guile "geiser-repl.el" - "Start a Geiser Guile REPL, or switch to a running one" t) + "Start a Geiser Guile REPL, or switch to a running one." t) (autoload 'switch-to-guile "geiser-repl.el" - "Start a Geiser Guile REPL, or switch to a running one" t) + "Start a Geiser Guile REPL, or switch to a running one." t) + +(autoload 'geiser-mode "geiser-mode.el" + "Minor mode adding Geiser REPL interaction to Scheme buffers." t) (provide 'geiser) |