From 94be6173b640411e8205778fc7e080f6fbdac9dc 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(-) (limited to 'elisp/geiser-autodoc.el') 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 9d64bcb33f7ac1b3a06220842d04ce3c0534948e 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(-) (limited to 'elisp/geiser-autodoc.el') 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 283e6f040449bb4f740991956007332c48308b38 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 ++++++++ scheme/guile/geiser/doc.scm | 85 ++++++------------------- scheme/plt/geiser/autodoc.ss | 97 ++++++++-------------------- 4 files changed, 149 insertions(+), 208 deletions(-) (limited to 'elisp/geiser-autodoc.el') 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) diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm index 3f060e3..d951f1c 100644 --- a/scheme/guile/geiser/doc.scm +++ b/scheme/guile/geiser/doc.scm @@ -37,76 +37,33 @@ #:use-module (oop goops) #:use-module (srfi srfi-1)) -(define (autodoc form) - (cond ((null? form) #f) - ((symbol? form) (describe-application (list form))) - ((not (pair? form)) #f) - ((not (list? form)) (autodoc (pair->list form))) - ((define-head? form) => autodoc) - (else (autodoc/list form)))) - -(define (autodoc/list form) - (let ((lst (last form))) - (cond ((and (symbol? lst) (describe-application (list lst)))) - ((and (pair? lst) (not (memq (car lst) '(quote))) (autodoc lst))) - (else (describe-application form))))) - -(define (define-head? form) - (define defforms '(define define* define-macro define-macro* - define-method define-class define-generic)) - (and (= 2 (length form)) - (memq (car form) defforms) - (car form))) - -(define (describe-application form) - (let* ((fun (car form)) - (args (obj-args (symbol->object fun)))) +(define (autodoc ids) + (if (not (list? ids)) + '() + (map (lambda (id) (or (autodoc* id) (list id))) ids))) + +(define (autodoc* id) + (let ((args (obj-args (symbol->object id)))) (and args - (list (cons 'signature (signature fun args)) - (cons 'position (find-position args form)) - (cons 'module (symbol-module fun)))))) + `(,@(signature id args) + (module . ,(symbol-module id)))))) (define (object-signature name obj) (let ((args (obj-args obj))) (and args (signature name args)))) -(define (signature fun args) - (let ((req (arglst args 'required)) - (opt (arglst args 'optional)) - (key (arglst args 'keyword)) - (rest (assq-ref args 'rest))) - (let ((sgn `(,fun ,@req - ,@(if (not (null? opt)) (cons 'geiser-opt_marker opt) '()) - ,@(if (not (null? key)) (cons 'geiser-key_maker key) '())))) - (if rest `(,@sgn geiser-rest_marker ,rest) sgn)))) - -(define (find-position args form) - (let* ((lf (length form)) - (lf-1 (- lf 1))) - (if (= 1 lf) 0 - (let ((req (length (arglst args 'required))) - (opt (length (arglst args 'optional))) - (keys (map (lambda (k) (symbol->keyword (if (list? k) (car k) k))) - (arglst args 'keyword))) - (rest (assq-ref args 'rest))) - (cond ((<= lf (+ 1 req)) lf-1) - ((<= lf (+ 1 req opt)) (if (> opt 0) lf lf-1)) - ((or (memq (last form) keys) - (memq (car (take-right form 2)) keys)) => - (lambda (sl) - (+ 2 req - (if (> opt 0) (+ 1 opt) 0) - (- (length keys) (length sl))))) - (else (+ 1 req - (if (> opt 0) (+ 1 opt) 0) - (if (null? keys) 0 (+ 1 (length keys))) - (if rest 2 0)))))))) - -(define (arglst args kind) - (let ((args (assq-ref args kind))) - (cond ((or (not args) (null? args)) '()) - ((list? args) args) - (else (list args))))) +(define (signature id args) + (define (arglst kind) + (let ((args (assq-ref args kind))) + (cond ((or (not args) (null? args)) '()) + ((list? args) args) + (else (list args))))) + `(,id + (required ,@(arglst 'required)) + (optional ,@(arglst 'optional) + ,@(let ((rest (assq-ref args 'rest))) + (if rest (list "...") '()))) + (key ,@(arglst 'keyword)))) (define (obj-args obj) (cond ((not obj) #f) diff --git a/scheme/plt/geiser/autodoc.ss b/scheme/plt/geiser/autodoc.ss index 6607a94..2fe3a83 100644 --- a/scheme/plt/geiser/autodoc.ss +++ b/scheme/plt/geiser/autodoc.ss @@ -31,39 +31,32 @@ (eval `(help ,symbol #:from ,mod))))) (eval `(help ,symbol)))) -(define (autodoc form) - (cond ((null? form) #f) - ((symbol? form) (describe-application (list form))) - ((not (pair? form)) #f) - ((not (list? form)) (autodoc (pair->list form))) - ((define-head? form) => autodoc) - (else (autodoc/list form)))) - -(define (autodoc/list form) - (let ((lst (last form))) - (cond ((and (symbol? lst) (describe-application (list lst)))) - ((and (pair? lst) (not (memq (car lst) '(quote))) (autodoc lst))) - (else (describe-application form))))) - -(define (define-head? form) - (define defforms '(-define - define define-values - define-method define-class define-generic define-struct - define-syntax define-syntaxes -define-syntax)) - (and (= 2 (length form)) - (memq (car form) defforms) - (car form))) - -(define (describe-application form) - (let* ((fun (car form)) - (loc (symbol-location* fun)) - (name (car loc)) - (path (cdr loc)) - (sgn (and path (find-signature path name fun)))) - (and sgn - (list (cons 'signature (format-signature fun sgn)) - (cons 'position (find-position sgn form)) - (cons 'module (module-path-name->name path)))))) +(define (autodoc ids) + (if (not (list? ids)) + '() + (map (lambda (id) (or (autodoc* id) (list id))) ids))) + +(define (autodoc* id) + (and + (symbol? id) + (let* ((loc (symbol-location* id)) + (name (car loc)) + (path (cdr loc)) + (sgn (and path (find-signature path name id)))) + (and sgn + `(,id + (name . ,name) + ,@(format-signature sgn) + (module . ,(module-path-name->name path))))))) + +(define (format-signature sign) + (if (signature? sign) + `((required ,@(signature-required sign)) + (optional ,@(signature-optional sign) + ,@(let ((rest (signature-rest sign))) + (if rest (list "...") '()))) + (key ,@(signature-keys sign))) + '())) (define signatures (make-hash)) @@ -167,44 +160,6 @@ (opt-no (- max-val min-val))) (make-signature (args 0 min-val) (args min-val opt-no) '() #f))))) -(define (format-signature fun sign) - (cond ((symbol? sign) (cons fun sign)) - ((signature? sign) - (let ((req (signature-required sign)) - (opt (signature-optional sign)) - (keys (signature-keys sign)) - (rest (signature-rest sign))) - `(,fun - ,@req - ,@(if (null? opt) opt (cons 'geiser-opt_marker opt)) - ,@(if (null? keys) keys (cons 'geiser-key_maker keys)) - ,@(if rest (list 'geiser-rest_marker rest) '())))) - (else #f))) - -(define (find-position sign form) - (if (signature? sign) - (let* ((lf (length form)) - (lf-1 (- lf 1))) - (if (= 1 lf) 0 - (let ((req (length (signature-required sign))) - (opt (length (signature-optional sign))) - (keys (map (lambda (k) (symbol->keyword (if (list? k) (car k) k))) - (signature-keys sign))) - (rest (signature-rest sign))) - (cond ((<= lf (+ 1 req)) lf-1) - ((<= lf (+ 1 req opt)) (if (> opt 0) lf lf-1)) - ((or (memq (last form) keys) - (memq (car (take-right form 2)) keys)) => - (lambda (sl) - (+ 2 req - (if (> opt 0) (+ 1 opt) 0) - (- (length keys) (length sl))))) - (else (+ 1 req - (if (> opt 0) (+ 1 opt) 0) - (if (null? keys) 0 (+ 1 (length keys))) - (if rest 2 0))))))) - 0)) - (define (update-module-cache path . form) (when (and (string? path) (or (null? form) -- cgit v1.2.3 From 18db590dece0f88c3f2bd850a3158bb50605e2c6 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 ++++++++-------- scheme/guile/geiser/doc.scm | 16 ++++++++----- scheme/plt/geiser/autodoc.ss | 6 ++--- 5 files changed, 54 insertions(+), 47 deletions(-) (limited to 'elisp/geiser-autodoc.el') 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 diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm index d951f1c..bc4acd9 100644 --- a/scheme/guile/geiser/doc.scm +++ b/scheme/guile/geiser/doc.scm @@ -37,6 +37,8 @@ #:use-module (oop goops) #:use-module (srfi srfi-1)) +(define *an-object* #t) + (define (autodoc ids) (if (not (list? ids)) '() @@ -59,17 +61,19 @@ ((list? args) args) (else (list args))))) `(,id - (required ,@(arglst 'required)) - (optional ,@(arglst 'optional) - ,@(let ((rest (assq-ref args 'rest))) - (if rest (list "...") '()))) - (key ,@(arglst 'keyword)))) + (args ,@(if (list? args) + `((required ,@(arglst 'required)) + (optional ,@(arglst 'optional) + ,@(let ((rest (assq-ref args 'rest))) + (if rest (list "...") '()))) + (key ,@(arglst 'keyword))) + '())))) (define (obj-args obj) (cond ((not obj) #f) ((or (procedure? obj) (program? obj)) (arguments obj)) ((macro? obj) (or (obj-args (macro-transformer obj)) '((required ...)))) - (else #f))) + (else 'variable))) (define (arguments proc) (cond diff --git a/scheme/plt/geiser/autodoc.ss b/scheme/plt/geiser/autodoc.ss index 2fe3a83..c43f8c9 100644 --- a/scheme/plt/geiser/autodoc.ss +++ b/scheme/plt/geiser/autodoc.ss @@ -46,7 +46,7 @@ (and sgn `(,id (name . ,name) - ,@(format-signature sgn) + (args ,@(format-signature sgn)) (module . ,(module-path-name->name path))))))) (define (format-signature sign) @@ -64,9 +64,7 @@ (define (find-signature path name local-name) (let ((path (if (path? path) (path->string path) path))) - (hash-ref! (hash-ref! signatures - path - (lambda () (parse-signatures path))) + (hash-ref! (hash-ref! signatures path (lambda () (parse-signatures path))) name (lambda () (infer-signature local-name))))) -- cgit v1.2.3 From 11e52e18251f6c2c5a9c7c37bbd4a1787e84b282 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-guile.el | 3 +++ elisp/geiser-impl.el | 58 ++++++++++++++++++++++++---------------------- elisp/geiser-log.el | 2 ++ 9 files changed, 66 insertions(+), 72 deletions(-) (limited to 'elisp/geiser-autodoc.el') 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-guile.el b/elisp/geiser-guile.el index ed2a555..ed14e87 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -27,6 +27,9 @@ (require 'geiser-syntax) (require 'geiser-custom) (require 'geiser-base) +(require 'geiser-eval) +(require 'geiser-edit) +(require 'geiser) ;;; Customization: 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 bc740d87f846f372f06263298495a9ff1506e4c7 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(-) (limited to 'elisp/geiser-autodoc.el') 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 f52ac22eb1c09f7eae9d53d7d12d15edac56f942 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 (limited to 'elisp/geiser-autodoc.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 98e199daf7b1a56179b670c192c7d244fcb2b323 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(-) (limited to 'elisp/geiser-autodoc.el') 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 2f5a1cce9e66e6f931749e5d3df6fe3fb220ad1f 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(-) (limited to 'elisp/geiser-autodoc.el') 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 2c6f07d95935668a82bbd549901da6d0949fbbe7 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(-) (limited to 'elisp/geiser-autodoc.el') 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