From d8da8d0e8733bb5c2fc01347be17dfc7c1c4cfa7 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 14 Jun 2009 22:19:36 +0200 Subject: Fixes in geiser-reload (unload forcibly and pick repl implementations). --- elisp/geiser-impl.el | 2 +- elisp/geiser-repl.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index 6bc4e79..d45fadc 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -213,7 +213,7 @@ implementation to be used by Geiser.")) (defun geiser-impl-unload-function () (dolist (imp (mapcar 'geiser-impl--impl-feature geiser-impl--impls)) - (when (featurep imp) (unload-feature imp))) + (when (featurep imp) (unload-feature imp t))) t) (defun geiser-impl--reload-implementations (impls) diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index f4d85dc..da7dde7 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -326,7 +326,7 @@ If no REPL is running, execute `run-geiser' to start a fresh one." (defun geiser-repl--restore (impls) (dolist (impl impls) - (when impl (geiser impl)))) + (when impl (geiser nil impl)))) (defun geiser-repl-unload-function () (dolist (repl geiser-repl--repls) -- cgit v1.2.3 From 7fad7a69914a920774fd2ce766198ecbd25265bc Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 16 Jun 2009 22:35:21 +0200 Subject: Better parsing of scheme retorts in the Emacs end. --- elisp/geiser-connection.el | 10 +++++++--- elisp/geiser-syntax.el | 21 ++++----------------- 2 files changed, 11 insertions(+), 20 deletions(-) diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index 33579f6..33668e0 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -160,10 +160,14 @@ (defun geiser-con--comint-buffer-form () (with-current-buffer (geiser-con--comint-buffer) - (geiser-syntax--prepare-scheme-for-elisp-reader) (condition-case nil - (let ((form (read (current-buffer)))) - (if (listp form) form (error))) + (progn + (goto-char (point-min)) + (re-search-forward "((\\(result\\|error\\) ") + (goto-char (match-beginning 0)) + (geiser-syntax--prepare-scheme-for-elisp-reader) + (let ((form (read (current-buffer)))) + (if (listp form) form (error)))) (error `((error (key . geiser-con-error) (msg . ,(buffer-string)))))))) (defun geiser-con--process-next (con) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index 14d996c..c70aacb 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -89,23 +89,10 @@ (goto-char (point-max)) (and (re-search-backward "(output \\. \"" nil t) (point))))) - (goto-char (point-min)) - (while (re-search-forward "#\<\\([^>]*?\\)\>" end t) - (let ((from (match-beginning 1)) - (to (match-end 1))) - (goto-char from) - (while (re-search-forward "\\([ ;'`]\\)" to t) - (replace-match "\\\\\\1")) - (goto-char from) - (while (re-search-forward "[()]" to t) - (replace-match "")) - (goto-char to))) - (goto-char (point-min)) - (while (re-search-forward "#(" end t) (replace-match "(vector ")) - (goto-char (point-min)) - (while (re-search-forward "#" end t) (replace-match "\\\\#")) - (goto-char (point-min)) - (skip-syntax-forward "^("))) + (save-excursion + (while (re-search-forward "#(" end t) (replace-match "(vector ")) + (goto-char (point-min)) + (while (re-search-forward "#" end t) (replace-match "\\\\#"))))) (defsubst geiser-syntax--del-sexp (arg) (let ((p (point))) -- cgit v1.2.3 From 631d43de316ac010ac8d8bcc165b64dd75a328a1 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 16 Jun 2009 22:36:15 +0200 Subject: Elimination of dead code in stack trace display. --- elisp/geiser-debug.el | 46 +++++++++++++++------------------------------- elisp/geiser-eval.el | 3 +-- 2 files changed, 16 insertions(+), 33 deletions(-) diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index 7ebd0b5..f0dc6ec 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -32,15 +32,23 @@ ;;; Debug buffer mode: -(defconst geiser-debug--error-alist - '(("^\\(In file +\\| +\\)\\([^ \n]+\\):\\([0-9]+\\):\\([0-9]+\\)" 2 3 4) - ("^Error.+$" nil nil nil 0))) +(defvar geiser-debug-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (set-keymap-parent map button-buffer-map) + map)) -(define-derived-mode geiser-debug-mode compilation-mode "Geiser Dbg" +(defun geiser-debug-mode () "A major mode for displaying Scheme compilation and evaluation results. \\{geiser-debug-mode-map}" - (set (make-local-variable 'compilation-error-regexp-alist) - geiser-debug--error-alist)) + (interactive) + (kill-all-local-variables) + (buffer-disable-undo) + (use-local-map geiser-debug-mode-map) + (set-syntax-table scheme-mode-syntax-table) + (setq mode-name "Geiser DBG") + (setq major-mode 'geiser-debug-mode) + (setq buffer-read-only t)) ;;; Buffer for displaying evaluation results: @@ -52,40 +60,16 @@ (defun geiser-debug--display-retort (what ret) (let* ((err (geiser-eval--retort-error ret)) - (output (geiser-eval--retort-output ret)) - (stack (geiser-eval--retort-stack ret))) + (output (geiser-eval--retort-output ret))) (geiser-debug--with-buffer (erase-buffer) (insert what) (newline 2) (when err (insert (geiser-eval--error-str err) "\n\n")) (when output (insert output "\n\n")) - (when stack (geiser-debug--display-stack stack)) (goto-char (point-min))) (when err (geiser-debug--pop-to-buffer)))) -(defsubst geiser-debug--frame-proc (frame) (cdr (assoc 'procedure frame))) -(defsubst geiser-debug--frame-desc (frame) (cdr (assoc 'description frame))) -(defsubst geiser-debug--frame-source (frame) (cdr (assoc 'source frame))) -(defsubst geiser-debug--frame-source-file (src) (car src)) -(defsubst geiser-debug--frame-source-line (src) (or (cadr src) 1)) -(defsubst geiser-debug--frame-source-column (src) (or (caddr src) 0)) - -(defun geiser-debug--display-stack (stack) - (mapc 'geiser-debug--display-stack-frame (reverse (cdr stack)))) - -(defun geiser-debug--display-stack-frame (frame) - (let ((procedure (geiser-debug--frame-proc frame)) - (source (geiser-debug--frame-source frame)) - (description (geiser-debug--frame-desc frame))) - (if source - (insert (format "In file %s:%s:%s\n" - (geiser-debug--frame-source-file source) - (geiser-debug--frame-source-line source) - (1+ (geiser-debug--frame-source-column source)))) - (insert "In expression:\n")) - (insert (format "%s\n" description)))) - (defsubst geiser-debug--wrap-region (str) (format "(begin %s)" str)) diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index c493092..90be67c 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -149,7 +149,6 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) (defsubst geiser-eval--retort-output (ret) (cdr (assoc 'output ret))) (defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret))) -(defsubst geiser-eval--retort-stack (ret) (cdr (assoc 'stack ret))) (defsubst geiser-eval--error-key (err) (cdr (assoc 'key err))) (defsubst geiser-eval--error-subr (err) (cdr (assoc 'subr err))) @@ -160,7 +159,7 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) (let* ((key (geiser-eval--error-key err)) (key-str (if key (format ": %s" key) ":")) (subr (geiser-eval--error-subr err)) - (subr-str (if subr (format " (%s):" subr) ":")) + (subr-str (if subr (format " (%s):" subr) "")) (msg (geiser-eval--error-msg err)) (msg-str (if msg (format "\n %s" msg) "")) (rest (geiser-eval--error-rest err)) -- cgit v1.2.3 From 85838e68615303ec37832272a398fa8d4f474962 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 16 Jun 2009 23:15:16 +0200 Subject: Fixes in retort parsing. --- elisp/geiser-connection.el | 4 ++-- elisp/geiser-impl.el | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index 33668e0..8090247 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -163,12 +163,12 @@ (condition-case nil (progn (goto-char (point-min)) - (re-search-forward "((\\(result\\|error\\) ") + (re-search-forward "((\\(result\\|error\\)\\>") (goto-char (match-beginning 0)) (geiser-syntax--prepare-scheme-for-elisp-reader) (let ((form (read (current-buffer)))) (if (listp form) form (error)))) - (error `((error (key . geiser-con-error) (msg . ,(buffer-string)))))))) + (error `((error (key . geiser-con-error)) (output . ,(buffer-string))))))) (defun geiser-con--process-next (con) (when (not (geiser-con--connection-current-request con)) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index d45fadc..38c34ee 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -171,7 +171,8 @@ (geiser-impl--call-if-bound (geiser-impl--default-implementation) "geiser-procedure" proc)) -(set-default 'geiser-eval--geiser-procedure-function 'geiser-impl-geiser-procedure) +(set-default 'geiser-eval--geiser-procedure-function + 'geiser-impl-geiser-procedure) ;;; Access to implementation specific execution parameters: -- cgit v1.2.3 From d3fc72a4441c6b4f0d447e7a205b469dbb7b78a6 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Wed, 17 Jun 2009 00:05:34 +0200 Subject: Whitespace. --- elisp/geiser-doc.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el index 8024239..bece09e 100644 --- a/elisp/geiser-doc.el +++ b/elisp/geiser-doc.el @@ -165,7 +165,8 @@ (funcall geiser-doc--external-help-function symbol module))) (defun geiser-doc--get-docstring (symbol module) - (geiser-eval--send/result `(:eval ((:ge symbol-documentation) ',symbol) ,module))) + (geiser-eval--send/result + `(:eval ((:ge symbol-documentation) ',symbol) ,module))) (defun geiser-doc--get-module-exports (module) (geiser-eval--send/result `(:eval ((:ge module-exports) (:module ,module))))) @@ -193,7 +194,8 @@ With prefix argument, ask for symbol (with completion)." (interactive "P") (let ((symbol (or (and (not arg) (symbol-at-point)) - (geiser-completion--read-symbol "Symbol: " (symbol-at-point))))) + (geiser-completion--read-symbol "Symbol: " + (symbol-at-point))))) (when symbol (geiser-doc-symbol symbol)))) @@ -219,7 +221,8 @@ With prefix argument, ask for symbol (with completion)." impl)) (goto-char (point-min)) (setq geiser-doc--buffer-link - (geiser-doc--history-push (geiser-doc--make-link nil module impl)))) + (geiser-doc--history-push + (geiser-doc--make-link nil module impl)))) (geiser-doc--pop-to-buffer)))) (defun geiser-doc-next (&optional forget-current) -- cgit v1.2.3 From a38f0cb328b48de908a978436388f216a270d6dd Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Wed, 17 Jun 2009 00:53:36 +0200 Subject: Circular dependencies between elisp modules eliminated. --- elisp/geiser-doc.el | 16 +++++----------- elisp/geiser-impl.el | 12 +++--------- elisp/geiser.el | 4 ++-- 3 files changed, 10 insertions(+), 22 deletions(-) diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el index bece09e..adef4c6 100644 --- a/elisp/geiser-doc.el +++ b/elisp/geiser-doc.el @@ -24,6 +24,7 @@ ;;; Code: +(require 'geiser-impl) (require 'geiser-completion) (require 'geiser-eval) (require 'geiser-syntax) @@ -157,13 +158,6 @@ ;;; Commands: -(make-variable-buffer-local - (defvar geiser-doc--external-help-function nil)) - -(defun geiser-doc--external-help (symbol module) - (and geiser-doc--external-help-function - (funcall geiser-doc--external-help-function symbol module))) - (defun geiser-doc--get-docstring (symbol module) (geiser-eval--send/result `(:eval ((:ge symbol-documentation) ',symbol) ,module))) @@ -172,10 +166,10 @@ (geiser-eval--send/result `(:eval ((:ge module-exports) (:module ,module))))) (defun geiser-doc-symbol (symbol &optional module impl) - (let ((module (or module (geiser-eval--get-module)))) - (unless (geiser-doc--external-help symbol module) - (let ((impl (or impl geiser-impl--implementation)) - (ds (geiser-doc--get-docstring symbol module))) + (let ((module (or module (geiser-eval--get-module))) + (impl (or impl geiser-impl--implementation))) + (unless (geiser-impl--external-help impl symbol module) + (let ((ds (geiser-doc--get-docstring symbol module))) (if (or (not ds) (not (listp ds))) (message "No documentation available for '%s'" symbol) (geiser-doc--with-buffer diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index 38c34ee..b4c01c7 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -27,7 +27,6 @@ (require 'geiser-eval) (require 'geiser-base) -(require 'geiser-doc) (require 'geiser-completion) @@ -124,10 +123,6 @@ (defsubst geiser-impl--geiser-procedure-function (impl) (geiser-impl--sym impl "geiser-procedure")) -(defsubst geiser-impl--external-help-function (impl) - (let ((f (geiser-impl--sym impl "external-help"))) - (and (fboundp f) f))) - (defsubst geiser-impl--symbol-begin (impl) (geiser-impl--sym impl "symbol-begin")) @@ -136,8 +131,6 @@ (geiser-impl--module-function impl)) (setq geiser-eval--geiser-procedure-function (geiser-impl--geiser-procedure-function impl)) - (setq geiser-doc--external-help-function - (geiser-impl--external-help-function impl)) (setq geiser-completion--symbol-begin-function (geiser-impl--symbol-begin impl))) @@ -150,8 +143,6 @@ (geiser-impl--module-function imp)) (geiser-eval--geiser-procedure-function (geiser-impl--geiser-procedure-function imp)) - (geiser-doc--external-help-function - (geiser-impl--external-help-function imp)) (geiser-completion--symbol-begin-function (geiser-impl--symbol-begin imp))) (funcall thunk))) @@ -192,6 +183,9 @@ (defsubst geiser-impl--startup (impl) (geiser-impl--call-if-bound impl "startup")) +(defsubst geiser-impl--external-help (impl symbol module) + (geiser-impl--call-if-bound impl "external-help" symbol module)) + ;;; Access to implementation guessing function: diff --git a/elisp/geiser.el b/elisp/geiser.el index b12127c..926cb4f 100644 --- a/elisp/geiser.el +++ b/elisp/geiser.el @@ -114,10 +114,10 @@ (quote '( geiser-mode geiser-repl - geiser-impl - geiser-doc geiser-xref geiser-edit + geiser-doc + geiser-impl geiser-completion geiser-autodoc geiser-compile -- cgit v1.2.3 From 44a70803378f67ef2f6a9bfb91a2d9cbe7063369 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Wed, 17 Jun 2009 03:12:33 +0200 Subject: Whitespace. --- elisp/geiser-connection.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index 8090247..0ec6405 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -168,7 +168,8 @@ (geiser-syntax--prepare-scheme-for-elisp-reader) (let ((form (read (current-buffer)))) (if (listp form) form (error)))) - (error `((error (key . geiser-con-error)) (output . ,(buffer-string))))))) + (error `((error (key . geiser-con-error)) + (output . ,(buffer-string))))))) (defun geiser-con--process-next (con) (when (not (geiser-con--connection-current-request con)) -- cgit v1.2.3 From bcc096b289e0ca237914c8aaa3e351d2bf7d0731 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Wed, 17 Jun 2009 03:13:38 +0200 Subject: Implementation-specific backtrace display. --- elisp/geiser-debug.el | 11 ++++++++--- elisp/geiser-impl.el | 3 +++ elisp/geiser.el | 2 +- 3 files changed, 12 insertions(+), 4 deletions(-) diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index f0dc6ec..3bf262c 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -25,6 +25,7 @@ ;;; Code: +(require 'geiser-impl) (require 'geiser-eval) (require 'geiser-popup) (require 'geiser-base) @@ -60,13 +61,17 @@ (defun geiser-debug--display-retort (what ret) (let* ((err (geiser-eval--retort-error ret)) - (output (geiser-eval--retort-output ret))) + (key (geiser-eval--error-key err)) + (output (geiser-eval--retort-output ret)) + (impl geiser-impl--implementation) + (module (geiser-eval--get-module))) (geiser-debug--with-buffer (erase-buffer) (insert what) (newline 2) - (when err (insert (geiser-eval--error-str err) "\n\n")) - (when output (insert output "\n\n")) + (unless (geiser-impl--display-error impl module key output) + (when err (insert (geiser-eval--error-str err) "\n\n")) + (when output (insert output "\n\n"))) (goto-char (point-min))) (when err (geiser-debug--pop-to-buffer)))) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index b4c01c7..fadc8b6 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -186,6 +186,9 @@ (defsubst geiser-impl--external-help (impl symbol module) (geiser-impl--call-if-bound impl "external-help" symbol module)) +(defsubst geiser-impl--display-error (impl module key msg) + (geiser-impl--call-if-bound impl "display-error" module key msg)) + ;;; Access to implementation guessing function: diff --git a/elisp/geiser.el b/elisp/geiser.el index 926cb4f..748fb23 100644 --- a/elisp/geiser.el +++ b/elisp/geiser.el @@ -117,11 +117,11 @@ geiser-xref geiser-edit geiser-doc + geiser-debug geiser-impl geiser-completion geiser-autodoc geiser-compile - geiser-debug geiser-eval geiser-connection geiser-syntax -- cgit v1.2.3 From e9b6d59467d736d89588c7575d9ff9f4c921c34a Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Wed, 17 Jun 2009 03:14:07 +0200 Subject: Auxiliary functions to insert error links. --- elisp/geiser-edit.el | 39 ++++++++++++++++++++++++++++++++++++--- 1 file changed, 36 insertions(+), 3 deletions(-) diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el index 986099e..62b8a53 100644 --- a/elisp/geiser-edit.el +++ b/elisp/geiser-edit.el @@ -44,7 +44,11 @@ (geiser-edit--define-custom-visit geiser-edit-symbol-method geiser-mode - "How the new buffer is opened when invoking \\[geiser-edit-symbol-at-point].") + "How the new buffer is opened when invoking \\[geiser-edit-symbol-at-point] +or following links in error buffers.") + +(geiser-custom--defface error-link + 'link geiser-debug "links in error buffers") ;;; Auxiliar functions: @@ -63,6 +67,12 @@ (defsubst geiser-edit--location-line (loc) (cdr (assoc 'line loc))) +(defsubst geiser-edit--location-column (loc) + (cdr (assoc 'column loc))) + +(defsubst geiser-edit--make-location (name file line column) + `((name . ,name) (file . ,file) (line . ,line) (column . ,column))) + (defconst geiser-edit--def-re (regexp-opt '("define" "defmacro" @@ -103,15 +113,38 @@ (defun geiser-edit--try-edit-location (symbol loc &optional method) (let ((symbol (or (geiser-edit--location-name loc) symbol)) (file (geiser-edit--location-file loc)) - (line (geiser-edit--location-line loc))) + (line (geiser-edit--location-line loc)) + (col (geiser-edit--location-column loc))) (unless file (error "Couldn't find edit location for '%s'" symbol)) (unless (file-readable-p file) (error "Couldn't open '%s' for read" file)) (geiser-edit--visit-file file (or method geiser-edit-symbol-method)) - (geiser-edit--goto-line symbol line))) + (geiser-edit--goto-line symbol line) + (when col + (beginning-of-line) + (forward-char col)))) (defsubst geiser-edit--try-edit (symbol ret) (geiser-edit--try-edit-location symbol (geiser-eval--retort-result ret))) + +;;; Links + +(define-button-type 'geiser-edit--button + 'action 'geiser-edit--button-action + 'face 'geiser-font-lock-error-link + 'follow-link t) + +(defun geiser-edit--button-action (button) + (let ((loc (button-get button 'geiser-location))) + (when loc (geiser-edit--try-edit-location nil loc)))) + +(defun geiser-edit--make-link (beg end file line col) + (make-button beg end + :type 'geiser-edit--button + 'geiser-location + (geiser-edit--make-location 'error file line col) + 'help-echo "Go to error location")) + ;;; Commands: -- cgit v1.2.3 From 157aaf018dd876c00819d75fda7791fc244513be Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Wed, 17 Jun 2009 03:14:45 +0200 Subject: PLT: buttonize errors implemented. --- elisp/geiser-plt.el | 39 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 38 insertions(+), 1 deletion(-) diff --git a/elisp/geiser-plt.el b/elisp/geiser-plt.el index 44312b9..6c50c99 100644 --- a/elisp/geiser-plt.el +++ b/elisp/geiser-plt.el @@ -24,6 +24,8 @@ ;;; Code: +(require 'geiser-edit) +(require 'geiser-doc) (require 'geiser-eval) (require 'geiser-syntax) (require 'geiser-custom) @@ -121,12 +123,47 @@ This function uses `geiser-plt-init-file' if it exists." ;;; External help + (defun geiser-plt-external-help (symbol module) (message "Requesting help for '%s'..." symbol) - (geiser-eval--send/wait `(:eval (get-help ',symbol (:module ,module)) geiser/autodoc)) + (geiser-eval--send/wait + `(:eval (get-help ',symbol (:module ,module)) geiser/autodoc)) (minibuffer-message "%s done" (current-message)) t) + +;;; Error display + +(defconst geiser-plt--file-rx-0 "^\\([^:\n\"]+\\):\\([0-9]+\\):\\([0-9]+\\)") +(defconst geiser-plt--file-rx-1 "path:\"?\\([^>\"\n]+\\)\"?>") +(defconst geiser-plt--file-rx-2 "module: \"\\([^>\"\n]+\\)\"") + +(defun geiser-plt--find-files (rx) + (save-excursion + (while (re-search-forward rx nil t) + (geiser-edit--make-link (match-beginning 1) + (match-end 1) + (match-string 1) + (match-string 2) + (match-string 3))))) + +(defun geiser-plt-display-error (module key msg) + (insert "Error: ") + (when key (geiser-doc--insert-button key nil 'plt)) + (newline 2) + (when msg + (let ((p (point))) + (insert msg) + (let ((end (point))) + (goto-char p) + (geiser-plt--find-files geiser-plt--file-rx-0) + (geiser-plt--find-files geiser-plt--file-rx-1) + (geiser-plt--find-files geiser-plt--file-rx-2) + (goto-char end) + (fill-region p end) + (newline)))) + t) + ;;; Trying to ascertain whether a buffer is mzscheme scheme: -- cgit v1.2.3 From 59bacc785505fff98d0bc4b05ce9fa51464f832e Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Wed, 17 Jun 2009 03:25:44 +0200 Subject: Refactoring. --- elisp/geiser-plt.el | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/elisp/geiser-plt.el b/elisp/geiser-plt.el index 6c50c99..2fbfb22 100644 --- a/elisp/geiser-plt.el +++ b/elisp/geiser-plt.el @@ -134,9 +134,9 @@ This function uses `geiser-plt-init-file' if it exists." ;;; Error display -(defconst geiser-plt--file-rx-0 "^\\([^:\n\"]+\\):\\([0-9]+\\):\\([0-9]+\\)") -(defconst geiser-plt--file-rx-1 "path:\"?\\([^>\"\n]+\\)\"?>") -(defconst geiser-plt--file-rx-2 "module: \"\\([^>\"\n]+\\)\"") +(defconst geiser-plt--file-rxs '("^\\([^:\n\"]+\\):\\([0-9]+\\):\\([0-9]+\\)" + "path:\"?\\([^>\"\n]+\\)\"?>" + "module: \"\\([^>\"\n]+\\)\"")) (defun geiser-plt--find-files (rx) (save-excursion @@ -148,17 +148,16 @@ This function uses `geiser-plt-init-file' if it exists." (match-string 3))))) (defun geiser-plt-display-error (module key msg) - (insert "Error: ") - (when key (geiser-doc--insert-button key nil 'plt)) - (newline 2) + (when key + (insert "Error: ") + (geiser-doc--insert-button key nil 'plt) + (newline 2)) (when msg (let ((p (point))) (insert msg) (let ((end (point))) (goto-char p) - (geiser-plt--find-files geiser-plt--file-rx-0) - (geiser-plt--find-files geiser-plt--file-rx-1) - (geiser-plt--find-files geiser-plt--file-rx-2) + (mapc 'geiser-plt--find-files geiser-plt--file-rxs) (goto-char end) (fill-region p end) (newline)))) -- cgit v1.2.3 From a4f4968e22784e7f8114bcde712b385e7cb7d3ea Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Thu, 18 Jun 2009 04:51:07 +0200 Subject: Initialisation fixes. - Honouring geiser-impl-installed-implementations - Missing autoloads for customization groups added --- elisp/geiser.el | 25 +++++++++++-------------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/elisp/geiser.el b/elisp/geiser.el index 748fb23..42e8cc1 100644 --- a/elisp/geiser.el +++ b/elisp/geiser.el @@ -85,27 +85,23 @@ geiser-faces geiser-mode geiser-guile - geiser-plt)) + geiser-plt + geiser-impl + geiser-xref)) ;;; Scheme mode setup: -(defun geiser-setup-scheme-mode () - (eval-after-load "scheme" - '(add-hook 'scheme-mode-hook 'turn-on-geiser-mode))) - -(defun geiser-setup-implementations (impls) - (setq geiser-impl-installed-implementations (or impls '(guile plt)))) - (defsubst geiser-impl--impl-feature (impl) (intern (format "geiser-%s" impl))) -(defun geiser-setup (&rest impls) - (geiser-setup-implementations impls) - (geiser-setup-scheme-mode) +(defun geiser-setup () + (eval-after-load "scheme" + '(add-hook 'scheme-mode-hook 'turn-on-geiser-mode)) (mapc (lambda (impl) (require (geiser-impl--impl-feature impl) nil t)) - geiser-impl-installed-implementations)) + (or geiser-impl-installed-implementations + '(guile plt)))) ;;; Reload: @@ -152,6 +148,7 @@ loaded." geiser-root-dir)) geiser-root-dir)) (geiser-main-file (expand-file-name "elisp/geiser.el" dir)) + (installed-impls geiser-impl-installed-implementations) (impls (and (featurep 'geiser-impl) geiser-impl--impls)) (repls (and (featurep 'geiser-repl) (geiser-repl--repl-list))) (buffers (and (featurep 'geiser-mode) (geiser-mode--buffers)))) @@ -159,9 +156,9 @@ loaded." (error "%s does not contain Geiser!" dir)) (geiser-unload) (setq load-path (remove geiser-elisp-dir load-path)) + (setq geiser-impl-installed-implementations installed-impls) (load-file geiser-main-file) - (geiser-setup) - (dolist (feature (reverse (geiser--features-list))) + (dolist (feature (geiser--features-list)) (load-library (format "%s" feature))) (geiser-impl--reload-implementations impls) (geiser-repl--restore repls) -- cgit v1.2.3 From 222d885b124798234e5e736b25a24a87918db49b Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Thu, 18 Jun 2009 17:30:23 +0200 Subject: Will i ever get initialisation right? --- elisp/geiser-impl.el | 6 +++++- elisp/geiser.el | 19 +++---------------- 2 files changed, 8 insertions(+), 17 deletions(-) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index fadc8b6..ccb0584 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -105,6 +105,9 @@ (defsubst geiser-impl--fboundp (imp name) (fboundp (geiser-impl--sym imp name))) +(defsubst geiser-impl--impl-feature (impl) + (intern (format "geiser-%s" impl))) + (defun geiser-impl--value (imp name &optional fun) (let ((sym (geiser-impl--sym imp name))) (unless (or (and (not fun) (boundp sym)) @@ -221,7 +224,8 @@ implementation to be used by Geiser.")) ;;; Initialization: -(mapc 'geiser-impl--register geiser-impl-installed-implementations) +(mapc 'geiser-impl--register + (or geiser-impl-installed-implementations '(guile plt))) (provide 'geiser-impl) diff --git a/elisp/geiser.el b/elisp/geiser.el index 42e8cc1..1cc3c51 100644 --- a/elisp/geiser.el +++ b/elisp/geiser.el @@ -90,18 +90,10 @@ geiser-xref)) -;;; Scheme mode setup: +;;; Setup: -(defsubst geiser-impl--impl-feature (impl) - (intern (format "geiser-%s" impl))) - -(defun geiser-setup () - (eval-after-load "scheme" - '(add-hook 'scheme-mode-hook 'turn-on-geiser-mode)) - (mapc (lambda (impl) - (require (geiser-impl--impl-feature impl) nil t)) - (or geiser-impl-installed-implementations - '(guile plt)))) +(eval-after-load "scheme" + '(add-hook 'scheme-mode-hook 'turn-on-geiser-mode)) ;;; Reload: @@ -165,11 +157,6 @@ loaded." (geiser-mode--restore buffers) (message "Geiser reloaded!"))) - -;; Initialization: - -(geiser-setup) - (provide 'geiser) ;;; geiser.el ends here -- cgit v1.2.3 From b6723f8fe425bde252ef02936f8864e3bef3aa53 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Thu, 18 Jun 2009 17:41:18 +0200 Subject: PLT: Bug fix in implementation guessing. --- elisp/geiser-plt.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elisp/geiser-plt.el b/elisp/geiser-plt.el index 2fbfb22..b497d05 100644 --- a/elisp/geiser-plt.el +++ b/elisp/geiser-plt.el @@ -171,7 +171,7 @@ This function uses `geiser-plt-init-file' if it exists." (goto-char (point-min)) (re-search-forward "#lang " nil t)) (geiser-plt--explicit-module) - (string-equal (file-name-extension (buffer-file-name)) "ss"))) + (string-equal (file-name-extension (or (buffer-file-name) "")) "ss"))) (provide 'geiser-plt) -- cgit v1.2.3 From fee4491e73ff69a25a320be815a64daf18246ca8 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Fri, 19 Jun 2009 16:51:31 +0200 Subject: Directory-specific implementations. --- elisp/geiser-impl.el | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index ccb0584..236af27 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -46,6 +46,18 @@ :type '(repeat symbol) :group 'geiser-impl) +(defcustom geiser-impl-implementations-alist nil + "A map from regular expressions or directories to implementations. +When opening a new file, its full path will be matched against +each one of the regular expressions or directories in this map in order to +determine its scheme flavour." + :type '(repeat (list (choice (group :tag "Regular expression" + (const regexp) regexp) + (group :tag "Directory" + (const dir) directory)) + symbol)) + :group 'geiser-impl) + ;;; Registering implementations: @@ -200,10 +212,21 @@ "Set this buffer local variable to specify the Scheme implementation to be used by Geiser.")) +(defun geiser-impl--match-impl (desc bn) + (let ((rx (if (eq (car desc) 'regexp) + (cadr desc) + (format "^%s" (regexp-quote (cadr desc)))))) + (and rx (string-match-p rx bn)))) + (defun geiser-impl--guess () (or geiser-impl--implementation geiser-scheme-implementation (catch 'impl + (let ((bn (buffer-file-name))) + (when bn + (dolist (x geiser-impl-implementations-alist) + (when (geiser-impl--match-impl (car x) bn) + (throw 'impl (cadr x)))))) (dolist (impl geiser-impl--impls) (when (geiser-impl--call-if-bound impl "guess") (throw 'impl impl)))) -- cgit v1.2.3 From 9523b4db72dbb5a85f2dfb6c70262af77fd85575 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Fri, 19 Jun 2009 17:03:10 +0200 Subject: Better display of evaluation results. --- elisp/geiser-debug.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index 3bf262c..ec2e93e 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -90,7 +90,7 @@ (ret (geiser-eval--send/wait code)) (err (geiser-eval--retort-error ret))) (when and-go (funcall and-go)) - (when (not err) (message (format "=> %s" (geiser-eval--retort-result ret)))) + (when (not err) (message (format "=> %S" (geiser-eval--retort-result ret)))) (geiser-debug--display-retort str ret))) (defun geiser-debug--expand-region (start end all wrap) -- cgit v1.2.3 From 00dbf12a4326b911d9cc78378754e24000952d75 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Fri, 19 Jun 2009 17:03:30 +0200 Subject: Registered implementations are loaded by default. --- elisp/geiser-impl.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index 236af27..c148920 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -64,7 +64,8 @@ determine its scheme flavour." (defvar geiser-impl--impls nil) (defun geiser-impl--register (impl) - (add-to-list 'geiser-impl--impls impl)) + (when (require (geiser-impl--impl-feature impl) nil t) + (add-to-list 'geiser-impl--impls impl))) (defun geiser-impl--unregister (impl) (setq geiser-impl--impls (remove impl geiser-impl--impls))) -- cgit v1.2.3 From ac30982fe9cf0b9fdde1de4f7e86684a0f688db4 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Fri, 19 Jun 2009 17:26:16 +0200 Subject: User command to register scheme implementations (geiser-register-implementation). --- elisp/geiser-impl.el | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index c148920..58cd089 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -233,6 +233,21 @@ implementation to be used by Geiser.")) (throw 'impl impl)))) (geiser-impl--default-implementation))) + +;;; User commands + +(defun geiser-register-implementation () + "Register a new Scheme implementation." + (interactive) + (let ((current geiser-impl-installed-implementations) + (impl (geiser-impl--read-impl "New implementation: " nil t))) + (unless (geiser-impl--register impl) + (error "geiser-%s.el not found in load-path")) + (when (and (not (memq impl current)) + (y-or-n-p "Remember this implementation using customize? ")) + (customize-save-variable + 'geiser-impl-installed-implementations (cons impl current))))) + ;;; Unload support -- cgit v1.2.3 From 8b5fc88976f5cd037ed8304bade16a8118e67825 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Fri, 19 Jun 2009 17:27:31 +0200 Subject: Bug fix. --- elisp/geiser-impl.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index 58cd089..767a7cf 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -242,7 +242,7 @@ implementation to be used by Geiser.")) (let ((current geiser-impl-installed-implementations) (impl (geiser-impl--read-impl "New implementation: " nil t))) (unless (geiser-impl--register impl) - (error "geiser-%s.el not found in load-path")) + (error "geiser-%s.el not found in load-path" impl)) (when (and (not (memq impl current)) (y-or-n-p "Remember this implementation using customize? ")) (customize-save-variable -- cgit v1.2.3 From 737ef29d17b6d85732c6164f560949d75c5f4c77 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Fri, 19 Jun 2009 20:44:32 +0200 Subject: New user command to unregister Scheme implementations. --- elisp/geiser-impl.el | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index 767a7cf..4239f1e 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -68,7 +68,8 @@ determine its scheme flavour." (add-to-list 'geiser-impl--impls impl))) (defun geiser-impl--unregister (impl) - (setq geiser-impl--impls (remove impl geiser-impl--impls))) + (setq geiser-impl--impls (remove impl geiser-impl--impls)) + (ignore-errors (unload-feature (geiser-impl--impl-feature impl)))) (defvar geiser-impl--default-implementation geiser-impl-default-implementation) @@ -240,7 +241,7 @@ implementation to be used by Geiser.")) "Register a new Scheme implementation." (interactive) (let ((current geiser-impl-installed-implementations) - (impl (geiser-impl--read-impl "New implementation: " nil t))) + (impl (geiser-impl--read-impl "New Scheme implementation: " nil t))) (unless (geiser-impl--register impl) (error "geiser-%s.el not found in load-path" impl)) (when (and (not (memq impl current)) @@ -248,6 +249,17 @@ implementation to be used by Geiser.")) (customize-save-variable 'geiser-impl-installed-implementations (cons impl current))))) +(defun geiser-unregister-implementation () + "Unregister an installed Scheme implementation." + (interactive) + (let* ((current geiser-impl-installed-implementations) + (impl (geiser-impl--read-impl "Forget implementation: " current))) + (geiser-impl--unregister impl) + (when (and (impl current) + (y-or-n-p "Forget permanently using customize? ")) + (customize-save-variable + 'geiser-impl-installed-implementations (remove impl current))))) + ;;; Unload support -- cgit v1.2.3 From 5e9892d0cfbd25448ee106a8304b5b1ed528c121 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sat, 20 Jun 2009 09:56:59 +0200 Subject: Auxiliary function. --- elisp/geiser-impl.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index 4239f1e..cb5daa8 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -71,6 +71,9 @@ determine its scheme flavour." (setq geiser-impl--impls (remove impl geiser-impl--impls)) (ignore-errors (unload-feature (geiser-impl--impl-feature impl)))) +(defun geiser-impl--add-to-alist (kind what impl) + (add-to-list 'geiser-impl-implementations-alist (list (list kind what) impl))) + (defvar geiser-impl--default-implementation geiser-impl-default-implementation) -- cgit v1.2.3 From 7eae5fdf9d5841027701b2f1d555543b472109b7 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sat, 20 Jun 2009 22:04:19 +0200 Subject: REPL improvements: bailing out earlier on startup abort; C-c z DTRT for a running REPL. --- elisp/geiser-repl.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index da7dde7..38ebc6c 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -152,8 +152,10 @@ implementation name gets appended to it." (setq geiser-eval--default-proc-function 'geiser-repl--process) (defun geiser-repl--wait-for-prompt (timeout) - (let ((p (point)) (seen)) - (while (and (not seen) (> timeout 0)) + (let ((p (point)) (seen) (buffer (current-buffer))) + (while (and (not seen) + (> timeout 0) + (get-buffer-process buffer)) (sleep-for 0.1) (setq timeout (- timeout 100)) (goto-char p) @@ -176,7 +178,8 @@ implementation name gets appended to it." (interactive (list (or (geiser-repl--only-impl-p) (and (eq major-mode 'geiser-repl-mode) geiser-impl--implementation) - (geiser-repl--read-impl "Start Geiser for scheme implementation: ")))) + (geiser-repl--read-impl + "Start Geiser for scheme implementation: ")))) (geiser-repl--start-repl impl)) (defun switch-to-geiser (&optional ask impl) @@ -292,8 +295,8 @@ If no REPL is running, execute `run-geiser' to start a fresh one." (define-key geiser-repl-mode-map "\C-d" 'delete-char) -(define-key geiser-repl-mode-map "\C-cz" 'run-geiser) -(define-key geiser-repl-mode-map "\C-c\C-z" 'run-geiser) +(define-key geiser-repl-mode-map "\C-cz" 'switch-to-geiser) +(define-key geiser-repl-mode-map "\C-c\C-z" 'switch-to-geiser) (define-key geiser-repl-mode-map "\C-a" 'geiser-repl--bol) (define-key geiser-repl-mode-map (kbd "") 'geiser-repl--bol) (define-key geiser-repl-mode-map "\C-ca" 'geiser-autodoc-mode) -- cgit v1.2.3 From b0e3391ace36cf2bb111ed0c56883dd1e0cb4117 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 28 Jun 2009 21:47:49 +0200 Subject: Bug fix: initialisation loop removed. --- elisp/geiser-impl.el | 13 ++++++++----- elisp/geiser-repl.el | 7 ++++--- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index cb5daa8..32acade 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -64,7 +64,8 @@ determine its scheme flavour." (defvar geiser-impl--impls nil) (defun geiser-impl--register (impl) - (when (require (geiser-impl--impl-feature impl) nil t) + (when (and (not (memq impl geiser-impl--impls)) + (require (geiser-impl--impl-feature impl) nil t)) (add-to-list 'geiser-impl--impls impl))) (defun geiser-impl--unregister (impl) @@ -275,12 +276,14 @@ implementation to be used by Geiser.")) (dolist (impl impls) (load-library (format "geiser-%s" impl)))) + +(provide 'geiser-impl) + ;;; Initialization: -(mapc 'geiser-impl--register - (or geiser-impl-installed-implementations '(guile plt))) +(eval-after-load 'geiser-impl + '(mapc 'geiser-impl--register + (or geiser-impl-installed-implementations '(guile plt)))) - -(provide 'geiser-impl) ;;; geiser-impl.el ends here diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index 38ebc6c..f1719e8 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -141,8 +141,8 @@ implementation name gets appended to it." (geiser-repl--history-setup) (geiser-con--setup-connection (current-buffer) prompt-rx) (add-to-list 'geiser-repl--repls (current-buffer)) - (geiser-impl--startup impl) - (geiser-repl--set-this-buffer-repl (current-buffer)))) + (geiser-repl--set-this-buffer-repl (current-buffer)) + (geiser-impl--startup impl))) (defun geiser-repl--process () (let ((buffer (geiser-repl--get-repl geiser-impl--implementation))) @@ -257,7 +257,8 @@ If no REPL is running, execute `run-geiser' to start a fresh one." (set (make-local-variable 'comint-input-filter) 'geiser-repl--input-filter) (add-hook 'kill-buffer-hook 'geiser-repl--on-kill nil t) (comint-read-input-ring t) - (set-process-sentinel (get-buffer-process (current-buffer)) 'geiser-repl--sentinel)) + (set-process-sentinel (get-buffer-process (current-buffer)) + 'geiser-repl--sentinel)) ;;; geiser-repl mode: -- cgit v1.2.3 From e01166f7d2f3551596a04474a76f4811fc841edc Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 29 Jun 2009 00:08:44 +0200 Subject: Safer handling of file line and columns in emacs. --- elisp/geiser-edit.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el index 62b8a53..723e898 100644 --- a/elisp/geiser-edit.el +++ b/elisp/geiser-edit.el @@ -64,11 +64,15 @@ or following links in error buffers.") (defsubst geiser-edit--location-file (loc) (cdr (assoc 'file loc))) +(defsubst geiser-edit--to-number (x) + (cond ((numberp x) x) + ((stringp x) (string-to-number x)))) + (defsubst geiser-edit--location-line (loc) - (cdr (assoc 'line loc))) + (geiser-edit--to-number (cdr (assoc 'line loc)))) (defsubst geiser-edit--location-column (loc) - (cdr (assoc 'column loc))) + (geiser-edit--to-number (cdr (assoc 'column loc)))) (defsubst geiser-edit--make-location (name file line column) `((name . ,name) (file . ,file) (line . ,line) (column . ,column))) -- cgit v1.2.3 From bdd12279d05fd5451b186d2da9f1a864f1d1a0f9 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Thu, 2 Jul 2009 05:29:04 +0200 Subject: Simpler, nicer, more efficient handling of evaluation results. It comes with a pony too. --- elisp/geiser-connection.el | 1 - elisp/geiser-debug.el | 10 +++++++--- elisp/geiser-eval.el | 9 ++++++++- elisp/geiser-syntax.el | 10 ---------- 4 files changed, 15 insertions(+), 15 deletions(-) diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index 0ec6405..4f8592b 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -165,7 +165,6 @@ (goto-char (point-min)) (re-search-forward "((\\(result\\|error\\)\\>") (goto-char (match-beginning 0)) - (geiser-syntax--prepare-scheme-for-elisp-reader) (let ((form (read (current-buffer)))) (if (listp form) form (error)))) (error `((error (key . geiser-con-error)) diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index ec2e93e..6d795df 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -59,7 +59,7 @@ ;;; Displaying retorts -(defun geiser-debug--display-retort (what ret) +(defun geiser-debug--display-retort (what ret &optional res) (let* ((err (geiser-eval--retort-error ret)) (key (geiser-eval--error-key err)) (output (geiser-eval--retort-output ret)) @@ -69,6 +69,9 @@ (erase-buffer) (insert what) (newline 2) + (when res + (insert res) + (newline 2)) (unless (geiser-impl--display-error impl module key output) (when err (insert (geiser-eval--error-str err) "\n\n")) (when output (insert output "\n\n"))) @@ -88,10 +91,11 @@ (wrapped (if wrap (geiser-debug--wrap-region str) str)) (code `(,(if compile :comp :eval) (:scm ,wrapped))) (ret (geiser-eval--send/wait code)) + (res (geiser-eval--retort-result-str ret)) (err (geiser-eval--retort-error ret))) (when and-go (funcall and-go)) - (when (not err) (message (format "=> %S" (geiser-eval--retort-result ret)))) - (geiser-debug--display-retort str ret))) + (when (not err) (message "%s" res)) + (geiser-debug--display-retort str ret res))) (defun geiser-debug--expand-region (start end all wrap) (let* ((str (buffer-substring-no-properties start end)) diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 90be67c..428d057 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -145,7 +145,14 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) (defun geiser-eval--retort-result (ret) (let ((values (cdr (assoc 'result ret)))) - (if (> (length values) 1) (cons :values values) (car values)))) + (and (stringp (car values)) + (ignore-errors (car (read-from-string (car values))))))) + +(defun geiser-eval--retort-result-str (ret) + (let ((values (cdr (assoc 'result ret)))) + (if values + (concat "=> " (mapconcat 'identity values "\n=> ")) + "(No value)")))) (defsubst geiser-eval--retort-output (ret) (cdr (assoc 'output ret))) (defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret))) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index c70aacb..db1c842 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -84,16 +84,6 @@ (geiser-popup--define syntax " *geiser syntax analyst*" scheme-mode) -(defun geiser-syntax--prepare-scheme-for-elisp-reader () - (let ((end (save-excursion - (goto-char (point-max)) - (and (re-search-backward "(output \\. \"" nil t) - (point))))) - (save-excursion - (while (re-search-forward "#(" end t) (replace-match "(vector ")) - (goto-char (point-min)) - (while (re-search-forward "#" end t) (replace-match "\\\\#"))))) - (defsubst geiser-syntax--del-sexp (arg) (let ((p (point))) (forward-sexp arg) -- cgit v1.2.3 From 1a3d29079c07ee9288fc9ffcadc9ad101f1a019a Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 6 Jul 2009 23:47:00 +0200 Subject: Stray paren killed. --- elisp/geiser-eval.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 428d057..3e0d0d9 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -152,7 +152,7 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) (let ((values (cdr (assoc 'result ret)))) (if values (concat "=> " (mapconcat 'identity values "\n=> ")) - "(No value)")))) + "(No value)"))) (defsubst geiser-eval--retort-output (ret) (cdr (assoc 'output ret))) (defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret))) -- cgit v1.2.3 From c882e02981f805df197dcaef3a14147e5ef815c7 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Fri, 7 Aug 2009 00:11:52 +0200 Subject: kludgy fix for opt/key/rest markers in autodoc --- elisp/geiser-autodoc.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index f6d36a8..0449032 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -97,10 +97,10 @@ when `geiser-autodoc-display-module-p' is on." (defun geiser-autodoc--insert-arg (arg current pos) (let ((p (point)) - (str (format "%s" (if (eq arg '\#:rest) "." arg))) - (face (cond ((eq '\#:opt arg) + (str (format "%s" (if (eq arg 'geiser-rest_marker) "." arg))) + (face (cond ((eq 'geiser-opt_marker arg) 'geiser-font-lock-autodoc-optional-arg-marker) - ((eq '\#:key arg) + ((eq 'geiser-key_marker arg) 'geiser-font-lock-autodoc-key-arg-marker) ((= current pos) 'geiser-font-lock-autodoc-current-arg) -- cgit v1.2.3 From ded319e99f9c15a1384e5afee6329509a134117d Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 11 Aug 2009 15:44:54 +0200 Subject: autodoc: better emacs display for opt/key markers. --- elisp/geiser-autodoc.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index 0449032..1225f87 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -97,7 +97,10 @@ when `geiser-autodoc-display-module-p' is on." (defun geiser-autodoc--insert-arg (arg current pos) (let ((p (point)) - (str (format "%s" (if (eq arg 'geiser-rest_marker) "." arg))) + (str (format "%s" (cond ((eq arg 'geiser-rest_marker) ".") + ((eq arg 'geiser-opt_marker) "#:opt") + ((eq arg 'geiser-key_marker) "#:key") + (t arg)))) (face (cond ((eq 'geiser-opt_marker arg) 'geiser-font-lock-autodoc-optional-arg-marker) ((eq 'geiser-key_marker arg) -- cgit v1.2.3 From f4b4ba80ce66f7ae21d436103b6bc8262d211305 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 17 Aug 2009 04:18:02 +0200 Subject: Simpler, more correct and efficient autodoc implementation. Not that it was difficult: it's replacing an ugly kludge. --- elisp/geiser-autodoc.el | 148 ++++++++++++++++++++++++------------------------ elisp/geiser-syntax.el | 27 +++++++++ 2 files changed, 102 insertions(+), 73 deletions(-) diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index 1225f87..16ca9ac 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -46,14 +46,6 @@ 'font-lock-function-name-face geiser-autodoc "highlighting procedure name in autodoc messages") -(geiser-custom--defface autodoc-optional-arg-marker - 'font-lock-keyword-face - geiser-autodoc "highlighting #:opt marker in autodoc messages") - -(geiser-custom--defface autodoc-key-arg-marker - 'font-lock-keyword-face - geiser-autodoc "highlighting #:key marker in autodoc messages") - (defcustom geiser-autodoc-delay 0.3 "Delay before autodoc messages are fetched and displayed, in seconds." :type 'number @@ -74,82 +66,92 @@ when `geiser-autodoc-display-module-p' is on." ;;; Procedure arguments: (make-variable-buffer-local - (defvar geiser-autodoc--last nil)) - -(make-variable-buffer-local - (defvar geiser-autodoc--last-result nil)) - -(defun geiser-autodoc--function-args (form) - (if (equal (car geiser-autodoc--last) form) (cdr geiser-autodoc--last) - (when form - (let ((res (geiser-eval--send/result - `(:eval ((:ge autodoc) (quote (:scm ,form)))) - 500))) - (when (and res (listp res)) - (unless (equalp res geiser-autodoc--last-result) - (setq geiser-autodoc--last-result res) - (setq geiser-autodoc--last - (cons form - (geiser-autodoc--str (cdr (assoc 'signature res)) - (or (cdr (assoc 'position res)) 0) - (cdr (assoc 'module res)))))) - (cdr geiser-autodoc--last)))))) - -(defun geiser-autodoc--insert-arg (arg current pos) - (let ((p (point)) - (str (format "%s" (cond ((eq arg 'geiser-rest_marker) ".") - ((eq arg 'geiser-opt_marker) "#:opt") - ((eq arg 'geiser-key_marker) "#:key") - (t arg)))) - (face (cond ((eq 'geiser-opt_marker arg) - 'geiser-font-lock-autodoc-optional-arg-marker) - ((eq 'geiser-key_marker arg) - 'geiser-font-lock-autodoc-key-arg-marker) - ((= current pos) - 'geiser-font-lock-autodoc-current-arg) - (t nil)))) - (insert str) - (when (listp arg) - (save-excursion - (replace-regexp "(quote \\(.*\\))" "'\\1" nil p (point)) - (replace-string "nil" "()" t p (point)))) - (when face (put-text-property p (point) 'face face)))) + (defvar geiser-autodoc--cached-signatures nil)) + +(defun geiser-autodoc--get-signatures (funs) + (when funs + (let ((missing) (cached)) + (if (not geiser-autodoc--cached-signatures) + (setq missing funs) + (dolist (f funs) + (let ((cf (assq f geiser-autodoc--cached-signatures))) + (if cf (push cf cached) + (push f missing))))) + (unless cached + (setq geiser-autodoc--cached-signatures nil)) + (if (not missing) + geiser-autodoc--cached-signatures + (let ((res (geiser-eval--send/result `(:eval ((:ge autodoc) + (quote ,missing))) + 500))) + (when res + (setq geiser-autodoc--cached-signatures (append cached res)))))))) + +(defun geiser-autodoc--insert-args (args current &optional pos) + (dolist (a args) + (let ((p (point))) + (insert (format "%s" a)) + (when (or (and (numberp pos) + (numberp current) + (setq current (1+ current)) + (= (1+ pos) current)) + (and (symbolp current) + (listp a) + (eq current (car a)))) + (put-text-property p (point) 'face 'geiser-font-lock-autodoc-current-arg) + (setq pos nil current nil))) + (insert " ")) + (when args (backward-char)) + current) (defsubst geiser-autodoc--proc-name (proc module) (let ((str (if module (format geiser-autodoc-procedure-name-format module proc) proc))) - (put-text-property 0 (length str) - 'face 'geiser-font-lock-autodoc-procedure-name - str) - str)) - -(defun geiser-autodoc--str (signature pos module) - (when (consp signature) - (let* ((proc (car signature)) - (args (cdr signature)) - (len (if (listp args) (length args) 0)) - (current 1) - (pos (if (> pos len) len pos))) - (if (eq args 'variable) - (geiser-autodoc--proc-name proc module) - (save-current-buffer - (set-buffer (geiser-syntax--font-lock-buffer)) - (erase-buffer) - (insert (format "(%s" (geiser-autodoc--proc-name proc module))) - (dolist (a args) - (insert " ") - (geiser-autodoc--insert-arg a current pos) - (setq current (1+ current))) - (insert ")") - (buffer-string)))))) + (propertize str 'face 'geiser-font-lock-autodoc-procedure-name))) + +(defun geiser-autodoc--str (proc desc signature) + ;; (message "composing %s with desc %s and signature %s" proc desc signature) + (let ((cpos 1) + (pos (second desc)) + (prev (third desc)) + (module (cdr (assoc 'module signature))) + (reqs (cdr (assoc 'required signature))) + (opts (cdr (assoc 'optional signature))) + (keys (cdr (assoc 'key signature)))) + (save-current-buffer + (set-buffer (geiser-syntax--font-lock-buffer)) + (erase-buffer) + (insert (format "(%s " (geiser-autodoc--proc-name proc module))) + (setq cpos + (geiser-autodoc--insert-args reqs cpos (and (not (zerop pos)) pos))) + (when opts + (insert " [") + (setq cpos (geiser-autodoc--insert-args opts cpos pos)) + (when keys + (insert " [") + (geiser-autodoc--insert-args keys prev nil) + (insert "]")) + (insert "]")) + (insert ")") + (buffer-string)))) + +(defun geiser-autodoc--autodoc (path) + (let* ((funs (nreverse (mapcar 'car path))) + (signs (geiser-autodoc--get-signatures funs))) + (when signs + (catch 'signature + (dolist (f funs) + (let ((signature (cdr (assq f signs)))) + (when signature + (throw 'signature (geiser-autodoc--str f (assq f path) signature))))))))) ;;; Autodoc function: (defun geiser-autodoc--eldoc-function () (condition-case e - (geiser-autodoc--function-args (geiser-syntax--get-partial-sexp)) + (geiser-autodoc--autodoc (geiser-syntax--scan-sexps)) (error (format "Autodoc not available (%s)" (error-message-string e))))) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index db1c842..475a556 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -94,6 +94,33 @@ (defsubst geiser-syntax--beginning-of-form () (memq (char-after (point)) '(?\" ?\())) +(defun geiser-syntax--scan-sexp () + (let ((p (point)) + (n -1) + prev + head) + (ignore-errors + (backward-up-list) + (save-excursion + (forward-char) + (skip-syntax-forward "^_w" p) + (when (setq head (symbol-at-point)) + (while (< (point) p) + (setq n (1+ n)) + (setq prev (symbol-at-point)) + (forward-sexp)))) + (if head (list head n prev) 'skip)))) + +(defun geiser-syntax--scan-sexps () + (save-excursion + (goto-char (or (nth 8 (syntax-ppss)) (point))) + (let* ((sap (symbol-at-point)) + (path (and sap `((,sap 0)))) + s) + (while (setq s (geiser-syntax--scan-sexp)) + (when (listp s) (push s path))) + path))) + (defun geiser-syntax--complete-partial-sexp (buffer begin end) (geiser-syntax--with-buffer (erase-buffer) -- cgit v1.2.3 From 0377f2e81a24640a7ab8aaef7d36fe31cb13ce71 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 17 Aug 2009 16:23:45 +0200 Subject: Well, i said that it was better, not that it was perfect. Autodoc buglets and support for displaying module variables too. --- elisp/geiser-autodoc.el | 54 ++++++++++++++++++++++++------------------------- elisp/geiser-doc.el | 5 ++++- elisp/geiser-syntax.el | 20 +++++++++--------- 3 files changed, 42 insertions(+), 37 deletions(-) diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index 16ca9ac..1d876dd 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -79,8 +79,7 @@ when `geiser-autodoc-display-module-p' is on." (push f missing))))) (unless cached (setq geiser-autodoc--cached-signatures nil)) - (if (not missing) - geiser-autodoc--cached-signatures + (if (not missing) geiser-autodoc--cached-signatures (let ((res (geiser-eval--send/result `(:eval ((:ge autodoc) (quote ,missing))) 500))) @@ -111,33 +110,34 @@ when `geiser-autodoc-display-module-p' is on." (propertize str 'face 'geiser-font-lock-autodoc-procedure-name))) (defun geiser-autodoc--str (proc desc signature) - ;; (message "composing %s with desc %s and signature %s" proc desc signature) - (let ((cpos 1) - (pos (second desc)) - (prev (third desc)) - (module (cdr (assoc 'module signature))) - (reqs (cdr (assoc 'required signature))) - (opts (cdr (assoc 'optional signature))) - (keys (cdr (assoc 'key signature)))) - (save-current-buffer - (set-buffer (geiser-syntax--font-lock-buffer)) - (erase-buffer) - (insert (format "(%s " (geiser-autodoc--proc-name proc module))) - (setq cpos - (geiser-autodoc--insert-args reqs cpos (and (not (zerop pos)) pos))) - (when opts - (insert " [") - (setq cpos (geiser-autodoc--insert-args opts cpos pos)) - (when keys - (insert " [") - (geiser-autodoc--insert-args keys prev nil) - (insert "]")) - (insert "]")) - (insert ")") - (buffer-string)))) + (let ((args (cdr (assoc 'args signature))) + (module (cdr (assoc 'module signature)))) + (if (not args) (geiser-autodoc--proc-name proc module) + (let ((cpos 1) + (pos (or (second desc) 0)) + (prev (third desc)) + (reqs (cdr (assoc 'required args))) + (opts (cdr (assoc 'optional args))) + (keys (cdr (assoc 'key args)))) + (save-current-buffer + (set-buffer (geiser-syntax--font-lock-buffer)) + (erase-buffer) + (insert (format "(%s " (geiser-autodoc--proc-name proc module))) + (setq cpos + (geiser-autodoc--insert-args reqs cpos (and (not (zerop pos)) pos))) + (when opts + (insert " [") + (setq cpos (geiser-autodoc--insert-args opts cpos pos)) + (when keys + (insert " [") + (geiser-autodoc--insert-args keys prev nil) + (insert "]")) + (insert "]")) + (insert ")") + (buffer-string)))))) (defun geiser-autodoc--autodoc (path) - (let* ((funs (nreverse (mapcar 'car path))) + (let* ((funs (mapcar 'car path)) (signs (geiser-autodoc--get-signatures funs))) (when signs (catch 'signature diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el index adef4c6..61c50f5 100644 --- a/elisp/geiser-doc.el +++ b/elisp/geiser-doc.el @@ -26,6 +26,7 @@ (require 'geiser-impl) (require 'geiser-completion) +(require 'geiser-autodoc) (require 'geiser-eval) (require 'geiser-syntax) (require 'geiser-popup) @@ -174,7 +175,9 @@ (message "No documentation available for '%s'" symbol) (geiser-doc--with-buffer (erase-buffer) - (geiser-doc--insert-title (cdr (assoc 'signature ds))) + (geiser-doc--insert-title (geiser-autodoc--str (format "%s" symbol) + nil + (cdr (assoc 'signature ds)))) (newline) (insert (or (cdr (assoc 'docstring ds)) "")) (goto-line (point-min)) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index 475a556..6cadf61 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -97,29 +97,31 @@ (defun geiser-syntax--scan-sexp () (let ((p (point)) (n -1) - prev - head) + prev head) (ignore-errors (backward-up-list) (save-excursion (forward-char) - (skip-syntax-forward "^_w" p) + (skip-syntax-forward "^_w(" p) (when (setq head (symbol-at-point)) (while (< (point) p) (setq n (1+ n)) (setq prev (symbol-at-point)) (forward-sexp)))) - (if head (list head n prev) 'skip)))) + (if head (list head n (and (> n 1) prev)) 'skip)))) (defun geiser-syntax--scan-sexps () (save-excursion (goto-char (or (nth 8 (syntax-ppss)) (point))) (let* ((sap (symbol-at-point)) - (path (and sap `((,sap 0)))) - s) - (while (setq s (geiser-syntax--scan-sexp)) - (when (listp s) (push s path))) - path))) + (fst (and sap (geiser-syntax--scan-sexp))) + (path (and fst + (cond ((not (listp fst)) `((,sap 0))) + ((eq sap (car fst)) (list fst)) + (t (list fst (list sap 0))))))) + (while (setq fst (geiser-syntax--scan-sexp)) + (when (listp fst) (push fst path))) + (nreverse path)))) (defun geiser-syntax--complete-partial-sexp (buffer begin end) (geiser-syntax--with-buffer -- cgit v1.2.3 From 5c7b3550e46cb6b29a65a77b656f89523ba3fc18 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 18 Aug 2009 06:16:57 +0200 Subject: Yet another deklugdification: locals scanning moved to elisp. ... and say goodbye to the ugly parse partial sexp, reducing not only sloppy code, but also duplication and data transfers. --- elisp/geiser-completion.el | 5 +-- elisp/geiser-syntax.el | 101 ++++++++++++++++++++++++--------------------- 2 files changed, 55 insertions(+), 51 deletions(-) diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el index 799280e..28aef12 100644 --- a/elisp/geiser-completion.el +++ b/elisp/geiser-completion.el @@ -148,9 +148,8 @@ terminates a current completion." (defsubst geiser-completion--symbol-list (prefix) (delete-duplicates - (geiser-eval--send/result - `(:eval ((:ge completions) ,prefix - (quote (:scm ,(or (geiser-syntax--get-partial-sexp) "()")))))) + (append (mapcar (lambda (s) (format "%s" s)) (geiser-syntax--locals-around-point)) + (geiser-eval--send/result `(:eval ((:ge completions) ,prefix)))) :test 'string=)) (defsubst geiser-completion--module-list (prefix) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index 6cadf61..6af04a1 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -84,15 +84,11 @@ (geiser-popup--define syntax " *geiser syntax analyst*" scheme-mode) -(defsubst geiser-syntax--del-sexp (arg) - (let ((p (point))) - (forward-sexp arg) - (delete-region p (point)))) +(defsubst geiser-syntax--skip-comment/string () + (goto-char (or (nth 8 (syntax-ppss)) (point)))) -(defconst geiser-syntax--placeholder (format "___%s___" (random 100))) - -(defsubst geiser-syntax--beginning-of-form () - (memq (char-after (point)) '(?\" ?\())) +(defsubst geiser-syntax--nesting-level () + (or (nth 0 (syntax-ppss)) 0)) (defun geiser-syntax--scan-sexp () (let ((p (point)) @@ -112,7 +108,7 @@ (defun geiser-syntax--scan-sexps () (save-excursion - (goto-char (or (nth 8 (syntax-ppss)) (point))) + (geiser-syntax--skip-comment/string) (let* ((sap (symbol-at-point)) (fst (and sap (geiser-syntax--scan-sexp))) (path (and fst @@ -123,46 +119,55 @@ (when (listp fst) (push fst path))) (nreverse path)))) -(defun geiser-syntax--complete-partial-sexp (buffer begin end) - (geiser-syntax--with-buffer - (erase-buffer) - (insert-buffer-substring-no-properties buffer begin end) - (when (not (geiser-syntax--beginning-of-form)) - (skip-syntax-backward "-<>") - (delete-region (point) (point-max))) - (let ((p (nth 8 (syntax-ppss)))) - (when p ;; inside a comment or string - (delete-region p (point-max)) - (insert geiser-syntax--placeholder))) - (when (cond ((eq (char-after (1- (point))) ?\)) - (geiser-syntax--del-sexp -1) t) - ((geiser-syntax--beginning-of-form) - (delete-region (point) (point-max)) t) - ((memq (char-after (1- (point))) (list ?. ?@ ?, ?\' ?\` ?\# ?\\)) - (skip-syntax-backward "^-(") - (delete-region (point) (point-max)) - t)) - (insert geiser-syntax--placeholder)) +(defun geiser-syntax--read-list (p) + (let ((list (ignore-errors (read (current-buffer))))) + (if (and list (< (point) p)) + list + (goto-char p) + nil))) + +(defconst geiser-syntax--delim-regexp "\\(?:[\s-\s<\s>$\n]+\\)") + +(defconst geiser-syntax--ident-regexp + (format "\\(?:%s\\([^ (]+?\\)\\)" geiser-syntax--delim-regexp)) + +(defconst geiser-syntax--let-regexp + (format "\\=(let\\(?:\\*\\|rec\\|%s\\|%s\\)%s*(" + geiser-syntax--ident-regexp + geiser-syntax--delim-regexp + geiser-syntax--delim-regexp)) + +(defconst geiser-syntax--ldefine-regexp + (format "\\=(define%s%s" geiser-syntax--ident-regexp geiser-syntax--delim-regexp)) + +(defconst geiser-syntax--define-regexp + (format "\\=(\\(?:define\\|lambda\\)%s(" geiser-syntax--delim-regexp)) + +(defun geiser-syntax--locals-around-point () + (when (eq major-mode 'scheme-mode) (save-excursion - (goto-char (point-min)) - (while (re-search-forward "[.@,'`#\\\\]" nil t) - (replace-match "" nil nil)) - (goto-char (point-min)) - (while (re-search-forward "\\[" nil t) - (replace-match "(" nil nil)) - (goto-char (point-min)) - (while (re-search-forward "\\]" nil t) - (replace-match ")" nil nil))) - (let ((depth (nth 0 (parse-partial-sexp (point-min) (point))))) - (unless (zerop depth) (insert (make-string depth ?\))))) - (when (< (point-min) (point)) (buffer-substring (point-min) (point))))) - -(defsubst geiser-syntax--get-partial-sexp () - (unless (zerop (nth 0 (syntax-ppss))) - (let* ((end (if (geiser-syntax--beginning-of-form) (1+ (point)) - (save-excursion (skip-syntax-forward "^-\"<>()") (point)))) - (begin (save-excursion (beginning-of-defun) (point)))) - (geiser-syntax--complete-partial-sexp (current-buffer) begin end)))) + (geiser-syntax--skip-comment/string) + (let ((ids)) + (while (not (zerop (geiser-syntax--nesting-level))) + (let ((p (point))) + (backward-up-list) + (save-excursion + (while (< (point) p) + (cond ((re-search-forward geiser-syntax--let-regexp p t) + (when (match-string 1) (push (intern (match-string 1)) ids)) + (backward-char 1) + (dolist (l (nreverse (geiser-syntax--read-list p))) + (when (and (listp l) (symbolp (car l))) + (push (car l) ids)))) + ((re-search-forward geiser-syntax--ldefine-regexp p t) + (when (match-string 1) (push (intern (match-string 1)) ids))) + ((re-search-forward geiser-syntax--define-regexp p t) + (backward-char 1) + (dolist (s (nreverse (geiser-syntax--read-list p))) + (let ((sn (if (listp s) (car s) s))) + (when (symbolp sn) (push sn ids))))) + (t (goto-char (1+ p)))))))) + (nreverse ids))))) ;;; Fontify strings as Scheme code: -- cgit v1.2.3 From 718078f1e4314b45c7b78d06b891720aab2822cb Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 18 Aug 2009 23:46:05 +0200 Subject: PLT: bug fix in (module) recognition. --- elisp/geiser-plt.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elisp/geiser-plt.el b/elisp/geiser-plt.el index b497d05..8810250 100644 --- a/elisp/geiser-plt.el +++ b/elisp/geiser-plt.el @@ -111,7 +111,7 @@ This function uses `geiser-plt-init-file' if it exists." :f))) (defun geiser-plt-get-module (&optional module) - (cond ((and (null module) (geiser-plt--explicit-module))) + (cond ((and (null module) (buffer-file-name))) ;; (geiser-plt--explicit-module) ((null module) (geiser-plt--implicit-module)) ((symbolp module) module) ((and (stringp module) (file-name-absolute-p module)) module) -- cgit v1.2.3 From a9699340d3dbb641fac7a2e29153b63f6f2a6ed5 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 18 Aug 2009 23:46:31 +0200 Subject: REPLs: using compile-shell-minor-mode. --- elisp/geiser-repl.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index f1719e8..8eb1fc9 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -292,7 +292,8 @@ If no REPL is running, execute `run-geiser' to start a fresh one." 'geiser-repl--beginning-of-defun) (set-syntax-table scheme-mode-syntax-table) (setq geiser-eval--get-module-function 'geiser-repl--module-function) - (when geiser-repl-autodoc-p (geiser-autodoc-mode 1))) + (when geiser-repl-autodoc-p (geiser-autodoc-mode 1)) + (compilation-shell-minor-mode 1)) (define-key geiser-repl-mode-map "\C-d" 'delete-char) -- cgit v1.2.3 From ceb34c77c231876d9383dcbacff00584914aa8dd Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Wed, 19 Aug 2009 23:44:54 +0200 Subject: C-c k == nuke repl --- README | 37 ++++++++++++++++++------------------- elisp/geiser-repl.el | 4 +++- 2 files changed, 21 insertions(+), 20 deletions(-) diff --git a/README b/README index 626bed9..141b83d 100644 --- a/README +++ b/README @@ -22,9 +22,7 @@ Currently supported implementations are Guile and PLT. - - Guile works only with the development, vm-based binary. Be sure - to customize `geiser-repl-guile-binary' to point to a correct vm - binary. + - Guile 1.9.x virtual machine required. - PLT Scheme 4.1.5.5 or better required. * Installation @@ -94,22 +92,23 @@ *** In the REPL - |----------------+-------------------------------------------| - | C-c C-z, C-c z | Start Scheme REPL (if it's not running) | - |----------------+-------------------------------------------| - | M-. | Edit identifier at point | - | TAB, M-TAB | Complete identifier at point | - | M-`, C-. | Complete module name at point | - |----------------+-------------------------------------------| - | M-p, M-n | Prompt history, matching current prefix | - |----------------+-------------------------------------------| - | C-c k | Compile and load scheme file | - | C-c l | Load scheme file | - |----------------+-------------------------------------------| - | C-c d | See documentation for identifier at point | - | C-c m | See module documentation | - | C-c a | Toggle autodoc mode | - |----------------+-------------------------------------------| + |----------------+----------------------------------------------------| + | C-c C-z, C-c z | Start Scheme REPL (if it's not running) | + |----------------+----------------------------------------------------| + | M-. | Edit identifier at point | + | TAB, M-TAB | Complete identifier at point | + | M-`, C-. | Complete module name at point | + |----------------+----------------------------------------------------| + | M-p, M-n | Prompt history, matching current prefix | + |----------------+----------------------------------------------------| + | C-c C-k, C-c k | Nuke REPL: use it if the REPL becomes unresponsive | + |----------------+----------------------------------------------------| + | C-c l | Load scheme file | + |----------------+----------------------------------------------------| + | C-c d | See documentation for identifier at point | + | C-c m | See module documentation | + | C-c a | Toggle autodoc mode | + |----------------+----------------------------------------------------| *** In the documentation browser: diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index 8eb1fc9..bed653f 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -297,6 +297,9 @@ If no REPL is running, execute `run-geiser' to start a fresh one." (define-key geiser-repl-mode-map "\C-d" 'delete-char) +(define-key geiser-repl-mode-map "\C-ck" 'geiser-repl-nuke) +(define-key geiser-repl-mode-map "\C-c\C-k" 'geiser-repl-nuke) + (define-key geiser-repl-mode-map "\C-cz" 'switch-to-geiser) (define-key geiser-repl-mode-map "\C-c\C-z" 'switch-to-geiser) (define-key geiser-repl-mode-map "\C-a" 'geiser-repl--bol) @@ -304,7 +307,6 @@ If no REPL is running, execute `run-geiser' to start a fresh one." (define-key geiser-repl-mode-map "\C-ca" 'geiser-autodoc-mode) (define-key geiser-repl-mode-map "\C-cd" 'geiser-doc-symbol-at-point) (define-key geiser-repl-mode-map "\C-cm" 'geiser-repl--doc-module) -(define-key geiser-repl-mode-map "\C-ck" 'geiser-compile-file) (define-key geiser-repl-mode-map "\C-cl" 'geiser-load-file) (define-key geiser-repl-mode-map "\M-p" 'comint-previous-matching-input-from-input) -- cgit v1.2.3 From 9187b776fdfbb73e0ea6ebe1d203ed2c838fbdbd Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Thu, 20 Aug 2009 02:58:01 +0200 Subject: Bug fix: bogus regexp. --- elisp/geiser-syntax.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index 6af04a1..38bb76c 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -126,7 +126,7 @@ (goto-char p) nil))) -(defconst geiser-syntax--delim-regexp "\\(?:[\s-\s<\s>$\n]+\\)") +(defconst geiser-syntax--delim-regexp "\\(?:[\\s-\\s<\\s>$\n]+\\)") (defconst geiser-syntax--ident-regexp (format "\\(?:%s\\([^ (]+?\\)\\)" geiser-syntax--delim-regexp)) -- cgit v1.2.3 From c59998e52dec584d17542059c93692cfbd731bbe Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 23 Aug 2009 02:58:13 +0200 Subject: Autotoolification. --- .gitignore | 11 ++++++ AUTHORS | 0 INSTALL | 0 Makefile.am | 1 + NEWS | 0 configure.ac | 33 ++++++++++++++++ elisp/Makefile.am | 31 +++++++++++++++ elisp/geiser-install.el.in | 5 +++ elisp/geiser-reload.el | 96 ++++++++++++++++++++++++++++++++++++++++++++++ elisp/geiser-version.el.in | 12 ++++++ elisp/geiser.el | 77 ++++--------------------------------- 11 files changed, 197 insertions(+), 69 deletions(-) create mode 100644 AUTHORS create mode 100644 INSTALL create mode 100644 Makefile.am create mode 100644 NEWS create mode 100644 configure.ac create mode 100644 elisp/Makefile.am create mode 100644 elisp/geiser-install.el.in create mode 100644 elisp/geiser-reload.el create mode 100644 elisp/geiser-version.el.in diff --git a/.gitignore b/.gitignore index 106f9fe..c1eb482 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,14 @@ /scheme/guile/geiser/eval.go /scheme/guile/geiser/introspection.go /scheme/guile/geiser/file.go +/Makefile +/Makefile.in +/aclocal.m4 +/configure +/elisp-comp +/elisp/Makefile.in +/install-sh +/missing +/scheme/Makefile.in +/scheme/guile/Makefile.in +/scheme/guile/geiser/Makefile.in diff --git a/AUTHORS b/AUTHORS new file mode 100644 index 0000000..e69de29 diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..e69de29 diff --git a/Makefile.am b/Makefile.am new file mode 100644 index 0000000..c1d4ac4 --- /dev/null +++ b/Makefile.am @@ -0,0 +1 @@ +SUBDIRS = elisp scheme diff --git a/NEWS b/NEWS new file mode 100644 index 0000000..e69de29 diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..f8ed7ec --- /dev/null +++ b/configure.ac @@ -0,0 +1,33 @@ +# Copyright (C) 2009 Free Software Foundation, Inc. +# +# This file is free software; as a special exception the author gives +# unlimited permission to copy and/or distribute it, with or without +# modifications, as long as this notice is preserved. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY, to the extent permitted by law; without even the +# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +AC_INIT([GNU Geiser],[0.0.7],[jao@gnu.org],geiser) +AC_CONFIG_SRCDIR([elisp/geiser.el]) +AM_INIT_AUTOMAKE + +AC_PROG_MAKE_SET +AC_PROG_INSTALL +AC_PROG_MKDIR_P +AC_CHECK_PROG(MAKEINFO, makeinfo, makeinfo, no) +AC_CHECK_PROG(TEXI2PDF, texi2pdf, texi2pdf, false) + +AM_PATH_LISPDIR + +dnl scheme/plt/Makefile +dnl scheme/plt/geiser/Makefile + +AC_CONFIG_FILES([ +Makefile +elisp/Makefile +elisp/geiser-version.el +scheme/Makefile +]) + +AC_OUTPUT diff --git a/elisp/Makefile.am b/elisp/Makefile.am new file mode 100644 index 0000000..790a033 --- /dev/null +++ b/elisp/Makefile.am @@ -0,0 +1,31 @@ +EXTRA_DIST = geiser-install.el.in + +dist_lisp_LISP = \ + geiser-autodoc.el \ + geiser-base.el \ + geiser-compile.el \ + geiser-completion.el \ + geiser-connection.el \ + geiser-custom.el \ + geiser-debug.el \ + geiser-doc.el \ + geiser-edit.el \ + geiser.el \ + geiser-eval.el \ + geiser-guile.el \ + geiser-impl.el \ + geiser-log.el \ + geiser-mode.el \ + geiser-plt.el \ + geiser-popup.el \ + geiser-reload.el \ + geiser-repl.el \ + geiser-syntax.el \ + geiser-xref.el \ + geiser-version.el + +lisp_LISP = geiser-install.el + +geiser-install.el: $(srcdir)/geiser.el $(srcdir)/geiser-install.el.in + @sed -e "s|@SCHEME_DIR[@]|$(datarootdir)/geiser|" $(srcdir)/geiser-install.el.in >$@ + diff --git a/elisp/geiser-install.el.in b/elisp/geiser-install.el.in new file mode 100644 index 0000000..da9f28f --- /dev/null +++ b/elisp/geiser-install.el.in @@ -0,0 +1,5 @@ +(require 'geiser) + +(setq geiser-scheme-dir "@SCHEME_DIR@") + +(provide 'geiser-install) diff --git a/elisp/geiser-reload.el b/elisp/geiser-reload.el new file mode 100644 index 0000000..f592164 --- /dev/null +++ b/elisp/geiser-reload.el @@ -0,0 +1,96 @@ +;; geiser-reload.el -- unload/load geiser packages + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz +;; Start date: Sat Aug 22, 2009 23:04 + +;; 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 . + +;;; Code: + +(require 'geiser-impl) +(require 'geiser-repl) +(require 'geiser-mode) + + +;;; Reload: + +(defmacro geiser--features-list () + (quote '( + geiser-mode + geiser-repl + geiser-xref + geiser-edit + geiser-doc + geiser-debug + geiser-impl + geiser-completion + geiser-autodoc + geiser-compile + geiser-eval + geiser-connection + geiser-syntax + geiser-log + geiser-custom + geiser-base + geiser-popup + geiser + geiser-version + ))) + +(defun geiser-reload-unload-function () + (dolist (feature (geiser--features-list)) + (when (featurep feature) (unload-feature feature t))) + t) + +(defun geiser-unload () + (interactive) + (unload-feature 'geiser-reload)) + +(defun geiser-reload (&optional arg) + "Reload Geiser. +With prefix arg, prompts for the DIRECTORY from which Geiser should be +loaded." + (interactive "P") + (let* ((old-dir geiser-elisp-dir) + (dir (or (and arg (read-directory-name "New Geiser elisp dir: " + old-dir old-dir t old-dir)) + old-dir)) + (gf (expand-file-name "geiser.el" dir)) + (gfi (expand-file-name "geiser-install.el" dir))) + (unless (or (file-exists-p gfi) + (file-exists-p gf)) + (error "%s does not contain Geiser!" dir)) + (let ((installed-impls geiser-impl-installed-implementations) + (impls geiser-impl--impls) + (repls (geiser-repl--repl-list)) + (buffers (geiser-mode--buffers))) + (setq load-path (remove geiser-elisp-dir load-path)) + (geiser-unload) + (add-to-list 'load-path dir) + (setq geiser-impl-installed-implementations installed-impls) + (if (file-exists-p gfi) + (require 'geiser-install) + (load-file gf)) + (dolist (feature (geiser--features-list)) + (load-library (format "%s" feature))) + (geiser-impl--reload-implementations impls) + (geiser-repl--restore repls) + (geiser-mode--restore buffers) + (message "Geiser reloaded!")))) + + +(provide 'geiser-reload) +;;; geiser-reload.el ends here diff --git a/elisp/geiser-version.el.in b/elisp/geiser-version.el.in new file mode 100644 index 0000000..5b1258b --- /dev/null +++ b/elisp/geiser-version.el.in @@ -0,0 +1,12 @@ + +;;; Versioning: + +(defvar geiser-version-string "@PACKAGE_STRING@" + "Geiser's version as a string.") + +(defun geiser-version () + "Echoes Geiser's version." + (interactive) + (message "%s" geiser-version-string)) + +(provide 'geiser-version) diff --git a/elisp/geiser.el b/elisp/geiser.el index 1cc3c51..64d4efb 100644 --- a/elisp/geiser.el +++ b/elisp/geiser.el @@ -27,9 +27,6 @@ ;;; Locations: -(defvar geiser-root-dir nil - "Geiser's root directory.") - (defvar geiser-elisp-dir nil "Directory containing Geiser's Elisp files.") @@ -37,14 +34,19 @@ "Directory containing Geiser's Scheme files.") (setq geiser-elisp-dir (file-name-directory load-file-name)) -(setq geiser-scheme-dir (expand-file-name "../scheme/" geiser-elisp-dir)) -(setq geiser-root-dir (expand-file-name "../" geiser-elisp-dir)) - (add-to-list 'load-path geiser-elisp-dir) +(setq geiser-scheme-dir (expand-file-name "../scheme/" geiser-elisp-dir)) + ;;; Autoloads: +(autoload 'geiser-version "geiser-version.el" "Echo Geiser's version." t) + +(autoload 'geiser-unload "geiser-reload.el" "Unload all Geiser code." t) + +(autoload 'geiser-reload "geiser-reload.el" "Reload Geiser code." t) + (autoload 'geiser "geiser-repl.el" "Start a Geiser REPL, or switch to a running one." t) @@ -95,68 +97,5 @@ (eval-after-load "scheme" '(add-hook 'scheme-mode-hook 'turn-on-geiser-mode)) - -;;; Reload: - -(defmacro geiser--features-list () - (quote '( - geiser-mode - geiser-repl - geiser-xref - geiser-edit - geiser-doc - geiser-debug - geiser-impl - geiser-completion - geiser-autodoc - geiser-compile - geiser-eval - geiser-connection - geiser-syntax - geiser-log - geiser-custom - geiser-base - geiser-popup - ))) - -(defun geiser-unload-function () - (dolist (feature (geiser--features-list)) - (when (featurep feature) (unload-feature feature t))) - t) - -(defun geiser-unload () - (interactive) - (when (featurep 'geiser) (unload-feature 'geiser))) - -(defun geiser-reload (&optional arg) - "Reload Geiser. -With prefix arg, prompts for the DIRECTORY in which Geiser should be -loaded." - (interactive "P") - (let* ((dir (or (and arg (read-directory-name "New Geiser root dir: " - geiser-root-dir - geiser-root-dir - t - geiser-root-dir)) - geiser-root-dir)) - (geiser-main-file (expand-file-name "elisp/geiser.el" dir)) - (installed-impls geiser-impl-installed-implementations) - (impls (and (featurep 'geiser-impl) geiser-impl--impls)) - (repls (and (featurep 'geiser-repl) (geiser-repl--repl-list))) - (buffers (and (featurep 'geiser-mode) (geiser-mode--buffers)))) - (unless (file-exists-p geiser-main-file) - (error "%s does not contain Geiser!" dir)) - (geiser-unload) - (setq load-path (remove geiser-elisp-dir load-path)) - (setq geiser-impl-installed-implementations installed-impls) - (load-file geiser-main-file) - (dolist (feature (geiser--features-list)) - (load-library (format "%s" feature))) - (geiser-impl--reload-implementations impls) - (geiser-repl--restore repls) - (geiser-mode--restore buffers) - (message "Geiser reloaded!"))) - (provide 'geiser) -;;; geiser.el ends here -- cgit v1.2.3 From 8ec4b1b63c9e4976988988b0f534bcec77583c79 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 23 Aug 2009 02:59:09 +0200 Subject: Fixes for all byte-compilation warnings. --- elisp/geiser-autodoc.el | 4 ++-- elisp/geiser-base.el | 20 ++-------------- elisp/geiser-completion.el | 6 ++--- elisp/geiser-doc.el | 2 +- elisp/geiser-edit.el | 5 +++- elisp/geiser-eval.el | 38 +++++++++++++++--------------- elisp/geiser-impl.el | 58 ++++++++++++++++++++++++---------------------- elisp/geiser-log.el | 2 ++ 8 files changed, 63 insertions(+), 72 deletions(-) diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index 1d876dd..a8a7a50 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -114,8 +114,8 @@ when `geiser-autodoc-display-module-p' is on." (module (cdr (assoc 'module signature)))) (if (not args) (geiser-autodoc--proc-name proc module) (let ((cpos 1) - (pos (or (second desc) 0)) - (prev (third desc)) + (pos (or (cadr desc) 0)) + (prev (caddr desc)) (reqs (cdr (assoc 'required args))) (opts (cdr (assoc 'optional args))) (keys (cdr (assoc 'key args)))) diff --git a/elisp/geiser-base.el b/elisp/geiser-base.el index 362930d..ba0067a 100644 --- a/elisp/geiser-base.el +++ b/elisp/geiser-base.el @@ -25,26 +25,10 @@ ;;; Code: - -;;; Versioning: - -(defconst geiser-version-major 0 - "Geiser's major version number.") -(defconst geiser-version-minor 1 - "Geiser's minor version number.") - -(defun geiser-version-string () - "Geiser's version as a string." - (format "%s.%s" geiser-version-major geiser-version-minor)) - -(defun geiser-version () - "Echoes Geiser's version." - (interactive) - (message "Geiser %s" (geiser-version-string))) - - ;;; Emacs compatibility: +(eval-when-compile (require 'cl)) + (eval-after-load "ring" '(when (not (fboundp 'ring-member)) (defun ring-member (ring item) diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el index 28aef12..cd03cae 100644 --- a/elisp/geiser-completion.el +++ b/elisp/geiser-completion.el @@ -29,7 +29,7 @@ (require 'geiser-syntax) (require 'geiser-base) -(eval-when-compile (require 'cl)) +(require 'cl) ;;; Completions window handling, heavily inspired in slime's: @@ -84,7 +84,7 @@ terminates a current completion." (remove-hook 'pre-command-hook 'geiser-completion--maybe-restore-window-cfg) (condition-case err - (cond ((find last-command-char "()\"'`,# \r\n:") + (cond ((find last-command-event "()\"'`,# \r\n:") (geiser-completion--restore-window-cfg)) ((not (geiser-completion--window-active-p)) (geiser-completion--forget-window-cfg)) @@ -146,7 +146,7 @@ terminates a current completion." ;;; Completion functionality: -(defsubst geiser-completion--symbol-list (prefix) +(defun geiser-completion--symbol-list (prefix) (delete-duplicates (append (mapcar (lambda (s) (format "%s" s)) (geiser-syntax--locals-around-point)) (geiser-eval--send/result `(:eval ((:ge completions) ,prefix)))) diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el index 61c50f5..8e5c816 100644 --- a/elisp/geiser-doc.el +++ b/elisp/geiser-doc.el @@ -180,7 +180,7 @@ (cdr (assoc 'signature ds)))) (newline) (insert (or (cdr (assoc 'docstring ds)) "")) - (goto-line (point-min)) + (goto-char (point-min)) (setq geiser-doc--buffer-link (geiser-doc--history-push (geiser-doc--make-link symbol module impl)))) diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el index 723e898..ad2c11e 100644 --- a/elisp/geiser-edit.el +++ b/elisp/geiser-edit.el @@ -106,8 +106,9 @@ or following links in error buffers.") (format "\\_<%s\\_>" (regexp-quote (format "%s" thing)))) (defun geiser-edit--goto-line (symbol line) + (goto-char (point-min)) (if (numberp line) - (goto-line line) + (forward-line (max 0 (1- line))) (goto-char (point-min)) (when (or (re-search-forward (geiser-edit--def-re symbol) nil t) (re-search-forward (geiser-edit--def-re* symbol) nil t) @@ -152,6 +153,8 @@ or following links in error buffers.") ;;; Commands: +(defvar geiser-edit--symbol-history nil) + (defun geiser-edit-symbol () "Asks for a symbol to edit, with completion." (interactive) diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 3e0d0d9..1c8cbfe 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -54,25 +54,6 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) ;;; Code formatting: -(defun geiser-eval--scheme-str (code) - (cond ((null code) "'()") - ((eq code :f) "#f") - ((eq code :t) "#t") - ((listp code) - (cond ((eq (car code) :eval) (geiser-eval--eval (cdr code))) - ((eq (car code) :comp) (geiser-eval--comp (cdr code))) - ((eq (car code) :load-file) - (geiser-eval--load-file (cadr code))) - ((eq (car code) :comp-file) - (geiser-eval--comp-file (cadr code))) - ((eq (car code) :module) (geiser-eval--module (cadr code))) - ((eq (car code) :ge) (geiser-eval--ge (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--eval (code) (geiser-eval--scheme-str `(,(geiser-eval--form 'eval) (quote ,(nth 0 code)) @@ -99,6 +80,25 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) (defsubst geiser-eval--ge (proc) (geiser-eval--scheme-str (geiser-eval--form proc))) +(defun geiser-eval--scheme-str (code) + (cond ((null code) "'()") + ((eq code :f) "#f") + ((eq code :t) "#t") + ((listp code) + (cond ((eq (car code) :eval) (geiser-eval--eval (cdr code))) + ((eq (car code) :comp) (geiser-eval--comp (cdr code))) + ((eq (car code) :load-file) + (geiser-eval--load-file (cadr code))) + ((eq (car code) :comp-file) + (geiser-eval--comp-file (cadr code))) + ((eq (car code) :module) (geiser-eval--module (cadr code))) + ((eq (car code) :ge) (geiser-eval--ge (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)))) + ;;; Code sending: diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index 32acade..840d0c1 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -58,11 +58,40 @@ determine its scheme flavour." symbol)) :group 'geiser-impl) + +;;; Auxiliary functions: +(defsubst geiser-impl--sym (imp name) + (intern (format "geiser-%s-%s" imp name))) + +(defsubst geiser-impl--boundp (imp name) + (boundp (geiser-impl--sym imp name))) + +(defsubst geiser-impl--fboundp (imp name) + (fboundp (geiser-impl--sym imp name))) + +(defsubst geiser-impl--impl-feature (impl) + (intern (format "geiser-%s" impl))) + +(defun geiser-impl--value (imp name &optional fun) + (let ((sym (geiser-impl--sym imp name))) + (unless (or (and (not fun) (boundp sym)) + (and fun (fboundp sym))) + (error "Unbound %s '%s' in Geiser Scheme implementation %s" + (if fun "function" "variable") sym imp)) + (if fun (symbol-function sym) (symbol-value sym)))) + +(defsubst geiser-impl--call-if-bound (imp name &rest args) + (when (geiser-impl--fboundp imp name) + (apply (geiser-impl--value imp name t) args))) + ;;; Registering implementations: (defvar geiser-impl--impls nil) +(make-variable-buffer-local + (defvar geiser-impl--implementation nil)) + (defun geiser-impl--register (impl) (when (and (not (memq impl geiser-impl--impls)) (require (geiser-impl--impl-feature impl) nil t)) @@ -91,9 +120,6 @@ determine its scheme flavour." ;;; Installing Scheme implementations: -(make-variable-buffer-local - (defvar geiser-impl--implementation nil)) - (defvar geiser-impl--impl-prompt-history nil) (defun geiser-impl--read-impl (&optional prompt impls non-req) @@ -114,30 +140,6 @@ determine its scheme flavour." (geiser-impl--install-vars impl) (geiser-impl--register impl))) -(defsubst geiser-impl--sym (imp name) - (intern (format "geiser-%s-%s" imp name))) - -(defsubst geiser-impl--boundp (imp name) - (boundp (geiser-impl--sym imp name))) - -(defsubst geiser-impl--fboundp (imp name) - (fboundp (geiser-impl--sym imp name))) - -(defsubst geiser-impl--impl-feature (impl) - (intern (format "geiser-%s" impl))) - -(defun geiser-impl--value (imp name &optional fun) - (let ((sym (geiser-impl--sym imp name))) - (unless (or (and (not fun) (boundp sym)) - (and fun (fboundp sym))) - (error "Unbound %s '%s' in Geiser Scheme implementation %s" - (if fun "function" "variable") sym imp)) - (if fun (symbol-function sym) (symbol-value sym)))) - -(defsubst geiser-impl--call-if-bound (imp name &rest args) - (when (geiser-impl--fboundp imp name) - (apply (geiser-impl--value imp name t) args))) - (defsubst geiser-impl--module-function (impl) (geiser-impl--sym impl "get-module")) @@ -259,7 +261,7 @@ implementation to be used by Geiser.")) (let* ((current geiser-impl-installed-implementations) (impl (geiser-impl--read-impl "Forget implementation: " current))) (geiser-impl--unregister impl) - (when (and (impl current) + (when (and impl (y-or-n-p "Forget permanently using customize? ")) (customize-save-variable 'geiser-impl-installed-implementations (remove impl current))))) diff --git a/elisp/geiser-log.el b/elisp/geiser-log.el index 68e0fae..27a485a 100644 --- a/elisp/geiser-log.el +++ b/elisp/geiser-log.el @@ -28,6 +28,8 @@ (require 'geiser-popup) (require 'geiser-base) +(require 'comint) + ;;; Customization: -- cgit v1.2.3 From 065ed08b64474ae86c98aaff7704ded34ce39e0a Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 23 Aug 2009 03:11:40 +0200 Subject: Automatic ChangeLog generation during make dist. --- .gitignore | 1 + Makefile.am | 5 ++++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index c1eb482..143a14e 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,4 @@ /scheme/Makefile.in /scheme/guile/Makefile.in /scheme/guile/geiser/Makefile.in +/ChangeLog diff --git a/Makefile.am b/Makefile.am index c1d4ac4..fea9f9d 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1 +1,4 @@ -SUBDIRS = elisp scheme +SUBDIRS = . elisp scheme + +dist-hook: + git log --summary --stat > $(top_distdir)/ChangeLog -- cgit v1.2.3 From 3983e638629b1185963fc642c50c2138bd0e66fa Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 23 Aug 2009 05:18:39 +0200 Subject: Standardese filling. --- AUTHORS | 4 + INSTALL | 316 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ README | 57 +++++++++--- 3 files changed, 364 insertions(+), 13 deletions(-) diff --git a/AUTHORS b/AUTHORS index e69de29..c1ecdb8 100644 --- a/AUTHORS +++ b/AUTHORS @@ -0,0 +1,4 @@ +Jose A. Ortega Ruiz designed and implemented GNU Geiser. For +more boring details about him, see . + +See also the files THANKS and ChangeLog. diff --git a/INSTALL b/INSTALL index e69de29..4333c7f 100644 --- a/INSTALL +++ b/INSTALL @@ -0,0 +1,316 @@ +Installing Geiser. +------------------ + +You'll find below the generic build and installation instructions for +a GNU package, which Geiser happens to be. As you know, they can be +summarised as: + + mkdir build && cd build + ../configure + make + make install + +And, in our case, we'll need to tell emacs about this new little +package with + + (require 'geiser-install) + +in your moral equivalent to ~/.emacs. + +As explained in the README file, Geiser is also directly usable from +its source tree, with no configuration whatsoever. Read that README to +see how. + +As promised, here you have the gory details of the autotools jazz: + +Installation Instructions +************************* + +Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002, 2004, 2005, +2006, 2007, 2008, 2009 Free Software Foundation, Inc. + + This file is free documentation; the Free Software Foundation gives +unlimited permission to copy, distribute and modify it. + +Basic Installation +================== + + Briefly, the shell commands `./configure; make; make install' should +configure, build, and install this package. The following +more-detailed instructions are generic; see the `README' file for +instructions specific to this package. + + The `configure' shell script attempts to guess correct values for +various system-dependent variables used during compilation. It uses +those values to create a `Makefile' in each directory of the package. +It may also create one or more `.h' files containing system-dependent +definitions. Finally, it creates a shell script `config.status' that +you can run in the future to recreate the current configuration, and a +file `config.log' containing compiler output (useful mainly for +debugging `configure'). + + It can also use an optional file (typically called `config.cache' +and enabled with `--cache-file=config.cache' or simply `-C') that saves +the results of its tests to speed up reconfiguring. Caching is +disabled by default to prevent problems with accidental use of stale +cache files. + + If you need to do unusual things to compile the package, please try +to figure out how `configure' could check whether to do them, and mail +diffs or instructions to the address given in the `README' so they can +be considered for the next release. If you are using the cache, and at +some point `config.cache' contains results you don't want to keep, you +may remove or edit it. + + The file `configure.ac' (or `configure.in') is used to create +`configure' by a program called `autoconf'. You need `configure.ac' if +you want to change it or regenerate `configure' using a newer version +of `autoconf'. + +The simplest way to compile this package is: + + 1. `cd' to the directory containing the package's source code and type + `./configure' to configure the package for your system. + + Running `configure' might take a while. While running, it prints + some messages telling which features it is checking for. + + 2. Type `make' to compile the package. + + 3. Optionally, type `make check' to run any self-tests that come with + the package. + + 4. Type `make install' to install the programs and any data files and + documentation. + + 5. You can remove the program binaries and object files from the + source code directory by typing `make clean'. To also remove the + files that `configure' created (so you can compile the package for + a different kind of computer), type `make distclean'. There is + also a `make maintainer-clean' target, but that is intended mainly + for the package's developers. If you use it, you may have to get + all sorts of other programs in order to regenerate files that came + with the distribution. + + 6. Often, you can also type `make uninstall' to remove the installed + files again. + +Compilers and Options +===================== + + Some systems require unusual options for compilation or linking that +the `configure' script does not know about. Run `./configure --help' +for details on some of the pertinent environment variables. + + You can give `configure' initial values for configuration parameters +by setting variables in the command line or in the environment. Here +is an example: + + ./configure CC=c99 CFLAGS=-g LIBS=-lposix + + *Note Defining Variables::, for more details. + +Compiling For Multiple Architectures +==================================== + + You can compile the package for more than one kind of computer at the +same time, by placing the object files for each architecture in their +own directory. To do this, you can use GNU `make'. `cd' to the +directory where you want the object files and executables to go and run +the `configure' script. `configure' automatically checks for the +source code in the directory that `configure' is in and in `..'. + + With a non-GNU `make', it is safer to compile the package for one +architecture at a time in the source code directory. After you have +installed the package for one architecture, use `make distclean' before +reconfiguring for another architecture. + + On MacOS X 10.5 and later systems, you can create libraries and +executables that work on multiple system types--known as "fat" or +"universal" binaries--by specifying multiple `-arch' options to the +compiler but only a single `-arch' option to the preprocessor. Like +this: + + ./configure CC="gcc -arch i386 -arch x86_64 -arch ppc -arch ppc64" \ + CXX="g++ -arch i386 -arch x86_64 -arch ppc -arch ppc64" \ + CPP="gcc -E" CXXCPP="g++ -E" + + This is not guaranteed to produce working output in all cases, you +may have to build one architecture at a time and combine the results +using the `lipo' tool if you have problems. + +Installation Names +================== + + By default, `make install' installs the package's commands under +`/usr/local/bin', include files under `/usr/local/include', etc. You +can specify an installation prefix other than `/usr/local' by giving +`configure' the option `--prefix=PREFIX'. + + You can specify separate installation prefixes for +architecture-specific files and architecture-independent files. If you +pass the option `--exec-prefix=PREFIX' to `configure', the package uses +PREFIX as the prefix for installing programs and libraries. +Documentation and other data files still use the regular prefix. + + In addition, if you use an unusual directory layout you can give +options like `--bindir=DIR' to specify different values for particular +kinds of files. Run `configure --help' for a list of the directories +you can set and what kinds of files go in them. + + If the package supports it, you can cause programs to be installed +with an extra prefix or suffix on their names by giving `configure' the +option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'. + +Optional Features +================= + + Some packages pay attention to `--enable-FEATURE' options to +`configure', where FEATURE indicates an optional part of the package. +They may also pay attention to `--with-PACKAGE' options, where PACKAGE +is something like `gnu-as' or `x' (for the X Window System). The +`README' should mention any `--enable-' and `--with-' options that the +package recognizes. + + For packages that use the X Window System, `configure' can usually +find the X include and library files automatically, but if it doesn't, +you can use the `configure' options `--x-includes=DIR' and +`--x-libraries=DIR' to specify their locations. + +Particular systems +================== + + On HP-UX, the default C compiler is not ANSI C compatible. If GNU +CC is not installed, it is recommended to use the following options in +order to use an ANSI C compiler: + + ./configure CC="cc -Ae" + +and if that doesn't work, install pre-built binaries of GCC for HP-UX. + + On OSF/1 a.k.a. Tru64, some versions of the default C compiler cannot +parse its `' header file. The option `-nodtk' can be used as +a workaround. If GNU CC is not installed, it is therefore recommended +to try + + ./configure CC="cc" + +and if that doesn't work, try + + ./configure CC="cc -nodtk" + +Specifying the System Type +========================== + + There may be some features `configure' cannot figure out +automatically, but needs to determine by the type of machine the package +will run on. Usually, assuming the package is built to be run on the +_same_ architectures, `configure' can figure that out, but if it prints +a message saying it cannot guess the machine type, give it the +`--build=TYPE' option. TYPE can either be a short name for the system +type, such as `sun4', or a canonical name which has the form: + + CPU-COMPANY-SYSTEM + +where SYSTEM can have one of these forms: + + OS KERNEL-OS + + See the file `config.sub' for the possible values of each field. If +`config.sub' isn't included in this package, then this package doesn't +need to know the machine type. + + If you are _building_ compiler tools for cross-compiling, you should +use the option `--target=TYPE' to select the type of system they will +produce code for. + + If you want to _use_ a cross compiler, that generates code for a +platform different from the build platform, you should specify the +"host" platform (i.e., that on which the generated programs will +eventually be run) with `--host=TYPE'. + +Sharing Defaults +================ + + If you want to set default values for `configure' scripts to share, +you can create a site shell script called `config.site' that gives +default values for variables like `CC', `cache_file', and `prefix'. +`configure' looks for `PREFIX/share/config.site' if it exists, then +`PREFIX/etc/config.site' if it exists. Or, you can set the +`CONFIG_SITE' environment variable to the location of the site script. +A warning: not all `configure' scripts look for a site script. + +Defining Variables +================== + + Variables not defined in a site shell script can be set in the +environment passed to `configure'. However, some packages may run +configure again during the build, and the customized values of these +variables may be lost. In order to avoid this problem, you should set +them in the `configure' command line, using `VAR=value'. For example: + + ./configure CC=/usr/local2/bin/gcc + +causes the specified `gcc' to be used as the C compiler (unless it is +overridden in the site shell script). + +Unfortunately, this technique does not work for `CONFIG_SHELL' due to +an Autoconf bug. Until the bug is fixed you can use this workaround: + + CONFIG_SHELL=/bin/bash /bin/bash ./configure CONFIG_SHELL=/bin/bash + +`configure' Invocation +====================== + + `configure' recognizes the following options to control how it +operates. + +`--help' +`-h' + Print a summary of all of the options to `configure', and exit. + +`--help=short' +`--help=recursive' + Print a summary of the options unique to this package's + `configure', and exit. The `short' variant lists options used + only in the top level, while the `recursive' variant lists options + also present in any nested packages. + +`--version' +`-V' + Print the version of Autoconf used to generate the `configure' + script, and exit. + +`--cache-file=FILE' + Enable the cache: use and save the results of the tests in FILE, + traditionally `config.cache'. FILE defaults to `/dev/null' to + disable caching. + +`--config-cache' +`-C' + Alias for `--cache-file=config.cache'. + +`--quiet' +`--silent' +`-q' + Do not print messages saying which checks are being made. To + suppress all normal output, redirect it to `/dev/null' (any error + messages will still be shown). + +`--srcdir=DIR' + Look for the package's source code in directory DIR. Usually + `configure' can determine that directory automatically. + +`--prefix=DIR' + Use DIR as the installation prefix. *Note Installation Names:: + for more details, including other options available for fine-tuning + the installation locations. + +`--no-create' +`-n' + Run the configure checks, but stop before creating any output + files. + +`configure' also accepts some other, not widely useful, options. Run +`configure --help' for more details. + diff --git a/README b/README index 141b83d..537f291 100644 --- a/README +++ b/README @@ -26,29 +26,60 @@ - PLT Scheme 4.1.5.5 or better required. * Installation + Geiser can be used either directly from its uninstalled source tree + or byte-compiled and installed after perfoming the standard + configure/make/make install dance. - - In your .emacs: +*** In place + - Extract the tarball or clone the git repository anywhere in your + file system. Let's call that place . + - In your .emacs: - (load-file "/elisp/geiser.el") + (load-file "/elisp/geiser.el") - This installs all supported Scheme implementations. You can list - explicitly the ones that you want by setting the variable - `geiser-impl-installed-implementations' *before* loading geiser.el. - For instance: +*** Byte-compiled + - Create a build directory, `build', say: + $ cd + $ mkdir build; cd build + - Configure and make: + $ ../configure && make + You'll have a directory called "elisp" which contains Geiser's + elisp bytecode. Now, you can either use it in place, with the + .emacs incantation: - (setq geiser-impl-installed-implementations '(plt guile)) + (load-file "/build/elisp/geiser.elc") - On opening a scheme file, Geiser will try to guess its Scheme, - defaulting to the first in the list. + or install it with: - - Check the geiser customization group for some options with: + $ make install + + and require 'geiser-install (not 'geiser, mind you) in your emacs + initialization file: + + (require 'geiser-install) + + You're ready to go! + +* Basic configuration + The loading invocations above install all supported Scheme + implementations. You can list explicitly the ones that you want by + setting the variable `geiser-impl-installed-implementations' *before* + loading geiser.el. For instance: + + (setq geiser-impl-installed-implementations '(plt guile)) + + On opening a scheme file, Geiser will try to guess its Scheme, + defaulting to the first in the list. Use `C-c C-s' to select the + implementation by hand (on a per file basis). + + Check the geiser customization group for some options with: M-x customize-group RET geiser RET - In particular, customize `geiser-repl--binary' (in - geiser-repl), which should point to an executable in your path. + In particular, customize `geiser-repl--binary' (in + geiser-repl), which should point to an executable in your path. - - To start a REPL, M-x geiser. + To start a REPL, M-x geiser. * Quick key reference -- cgit v1.2.3 From 54d772a57b4fa5ad3bfe14884a1421d466724895 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 23 Aug 2009 15:22:07 +0200 Subject: Thanks, many THANKS. --- INSTALL | 4 +++- Makefile.am | 2 ++ THANKS | 21 +++++++++++++++++++++ 3 files changed, 26 insertions(+), 1 deletion(-) create mode 100644 THANKS diff --git a/INSTALL b/INSTALL index 4333c7f..57d9c1f 100644 --- a/INSTALL +++ b/INSTALL @@ -21,7 +21,9 @@ As explained in the README file, Geiser is also directly usable from its source tree, with no configuration whatsoever. Read that README to see how. -As promised, here you have the gory details of the autotools jazz: +As promised, here you have the gory details of the autotools jazz, +which you can freely and safely skip on a first, second and third +reading. Installation Instructions ************************* diff --git a/Makefile.am b/Makefile.am index fea9f9d..90d5015 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,4 +1,6 @@ SUBDIRS = . elisp scheme +EXTRA_DIST = THANKS + dist-hook: git log --summary --stat > $(top_distdir)/ChangeLog diff --git a/THANKS b/THANKS new file mode 100644 index 0000000..17d1c08 --- /dev/null +++ b/THANKS @@ -0,0 +1,21 @@ + +Andy Wingo, Geiser's first user, has been a continuous source of +encouragement and suggestions, and keeps improving Guile and heeding +my feature requests. + +Eduardo Cavazos' contagious enthusiasm has helped in many ways to keep +Geiser alive, and he's become its best evangelist in R6RS circles. + +Eli Barzilay took the time to play with an early beta and make many +valuable suggestions, besides answering all my 'how do you in PLT' +questions. + +Matthew Flatt, Robby Findler and the rest of the PLT team did not only +answer my inquiries, but provided almost instant fixes to the few +issues i found. + +Thanks also to the PLT and Guile communities, for showing me that +Geiser was not only possible, but a pleasure to hack on. + +Karl Berry happily jeopardized GNU's prestige by reviewing and +accepting Geiser as a GNU official package. -- cgit v1.2.3 From 9475d8e30039bff3dfb500471ef74cf2b6362f79 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 23 Aug 2009 15:44:02 +0200 Subject: Buglet in autodoc's argument display. --- elisp/geiser-autodoc.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index a8a7a50..26abd8d 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -122,9 +122,13 @@ when `geiser-autodoc-display-module-p' is on." (save-current-buffer (set-buffer (geiser-syntax--font-lock-buffer)) (erase-buffer) - (insert (format "(%s " (geiser-autodoc--proc-name proc module))) - (setq cpos - (geiser-autodoc--insert-args reqs cpos (and (not (zerop pos)) pos))) + (insert (format "(%s" (geiser-autodoc--proc-name proc module))) + (when reqs + (insert " ") + (setq cpos + (geiser-autodoc--insert-args reqs + cpos + (and (not (zerop pos)) pos)))) (when opts (insert " [") (setq cpos (geiser-autodoc--insert-args opts cpos pos)) -- cgit v1.2.3 From 350c3ae07c4fa7e99c8f4e638cc2a381265909f4 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 23 Aug 2009 15:48:57 +0200 Subject: Automake tweak: geiser-install.el belongs to CLEANFILES. --- elisp/Makefile.am | 2 ++ 1 file changed, 2 insertions(+) diff --git a/elisp/Makefile.am b/elisp/Makefile.am index 790a033..a6ff248 100644 --- a/elisp/Makefile.am +++ b/elisp/Makefile.am @@ -26,6 +26,8 @@ dist_lisp_LISP = \ lisp_LISP = geiser-install.el +CLEANFILES = geiser-install.el + geiser-install.el: $(srcdir)/geiser.el $(srcdir)/geiser-install.el.in @sed -e "s|@SCHEME_DIR[@]|$(datarootdir)/geiser|" $(srcdir)/geiser-install.el.in >$@ -- cgit v1.2.3 From 533102a1bfe4891ab6adc82ac0492ef2db285b27 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 23 Aug 2009 20:22:22 +0200 Subject: geiser-reload works again (was broken for installed geiser). --- elisp/geiser-base.el | 3 +-- elisp/geiser-reload.el | 36 +++++++++++++++++------------------- 2 files changed, 18 insertions(+), 21 deletions(-) diff --git a/elisp/geiser-base.el b/elisp/geiser-base.el index ba0067a..fca955a 100644 --- a/elisp/geiser-base.el +++ b/elisp/geiser-base.el @@ -27,7 +27,7 @@ ;;; Emacs compatibility: -(eval-when-compile (require 'cl)) +(require 'cl) (eval-after-load "ring" '(when (not (fboundp 'ring-member)) @@ -39,7 +39,6 @@ (when (not (fboundp 'completion-table-dynamic)) (defun completion-table-dynamic (fun) - (require 'cl) (lexical-let ((fun fun)) (lambda (string pred action) (with-current-buffer (let ((win (minibuffer-selected-window))) diff --git a/elisp/geiser-reload.el b/elisp/geiser-reload.el index f592164..97b398d 100644 --- a/elisp/geiser-reload.el +++ b/elisp/geiser-reload.el @@ -23,6 +23,8 @@ (require 'geiser-impl) (require 'geiser-repl) (require 'geiser-mode) +(require 'geiser-base) +(require 'geiser) ;;; Reload: @@ -46,46 +48,42 @@ geiser-custom geiser-base geiser-popup + geiser-install geiser geiser-version ))) -(defun geiser-reload-unload-function () - (dolist (feature (geiser--features-list)) - (when (featurep feature) (unload-feature feature t))) - t) - (defun geiser-unload () + "Unload all Geiser modules." (interactive) - (unload-feature 'geiser-reload)) + (let ((fs (geiser--features-list))) + (unload-feature 'geiser-reload t) + (dolist (f fs) + (when (featurep f) (unload-feature f t))))) (defun geiser-reload (&optional arg) "Reload Geiser. With prefix arg, prompts for the DIRECTORY from which Geiser should be -loaded." +loaded again." (interactive "P") (let* ((old-dir geiser-elisp-dir) (dir (or (and arg (read-directory-name "New Geiser elisp dir: " old-dir old-dir t old-dir)) - old-dir)) - (gf (expand-file-name "geiser.el" dir)) - (gfi (expand-file-name "geiser-install.el" dir))) - (unless (or (file-exists-p gfi) - (file-exists-p gf)) + old-dir))) + (unless (or (file-exists-p (expand-file-name "geiser-reload.el" dir)) + (file-exists-p (expand-file-name "geiser-reload.elc" dir))) (error "%s does not contain Geiser!" dir)) - (let ((installed-impls geiser-impl-installed-implementations) + (let ((installed (featurep 'geiser-install)) + (installed-impls geiser-impl-installed-implementations) (impls geiser-impl--impls) (repls (geiser-repl--repl-list)) (buffers (geiser-mode--buffers))) - (setq load-path (remove geiser-elisp-dir load-path)) (geiser-unload) + (setq load-path (remove old-dir load-path)) (add-to-list 'load-path dir) (setq geiser-impl-installed-implementations installed-impls) - (if (file-exists-p gfi) - (require 'geiser-install) - (load-file gf)) - (dolist (feature (geiser--features-list)) - (load-library (format "%s" feature))) + (require 'geiser-reload) + (when installed (require 'geiser-install nil t)) (geiser-impl--reload-implementations impls) (geiser-repl--restore repls) (geiser-mode--restore buffers) -- cgit v1.2.3 From 2120142f34e99935354e3ec74c4eed400a63b5be Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 23 Aug 2009 22:35:24 +0200 Subject: fixes for geiser-unload. --- elisp/geiser-impl.el | 9 ++++----- elisp/geiser-mode.el | 4 ++++ 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index 840d0c1..00fa1ef 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -271,16 +271,12 @@ implementation to be used by Geiser.")) (defun geiser-impl-unload-function () (dolist (imp (mapcar 'geiser-impl--impl-feature geiser-impl--impls)) - (when (featurep imp) (unload-feature imp t))) - t) + (when (featurep imp) (unload-feature imp t)))) (defun geiser-impl--reload-implementations (impls) (dolist (impl impls) (load-library (format "geiser-%s" impl)))) - -(provide 'geiser-impl) - ;;; Initialization: @@ -288,4 +284,7 @@ implementation to be used by Geiser.")) '(mapc 'geiser-impl--register (or geiser-impl-installed-implementations '(guile plt)))) + +(provide 'geiser-impl) + ;;; geiser-impl.el ends here diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el index e19cb68..cc5a00f 100644 --- a/elisp/geiser-mode.el +++ b/elisp/geiser-mode.el @@ -261,6 +261,10 @@ interacting with the Geiser REPL is at your disposal. (geiser-mode 1) (when (cdr b) (geiser-impl--set-buffer-implementation (cdr b)))))) +(defun geiser-mode-unload-function () + (dolist (b (geiser-mode--buffers)) + (with-current-buffer (car b) (geiser-mode nil)))) + (provide 'geiser-mode) ;;; geiser-mode.el ends here -- cgit v1.2.3 From 2be4c066de8088df8442600dff5f2440f69ffa9b Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 23 Aug 2009 22:57:11 +0200 Subject: autogen.sh --- autogen.sh | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100755 autogen.sh diff --git a/autogen.sh b/autogen.sh new file mode 100755 index 0000000..cd0b02f --- /dev/null +++ b/autogen.sh @@ -0,0 +1,9 @@ +#!/bin/sh + +[ -f elisp/geiser.el ] || exit 1 + +touch ./ChangeLog + +autoreconf -Wall + +rm ./ChangeLog -- cgit v1.2.3 From 8e2810f0942745de2534c4dbc8d5d7ec52e79a22 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 23 Aug 2009 23:19:08 +0200 Subject: Putting ChangeLog to good use. --- .gitignore | 1 - ChangeLog | 6 ++++++ Makefile.am | 2 +- autogen.sh | 4 ---- 4 files changed, 7 insertions(+), 6 deletions(-) create mode 100644 ChangeLog diff --git a/.gitignore b/.gitignore index 143a14e..c1eb482 100644 --- a/.gitignore +++ b/.gitignore @@ -13,4 +13,3 @@ /scheme/Makefile.in /scheme/guile/Makefile.in /scheme/guile/geiser/Makefile.in -/ChangeLog diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..09d790c --- /dev/null +++ b/ChangeLog @@ -0,0 +1,6 @@ +## The contents of this file will be generated during 'make dist' by the +## shell command: + + git log --summary --stat + +# which you can run using 'sh ChangeLog' diff --git a/Makefile.am b/Makefile.am index 90d5015..c86aecb 100644 --- a/Makefile.am +++ b/Makefile.am @@ -3,4 +3,4 @@ SUBDIRS = . elisp scheme EXTRA_DIST = THANKS dist-hook: - git log --summary --stat > $(top_distdir)/ChangeLog + $(SHELL) $(top_srcdir)/ChangeLog > $(top_distdir)/ChangeLog diff --git a/autogen.sh b/autogen.sh index cd0b02f..f084b65 100755 --- a/autogen.sh +++ b/autogen.sh @@ -2,8 +2,4 @@ [ -f elisp/geiser.el ] || exit 1 -touch ./ChangeLog - autoreconf -Wall - -rm ./ChangeLog -- cgit v1.2.3 From e0dd77a67b8e7c7d2d56aa353967249cc1e19f1e Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 24 Aug 2009 03:22:12 +0200 Subject: Taking into account those ugly square brackets while scanning locals. --- elisp/geiser-syntax.el | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index 38bb76c..789b6e9 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -119,29 +119,35 @@ (when (listp fst) (push fst path))) (nreverse path)))) +(defsubst geiser-syntax--listify (l &optional strict) + (cond ((vectorp l) (append l nil)) + ((listp l) l) + (strict nil) + (t l))) + (defun geiser-syntax--read-list (p) - (let ((list (ignore-errors (read (current-buffer))))) + (let ((list (geiser-syntax--listify (ignore-errors (read (current-buffer))) t))) (if (and list (< (point) p)) - list + (mapcar 'geiser-syntax--listify list) (goto-char p) nil))) -(defconst geiser-syntax--delim-regexp "\\(?:[\\s-\\s<\\s>$\n]+\\)") +(defconst geiser-syntax--delim-regexp "\\(?:\\s-\\|\\s<\\|\\s>\\|$\\|\n\\)+") (defconst geiser-syntax--ident-regexp - (format "\\(?:%s\\([^ (]+?\\)\\)" geiser-syntax--delim-regexp)) + (format "\\(?:%s\\([^[ (]+?\\)\\)" geiser-syntax--delim-regexp)) (defconst geiser-syntax--let-regexp - (format "\\=(let\\(?:\\*\\|rec\\|%s\\|%s\\)%s*(" + (format "\\=[[(]let\\(?:\\*\\|rec\\|%s\\|%s\\)%s*[[(]" geiser-syntax--ident-regexp geiser-syntax--delim-regexp geiser-syntax--delim-regexp)) (defconst geiser-syntax--ldefine-regexp - (format "\\=(define%s%s" geiser-syntax--ident-regexp geiser-syntax--delim-regexp)) + (format "\\=[[(]define%s%s" geiser-syntax--ident-regexp geiser-syntax--delim-regexp)) (defconst geiser-syntax--define-regexp - (format "\\=(\\(?:define\\|lambda\\)%s(" geiser-syntax--delim-regexp)) + (format "\\=[[(]\\(?:define\\|lambda\\)%s[[(]" geiser-syntax--delim-regexp)) (defun geiser-syntax--locals-around-point () (when (eq major-mode 'scheme-mode) -- cgit v1.2.3 From 91841a63fb0cf3c8a0a6ed1e9086b72097cd44e4 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 25 Aug 2009 01:58:55 +0200 Subject: Now this is cool: support for company mode. --- README | 11 +++++ elisp/Makefile.am | 1 + elisp/geiser-autodoc.el | 6 ++- elisp/geiser-company.el | 111 +++++++++++++++++++++++++++++++++++++++++++++ elisp/geiser-completion.el | 8 ++-- elisp/geiser-edit.el | 11 ++--- elisp/geiser-mode.el | 7 +++ elisp/geiser-reload.el | 1 + elisp/geiser-repl.el | 7 +++ 9 files changed, 153 insertions(+), 10 deletions(-) create mode 100644 elisp/geiser-company.el diff --git a/README b/README index 537f291..8870006 100644 --- a/README +++ b/README @@ -81,6 +81,17 @@ To start a REPL, M-x geiser. +*** Completion with company-mode + Geiser offers identifier and module name completion, bound to + M-TAB and M-` respectively. Only names visible in the current + module are offered. + + While that is cool and all, things are even better: if you have + [[http://nschum.de/src/emacs/company-mode/][company-mode]] installed, Geiser's completion will use it. Just + require company-mode and, from then on, any new scheme buffer or + REPL will use it. If you didn't know about Nikolaj Schumacher's + awesome mode, check [[http://www.screentoaster.com/watch/stU0lSRERIR1pYRFVdXVlRVFFV/company_mode_for_gnu_emacs][this screencast]]. + * Quick key reference *** In Scheme buffers: diff --git a/elisp/Makefile.am b/elisp/Makefile.am index a6ff248..9f93e64 100644 --- a/elisp/Makefile.am +++ b/elisp/Makefile.am @@ -3,6 +3,7 @@ EXTRA_DIST = geiser-install.el.in dist_lisp_LISP = \ geiser-autodoc.el \ geiser-base.el \ + geiser-company.el \ geiser-compile.el \ geiser-completion.el \ geiser-connection.el \ diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index 26abd8d..5aa6691 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -153,9 +153,13 @@ when `geiser-autodoc-display-module-p' is on." ;;; Autodoc function: +(make-variable-buffer-local + (defvar geiser-autodoc--inhibit-flag nil)) + (defun geiser-autodoc--eldoc-function () (condition-case e - (geiser-autodoc--autodoc (geiser-syntax--scan-sexps)) + (and (not geiser-autodoc--inhibit-flag) + (geiser-autodoc--autodoc (geiser-syntax--scan-sexps))) (error (format "Autodoc not available (%s)" (error-message-string e))))) diff --git a/elisp/geiser-company.el b/elisp/geiser-company.el new file mode 100644 index 0000000..8ae8969 --- /dev/null +++ b/elisp/geiser-company.el @@ -0,0 +1,111 @@ +;; geiser-company.el -- integration with company-mode + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz +;; Start date: Mon Aug 24, 2009 12: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 . + +;;; Code: + +(require 'geiser-autodoc) +(require 'geiser-completion) +(require 'geiser-edit) +(require 'geiser-base) + + +;;; Helpers: + +(make-variable-buffer-local + (defvar geiser-company--enabled-flag nil)) + +(defsubst geiser-company--candidates (prefix module) + (car (geiser-completion--complete prefix module))) + +(defsubst geiser-company--doc (id module) + (ignore-errors + (if module + (format "%s [module]" id) + (geiser-autodoc--autodoc (list (list (intern id) 0)))))) + +(defsubst geiser-company--doc-buffer (id module) + nil) + +(defun geiser-company--location (id module) + (ignore-errors + (let ((id (intern id))) + (save-current-buffer + (if module (geiser-edit-module id) (geiser-edit-symbol id)) + (cons (current-buffer) (point)))))) + +(defsubst geiser-company--prefix-at-point (module) + (and geiser-company--enabled-flag + (looking-at-p "\\_>") + (not (nth 8 (syntax-ppss))) + (geiser-completion--prefix module))) + + +;;; Activation + +(defun geiser-company--setup (enable) + (setq geiser-company--enabled-flag enable) + (when (fboundp 'company-mode) + (company-mode nil) + (when enable (company-mode enable))) + (when (boundp 'company-lighter) + (setq company-lighter "/C"))) + +(defun geiser-company--inhibit-autodoc (ignored) + (setq geiser-autodoc--inhibit-flag t)) + +(defun geiser-company--restore-autodoc (&optional ignored) + (setq geiser-autodoc--inhibit-flag nil)) + + +;;; Backends: +(defmacro geiser-company--make-backend (name mod) + `(defun ,name (command &optional arg &rest ignored) + "A `company-mode' completion back-end for `geiser-mode'." + (interactive (list 'interactive)) + (case command + ('interactive (company-begin-backend ',name)) + ('prefix (geiser-company--prefix-at-point ,mod)) + ('candidates (geiser-company--candidates arg ,mod)) + ('meta (geiser-company--doc arg ,mod)) + ('doc-buffer (geiser-company--doc-buffer arg ,mod)) + ('location (geiser-company--location arg ,mod)) + ('sorted t)))) + +(defvar geiser-company--backend '(company-geiser-ids company-geiser-modules)) + +(eval-after-load "company" + '(progn + (geiser-company--make-backend company-geiser-ids nil) + (geiser-company--make-backend company-geiser-modules t) + (add-to-list 'company-backends geiser-company--backend) + (add-hook 'company-completion-finished-hook 'geiser-company--restore-autodoc) + (add-hook 'company-completion-cancelled-hook 'geiser-company--restore-autodoc) + (add-hook 'company-completion-started-hook 'geiser-company--inhibit-autodoc))) + + +;;; Reload support: + +(defun geiser-company-unload-function () + (when (boundp 'company-backends) + (setq company-backends (remove geiser-company--backend company-backends)))) + + +(provide 'geiser-company) +;;; geiser-company.el ends here diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el index cd03cae..e3bd74b 100644 --- a/elisp/geiser-completion.el +++ b/elisp/geiser-completion.el @@ -204,14 +204,16 @@ terminates a current completion." (funcall geiser-completion--symbol-begin-function module)) (save-excursion (skip-syntax-backward "^-()>") (point)))) +(defsubst geiser-completion--prefix (module) + (buffer-substring-no-properties (point) + (geiser-completion--symbol-begin module))) + (defun geiser-completion--complete-symbol (&optional arg) "Complete the symbol at point. Perform completion similar to Emacs' complete-symbol. With prefix, complete module name." (interactive "P") - (let* ((end (point)) - (beg (geiser-completion--symbol-begin arg)) - (prefix (buffer-substring-no-properties beg end)) + (let* ((prefix (geiser-completion--prefix arg)) (result (geiser-completion--complete prefix arg)) (completions (car result)) (partial (cdr result))) diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el index ad2c11e..418b6e3 100644 --- a/elisp/geiser-edit.el +++ b/elisp/geiser-edit.el @@ -155,13 +155,12 @@ or following links in error buffers.") (defvar geiser-edit--symbol-history nil) -(defun geiser-edit-symbol () +(defun geiser-edit-symbol (symbol) "Asks for a symbol to edit, with completion." - (interactive) - (let* ((symbol (geiser-completion--read-symbol "Edit symbol: " - nil - geiser-edit--symbol-history)) - (cmd `(:eval ((:ge symbol-location) ',symbol)))) + (interactive (list (geiser-completion--read-symbol "Edit symbol: " + nil + geiser-edit--symbol-history))) + (let ((cmd `(:eval ((:ge symbol-location) ',symbol)))) (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd)))) (defun geiser-edit-symbol-at-point (&optional arg) diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el index cc5a00f..fa686ec 100644 --- a/elisp/geiser-mode.el +++ b/elisp/geiser-mode.el @@ -28,6 +28,7 @@ (require 'geiser-doc) (require 'geiser-compile) (require 'geiser-completion) +(require 'geiser-company) (require 'geiser-xref) (require 'geiser-edit) (require 'geiser-autodoc) @@ -52,6 +53,11 @@ :group 'geiser-autodoc :type 'boolean) +(defcustom geiser-mode-company-p t + "Whether to use company-mode for completion, if available." + :group 'geiser-mode + :type 'boolean) + (defcustom geiser-mode-smart-tab-p nil "Whether `geiser-smart-tab-mode' gets enabled by default in Scheme buffers." :group 'geiser-mode @@ -188,6 +194,7 @@ interacting with the Geiser REPL is at your disposal. (when geiser-mode (geiser-impl--set-buffer-implementation)) (setq geiser-autodoc-mode-string "/A") (setq geiser-smart-tab-mode-string "/T") + (geiser-company--setup (and geiser-mode geiser-mode-company-p)) (when geiser-mode-autodoc-p (geiser-autodoc-mode geiser-mode)) (when geiser-mode-smart-tab-p (geiser-smart-tab-mode geiser-mode))) diff --git a/elisp/geiser-reload.el b/elisp/geiser-reload.el index 97b398d..5a30e1f 100644 --- a/elisp/geiser-reload.el +++ b/elisp/geiser-reload.el @@ -38,6 +38,7 @@ geiser-doc geiser-debug geiser-impl + geiser-company geiser-completion geiser-autodoc geiser-compile diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index bed653f..4ea1bb7 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -24,6 +24,7 @@ ;;; Code: +(require 'geiser-company) (require 'geiser-autodoc) (require 'geiser-edit) (require 'geiser-impl) @@ -70,6 +71,11 @@ implementation name gets appended to it." :type 'boolean :group 'geiser-repl) +(defcustom geiser-repl-company-p t + "Whether to use company-mode for completion, if available." + :group 'geiser-mode + :type 'boolean) + (defcustom geiser-repl-read-only-prompt-p t "Whether the REPL's prompt should be read-only." :type 'boolean @@ -293,6 +299,7 @@ If no REPL is running, execute `run-geiser' to start a fresh one." (set-syntax-table scheme-mode-syntax-table) (setq geiser-eval--get-module-function 'geiser-repl--module-function) (when geiser-repl-autodoc-p (geiser-autodoc-mode 1)) + (geiser-company--setup geiser-repl-company-p) (compilation-shell-minor-mode 1)) (define-key geiser-repl-mode-map "\C-d" 'delete-char) -- cgit v1.2.3 From b38d0243910b65d763576bcf662da4d33f64e324 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 25 Aug 2009 15:30:51 +0200 Subject: Slightly better autodoc caching (probably needs an overhaul, though). --- elisp/geiser-autodoc.el | 33 ++++++++++++++++++--------------- elisp/geiser-company.el | 8 ++++---- elisp/geiser-doc.el | 3 +-- 3 files changed, 23 insertions(+), 21 deletions(-) diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index 5aa6691..c2746a0 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -68,7 +68,7 @@ when `geiser-autodoc-display-module-p' is on." (make-variable-buffer-local (defvar geiser-autodoc--cached-signatures nil)) -(defun geiser-autodoc--get-signatures (funs) +(defun geiser-autodoc--get-signatures (funs &optional keep-cached) (when funs (let ((missing) (cached)) (if (not geiser-autodoc--cached-signatures) @@ -77,14 +77,16 @@ when `geiser-autodoc-display-module-p' is on." (let ((cf (assq f geiser-autodoc--cached-signatures))) (if cf (push cf cached) (push f missing))))) - (unless cached + (unless (or cached keep-cached) (setq geiser-autodoc--cached-signatures nil)) - (if (not missing) geiser-autodoc--cached-signatures + (when missing (let ((res (geiser-eval--send/result `(:eval ((:ge autodoc) (quote ,missing))) 500))) (when res - (setq geiser-autodoc--cached-signatures (append cached res)))))))) + (setq geiser-autodoc--cached-signatures + (append res (if keep-cached geiser-autodoc--cached-signatures cached)))))) + geiser-autodoc--cached-signatures))) (defun geiser-autodoc--insert-args (args current &optional pos) (dolist (a args) @@ -109,8 +111,9 @@ when `geiser-autodoc-display-module-p' is on." proc))) (propertize str 'face 'geiser-font-lock-autodoc-procedure-name))) -(defun geiser-autodoc--str (proc desc signature) - (let ((args (cdr (assoc 'args signature))) +(defun geiser-autodoc--str (desc signature) + (let ((proc (car desc)) + (args (cdr (assoc 'args signature))) (module (cdr (assoc 'module signature)))) (if (not args) (geiser-autodoc--proc-name proc module) (let ((cpos 1) @@ -140,15 +143,15 @@ when `geiser-autodoc-display-module-p' is on." (insert ")") (buffer-string)))))) -(defun geiser-autodoc--autodoc (path) - (let* ((funs (mapcar 'car path)) - (signs (geiser-autodoc--get-signatures funs))) - (when signs - (catch 'signature - (dolist (f funs) - (let ((signature (cdr (assq f signs)))) - (when signature - (throw 'signature (geiser-autodoc--str f (assq f path) signature))))))))) +(defun geiser-autodoc--autodoc (path &optional keep-cached) + (let ((signs (geiser-autodoc--get-signatures (mapcar 'car path) keep-cached)) + (p (car path)) + (s)) + (while (and path (not s)) + (unless (setq s (cdr (assq (car p) signs))) + (setq p (car path)) + (setq path (cdr path)))) + (when s (geiser-autodoc--str p s)))) ;;; Autodoc function: diff --git a/elisp/geiser-company.el b/elisp/geiser-company.el index 8ae8969..ef4ce38 100644 --- a/elisp/geiser-company.el +++ b/elisp/geiser-company.el @@ -38,7 +38,7 @@ (ignore-errors (if module (format "%s [module]" id) - (geiser-autodoc--autodoc (list (list (intern id) 0)))))) + (geiser-autodoc--autodoc (list (list (intern id) 0)) t)))) (defsubst geiser-company--doc-buffer (id module) nil) @@ -61,11 +61,11 @@ (defun geiser-company--setup (enable) (setq geiser-company--enabled-flag enable) + (when (boundp 'company-lighter) + (setq company-lighter "/C")) (when (fboundp 'company-mode) (company-mode nil) - (when enable (company-mode enable))) - (when (boundp 'company-lighter) - (setq company-lighter "/C"))) + (when enable (company-mode enable)))) (defun geiser-company--inhibit-autodoc (ignored) (setq geiser-autodoc--inhibit-flag t)) diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el index 8e5c816..29f0de2 100644 --- a/elisp/geiser-doc.el +++ b/elisp/geiser-doc.el @@ -175,8 +175,7 @@ (message "No documentation available for '%s'" symbol) (geiser-doc--with-buffer (erase-buffer) - (geiser-doc--insert-title (geiser-autodoc--str (format "%s" symbol) - nil + (geiser-doc--insert-title (geiser-autodoc--str (list (format "%s" symbol) 0) (cdr (assoc 'signature ds)))) (newline) (insert (or (cdr (assoc 'docstring ds)) "")) -- cgit v1.2.3 From fd316e2c5b7b2868d7e5ba571af90de258d005f6 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Wed, 26 Aug 2009 00:57:58 +0200 Subject: Company: handling correctly the mode lighter and autodoc interaction. --- elisp/geiser-company.el | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/elisp/geiser-company.el b/elisp/geiser-company.el index ef4ce38..15b9cb8 100644 --- a/elisp/geiser-company.el +++ b/elisp/geiser-company.el @@ -31,6 +31,9 @@ (make-variable-buffer-local (defvar geiser-company--enabled-flag nil)) +(make-variable-buffer-local + (defvar geiser-company--autodoc-flag nil)) + (defsubst geiser-company--candidates (prefix module) (car (geiser-completion--complete prefix module))) @@ -50,28 +53,31 @@ (if module (geiser-edit-module id) (geiser-edit-symbol id)) (cons (current-buffer) (point)))))) -(defsubst geiser-company--prefix-at-point (module) - (and geiser-company--enabled-flag - (looking-at-p "\\_>") - (not (nth 8 (syntax-ppss))) - (geiser-completion--prefix module))) +(defun geiser-company--prefix-at-point (module) + (when geiser-company--enabled-flag + (cond ((nth 8 (syntax-ppss)) 'stop) + ((looking-at-p "\\_>") (geiser-completion--prefix module)) + (module 'stop) + (t nil)))) ;;; Activation (defun geiser-company--setup (enable) (setq geiser-company--enabled-flag enable) - (when (boundp 'company-lighter) - (setq company-lighter "/C")) + (when (boundp 'company-default-lighter) + (set (make-local-variable 'company-default-lighter) "/C")) (when (fboundp 'company-mode) (company-mode nil) (when enable (company-mode enable)))) (defun geiser-company--inhibit-autodoc (ignored) - (setq geiser-autodoc--inhibit-flag t)) + (when (setq geiser-company--autodoc-flag geiser-autodoc-mode) + (geiser-autodoc-mode -1))) (defun geiser-company--restore-autodoc (&optional ignored) - (setq geiser-autodoc--inhibit-flag nil)) + (when geiser-company--autodoc-flag + (geiser-autodoc-mode 1))) ;;; Backends: -- cgit v1.2.3 From 69643a0d6d214a164117a49696b08073cfbe58e5 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Wed, 26 Aug 2009 00:58:36 +0200 Subject: Slightly faster autodoc. --- elisp/geiser-autodoc.el | 37 ++++++++++++++++++++----------------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index c2746a0..e00f6b6 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -70,23 +70,26 @@ when `geiser-autodoc-display-module-p' is on." (defun geiser-autodoc--get-signatures (funs &optional keep-cached) (when funs - (let ((missing) (cached)) - (if (not geiser-autodoc--cached-signatures) - (setq missing funs) - (dolist (f funs) - (let ((cf (assq f geiser-autodoc--cached-signatures))) - (if cf (push cf cached) - (push f missing))))) - (unless (or cached keep-cached) - (setq geiser-autodoc--cached-signatures nil)) - (when missing - (let ((res (geiser-eval--send/result `(:eval ((:ge autodoc) - (quote ,missing))) - 500))) - (when res - (setq geiser-autodoc--cached-signatures - (append res (if keep-cached geiser-autodoc--cached-signatures cached)))))) - geiser-autodoc--cached-signatures))) + (let ((fs (assq (car funs) geiser-autodoc--cached-signatures))) + (if fs + (list fs) + (let ((missing) (cached)) + (if (not geiser-autodoc--cached-signatures) + (setq missing funs) + (dolist (f funs) + (let ((cf (assq f geiser-autodoc--cached-signatures))) + (if cf (push cf cached) + (push f missing))))) + (unless (or cached keep-cached) + (setq geiser-autodoc--cached-signatures nil)) + (when missing + (let ((res (geiser-eval--send/result `(:eval ((:ge autodoc) + (quote ,missing))) + 500))) + (when res + (setq geiser-autodoc--cached-signatures + (append res (if keep-cached geiser-autodoc--cached-signatures cached)))))) + geiser-autodoc--cached-signatures))))) (defun geiser-autodoc--insert-args (args current &optional pos) (dolist (a args) -- cgit v1.2.3 From e7cdf10b94d7f5e66a5b3a6e7e65439ef35f874f Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Wed, 26 Aug 2009 12:23:53 +0200 Subject: Company's go to location working also for locations in same file. --- elisp/geiser-company.el | 10 ++++++---- elisp/geiser-edit.el | 16 +++++++++------- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/elisp/geiser-company.el b/elisp/geiser-company.el index 15b9cb8..2fb89f4 100644 --- a/elisp/geiser-company.el +++ b/elisp/geiser-company.el @@ -41,7 +41,8 @@ (ignore-errors (if module (format "%s [module]" id) - (geiser-autodoc--autodoc (list (list (intern id) 0)) t)))) + (or (geiser-autodoc--autodoc (list (list (intern id) 0)) t) + (format "%s [local id]" id))))) (defsubst geiser-company--doc-buffer (id module) nil) @@ -49,9 +50,10 @@ (defun geiser-company--location (id module) (ignore-errors (let ((id (intern id))) - (save-current-buffer - (if module (geiser-edit-module id) (geiser-edit-symbol id)) - (cons (current-buffer) (point)))))) + (save-excursion + (if module + (geiser-edit-module id 'noselect) + (geiser-edit-symbol id 'noselect)))))) (defun geiser-company--prefix-at-point (module) (when geiser-company--enabled-flag diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el index 418b6e3..0ec1669 100644 --- a/elisp/geiser-edit.el +++ b/elisp/geiser-edit.el @@ -56,6 +56,7 @@ or following links in error buffers.") (defun geiser-edit--visit-file (file method) (cond ((eq method 'window) (find-file-other-window file)) ((eq method 'frame) (find-file-other-frame file)) + ((eq method 'noselect) (find-file-noselect file t)) (t (find-file file)))) (defsubst geiser-edit--location-name (loc) @@ -126,10 +127,11 @@ or following links in error buffers.") (geiser-edit--goto-line symbol line) (when col (beginning-of-line) - (forward-char col)))) + (forward-char col)) + (cons (current-buffer) (point)))) -(defsubst geiser-edit--try-edit (symbol ret) - (geiser-edit--try-edit-location symbol (geiser-eval--retort-result ret))) +(defsubst geiser-edit--try-edit (symbol ret &optional method) + (geiser-edit--try-edit-location symbol (geiser-eval--retort-result ret) method)) ;;; Links @@ -155,13 +157,13 @@ or following links in error buffers.") (defvar geiser-edit--symbol-history nil) -(defun geiser-edit-symbol (symbol) +(defun geiser-edit-symbol (symbol &optional method) "Asks for a symbol to edit, with completion." (interactive (list (geiser-completion--read-symbol "Edit symbol: " nil geiser-edit--symbol-history))) (let ((cmd `(:eval ((:ge symbol-location) ',symbol)))) - (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd)))) + (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd) method))) (defun geiser-edit-symbol-at-point (&optional arg) "Opens a new window visiting the definition of the symbol at point. @@ -181,11 +183,11 @@ With prefix, asks for the symbol to edit." (pop-tag-mark) (error "No previous location for find symbol invocation"))) -(defun geiser-edit-module (module) +(defun geiser-edit-module (module &optional method) "Asks for a module and opens it in a new buffer." (interactive (list (geiser-completion--read-module))) (let ((cmd `(:eval ((:ge module-location) (:module ,module))))) - (geiser-edit--try-edit module (geiser-eval--send/wait cmd)))) + (geiser-edit--try-edit module (geiser-eval--send/wait cmd) method))) (provide 'geiser-edit) -- cgit v1.2.3 From d33d6d6973005f9f148a09f4a59aaa72eca96de6 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Wed, 26 Aug 2009 15:13:42 +0200 Subject: Quicker metadata display in company mode. --- elisp/geiser-company.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/elisp/geiser-company.el b/elisp/geiser-company.el index 2fb89f4..37c2196 100644 --- a/elisp/geiser-company.el +++ b/elisp/geiser-company.el @@ -67,11 +67,8 @@ (defun geiser-company--setup (enable) (setq geiser-company--enabled-flag enable) - (when (boundp 'company-default-lighter) - (set (make-local-variable 'company-default-lighter) "/C")) - (when (fboundp 'company-mode) - (company-mode nil) - (when enable (company-mode enable)))) + (when (fboundp 'geiser-company--setup-company) + (geiser-company--setup-company enable))) (defun geiser-company--inhibit-autodoc (ignored) (when (setq geiser-company--autodoc-flag geiser-autodoc-mode) @@ -100,6 +97,11 @@ (eval-after-load "company" '(progn + (defun geiser-company--setup-company (enable) + (set (make-local-variable 'company-default-lighter) "/C") + (set (make-local-variable 'company-echo-delay) 0.01) + (company-mode nil) + (when enable (company-mode enable))) (geiser-company--make-backend company-geiser-ids nil) (geiser-company--make-backend company-geiser-modules t) (add-to-list 'company-backends geiser-company--backend) -- cgit v1.2.3 From fb39ae2fcc37bd2f0b44b16627e99af7e7daecc6 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Thu, 27 Aug 2009 00:05:13 +0200 Subject: Better detection of locals (internal defines). - The implementation is still buggy, though, because it uses the elisp reader, which bails at some scheme syntaxes (e.g. chars) --- elisp/geiser-syntax.el | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index 789b6e9..937107b 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -144,10 +144,13 @@ geiser-syntax--delim-regexp)) (defconst geiser-syntax--ldefine-regexp - (format "\\=[[(]define%s%s" geiser-syntax--ident-regexp geiser-syntax--delim-regexp)) + (format "[[(]define%s%s" geiser-syntax--ident-regexp geiser-syntax--delim-regexp)) (defconst geiser-syntax--define-regexp - (format "\\=[[(]\\(?:define\\|lambda\\)%s[[(]" geiser-syntax--delim-regexp)) + (format "[[(]\\(?:define\\)%s[[(]" geiser-syntax--delim-regexp)) + +(defconst geiser-syntax--lambda-regexp + (format "[[(]\\(?:lambda\\)%s[[(]" geiser-syntax--delim-regexp)) (defun geiser-syntax--locals-around-point () (when (eq major-mode 'scheme-mode) @@ -165,13 +168,21 @@ (dolist (l (nreverse (geiser-syntax--read-list p))) (when (and (listp l) (symbolp (car l))) (push (car l) ids)))) + ((looking-at geiser-syntax--ldefine-regexp) + (when (match-string 1) (push (intern (match-string 1)) ids)) + (goto-char (min p (match-end 0)))) + ((or (looking-at geiser-syntax--define-regexp) + (looking-at geiser-syntax--lambda-regexp)) + (goto-char (min p (1- (match-end 0)))) + (dolist (s (nreverse (geiser-syntax--read-list p))) + (let ((sn (if (listp s) (car s) s))) + (when (symbolp sn) (push sn ids))))) ((re-search-forward geiser-syntax--ldefine-regexp p t) (when (match-string 1) (push (intern (match-string 1)) ids))) ((re-search-forward geiser-syntax--define-regexp p t) (backward-char 1) - (dolist (s (nreverse (geiser-syntax--read-list p))) - (let ((sn (if (listp s) (car s) s))) - (when (symbolp sn) (push sn ids))))) + (let ((s (car (geiser-syntax--read-list p)))) + (when (symbolp s) (push s ids)))) (t (goto-char (1+ p)))))))) (nreverse ids))))) -- cgit v1.2.3 From e2b9d184157eb789a751d0c32999fe85829e936e Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Thu, 27 Aug 2009 11:43:12 +0200 Subject: Small configure tweaks. --- autogen.sh | 2 +- configure.ac | 3 --- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/autogen.sh b/autogen.sh index f084b65..781eabd 100755 --- a/autogen.sh +++ b/autogen.sh @@ -2,4 +2,4 @@ [ -f elisp/geiser.el ] || exit 1 -autoreconf -Wall +autoreconf -Wall -i diff --git a/configure.ac b/configure.ac index f8ed7ec..2333901 100644 --- a/configure.ac +++ b/configure.ac @@ -20,9 +20,6 @@ AC_CHECK_PROG(TEXI2PDF, texi2pdf, texi2pdf, false) AM_PATH_LISPDIR -dnl scheme/plt/Makefile -dnl scheme/plt/geiser/Makefile - AC_CONFIG_FILES([ Makefile elisp/Makefile -- cgit v1.2.3 From abe824fdc168e3405426b2df47de4178eb3e4276 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 30 Aug 2009 11:19:09 +0200 Subject: Biting the bullet: a simple, permissive, scheme reader. Currently put to (let's hope, good) use for context parsing in autodoc and locals discovery (internal defines are recognised now). --- elisp/geiser-autodoc.el | 9 ++- elisp/geiser-syntax.el | 209 ++++++++++++++++++++++++++++-------------------- 2 files changed, 128 insertions(+), 90 deletions(-) diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index e00f6b6..75f2e7c 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -71,8 +71,7 @@ when `geiser-autodoc-display-module-p' is on." (defun geiser-autodoc--get-signatures (funs &optional keep-cached) (when funs (let ((fs (assq (car funs) geiser-autodoc--cached-signatures))) - (if fs - (list fs) + (unless fs (let ((missing) (cached)) (if (not geiser-autodoc--cached-signatures) (setq missing funs) @@ -88,8 +87,10 @@ when `geiser-autodoc-display-module-p' is on." 500))) (when res (setq geiser-autodoc--cached-signatures - (append res (if keep-cached geiser-autodoc--cached-signatures cached)))))) - geiser-autodoc--cached-signatures))))) + (append res (if keep-cached + geiser-autodoc--cached-signatures + cached)))))))) + geiser-autodoc--cached-signatures))) (defun geiser-autodoc--insert-args (args current &optional pos) (dolist (a args) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index 937107b..5cfbc32 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -80,9 +80,89 @@ (with-syntax 1)) -;;; Code parsing: +;;; A simple scheme reader + +(defvar geiser-syntax--read/buffer-limit nil) + +(defsubst geiser-syntax--read/eos () + (or (eobp) + (and (numberp geiser-syntax--read/buffer-limit) + (<= geiser-syntax--read/buffer-limit (point))))) + +(defsubst geiser-syntax--read/next-char () + (unless (geiser-syntax--read/eos) + (forward-char) + (char-after))) + +(defsubst geiser-syntax--read/token (token) + (geiser-syntax--read/next-char) + (if (listp token) token (list token))) + +(defsubst geiser-syntax--read/elisp () + (ignore-errors (read (current-buffer)))) + +(defun geiser-syntax--read/next-token () + (skip-syntax-forward "->") + (if (geiser-syntax--read/eos) '(eob) + (let ((c (char-after))) + (cond ((not c) '(eob)) + ((eq c '\;) + (skip-syntax-forward "^>") + (geiser-syntax--read/next-token)) + ((memq c '(?\( ?\[)) (geiser-syntax--read/token 'lparen)) + ((memq c '(?\) ?\])) (geiser-syntax--read/token 'rparen)) + ((eq c ?.) + (if (memq (syntax-after (1+ (point))) '(0 11 12)) + (geiser-syntax--read/token 'dot) + (cons 'atom (geiser-syntax--read/elisp)))) + ((eq c ?\#) + (let ((c (geiser-syntax--read/next-char))) + (cond ((not c) '(eob)) + ((eq c ?\\) (cons 'char (geiser-syntax--read/elisp))) + ((eq c ?\() (geiser-syntax--read/token 'vectorb)) + (t (geiser-syntax--read/next-token))))) + ((eq c ?\') (geiser-syntax--read/token '(quote . quote))) + ((eq c ?\`) (geiser-syntax--read/token + `(backquote . ,backquote-backquote-symbol))) + ((eq c ?,) (if (eq (geiser-syntax--read/next-char) ?@) + (geiser-syntax--read/token + `(splice . ,backquote-splice-symbol)) + `(unquote . ,backquote-unquote-symbol))) + ((eq c ?\") (cons 'string (geiser-syntax--read/elisp))) + (t (cons 'atom (geiser-syntax--read/elisp))))))) + +(defsubst geiser-syntax--read/match (&rest tks) + (let ((token (geiser-syntax--read/next-token))) + (if (memq (car token) tks) token + (error "Unexpected token: %s" token)))) + +(defsubst geiser-syntax--read/try (&rest tks) + (let ((p (point)) + (tk (ignore-errors (apply 'geiser-syntax--read/match tks)))) + (unless tk (goto-char p)) + tk)) + +(defun geiser-syntax--read/list () + (cond ((geiser-syntax--read/try 'dot) + (let ((tail (geiser-syntax--read))) + (geiser-syntax--read/match 'eob 'rparen) + tail)) + ((geiser-syntax--read/try 'rparen 'eob) nil) + (t (cons (geiser-syntax--read) + (geiser-syntax--read/list))))) + +(defun geiser-syntax--read () + (let ((token (geiser-syntax--read/next-token))) + (case (car token) + (eob nil) + (lparen (geiser-syntax--read/list)) + (vectorb (apply 'vector (geiser-syntax--read/list))) + ((quote backquote unquote splice) (list (cdr token) (geiser-syntax--read))) + ((char string atom) (cdr token)) + (t (error "Reading scheme syntax: unexpected token: %s" token))))) -(geiser-popup--define syntax " *geiser syntax analyst*" scheme-mode) + +;;; Code parsing: (defsubst geiser-syntax--skip-comment/string () (goto-char (or (nth 8 (syntax-ppss)) (point)))) @@ -90,105 +170,62 @@ (defsubst geiser-syntax--nesting-level () (or (nth 0 (syntax-ppss)) 0)) -(defun geiser-syntax--scan-sexp () - (let ((p (point)) - (n -1) - prev head) - (ignore-errors - (backward-up-list) - (save-excursion - (forward-char) - (skip-syntax-forward "^_w(" p) - (when (setq head (symbol-at-point)) - (while (< (point) p) - (setq n (1+ n)) - (setq prev (symbol-at-point)) - (forward-sexp)))) - (if head (list head n (and (> n 1) prev)) 'skip)))) - (defun geiser-syntax--scan-sexps () (save-excursion - (geiser-syntax--skip-comment/string) - (let* ((sap (symbol-at-point)) - (fst (and sap (geiser-syntax--scan-sexp))) - (path (and fst - (cond ((not (listp fst)) `((,sap 0))) - ((eq sap (car fst)) (list fst)) - (t (list fst (list sap 0))))))) - (while (setq fst (geiser-syntax--scan-sexp)) - (when (listp fst) (push fst path))) + (let* ((fst (symbol-at-point)) + (path (and fst (list (list fst 0))))) + (while (not (zerop (geiser-syntax--nesting-level))) + (let ((geiser-syntax--read/buffer-limit (1+ (point)))) + (backward-up-list) + (let ((form (save-excursion (geiser-syntax--read)))) + (when (and (listp form) (car form) (symbolp (car form))) + (let* ((len-1 (1- (length form))) + (prev (and (> len-1 1) (nth (1- len-1) form)))) + (push `(,(car form) ,len-1 ,@(and prev (symbolp prev) (list prev))) + path)))))) (nreverse path)))) -(defsubst geiser-syntax--listify (l &optional strict) - (cond ((vectorp l) (append l nil)) - ((listp l) l) - (strict nil) - (t l))) - -(defun geiser-syntax--read-list (p) - (let ((list (geiser-syntax--listify (ignore-errors (read (current-buffer))) t))) - (if (and list (< (point) p)) - (mapcar 'geiser-syntax--listify list) - (goto-char p) - nil))) - -(defconst geiser-syntax--delim-regexp "\\(?:\\s-\\|\\s<\\|\\s>\\|$\\|\n\\)+") - -(defconst geiser-syntax--ident-regexp - (format "\\(?:%s\\([^[ (]+?\\)\\)" geiser-syntax--delim-regexp)) - -(defconst geiser-syntax--let-regexp - (format "\\=[[(]let\\(?:\\*\\|rec\\|%s\\|%s\\)%s*[[(]" - geiser-syntax--ident-regexp - geiser-syntax--delim-regexp - geiser-syntax--delim-regexp)) - -(defconst geiser-syntax--ldefine-regexp - (format "[[(]define%s%s" geiser-syntax--ident-regexp geiser-syntax--delim-regexp)) - -(defconst geiser-syntax--define-regexp - (format "[[(]\\(?:define\\)%s[[(]" geiser-syntax--delim-regexp)) - -(defconst geiser-syntax--lambda-regexp - (format "[[(]\\(?:lambda\\)%s[[(]" geiser-syntax--delim-regexp)) - (defun geiser-syntax--locals-around-point () (when (eq major-mode 'scheme-mode) (save-excursion (geiser-syntax--skip-comment/string) - (let ((ids)) + (let* ((ids) + (push-id (lambda (n) (when (symbolp n) (push n ids)))) + (get-arg (lambda (n) (if (listp n) (car n) n))) + (push-ids (lambda (is) (mapc push-id (nreverse (mapcar get-arg is)))))) (while (not (zerop (geiser-syntax--nesting-level))) - (let ((p (point))) + (let ((geiser-syntax--read/buffer-limit (point))) (backward-up-list) - (save-excursion - (while (< (point) p) - (cond ((re-search-forward geiser-syntax--let-regexp p t) - (when (match-string 1) (push (intern (match-string 1)) ids)) - (backward-char 1) - (dolist (l (nreverse (geiser-syntax--read-list p))) - (when (and (listp l) (symbolp (car l))) - (push (car l) ids)))) - ((looking-at geiser-syntax--ldefine-regexp) - (when (match-string 1) (push (intern (match-string 1)) ids)) - (goto-char (min p (match-end 0)))) - ((or (looking-at geiser-syntax--define-regexp) - (looking-at geiser-syntax--lambda-regexp)) - (goto-char (min p (1- (match-end 0)))) - (dolist (s (nreverse (geiser-syntax--read-list p))) - (let ((sn (if (listp s) (car s) s))) - (when (symbolp sn) (push sn ids))))) - ((re-search-forward geiser-syntax--ldefine-regexp p t) - (when (match-string 1) (push (intern (match-string 1)) ids))) - ((re-search-forward geiser-syntax--define-regexp p t) - (backward-char 1) - (let ((s (car (geiser-syntax--read-list p)))) - (when (symbolp s) (push s ids)))) - (t (goto-char (1+ p)))))))) + (let* ((form (save-excursion (geiser-syntax--read))) + (head (and (listp form) (car form))) + (snd (and head (cadr form))) + (third (and head (caddr form))) + (is (case head + ((define define*) (if (listp snd) snd (list snd))) + ((let* letrec lambda let) + (if (listp snd) snd + (cons snd (and (eq head 'let) + (listp third) + third)))))) + (body (and is (case head + ((define define*) (and (listp snd) (cddr form))) + ((let let* letrec lambda) + (if (listp snd) (cddr form) + (cdddr form))))))) + (when is + (funcall push-ids + (mapcar 'cdr + (remove-if (lambda (f) (or (not (listp f)) + (not (eq (car f) 'define)))) + body))) + (funcall push-ids is))))) (nreverse ids))))) ;;; Fontify strings as Scheme code: +(geiser-popup--define syntax " *geiser syntax analyst*" scheme-mode) + (defun geiser-syntax--font-lock-buffer () (let ((name " *geiser font lock*")) (or (get-buffer name) -- cgit v1.2.3 From b3aaa30d9a655028d6b39c477f1b1a92a872415a Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 30 Aug 2009 11:52:15 +0200 Subject: Tagging keywords as such in the scheme reader, for later spotting of active argument in autodoc. --- elisp/geiser-syntax.el | 59 +++++++++++++++++++++++++++----------------------- 1 file changed, 32 insertions(+), 27 deletions(-) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index 5cfbc32..91993be 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -104,32 +104,32 @@ (defun geiser-syntax--read/next-token () (skip-syntax-forward "->") (if (geiser-syntax--read/eos) '(eob) - (let ((c (char-after))) - (cond ((not c) '(eob)) - ((eq c '\;) - (skip-syntax-forward "^>") - (geiser-syntax--read/next-token)) - ((memq c '(?\( ?\[)) (geiser-syntax--read/token 'lparen)) - ((memq c '(?\) ?\])) (geiser-syntax--read/token 'rparen)) - ((eq c ?.) - (if (memq (syntax-after (1+ (point))) '(0 11 12)) - (geiser-syntax--read/token 'dot) - (cons 'atom (geiser-syntax--read/elisp)))) - ((eq c ?\#) - (let ((c (geiser-syntax--read/next-char))) - (cond ((not c) '(eob)) - ((eq c ?\\) (cons 'char (geiser-syntax--read/elisp))) - ((eq c ?\() (geiser-syntax--read/token 'vectorb)) - (t (geiser-syntax--read/next-token))))) - ((eq c ?\') (geiser-syntax--read/token '(quote . quote))) - ((eq c ?\`) (geiser-syntax--read/token - `(backquote . ,backquote-backquote-symbol))) - ((eq c ?,) (if (eq (geiser-syntax--read/next-char) ?@) - (geiser-syntax--read/token - `(splice . ,backquote-splice-symbol)) - `(unquote . ,backquote-unquote-symbol))) - ((eq c ?\") (cons 'string (geiser-syntax--read/elisp))) - (t (cons 'atom (geiser-syntax--read/elisp))))))) + (case (char-after) + (\; + (skip-syntax-forward "^>") + (geiser-syntax--read/next-token)) + ((?\( ?\[) (geiser-syntax--read/token 'lparen)) + ((?\) ?\]) (geiser-syntax--read/token 'rparen)) + (?. (if (memq (syntax-after (1+ (point))) '(0 11 12)) + (geiser-syntax--read/token 'dot) + (cons 'atom (geiser-syntax--read/elisp)))) + (?\# (let ((c (geiser-syntax--read/next-char))) + (cond ((not c) '(eob)) + ((eq c ?:) + (if (geiser-syntax--read/next-char) + (cons 'kwd (geiser-syntax--read/elisp)) + '(eob))) + ((eq c ?\\) (cons 'char (geiser-syntax--read/elisp))) + ((eq c ?\() (geiser-syntax--read/token 'vectorb)) + (t (geiser-syntax--read/next-token))))) + (?\' (geiser-syntax--read/token '(quote . quote))) + (?\` (geiser-syntax--read/token + `(backquote . ,backquote-backquote-symbol))) + (?, (if (eq (geiser-syntax--read/next-char) ?@) + (geiser-syntax--read/token `(splice . ,backquote-splice-symbol)) + `(unquote . ,backquote-unquote-symbol))) + (?\" (cons 'string (geiser-syntax--read/elisp))) + (t (cons 'atom (geiser-syntax--read/elisp)))))) (defsubst geiser-syntax--read/match (&rest tks) (let ((token (geiser-syntax--read/next-token))) @@ -158,9 +158,13 @@ (lparen (geiser-syntax--read/list)) (vectorb (apply 'vector (geiser-syntax--read/list))) ((quote backquote unquote splice) (list (cdr token) (geiser-syntax--read))) + (kwd `(:keyword . ,(cdr token))) ((char string atom) (cdr token)) (t (error "Reading scheme syntax: unexpected token: %s" token))))) +(defsubst geiser-syntax--read/keyword-value (s) + (and (consp s) (eq (car s) :keyword) (cdr s))) + ;;; Code parsing: @@ -180,7 +184,8 @@ (let ((form (save-excursion (geiser-syntax--read)))) (when (and (listp form) (car form) (symbolp (car form))) (let* ((len-1 (1- (length form))) - (prev (and (> len-1 1) (nth (1- len-1) form)))) + (prev (and (> len-1 1) (nth (1- len-1) form))) + (prev (and prev (geiser-syntax--read/keyword-value prev)))) (push `(,(car form) ,len-1 ,@(and prev (symbolp prev) (list prev))) path)))))) (nreverse path)))) -- cgit v1.2.3 From 04630a92cf4a6a48cac29b7b4569c65158e57d26 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 30 Aug 2009 23:53:19 +0200 Subject: Improved local names detection (both implementation- and functional-wise). --- elisp/geiser-syntax.el | 66 +++++++++++++++++++++++++------------------------- 1 file changed, 33 insertions(+), 33 deletions(-) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index 91993be..13cab62 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -86,7 +86,7 @@ (defsubst geiser-syntax--read/eos () (or (eobp) - (and (numberp geiser-syntax--read/buffer-limit) + (and geiser-syntax--read/buffer-limit (<= geiser-syntax--read/buffer-limit (point))))) (defsubst geiser-syntax--read/next-char () @@ -165,6 +165,10 @@ (defsubst geiser-syntax--read/keyword-value (s) (and (consp s) (eq (car s) :keyword) (cdr s))) +(defsubst geiser-syntax--form-after-point (&optional boundary) + (let ((geiser-syntax--read/buffer-limit (and (numberp boundary) boundary))) + (save-excursion (values (geiser-syntax--read) (point))))) + ;;; Code parsing: @@ -179,9 +183,9 @@ (let* ((fst (symbol-at-point)) (path (and fst (list (list fst 0))))) (while (not (zerop (geiser-syntax--nesting-level))) - (let ((geiser-syntax--read/buffer-limit (1+ (point)))) + (let ((boundary (1+ (point)))) (backward-up-list) - (let ((form (save-excursion (geiser-syntax--read)))) + (let ((form (nth-value 0 (geiser-syntax--form-after-point boundary)))) (when (and (listp form) (car form) (symbolp (car form))) (let* ((len-1 (1- (length form))) (prev (and (> len-1 1) (nth (1- len-1) form))) @@ -190,41 +194,37 @@ path)))))) (nreverse path)))) +(defun geiser-syntax--scan-locals (form partial locals) + (flet ((if-symbol (x) (and (symbolp x) x)) + (if-list (x) (and (listp x) x)) + (normalize (vars) (mapcar (lambda (i) (if (listp i) (car i) i)) vars))) + (cond ((or (null form) (not (listp form))) (normalize locals)) + ((not (memq (car form) '(define let let* letrec lambda))) + (geiser-syntax--scan-locals (car (last form)) partial locals)) + (t + (let* ((head (car form)) + (name (if-symbol (cadr form))) + (names (if name (if-list (caddr form)) (if-list (cadr form)))) + (rest (if name (cdddr form) (cddr form))) + (use-names (or (eq head 'let*) (not partial) rest))) + (when name (push name locals)) + (when use-names (dolist (n names) (push n locals))) + (dolist (f (butlast rest)) + (when (eq (car f) 'define) (push (cadr f) locals))) + (geiser-syntax--scan-locals (car (last (or rest names))) + partial + locals)))))) + (defun geiser-syntax--locals-around-point () (when (eq major-mode 'scheme-mode) (save-excursion (geiser-syntax--skip-comment/string) - (let* ((ids) - (push-id (lambda (n) (when (symbolp n) (push n ids)))) - (get-arg (lambda (n) (if (listp n) (car n) n))) - (push-ids (lambda (is) (mapc push-id (nreverse (mapcar get-arg is)))))) + (let ((boundary (point))) (while (not (zerop (geiser-syntax--nesting-level))) - (let ((geiser-syntax--read/buffer-limit (point))) - (backward-up-list) - (let* ((form (save-excursion (geiser-syntax--read))) - (head (and (listp form) (car form))) - (snd (and head (cadr form))) - (third (and head (caddr form))) - (is (case head - ((define define*) (if (listp snd) snd (list snd))) - ((let* letrec lambda let) - (if (listp snd) snd - (cons snd (and (eq head 'let) - (listp third) - third)))))) - (body (and is (case head - ((define define*) (and (listp snd) (cddr form))) - ((let let* letrec lambda) - (if (listp snd) (cddr form) - (cdddr form))))))) - (when is - (funcall push-ids - (mapcar 'cdr - (remove-if (lambda (f) (or (not (listp f)) - (not (eq (car f) 'define)))) - body))) - (funcall push-ids is))))) - (nreverse ids))))) + (backward-up-list)) + (multiple-value-bind (form end) + (geiser-syntax--form-after-point boundary) + (geiser-syntax--scan-locals form (> end boundary) '())))))) ;;; Fontify strings as Scheme code: -- cgit v1.2.3 From fff6b102f88479f470d3d02a905674c594edb154 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 7 Sep 2009 00:17:12 +0200 Subject: Scheme reader improvements: #<>, #||# and other bits. --- elisp/geiser-syntax.el | 62 +++++++++++++++++++++++++++++++++++--------------- 1 file changed, 44 insertions(+), 18 deletions(-) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index 13cab62..ca218c8 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -101,32 +101,52 @@ (defsubst geiser-syntax--read/elisp () (ignore-errors (read (current-buffer)))) +(defun geiser-syntax--read/matching (open close) + (let ((count 1) + (p (1+ (point)))) + (while (and (> count 0) + (geiser-syntax--read/next-char)) + (cond ((looking-at-p open) (setq count (1+ count))) + ((looking-at-p close) (setq count (1- count))))) + (buffer-substring-no-properties p (point)))) + +(defsubst geiser-syntax--read/unprintable () + (geiser-syntax--read/token + (cons 'unprintable (geiser-syntax--read/matching "<" ">")))) + +(defun geiser-syntax--read/skip-comment () + (while (and (geiser-syntax--read/next-char) + (nth 8 (syntax-ppss)))) + (geiser-syntax--read/next-token)) + (defun geiser-syntax--read/next-token () (skip-syntax-forward "->") (if (geiser-syntax--read/eos) '(eob) (case (char-after) - (\; - (skip-syntax-forward "^>") - (geiser-syntax--read/next-token)) + (?\; (geiser-syntax--read/skip-comment)) ((?\( ?\[) (geiser-syntax--read/token 'lparen)) ((?\) ?\]) (geiser-syntax--read/token 'rparen)) (?. (if (memq (syntax-after (1+ (point))) '(0 11 12)) (geiser-syntax--read/token 'dot) (cons 'atom (geiser-syntax--read/elisp)))) - (?\# (let ((c (geiser-syntax--read/next-char))) - (cond ((not c) '(eob)) - ((eq c ?:) - (if (geiser-syntax--read/next-char) - (cons 'kwd (geiser-syntax--read/elisp)) - '(eob))) - ((eq c ?\\) (cons 'char (geiser-syntax--read/elisp))) - ((eq c ?\() (geiser-syntax--read/token 'vectorb)) - (t (geiser-syntax--read/next-token))))) + (?\# (case (geiser-syntax--read/next-char) + ('nil '(eob)) + (?| (geiser-syntax--read/skip-comment)) + (?: (if (geiser-syntax--read/next-char) + (cons 'kwd (geiser-syntax--read/elisp)) + '(eob))) + (?\\ (cons 'char (geiser-syntax--read/elisp))) + (?\( (geiser-syntax--read/token 'vectorb)) + (?\< (geiser-syntax--read/unprintable)) + (t (let ((tok (geiser-syntax--read/elisp))) + (if tok (cons 'atom (intern (format "#%s" tok))) + (geiser-syntax--read/next-token)))))) (?\' (geiser-syntax--read/token '(quote . quote))) (?\` (geiser-syntax--read/token `(backquote . ,backquote-backquote-symbol))) (?, (if (eq (geiser-syntax--read/next-char) ?@) - (geiser-syntax--read/token `(splice . ,backquote-splice-symbol)) + (geiser-syntax--read/token + `(splice . ,backquote-splice-symbol)) `(unquote . ,backquote-unquote-symbol))) (?\" (cons 'string (geiser-syntax--read/elisp))) (t (cons 'atom (geiser-syntax--read/elisp)))))) @@ -157,8 +177,10 @@ (eob nil) (lparen (geiser-syntax--read/list)) (vectorb (apply 'vector (geiser-syntax--read/list))) - ((quote backquote unquote splice) (list (cdr token) (geiser-syntax--read))) + ((quote backquote unquote splice) (list (cdr token) + (geiser-syntax--read))) (kwd `(:keyword . ,(cdr token))) + (unprintable (format "#<%s>" (cdr token))) ((char string atom) (cdr token)) (t (error "Reading scheme syntax: unexpected token: %s" token))))) @@ -185,12 +207,15 @@ (while (not (zerop (geiser-syntax--nesting-level))) (let ((boundary (1+ (point)))) (backward-up-list) - (let ((form (nth-value 0 (geiser-syntax--form-after-point boundary)))) + (let ((form + (nth-value 0 (geiser-syntax--form-after-point boundary)))) (when (and (listp form) (car form) (symbolp (car form))) (let* ((len-1 (1- (length form))) (prev (and (> len-1 1) (nth (1- len-1) form))) - (prev (and prev (geiser-syntax--read/keyword-value prev)))) - (push `(,(car form) ,len-1 ,@(and prev (symbolp prev) (list prev))) + (prev (and prev + (geiser-syntax--read/keyword-value prev)))) + (push `(,(car form) + ,len-1 ,@(and prev (symbolp prev) (list prev))) path)))))) (nreverse path)))) @@ -204,7 +229,8 @@ (t (let* ((head (car form)) (name (if-symbol (cadr form))) - (names (if name (if-list (caddr form)) (if-list (cadr form)))) + (names (if name (if-list (caddr form)) + (if-list (cadr form)))) (rest (if name (cdddr form) (cddr form))) (use-names (or (eq head 'let*) (not partial) rest))) (when name (push name locals)) -- cgit v1.2.3