geiser-0.8.1/0000755000175000017500000000000012607252416011107 5ustar jaojaogeiser-0.8.1/geiser-guile.el0000644000175000017500000003444112607252416014020 0ustar jaojao;; geiser-guile.el -- guile's implementation of the geiser protocols ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sun Mar 08, 2009 23:03 (require 'geiser-connection) (require 'geiser-syntax) (require 'geiser-custom) (require 'geiser-base) (require 'geiser-eval) (require 'geiser-edit) (require 'geiser-log) (require 'geiser) (require 'compile) (require 'info-look) (eval-when-compile (require 'cl)) ;;; Customization: (defgroup geiser-guile nil "Customization for Geiser's Guile flavour." :group 'geiser) (geiser-custom--defcustom geiser-guile-binary (cond ((eq system-type 'windows-nt) "guile.exe") ((eq system-type 'darwin) "guile") (t "guile")) "Name to use to call the Guile executable when starting a REPL." :type '(choice string (repeat string)) :group 'geiser-guile) (geiser-custom--defcustom geiser-guile-load-path nil "A list of paths to be added to Guile's load path when it's started." :type '(repeat file) :group 'geiser-guile) (geiser-custom--defcustom geiser-guile-init-file "~/.guile-geiser" "Initialization file with user code for the Guile REPL. If all you want is to load ~/.guile, set `geiser-guile-load-init-file-p' instead." :type 'string :group 'geiser-guile) (geiser-custom--defcustom geiser-guile-load-init-file-p nil "Whether to load ~/.guile when starting Guile. Note that, due to peculiarities in the way Guile loads its init file, using `geiser-guile-init-file' is not equivalent to setting this variable to t." :type 'boolean :group 'geiser-guile) (geiser-custom--defcustom geiser-guile-debug-show-bt-p nil "Whether to autmatically show a full backtrace when entering the debugger. If `nil', only the last frame is shown." :type 'boolean :group 'geiser-guile) (geiser-custom--defcustom geiser-guile-jump-on-debug-p nil "Whether to autmatically jump to error when entering the debugger. If `t', Geiser will use `next-error' to jump to the error's location." :type 'boolean :group 'geiser-guile) (geiser-custom--defcustom geiser-guile-show-debug-help-p t "Whether to show brief help in the echo area when entering the debugger." :type 'boolean :group 'geiser-guile) (geiser-custom--defcustom geiser-guile-warning-level 'medium "Verbosity of the warnings reported by Guile. You can either choose one of the predefined warning sets, or provide a list of symbols identifying the ones you want. Possible choices are arity-mismatch, unbound-variable, unused-variable and unused-toplevel. Unrecognised symbols are ignored. The predefined levels are: - Medium: arity-mismatch, unbound-variable, format - High: arity-mismatch, unbound-variable, unused-variable, format - None: no warnings Changes to the value of this variable will automatically take effect on new REPLs. For existing ones, use the command \\[geiser-guile-update-warning-level]." :type '(choice (const :tag "Medium (arity and unbound vars)" medium) (const :tag "High (also unused vars)" high) (const :tag "No warnings" none) (repeat :tag "Custom" symbol)) :group 'geiser-guile) (geiser-custom--defcustom geiser-guile-extra-keywords nil "Extra keywords highlighted in Guile scheme buffers." :type '(repeat string) :group 'geiser-guile) (geiser-custom--defcustom geiser-guile-case-sensitive-p t "Non-nil means keyword highlighting is case-sensitive." :type 'boolean :group 'geiser-guile) (geiser-custom--defcustom geiser-guile-manual-lookup-other-window-p nil "Non-nil means pop up the Info buffer in another window." :type 'boolean :group 'geiser-guile) (geiser-custom--defcustom geiser-guile-manual-lookup-nodes '("Guile" "guile-2.0") "List of info nodes that, when present, are used for manual lookups" :type '(repeat string) :group 'geiser-guile) ;;; REPL support: (defun geiser-guile--binary () (if (listp geiser-guile-binary) (car geiser-guile-binary) geiser-guile-binary)) (defun geiser-guile--parameters () "Return a list with all parameters needed to start Guile. This function uses `geiser-guile-init-file' if it exists." (let ((init-file (and (stringp geiser-guile-init-file) (expand-file-name geiser-guile-init-file))) (q-flags (and (not geiser-guile-load-init-file-p) '("-q")))) `(,@(and (listp geiser-guile-binary) (cdr geiser-guile-binary)) ,@q-flags "-L" ,(expand-file-name "guile/" geiser-scheme-dir) ,@(apply 'append (mapcar (lambda (p) (list "-L" p)) geiser-guile-load-path)) ,@(and init-file (file-readable-p init-file) (list "-l" init-file))))) ;;(defconst geiser-guile--prompt-regexp "^[^() \n]+@([^)]*?)> ") (defconst geiser-guile--prompt-regexp "[^@()]+@([^)]*?)> ") (defconst geiser-guile--debugger-prompt-regexp "[^@()]+@([^)]*?) \\[[0-9]+\\]> ") ;;; Evaluation support: (defsubst geiser-guile--linearize-args (args) (mapconcat 'identity args " ")) (defun geiser-guile--geiser-procedure (proc &rest args) (case proc ((eval compile) (format ",geiser-eval %s %s%s" (or (car args) "#f") (geiser-guile--linearize-args (cdr args)) (if (cddr args) "" " ()"))) ((load-file compile-file) (format ",geiser-load-file %s" (car args))) ((no-values) ",geiser-no-values") (t (format "ge:%s (%s)" proc (geiser-guile--linearize-args args))))) (defconst geiser-guile--module-re "(define-module +\\(([^)]+)\\)") (defconst geiser-guile--library-re "(library +\\(([^)]+)\\)") (defun geiser-guile--get-module (&optional module) (cond ((null module) (save-excursion (geiser-syntax--pop-to-top) (if (or (re-search-backward geiser-guile--module-re nil t) (looking-at geiser-guile--library-re) (re-search-forward geiser-guile--module-re nil t)) (geiser-guile--get-module (match-string-no-properties 1)) :f))) ((listp module) module) ((stringp module) (condition-case nil (car (geiser-syntax--read-from-string module)) (error :f))) (t :f))) (defun geiser-guile--module-cmd (module fmt &optional def) (when module (let* ((module (geiser-guile--get-module module)) (module (cond ((or (null module) (eq module :f)) def) (t (format "%s" module))))) (and module (format fmt module))))) (defun geiser-guile--import-command (module) (geiser-guile--module-cmd module ",use %s")) (defun geiser-guile--enter-command (module) (geiser-guile--module-cmd module ",m %s" "(guile-user)")) (defun geiser-guile--exit-command () ",q") (defun geiser-guile--symbol-begin (module) (if module (max (save-excursion (beginning-of-line) (point)) (save-excursion (skip-syntax-backward "^(>") (1- (point)))) (save-excursion (skip-syntax-backward "^'-()>") (point)))) ;;; Error display (defun geiser-guile--enter-debugger () (let ((bt-cmd (format ",geiser-newline\n,error-message\n,%s\n" (if geiser-guile-debug-show-bt-p "bt" "fr")))) (compilation-forget-errors) (goto-char (point-max)) (geiser-repl--prepare-send) (comint-send-string nil bt-cmd) (when geiser-guile-show-debug-help-p (message "Debug REPL. Enter ,q to quit, ,h for help.")) (when geiser-guile-jump-on-debug-p (accept-process-output (get-buffer-process (current-buffer)) 0.2 nil t) (ignore-errors (next-error))))) (defun geiser-guile--display-error (module key msg) (newline) (when (stringp msg) (save-excursion (insert msg)) (geiser-edit--buttonize-files)) (and (not key) msg (not (zerop (length msg))))) ;;; Trying to ascertain whether a buffer is Guile Scheme: (defconst geiser-guile--guess-re (format "\\(%s\\|#! *.+\\(/\\| \\)guile\\( *\\\\\\)?\\)" geiser-guile--module-re)) (defun geiser-guile--guess () (save-excursion (goto-char (point-min)) (re-search-forward geiser-guile--guess-re nil t))) ;;; Keywords and syntax (defconst geiser-guile--builtin-keywords '("call-with-input-file" "call-with-input-string" "call-with-output-file" "call-with-output-string" "call-with-prompt" "call-with-trace" "define-accessor" "define-class" "define-enumeration" "define-inlinable" "define-syntax-parameter" "eval-when" "lambda*" "syntax-parameterize" "use-modules" "with-error-to-file" "with-error-to-port" "with-error-to-string" "with-fluid*" "with-fluids" "with-fluids*" "with-input-from-port" "with-input-from-string" "with-output-to-port" "with-output-to-string")) (defun geiser-guile--keywords () (append (geiser-syntax--simple-keywords geiser-guile-extra-keywords) (geiser-syntax--simple-keywords geiser-guile--builtin-keywords) `((,(rx "(" (group "define-once") eow (* space) (? (group (+ word)))) (1 font-lock-keyword-face) (2 font-lock-variable-name-face nil t)) ("(\\(define-module\\) +(\\([^)]+\\))" (1 font-lock-keyword-face) (2 font-lock-type-face nil t))))) (geiser-syntax--scheme-indent (c-declare 0) (c-lambda 2) (call-with-input-string 1) (call-with-output-string 0) (call-with-prompt 1) (call-with-trace 0) (eval-when 1) (lambda* 1) (pmatch defun) (sigaction 1) (syntax-parameterize 1) (with-error-to-file 1) (with-error-to-port 1) (with-error-to-string 0) (with-fluid* 1) (with-fluids 1) (with-fluids* 1) (with-input-from-string 1) (with-method 1) (with-mutex 1) (with-output-to-string 0) (with-throw-handler 1)) ;;; Compilation shell regexps (defconst geiser-guile--path-rx "^In \\([^:\n ]+\\):\n") (defconst geiser-guile--rel-path-rx "^In +\\([^/\n :]+\\):\n") (defvar geiser-guile--file-cache (make-hash-table :test 'equal)) (defun geiser-guile--resolve-file (file) (when (and (stringp file) (not (member file '("socket" "stdin" "unknown file")))) (if (file-name-absolute-p file) file (or (gethash file geiser-guile--file-cache) (puthash file (geiser-eval--send/result `(:eval (:ge find-file ,file))) geiser-guile--file-cache))))) (defun geiser-guile--resolve-file-x () (let ((f (geiser-guile--resolve-file (match-string-no-properties 1)))) (and (stringp f) (list f)))) ;;; REPL startup (defconst geiser-guile-minimum-version "2.0") (defun geiser-guile--version (binary) (shell-command-to-string (format "%s -c '(display (version))'" binary))) (defun geiser-guile-update-warning-level () "Update the warning level used by the REPL. The new level is set using the value of `geiser-guile-warning-level'." (interactive) (let ((code `(:eval (:ge set-warnings ',geiser-guile-warning-level) (geiser evaluation)))) (geiser-eval--send/result code))) (defun connect-to-guile () "Start a Guile REPL connected to a remote process. Start the external Guile process with the flag --listen to make it spawn a server thread." (interactive) (geiser-connect 'guile)) (defun geiser-guile--set-geiser-load-path () (let* ((path (expand-file-name "guile/" geiser-scheme-dir)) (witness "geiser/emacs.scm") (code `(begin (if (not (%search-load-path ,witness)) (set! %load-path (cons ,path %load-path))) 'done))) (geiser-eval--send/wait code))) (defun geiser-guile--startup (remote) (set (make-local-variable 'compilation-error-regexp-alist) `((,geiser-guile--path-rx geiser-guile--resolve-file-x) ("^ +\\([0-9]+\\):\\([0-9]+\\)" nil 1 2))) (compilation-setup t) (font-lock-add-keywords nil `((,geiser-guile--path-rx 1 compilation-error-face))) (let ((geiser-log-verbose-p t)) (when remote (geiser-guile--set-geiser-load-path)) (geiser-eval--send/wait ",use (geiser emacs)\n'done") (dolist (dir geiser-guile-load-path) (let ((dir (expand-file-name dir))) (geiser-eval--send/wait `(:eval (:ge add-to-load-path ,dir))))) (geiser-guile-update-warning-level))) ;;; Manual lookup (defun geiser-guile--info-spec (&optional nodes) (let* ((nrx "^[ ]+-+ [^:]+:[ ]*") (drx "\\b") (res (when (Info-find-file "r5rs" t) `(("(r5rs)Index" nil ,nrx ,drx))))) (dolist (node (or nodes geiser-guile-manual-lookup-nodes) res) (when (Info-find-file node t) (mapc (lambda (idx) (add-to-list 'res (list (format "(%s)%s" node idx) nil nrx drx))) '("Variable Index" "Procedure Index" "R5RS Index")))))) (info-lookup-add-help :topic 'symbol :mode 'geiser-guile-mode :ignore-case nil :regexp "[^()`',\" \n]+" :doc-spec (geiser-guile--info-spec)) (defun guile--manual-look-up (id mod) (let ((info-lookup-other-window-flag geiser-guile-manual-lookup-other-window-p)) (info-lookup-symbol id 'geiser-guile-mode)) (when geiser-guile-manual-lookup-other-window-p (switch-to-buffer-other-window "*info*")) (search-forward (format "%s" id) nil t)) ;;; Implementation definition: (define-geiser-implementation guile (binary geiser-guile--binary) (arglist geiser-guile--parameters) (version-command geiser-guile--version) (minimum-version geiser-guile-minimum-version) (repl-startup geiser-guile--startup) (prompt-regexp geiser-guile--prompt-regexp) (debugger-prompt-regexp geiser-guile--debugger-prompt-regexp) (enter-debugger geiser-guile--enter-debugger) (marshall-procedure geiser-guile--geiser-procedure) (find-module geiser-guile--get-module) (enter-command geiser-guile--enter-command) (exit-command geiser-guile--exit-command) (import-command geiser-guile--import-command) (find-symbol-begin geiser-guile--symbol-begin) (display-error geiser-guile--display-error) (external-help guile--manual-look-up) (check-buffer geiser-guile--guess) (keywords geiser-guile--keywords) (case-sensitive geiser-guile-case-sensitive-p)) (geiser-impl--add-to-alist 'regexp "\\.scm$" 'guile t) (provide 'geiser-guile) geiser-0.8.1/geiser-eval.el0000644000175000017500000001624412607252416013643 0ustar jaojao;;; geiser-eval.el -- sending scheme code for evaluation ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sat Feb 07, 2009 22:35 ;; Functions, building on top of geiser-connection, to evaluate scheme ;; code. (require 'geiser-impl) (require 'geiser-connection) (require 'geiser-syntax) (require 'geiser-log) (require 'geiser-base) ;;; Plug-able functions: (make-variable-buffer-local (defvar geiser-eval--get-module-function nil)) (set-default 'geiser-eval--get-module-function nil) (defvar geiser-eval--get-impl-module nil) (geiser-impl--register-local-method 'geiser-eval--get-impl-module 'find-module '(lambda (&rest) nil) "Function used to obtain the module for current buffer. It takes an optional argument, for cases where we want to force its value.") (defun geiser-eval--get-module (&optional module) (if geiser-eval--get-module-function (funcall geiser-eval--get-module-function module) (funcall geiser-eval--get-impl-module module))) (defvar geiser-eval--geiser-procedure-function) (geiser-impl--register-local-method 'geiser-eval--geiser-procedure-function 'marshall-procedure 'identity "Function to translate a bare procedure symbol to one executable in the Scheme context. Return NULL for unsupported ones; at the very least, EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.") (defvar geiser-eval--unsupported nil) (geiser-impl--register-local-variable 'geiser-eval--unsupported 'unsupported-procedures nil "A list, or function returning a list, of the Geiser procedures not implemented by this Scheme implementation. Possible values include macroexpand, completions, module-completions, find-file, symbol-location, module-location, symbol-documentation, module-exports, autodoc, callers, callees and generic-methods.") (defun geiser-eval--supported-p (feat) (or (not geiser-eval--unsupported) (not (memq feat geiser-eval--unsupported)))) (defsubst geiser-eval--form (&rest args) (when (not (geiser-eval--supported-p (car args))) (error "Sorry, the %s scheme implementation does not support Geiser's %s" geiser-impl--implementation (car args))) (apply geiser-eval--geiser-procedure-function args)) ;;; Code formatting: (defsubst geiser-eval--load-file (file) (geiser-eval--form 'load-file (geiser-eval--scheme-str file))) (defsubst geiser-eval--comp-file (file) (geiser-eval--form 'compile-file (geiser-eval--scheme-str file))) (defsubst geiser-eval--module (code) (geiser-eval--scheme-str (cond ((or (null code) (eq code :t) (eq code :buffer)) (geiser-eval--get-module)) ((or (eq code :repl) (eq code :f)) :f) (t (geiser-eval--get-module code))))) (defsubst geiser-eval--eval (code) (geiser-eval--form 'eval (geiser-eval--module (nth 1 code)) (geiser-eval--scheme-str (nth 0 code)))) (defsubst geiser-eval--comp (code) (geiser-eval--form 'compile (geiser-eval--module (nth 1 code)) (geiser-eval--scheme-str (nth 0 code)))) (defsubst geiser-eval--ge (proc args) (apply 'geiser-eval--form (cons proc (mapcar 'geiser-eval--scheme-str args)))) (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) (cddr code))) ((eq (car code) :scm) (cadr code)) (t (concat "(" (mapconcat 'geiser-eval--scheme-str code " ") ")")))) ((symbolp code) (substring-no-properties (format "%s" code))) (t (substring-no-properties (format "%S" code))))) ;;; Code sending: (defvar geiser-eval--default-connection-function nil) (defsubst geiser-eval--connection () (and geiser-eval--default-connection-function (funcall geiser-eval--default-connection-function))) (defsubst geiser-eval--log (s) (geiser-log--info "RETORT: %S" s) s) (defsubst geiser-eval--code-str (code) (if (stringp code) code (geiser-eval--scheme-str code))) (defsubst geiser-eval--send (code cont &optional buffer) (geiser-con--send-string (geiser-eval--connection) (geiser-eval--code-str code) cont buffer)) (defvar geiser-eval--sync-retort nil) (defun geiser-eval--set-sync-retort (s) (setq geiser-eval--sync-retort (geiser-eval--log s))) (defun geiser-eval--send/wait (code &optional timeout buffer) (setq geiser-eval--sync-retort nil) (geiser-con--send-string/wait (geiser-eval--connection) (geiser-eval--code-str code) 'geiser-eval--set-sync-retort timeout buffer) geiser-eval--sync-retort) ;;; Retort parsing: (defsubst geiser-eval--retort-p (ret) (and (listp ret) (or (assoc 'error ret) (assoc 'result ret)))) (defsubst geiser-eval--retort-result (ret) (let ((values (cdr (assoc 'result ret)))) (car (geiser-syntax--read-from-string (car values))))) (defsubst geiser-eval--send/result (code &optional timeout buffer) (geiser-eval--retort-result (geiser-eval--send/wait code timeout buffer))) (defun geiser-eval--retort-result-str (ret prefix) (let* ((prefix (or prefix "=> ")) (nlprefix (concat "\n" prefix)) (values (cdr (assoc 'result ret)))) (if values (concat prefix (mapconcat 'identity values nlprefix)) (or prefix "(No value)")))) (defsubst geiser-eval--retort-output (ret) (cdr (assoc 'output ret))) (defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret))) (defsubst geiser-eval--error-key (err) (cdr (assoc 'key err))) (defsubst geiser-eval--error-subr (err) (cdr (assoc 'subr err))) (defsubst geiser-eval--error-msg (err) (cdr (assoc 'msg err))) (defsubst geiser-eval--error-rest (err) (cdr (assoc 'rest err))) (defun geiser-eval--error-str (err) (let* ((key (geiser-eval--error-key err)) (key-str (if key (format ": %s" key) ":")) (subr (geiser-eval--error-subr err)) (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)) (rest-str (if rest (format "\n %s" rest) ""))) (format "Error%s%s%s%s" subr-str key-str msg-str rest-str))) (provide 'geiser-eval) geiser-0.8.1/geiser.info0000644000175000017500000024502112607252416013246 0ustar jaojaoThis is geiser.info, produced by makeinfo version 6.0 from geiser.texi. This manual documents Geiser, an Emacs environment to hack in Scheme. Copyright (C) 2010, 2011, 2012, 2013, 2014, 2015 Jose Antonio Ortega Ruiz Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or any later version published by the Free Software Foundation; with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A copy of the license is available from the Free Software Foundation Web site at . The document was typeset with GNU Texinfo (http://www.gnu.org/software/texinfo/index.html). INFO-DIR-SECTION Emacs START-INFO-DIR-ENTRY * Geiser: (geiser). Emacs environment for Scheme hacking. END-INFO-DIR-ENTRY  File: geiser.info, Node: Top, Next: Introduction, Prev: (dir), Up: (dir) Geiser ****** This manual documents Geiser, an Emacs environment to hack in Scheme. Copyright (C) 2010, 2011, 2012, 2013, 2014, 2015 Jose Antonio Ortega Ruiz Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or any later version published by the Free Software Foundation; with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A copy of the license is available from the Free Software Foundation Web site at . The document was typeset with GNU Texinfo (http://www.gnu.org/software/texinfo/index.html). * Menu: * Introduction:: * Installation:: * The REPL:: * Between the parens:: * Cheat sheet:: * No hacker is an island:: * Index:: -- The Detailed Node Listing -- Introduction * Modus operandi:: * Showing off:: Installation * Must needs:: * The easy and quick way:: * From the source's mouth:: * Friends:: The REPL * Starting the REPL:: * First aids:: * Switching context:: * Completion and error handling:: * Autodoc and friends:: * Seeing is believing:: * Customization and tips:: Between the parens * Activating Geiser:: * The source and the REPL:: * Documentation helpers:: * To eval or not to eval:: * To err perchance to debug:: * Jumping around:: * Geiser writes for you:: Cheat sheet * Scheme buffers:: * REPL:: * Documentation browser:: Geiser is a collection of Emacs major and minor modes that conspire with one or more Scheme interpreters to keep the Lisp Machine Spirit alive. It draws inspiration (and a bit more) from environments such as Common Lisp's Slime, Factor's FUEL, Squeak or Emacs itself, and does its best to make Scheme hacking inside Emacs (even more) fun. Or, to be precise, what i (http://hacks-galore.org/jao) consider fun. Geiser is thus my humble contribution to the dynamic school of expression, and a reaction against what i perceive as a derailment, in modern times, of standard Scheme towards the static camp. Because i prefer growing and healing to poking at corpses, the continuously running Scheme interpreter takes the center of the stage in Geiser. A bundle of Elisp shims orchestrates the dialog between the Scheme interpreter, Emacs and, ultimately, the schemer, giving her access to live metadata. Here's how.  File: geiser.info, Node: Introduction, Next: Installation, Prev: Top, Up: Top 1 Introduction ************** Geiser is an Emacs environment to hack and have fun in Scheme. If that's enough for you, see *note Installation:: to get it running and *note The REPL:: for the fun part. * Menu: * Modus operandi:: * Showing off::  File: geiser.info, Node: Modus operandi, Next: Showing off, Prev: Introduction, Up: Introduction 1.1 Modus operandi ================== As already mentioned, Geiser relies on a running Scheme process to obtain the information it makes accessible to the programmer. There's little effort, on the Elisp side, to understand, say, the module system used by the Scheme implementation at hand; instead, a generic interface between the two worlds is defined, and each supported Scheme includes a library implementing that API, together with some wee shims in Elisp allowing the reuse of the Emacs-side framework, which constitutes the bulk of the code. While being as generic as possible, the Scheme-Elisp interface makes some assumptions about the capabilities and interaction mode of the corresponding REPL. In particular, Geiser expects the latter to support namespaces in the form of a module system, and to provide a well-defined way to establish the REPL's current namespace (or module), as well as the current file's module (or namespace). Thus, all evaluations performed by Geiser either in the REPL or in a source code buffer happen in the context of the current namespace. Every time you switch to a different file, you're switching namespaces automatically; at the REPL, you must request the switch explicitly (usually just using means provided by the Scheme implementation itself). If your favourite Scheme supports the above modus operandi, it has all that's needed for a bare-bones Geiser mode. But Geiser can, and will, use any metadata available: procedure arities and argument lists to display interactive help, documentation strings, location information to jump to definitions, export lists to provide completion, and so on and so forth. Although this is not an all-or-none proposition (Geiser can operate with just part of that functionality available), i initially concentrated in supporting those Schemes with the richest (to my knowledge) introspection capabilities, namely, Guile and Racket. Later on, Dan Leslie added support for Chicken, and there's active work to add support for scsh.  File: geiser.info, Node: Showing off, Prev: Modus operandi, Up: Introduction 1.2 Showing off =============== When working with a fully conniving Scheme, Geiser can offer the following functionality: * Form evaluation in the context of the current file's module. * Macro expansion. * File/module loading and/or compilation. * Namespace-aware identifier completion (including local bindings, names visible in the current module, and module names). * Autodoc: the echo area shows information about the signature of the procedure/macro around point automatically. * Jump to definition of identifier at point. * Access to documentation (including docstrings when the implementation provides it). * Listings of identifiers exported by a given module. * Listings of callers/callees of procedures. * Rudimentary support for debugging (when the REPL provides a debugger) and error navigation. * Support for multiple, simultaneous REPLs. * Support for image display in those Schemes that treat them as first class values. In the following pages, i'll try to explain what these features actually are (i'm just swanking here), and how to use them for your profit. But, before that, let's see how to install Geiser.  File: geiser.info, Node: Installation, Next: The REPL, Prev: Introduction, Up: Top 2 Installation ************** * Menu: * Must needs:: * The easy and quick way:: * From the source's mouth:: * Friends::  File: geiser.info, Node: Must needs, Next: The easy and quick way, Prev: Installation, Up: Installation 2.1 Must needs ============== If Geiser came with any guarantees, you'd break all of them by not using GNU Emacs 23.2 (or better: i regularly use it with a recent Emacs snapshot) and at least one of the supported Schemes, namely: * Racket (http://www.racket-lang.org) 6.0 or better * Guile (http://www.gnu.org/software/guile) 2.0.9 or better * Chicken (http://call-cc.org) 4.8.0 or better Since Geiser supports multiple REPLs, having both of them will just add to the fun. You'll also need Geiser itself. The quickest installation is via its ELPA package, as described in the next section. If you prefer to use the source code directly, it's not that difficult either: just keep on reading.  File: geiser.info, Node: The easy and quick way, Next: From the source's mouth, Prev: Must needs, Up: Installation 2.2 The easy and quick way ========================== Did i mention that the easiest way of installing Geiser is using its ELPA (http://emacswiki.org/emacs/ELPA) package? If you're using Emacs 24, ELPA (http://emacswiki.org/emacs/ELPA) is already there; for earlier versions, the page i just linked to twice will tell you where to find the goodies. ELPA packages live in repositories accessible via HTTP. You can find Geiser's package in either MELPA stable (http://melpa-stable.org/#/geiser) or, if you like living on the bleeding edge, MELPA (http://melpa.org/#/geiser) (directly from the git repo). To tell Emacs that an ELPA repo exists, you add it to 'package-archives': (require 'package) ;;; either the stable version: (add-to-list 'package-archives ;; choose either the stable or the latest git version: ;; '("melpa-stable" . "http://melpa-stable.org/packages/") '("melpa-unstable" . "http://melpa.org/packages/")) (package-initialize) And then installing Geiser is as easy as: M-x package-install RET geiser RET Alternatively, you can manually download the package file (http://download-mirror.savannah.gnu.org/releases/geiser/packages/geiser-0.8.1.tar), and install from your local disk with 'M-x package-install-file'. If you plan to use Chicken, you'll need also to fire a terminal and configure a couple of Chicken eggs: $ chicken-install -s apropos chicken-doc $ cd `csi -p '(chicken-home)'` $ curl http://3e8.org/pub/chicken-doc/chicken-doc-repo.tgz | sudo tar zx With that, you are pretty much all set up. See *note The REPL:: to start using Geiser.  File: geiser.info, Node: From the source's mouth, Next: Friends, Prev: The easy and quick way, Up: Installation 2.3 Installing from source ========================== Downloading Geiser .................. The latest release tarball can be found here (http://download-mirror.savannah.gnu.org/releases/geiser/0.8.1/). Just download geiser-0.8.1.tar.gz (http://download-mirror.savannah.gnu.org/releases/geiser/0.8.1/geiser-0.8.1.tar.gz) and untar it in a directory of your choice. If you feel like living on the bleeding edge, just grab Geiser from its Git repository over at Savannah (http://git.savannah.nongnu.org/cgit/geiser.git/), either with the following incantation: git clone git://git.sv.gnu.org/geiser.git or, if you happen to live behind a firewall, with the alternative: git clone http://git.sv.gnu.org/r/geiser.git You can also follow Geiser's development in one (https://github.com/jaor/geiser) or (http://repo.or.cz/w/geiser.git) three (http://gitorious.org/geiser) mirrors that are kept synchronized with the one at Savannah. Either way, you'll now be in possession of a copy of Geiser's libre code. I'll follow you into its directory and the next section. Setting it up ............. Geiser is ready to be used out of the box without much more ado. For the sake of concreteness, let's assume you put its source in the directory '~/lisp/geiser'. All you need to do is to add the following line to your Emacs initialisation file (be it '~/.emacs' or any of its moral equivalents): (load-file "~/lisp/geiser/elisp/geiser.el") or simply evaluate that form inside Emacs (you wouldn't kill a friend just to start using Geiser, would you?). That's it: you're ready to go (*note The REPL::). What? You still here? I promise the above is all that's needed to start using Geiser. But, in case you are missing your configure/make all install routine, by all means, you can go through those motions to byte compile and install Geiser too. That is, you enter the source directory and (since we grabbed the development tree) run the customary autogen script: $ cd ~/lisp/geiser $ ./autogen.sh I recommend that you compile Geiser in a separate directory: $ mkdir build && cd build $ ../configure $ make all Now you have two options: loading the byte-compiled Geiser from the 'elisp' subdirectory, or installing it system-wide. To load the byte-code from here, add this line to your initialisation file: (load "~/lisp/geiser/build/elisp/geiser-load") and eval that form and you're done (you could also restart Emacs, but killing your friends is widely considered bad form). Yes, that's 'load' and 'geiser-load' instead of 'load-file' and 'geiser.el'. If you prefer a system-wide installation, just type: $ sudo make install With the above spell, Geiser will be compiled and installed in a safe place inside Emacs load path. To load it into Emacs you'll need, instead of the 'load-file' form above, the following line in your initialisation file: (require 'geiser-install) Please note that we're requiring 'geiser-install', and not 'geiser', and that there's no 'load-file' to be seen this time. There are some ways of fine-tuning this process, mainly by providing additional arguments in the call to configure: you'll find those gory details in the file called 'INSTALL', right at the root of the source tree. The installation will also take care of placing this manual, in Info format, where Emacs can find it, so you can continue to learn about Geiser inside its natural habitat. See you there and into the next chapter!  File: geiser.info, Node: Friends, Prev: From the source's mouth, Up: Installation 2.4 Friends =========== Although Geiser does not need them, it plays well with (and is enhanced by) the following Emacs packages: * Paredit (http://www.emacswiki.org/emacs/ParEdit). Regardless of whether you use Geiser or not, you shouldn't be coding in any Lisp dialect without the aid of Taylor Campbell's structured editing mode. * Company (http://company-mode.github.io/). Nikolaj Schumacher's and Dmitry Gutov's 'company-mode' provides a generic front-end for completion engines (such as Geiser's), with pretty and automatic completion lists. * ac-geiser (https://github.com/xiaohanyu/ac-geiser/) If you prefer 'auto-complete-mode' to 'company-mode', Xiao Hanyu's 'ac-geiser', which provides a Geiser plugin for the popular Emacs Auto Completion Mode (http://cx4a.org/software/auto-complete/), is the package for you. Like Geiser, 'ac-geiser' is available in Marmalade and MELPA, and also as an 'el-get' package. * Quack (http://www.neilvandyke.org/quack/). You can still use the many goodies provided by Neil van Dyke's 'quack-mode', since most of them are not (yet) available in Geiser. The only caveat might be a conflict between Quack's and Geiser's default key bindings, which i'm sure you'll manage to tackle just fine. It's also probably a good idea to require 'quack' after loading 'geiser.el' (or requiring a compiled version). You just need to install and setup them as usual, for every package's definition of usual. Geiser will notice their presence and react accordingly.  File: geiser.info, Node: The REPL, Next: Between the parens, Prev: Installation, Up: Top 3 The REPL ********** If you've followed the instructions in *note Installation::, your Emacs is now ready to start playing. Otherwise, i'll wait for you: when you're ready, just come back here and proceed to the following sections. * Menu: * Starting the REPL:: * First aids:: * Switching context:: * Completion and error handling:: * Autodoc and friends:: * Seeing is believing:: * Customization and tips::  File: geiser.info, Node: Starting the REPL, Next: First aids, Prev: The REPL, Up: The REPL 3.1 Starting the REPL ===================== To start a Scheme REPL (meaning, a Scheme process offering you a Read-Eval-Print Loop), Geiser provides the generic interactive command 'run-geiser'. If you invoke it (via, as is customary in Emacs, 'M-x run-geiser'), you'll be saluted by a prompt asking which one of the supported implementations you want to launch--yes, you can stop the asking, see *note below: active-implementations. Tabbing for completion will offer you, as of this writing, 'guile' and 'racket'. Just choose your poison, and a new REPL buffer will pop up (by default, the REPL will appear in a new window: if that annoys you, just set 'geiser-repl-use-other-window' to 'nil' and the current window will be used). If all went according to plan, you'll be facing an implementation-dependent banner, followed by an interactive prompt. Going according to plan includes having the executable of the Scheme you chose in your path. If that's not the case, you can tell Emacs where it is, as described in *note a moment: impl-binary. Returning to our REPL, the first thing to notice is that the funny prompt is telling you your current module: its name is the part just after the @ sign (in Guile, that means 'guile-user', while Racket's and Chicken's top namespaces don't have a name; cf. discussion in *note Switching context::). than that, this is pretty much equivalent to having a command-line interpreter in a terminal, with a bunch of add-ons that we'll be reviewing below. You can start typing sexps right there: Geiser will only dispatch them for evaluation when they're complete, and will indent new lines properly until then. It will also keep track of your input, maintaining a history file that will be reloaded whenever you restart the REPL. If you're not happy with the faces Geiser is using for the REPL's prompt and evaluated input, you can customise 'geiser-font-lock-repl-prompt' and 'geiser-font-lock-repl-input' to better looking faces. Connecting to an external Scheme ................................ There's an alternative way of starting a Geiser REPL: you can connect to an external Scheme process, provided it's running a REPL server at some known port. How to make that happen depends on the Scheme implementation. If you use Guile, you just need to start your Guile process (possibly outside Emacs) passing to it the flag '--listen'. This flag accepts an optional port as argument (as in '--listen=1969'), if you don't want to use the default. In Racket, you have to use the REPL server that comes with Geiser. To that end, put Geiser's Racket 'scheme' directory in Racket's collection search path and invoke 'start-geiser' (a procedure in the module 'geiser/server') somewhere in your program, passing it the desired port and, if desired, network interface name. This procedure will start the REPL server in a separate thread. For an example of how to do that, see the script 'bin/geiser-racket.sh' in the source distribution, or, if you've compiled Geiser, 'bin/geiser-racket-noinst' in the build directory, or, if you've installed Geiser, 'geiser-racket' in '/bin'. These scripts start a new interactive Racket that is also running a REPL server (they also load the errortrace library to provide better diagnostics, but that's not strictly needed). With your external Scheme process running and serving, come back to Emacs and execute 'M-x geiser-connect', 'M-x connect-to-guile' or 'M-x connect-to-racket'. You'll be asked for a host and a port, and, voila, you'll have a Geiser REPL that is served by the remote Scheme process in a dedicated thread, meaning that your external program can go on doing whatever it was doing while you tinker with it from Emacs. Note, however, that all Scheme threads share the heap, so that you'll be able to interact with those other threads in the running Scheme from Emacs in a variety of ways. For starters, all your (re)definitions will be visible everywhere. That's dangerous, but will come in handy when you need to debug your running web server. The connection between Emacs and the Scheme process goes over TCP, so it can be as remote as you need, perhaps with the intervention of an SSH tunnel.  File: geiser.info, Node: First aids, Next: Switching context, Prev: Starting the REPL, Up: The REPL 3.2 First aids ============== A quick way of seeing what else Geiser's REPL can do for you, is to display the corresponding entry up there in your menu bar. No, i don't normally use menus either; but they can come in handy until you've memorized Geiser's commands, as a learning device. And yes, i usually run Emacs inside a terminal, but one can always use La Carte (http://www.emacswiki.org/emacs/LaCarte) to access the menus in a convenient enough fashion. Or just press 'C-h m' and be done with that. Among the commands at your disposal, we find the familiar input navigation keys, with a couple twists. By default, 'M-p' and 'M-n' are bound to matching items in your input history. That is, they'll find the previous or next sexp that starts with the current input prefix (defined as the text between the end of the prompt and your current position, a.k.a. "point", in the buffer). For going up and down the list unconditionally, just use 'C-c M-p' and 'C-c M-n'. In addition, navigation is sexp-based rather than line-based. There are also a few commands to twiddle with the Scheme process. 'C-c C-q' will gently ask it to quit, while 'C-u C-c C-q' will mercilessly kill the process (but not before stowing your history in the file system). Unless you're using a remote REPL, that is, in which case both commands will just sever the connection and leave the remote process alone. If worse comes to worst and the process is dead, 'C-c C-z' will restart it. However, the same shortcut, issued when the REPL is alive, will bring you back to the buffer you came from, as explained in *note this section: switching-repl-buff. The remaining commands are meatier, and deserve sections of their own.  File: geiser.info, Node: Switching context, Next: Completion and error handling, Prev: First aids, Up: The REPL 3.3 Switching context ===================== In tune with Geiser's modus operandi, evaluations in the REPL take place in the namespace of the current module. As noted above, the REPL's prompt tells you the name of the current module. To switch to a different one, you can use the command 'switch-to-geiser-module', bound to 'C-c C-m'. You'll notice that Geiser simply uses a couple of meta-commands provided by the Scheme REPL (the stock ',m' in Guile and Chicken and the (geiser-defined) ',enter' in Racket), and that it doesn't even try to hide that fact. That means that you can freely use said native ways directly at the REPL, and Geiser will be happy to oblige. In Racket, ',enter' works like Racket's standard 'enter!' form, but you can also provide a path string as its argument (e.g., ',enter "/tmp/foo.rkt"' is equivalent to ',enter (file "/tmp/foo.rkt")'). Like 'enter!', ',enter' accepts also module names (as in, say, ',enter geiser/main'). As mentioned, in Guile and Chicken, ',m' is used as is. Once you enter a new module, only those bindings visible in its namespace will be available to your evaluations. All Schemes supported by Geiser provide a way to import new modules in the current namespace. Again, there's a Geiser command, 'geiser-repl-import-module', to invoke such functionality, bound this time to 'C-c C-i'. And, again, you'll see Geiser just introducing the native incantation for you, and you're free to use such incantations by hand whenever you want. One convenience provided by these two Geiser commands is that completion is available when introducing the new module name, using the '' key. Pressing it at the command's prompt will offer you a prefix-aware list of available module names. Which brings me to the next group of REPL commands.  File: geiser.info, Node: Completion and error handling, Next: Autodoc and friends, Prev: Switching context, Up: The REPL 3.4 Completion and error handling ================================= We've already seen Geiser completion of module names in action at the minibuffer. You won't be surprised to know that it's also available at the REPL buffer itself. There, you can use either 'C-.' or 'M-`' to complete module names, and '' or 'M-' to complete identifiers. Geiser will know what identifiers are bound in the current module and show you a list of those starting with the prefix at point. Needless to say, this is not a static list, and it will grow as you define or import new bindings in the namespace at hand. If no completion is found, '' will try to complete the prefix after point as a module name. REPL buffers use Emacs' compilation mode to highlight errors reported by the Scheme interpreter, and you can use the 'next-error' command ('M-g n') to jump to their location. By default, every time you enter a new expression for evaluation old error messages are forgotten, so that 'M-g n' will always jump to errors related to the last evaluation request, if any. If you prefer a not-so-forgetful REPL, set the customization variable 'geiser-repl-forget-old-errors-p' to 'nil'. Note, however, that even when that variable is left as 't', you can always jump to an old error by moving to its line at the REPL and pressing ''. When your cursor is away from the last prompt, '' will move to the next error in the buffer, and you can use '' everywhere to go to the previous one.  File: geiser.info, Node: Autodoc and friends, Next: Seeing is believing, Prev: Completion and error handling, Up: The REPL 3.5 Autodoc and friends ======================= Oftentimes, there's more you'll want to know about an identifier besides its name: What module does it belong to? Is it a procedure and, if so, what arguments does it take? Geiser tries to help you answering those questions too. Actually, if you've been playing with the REPL as you read, you might have notice some frantic activity taking place in the echo area every now and then. That was Geiser trying to be helpful (while, hopefully, not being clippy), or, more concretely, what i call, for want of a better name, its "autodoc" mode. Whenever it's active (did you notice that A in the mode-line?), Geiser's gerbils will be scanning what you type and showing (unless you silence them with 'C-c C-d C-a') information about the identifier nearest to point. If that identifier corresponds to a variable visible in the current namespace, you'll see the module it belongs to and its value. For procedures and macros, autodoc will display, instead of their value, the argument names (or an underscore if Geiser cannot determine the name used in the definition). Optional arguments are surrounded by parentheses. When the optional argument has a default value, it's represented by a list made up of its name and that value. When the argument is a keyword argument, its name has "#:" as a prefix. If that's not enough documentation for you, 'C-c C-d d' will open a separate documentation buffer with help on the symbol at point. This buffer will contain implementation-specific information about the identifier (e.g., its docstring for Guile, or its contract, if any, for Racket), and a handy button to open the corresponding manual entry for the symbol, which will open an HTML page (for Racket and Chicken) or the texinfo manual (for Guile). If you'd rather go directly to the manual, try 'C-c C-d i', which invokes 'geiser-doc-look-up-manual' as the handy button does. Geiser can also produce for you a list, classified by kind, of the identifiers exported by a given module: all you need to do is press 'C-c C-d m', and type or complete the desired module's name. The list of exported bindings is shown, again, in a buffer belonging to Geiser's documentation browser, where you have at your disposal a bunch of navigation commands listed in *note our cheat-sheet: Documentation browser. We'll have a bit more to say about the documentation browser in *note a later section: doc-browser. If that's still not enough, Geiser can jump, via 'M-.', to the symbol's definition. A buffer with the corresponding file will pop up, with its point resting upon the identifier's defining form. When you're done inspecting, 'M-,' will bring you back to where you were. As we will see, these commands are also available in Scheme buffers. 'M-.' also works for modules: if your point is on an unambiguous module name, the file where it's defined will be opened for you.  File: geiser.info, Node: Seeing is believing, Next: Customization and tips, Prev: Autodoc and friends, Up: The REPL 3.6 Seeing is believing ======================= In schemes that support images as values (currently, that means Racket), the REPL will display them inline if you're using them in a graphics-aware Emacs. For the terminal, images will appear as buttons: press return on them to invoke an external viewer (configurable via 'geiser-image-viewer') that will show you the image at hand. You can also ask for the same behaviour on all emacsen by customising 'geiser-repl-inline-images-p' to 'nil'. Geiser keeps a cache of the last displayed images in the directory 'geiser-image-cache-dir', which defaults to the system's temp directory, with up to 'geiser-image-cache-keep-last' files. You can invoke the external image viewer on any of them with 'M-x geiser-view-last-image', which takes a prefix argument to indicate which image number you want, 0 corresponding to the newest one.  File: geiser.info, Node: Customization and tips, Prev: Seeing is believing, Up: The REPL 3.7 Customization and tips ========================== The looks and ways of the REPL can be fine-tuned via a bunch of customization variables. You can see and modify them all in the corresponding customization group (by using the menu entry or the good old 'M-x customize-group geiser-repl'), or by setting them in your Emacs initialisation files (as a rule, all knobs in Geiser are tunable this way: you don't need to use customization buffers if you don't like them). I'm documenting below a proper subset of those settings, together with some related tips. Choosing a Scheme implementation ................................ Instead of using the generic 'run-geiser' command, you can start directly your Scheme of choice via 'run-racket' or 'run-guile'. In addition, the variable 'geiser-active-implementations' contains a list of those Schemes Geiser should be aware of. Thus, if you happen to be, say, a racketeer not to be beguiled by other schemes, you can tell Geiser to forget about the richness of the Scheme ecosystem with something like: (setq geiser-active-implementations '(racket)) in your initialisation files. When starting a new REPL, Geiser assumes, by default, that the corresponding Scheme binary is in your path. If that's not the case, the variables to tweak are 'geiser-guile-binary' and 'geiser-racket-binary', which should be set to a string with the full path to the requisite binary. Before starting the REPL, Geiser will check wether the version of your Scheme interpreter is good enough. This means that it will spend a couple tenths of a second launching and quickly discarding a Scheme process, but also that the error message you'll get if you're on the wrong Scheme version will be much more informative. If you one to avoid version checks, just check 'geiser-repl-skip-version-check-p' to 't' in your configuration. You can also specify a couple more initialisation parameters. For Guile, 'geiser-guile-load-path' is a list of paths to add to its load path (and its compiled load path) when it's started, while 'geiser-guile-init-file' is the path to an initialisation file to be loaded on start-up. The equivalent variables for Racket are 'geiser-racket-collects' and 'geiser-racket-init-file'. Note, however, that specifying 'geiser-guile-init-file' is not equivalent to changing Guile's initialization file ('~/.guile'), because the former is loaded using the '-l' flag, together with '-q' to disable loading the second. But there are subtle differences in the way Guile loads the initialization file versus how it loads a file specified via the '-l' flag. If what you want is just loading '~/.guile', leave 'geiser-guile-init-file' alone and set 'geiser-guile-load-init-file-p' to 't' instead. Racket startup time ................... When starting Racket in little computers, Geiser might have to wait a bit more than it expects (which is ten seconds, or ten thousand milliseconds, by default). If you find that Geiser is giving up too quickly and complaining that no prompt was found, try to increase the value of 'geiser-repl-startup-time' to, say, twenty seconds: (setq geiser-repl-startup-time 20000) If you prefer, you can use the customize interface to, well, customise the above variable's value. History ....... By default, Geiser won't record duplicates in your input history. If you prefer it did, just set 'geiser-repl-history-no-dups-p' to 'nil'. History entries are persistent across REPL sessions: they're saved in implementation-specific files whose location is controlled by the variable 'geiser-repl-history-filename'. For example, my Geiser configuration includes the following line: (setq geiser-repl-history-filename "~/.emacs.d/geiser-history") which makes the files 'geiser-history.guile' and 'geiser-history.racket' to live inside my home's '.emacs.d' directory. Autodoc ....... If you happen to love peace and quiet and prefer to keep your REPL's echo area free from autodoc's noise, 'geiser-repl-autodoc-p' is the customization variable for you: set it to 'nil' and autodoc will be disabled by default in new REPLs. You can always bring the fairies back, on a per-REPL basis, using 'C-c C-d C-a'. Remote connections .................. When using 'connect-to-guile', 'connect-to-racket' or 'geiser-connect', you'll be prompted for a host and a port, defaulting to "localhost" and 37146. You can change those defaults customizing 'geiser-repl-default-host' and 'geiser-repl-default-port', respectively. Killing REPLs ............. If you don't want Emacs to ask for confirmation when you're about to kill a live REPL buffer (as will happen, for instance, if you're exiting Emacs before closing all your REPLs), you can set the flag 'geiser-repl-query-on-kill-p' to 'nil'. On a related note, the customizable variable 'geiser-repl-query-on-exit-p' controls whether Geiser should ask for confirmation when you exit the REPL explicitly (via, say, 'C-c C-q', as opposed to killing the buffer), and is set to 'nil' by default.  File: geiser.info, Node: Between the parens, Next: Cheat sheet, Prev: The REPL, Up: Top 4 Between the parens ******************** A good REPL is a must, but just about half the story of a good Scheme hacking environment. Well, perhaps a bit more than a half; but, at any rate, one surely needs also a pleasant way of editing source code. Don't pay attention to naysayers: Emacs comes with an excellent editor included for about any language on Earth, and just the best one when that language is sexpy (especially if you use Paredit). Geiser's support for writing Scheme code adds to Emacs' 'scheme-mode', rather than supplanting it; and it does so by means of a minor mode (unimaginatively dubbed 'geiser-mode') that defines a bunch of new commands to try and, with the help of the same Scheme process giving you the REPL, make those Scheme buffers come to life. * Menu: * Activating Geiser:: * The source and the REPL:: * Documentation helpers:: * To eval or not to eval:: * To err perchance to debug:: * Jumping around:: * Geiser writes for you::  File: geiser.info, Node: Activating Geiser, Next: The source and the REPL, Prev: Between the parens, Up: Between the parens 4.1 Activating Geiser ===================== With Geiser installed following any of the procedures described in *note The easy and quick way:: or *note From the source's mouth::, Emacs will automatically activate geiser-mode when opening a Scheme buffer. Geiser also instructs Emacs to consider files with the extension 'rkt' part of the family, so that, in principle, there's nothing you need to do to ensure that Geiser's extensions will be available, out of the box, when you start editing Scheme code. Indications that everything is working according to plan include the 'Geiser' minor mode indicator in your mode-line and the appearance of a new entry for Geiser in the menu bar. If, moreover, the mode-line indicator is the name of a Scheme implementation, you're indeed in a perfect world; otherwise, don't despair and keep on reading: i'll tell you how to fix that in a moment. The menu provides a good synopsis of everything Geiser brings to the party, including those keyboard shortcuts we Emacsers love. If you're seeing the name of your favourite Scheme implementation in the mode-line, have a running REPL and are comfortable with Emacs, you can stop reading now and, instead, discover Geiser's joys by yourself. I've tried to make Geiser as self-documenting as any self-respecting Emacs package should be. If you follow this route, make sure to take a look at Geiser's customization buffers ('M-x customize-group geiser'): there's lot of fine-tuning available there. You might also want to take a glance at the tables in *note our cheat sheet: Cheat sheet. Since geiser-mode is a minor mode, you can toggle it with 'M-x geiser-mode', and control its activation in hooks with the functions 'turn-on-geiser-mode' and 'turn-off-geiser-mode'. If, for some reason i cannot fathom, you prefer geiser-mode not to be active by default, customizing 'geiser-mode-auto-p' to 'nil' will do the trick. And if you happen to use a funky extension for your Scheme files that is not recognised as such by Emacs, just tell her about it with: (add-to-list 'auto-mode-alist '("\\.funky-extension\\'" . scheme-mode)) Now, geiser-mode is just a useless wretch unless there's a running Scheme process backing it up. Meaning that virtually all the commands it provides require a REPL up and running, preferably corresponding to the correct Scheme implementation. In the following section, we'll see how to make sure that that's actually the case.  File: geiser.info, Node: The source and the REPL, Next: Documentation helpers, Prev: Activating Geiser, Up: Between the parens 4.2 The source and the REPL =========================== As i've already mentioned a couple of times, geiser-mode needs a running REPL to be operative. Thus, a common usage pattern will be for you to first call 'run-geiser' (or one of its variants, e.g. 'run-guile'), and then open some Scheme files; but there's nothing wrong in first opening a couple Scheme buffers and then starting the REPL (you can even find it more convenient, since pressing 'C-c C-z' in a Scheme buffer will start the REPL for you). Since Geiser supports more than one Scheme implementation, though, there's the problem of knowing which of them is to be associated with each Scheme source file. Serviceable as it is, geiser-mode will try to guess the correct implementation for you, according to the algorithm described below. How Geiser associates a REPL to your Scheme buffer .................................................. To determine what Scheme implementation corresponds to a given source file, Geiser uses the following algorithm: 1. If the file-local variable 'geiser-scheme-implementation' is defined, its value is used. A common way of setting buffer-local variables is to put them in a comment near the beginning of the file, surrounded by '-*-' marks, as in: ;; -*- geiser-scheme-implementation: guile -*- 2. If you've customized 'geiser-active-implementations' so that it's a single-element list, that element is used as the chosen implementation. 3. The contents of the file is scanned for hints on its associated implementation. For instance, files that contain a '#lang' directive will be considered Racket source code, while those with a 'define-module' form in them will be assigned to a Guile REPL. 4. The current buffer's file name is checked against the rules given in 'geiser-implementations-alist', and the first match is applied. You can provide your own rules by customizing this variable, as explained below. 5. If we haven't been lucky this far and you have customized 'geiser-default-implementation' to the name of a supported implementation, we'll follow your lead. 6. See? That's the problem of being a smart aleck: one's always outsmarted by people around. At this point, geiser-mode will humbly give up and ask you to explicitly choose the Scheme implementation. As you can see in the list above, there are several ways to influence Geiser's guessing by means of customizable variables. The most direct (and most impoverishing) is probably limiting the active implementations to a single one, while customizing 'geiser-implementations-alist' is the most flexible (and, unsurprisingly, also the most complex). Here's the default value for the latter variable: (((regexp "\\.scm$") guile) ((regexp "\\.ss$") racket) ((regexp "\\.rkt$") racket)) which describes the simple heuristic that files with '.scm' as extension are by default associated to a Guile REPL while those ending in '.ss' or '.rkt' correspond to Racket's implementation (with the caveat that these rules are applied only if the previous heuristics have failed to detect the correct implementation, and that they'll match only if the corresponding implementation is active). You can add rules to 'geiser-implementations-alist' (or replace all of them) by customizing it. Besides regular expressions, you can also use a directory name; for instance, the following snippet: (eval-after-load "geiser-impl" '(add-to-list 'geiser-implementations-alist '((dir "/home/jao/prj/frob") guile))) will add a new rule that says that any file inside my '/home/jao/prj/frob' directory (or, recursively, any of its children) is to be assigned to Guile. Since rules are first matched, first served, this new rule will take precedence over the default ones. A final tip: if you want Geiser to start automatically a REPL for you if it notices that there's no one active when it enters geiser-mode, you can customize 'geiser-mode-start-repl-p' to 't'. Switching between source files and the REPL ........................................... Once you have a working geiser-mode, you can switch from Scheme source buffers to the REPL or 'C-c C-z'. Those shortcuts map to the interactive command 'switch-to-geiser'. If you use a numeric prefix, as in 'C-u C-c C-z', besides being teleported to the REPL, the latter will switch to the namespace of the Scheme source file, as if you had used 'C-c C-m' in the REPL, with the source file's module as argument; cf. discussion in *note Switching context::. This command is also bound to 'C-c C-a'. Once you're in the REPL, the same 'C-c C-z' shortcut will bring you back to the buffer you jumped from, provided you don't kill the Scheme process in between. This is why the command is called switch-to-geiser instead of switch-to-repl, and what makes it really handy, if you ask me. If for some reason you're not happy with the Scheme implementation that Geiser has assigned to your file, you can change it with 'C-c C-s', and you probably should take a look at the previous subsection to make sure that Geiser doesn't get confused again. A note about context .................... As explained before (*note Modus operandi::), all Geiser activities take place in the context of the current namespace, which, for Scheme buffers, corresponds to the module that the Scheme implementation associates to the source file at hand (for instance, in Racket, there's a one-to-one correspondence between paths and modules, while Guile relies on explicit 'define-module' forms in the source file). Now that we have 'geiser-mode' happily alive in our Scheme buffers and communicating with the right REPL instance, let us see what it can do for us, besides jumping to and fro.  File: geiser.info, Node: Documentation helpers, Next: To eval or not to eval, Prev: The source and the REPL, Up: Between the parens 4.3 Documentation helpers ========================= Autodoc redux ............. The first thing you will notice by moving around Scheme source is that, every now and then, the echo area lights up with the same autodoc messages we know and love from our REPL forays. This happens every time the Scheme process is able to recognise an identifier in the buffer, and provide information either on its value (for variables) or on its arity and the name of its formal arguments (for procedures and macros). That information will only be available if the module the identifier belongs to has been loaded in the running Scheme image. So it can be the case that, at first, no autodoc is shown for identifiers defined in the file you're editing. But as soon as you evaluate them (either individually or collectively using any of the devices described in *note To eval or not to eval::) their signatures will start appearing in the echo area. Autodoc activation is controlled by a minor mode, 'geiser-autodoc', which you can toggle with 'M-x geiser-autodoc-mode', or its associated keyboard shortcut, 'C-c C-d a'. That /A indicator in the mode-line is telling you that autodoc is active. If you prefer that it be inactive by default (e.g., because you're connecting to a really remote scheme and want to minimize network exchanges), just set 'geiser-mode-autodoc-p' to 'nil' in your customization files. Even when autodoc mode is off, you can use 'geiser-autodoc-show', bound by default to 'C-c C-d s', to show the autodoc string for the symbol at point. The way autodoc displays information deserves some explanation. It will first show the name of the module where the identifier at hand is defined, followed by a colon and the identifier itself. If the latter corresponds to a procedure or macro, it will be followed by a list of argument names, starting with the ones that are required. Then there comes a list of optional arguments, if any, enclosed in parentheses. When an optional argument has a default value (or a form defining its default value), autodoc will display it after the argument name. When the optional arguments are keywords, their names are prefixed with "#:" (i.e., their names are keywords). An ellipsis (...) serves as a marker of an indeterminate number of parameters, as is the case with rest arguments or when autodoc cannot fathom the exact number of arguments (this is often the case with macros defined using 'syntax-case'). Another way in which autodoc displays its ignorance is by using an underscore to display parameters whose name is beyond its powers. It can also be the case that a function or macro has more than one signature (e.g., functions defined using 'case-lambda', or some 'syntax-rules' macros, for which Geiser has often the black magic necessary to retrieve their actual arities). In those cases, autodoc shows all known signatures (using the above rules for each one) separated by a vertical bar (|). As you have already noticed, the whole autodoc message is enclosed in parentheses. After all, we're talking about Scheme here. Finally, life is much easier when your cursor is on a symbol corresponding to a plain variable: you'll see in the echo area its name, preceded by the module where it's defined, and followed by its value, with an intervening arrow for greater effect. This time, there are no enclosing parentheses (i hope you see the logic in my madness). You can change the way Geiser displays the module/identifier combo by customizing 'geiser-autodoc-identifier-format'. For example, if you wanted a tilde surrounded by spaces instead of a colon as a separator, you would write something like: (setq geiser-autodoc-identifier-format "%s ~ %s") in your Emacs initialisation files. There's also a face ('geiser-font-lock-autodoc-identifier') that you can customize (for instance, with 'M-x customize-face') to change the appearance of the text. And another one ('geiser-font-lock-autodoc-current-arg') that controls how the current argument position is highlighted. Other documentation commands ............................ Sometimes, autodoc won't provide enough information for you to understand what a function does. In those cases, you can ask Geiser to ask the running Scheme for further information on a given identifier or module. For symbols, the incantation is 'M-x geiser-doc-symbol-at-point', or 'C-c C-d C-d' for short. If the associated Scheme supports docstrings (as, for instance, Guile does), you'll be teleported to a new Emacs buffer displaying Geiser's documentation browser, filled with information about the identifier, including its docstring (if any; unfortunately, that an implementation supports docstrings doesn't mean that they're used everywhere). Pressing 'q' in the documentation buffer will bring you back, enlightened, to where you were. There's also a handful of other navigation commands available in that buffer, which you can discover by means of its menu or via the good old 'C-h m' command. And feel free to use the navigation buttons and hyperlinks that justify my calling this buffer a documentation browser. For Racket, which does not support docstrings out of the box, this command will provide less information, but the documentation browser will display the corresponding contract when it's available, as well as some other tidbits for re-exported identifiers. You can also ask Geiser to display information about a module, in the form of a list of its exported identifiers, using 'C-c C-d C-m', exactly as you would do in *note the REPL: repl-mod. In both cases, the documentation browser will show a couple of buttons giving you access to further documentation. First, you'll see a button named source: pressing it you'll jump to the symbol's definition. The second button, dubbed manual, will open the Scheme implementation's manual page for the symbol at hand. For Racket, that will open your web browser displaying the corresponding reference's page (using the HTML browser in Racket's configuration, which you can edit in DrRacket's preferences dialog, or by setting 'plt:framework-pref:external-browser' directly in '~/.racket/racket-prefs.rktd'), while in Guile a lookup will be performed in the texinfo manual. For Guile, the manual lookup uses the info indexes in the standard Guile info nodes, which are usually named "guile" or "guile-2.0". If yours are named differently, just add your name to the customizable variable 'geiser-guile-manual-lookup-nodes'. A list of all navigation commands in the documentation browser is available in *note our cheat-sheet: Documentation browser. You can also skip the documentation browser and jump directly to the manual page for the symbol at point with the command 'geiser-doc-look-up-manual', bound to 'C-c C-d i'.  File: geiser.info, Node: To eval or not to eval, Next: To err perchance to debug, Prev: Documentation helpers, Up: Between the parens 4.4 To eval or not to eval ========================== One of Geiser's main goals is to facilitate incremental development. You might have noticed that i've made a big fuss of Geiser's ability to recognize context, by being aware of the namespace where its operations happen. That awareness is especially important when evaluating code in your scheme buffers, using the commands described below. They allow you to send code to the running Scheme with a granularity ranging from whole files to single s-expressions. That code will be evaluated in the module associated with the file you're editing, allowing you to redefine values and procedures to your heart's (and other modules') content. Macros are, of course, another kettle of fish: one needs to re-evaluate uses of a macro after redefining it. That's not a limitation imposed by Geiser, but a consequence of how macros work in Scheme (and other Lisps). There's also the risk that you lose track of what's actually defined and what's not during a given session. But, in my opinion (http://programming-musings.org/2009/03/29/from-my-cold-prying-hands/), those are limitations we lispers are aware of, and they don't force us to throw the baby with the bathwater and ditch incremental evaluation. Some people disagree; if you happen to find their arguments (http://blog.racket-lang.org/2009/03/drscheme-repl-isnt-lisp.html) convincing, you don't have to throw away Geiser together with the baby: 'M-x geiser-restart-repl' will let you restart the REPL as many times as you see fit. For all of you bearded old lispers still with me, here are some of the commands performing incremental evaluation in Geiser. 'geiser-eval-last-sexp', bound to 'C-x C-e', will eval the s-expression just before point. If you use a prefix, as in 'C-u C-x C-e', besides evaluating it the expression is inserted in the the buffer. 'geiser-eval-definition', bound to 'C-M-x', finds the topmost definition containing point and sends it for evaluation. The variant 'geiser-eval-definition-and-go' ('C-c M-e') works in the same way, but it also teleports you to REPL after the evaluation. 'geiser-eval-region', bound to 'C-c C-r', evals the current region. Again, there's an and-go version available, 'geiser-eval-region-and-go', bound to 'C-c M-r'. And, if you want to extend the evaluated region to the whole buffer, there is 'geiser-eval-buffer', bound to 'C-c C-b' and its companion 'geiser-eval-buffer-and-go', bound to 'C-c M-b'. For all the commands above, the result of the evaluation is displayed in the minibuffer, unless it causes a (Scheme-side) error (*note To err perchance to debug::), or, for schemes supporting them (such as Racket), the evaluation yields an image, in which case you'll see it in popping up in the Geiser debug buffer (if your Emacs runs under the auspices of a graphical toolkit), or via an external viewer if you set program (see also *note Seeing is believing:: for more on image support). At the risk of repeating myself, i'll remind you that all these evaluations will take place in the namespace of the module corresponding to the Scheme file from which you're sending your code, which, in general, will be different from the REPL's current module. And, if all goes according to plan, (re)defined variables and procedures should be immediately visible inside and, if exported, outside their module. Besides evaluating expressions, definitions and regions, you can also macro-expand them. The corresponding key bindings start with the prefix 'C-c C-m' and end, respectively, with 'C-e', 'C-x' and 'C-r'. The result of the macro expansion always appears in a pop up buffer.  File: geiser.info, Node: To err perchance to debug, Next: Jumping around, Prev: To eval or not to eval, Up: Between the parens 4.5 To err: perchance to debug ============================== When an error occurs during evaluation, it will be reported according to the capabilities of the underlying Scheme REPL. In Racket, you'll be presented with a backtrace, in a new buffer where file paths locating the origin of the error are click-able (you can navigate them using the key, and use or the mouse to jump to the offending spot; or invoke Emacs' stock commands 'next-error' and 'previous-error', bound to 'M-g n' and 'M-g p' by default). The Racket backtrace also highlights the exception type, making it click-able. Following the link will open the documentation corresponding to said exception type. Both the error and exception link faces are customizable ('geiser-font-lock-error-link' and 'geiser-font-lock-doc-link'). By default, Geiser will tele-transport your pointer to the debug buffer: if you prefer to stay in the source buffer, set 'geiser-debug-jump-to-debug-p' to nil. And if, in addition, you don't even want to see the error trace, customize 'geiser-debug-show-debug-p', again, to nil. On the other hand, Guile's reaction to evaluation errors is different: it enters the debugger in its REPL. Accordingly, the REPL buffer will pop up if your evaluation fails in a Guile file, and the error message and backtrace will be displayed in there, again click-able and all. But there you have the debugger at your disposal, with the REPL's current module set to that of the offender, and a host of special debugging commands that are described in Guile's fine documentation. In addition, Guile will sometimes report warnings for otherwise successful evaluations. In those cases, it won't enter the debugger, and Geiser will report the warnings in a debug buffer, as it does for Racket. You can control how picky Guile is reporting warnings by customizing the variable 'geiser-guile-warning-level', whose detailed docstring (which see, using, e.g. 'C-h v') allows me to offer no further explanation here. The customization group geiser-guile is also worth a glance, for a couple of options to fine-tune how Geiser interacts with Guile's debugger (and more). Same thing for racketeers and geiser-racket.  File: geiser.info, Node: Jumping around, Next: Geiser writes for you, Prev: To err perchance to debug, Up: Between the parens 4.6 Jumping around ================== This one feature is as sweet as it is easy to explain: 'M-.' ('geiser-edit-symbol-at-point') will open the file where the identifier around point is defined and land your point on its definition. To return to where you were, press 'M-,' ('geiser-pop-symbol-stack'). This command works also for module names: Geiser first tries to locate a definition for the identifier at point and, if that fails, a module with that name; if the latter succeeds, the file where the module is defined will pop up. Sometimes, the underlying Scheme will tell Geiser only the file where the symbol is defined, but Geiser will use some heuristics (read, regular expressions) to locate the exact line and bring you there. Thus, if you find Geiser systematically missing your definitions, send a message to the mailing list , and we'll try to make the algorithm smarter. You can control how the destination buffer pops up by setting 'geiser-edit-symbol-method' to either 'nil' (to open the file in the current window), ''window' (other window in the same frame) or ''frame' (in a new frame).  File: geiser.info, Node: Geiser writes for you, Prev: Jumping around, Up: Between the parens 4.7 Geiser writes for you ========================= No self-respecting programming mode would be complete without completion. In geiser-mode, identifier completion is bound to 'M-', and will offer all visible identifiers starting with the prefix before point. Visible here means all symbols imported or defined in the current namespace plus locally bound ones. E.g., if you're at the end of the following partial expression: (let ((default 42)) (frob def and press 'M-', one of the possible completions will be 'default'. After obtaining the list of completions from the running Scheme, Geiser uses the standard Emacs completion machinery to display them. That means, among other things, that partial completion is available: just try to complete 'd-s' or 'w-o-t-s' to see why this is a good thing. Partial completion won't work if you have disabled it globally in your Emacs configuration: if you don't know what i'm talking about, never mind: Geiser's partial completion will work for you out of the box. If you find the 'M' modifier annoying, you always have the option to activate 'geiser-smart-tab-mode', which will make the key double duty as the regular Emacs indentation command (when the cursor is not near a symbol) and Geiser's completion function. If you want this smarty pants mode always on in Scheme buffers, customize 'geiser-mode-smart-tab-p' to 't'. Geiser also knows how to complete module names: if no completion for the prefix at point is found among the currently visible bindings, it will try to find a module name that matches it. You can also request explicitly completion only over module names using 'M-`' (that's a backtick). Besides completion, there's also this little command, 'geiser-squarify', which will toggle the delimiters of the innermost list around point between round and square brackets. It is bound to 'C-c C-e ['. With a numeric prefix (as in, say, 'M-2 C-c C-e ['), it will perform that many toggles, forward for positive values and backward for negative ones.  File: geiser.info, Node: Cheat sheet, Next: No hacker is an island, Prev: Between the parens, Up: Top 5 Cheat sheet ************* In the tables below, triple chords always accept a variant with the third key not modified by ; e.g., 'geiser-autodoc-show' is bound both to 'C-c C-d C-s' and 'C-c C-d s'. * Menu: * Scheme buffers:: * REPL:: * Documentation browser::  File: geiser.info, Node: Scheme buffers, Next: REPL, Prev: Cheat sheet, Up: Cheat sheet 5.1 Scheme buffers ================== Key Command Description --------------------------------------------------------------------------- C-c C-z 'geiser-mode-switch-to-repl' Switch to REPL C-c C-a 'geiser-mode-switch-to-repl-and-enter'Switch to REPL and current module (also 'C-u C-c C-z') C-c C-s 'geiser-set-scheme' Specify Scheme implementation for buffer M-. 'geiser-edit-symbol-at-point' Go to definition of identifier at point M-, 'geiser-pop-symbol-stack' Go back to where M-. was last invoked C-c C-e C-m 'geiser-edit-module' Ask for a module and open its file C-c C-e C-l 'geiser-add-to-load-path' Ask for a directory and add to Scheme load path C-c C-e C-[ 'geiser-squarify' Toggle between () and [] for current form C-c C-\ 'geiser-insert-lambda' Insert greek lambda or, with prefix, a lambda form C-M-x 'geiser-eval-definition' Eval definition around point C-c M-e 'geiser-eval-definition-and-go'Eval definition around point and switch to REPL C-x C-e 'geiser-eval-last-sexp' Eval sexp before point C-c C-r 'geiser-eval-region' Eval region C-c M-r 'geiser-eval-region-and-go' Eval region and switch to REPL C-c C-b 'geiser-eval-buffer' Eval buffer C-c M-b 'geiser-eval-buffer-and-go' Eval buffer and switch to REPL C-c C-m C-x 'geiser-expand-definition' Macro-expand definition around point C-c C-m C-e 'geiser-expand-last-sexp' Macro-expand sexp before point C-c C-m C-r 'geiser-expand-region' Macro-expand region C-c C-k 'geiser-compile-current-buffer'Compile and load current file M-g n, C-x ' 'next-error' Jump to the location of next error M-g p 'previous-error' Jump to the location of previous error C-c C-d C-d 'geiser-doc-symbol-at-point' See documentation for identifier at point C-c C-d C-s 'geiser-autodoc-show' Show signature or value for identifier at point in echo area C-c C-d C-m 'geiser-doc-module' See a list of a module's exported identifiers C-c C-d C-i 'geiser-doc-look-up-manual' Look up manual for symbol at point C-c C-d C-a 'geiser-autodoc-mode' Toggle autodoc mode C-c < 'geiser-xref-callers' Show callers of procedure at point C-c > 'geiser-xref-callees' Show callees of procedure at point M-TAB 'completion-at-point' Complete identifier at point M-', C-. 'geiser-completion--complete-module'Complete module name at point  File: geiser.info, Node: REPL, Next: Documentation browser, Prev: Scheme buffers, Up: Cheat sheet 5.2 REPL ======== Key Command Description --------------------------------------------------------------------------- C-c C-z 'switch-to-geiser' Start Scheme REPL, or jump to previous buffer C-c M-o 'geiser-repl-clear-buffer' Clear REPL buffer C-c C-k 'geiser-repl-interrupt' Interrupt REPL evaluation (signalling inferior scheme) C-c C-q 'geiser-repl-exit' Kill Scheme process M-. 'geiser-edit-symbol-at-point' Edit identifier at point TAB 'geiser-repl-tab-dwim' Complete, indent, or go to next error S-TAB 'geiser-repl--previous-error' Go to previous error in the (backtab) REPL buffer M-TAB 'completion-at-point' Complete indentifier at point M-', C-. 'geiser-completion--complete-module'Complete module name at point C-c C-r 'geiser-add-to-load-path' Ask for a directory and add to Scheme load path M-p, M-n (comint commands) Prompt history, matching current prefix C-c M-p, C-c (comint commands) Previous/next prompt inputs M-n C-c C-m 'switch-to-geiser-module' Set current module C-c C-i 'geiser-repl-import-module' Import module into current namespace C-c C-d C-d 'geiser-doc-symbol-at-point' See documentation for symbol at point C-c C-d C-i 'geiser-doc-look-up-manual' Look up manual for symbol at point C-c C-d C-m 'geiser-repl--doc-module' See documentation for module C-c C-d C-a 'geiser-autodoc-mode' Toggle autodoc mode  File: geiser.info, Node: Documentation browser, Prev: REPL, Up: Cheat sheet 5.3 Documentation browser ========================= Key Command Description --------------------------------------------------------------------------- TAB, n 'forward-button' Next link S-TAB, p 'backward-button' Previous link N 'geiser-doc-next-section' Next section P 'geiser-doc-previous-section' Previous section f 'geiser-doc-next' Next page b 'geiser-doc-previous' Previous page k 'geiser-doc-kill-page' Kill current page and go to previous or next g, r 'geiser-doc-refresh' Refresh page c 'geiser-doc-clean-history' Clear browsing history ., M-. 'geiser-doc-edit-symbol-at-point'Edit identifier at point z 'geiser-doc-switch-to-repl' Switch to REPL q 'View-quit' Bury buffer  File: geiser.info, Node: No hacker is an island, Next: Index, Prev: Cheat sheet, Up: Top 6 No hacker is an island ************************ Dan Leslie, with the help of his three-months old daughter Freija, proved there's a smidgen of sense in this madness by adding support for Chicken to version 0.7 of Geiser, several years after it was born. Andy Wingo, Geiser's first user, has been a continuous source of encouragement and suggestions, and keeps improving Guile and heeding my feature requests. The nice thing about collaborating with Andreas Rottmann over all these years is that he will not only make your project better with insightful comments and prodding: he'll send you patches galore too. Ludovic Courtès, #geiser's citizen no. 1, joined the fun after a while, and has since then been a continuous source of encouragement, ideas and bug reports. Michael Wilber convinced me that image support for Racket was not only fun, but easy, with the best argument: actual code! Daniel Hackney and Grant Rettke created the first ELPA packages for Geiser and taught me to fish. Diogo F. S. Ramos is Geiser's most indefatigable user and bug reporter, and the mailing list has been a far less lonely place since he came. Aleix Conchillo has been my favourite spammer, beta tester and patch sender during more years and for more projects than i can remember. Eduardo Cavazos' contagious enthusiasm has helped in many ways to keep Geiser alive, and he's become its best evangelist in R6RS circles. Alex Kost has contributed with many bug reports and improved Geiser with several patches. Eli Barzilay took the time to play with an early alpha and made 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. And to the Slime hackers, who led the way. Joining the fun ............... * For questions, praise, critique and anything else Geiser, do not hesitate to drop an email to our list, (@ geiser-users (. nongnu org)) (mailto:geiser-users@nongnu.org): no subscription required. Check the list page (http://lists.nongnu.org/mailman/listinfo/geiser-users) for more information or browse the archives (http://lists.nongnu.org/archive/html/geiser-users/). The list is also accessible via Gmane (http://gmane.org) as gmane.lisp.scheme.geiser (http://dir.gmane.org/gmane.lisp.scheme.geiser). * You can submit bug reports either to the mailing list or to our bug tracker (https://github.com/jaor/geiser/issues) over at Github. * If you only need to hear about Geiser on new releases, the News page (http://savannah.nongnu.org/news/?group=geiser) and its Atom feed (https://savannah.nongnu.org/news/atom.php?group=geiser) are probably what you're looking for. * The Freenode IRC channel #geiser is the Geiserati's meeting point in cyberspace.  File: geiser.info, Node: Index, Prev: No hacker is an island, Up: Top Index ***** [index] * Menu: * ,enter vs. enter!: Switching context. (line 6) * ac-geiser: Friends. (line 9) * ask on kill, don't: Customization and tips. (line 111) * autocomplete: Friends. (line 9) * autodoc customized: Documentation helpers. (line 64) * autodoc explained: Documentation helpers. (line 32) * autodoc for variables: Documentation helpers. (line 58) * autodoc, disabling: Customization and tips. (line 94) * autodoc, in scheme buffers: Documentation helpers. (line 9) * autodoc, in the REPL: Autodoc and friends. (line 11) * autostart REPL: The source and the REPL. (line 80) * backtraces: To err perchance to debug. (line 6) * bug tracker: No hacker is an island. (line 66) * byte-compilation: From the source's mouth. (line 49) * Chicken: The easy and quick way. (line 37) * Chicken installation: The easy and quick way. (line 37) * company: Friends. (line 9) * completion for module names: Geiser writes for you. (line 33) * completion in scheme buffers: Geiser writes for you. (line 6) * completion, at the REPL: Completion and error handling. (line 6) * connect to server: Starting the REPL. (line 43) * corpses: Top. (line 79) * current module: Modus operandi. (line 15) * current module, change: Switching context. (line 21) * current module, in REPL: Switching context. (line 6) * derailment: Top. (line 79) * disabling autodoc: Documentation helpers. (line 22) * docstrings, maybe: Documentation helpers. (line 85) * documentation for symbol: Documentation helpers. (line 85) * ELPA: The easy and quick way. (line 6) * error buffer: To err perchance to debug. (line 9) * evaluating images: To eval or not to eval. (line 52) * evaluation: To eval or not to eval. (line 33) * external image viewer: Seeing is believing. (line 10) * faces, in the REPL: Starting the REPL. (line 35) * geiser-mode: Activating Geiser. (line 6) * geiser-mode commands: Activating Geiser. (line 21) * gmane: No hacker is an island. (line 56) * Guile info nodes: Documentation helpers. (line 120) * Guile's REPL server: Starting the REPL. (line 48) * GUILE_LOAD_COMPILED_PATH: Customization and tips. (line 46) * GUILE_LOAD_PATH: Customization and tips. (line 46) * help on identifier: Autodoc and friends. (line 29) * host, default: Customization and tips. (line 103) * image cache: Seeing is believing. (line 16) * image display: To eval or not to eval. (line 52) * image support: Seeing is believing. (line 6) * image viewer: Seeing is believing. (line 10) * incremental development: To eval or not to eval. (line 6) * incremental development, evil: To eval or not to eval. (line 18) * incremental development, not evil: To eval or not to eval. (line 33) * IRC channel: No hacker is an island. (line 72) * jump, at the REPL: Autodoc and friends. (line 51) * jumping customized: Jumping around. (line 22) * jumping in scheme buffers: Jumping around. (line 6) * mailing list: No hacker is an island. (line 56) * manual autodoc: Documentation helpers. (line 22) * module exports: Autodoc and friends. (line 39) * modus operandi: Modus operandi. (line 6) * news feed: No hacker is an island. (line 68) * opening manual pages: Documentation helpers. (line 128) * paredit: Friends. (line 9) * partial completion: Geiser writes for you. (line 18) * peace and quiet: Customization and tips. (line 94) * philosophy: Top. (line 79) * philosophy <1>: To eval or not to eval. (line 6) * PLTCOLLECTS: Customization and tips. (line 46) * port, default: Customization and tips. (line 103) * quack: Friends. (line 9) * quick install: The easy and quick way. (line 6) * Racket's REPL server: Starting the REPL. (line 53) * recursion: Index. (line 6) * remote connections: Starting the REPL. (line 78) * remote REPL: Starting the REPL. (line 43) * REPL: Starting the REPL. (line 6) * REPL commands: First aids. (line 6) * REPL customization: Customization and tips. (line 6) * REPL, faces: Starting the REPL. (line 35) * scheme binary: Customization and tips. (line 32) * scheme executable path: Customization and tips. (line 32) * scheme file extensions: Activating Geiser. (line 38) * scheme implementation, choosing: Customization and tips. (line 20) * scheme implementation, choosing <1>: The source and the REPL. (line 21) * scheme init file: Customization and tips. (line 46) * scheme load path: Customization and tips. (line 46) * smart tabs: Geiser writes for you. (line 26) * start REPL, automatically: The source and the REPL. (line 80) * startup timeout: Customization and tips. (line 65) * supported versions: Must needs. (line 6) * swanking: Showing off. (line 6) * switching schemes: The source and the REPL. (line 103) * switching to module: The source and the REPL. (line 91) * switching to REPL: The source and the REPL. (line 87) * switching to source: The source and the REPL. (line 87) * thanks: No hacker is an island. (line 6) * timeout: Customization and tips. (line 65) * to err is schemey: To err perchance to debug. (line 6) * use the source, Luke: From the source's mouth. (line 9) * useless wretch: Activating Geiser. (line 43) * Version checking: Customization and tips. (line 38) * versions supported: Must needs. (line 6)  Tag Table: Node: Top883 Node: Introduction3339 Node: Modus operandi3673 Ref: current-module4328 Node: Showing off5801 Node: Installation7079 Node: Must needs7292 Node: The easy and quick way8116 Node: From the source's mouth9894 Node: Friends13584 Ref: paredit13858 Node: The REPL15270 Ref: quick-start15389 Node: Starting the REPL15780 Node: First aids20126 Node: Switching context21959 Node: Completion and error handling23884 Node: Autodoc and friends25521 Ref: repl-mod27591 Node: Seeing is believing28597 Node: Customization and tips29609 Ref: choosing-impl30338 Ref: active-implementations30466 Ref: impl-binary30847 Node: Between the parens34757 Node: Activating Geiser35819 Node: The source and the REPL38429 Ref: repl-association39473 Ref: switching-repl-buff42741 Node: Documentation helpers44426 Ref: doc-browser48694 Node: To eval or not to eval51421 Node: To err perchance to debug55248 Node: Jumping around57610 Node: Geiser writes for you58887 Node: Cheat sheet61047 Node: Scheme buffers61431 Node: REPL65357 Node: Documentation browser67616 Node: No hacker is an island68684 Node: Index71869  End Tag Table geiser-0.8.1/geiser-debug.el0000644000175000017500000001647112607252416014004 0ustar jaojao;;; geiser-debug.el -- displaying debug information and evaluation results ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Mon Feb 23, 2009 22:34 (require 'geiser-edit) (require 'geiser-autodoc) (require 'geiser-impl) (require 'geiser-eval) (require 'geiser-menu) (require 'geiser-popup) (require 'geiser-base) (require 'geiser-image) ;;; Customization: (defgroup geiser-debug nil "Debugging and error display options." :group 'geiser) (geiser-custom--defcustom geiser-debug-always-display-sexp-after-p nil "Whether to always display the sexp whose evaluation caused an error after the error message in the debug pop-up. If nil, expressions shorter than `geiser-debug-long-sexp-lines` lines are show before the error message." :group 'geiser-debug :type 'boolean) (geiser-custom--defcustom geiser-debug-long-sexp-lines 6 "Length of an expression in order to be relegated to the bottom of the debug pop-up (after the error message). If `geiser-debug-always-display-sexp-after-p` is t, this variable has no effect." :group 'geiser-debug :type 'int) (geiser-custom--defcustom geiser-debug-jump-to-debug-p t "When set to t (the default), jump to the debug pop-up buffer in case of evaluation errors. See also `geiser-debug-show-debug-p`. " :group 'geiser-debug :type 'boolean) (geiser-custom--defcustom geiser-debug-show-debug-p t "When set to t (the default), show the debug pop-up buffer in case of evaluation errors. This option takes effect even if `geiser-debug-jump-to-debug-p` is set." :group 'geiser-debug :type 'boolean) (geiser-custom--defcustom geiser-debug-auto-display-images-p t "Whether to automatically invoke the external viewer to display images when they're evaluated. See also `geiser-repl-auto-display-images-p'." :group 'geiser-debug :type 'boolean) ;;; Debug buffer mode: (defvar geiser-debug-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) (set-keymap-parent map button-buffer-map) map)) (defun geiser-debug-mode () "A major mode for displaying Scheme compilation and evaluation results. \\{geiser-debug-mode-map}" (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 next-error-function 'geiser-edit--open-next) (setq buffer-read-only t)) (defun geiser-debug--button-p (nextp) (let ((m (funcall (if nextp 'next-button 'previous-button) (point)))) (and m (funcall (if nextp '< '>) (point) (marker-position m))))) (geiser-menu--defmenu debug geiser-debug-mode-map ("Next error" "n" forward-button :enable (geiser-debug--button-p t)) ("Previous error" "p" backward-button :enable (geiser-debug--button-p t)) -- ("Quit" nil View-quit)) ;;; Buffer for displaying evaluation results: (geiser-popup--define debug "*Geiser dbg*" geiser-debug-mode) ;;; Displaying retorts (geiser-impl--define-caller geiser-debug--display-error display-error (module key message) "This method takes 3 parameters (a module name, the error key, and the accompanying error message) and should display (in the current buffer) a formatted version of the error. If the error was successfully displayed, the call should evaluate to a non-null value.") (geiser-impl--define-caller geiser-debug--enter-debugger enter-debugger () "This method is called upon entering the debugger, in the REPL buffer.") (defun geiser-debug--display-after (what) (or geiser-debug-always-display-sexp-after-p (>= (with-temp-buffer (insert what) (count-lines (point-min) (point-max))) geiser-debug-long-sexp-lines))) (defun geiser-debug--insert-res (res) (let ((begin (point))) (insert res) (let ((end (point))) (goto-char begin) (let ((no (geiser-image--replace-images t geiser-debug-auto-display-images-p))) (goto-char end) (newline 2) (and no (> no 0)))))) (defun geiser-debug--display-retort (what ret &optional res auto-p) (let* ((err (geiser-eval--retort-error ret)) (key (geiser-eval--error-key err)) (output (geiser-eval--retort-output ret)) (impl geiser-impl--implementation) (module (geiser-eval--get-module)) (dbg nil) (img nil) (dir default-directory) (buffer (current-buffer)) (debug (eq key 'geiser-debugger)) (after (geiser-debug--display-after what))) (when debug (switch-to-geiser nil nil buffer) (geiser-debug--enter-debugger impl)) (geiser-debug--with-buffer (erase-buffer) (when dir (setq default-directory dir)) (unless after (geiser-debug--display-error impl module nil what) (newline 2)) (setq img (when (and res (not err)) (geiser-debug--insert-res res))) (setq dbg (geiser-debug--display-error impl module key output)) (when after (goto-char (point-max)) (insert "\nExpression evaluated was:\n\n") (geiser-debug--display-error impl module nil what)) (goto-char (point-min))) (when (or img dbg) (geiser-debug--pop-to-buffer) (when (and dbg (not geiser-debug-jump-to-debug-p)) (next-error) (when (not geiser-debug-show-debug-p) (pop-to-buffer (geiser-debug--buffer) 'display-buffer-reuse-window t) (View-quit)) (message "Evaluation error: %s" dbg))))) (defsubst geiser-debug--wrap-region (str) (format "(begin %s)" str)) (defun geiser-debug--unwrap (str) (if (string-match "(begin[ \t\n\v\r]+\\(.+\\)*)" str) (match-string 1 str) str)) (defun geiser-debug--send-region (compile start end and-go wrap &optional nomsg) (let* ((str (buffer-substring-no-properties start end)) (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 nil)) (err (geiser-eval--retort-error ret))) (when and-go (funcall and-go)) (when (not err) (save-excursion (goto-char (/ (+ end start) 2)) (geiser-autodoc--clean-cache)) (unless nomsg (message "%s" res))) (geiser-debug--display-retort (geiser-syntax--scheme-str str) ret res) ret)) (defun geiser-debug--expand-region (start end all wrap) (let* ((str (buffer-substring-no-properties start end)) (wrapped (if wrap (geiser-debug--wrap-region str) str)) (code `(:eval (:ge macroexpand (quote (:scm ,wrapped)) ,(if all :t :f)))) (ret (geiser-eval--send/wait code)) (err (geiser-eval--retort-error ret)) (result (geiser-eval--retort-result ret))) (if err (geiser-debug--display-retort str ret) (geiser-debug--with-buffer (erase-buffer) (insert (format "%s" (if wrap (geiser-debug--unwrap result) result))) (goto-char (point-min))) (geiser-debug--pop-to-buffer)))) (provide 'geiser-debug) geiser-0.8.1/geiser-syntax.el0000644000175000017500000004106212607252416014236 0ustar jaojao;;; geiser-syntax.el -- utilities for parsing scheme syntax ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sun Feb 08, 2009 15:03 (require 'geiser-impl) (require 'geiser-popup) (require 'geiser-base) (require 'scheme) (eval-when-compile (require 'cl)) ;;; Indentation: (defmacro geiser-syntax--scheme-indent (&rest pairs) `(progn ,@(mapcar (lambda (p) `(put ',(car p) 'scheme-indent-function ',(cadr p))) pairs))) (geiser-syntax--scheme-indent (and-let* 1) (case-lambda 0) (catch defun) (class defun) (dynamic-wind 0) (guard 1) (let*-values 1) (let-values 1) (let/ec 1) (letrec* 1) (match 1) (match-lambda 0) (match-lambda* 0) (match-let 1) (match-let* 1) (match-letrec 1) (opt-lambda 1) (parameterize 1) (parameterize* 1) (receive 2) (require-extension 0) (syntax-case 2) (test-approximate 1) (test-assert 1) (test-eq 1) (test-equal 1) (test-eqv 1) (test-group-with-cleanup 1) (test-runner-on-bad-count! 1) (test-runner-on-bad-end-name! 1) (test-runner-on-final! 1) (test-runner-on-group-begin! 1) (test-runner-on-group-end! 1) (test-runner-on-test-begin! 1) (test-runner-on-test-end! 1) (test-with-runner 1) (unless 1) (when 1) (while 1) (with-exception-handler 1) (with-syntax 1)) ;;; Extra syntax keywords (defconst geiser-syntax--builtin-keywords '("and-let*" "cut" "cute" "define-condition-type" "define-immutable-record-type" "define-record-type" "define-values" "letrec*" "match" "match-lambda" "match-lambda*" "match-let" "match-let*" "match-letrec" "parameterize" "receive" "require-extension" "set!" "syntax-case" "test-approximate" "test-assert" "test-begin" "test-end" "test-eq" "test-equal" "test-eqv" "test-error" "test-group" "test-group-with-cleanup" "test-with-runner" "unless" "when" "with-exception-handler" "with-input-from-file" "with-output-to-file")) (defun geiser-syntax--simple-keywords (keywords) "Return `font-lock-keywords' to highlight scheme KEYWORDS. KEYWORDS should be a list of strings." (when keywords `((,(format "[[(]%s\\>" (regexp-opt keywords 1)) . 1)))) (defun geiser-syntax--keywords () (append (geiser-syntax--simple-keywords geiser-syntax--builtin-keywords) `(("\\[\\(else\\)\\>" . 1) (,(rx "(" (group "define-syntax-rule") eow (* space) (? "(") (? (group (1+ word)))) (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))))) (font-lock-add-keywords 'scheme-mode (geiser-syntax--keywords)) (geiser-impl--define-caller geiser-syntax--impl-kws keywords () "A variable (or thunk returning a value) giving additional, implementation-specific entries for font-lock-keywords.") (geiser-impl--define-caller geiser-syntax--case-sensitive case-sensitive () "A flag saying whether keywords are case sensitive.") (defun geiser-syntax--add-kws () (when (not (and (boundp 'quack-mode) quack-mode)) (let ((kw (geiser-syntax--impl-kws geiser-impl--implementation)) (cs (geiser-syntax--case-sensitive geiser-impl--implementation))) (when kw (font-lock-add-keywords nil kw)) (setq font-lock-keywords-case-fold-search (not cs))))) ;;; A simple scheme reader (defvar geiser-syntax--read/buffer-limit nil) (defsubst geiser-syntax--read/eos () (or (eobp) (and 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/symbol () (with-syntax-table scheme-mode-syntax-table (when (re-search-forward "\\(\\sw\\|\\s_\\)+" nil t) (make-symbol (match-string-no-properties 0))))) (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) (?\; (geiser-syntax--read/skip-comment)) ((?\( ?\[) (geiser-syntax--read/token 'lparen)) ((?\) ?\]) (geiser-syntax--read/token 'rparen)) (?. (if (memq (car (syntax-after (1+ (point)))) '(0 11 12)) (geiser-syntax--read/token 'dot) (cons 'atom (geiser-syntax--read/elisp)))) (?\# (case (geiser-syntax--read/next-char) ('nil '(eob)) (?| (geiser-syntax--read/skip-comment)) (?: (if (geiser-syntax--read/next-char) (cons 'kwd (geiser-syntax--read/symbol)) '(eob))) (?\\ (cons 'char (geiser-syntax--read/elisp))) (?\( (geiser-syntax--read/token 'vectorb)) (?\< (geiser-syntax--read/unprintable)) ((?' ?` ?,) (geiser-syntax--read/next-token)) (t (let ((tok (geiser-syntax--read/symbol))) (cond ((equal (symbol-name tok) "t") '(boolean . :t)) ((equal (symbol-name tok) "f") '(boolean . :f)) (tok (cons 'atom tok)) (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/symbol)))))) (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/skip-until (&rest tks) (let (token) (while (and (not (memq (car token) tks)) (not (eq (car token) 'eob))) (setq token (geiser-syntax--read/next-token))) 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/skip-until '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)) (max-lisp-eval-depth (max max-lisp-eval-depth 3000))) (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))) (kwd (make-symbol (format ":%s" (cdr token)))) (unprintable (format "#<%s>" (cdr token))) ((char string atom) (cdr token)) (boolean (cdr token)) (t (error "Reading scheme syntax: unexpected token: %s" token))))) (defun geiser-syntax--read-from-string (string &optional start end) (when (stringp string) (let* ((start (or start 0)) (end (or end (length string))) (max-lisp-eval-depth (min 20000 (max max-lisp-eval-depth (- end start))))) (with-temp-buffer (save-excursion (insert string)) (cons (ignore-errors (geiser-syntax--read)) (point)))))) (defun geiser-syntax--form-from-string (s) (car (geiser-syntax--read-from-string 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))))) (defun geiser-syntax--mapconcat (fun lst sep) (cond ((null lst) "") ((not (listp lst)) (format ".%s%s" sep (funcall fun lst))) ((null (cdr lst)) (format "%s" (funcall fun (car lst)))) (t (format "%s%s%s" (funcall fun (car lst)) sep (geiser-syntax--mapconcat fun (cdr lst) sep))))) ;;; Code parsing: (defsubst geiser-syntax--symbol-at-point () (and (not (nth 8 (syntax-ppss))) (car (geiser-syntax--read-from-string (thing-at-point 'symbol))))) (defsubst geiser-syntax--skip-comment/string () (let ((pos (nth 8 (syntax-ppss)))) (goto-char (or pos (point))) pos)) (defsubst geiser-syntax--nesting-level () (or (nth 0 (syntax-ppss)) 0)) (defun geiser-syntax--pop-to-top () (ignore-errors (while (> (geiser-syntax--nesting-level) 0) (backward-up-list)))) (defsubst geiser-syntax--in-string-p () (nth 3 (syntax-ppss))) (defsubst geiser-syntax--pair-length (p) (if (cdr (last p)) (1+ (safe-length p)) (length p))) (defun geiser-syntax--shallow-form (boundary) (when (looking-at-p "\\s(") (save-excursion (forward-char) (let ((elems)) (ignore-errors (while (< (point) boundary) (skip-syntax-forward "-<>") (when (<= (point) boundary) (forward-sexp) (let ((s (thing-at-point 'symbol))) (unless (equal "." s) (push (car (geiser-syntax--read-from-string s)) elems)))))) (nreverse elems))))) (defsubst geiser-syntax--keywordp (s) (and s (symbolp s) (string-match "^:.+" (symbol-name s)))) (defsubst geiser-syntax--symbol-eq (s0 s1) (and (symbolp s0) (symbolp s1) (equal (symbol-name s0) (symbol-name s1)))) (defun geiser-syntax--scan-sexps (&optional begin) (let* ((fst (geiser-syntax--symbol-at-point)) (smth (or fst (not (looking-at-p "[\s \s)\s>\s<\n]")))) (path (and fst `((,fst 0))))) (save-excursion (while (> (or (geiser-syntax--nesting-level) 0) 0) (let ((boundary (point))) (geiser-syntax--skip-comment/string) (backward-up-list) (let ((form (geiser-syntax--shallow-form boundary))) (when (and (listp form) (car form) (symbolp (car form))) (let* ((len (geiser-syntax--pair-length form)) (pos (if smth (1- len) (progn (setq smth t) len))) (prev (and (> pos 1) (nth (1- pos) form))) (prev (and (geiser-syntax--keywordp prev) (list prev)))) (push `(,(car form) ,pos ,@prev) path))))))) (mapcar (lambda (e) (cons (substring-no-properties (format "%s" (car e))) (cdr e))) (nreverse path)))) (defsubst geiser-syntax--binding-form-p (bfs sbfs f) (and (symbolp f) (let ((f (symbol-name f))) (or (member f '("define" "define*" "define-syntax" "syntax-rules" "lambda" "case-lambda" "let" "let*" "let-values" "let*-values" "letrec" "letrec*" "parameterize")) (member f bfs) (member f sbfs))))) (defsubst geiser-syntax--binding-form*-p (sbfs f) (and (symbolp f) (let ((f (symbol-name f))) (or (member f '("let*" "let*-values" "letrec" "letrec*")) (member f sbfs))))) (defsubst geiser-syntax--if-symbol (x) (and (symbolp x) x)) (defsubst geiser-syntax--if-list (x) (and (listp x) x)) (defsubst geiser-syntax--normalize (vars) (mapcar (lambda (i) (let ((i (if (listp i) (car i) i))) (and (symbolp i) (symbol-name i)))) vars)) (defun geiser-syntax--linearize (form) (cond ((not (listp form)) (list form)) ((null form) nil) (t (cons (car form) (geiser-syntax--linearize (cdr form)))))) (defun geiser-syntax--scan-locals (bfs sbfs form nesting locals) (if (or (null form) (not (listp form))) (geiser-syntax--normalize locals) (if (not (geiser-syntax--binding-form-p bfs sbfs (car form))) (geiser-syntax--scan-locals bfs sbfs (car (last form)) (1- nesting) locals) (let* ((head (car form)) (name (geiser-syntax--if-symbol (cadr form))) (names (if name (geiser-syntax--if-list (caddr form)) (geiser-syntax--if-list (cadr form)))) (bns (and name (geiser-syntax--binding-form-p bfs sbfs (car names)))) (rest (if (and name (not bns)) (cdddr form) (cddr form))) (use-names (and (or rest (< nesting 1) (geiser-syntax--binding-form*-p sbfs head)) (not bns)))) (when name (push name locals)) (when (geiser-syntax--symbol-eq head 'case-lambda) (dolist (n (and (> nesting 0) (caar (last form)))) (when n (push n locals))) (setq rest (and (> nesting 0) (cdr form))) (setq use-names nil)) (when (geiser-syntax--symbol-eq head 'syntax-rules) (dolist (n (and (> nesting 0) (cdaar (last form)))) (when n (push n locals))) (setq rest (and (> nesting 0) (cdr form)))) (when use-names (dolist (n (geiser-syntax--linearize names)) (let ((xs (if (and (listp n) (listp (car n))) (car n) (list n)))) (dolist (x xs) (when x (push x locals)))))) (dolist (f (butlast rest)) (when (and (listp f) (geiser-syntax--symbol-eq (car f) 'define) (cadr f)) (push (cadr f) locals))) (geiser-syntax--scan-locals bfs sbfs (car (last (or rest names))) (1- nesting) locals))))) (defun geiser-syntax--locals-around-point (bfs sbfs) (when (eq major-mode 'scheme-mode) (save-excursion (let ((sym (unless (geiser-syntax--skip-comment/string) (thing-at-point 'symbol)))) (skip-syntax-forward "->") (let ((boundary (point)) (nesting (geiser-syntax--nesting-level))) (geiser-syntax--pop-to-top) (multiple-value-bind (form end) (geiser-syntax--form-after-point boundary) (delete sym (geiser-syntax--scan-locals bfs sbfs form (1- nesting) '())))))))) ;;; Display and fontify strings as Scheme code: (defun geiser-syntax--display (a) (cond ((null a) "()") ((eq a :t) "#t") ((eq a :f) "#f") ((geiser-syntax--keywordp a) (format "#%s" a)) ((symbolp a) (format "%s" a)) ((equal a "...") "...") ((stringp a) (format "%S" a)) ((and (listp a) (symbolp (car a)) (equal (symbol-name (car a)) "quote")) (format "'%s" (geiser-syntax--display (cadr a)))) ((listp a) (format "(%s)" (geiser-syntax--mapconcat 'geiser-syntax--display a " "))) (t (format "%s" a)))) (defun geiser-syntax--font-lock-buffer () (let ((name " *geiser font lock*")) (or (get-buffer name) (let ((buffer (get-buffer-create name))) (set-buffer buffer) (let ((geiser-default-implementation (or geiser-default-implementation (car geiser-active-implementations)))) (scheme-mode)) buffer)))) (defun geiser-syntax--scheme-str (str) (save-current-buffer (set-buffer (geiser-syntax--font-lock-buffer)) (erase-buffer) (insert str) (let ((font-lock-verbose nil)) (if (fboundp 'font-lock-ensure) (font-lock-ensure) (with-no-warnings (font-lock-fontify-buffer)))) (buffer-string))) (provide 'geiser-syntax) geiser-0.8.1/geiser-compile.el0000644000175000017500000000467012607252416014344 0ustar jaojao;; geiser-compile.el -- compile/load scheme files ;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Wed Feb 11, 2009 00:16 (require 'geiser-debug) (require 'geiser-autodoc) (require 'geiser-eval) (require 'geiser-base) ;;; Auxiliary functions: (defun geiser-compile--buffer/path (&optional path) (let ((path (or path (read-file-name "Scheme file: " nil nil t)))) (let ((buffer (find-file-noselect path))) (when (and (buffer-modified-p buffer) (y-or-n-p "Save buffer? ")) (save-buffer buffer)) (cons buffer path)))) (defun geiser-compile--display-result (title ret) (if (not (geiser-eval--retort-error ret)) (message "%s done" title) (message "")) (geiser-debug--display-retort title ret)) (defun geiser-compile--file-op (path compile-p msg) (let* ((b/p (geiser-compile--buffer/path path)) (buffer (car b/p)) (path (cdr b/p)) (msg (format "%s %s ..." msg path))) (message msg) (geiser-autodoc--clean-cache) (geiser-compile--display-result msg (geiser-eval--send/wait `(,(if compile-p :comp-file :load-file) ,path))))) ;;; User commands: (defun geiser-compile-file (path) "Compile and load Scheme file." (interactive "FScheme file: ") (geiser-compile--file-op path t "Compiling")) (defun geiser-compile-current-buffer () "Compile and load current Scheme file." (interactive) (geiser-compile-file (buffer-file-name (current-buffer)))) (defun geiser-load-file (path) "Load Scheme file." (interactive "FScheme file: ") (geiser-compile--file-op path nil "Loading")) (defun geiser-load-current-buffer () "Load current Scheme file." (interactive) (geiser-load-file (buffer-file-name (current-buffer)))) (defun geiser-add-to-load-path (path) "Add a new directory to running Scheme's load path. When called interactively, this function will ask for the path to add, defaulting to the current buffer's directory." (interactive "DDirectory to add: ") (let* ((c `(:eval (:ge add-to-load-path ,(expand-file-name path)))) (r (geiser-eval--send/result c))) (message "%s" (if r "Added" "Failed!")))) (provide 'geiser-compile) geiser-0.8.1/README0000644000175000017500000000315412607252416011772 0ustar jaojaoGeiser is a generic Emacs/Scheme interaction mode, featuring an enhanced REPL and a set of minor modes improving Emacs' basic scheme major mode. Geiser supports Racket and Guile. Main functionalities: - Evaluation of forms in the namespace of the current module. - Macro expansion. - File/module loading. - Namespace-aware identifier completion (including local bindings, names visible in the current module, and module names). - Autodoc: the echo area shows information about the signature of the procedure/macro around point automatically. - Jump to definition of identifier at point. - Direct access to documentation, including docstrings (when the implementation provides them) and user manuals. - Listings of identifiers exported by a given module (Guile). - Listings of callers/callees of procedures (Guile). - Rudimentary support for debugging (list of evaluation/compilation error in an Emacs' compilation-mode buffer). - Support for inline images in schemes, such as Racket, that treat them as first order values. Chicken Addendum: These steps are necessary to fully support Chicken Scheme, but are not required for any other scheme. - Install the necessary support eggs: $ chicken-install -s apropos chicken-doc - Update the Chicken documentation database: $ cd `csi -p '(chicken-home)'` $ curl http://3e8.org/pub/chicken-doc/chicken-doc-repo.tgz | sudo tar zx See http://www.nongnu.org/geiser/ for the full manual in HTML form, or the the info manual installed by this package. Author: http://jao.io geiser-0.8.1/geiser-popup.el0000644000175000017500000000451112607252416014051 0ustar jaojao;; geiser-popup.el -- popup windows ;; Copyright (C) 2009, 2010, 2012, 2013 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sat Feb 07, 2009 14:05 (require 'view) ;;; Support for defining popup buffers and accessors: (defvar geiser-popup--registry nil) (defvar geiser-popup--overriding-map (let ((map (make-sparse-keymap))) (define-key map "q" 'View-quit) map)) (defun geiser-popup--setup-view-mode () (view-mode t) (set (make-local-variable 'view-no-disable-on-exit) t) (set (make-local-variable 'minor-mode-overriding-map-alist) (list (cons 'view-mode geiser-popup--overriding-map))) (setq view-exit-action (lambda (buffer) (with-current-buffer buffer (bury-buffer))))) (defmacro geiser-popup--define (base name mode) (let ((get-buff (intern (format "geiser-%s--buffer" base))) (pop-buff (intern (format "geiser-%s--pop-to-buffer" base))) (with-macro (intern (format "geiser-%s--with-buffer" base))) (method (make-symbol "method")) (buffer (make-symbol "buffer"))) `(progn (add-to-list 'geiser-popup--registry ,name) (defun ,get-buff () (or (get-buffer ,name) (with-current-buffer (get-buffer-create ,name) (funcall ',mode) (geiser-popup--setup-view-mode) (current-buffer)))) (defun ,pop-buff (&optional ,method) (let ((,buffer (funcall ',get-buff))) (unless (eq ,buffer (current-buffer)) (cond ((eq ,method 'buffer) (view-buffer ,buffer)) ((eq ,method 'frame) (view-buffer-other-frame ,buffer)) (t (view-buffer-other-window ,buffer)))))) (defmacro ,with-macro (&rest body) (list 'with-current-buffer (list ',get-buff) (cons 'let (cons '((inhibit-read-only t)) body)))) (put ',with-macro 'lisp-indent-function 'defun)))) (put 'geiser-popup--define 'lisp-indent-function 1) ;;; Reload support: (defun geiser-popup-unload-function () (dolist (name geiser-popup--registry) (when (buffer-live-p (get-buffer name)) (kill-buffer name)))) (provide 'geiser-popup) geiser-0.8.1/geiser-table.el0000644000175000017500000001075112607252416014000 0ustar jaojao;;; geiser-table.el -- table creation ;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Tue Jan 06, 2009 13:44 (defun geiser-table--col-widths (rows) (let* ((col-no (length (car rows))) (available (- (window-width) 2 (* 2 col-no))) (widths) (c 0)) (while (< c col-no) (let ((width 0) (av-width (- available (* 5 (- col-no c))))) (dolist (row rows) (setq width (min av-width (max width (length (nth c row)))))) (push width widths) (setq available (- available width))) (setq c (1+ c))) (reverse widths))) (defun geiser-table--pad-str (str width) (let ((len (length str))) (cond ((= len width) str) ((> len width) (concat (substring str 0 (- width 3)) "...")) (t (concat str (make-string (- width (length str)) ?\ )))))) (defun geiser-table--str-lines (str width) (if (<= (length str) width) (list (geiser-table--pad-str str width)) (with-temp-buffer (let ((fill-column width)) (insert str) (fill-region (point-min) (point-max)) (mapcar (lambda (s) (geiser-table--pad-str s width)) (split-string (buffer-string) "\n")))))) (defun geiser-table--pad-row (row) (let* ((max-ln (apply 'max (mapcar 'length row))) (result)) (dolist (lines row) (let ((ln (length lines))) (if (= ln max-ln) (push lines result) (let ((lines (reverse lines)) (l 0) (blank (make-string (length (car lines)) ?\ ))) (while (< l ln) (push blank lines) (setq l (1+ l))) (push (reverse lines) result))))) (reverse result))) (defun geiser-table--format-rows (rows widths) (let ((col-no (length (car rows))) (frows)) (dolist (row rows) (let ((c 0) (frow)) (while (< c col-no) (push (geiser-table--str-lines (nth c row) (nth c widths)) frow) (setq c (1+ c))) (push (geiser-table--pad-row (reverse frow)) frows))) (reverse frows))) (defvar geiser-table-corner-lt "┌") (defvar geiser-table-corner-lb "└") (defvar geiser-table-corner-rt "┐") (defvar geiser-table-corner-rb "┘") (defvar geiser-table-line "─") (defvar geiser-table-tee-t "┬") (defvar geiser-table-tee-b "┴") (defvar geiser-table-tee-l "├") (defvar geiser-table-tee-r "┤") (defvar geiser-table-crux "┼") (defvar geiser-table-sep "│") (defun geiser-table--insert-line (widths first last sep) (insert first geiser-table-line) (dolist (w widths) (while (> w 0) (insert geiser-table-line) (setq w (1- w))) (insert geiser-table-line sep geiser-table-line)) (delete-char -2) (insert geiser-table-line last) (newline)) (defun geiser-table--insert-first-line (widths) (geiser-table--insert-line widths geiser-table-corner-lt geiser-table-corner-rt geiser-table-tee-t)) (defun geiser-table--insert-middle-line (widths) (geiser-table--insert-line widths geiser-table-tee-l geiser-table-tee-r geiser-table-crux)) (defun geiser-table--insert-last-line (widths) (geiser-table--insert-line widths geiser-table-corner-lb geiser-table-corner-rb geiser-table-tee-b)) (defun geiser-table--insert-row (r) (let ((ln (length (car r))) (l 0)) (while (< l ln) (insert (concat geiser-table-sep " " (mapconcat 'identity (mapcar `(lambda (x) (nth ,l x)) r) (concat " " geiser-table-sep " ")) " " geiser-table-sep "\n")) (setq l (1+ l))))) (defun geiser-table--insert (rows) (let* ((widths (geiser-table--col-widths rows)) (rows (geiser-table--format-rows rows widths))) (geiser-table--insert-first-line widths) (dolist (r rows) (geiser-table--insert-row r) (geiser-table--insert-middle-line widths)) (kill-line -1) (geiser-table--insert-last-line widths))) (provide 'geiser-table) geiser-0.8.1/geiser-chicken.el0000644000175000017500000002460212607252416014315 0ustar jaojao;; geiser-chicken.el -- chicken's implementation of the geiser protocols ;; Copyright (C) 2014, 2015 Daniel Leslie ;; Based on geiser-guile.el by Jose Antonio Ortego Ruize ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sun Mar 08, 2009 23:03 (require 'geiser-connection) (require 'geiser-syntax) (require 'geiser-custom) (require 'geiser-base) (require 'geiser-eval) (require 'geiser-edit) (require 'geiser-log) (require 'geiser) (require 'compile) (require 'info-look) (eval-when-compile (require 'cl)) (defconst geiser-chicken-builtin-keywords '("assume" "compiler-typecase" "cond-expand" "condition-case" "declare" "define-constant" "define-inline" "define-interface" "define-record" "define-specialization" "define-type" "dotimes" "ecase" "fluid-let" "foreign-lambda" "foreign-lambda*" "foreign-primitive" "foreign-safe-lambda" "foreign-safe-lambda*" "functor" "handle-exceptions" "let-location" "let-optionals" "let-optionals*" "letrec-values" "module" "regex-case" "select" "use" "with-input-from-pipe")) ;;; Customization: (defgroup geiser-chicken nil "Customization for Geiser's Chicken flavour." :group 'geiser) (geiser-custom--defcustom geiser-chicken-prefix-delimiters '("^:" "^#") "Regex to match symbol prefix delimiters." :type '(repeat string) :group 'geiser-chicken) (geiser-custom--defcustom geiser-chicken-binary (cond ((eq system-type 'windows-nt) '("csi.exe" "-:c")) ((eq system-type 'darwin) "csi") (t "csi")) "Name to use to call the Chicken executable when starting a REPL." :type '(choice string (repeat string)) :group 'geiser-chicken) (geiser-custom--defcustom geiser-chicken-load-path nil "A list of paths to be added to Chicken's load path when it's started." :type '(repeat file) :group 'geiser-chicken) (geiser-custom--defcustom geiser-chicken-compile-geiser-p t "Non-nil means that the Geiser runtime will be compiled on load." :type 'boolean :group 'geiser-chicken) (geiser-custom--defcustom geiser-chicken-init-file "~/.chicken-geiser" "Initialization file with user code for the Chicken REPL. If all you want is to load ~/.csirc, set `geiser-chicken-load-init-file-p' instead." :type 'string :group 'geiser-chicken) (geiser-custom--defcustom geiser-chicken-load-init-file-p nil "Whether to load ~/.chicken when starting Chicken. Note that, due to peculiarities in the way Chicken loads its init file, using `geiser-chicken-init-file' is not equivalent to setting this variable to t." :type 'boolean :group 'geiser-chicken) (geiser-custom--defcustom geiser-chicken-extra-keywords nil "Extra keywords highlighted in Chicken scheme buffers." :type '(repeat string) :group 'geiser-chicken) (geiser-custom--defcustom geiser-chicken-case-sensitive-p t "Non-nil means keyword highlighting is case-sensitive." :type 'boolean :group 'geiser-chicken) ;;; REPL support: (defun geiser-chicken--binary () (if (listp geiser-chicken-binary) (car geiser-chicken-binary) geiser-chicken-binary)) (defun geiser-chicken--parameters () "Return a list with all parameters needed to start Chicken. This function uses `geiser-chicken-init-file' if it exists." (let ((init-file (and (stringp geiser-chicken-init-file) (expand-file-name geiser-chicken-init-file))) (n-flags (and (not geiser-chicken-load-init-file-p) '("-n")))) `(,@(and (listp geiser-chicken-binary) (cdr geiser-chicken-binary)) ,@n-flags "-include-path" ,(expand-file-name "chicken/" geiser-scheme-dir) ,@(apply 'append (mapcar (lambda (p) (list "-include-path" p)) geiser-chicken-load-path)) ,@(and init-file (file-readable-p init-file) (list init-file))))) (defconst geiser-chicken--prompt-regexp "#[^;]*;[^:0-9]*:?[0-9]+> ") ;;; Evaluation support: (defun geiser-chicken--geiser-procedure (proc &rest args) (case proc ((eval compile) (let ((form (mapconcat 'identity (cdr args) " "))) (format "(geiser-eval %s '%s)" (or (car args) "#f") form))) ((load-file compile-file) (format "(geiser-load-file %s)" (car args))) ((no-values) "(geiser-no-values)") (t (let ((form (mapconcat 'identity args " "))) (format "(geiser-%s %s)" proc form))))) (defconst geiser-chicken--module-re "( *module +\\(([^)]+)\\|[^ ]+\\)\\|( *define-library +\\(([^)]+)\\|[^ ]+\\)") (defun geiser-chicken--get-module (&optional module) (cond ((null module) (save-excursion (geiser-syntax--pop-to-top) (if (or (re-search-backward geiser-chicken--module-re nil t) (looking-at geiser-chicken--module-re) (re-search-forward geiser-chicken--module-re nil t)) (geiser-chicken--get-module (match-string-no-properties 1)) :f))) ((listp module) module) ((stringp module) (condition-case nil (car (geiser-syntax--read-from-string module)) (error :f))) (t :f))) (defun geiser-chicken--module-cmd (module fmt &optional def) (when module (let* ((module (geiser-chicken--get-module module)) (module (cond ((or (null module) (eq module :f)) def) (t (format "%s" module))))) (and module (format fmt module))))) (defun geiser-chicken--import-command (module) (geiser-chicken--module-cmd module "(use %s)")) (defun geiser-chicken--enter-command (module) (geiser-chicken--module-cmd module ",m %s" module)) (defun geiser-chicken--exit-command () ",q") (defun geiser-chicken--symbol-begin (module) (let ((distance-to-beginning-of-line (- (point) (line-beginning-position)))) (apply 'max (append (list (save-excursion (skip-syntax-backward "^'(>" distance-to-beginning-of-line) (point))) (mapcar (lambda (match-string) (save-excursion (skip-chars-backward match-string distance-to-beginning-of-line) (point))) geiser-chicken-prefix-delimiters))))) ;;; Error display (defun geiser-chicken--display-error (module key msg) (newline) (when (stringp msg) (save-excursion (insert msg)) (geiser-edit--buttonize-files)) (and (not key) msg (not (zerop (length msg))))) ;;; Trying to ascertain whether a buffer is Chicken Scheme: (defconst geiser-chicken--guess-re (regexp-opt (append '("csi" "chicken") geiser-chicken-builtin-keywords))) (defun geiser-chicken--guess () (save-excursion (goto-char (point-min)) (re-search-forward geiser-chicken--guess-re nil t))) (defun geiser-chicken--external-help (id module) "Loads chicken doc into a buffer" (browse-url (format "http://api.call-cc.org/cdoc?q=%s&query-name=Look+up" id))) ;;; Keywords and syntax (defun geiser-chicken--keywords () (append (geiser-syntax--simple-keywords geiser-chicken-extra-keywords) (geiser-syntax--simple-keywords geiser-chicken-builtin-keywords))) (geiser-syntax--scheme-indent (assume 1) (compiler-typecase 1) (cond-expand 0) (condition-case 1) (cut 1) (cute 1) (declare 0) (dotimes 1) (ecase 1) (fluid-let 1) (foreign-lambda 2) (foreign-lambda* 2) (foreign-primitive 2) (foreign-safe-lambda 2) (foreign-safe-lambda* 2) (functor 3) (handle-exceptions 2) (import 0) (let-location 1) (let-optionals 2) (let-optionals* 2) (letrec-values 1) (module 2) (regex-case 1) (select 1) (set! 1) (use 0) (with-input-from-pipe 1) (with-output-to-pipe 1)) ;;; REPL startup (defconst geiser-chicken-minimum-version "4.8.0.0") (defun geiser-chicken--version (binary) (shell-command-to-string (format "%s -e \"(display (chicken-version))\"" binary))) (defun connect-to-chicken () "Start a Chicken REPL connected to a remote process." (interactive) (geiser-connect 'chicken)) (defun geiser-chicken--compile-or-load (force-load) (let ((target (expand-file-name "chicken/geiser/emacs.so" geiser-scheme-dir)) (source (expand-file-name "chicken/geiser/emacs.scm" geiser-scheme-dir)) (force-load (or force-load (eq system-type 'windows-nt))) (suppression-prefix "(define geiser-stdout (current-output-port))(current-output-port (make-output-port (lambda a #f) (lambda a #f)))") (suppression-postfix "(current-output-port geiser-stdout)")) (let ((load-sequence (cond (force-load (format "(load \"%s\")\n(import geiser)\n" source)) ((file-exists-p target) (format "%s(load \"%s\")(import geiser)%s\n" suppression-prefix target suppression-postfix)) (t (format "%s(use utils)(compile-file \"%s\" options: '(\"-O3\" \"-s\") output-file: \"%s\" load: #t)(import geiser)%s\n" suppression-prefix source target suppression-postfix))))) (geiser-eval--send/wait load-sequence)))) (defun geiser-chicken--startup (remote) (compilation-setup t) (geiser-chicken--compile-or-load (not geiser-chicken-compile-geiser-p))) ;;; Implementation definition: (define-geiser-implementation chicken (unsupported-procedures '(callers callees generic-methods)) (binary geiser-chicken--binary) (arglist geiser-chicken--parameters) (version-command geiser-chicken--version) (minimum-version geiser-chicken-minimum-version) (repl-startup geiser-chicken--startup) (prompt-regexp geiser-chicken--prompt-regexp) (debugger-prompt-regexp nil) (enter-debugger nil) (marshall-procedure geiser-chicken--geiser-procedure) (find-module geiser-chicken--get-module) (enter-command geiser-chicken--enter-command) (exit-command geiser-chicken--exit-command) (import-command geiser-chicken--import-command) (find-symbol-begin geiser-chicken--symbol-begin) (display-error geiser-chicken--display-error) (external-help geiser-chicken--external-help) (check-buffer geiser-chicken--guess) (keywords geiser-chicken--keywords) (case-sensitive geiser-chicken-case-sensitive-p)) (geiser-impl--add-to-alist 'regexp "\\.scm$" 'chicken t) (geiser-impl--add-to-alist 'regexp "\\.release-info$" 'chicken t) (geiser-impl--add-to-alist 'regexp "\\.meta$" 'chicken t) (geiser-impl--add-to-alist 'regexp "\\.setup$" 'chicken t) (provide 'geiser-chicken) geiser-0.8.1/geiser-completion.el0000644000175000017500000001556512607252416015072 0ustar jaojao;;; geiser-completion.el -- tab completion ;; Copyright (C) 2009, 2010, 2011, 2012 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Mon Feb 09, 2009 22:21 (require 'geiser-impl) (require 'geiser-eval) (require 'geiser-log) (require 'geiser-syntax) (require 'geiser-base) (require 'comint) (require 'minibuffer) ;;; Minibuffer maps: (defvar geiser-completion--minibuffer-map (let ((map (make-keymap))) (set-keymap-parent map minibuffer-local-completion-map) (define-key map "?" 'self-insert-command) map)) (defvar geiser-completion--module-minibuffer-map (let ((map (make-keymap))) (set-keymap-parent map minibuffer-local-completion-map) (define-key map " " 'self-insert-command) (define-key map "?" 'self-insert-command) map)) ;;; Completion functionality: (defvar geiser-completion--binding-forms nil) (geiser-impl--register-local-variable 'geiser-completion--binding-forms 'binding-forms nil "A list of forms introducing local bindings, a la let or lambda.") (defvar geiser-completion--binding-forms* nil) (geiser-impl--register-local-variable 'geiser-completion--binding-forms* 'binding-forms* nil "A list of forms introducing nested local bindings, a la let*.") (defsubst geiser-completion--locals () (geiser-syntax--locals-around-point geiser-completion--binding-forms geiser-completion--binding-forms*)) (defun geiser-completion--symbol-list (prefix) (geiser--del-dups (append (all-completions prefix (geiser-completion--locals)) (geiser-eval--send/result `(:eval (:ge completions ,prefix)))))) (defsubst geiser-completion--module-list (prefix) (geiser-eval--send/result `(:eval (:ge module-completions ,prefix)))) (defvar geiser-completion--symbol-list-func (completion-table-dynamic 'geiser-completion--symbol-list)) (defvar geiser-completion--module-list-func (completion-table-dynamic 'geiser-completion--module-list)) (defun geiser-completion--complete (prefix modules) (if modules (geiser-completion--module-list prefix) (geiser-completion--symbol-list prefix))) (defvar geiser-completion--symbol-history nil) (defun geiser-completion--read-symbol (prompt &optional default history) (let ((minibuffer-local-completion-map geiser-completion--minibuffer-map)) (make-symbol (completing-read prompt geiser-completion--symbol-list-func nil nil nil (or history geiser-completion--symbol-history) (or default (geiser--symbol-at-point)))))) (defvar geiser-completion--module-history nil) (defun geiser-completion--read-module (&optional prompt default history) (let ((minibuffer-local-completion-map geiser-completion--module-minibuffer-map)) (completing-read (or prompt "Module name: ") geiser-completion--module-list-func nil nil nil (or history geiser-completion--module-history) default))) (defvar geiser-completion--symbol-begin-function nil) (defun geiser-completion--def-symbol-begin (module) (save-excursion (skip-syntax-backward "^-()>") (point))) (geiser-impl--register-local-method 'geiser-completion--symbol-begin-function 'find-symbol-begin 'geiser-completion--def-symbol-begin "An optional function finding the position of the beginning of the identifier around point. Takes a boolean, indicating whether we're looking for a module name.") (defun geiser-completion--symbol-begin (module) (funcall geiser-completion--symbol-begin-function module)) (defun geiser-completion--module-at-point () (save-excursion (goto-char (geiser-completion--symbol-begin t)) (ignore-errors (thing-at-point 'sexp)))) (defsubst geiser-completion--prefix (module) (buffer-substring-no-properties (geiser-completion--symbol-begin module) (point))) (defsubst geiser-completion--prefix-end (beg mod) (unless (or (eq beg (point-max)) (member (char-syntax (char-after beg)) (if mod '(?\" ?\)) '(?\" ?\( ?\))))) (let ((pos (point))) (condition-case nil (save-excursion (goto-char beg) (forward-sexp 1) (when (>= (point) pos) (point))) (scan-error pos))))) (defun geiser-completion--thing-at-point (module &optional predicate) (with-syntax-table scheme-mode-syntax-table (let* ((beg (geiser-completion--symbol-begin module)) (end (or (geiser-completion--prefix-end beg module) beg)) (prefix (and (> end beg) (buffer-substring-no-properties beg end))) (prefix (and prefix (if (string-match "\\([^-]+\\)-" prefix) (match-string 1 prefix) prefix))) (cmps (and prefix (geiser-completion--complete prefix module)))) (and cmps (list beg end cmps))))) (defun geiser-completion--for-symbol (&optional predicate) (geiser-completion--thing-at-point nil predicate)) (defun geiser-completion--for-module (&optional predicate) (geiser-completion--thing-at-point t predicate)) (defun geiser-completion--for-filename () (when (geiser-syntax--in-string-p) (let ((comint-completion-addsuffix "\"")) (comint-dynamic-complete-filename)))) (defun geiser-completion--setup (enable) (set (make-local-variable 'completion-at-point-functions) (if enable '(geiser-completion--for-symbol geiser-completion--for-module geiser-completion--for-filename) (default-value 'completion-at-point-functions)))) (defun geiser-completion--complete-module () "Complete module name at point." (interactive) (let ((completion-at-point-functions '(geiser-completion--for-module))) (call-interactively 'completion-at-point))) ;;; Smart tab mode: (make-variable-buffer-local (defvar geiser-smart-tab-mode-string " SmartTab" "Modeline indicator for geiser-smart-tab-mode")) (define-minor-mode geiser-smart-tab-mode "Toggle smart tab mode. With no argument, this command toggles the mode. Non-null prefix argument turns on the mode. Null prefix argument turns off the mode. When this mode is enable, TAB will indent if at point is at beginning of line or after a white space or closing parenthesis, and will try completing symbol at point otherwise." :init-value nil :lighter geiser-smart-tab-mode-string :group 'geiser-mode (set (make-local-variable 'tab-always-indent) (if geiser-smart-tab-mode 'complete (default-value 'tab-always-indent)))) (provide 'geiser-completion) geiser-0.8.1/geiser-xref.el0000644000175000017500000001307612607252416013660 0ustar jaojao;; geiser-xref.el -- utilities for cross-referencing ;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Thu Mar 05, 2009 23:03 (require' geiser-edit) (require 'geiser-autodoc) (require 'geiser-eval) (require 'geiser-popup) (require 'geiser-custom) (require 'geiser-base) (require 'button) (require 'lisp-mode) ;;; Customization: (defgroup geiser-xref nil "Options for cross-referencing commands." :group 'geiser) (geiser-edit--define-custom-visit geiser-xref-follow-link-method geiser-xref "How to visit buffers when following xrefs.") (geiser-custom--defface xref-link 'link geiser-xref "links in cross-reference buffers") (geiser-custom--defface xref-header 'bold geiser-xref "headers in cross-reference buffers") ;;; Ref button: (define-button-type 'geiser-xref--button 'action 'geiser-xref--button-action 'face 'geiser-font-lock-xref-link 'follow-link t) (defun geiser-xref--button-action (button) (let ((location (button-get button 'location)) (name (button-get button 'name))) (when location (geiser-edit--try-edit-location name location geiser-xref-follow-link-method)))) (defun geiser-xref--insert-button (xref) (let* ((location (cdr (assoc "location" xref))) (file (geiser-edit--location-file location)) (signature (cdr (assoc "signature" xref))) (signature-txt (and signature (geiser-autodoc--str* signature))) (module (cdr (assoc "module" xref))) (p (point))) (when signature (insert " - ") (if (stringp file) (insert-text-button signature-txt :type 'geiser-xref--button 'location location 'name (car signature) 'help-echo (format "%s in %s" (car signature) file)) (insert (format "%s" signature-txt))) (fill-region p (point)) (save-excursion (goto-char p) (indent-sexp)) (newline)))) (defun geiser-xref--module< (xr1 xr2) (let ((m1 (format "%s" (cdr (assoc "module" xr1)))) (m2 (format "%s" (cdr (assoc "module" xr2))))) (cond ((equal m1 m2) (string< (format "%s" (cdr (assoc "signature" xr1))) (format "%s" (cdr (assoc "signature" xr2))))) ((null m1) (not m2)) ((null m2)) (t (string< (format "%s" m1) (format "%s" m2)))))) (defun geiser-xref--display-xrefs (header xrefs) (geiser-xref--with-buffer (erase-buffer) (geiser--insert-with-face header 'geiser-font-lock-xref-header) (newline) (let ((last-module)) (dolist (xref (sort xrefs 'geiser-xref--module<)) (let ((module (format "%s" (cdr (assoc "module" xref))))) (when (not (equal module last-module)) (insert "\n In module ") (geiser--insert-with-face (format "%s" module) 'geiser-font-lock-xref-header) (newline 2) (setq last-module module)) (geiser-xref--insert-button xref))))) (geiser-xref--pop-to-buffer) (goto-char (point-min))) (defun geiser-xref--read-name (ask prompt) (let ((name (or (and (not ask) (geiser--symbol-at-point)) (read-string prompt nil nil (geiser--symbol-at-point))))) (and name (format "%s" name)))) (defun geiser-xref--fetch-xrefs (ask kind rkind proc) (let* ((name (geiser-xref--read-name ask (format "%s: " (capitalize kind)))) (res (and name (geiser-eval--send/result `(:eval (:ge ,proc (quote (:scm ,name)))))))) (message "Retrieving %ss list for '%s'..." rkind name) (if (or (not res) (not (listp res))) (message "No %ss found for '%s'" rkind name) (message "") (geiser-xref--display-xrefs (format "%ss for '%s'" (capitalize rkind) name) res)))) ;;; Buffer and mode: (geiser-popup--define xref "*Geiser xref*" geiser-xref-mode) (defvar geiser-xref-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) (set-keymap-parent map button-buffer-map) map)) (defun geiser-xref-mode () "Major mode for displaying cross-references. \\{geiser-xref-mode-map}" (interactive) (kill-all-local-variables) (buffer-disable-undo) (use-local-map geiser-xref-mode-map) (set-syntax-table scheme-mode-syntax-table) (setq mode-name "Geiser Xref") (setq major-mode 'geiser-xref-mode) (setq buffer-read-only t)) ;;; Commands: (defun geiser-xref-generic-methods (&optional arg) "Display information about known methods of a given generic. With prefix, ask for the name of the generic." (interactive "P") (geiser-xref--fetch-xrefs arg "generic" "method" 'generic-methods)) (defun geiser-xref-callers (&optional arg) "Display list of callers for procedure at point. With prefix, ask for the procedure." (interactive "P") (geiser-xref--fetch-xrefs arg "procedure" "caller" 'callers)) (defun geiser-xref-callees (&optional arg) "Display list of callees for procedure at point. With prefix, ask for the procedure." (interactive "P") (geiser-xref--fetch-xrefs arg "procedure" "callee" 'callees)) (provide 'geiser-xref) geiser-0.8.1/geiser-repl.el0000644000175000017500000007733712607252416013670 0ustar jaojao;;; geiser-repl.el --- Geiser's REPL ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . (require 'geiser-company) (require 'geiser-doc) (require 'geiser-autodoc) (require 'geiser-edit) (require 'geiser-completion) (require 'geiser-syntax) (require 'geiser-impl) (require 'geiser-eval) (require 'geiser-connection) (require 'geiser-menu) (require 'geiser-image) (require 'geiser-custom) (require 'geiser-base) (require 'comint) (require 'compile) (require 'scheme) ;;; Customization: (defgroup geiser-repl nil "Interacting with the Geiser REPL." :group 'geiser) (geiser-custom--defcustom geiser-repl-buffer-name-function 'geiser-repl-buffer-name "Function used to define the name of a REPL buffer. The function is called with a single argument - an implementation symbol (e.g., `guile', `chicken', etc.)." :type '(choice (function-item geiser-repl-buffer-name) (function :tag "Other function")) :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-use-other-window t "Whether to Use a window other than the current buffer's when switching to the Geiser REPL buffer." :type 'boolean :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-window-allow-split t "Whether to allow window splitting when switching to the Geiser REPL buffer." :type 'boolean :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-history-filename (expand-file-name "~/.geiser_history") "File where REPL input history is saved, so that it persists between sessions. This is actually the base name: the concrete Scheme implementation name gets appended to it." :type 'filename :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-history-size comint-input-ring-size "Maximum size of the saved REPL input history." :type 'integer :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-history-no-dups-p t "Whether to skip duplicates when recording history." :type 'boolean :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-save-debugging-history-p nil "Whether to skip debugging input in REPL history. By default, REPL interactions while scheme is in the debugger are not added to the REPL command history. Set this variable to t to change that." :type 'boolean :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-autodoc-p t "Whether to enable `geiser-autodoc-mode' in the REPL by default." :type 'boolean :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-company-p t "Whether to use company-mode for completion, if available." :group 'geiser-mode :type 'boolean) (geiser-custom--defcustom geiser-repl-read-only-prompt-p t "Whether the REPL's prompt should be read-only." :type 'boolean :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-auto-indent-p t "Whether newlines for incomplete sexps are autoindented." :type 'boolean :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-forget-old-errors-p t "Whether to forget old errors upon entering a new expression. When on (the default), every time a new expression is entered in the REPL old error messages are flushed, and using \\[next-error] afterwards will jump only to error locations produced by the new expression, if any." :type 'boolean :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-skip-version-check-p nil "Whether to skip version checks for the Scheme executable. When set, Geiser won't check the version of the Scheme interpreter when starting a REPL, saving a few tenths of a second. " :type 'boolean :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-query-on-exit-p nil "Whether to prompt for confirmation on \\[geiser-repl-exit]." :type 'boolean :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-query-on-kill-p t "Whether to prompt for confirmation when killing a REPL buffer with a life process." :type 'boolean :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-default-host "localhost" "Default host when connecting to remote REPLs." :type 'string :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-default-port 37146 "Default port for connecting to remote REPLs." :type 'integer :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-startup-time 10000 "Time, in milliseconds, to wait for Racket to startup. If you have a slow system, try to increase this time." :type 'integer :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-inline-images-p t "Whether to display inline images in the REPL." :type 'boolean :group 'geiser-repl) (geiser-custom--defcustom geiser-repl-auto-display-images-p t "Whether to automatically invoke the external viewer to display images popping up in the REPL. See also `geiser-debug-auto-display-images-p'." :type 'boolean :group 'geiser-repl) (geiser-custom--defface repl-input 'comint-highlight-input geiser-repl "evaluated input highlighting") (geiser-custom--defface repl-prompt 'comint-highlight-prompt geiser-repl "REPL prompt") ;;; Implementation-dependent parameters (geiser-impl--define-caller geiser-repl--binary binary () "A variable or function returning the path to the scheme binary for this implementation.") (geiser-impl--define-caller geiser-repl--arglist arglist () "A function taking no arguments and returning a list of arguments to be used when invoking the scheme binary.") (geiser-impl--define-caller geiser-repl--prompt-regexp prompt-regexp () "A variable (or thunk returning a value) giving the regular expression for this implementation's geiser scheme prompt.") (geiser-impl--define-caller geiser-repl--debugger-prompt-regexp debugger-prompt-regexp () "A variable (or thunk returning a value) giving the regular expression for this implementation's debugging prompt.") (geiser-impl--define-caller geiser-repl--startup repl-startup (remote) "Function taking no parameters that is called after the REPL has been initialised. All Geiser functionality is available to you at that point.") (geiser-impl--define-caller geiser-repl--enter-cmd enter-command (module) "Function taking a module designator and returning a REPL enter module command as a string") (geiser-impl--define-caller geiser-repl--import-cmd import-command (module) "Function taking a module designator and returning a REPL import module command as a string") (geiser-impl--define-caller geiser-repl--exit-cmd exit-command () "Function returning the REPL exit command as a string") (geiser-impl--define-caller geiser-repl--version version-command (binary) "Function returning the version of the corresponding scheme process, given its full path.") (geiser-impl--define-caller geiser-repl--min-version minimum-version () "A variable providing the minimum required scheme version, as a string.") ;;; Geiser REPL buffers and processes: (defvar geiser-repl--repls nil) (defvar geiser-repl--closed-repls nil) (make-variable-buffer-local (defvar geiser-repl--repl nil)) (defsubst geiser-repl--set-this-buffer-repl (r) (setq geiser-repl--repl r)) (defun geiser-repl--live-p () (and geiser-repl--repl (get-buffer-process geiser-repl--repl))) (defun geiser-repl--repl/impl (impl &optional repls) (catch 'repl (dolist (repl (or repls geiser-repl--repls)) (when (buffer-live-p repl) (with-current-buffer repl (when (eq geiser-impl--implementation impl) (throw 'repl repl))))))) (defun geiser-repl--set-up-repl (impl) (or (and (not impl) geiser-repl--repl) (setq geiser-repl--repl (let ((impl (or impl geiser-impl--implementation (geiser-impl--guess)))) (when impl (geiser-repl--repl/impl impl)))))) (defun geiser-repl--active-impls () (let ((act)) (dolist (repl geiser-repl--repls act) (with-current-buffer repl (add-to-list 'act geiser-impl--implementation))))) (defsubst geiser-repl--repl-name (impl) (format "%s REPL" (geiser-impl--impl-str impl))) (defsubst geiser-repl--buffer-name (impl) (funcall geiser-repl-buffer-name-function impl)) (defun geiser-repl-buffer-name (impl) "Return default name of the REPL buffer for implementation IMPL." (format "* %s *" (geiser-repl--repl-name impl))) (defun geiser-repl--switch-to-buffer (buffer) (unless (eq buffer (current-buffer)) (let ((pop-up-windows geiser-repl-window-allow-split)) (if geiser-repl-use-other-window (switch-to-buffer-other-window buffer) (switch-to-buffer buffer))))) (defun geiser-repl--to-repl-buffer (impl) (unless (and (eq major-mode 'geiser-repl-mode) (eq geiser-impl--implementation impl) (not (get-buffer-process (current-buffer)))) (let* ((old (geiser-repl--repl/impl impl geiser-repl--closed-repls)) (old (and (buffer-live-p old) (not (get-buffer-process old)) old))) (geiser-repl--switch-to-buffer (or old (generate-new-buffer (geiser-repl--buffer-name impl)))) (unless old (geiser-repl-mode) (geiser-impl--set-buffer-implementation impl))))) (defun geiser-repl--read-impl (prompt &optional active) (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls)))) (defsubst geiser-repl--only-impl-p () (and (null (cdr geiser-active-implementations)) (car geiser-active-implementations))) (defun geiser-repl--get-impl (prompt) (or (geiser-repl--only-impl-p) (and (eq major-mode 'geiser-repl-mode) geiser-impl--implementation) (geiser-repl--read-impl prompt))) ;;; Prompt &co. (defun geiser-repl--last-prompt-end () (cond ((and (boundp 'comint-last-prompt) (markerp (cdr comint-last-prompt))) (marker-position (cdr comint-last-prompt))) ((and (boundp 'comint-last-prompt-overlay) comint-last-prompt-overlay) (overlay-end comint-last-prompt-overlay)) (t (save-excursion (geiser-repl--bol) (+ 1 (point)))))) (defun geiser-repl--last-prompt-start () (cond ((and (boundp 'comint-last-prompt) (markerp (car comint-last-prompt))) (marker-position (car comint-last-prompt))) ((and (boundp 'comint-last-prompt-overlay) comint-last-prompt-overlay) (overlay-start comint-last-prompt-overlay)) (t (save-excursion (geiser-repl--bol) (point))))) ;;; REPL connections (make-variable-buffer-local (defvar geiser-repl--address nil)) (make-variable-buffer-local (defvar geiser-repl--connection nil)) (defun geiser-repl--remote-p () geiser-repl--address) (defsubst geiser-repl--host () (car geiser-repl--address)) (defsubst geiser-repl--port () (cdr geiser-repl--address)) (defun geiser-repl--read-address (&optional host port) (let ((defhost (or (geiser-repl--host) geiser-repl-default-host)) (defport (or (geiser-repl--port) geiser-repl-default-port))) (cons (or host (read-string (format "Host (default %s): " defhost) nil nil defhost)) (or port (read-number "Port: " defport))))) (defun geiser-repl--autodoc-mode (n) (when (or geiser-repl-autodoc-p (< n 0)) (geiser--save-msg (geiser-autodoc-mode n)))) (defun geiser-repl--save-remote-data (address) (setq geiser-repl--address address) (setq header-line-format (cond ((consp address) (format "Host: %s Port: %s" (geiser-repl--host) (geiser-repl--port))) ((stringp address) (format "Socket: %s" address)) (t nil)))) (defun geiser-repl--output-filter (txt) (geiser-con--connection-update-debugging geiser-repl--connection txt) (geiser-image--replace-images geiser-repl-inline-images-p geiser-repl-auto-display-images-p) (when (string-match-p (geiser-con--connection-prompt geiser-repl--connection) txt) (geiser-autodoc--disinhibit-autodoc))) (defun geiser-repl--check-version (impl) (when (not geiser-repl-skip-version-check-p) (let ((v (geiser-repl--version impl (geiser-repl--binary impl))) (r (geiser-repl--min-version impl))) (when (and v r (geiser--version< v r)) (error "Geiser requires %s version %s but detected %s" impl r v))))) (defun geiser-repl--start-repl (impl address) (message "Starting Geiser REPL for %s ..." impl) (when (not address) (geiser-repl--check-version impl)) (geiser-repl--to-repl-buffer impl) (sit-for 0) (goto-char (point-max)) (geiser-repl--autodoc-mode -1) (let* ((prompt-rx (geiser-repl--prompt-regexp impl)) (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl)) (prompt (geiser-con--combined-prompt prompt-rx deb-prompt-rx))) (unless prompt-rx (error "Sorry, I don't know how to start a REPL for %s" impl)) (geiser-repl--save-remote-data address) (geiser-repl--start-scheme impl address prompt) (geiser-repl--quit-setup) (geiser-repl--history-setup) (add-to-list 'geiser-repl--repls (current-buffer)) (geiser-repl--set-this-buffer-repl (current-buffer)) (setq geiser-repl--connection (geiser-con--make-connection (get-buffer-process (current-buffer)) prompt-rx deb-prompt-rx)) (geiser-repl--startup impl address) (geiser-repl--autodoc-mode 1) (geiser-company--setup geiser-repl-company-p) (add-hook 'comint-output-filter-functions 'geiser-repl--output-filter nil t) (set-process-query-on-exit-flag (get-buffer-process (current-buffer)) geiser-repl-query-on-kill-p) (message "%s up and running!" (geiser-repl--repl-name impl)))) (defun geiser-repl--start-scheme (impl address prompt) (setq comint-prompt-regexp prompt) (let* ((name (geiser-repl--repl-name impl)) (buff (current-buffer)) (args (cond ((consp address) (list address)) ((stringp address) '(())) (t `(,(geiser-repl--binary impl) nil ,@(geiser-repl--arglist impl)))))) (condition-case err (if (and address (stringp address)) ;; Connect over a Unix-domain socket. (let ((proc (make-network-process :name (buffer-name buff) :buffer buff :family 'local :remote address))) ;; brittleness warning: this is stuff ;; make-comint-in-buffer sets up, via comint-exec, when ;; it creates its own process, something we're doing ;; here by ourselves. (set-process-filter proc 'comint-output-filter) (goto-char (point-max)) (set-marker (process-mark proc) (point))) (apply 'make-comint-in-buffer `(,name ,buff ,@args))) (error (insert "Unable to start REPL:\n" (error-message-string err) "\n") (error "Couldn't start Geiser: %s" err))) (geiser-repl--wait-for-prompt geiser-repl-startup-time))) (defun geiser-repl--wait-for-prompt (timeout) (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) (setq seen (re-search-forward comint-prompt-regexp nil t))) (goto-char (point-max)) (unless seen (error "%s" "No prompt found!")))) (defun geiser-repl--is-debugging () (let ((dp (geiser-con--connection-debug-prompt geiser-repl--connection))) (and dp (save-excursion (goto-char (geiser-repl--last-prompt-start)) (re-search-forward dp (geiser-repl--last-prompt-end) t))))) (defun geiser-repl--connection* () (let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation))) (and (buffer-live-p buffer) (get-buffer-process buffer) (with-current-buffer buffer geiser-repl--connection)))) (defun geiser-repl--connection () (or (geiser-repl--connection*) (error "No Geiser REPL for this buffer (try M-x run-geiser)"))) (setq geiser-eval--default-connection-function 'geiser-repl--connection) (defun geiser-repl--prepare-send () (geiser-image--clean-cache) (geiser-autodoc--inhibit-autodoc) (geiser-con--connection-deactivate geiser-repl--connection)) (defun geiser-repl--send (cmd &optional save-history) "Send CMD input string to the current REPL buffer. If SAVE-HISTORY is non-nil, save CMD in the REPL history." (when (and cmd (eq major-mode 'geiser-repl-mode)) (geiser-repl--prepare-send) (goto-char (point-max)) (comint-kill-input) (insert cmd) (let ((comint-input-filter (if save-history comint-input-filter 'ignore))) (comint-send-input nil t)))) (defun geiser-repl-interrupt () (interactive) (when (get-buffer-process (current-buffer)) (interrupt-process nil comint-ptyp))) ;;; REPL history (defconst geiser-repl--history-separator "\n}{\n") (defsubst geiser-repl--history-file () (format "%s.%s" geiser-repl-history-filename geiser-impl--implementation)) (defun geiser-repl--read-input-ring () (let ((comint-input-ring-file-name (geiser-repl--history-file)) (comint-input-ring-separator geiser-repl--history-separator) (buffer-file-coding-system 'utf-8)) (comint-read-input-ring t))) (defun geiser-repl--write-input-ring () (let ((comint-input-ring-file-name (geiser-repl--history-file)) (comint-input-ring-separator geiser-repl--history-separator) (buffer-file-coding-system 'utf-8)) (comint-write-input-ring))) (defun geiser-repl--history-setup () (set (make-local-variable 'comint-input-ring-size) geiser-repl-history-size) (set (make-local-variable 'comint-input-filter) 'geiser-repl--input-filter) (geiser-repl--read-input-ring)) ;;; Cleaning up (defun geiser-repl--on-quit () (geiser-repl--write-input-ring) (let ((cb (current-buffer)) (impl geiser-impl--implementation) (comint-prompt-read-only nil)) (geiser-con--connection-deactivate geiser-repl--connection t) (geiser-con--connection-close geiser-repl--connection) (setq geiser-repl--repls (remove cb geiser-repl--repls)) (dolist (buffer (buffer-list)) (when (buffer-live-p buffer) (with-current-buffer buffer (when (and (eq geiser-impl--implementation impl) (equal cb geiser-repl--repl)) (geiser-repl--set-up-repl geiser-impl--implementation))))))) (defun geiser-repl--sentinel (proc event) (let ((pb (process-buffer proc))) (when (buffer-live-p pb) (with-current-buffer pb (let ((comint-prompt-read-only nil) (comint-input-ring-file-name (geiser-repl--history-file)) (comint-input-ring-separator geiser-repl--history-separator)) (geiser-repl--on-quit) (push pb geiser-repl--closed-repls) (goto-char (point-max)) (comint-kill-region comint-last-input-start (point)) (insert "\nIt's been nice interacting with you!\n") (insert "Press C-c C-z to bring me back.\n" )))))) (defun geiser-repl--on-kill () (geiser-repl--on-quit) (setq geiser-repl--closed-repls (remove (current-buffer) geiser-repl--closed-repls))) (defun geiser-repl--input-filter (str) (not (or (and (not geiser-repl-save-debugging-history-p) (geiser-repl--is-debugging)) (string-match "^\\s *$" str) (string-match "^,quit *$" str)))) (defun geiser-repl--old-input () (save-excursion (let ((end (point))) (backward-sexp) (buffer-substring (point) end)))) (defun geiser-repl--quit-setup () (add-hook 'kill-buffer-hook 'geiser-repl--on-kill nil t) (set-process-sentinel (get-buffer-process (current-buffer)) 'geiser-repl--sentinel)) ;;; geiser-repl mode: (defun geiser-repl--bol () (interactive) (when (= (point) (comint-bol)) (beginning-of-line))) (defun geiser-repl--beginning-of-defun () (save-restriction (narrow-to-region (geiser-repl--last-prompt-end) (point)) (let ((beginning-of-defun-function nil)) (beginning-of-defun)))) (defun geiser-repl--module-function (&optional module) (if (and module geiser-eval--get-impl-module) (funcall geiser-eval--get-impl-module module) :f)) (defun geiser-repl--doc-module () (interactive) (let ((geiser-eval--get-module-function (geiser-impl--method 'find-module geiser-impl--implementation))) (geiser-doc-module))) (defun geiser-repl--newline-and-indent () (interactive) (save-restriction (narrow-to-region comint-last-input-start (point-max)) (insert "\n") (lisp-indent-line))) (defun geiser-repl--nesting-level () (save-restriction (narrow-to-region (geiser-repl--last-prompt-end) (point-max)) (geiser-syntax--nesting-level))) (defun geiser-repl--mark-input-bounds (beg end) (add-text-properties beg end '(field t))) (defun geiser-repl--is-history-input () (get-text-property (if (eolp) (save-excursion (comint-bol)) (point)) 'field)) (defun geiser-repl--grab-input () (let ((pos (comint-bol))) (goto-char (point-max)) (insert (field-string-no-properties pos)))) (defun geiser-repl--send-input () (let* ((proc (get-buffer-process (current-buffer))) (pmark (and proc (process-mark proc))) (intxt (and pmark (buffer-substring pmark (point)))) (eob (point-max))) (when intxt (and geiser-repl-forget-old-errors-p (not (geiser-repl--is-debugging)) (compilation-forget-errors)) (geiser-repl--prepare-send) (geiser-repl--mark-input-bounds pmark eob) (comint-send-input) (when (string-match "^\\s-*$" intxt) (comint-send-string proc (geiser-eval--scheme-str '(:ge no-values))) (comint-send-string proc "\n"))))) (defun geiser-repl--maybe-send () (interactive) (let ((p (point))) (cond ((< p (geiser-repl--last-prompt-start)) (if (geiser-repl--is-history-input) (geiser-repl--grab-input) (ignore-errors (compile-goto-error)))) ((let ((inhibit-field-text-motion t)) (end-of-line) (<= (geiser-repl--nesting-level) 0)) (geiser-repl--send-input)) (t (goto-char p) (if geiser-repl-auto-indent-p (geiser-repl--newline-and-indent) (insert "\n")))))) (defun geiser-repl-tab-dwim (n) "If we're after the last prompt, complete symbol or indent (if there's no symbol at point). Otherwise, go to next error in the REPL buffer." (interactive "p") (if (>= (point) (geiser-repl--last-prompt-end)) (or (completion-at-point) (lisp-indent-line)) (compilation-next-error n))) (defun geiser-repl--previous-error (n) "Go to previous error in the REPL buffer." (interactive "p") (compilation-next-error (- n))) (defun geiser-repl-clear-buffer () "Delete the output generated by the scheme process." (interactive) (let ((inhibit-read-only t)) (delete-region (point-min) (geiser-repl--last-prompt-start)) (when (< (point) (geiser-repl--last-prompt-end)) (goto-char (geiser-repl--last-prompt-end))) (recenter t))) (define-derived-mode geiser-repl-mode comint-mode "REPL" "Major mode for interacting with an inferior scheme repl process. \\{geiser-repl-mode-map}" (scheme-mode-variables) (set (make-local-variable 'face-remapping-alist) '((comint-highlight-prompt geiser-font-lock-repl-prompt) (comint-highlight-input geiser-font-lock-repl-input))) (set (make-local-variable 'mode-line-process) nil) (set (make-local-variable 'comint-use-prompt-regexp) t) (set (make-local-variable 'comint-prompt-read-only) geiser-repl-read-only-prompt-p) (setq comint-process-echoes nil) (set (make-local-variable 'beginning-of-defun-function) 'geiser-repl--beginning-of-defun) (set (make-local-variable 'comint-input-ignoredups) geiser-repl-history-no-dups-p) (setq geiser-eval--get-module-function 'geiser-repl--module-function) (geiser-completion--setup t) (setq geiser-smart-tab-mode-string "") (geiser-smart-tab-mode t) (geiser-syntax--add-kws) ;; enabling compilation-shell-minor-mode without the annoying highlighter (compilation-setup t)) (define-key geiser-repl-mode-map "\C-d" 'delete-char) (define-key geiser-repl-mode-map "\C-m" 'geiser-repl--maybe-send) (define-key geiser-repl-mode-map [return] 'geiser-repl--maybe-send) (define-key geiser-repl-mode-map "\C-j" 'geiser-repl--newline-and-indent) (define-key geiser-repl-mode-map (kbd "TAB") 'geiser-repl-tab-dwim) (define-key geiser-repl-mode-map [backtab] 'geiser-repl--previous-error) (define-key geiser-repl-mode-map "\C-a" 'geiser-repl--bol) (define-key geiser-repl-mode-map (kbd "") 'geiser-repl--bol) (geiser-menu--defmenu repl geiser-repl-mode-map ("Complete symbol" ((kbd "M-TAB")) completion-at-point :enable (geiser--symbol-at-point)) ("Complete module name" ((kbd "C-.") (kbd "M-`")) geiser-completion--complete-module :enable (geiser--symbol-at-point)) ("Edit symbol" "\M-." geiser-edit-symbol-at-point :enable (geiser--symbol-at-point)) -- ("Switch to module..." "\C-c\C-m" switch-to-geiser-module) ("Import module..." "\C-c\C-i" geiser-repl-import-module) ("Add to load path..." "\C-c\C-r" geiser-add-to-load-path) -- ("Previous matching input" "\M-p" comint-previous-matching-input-from-input "Previous input matching current") ("Next matching input" "\M-n" comint-next-matching-input-from-input "Next input matching current") ("Previous input" "\C-c\M-p" comint-previous-input) ("Next input" "\C-c\M-n" comint-next-input) -- ("Interrupt evaluation" ("\C-c\C-k" "\C-c\C-c" "\C-ck") geiser-repl-interrupt) -- (mode "Autodoc mode" ("\C-c\C-da" "\C-c\C-d\C-a") geiser-autodoc-mode) ("Symbol documentation" ("\C-c\C-dd" "\C-c\C-d\C-d") geiser-doc-symbol-at-point "Documentation for symbol at point" :enable (geiser--symbol-at-point)) ("Lookup symbol in manul" ("\C-c\C-di" "\C-c\C-d\C-i") geiser-doc-look-up-manual "Documentation for symbol at point" :enable (geiser--symbol-at-point)) ("Module documentation" ("\C-c\C-dm" "\C-c\C-d\C-m") geiser-repl--doc-module "Documentation for module at point" :enable (geiser--symbol-at-point)) -- ("Clear buffer" "\C-c\M-o" geiser-repl-clear-buffer "Clean up REPL buffer, leaving just a lonely prompt") ("Kill Scheme interpreter" "\C-c\C-q" geiser-repl-exit :enable (geiser-repl--live-p)) ("Restart" "\C-c\C-z" switch-to-geiser :enable (not (geiser-repl--live-p))) -- (custom "REPL options" geiser-repl)) (define-key geiser-repl-mode-map [menu-bar completion] 'undefined) ;;; User commands (defun run-geiser (impl) "Start a new Geiser REPL." (interactive (list (geiser-repl--get-impl "Start Geiser for scheme implementation: "))) (let ((buffer (current-buffer))) (geiser-repl--start-repl impl nil) (geiser-repl--maybe-remember-scm-buffer buffer))) (defalias 'geiser 'run-geiser) (defun geiser-connect (impl &optional host port) "Start a new Geiser REPL connected to a remote Scheme process." (interactive (list (geiser-repl--get-impl "Connect to Scheme implementation: "))) (let ((buffer (current-buffer))) (geiser-repl--start-repl impl (geiser-repl--read-address host port)) (geiser-repl--maybe-remember-scm-buffer buffer))) (defun geiser-connect-local (impl &optional socket) "Start a new Geiser REPL connected to a remote Scheme process over a Unix-domain socket." (interactive (list (geiser-repl--get-impl "Connect to Scheme implementation: "))) (let ((buffer (current-buffer))) (geiser-repl--start-repl impl (read-file-name "Socket file name: ")) (geiser-repl--maybe-remember-scm-buffer buffer))) (make-variable-buffer-local (defvar geiser-repl--last-scm-buffer nil)) (defun geiser-repl--maybe-remember-scm-buffer (buffer) (when (and buffer (eq 'scheme-mode (with-current-buffer buffer major-mode)) (eq major-mode 'geiser-repl-mode)) (setq geiser-repl--last-scm-buffer buffer))) (defun switch-to-geiser (&optional ask impl buffer) "Switch to running Geiser REPL. With prefix argument, ask for which one if more than one is running. If no REPL is running, execute `run-geiser' to start a fresh one." (interactive "P") (let* ((impl (or impl geiser-impl--implementation)) (in-repl (eq major-mode 'geiser-repl-mode)) (in-live-repl (and in-repl (get-buffer-process (current-buffer)))) (repl (cond ((and (not ask) (not impl) (not in-repl) (or geiser-repl--repl (car geiser-repl--repls)))) ((and (not ask) (not in-repl) impl (geiser-repl--repl/impl impl)))))) (cond ((or in-live-repl (and (eq (current-buffer) repl) (not (eq repl buffer)))) (when (buffer-live-p geiser-repl--last-scm-buffer) (geiser-repl--switch-to-buffer geiser-repl--last-scm-buffer))) (repl (geiser-repl--switch-to-buffer repl)) ((geiser-repl--remote-p) (geiser-connect impl)) (impl (run-geiser impl)) (t (call-interactively 'run-geiser))) (geiser-repl--maybe-remember-scm-buffer buffer))) (defun switch-to-geiser-module (&optional module buffer) "Switch to running Geiser REPL and try to enter a given module." (interactive) (let* ((module (or module (geiser-completion--read-module "Switch to module (default top-level): "))) (cmd (and module (geiser-repl--enter-cmd geiser-impl--implementation module)))) (unless (eq major-mode 'geiser-repl-mode) (switch-to-geiser nil nil (or buffer (current-buffer)))) (geiser-repl--send cmd))) (defun geiser-repl-import-module (&optional module) "Import a given module in the current namespace of the REPL." (interactive) (let* ((module (or module (geiser-completion--read-module "Import module: "))) (cmd (and module (geiser-repl--import-cmd geiser-impl--implementation module)))) (switch-to-geiser nil nil (current-buffer)) (geiser-repl--send cmd))) (defun geiser-repl-exit (&optional arg) "Exit the current REPL. With a prefix argument, force exit by killing the scheme process." (interactive "P") (when (or (not geiser-repl-query-on-exit-p) (y-or-n-p "Really quit this REPL? ")) (geiser-con--connection-deactivate geiser-repl--connection t) (let ((cmd (and (not arg) (geiser-repl--exit-cmd geiser-impl--implementation)))) (if cmd (when (stringp cmd) (geiser-repl--send cmd)) (comint-kill-subjob))))) ;;; Unload: (defun geiser-repl--repl-list () (let (lst) (dolist (repl geiser-repl--repls lst) (when (buffer-live-p repl) (with-current-buffer repl (push (cons geiser-impl--implementation geiser-repl--address) lst)))))) (defun geiser-repl--restore (impls) (dolist (impl impls) (when impl (condition-case err (geiser-repl--start-repl (car impl) (cdr impl)) (error (message (error-message-string err))))))) (defun geiser-repl-unload-function () (dolist (repl geiser-repl--repls) (when (buffer-live-p repl) (with-current-buffer repl (let ((geiser-repl-query-on-exit-p nil)) (geiser-repl-exit)) (sit-for 0.05) (kill-buffer))))) (provide 'geiser-repl) ;;; Initialization: ;; After providing 'geiser-repl, so that impls can use us. (mapc 'geiser-impl--load-impl geiser-active-implementations) geiser-0.8.1/geiser-base.el0000644000175000017500000000502412607252416013620 0ustar jaojao;;; geiser-base.el --- shared bits ;; Copyright (C) 2009, 2010, 2012, 2013, 2015 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Settings and vars shared by all geiser modules, including little ;; utilities and emacsen compatibility bits. ;;; Emacs compatibility: (require 'ring) (eval-after-load "ring" '(when (not (fboundp 'ring-member)) (defun ring-member (ring item) (catch 'found (dotimes (ind (ring-length ring) nil) (when (equal item (ring-ref ring ind)) (throw 'found ind))))))) (when (not (fboundp 'looking-at-p)) (defsubst looking-at-p (regexp) (let ((inhibit-changing-match-data t)) (looking-at regexp)))) ;;; Utilities: (defsubst geiser--chomp (str) (if (string-match-p ".*\n$" str) (substring str 0 -1) str)) (defun geiser--shorten-str (str len &optional sep) (let ((str-len (length str))) (if (<= str-len len) str (let* ((sep (or sep " ... ")) (sep-len (length sep)) (prefix-len (/ (- str-len sep-len) 2)) (prefix (substring str 0 prefix-len)) (suffix (substring str (- str-len prefix-len)))) (format "%s%s%s" prefix sep suffix))))) (defun geiser--region-to-string (begin &optional end) (let ((end (or end (point)))) (when (< begin end) (let* ((str (buffer-substring-no-properties begin end)) (pieces (split-string str nil t))) (mapconcat 'identity pieces " "))))) (defun geiser--insert-with-face (str face) (let ((p (point))) (insert str) (put-text-property p (point) 'face face))) (defmacro geiser--save-msg (&rest body) (let ((msg (make-symbol "msg"))) `(let ((,msg (current-message))) ,@body (message ,msg)))) (put 'geiser--save-msg 'lisp-indent-function 0) (defun geiser--del-dups (lst) (let (result) (dolist (e lst (nreverse result)) (unless (member e result) (push e result))))) (defsubst geiser--symbol-at-point () (let ((thing (thing-at-point 'symbol))) (and thing (make-symbol thing)))) (defun geiser--cut-version (v) (when (string-match "\\([0-9]+\\(?:\\.[0-9]+\\)*\\).*" v) (match-string 1 v))) (defun geiser--version< (v1 v2) (let ((v1 (geiser--cut-version v1)) (v2 (geiser--cut-version v2))) (and v1 v2 (version< v1 v2)))) (provide 'geiser-base) geiser-0.8.1/geiser-pkg.el0000644000175000017500000000011412607252416013462 0ustar jaojao(define-package "geiser" "0.8.1" "GNU Emacs and Scheme talk to each other") geiser-0.8.1/geiser-company.el0000644000175000017500000001111712607252416014354 0ustar jaojao;; geiser-company.el -- integration with company-mode ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Mon Aug 24, 2009 12:44 (require 'geiser-autodoc) (require 'geiser-completion) (require 'geiser-edit) (require 'geiser-base) (require 'geiser-doc) (eval-when-compile (require 'cl)) ;;; Helpers: (make-variable-buffer-local (defvar geiser-company--enabled-flag nil)) (make-variable-buffer-local (defvar geiser-company--autodoc-flag nil)) (make-variable-buffer-local (defvar geiser-company--completions nil)) (defun geiser-company--candidates (prefix) (and (equal prefix (car geiser-company--completions)) (cdr geiser-company--completions))) (defun geiser-company--doc (id) (ignore-errors (when (not (geiser-autodoc--inhibit)) (let ((help (geiser-autodoc--autodoc `((,id 0))))) (and help (substring-no-properties help)))))) (defun geiser-company--doc-buffer (id) (let* ((impl geiser-impl--implementation) (module (geiser-doc-module (geiser-eval--get-module) impl)) (symbol (make-symbol id)) (ds (geiser-doc--get-docstring symbol module))) (if (or (not ds) (not (listp ds))) (message "No documentation available for '%s'" symbol) (with-current-buffer (get-buffer-create "*company-documentation*") (geiser-doc--render-docstring ds symbol module impl) (current-buffer))))) (defun geiser-company--location (id) (ignore-errors (when (not (geiser-autodoc--inhibit)) (let ((id (make-symbol id))) (condition-case nil (geiser-edit-module id 'noselect) (error (geiser-edit-symbol id 'noselect))))))) (defun geiser-company--prefix-at-point () (when (and (not (geiser-autodoc--inhibit)) geiser-company--enabled-flag) (if (nth 8 (syntax-ppss)) 'stop (let* ((prefix (and (looking-at-p "\\_>") (geiser-completion--prefix nil))) (cmps1 (and prefix (geiser-completion--complete prefix nil))) (cmps2 (and prefix (geiser-completion--complete prefix t))) (mprefix (and (not cmps1) (not cmps2) (geiser-completion--prefix t))) (cmps3 (and mprefix (geiser-completion--complete mprefix t))) (cmps (or cmps3 (append cmps1 cmps2))) (prefix (or mprefix prefix))) (setq geiser-company--completions (cons prefix cmps)) prefix)))) ;;; Activation (defun geiser-company--setup (enable) (setq geiser-company--enabled-flag 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) (geiser-autodoc-mode -1))) (defun geiser-company--restore-autodoc (&optional ignored) (when geiser-company--autodoc-flag (geiser-autodoc-mode 1))) ;;; Company activation (eval-after-load "company" '(progn (defun geiser-company-backend (command &optional arg &rest ignored) "A `company-mode' completion back-end for `geiser-mode'." (interactive (list 'interactive)) (case command ('interactive (company-begin-backend 'geiser-company-backend)) ('prefix (geiser-company--prefix-at-point)) ('candidates (geiser-company--candidates arg)) ('meta (geiser-company--doc arg)) ('doc-buffer (geiser-company--doc-buffer arg)) ('location (geiser-company--location arg)) ('sorted t))) (defun geiser-company--setup-company (enable) (set (make-local-variable 'company-default-lighter) "/C") (set (make-local-variable 'company-echo-delay) 0.01) (set (make-local-variable 'company-backends) (and enable '(geiser-company-backend))) (company-mode (if enable 1 -1))) (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) (define-key company-active-map (kbd "M-`") (lambda () (interactive) (company-cancel) (call-interactively 'geiser-completion--complete-module))))) (provide 'geiser-company) geiser-0.8.1/scheme/0000755000175000017500000000000012607252416012353 5ustar jaojaogeiser-0.8.1/scheme/guile/0000755000175000017500000000000012607252416013460 5ustar jaojaogeiser-0.8.1/scheme/guile/geiser/0000755000175000017500000000000012607252416014736 5ustar jaojaogeiser-0.8.1/scheme/guile/geiser/modules.scm0000644000175000017500000000514012607252416017112 0ustar jaojao;;; modules.scm -- module metadata ;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Mon Mar 02, 2009 02:00 (define-module (geiser modules) #:export (symbol-module module-name? module-path find-module all-modules submodules module-location) #:use-module (geiser utils) #:use-module (system vm program) #:use-module (ice-9 regex) #:use-module (ice-9 session) #:use-module (srfi srfi-1)) (define (module-name? module-name) (and (list? module-name) (not (null? module-name)) (every symbol? module-name))) (define (symbol-module sym . all) (and sym (catch 'module-name (lambda () (apropos-fold (lambda (module name var init) (if (eq? name sym) (throw 'module-name (module-name module)) init)) #f (regexp-quote (symbol->string sym)) (if (or (null? all) (not (car all))) (apropos-fold-accessible (current-module)) apropos-fold-all))) (lambda (key . args) (and (eq? key 'module-name) (car args)))))) (define (module-location name) (make-location (module-path name) #f)) (define (find-module mod-name) (and (module-name? mod-name) (resolve-module mod-name #f #:ensure #f))) (define (module-path module-name) (and (module-name? module-name) (or ((@@ (ice-9 session) module-filename) module-name) (module-filename (resolve-module module-name #f))))) (define (submodules mod) (hash-map->list (lambda (k v) v) (module-submodules mod))) (define (root-modules) (submodules (resolve-module '() #f))) (define (all-modules) (define (maybe-name m) (and (module-kind m) (format #f "~A" (module-name m)))) (let* ((guile (resolve-module '(guile))) (roots (remove (lambda (m) (eq? m guile)) (root-modules))) (children (append-map all-child-modules roots))) (cons "(guile)" (filter-map maybe-name children)))) (define* (all-child-modules mod #:optional (seen '())) (let ((cs (filter (lambda (m) (not (member m seen))) (submodules mod)))) (fold (lambda (m all) (append (all-child-modules m all) all)) (list mod) cs))) geiser-0.8.1/scheme/guile/geiser/emacs.scm0000644000175000017500000000405512607252416016536 0ustar jaojao;;; emacs.scm -- procedures for emacs interaction: entry point ;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sun Feb 08, 2009 18:39 (define-module (geiser emacs) #:use-module (ice-9 match) #:use-module (system repl command) #:use-module (system repl error-handling) #:use-module (system repl server) #:use-module (geiser evaluation) #:use-module ((geiser modules) #:renamer (symbol-prefix-proc 'ge:)) #:use-module ((geiser completion) #:renamer (symbol-prefix-proc 'ge:)) #:use-module ((geiser xref) #:renamer (symbol-prefix-proc 'ge:)) #:use-module ((geiser doc) #:renamer (symbol-prefix-proc 'ge:))) (define this-module (resolve-module '(geiser emacs))) (define-meta-command ((geiser-no-values geiser) repl) "geiser-no-values No-op command used internally by Geiser." (values)) (define-meta-command ((geiser-newline geiser) repl) "geiser-newline Meta-command used by Geiser to emit a new line." (newline)) (define-meta-command ((geiser-eval geiser) repl (mod form args) . rest) "geiser-eval module form args () Meta-command used by Geiser to evaluate and compile code." (if (null? args) (call-with-error-handling (lambda () (ge:compile form mod))) (let ((proc (eval form this-module))) (ge:eval `(,proc ,@args) mod)))) (define-meta-command ((geiser-load-file geiser) repl file) "geiser-load-file file Meta-command used by Geiser to load and compile files." (call-with-error-handling (lambda () (ge:compile-file file)))) (define-meta-command ((geiser-start-server geiser) repl) "geiser-start-server Meta-command used by Geiser to start a REPL server." (let* ((sock (make-tcp-server-socket #:port 0)) (port (sockaddr:port (getsockname sock)))) (spawn-server sock) (write (list 'port port)) (newline))) geiser-0.8.1/scheme/guile/geiser/utils.scm0000644000175000017500000000307112607252416016603 0ustar jaojao;;; utils.scm -- utility functions ;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Mon Mar 02, 2009 01:48 (define-module (geiser utils) #:export (make-location symbol->object pair->list sort-symbols! make-symbol-sort gensym?) #:use-module (ice-9 regex)) (define (symbol->object sym) (and (symbol? sym) (module-defined? (current-module) sym) (module-ref (current-module) sym))) (define (pair->list pair) (let loop ((d pair) (s '())) (cond ((null? d) (reverse! s)) ((symbol? d) (reverse! (cons d s))) (else (loop (cdr d) (cons (car d) s)))))) (define (make-location file line) (list (cons "file" (if (string? file) file '())) (cons "line" (if (number? line) (+ 1 line) '())))) (define (sort-symbols! syms) (let ((cmp (lambda (l r) (stringstring l) (symbol->string r))))) (sort! syms cmp))) (define (make-symbol-sort sel) (let ((cmp (lambda (a b) (stringstring (sel a)) (symbol->string (sel b)))))) (lambda (syms) (sort! syms cmp)))) (define (gensym? sym) (and (symbol? sym) (gensym-name? (format #f "~A" sym)))) (define (gensym-name? name) (and (string-match "^#[{]" name) #t)) geiser-0.8.1/scheme/guile/geiser/xref.scm0000644000175000017500000000555612607252416016421 0ustar jaojao;;; xref.scm -- cross-referencing utilities ;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Mon Mar 02, 2009 02:37 (define-module (geiser xref) #:export (symbol-location generic-methods callers callees find-file) #:use-module (geiser utils) #:use-module (geiser modules) #:use-module (geiser doc) #:use-module (oop goops) #:use-module (system xref) #:use-module (system vm program)) (define (symbol-location sym) (cond ((symbol-module sym) => module-location) (else (let ((obj (symbol->object sym))) (or (and (program? obj) (program-location obj)) '()))))) (define (generic-methods sym) (let* ((gen (symbol->object sym)) (methods (if (is-a? gen ) (generic-function-methods gen) '()))) (filter (lambda (x) (not (null? x))) (map (lambda (m) (make-xref (method-procedure m) sym (symbol-module sym))) methods)))) (define (make-xref proc name module) (and proc `(("location" . ,(or (program-location proc) (symbol-location name))) ("signature" . ,(object-signature name proc)) ("module" . ,(or module '()))))) (define (program-location p) (cond ((not (program? p)) #f) ((program-source p 0) => (lambda (s) (make-location (program-path p) (source:line s)))) ((program-path p) => (lambda (s) (make-location s #f))) (else #f))) (define (program-path p) (let* ((mod (program-module p)) (name (and (module? mod) (module-name mod)))) (and name (module-path name)))) (define (procedure-xref proc . mod-name) (let* ((proc-name (or (procedure-name proc) ')) (mod-name (if (null? mod-name) (symbol-module proc-name) (car mod-name)))) (make-xref proc proc-name mod-name))) (define (callers sym) (let ((mod (symbol-module sym #t))) (and mod (apply append (map (lambda (procs) (map (lambda (proc) (procedure-xref proc (car procs))) (cdr procs))) (procedure-callers (cons mod sym))))))) (define (callees sym) (let ((obj (symbol->object sym))) (and obj (map procedure-xref (procedure-callees obj))))) (define (find-file path) (let loop ((dirs %load-path)) (if (null? dirs) #f (let ((candidate (string-append (car dirs) "/" path))) (if (file-exists? candidate) candidate (loop (cdr dirs))))))) geiser-0.8.1/scheme/guile/geiser/doc.scm0000644000175000017500000002260412607252416016213 0ustar jaojao;;; doc.scm -- procedures providing documentation on scheme objects ;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sun Feb 08, 2009 18:44 (define-module (geiser doc) #:export (autodoc symbol-documentation module-exports object-signature) #:use-module (geiser utils) #:use-module (geiser modules) #:use-module (system vm program) #:use-module (ice-9 session) #:use-module (ice-9 documentation) #:use-module (ice-9 regex) #:use-module (ice-9 format) #:use-module (oop goops) #:use-module (srfi srfi-1)) (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 `(,@(signature id args) ("module" . ,(symbol-module id)))))) (define (object-signature name obj) (let ((args (obj-args obj))) (and args (signature name args)))) (define (value-str obj) (format #f "~:@y" obj)) (define* (signature id args-list #:optional (detail #t)) (define (arglst args kind) (let ((args (assq-ref args kind))) (cond ((or (not args) (null? args)) '()) ((list? args) args) (else (list args))))) (define (mkargs as) `(("required" ,@(arglst as 'required)) ("optional" ,@(arglst as 'optional) ,@(if (assq-ref as 'rest) (list "...") '())) ("key" ,@(arglst as 'keyword)))) (let* ((args-list (map mkargs (if (list? args-list) args-list '()))) (value (and (and detail (null? args-list)) (value-str (symbol->object id))))) `(,id ("args" ,@args-list) ,@(if value `(("value" . ,value)) '())))) (define default-macro-args '(((required ...)))) (define geiser-args-key (gensym "geiser-args-key-")) (define (obj-args obj) (cond ((not obj) #f) ((or (procedure? obj) (program? obj)) (cond ((procedure-property obj geiser-args-key)) ((arguments obj) => (lambda (args) (set-procedure-property! obj geiser-args-key args) args)) (else #f))) ((and (macro? obj) (macro-transformer obj)) => macro-args) ((macro? obj) default-macro-args) (else 'variable))) (define (arguments proc) (define (p-args prog) (let ((as (map (lambda (a) ((@@ (system vm program) arity->arguments-alist) prog a)) (or (program-arities prog) '())))) (and (not (null? as)) as))) (define (clist f) (lambda (x) (let ((y (f x))) (and y (list y))))) (cond ((is-a? proc ) (generic-args proc)) ((doc->args proc) => list) ((procedure-property proc 'arglist) => (clist arglist->args)) ((procedure-source proc) => (clist source->args)) ((and (program? proc) (p-args proc))) ((procedure-property proc 'arity) => (clist arity->args)) (else #f))) (define (source->args src) (let ((formals (cadr src))) (cond ((list? formals) `((required . ,formals))) ((pair? formals) `((required . ,(car formals)) (rest . ,(cdr formals)))) (else #f)))) (define (macro-args tf) (define* (collect args #:optional (req '())) (cond ((null? args) (arglist->args `(,(reverse req) #f #f r #f))) ((symbol? args) (arglist->args `(,(reverse req) #f #f r ,args))) ((and (pair? args) (symbol? (car args))) (collect (cdr args) (cons (car args) req))) (else #f))) (let* ((pats (procedure-property tf 'patterns)) (args (and pats (filter-map collect pats)))) (or (and args (not (null? args)) args) default-macro-args))) (define (arity->args art) (define (gen-arg-names count) (map (lambda (x) '_) (iota (max count 0)))) (let ((req (car art)) (opt (cadr art)) (rest (caddr art))) `(,@(if (> req 0) (list (cons 'required (gen-arg-names req))) '()) ,@(if (> opt 0) (list (cons 'optional (gen-arg-names opt))) '()) ,@(if rest (list (cons 'rest 'rest)) '())))) (define (arglist->args arglist) `((required . ,(car arglist)) (optional . ,(cadr arglist)) (keyword . ,(caddr arglist)) (rest . ,(car (cddddr arglist))))) (define (doc->args proc) ;; Guile 2.0.9+ uses the (texinfo ...) modules to produce ;; `guile-procedures.txt', and the output has a single hyphen, whereas ;; `makeinfo' produces two hyphens. (define proc-rx "--? Scheme Procedure: ([^[\n]+)\n") (define proc-rx2 "--? Scheme Procedure: ([^[\n]+\\[[^\n]*(\n[^\n]+\\]+)?)") (let ((doc (object-documentation proc))) (and doc (let ((match (or (string-match proc-rx doc) (string-match proc-rx2 doc)))) (and match (parse-signature-string (match:substring match 1))))))) (define (parse-signature-string str) (define opt-arg-rx "\\[([^] ]+)\\]?") (define opt-arg-rx2 "([^ ])+\\]+") (let ((tokens (string-tokenize str))) (if (< (length tokens) 2) '() (let loop ((tokens (cdr tokens)) (req '()) (opt '()) (rest #f)) (cond ((null? tokens) `((required ,@(map string->symbol (reverse! req))) (optional ,@(map string->symbol (reverse! opt))) ,@(if rest (list (cons 'rest (string->symbol rest))) '()))) ((string=? "." (car tokens)) (if (not (null? (cdr tokens))) (loop (cddr tokens) req opt (cadr tokens)) (loop '() req opt "rest"))) ((or (string-match opt-arg-rx (car tokens)) (string-match opt-arg-rx2 (car tokens))) => (lambda (m) (loop (cdr tokens) req (cons (match:substring m 1) opt) rest))) (else (loop (cdr tokens) (cons (car tokens) req) opt rest))))))) (define (generic-args gen) (define (src> src1 src2) (> (length (cadr src1)) (length (cadr src2)))) (define (src m) (catch #t (lambda () (method-source m)) (lambda (k . a) #f))) (let* ((methods (generic-function-methods gen)) (srcs (filter identity (map src methods)))) (cond ((and (null? srcs) (not (null? methods)) (method-procedure (car methods))) => arguments) ((not (null? srcs)) (list (source->args (car (sort! srcs src>))))) (else '(((rest . rest))))))) (define (symbol-documentation sym) (let ((obj (symbol->object sym))) (if obj `(("signature" . ,(or (obj-signature sym obj #f) sym)) ("docstring" . ,(docstring sym obj)))))) (define (docstring sym obj) (define (valuable?) (not (or (macro? obj) (procedure? obj) (program? obj)))) (with-output-to-string (lambda () (let* ((type (cond ((macro? obj) "A macro") ((procedure? obj) "A procedure") ((program? obj) "A compiled program") (else "An object"))) (modname (symbol-module sym)) (doc (object-documentation obj))) (display type) (if modname (begin (display " in module ") (display modname) (display "."))) (newline) (if doc (begin (newline) (display doc))) (if (valuable?) (begin (newline) (display "Value:") (newline) (display " ") (display (value-str obj)))))))) (define* (obj-signature sym obj #:optional (detail #t)) (let ((args (obj-args obj))) (and args (signature sym args detail)))) (define (module-exports mod-name) (define elt-sort (make-symbol-sort car)) (let* ((mod (catch #t (lambda () (resolve-interface mod-name)) (lambda args (resolve-module mod-name)))) (elts (hash-fold classify-module-object (list '() '() '()) (module-obarray mod))) (elts (map elt-sort elts)) (subs (map (lambda (m) (list (module-name m))) (submodules (resolve-module mod-name #f))))) (list (cons "modules" subs) (cons "procs" (car elts)) (cons "syntax" (cadr elts)) (cons "vars" (caddr elts))))) (define (classify-module-object name var elts) (let ((obj (and (variable-bound? var) (variable-ref var)))) (cond ((or (not obj) (module? obj)) elts) ((or (procedure? obj) (program? obj)) (list (cons (list name `("signature" . ,(obj-signature name obj))) (car elts)) (cadr elts) (caddr elts))) ((macro? obj) (list (car elts) (cons (list name `("signature" . ,(obj-signature name obj))) (cadr elts)) (caddr elts))) (else (list (car elts) (cadr elts) (cons (list name) (caddr elts))))))) geiser-0.8.1/scheme/guile/geiser/completion.scm0000644000175000017500000000176712607252416017626 0ustar jaojao;;; completion.scm -- completing known symbols and module names ;; Copyright (C) 2009, 2012 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Mon Mar 02, 2009 02:22 (define-module (geiser completion) #:export (completions module-completions) #:use-module (geiser utils) #:use-module (geiser modules) #:use-module (ice-9 session) #:use-module (ice-9 regex)) (define (completions prefix) (let ((prefix (string-append "^" (regexp-quote prefix)))) (sort! (map symbol->string (apropos-internal prefix)) string. ;; Start date: Mon Mar 02, 2009 02:46 (define-module (geiser evaluation) #:export (ge:compile ge:eval ge:macroexpand ge:compile-file ge:load-file ge:set-warnings ge:add-to-load-path) #:use-module (geiser modules) #:use-module (srfi srfi-1) #:use-module (language tree-il) #:use-module (system base compile) #:use-module (system base message) #:use-module (system base pmatch) #:use-module (system vm program) #:use-module (ice-9 pretty-print)) (define compile-opts '()) (define compile-file-opts '()) (define default-warnings '(arity-mismatch unbound-variable format)) (define verbose-warnings `(unused-variable ,@default-warnings)) (define (ge:set-warnings wl) (let* ((warns (cond ((list? wl) wl) ((symbol? wl) (case wl ((none nil null) '()) ((medium default) default-warnings) ((high verbose) verbose-warnings) (else '()))) (else '()))) (fwarns (if (memq 'unused-variable warns) (cons 'unused-toplevel warns) warns))) (set! compile-opts (list #:warnings warns)) (set! compile-file-opts (list #:warnings fwarns)))) (ge:set-warnings 'none) (define (call-with-result thunk) (letrec* ((result #f) (output (with-output-to-string (lambda () (with-fluids ((*current-warning-port* (current-output-port)) (*current-warning-prefix* "")) (with-error-to-port (current-output-port) (lambda () (set! result (map object->string (thunk)))))))))) (write `((result ,@result) (output . ,output))) (newline))) (define (ge:compile form module) (compile* form module compile-opts)) (define (compile* form module-name opts) (let* ((module (or (find-module module-name) (current-module))) (ev (lambda () (call-with-values (lambda () (let* ((o (compile form #:to 'objcode #:env module #:opts opts)) (thunk (make-program o))) (start-stack 'geiser-evaluation-stack (eval `(,thunk) module)))) (lambda vs vs))))) (call-with-result ev))) (define (ge:eval form module-name) (let* ((module (or (find-module module-name) (current-module))) (ev (lambda () (call-with-values (lambda () (eval form module)) (lambda vs vs))))) (call-with-result ev))) (define (ge:compile-file path) (call-with-result (lambda () (let ((cr (compile-file path #:canonicalization 'absolute #:opts compile-file-opts))) (and cr (list (object->string (save-module-excursion (lambda () (load-compiled cr)))))))))) (define ge:load-file ge:compile-file) (define (ge:macroexpand form . all) (let ((all (and (not (null? all)) (car all)))) (with-output-to-string (lambda () (pretty-print (tree-il->scheme (macroexpand form))))))) (define (add-to-list lst dir) (and (not (member dir lst)))) (define (ge:add-to-load-path dir) (and (file-is-directory? dir) (let ((in-lp (member dir %load-path)) (in-clp (member dir %load-compiled-path))) (when (not in-lp) (set! %load-path (cons dir %load-path))) (when (not in-clp) (set! %load-compiled-path (cons dir %load-compiled-path))) (or in-lp in-clp)))) geiser-0.8.1/scheme/chicken/0000755000175000017500000000000012607252416013757 5ustar jaojaogeiser-0.8.1/scheme/chicken/geiser/0000755000175000017500000000000012607252416015235 5ustar jaojaogeiser-0.8.1/scheme/chicken/geiser/emacs.scm0000644000175000017500000006452412607252416017044 0ustar jaojao;; Copyright (C) 2015 Daniel J Leslie ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . (module geiser (geiser-eval geiser-no-values geiser-newline geiser-start-server geiser-completions geiser-autodoc geiser-object-signature geiser-symbol-location geiser-symbol-documentation geiser-find-file geiser-add-to-load-path geiser-load-file geiser-compile-file geiser-compile geiser-module-exports geiser-module-path geiser-module-location geiser-module-completions geiser-macroexpand geiser-use-debug-log) (import chicken scheme) (use apropos chicken-doc data-structures extras ports posix srfi-1 srfi-13 srfi-14 srfi-18 srfi-69 tcp utils) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Symbol lists ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define geiser-r4rs-symbols (make-parameter '(not boolean? eq? eqv? equal? pair? cons car cdr caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr set-car! set-cdr! null? list? list length list-tail list-ref append reverse memq memv member assq assv assoc symbol? symbol->string string->symbol number? integer? exact? real? complex? inexact? rational? zero? odd? even? positive? negative? max min + - * / = > < >= <= quotient remainder modulo gcd lcm abs floor ceiling truncate round exact->inexact inexact->exact exp log expt sqrt sin cos tan asin acos atan number->string string->number char? char=? char>? char=? char<=? char-ci=? char-ci? char-ci>=? char-ci<=? char-alphabetic? char-whitespace? char-numeric? char-upper-case? char-lower-case? char-upcase char-downcase char->integer integer->char string? string=? string>? string=? string<=? string-ci=? string-ci? string-ci>=? string-ci<=? make-string string-length string-ref string-set! string-append string-copy string->list list->string substring string-fill! vector? make-vector vector-ref vector-set! string vector vector-length vector->list list->vector vector-fill! procedure? map for-each apply force call-with-current-continuation input-port? output-port? current-input-port current-output-port call-with-input-file call-with-output-file open-input-file open-output-file close-input-port close-output-port load read eof-object? read-char peek-char write display write-char newline with-input-from-file with-output-to-file eval char-ready? imag-part real-part magnitude numerator denominator scheme-report-environment null-environment interaction-environment else))) (define geiser-r5rs-symbols (make-parameter '(abs acos and angle append apply asin assoc assq assv atan begin boolean? caar cadr call-with-current-continuation call-with-input-file call-with-output-file call-with-values car case cdddar cddddr cdr ceiling char->integer char-alphabetic? char-ci<=? char-ci=? char-ci>? char-downcase char-lower-case? char-numeric? char-ready? char-upcase char-upper-case? char-whitespace? char<=? char=? char>? char? close-input-port close-output-port complex? cond cons cos current-input-port current-output-port define define-syntax delay denominator display do dynamic-wind else eof-object? eq? equal? eqv? eval even? exact->inexact exact? exp expt floor for-each force gcd if imag-part inexact->exact inexact? input-port? integer->char integer? interaction-environment lambda lcm length let let* let-syntax letrec letrec-syntax list list->string list->vector list-ref list-tail list? load log magnitude make-polar make-rectangular make-string make-vector map max member memq memv min modulo negative? newline not null-environment null? number->string number? numerator odd? open-input-file open-output-file or output-port? pair? peek-char port? positive? procedure? quasiquote quote quotient rational? rationalize read read-char real-part real? remainder reverse round scheme-report-environment set! set-car! set-cdr! setcar sin sqrt string string->list string->number string->symbol string-append string-ci<=? string-ci=? string-ci>? string-copy string-fill! string-length string-ref string-set! string<=? string=? string>? string? substring symbol->string symbol? syntax-rules tan transcript-off transcript-on truncate values vector vector->list vector-fill! vector-length vector-ref vector-set! vector? with-input-from-file with-output-to-file write write-char zero?))) (define geiser-r7rs-small-symbols (make-parameter '(* + - ... / < <= = => > >= abs and append apply assoc assq assv begin binary-port? boolean=? boolean? bytevector bytevector-append bytevector-copy bytevector-copy! bytevector-length bytevector-u8-ref bytevector-u8-set! bytevector? caar cadr call-with-current-continuation call-with-port call-with-values call/cc car case cdar cddr cdr ceiling char->integer char-ready? char<=? char=? char>? char? close-input-port close-output-port close-port complex? cond cond-expand cons current-error-port current-input-port current-output-port define define-record-type define-syntax define-values denominator do dynamic-wind else eof-object? equal? error error-object-message even? exact-integer-sqrt exact? features floor floor-remainder flush-output-port gcd get-output-string if include-ci inexact? input-port? integer? lcm let let*-values let-values letrec* list list->vector list-ref list-tail make-bytevector make-parameter make-vector max memq min negative? not number->string numerator open-input-bytevector open-output-bytevector or output-port? parameterize peek-u8 positive? quasiquote quotient raise-continuable rationalize read-bytevector! read-error? read-string real? reverse set! set-cdr! string string->number string->utf8 string-append eof-object eq? eqv? error-object-irritants error-object? exact exact-integer? expt file-error? floor-quotient floor/ for-each get-output-bytevector guard include inexact input-port-open? integer->char lambda length let* let-syntax letrec letrec-syntax list->string list-copy list-set! list? make-list make-string map member memv modulo newline null? number? odd? open-input-string open-output-string output-port-open? pair? peek-char port? procedure? quote raise rational? read-bytevector read-char read-line read-u8 remainder round set-car! square string->list string->symbol string->vector string-copy string-copy! string-for-each string-map string-set! string=? string? symbol->string symbol? syntax-rules truncate truncate-remainder u8-ready? unquote utf8->string vector vector->string vector-copy vector-fill! vector-length vector-ref vector? with-exception-handler write-char write-u8 string-fill! string-length string-ref string<=? string=? string>? substring symbol=? syntax-error textual-port? truncate-quotient truncate/ unless unquote-splicing values vector->list vector-append vector-copy! vector-for-each vector-map vector-set! when write-bytevector write-string zero?))) (define geiser-chicken-builtin-symbols (make-parameter '(and-let* assume compiler-typecase cond-expand condition-case cut cute declare define-constant define-inline define-interface define-record define-record-type define-specialization define-syntax-rule define-type define-values dotimes ecase fluid-let foreign-lambda foreign-lambda* foreign-primitive foreign-safe-lambda foreign-safe-lambda* functor handle-exceptions import let*-values let-location let-optionals let-optionals* let-values letrec* letrec-values match-letrec module parameterize regex-case require-extension select set! unless use when with-input-from-pipe match match-lambda match-lambda* match-let match-let* receive))) (define geiser-chicken-crunch-symbols (make-parameter '(* + - / < <= = > >= abs acos add1 argc argv-ref arithmetic-shift asin atan atan2 bitwise-and bitwise-ior bitwise-not bitwise-xor blob->f32vector blob->f32vector/shared blob->f64vector blob->f64vector/shared blob->s16vector blob->s16vector/shared blob->s32vector blob->s32vector/shared blob->s8vector blob->s8vector/shared blob->string blob->string/shared blob->u16vector blob->u16vector/shared blob->u32vector blob->u32vector/shared blob->u8vector blob->u8vector/shared ceiling char->integer char-alphabetic? char-ci<=? char-ci=? char-ci>? char-downcase char-lower-case? char-numeric? char-upcase char-upper-case? char-whitespace? char<=? char=? char>? cond-expand cos display display eq? equal? eqv? error even? exact->inexact exact? exit exp expt f32vector->blob f32vector->blob/shared f32vector-length f32vector-ref f32vector-set! f64vector->blob f64vector->blob/shared f64vector-length f64vector-ref f64vector-set! floor flush-output inexact->exact inexact? integer->char integer? log make-f32vector make-f64vector make-s16vector make-s32vector make-s8vector make-string make-u16vector make-u32vector make-u8vector max min modulo negative? newline not number->string odd? pointer-f32-ref pointer-f32-set! pointer-f64-ref pointer-f64-set! pointer-s16-ref pointer-s16-set! pointer-s32-ref pointer-s32-set! pointer-s8-ref pointer-s8-set! pointer-u16-ref pointer-u16-set! pointer-u32-ref pointer-u32-set! pointer-u8-ref pointer-u8-set! positive? quotient rec remainder round s16vector->blob s16vector->blob/shared s16vector-length s16vector-ref s16vector-set! s32vector->blob s32vector->blob/shared s32vector-length s32vector-ref s32vector-set! s8vector->blob s8vector->blob/shared s8vector-length s8vector-ref s8vector-set! sin sqrt string->blob string->blob/shared string->number string-append string-ci<=? string-ci=? string-ci>? string-copy string-fill! string-length string-ref string-set! string<=? string=? string>? sub1 subf32vector subf64vector subs16vector subs32vector subs8vector substring subu16vector subu32vector subu8vector switch tan truncate u16vector->blob u16vector->blob/shared u16vector-length u16vector-ref u16vector-set! u32vector->blob u32vector->blob/shared u32vector-length u32vector-ref u32vector-set! u8vector->blob u8vector->blob/shared u8vector-length u8vector-ref u8vector-set! unless void when write-char zero?))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Utilities ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define geiser-use-debug-log (make-parameter #f)) (define find-module ##sys#find-module) (define current-module ##sys#current-module) (define switch-module ##sys#switch-module) (define module-name ##sys#module-name) (define (list-modules) (map car ##sys#module-table)) (define memo (make-parameter (make-hash-table))) (define (clear-memo) (hash-table-clear! (memo))) (define (memoize tag thunk) (let ((table (memo))) (if (hash-table-exists? table tag) (hash-table-ref table tag) (begin (hash-table-set! table tag (thunk)) (memoize tag thunk))))) (define debug-log (make-parameter #f)) (define (write-to-log form) (when (geiser-use-debug-log) (when (not (debug-log)) (debug-log (file-open "geiser.log" (+ open/wronly open/append open/text open/creat))) (set-file-position! (debug-log) 0 seek/end)) (file-write (debug-log) (with-all-output-to-string (lambda () (write form) (newline)))) (file-write (debug-log) "\n"))) (define (remove-internal-name-mangling sym) (let* ((sym (->string sym)) (octothorpe-index (string-index-right sym #\#))) (if octothorpe-index (values (substring/shared sym (add1 octothorpe-index)) (substring/shared sym 0 octothorpe-index)) (values sym '())))) (define (string-has-prefix? s prefix) (let ((s-length (string-length s)) (prefix-length (string-length prefix))) (and (< prefix-length s-length) (string-contains s prefix 0 prefix-length)))) ;; This really should be a chicken library function (define (write-exception exn) (define (write-call-entry call) (let ((type (vector-ref call 0)) (line (vector-ref call 1))) (cond ((equal? type "") (display (string-append type " ")) (write line) (newline)) ((equal? type "") (display (string-append type " ")) (write line) (newline))))) (display (format "Error: (~s) ~s: ~s" ((condition-property-accessor 'exn 'location) exn) ((condition-property-accessor 'exn 'message) exn) ((condition-property-accessor 'exn 'arguments) exn))) (newline) (display "Call history: ") (newline) (map write-call-entry ((condition-property-accessor 'exn 'call-chain) exn)) (newline)) ;; And this should be a chicken library function as well (define (with-all-output-to-string thunk) (with-output-to-string (lambda () (with-error-output-to-port (current-output-port) thunk)))) (define (maybe-call func val) (if val (func val) #f)) ;; Wraps output from geiser functions (define (call-with-result module thunk) (let* ((result (if #f #f)) (output (if #f #f)) (module (maybe-call (lambda (v) (find-module module)) module)) (original-module (current-module))) (set! output (handle-exceptions exn (with-all-output-to-string (lambda () (write-exception exn))) (with-all-output-to-string (lambda () (switch-module module) (call-with-values thunk (lambda v (set! result v))))))) (switch-module original-module) (set! result (cond ((list? result) (map (lambda (v) (with-output-to-string (lambda () (write v)))) result)) ((eq? result (if #f #t)) (list output)) (else (list (with-output-to-string (lambda () (write result))))))) (let ((out-form `((result ,@result) (output . ,output)))) (write out-form) (write-to-log '[[RESPONSE]]) (write-to-log out-form)) (newline))) (define (find-standards-with-symbol sym) (append (if (any (cut eq? <> sym) (geiser-r4rs-symbols)) '(r4rs) '()) (if (any (cut eq? <> sym) (geiser-r5rs-symbols)) '(r5rs) '()) (if (any (cut eq? <> sym) (geiser-r7rs-small-symbols)) '(r7rs) '()) (if (any (cut eq? <> sym) (geiser-chicken-builtin-symbols)) '(chicken) '()) (if (any (cut eq? <> sym) (geiser-chicken-crunch-symbols)) '(crunch) '()))) ;; Locates any paths at which a particular symbol might be located (define (find-library-paths sym types) ;; Removes the given sym from the node path (define (remove-self sym path) (cond ((not (list? path)) path) ((null? path) path) ((null? (cdr path)) (if (eq? (car path) sym) '() path)) (else (cons (car path) (remove-self sym (cdr path)))))) (append (map (cut list <>) (find-standards-with-symbol sym)) (map (lambda (node) (remove-self sym (node-path node))) (filter (lambda (n) (let ((type (node-type n))) (any (cut eq? type <>) types))) (match-nodes sym))))) (define (make-module-list sym module-sym) (if (null? module-sym) (find-standards-with-symbol sym) (cons module-sym (find-standards-with-symbol sym)))) (define (fmt sym node) (let* ((entry-str (car node)) (module (cadr node)) (rest (cddr node)) (type (if (or (list? rest) (pair? rest)) (car rest) rest))) (cond ((equal? 'macro type) `(,entry-str ("args" (("required" ) ("optional" ...) ("key"))) ("module" ,@(make-module-list sym module)))) ((or (equal? 'variable type) (equal? 'constant type)) (if (null? module) `(,entry-str ("value" . ,(eval sym))) (let* ((original-module (current-module)) (desired-module (find-module (string->symbol module))) (value (begin (switch-module desired-module) (eval sym)))) (switch-module original-module) `(,entry-str ("value" . ,value) ("module" ,@(make-module-list sym module)))))) (else (let ((reqs '()) (opts '()) (keys '()) (args (if (or (list? rest) (pair? rest)) (cdr rest) '()))) (define (clean-arg arg) (let ((s (->string arg))) (substring/shared s 0 (string-skip-right s char-set:digit)))) (define (collect-args args #!key (reqs? #t) (opts? #f) (keys? #f)) (when (not (null? args)) (cond ((or (pair? args) (list? args)) (cond ((eq? '#!key (car args)) (collect-args (cdr args) reqs?: #f opts?: #f keys?: #t)) ((eq? '#!optional (car args)) (collect-args (cdr args) reqs?: #f opts?: #t keys?: #f)) (else (begin (cond (reqs? (set! reqs (append reqs (list (clean-arg (car args)))))) (opts? (set! opts (append opts (list (cons (clean-arg (caar args)) (cdar args)))))) (keys? (set! keys (append keys (list (cons (clean-arg (caar args)) (cdar args))))))) (collect-args (cdr args)))))) (else (set! opts (list (clean-arg args) '...)))))) (collect-args args) `(,entry-str ("args" (("required" ,@reqs) ("optional" ,@opts) ("key" ,@keys))) ("module" ,@(make-module-list sym module)))))))) ;; Builds a signature list from an identifier (define (find-signatures sym) (let ((str (->string sym))) (map (cut fmt sym <>) (filter (lambda (v) (eq? (car v) sym)) (map (lambda (s) ;; Remove egg name and add module (let-values (((name module) (remove-internal-name-mangling (car s)))) (cons (string->symbol name) (cons (if (string? module) (string->symbol module) module) (cdr s))))) (apropos-information-list sym #:macros? #t)))))) ;; Builds the documentation from Chicken Doc for a specific symbol (define (make-doc symbol #!optional (filter-for-type #f)) (with-output-to-string (lambda () (map (lambda (node) (display (string-append "= Node: " (->string (node-id node)) " " " =\n")) (describe node) (display "\n\n")) (filter (lambda (n) (or (not filter-for-type) (eq? (node-type n) filter-for-type))) (match-nodes symbol)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Geiser core functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Basically all non-core functions pass through geiser-eval (define (geiser-eval module form . rest) ;; We can't allow nested module definitions in Chicken (define (form-has-module? form) (or (eq? (car form) 'module) (eq? (car form) 'define-library))) (define (form-has-safe-geiser? form) (any (cut eq? (car form) <>) '(geiser-no-values geiser-newline geiser-completions geiser-autodoc geiser-object-signature geiser-symbol-location geiser-symbol-documentation geiser-find-file geiser-add-to-load-path geiser-module-exports geiser-module-path geiser-module-location geiser-module-completions geiser-use-debug-log))) (when (and module (not (symbol? module))) (error "Module should be a symbol")) ;; All calls start at toplevel (let* ((is-module? (form-has-module? form)) (is-safe-geiser? (form-has-safe-geiser? form)) (host-module (and (not is-module?) (any (cut equal? module <>) (list-modules)) module)) (thunk (lambda () (eval form)))) (write-to-log `[[REQUEST host-module ,host-module is-safe-geiser? ,is-safe-geiser?]]) (write-to-log form) (if is-safe-geiser? (call-with-result host-module (lambda () (memoize form thunk))) (begin (clear-memo) (call-with-result host-module thunk))))) ;; Load a file (define (geiser-load-file file) (let* ((file (if (symbol? file) (symbol->string file) file)) (found-file (geiser-find-file #f file))) (call-with-result #f (lambda () (when found-file (load found-file)))))) ;; The no-values identity (define (geiser-no-values) (values)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Miscellaneous ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Invoke a newline (define (geiser-newline . rest) (newline)) ;; Spawn a server for remote repl access (define (geiser-start-server . rest) (let* ((listener (tcp-listen 0)) (port (tcp-listener-port listener))) (define (remote-repl) (receive (in out) (tcp-accept listener) (current-input-port in) (current-output-port out) (current-error-port out) (repl))) (thread-start! (make-thread remote-repl)) (write-to-log `(geiser-start-server . ,rest)) (write-to-log `(port ,port)) (write `(port ,port)) (newline))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Completions, Autodoc and Signature ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (geiser-completions prefix . rest) (let ((prefix (->string prefix)) (unfiltered (map remove-internal-name-mangling (apropos-list prefix #:macros? #t)))) (filter (cut string-has-prefix? <> prefix) unfiltered))) (define (geiser-module-completions prefix . rest) (let ((prefix (->string prefix))) (filter (cut string-has-prefix? <> prefix) (map ->string (list-modules))))) (define (geiser-autodoc ids . rest) (cond ((null? ids) '()) ((not (list? ids)) (geiser-autodoc (list ids))) (else (let ((details (find-signatures (car ids)))) (if (null? details) (geiser-autodoc (cdr ids)) details))))) (define (geiser-object-signature name object . rest) (let* ((sig (geiser-autodoc `(,name)))) (if (null? sig) '() (car sig)))) ;; TODO: Divine some way to support this functionality (define (geiser-symbol-location symbol . rest) '(("file") ("line"))) (define (geiser-symbol-documentation symbol . rest) (let* ((sig (find-signatures symbol))) `(("signature" ,@(car sig)) ("docstring" . ,(make-doc symbol))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; File and Buffer Operations ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define geiser-load-paths (make-parameter '())) (define (geiser-find-file file . rest) (let ((paths (append '("" ".") (geiser-load-paths)))) (define (try-find file paths) (cond ((null? paths) #f) ((file-exists? (string-append (car paths) file)) (string-append (car paths) file)) (else (try-find file (cdr paths))))) (try-find file paths))) (define (geiser-add-to-load-path directory . rest) (let* ((directory (if (symbol? directory) (symbol->string directory) directory)) (directory (if (not (equal? #\/ (string-ref directory (- (string-length directory))))) (string-append directory "/") directory))) (call-with-result #f (lambda () (when (directory-exists? directory) (geiser-load-paths (cons directory (geiser-load-paths)))))))) (define (geiser-compile-file file . rest) (let* ((file (if (symbol? file) (symbol->string file) file)) (found-file (geiser-find-file file))) (call-with-result #f (lambda () (when found-file (compile-file found-file)))))) ;; TODO: Support compiling regions (define (geiser-compile form module . rest) (error "Chicken does not support compiling regions")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Modules ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Should return: ;; '(("modules" . sub-modules) ("procs" . procedures) ("syntax" . macros) ("vars" . variables)) (define (geiser-module-exports module-name . rest) (let* ((nodes (match-nodes module-name))) (if (null? nodes) '() (let ((mod '()) (proc '()) (syn '()) (var '())) (map (lambda (node) (let ((type (node-type node)) (name (node-id node)) (path (node-path node))) (cond ((memq type '(unit egg)) (set! mod (cons name mod))) ((memq type '(procedure record setter class method)) (set! proc (cons name proc))) ((memq type '(read syntax)) (set! syn (cons name syn))) ((memq type '(parameter constant)) (set! var (cons name var)))))) nodes) `(("modules" . ,mod) ("proces" . ,proc) ("syntax" . ,syn) ("vars" . ,var)))))) ;; Returns the path for the file in which an egg or module was defined (define (geiser-module-path module-name . rest) #f) ;; Returns: ;; `(("file" . ,(module-path name)) ("line")) (define (geiser-module-location name . rest) #f) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Misc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (geiser-macroexpand form . rest) (with-output-to-string (lambda () (write (expand form))))) ;; End module ) geiser-0.8.1/scheme/racket/0000755000175000017500000000000012607252416013624 5ustar jaojaogeiser-0.8.1/scheme/racket/geiser/0000755000175000017500000000000012607252416015102 5ustar jaojaogeiser-0.8.1/scheme/racket/geiser/images.rkt0000644000175000017500000000462512607252416017100 0ustar jaojao;;; images.rkt -- support for image handline ;; Copyright (C) 2012, 2014 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Authors: Michael Wilber, Jose Antonio Ortega Ruiz ;; Start date: Sun Sep 2, 2012 18:54 #lang racket/base (require racket/file file/convertible racket/pretty) (provide image-cache maybe-print-image maybe-write-image make-port-print-handler make-pretty-print-size-hook make-pretty-print-print-hook) (define image-cache (let ([ensure-dir (lambda (dir) (if (path-string? dir) (begin (make-directory* dir) (if (path? dir) (path->string dir) dir)) (path->string (find-system-path 'temp-dir))))]) (make-parameter (ensure-dir #f) ensure-dir))) (define (save-tmpimage imgbytes) ;; Save imgbytes to a new temporary file and return the filename (define filename (make-temporary-file "geiser-img-~a.png" #f (image-cache))) (with-output-to-file filename #:exists 'truncate (lambda () (display imgbytes))) (format "#" filename)) (define (maybe-save-image value) (and (convertible? value) ;; (The above could be problematic if a future version of racket ;; suddenly decides it can "convert" strings to picts) (save-tmpimage (convert value 'png-bytes)))) (define (maybe-print-image value) (cond [(maybe-save-image value) => (lambda (s) (printf "~a\n" s))] [else (unless (void? value) (pretty-print value))])) (define (maybe-write-image value) (write (or (maybe-save-image value) value))) (define (make-port-print-handler ph) (lambda (value port . rest) (apply ph (or (maybe-save-image value) value) port rest))) (define (make-pretty-print-size-hook [orig (pretty-print-size-hook)]) (lambda (value display? port) (if (convertible? value) (pretty-print-columns) (orig value display? port)))) (define (make-pretty-print-print-hook [orig (pretty-print-print-hook)]) (lambda (value display? port) (let [(img (maybe-save-image value))] (if img (print img port) (orig value display? port))))) geiser-0.8.1/scheme/racket/geiser/completions.rkt0000644000175000017500000000156412607252416020166 0ustar jaojao;;; completions.rkt -- completion support ;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sun Apr 26, 2009 19:02 #lang racket (provide symbol-completions module-completions) (require srfi/13 geiser/utils geiser/modules) (define (filter-prefix prefix lst sort?) (filter (lambda (s) (string-prefix? prefix s)) (if sort? (sort lst stringstring (namespace-mapped-symbols)) #t)) (define (module-completions prefix) (filter-prefix prefix (module-list) #f)) geiser-0.8.1/scheme/racket/geiser/main.rkt0000644000175000017500000000327112607252416016553 0ustar jaojao;;; main.rkt -- exported interface for emacs ;; Copyright (C) 2010, 2011 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Wed Mar 31, 2010 21:14 #lang racket/base (provide geiser:eval geiser:compile geiser:load-file geiser:compile-file geiser:macroexpand geiser:completions geiser:module-completions geiser:symbol-location geiser:module-location geiser:module-exports geiser:autodoc geiser:symbol-documentation geiser:help geiser:no-values) (require geiser/eval geiser/modules geiser/completions geiser/locations geiser/autodoc) (define (geiser:eval lang) (lambda (form spec) (update-signature-cache spec form) (eval-in form spec lang))) (define geiser:compile geiser:eval) (define (geiser:load-file file) (update-signature-cache file) (load-file file)) (define geiser:compile-file geiser:load-file) (define geiser:add-to-load-path add-to-load-path) (define geiser:autodoc autodoc) (define geiser:help get-help) (define geiser:completions symbol-completions) (define geiser:module-completions module-completions) (define geiser:symbol-location symbol-location) (define geiser:module-location module-location) (define geiser:module-exports module-exports) (define geiser:macroexpand macroexpand) (define geiser:symbol-documentation symbol-documentation) (define (geiser:no-values) (values)) geiser-0.8.1/scheme/racket/geiser/user.rkt0000644000175000017500000001410612607252416016604 0ustar jaojao;;; user.rkt -- global bindings visible to geiser users ;; Copyright (C) 2010, 2011, 2012, 2013, 2014 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Wed Mar 31, 2010 22:24 #lang racket (provide init-geiser-repl run-geiser-server start-geiser) (require (for-syntax racket/base) mzlib/thread racket/tcp racket/help geiser geiser/autodoc geiser/images geiser/enter geiser/eval geiser/modules) (define top-namespace (current-namespace)) (define last-entered (make-parameter "")) (define (do-enter mod name) (visit-module mod) (last-entered name) (current-namespace (module->namespace mod))) (define (file-mod? mod) (and (list? mod) (= 2 (length mod)) (eq? 'file (car mod)) (path-string? (cadr mod)))) (define (submod-path mod) (and (list? mod) (eq? 'submod (car mod)) (> (length mod) 1) (let ([parent (cadr mod)]) (cond [(path-string? parent) `(submod (file ,parent) ,@(cddr mod))] [(file-mod? parent) mod] [(symbol? parent) mod] [else #f])))) (define (module-error stx mod) (raise-syntax-error #f "Invalid module path" stx mod)) (define (enter! mod stx) (cond [(not mod) (current-namespace top-namespace) (last-entered "")] [(symbol? mod) (do-enter mod (symbol->string mod))] [(path-string? mod) (do-enter `(file ,mod) mod)] [(file-mod? mod) (do-enter mod (cadr mod))] [(submod-path mod) => (lambda (m) (do-enter m m))] [else (module-error stx mod)])) (define (geiser-eval) (define geiser-main (module->namespace 'geiser)) (define (eval-here form) (eval form geiser-main)) (let* ([mod (read)] [lang (read)] [form (read)] [res (cond [(equal? form '(unquote apply)) (let* ([proc (eval-here (read))] [args (map eval-here (read))] [ev (lambda () (apply proc args))]) (eval-in `(,ev) mod lang #t))] [else ((geiser:eval lang) form mod)])]) (datum->syntax #f (list 'quote res)))) (define (geiser-load stx) (let* ([mod (read)] [res (call-with-result (lambda () (visit-module (cond [(file-mod? mod) mod] [(path-string? mod) `(file ,mod)] [(submod-path mod)] [else (module-error stx mod)])) (void)))]) (datum->syntax stx (list 'quote res)))) (define ((geiser-read prompt)) (prompt) (flush-output (current-error-port)) (flush-output (current-output-port)) (let* ([in ((current-get-interaction-input-port))] [form ((current-read-interaction) (object-name in) in)]) (syntax-case form () [(uq cmd) (eq? 'unquote (syntax-e #'uq)) (case (syntax-e #'cmd) [(start-geiser) (datum->syntax #f `(list 'port ,(start-geiser)))] [(enter) (enter! (read) #'cmd)] [(geiser-eval) (geiser-eval)] [(geiser-load) (geiser-load #'cmd)] [(geiser-no-values) (datum->syntax #f (void))] [(add-to-load-path) (add-to-load-path (read))] [(set-image-cache) (image-cache (read))] [(help) (get-help (read) (read))] [(image-cache) (image-cache)] [(pwd) (~a (current-directory))] [(cd) (current-directory (~a (read)))] [else form])] [_ form]))) (define geiser-prompt (lambda () (let ([m (namespace->module-name (current-namespace) (last-entered))]) (printf "racket@~a> " (regexp-replace* " " m "_"))))) (define (geiser-prompt-read prompt) (make-repl-reader (geiser-read prompt))) (define (geiser-loader) (module-loader (current-load/use-compiled))) (define (install-print-handler handler) (let ([p (current-output-port)]) (handler p (make-port-print-handler (handler p))))) (define (install-print-handlers) (for-each install-print-handler (list port-print-handler port-write-handler port-display-handler)) (pretty-print-print-hook (make-pretty-print-print-hook)) (pretty-print-size-hook (make-pretty-print-size-hook))) (define (init-geiser-repl) (compile-enforce-module-constants #f) (current-load/use-compiled (geiser-loader)) (preload-help) (current-prompt-read (geiser-prompt-read geiser-prompt)) (current-print maybe-print-image) (install-print-handlers)) (define (run-geiser-repl in out enforce-module-constants) (parameterize [(compile-enforce-module-constants enforce-module-constants) (current-input-port in) (current-output-port out) (current-error-port out) (current-load/use-compiled (geiser-loader)) (current-prompt-read (geiser-prompt-read geiser-prompt)) (current-print maybe-print-image) (pretty-print-print-hook (make-pretty-print-print-hook)) (pretty-print-size-hook (make-pretty-print-size-hook))] (install-print-handlers) (preload-help) (read-eval-print-loop))) (define server-channel (make-channel)) (define (run-geiser-server port enforce-module-constants (hostname #f)) (run-server port (lambda (in out) (run-geiser-repl in out enforce-module-constants)) #f void (lambda (p _ __) (let ([lsner (tcp-listen p 4 #f hostname)]) (let-values ([(_ p __ ___) (tcp-addresses lsner #t)]) (channel-put server-channel p) lsner))))) (define (start-geiser (port 0) (hostname #f) (enforce-module-constants #f)) (thread (lambda () (run-geiser-server port enforce-module-constants hostname))) (channel-get server-channel)) geiser-0.8.1/scheme/racket/geiser/modules.rkt0000644000175000017500000001634512607252416017305 0ustar jaojao;;; modules.rkt -- module metadata ;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Wed May 06, 2009 02:35 #lang racket (provide load-module ensure-module-spec module-spec->namespace namespace->module-name namespace->module-path-name module-path-name->name module-spec->path-name module-path-index->name module-identifiers module-list submodules) (require srfi/13 syntax/modcode syntax/modresolve geiser/enter) (define (ensure-module-spec spec) (cond [(symbol? spec) spec] [(not (string? spec)) #f] [else `(file ,spec)])) (define (module-spec->namespace spec (lang #f) (current #t)) (define (try-lang) (and lang (with-handlers ([exn? (const #f)]) (load-module lang #f (current-namespace)) (module->namespace lang)))) (or (get-namespace spec) (try-lang) (and current (current-namespace)))) (define nowhere (open-output-nowhere)) (define (load-module spec (port #f) (ns #f)) (parameterize ([current-error-port (or port nowhere)]) (visit-module (ensure-module-spec spec)) (when (namespace? ns) (current-namespace ns)))) (define (namespace->rmp ns) (with-handlers ([exn? (const #f)]) (variable-reference->resolved-module-path (eval '(#%variable-reference) (or ns (current-namespace)))))) (define (namespace->module-path-name ns (p #f)) (let ([rmp (namespace->rmp ns)]) (or (and (resolved-module-path? rmp) (resolved-module-path-name rmp)) p))) (define (module-spec->path-name spec) (and (symbol? spec) (or (get-path spec) (register-path spec (namespace->module-path-name (module-spec->namespace spec #f #f)))))) (define unknown-module-name "*unresolved module*") (define (unix-path->string path) (regexp-replace* "\\\\" (path->string path) "/")) (define (path->name path) (if (path-string? path) (let* ([cpaths (map (compose unix-path->string path->directory-path) (current-library-collection-paths))] [prefix-len (lambda (p) (let ((pl (string-length p))) (if (= pl (string-prefix-length p path)) pl 0)))] [lens (map prefix-len cpaths)] [real-path (substring path (apply max lens))]) (if (absolute-path? real-path) (let-values ([(_ base __) (split-path path)]) (unix-path->string base)) (regexp-replace "\\.[^./]*$" real-path ""))) path)) (define (module-path-name->name path) (cond [(path? path) (module-path-name->name (unix-path->string path))] ;; [(eq? path '#%kernel) "(kernel)"] [(path-string? path) (path->name path)] [(symbol? path) (symbol->string path)] [(list? path) (string-join (map (compose path->name ~a) path) "/")] [else (~a path)])) (define (module-path-index->name mpi) (let ([rmp (module-path-index-resolve mpi)]) (if (resolved-module-path? rmp) (module-path-name->name (resolved-module-path-name rmp)) unknown-module-name))) (define (namespace->module-name ns (p #f)) (module-path-name->name (namespace->module-path-name ns p))) (define (module-identifiers mod) (define (extract-ids ls) (append-map (lambda (idls) (map car (cdr idls))) ls)) (let-values ([(reg syn) (module-compiled-exports (get-module-code (resolve-module-path (ensure-module-spec mod) #f)))]) (values (extract-ids reg) (extract-ids syn)))) (define (skippable-dir? path) (call-with-values (lambda () (split-path path)) (lambda (_ basename __) (member (path->string basename) '(".svn" "compiled"))))) (define path->symbol (compose string->symbol unix-path->string)) (define (path->entry path) (let ([ext (filename-extension path)]) (and ext (or (bytes=? ext #"rkt") (bytes=? ext #"ss")) (not (bytes=? (bytes-append #"main" ext) (path->bytes path))) (let* ([path (unix-path->string path)] [len (- (string-length path) (bytes-length ext) 1)]) (substring path 0 len))))) (define (ensure-path datum) (if (string? datum) (string->path datum) datum)) (define main-rkt (build-path "main.rkt")) (define main-ss (build-path "main.ss")) (define ((visit-module-path reg?) path kind acc) (define (register e p) (when reg? (register-path (string->symbol e) (build-path (current-directory) p))) (values (cons e acc) reg?)) (define (get-main path main) (and (file-exists? main) (build-path path main))) (define (find-main path) (parameterize ([current-directory path]) (or (get-main path main-rkt) (get-main path main-ss)))) (case kind [(file) (let ([entry (path->entry path)]) (if (not entry) acc (register entry path)))] [(dir) (cond [(skippable-dir? path) (values acc #f)] [(find-main path) => (curry register (unix-path->string path))] [else (values acc reg?)])] [else acc])) (define ((find-modules reg?) path acc) (if (directory-exists? path) (parameterize ([current-directory path]) (fold-files (visit-module-path reg?) acc)) acc)) (define (take-while pred lst) (let loop ([lst lst] [acc '()]) (cond [(null? lst) (reverse acc)] [(pred (car lst)) (loop (cdr lst) (cons (car lst) acc))] [else (reverse acc)]))) (define (submodules mod) (let* ([mod-name (if (symbol? mod) mod (get-mod mod))] [mod-str (and (symbol? mod-name) (symbol->string mod-name))]) (if mod-str (let ([ms (member mod-str (module-list))]) (and ms (take-while (lambda (m) (string-prefix? mod-str m)) (cdr ms)))) (find-submodules mod)))) (define (find-submodules path) (and (path-string? path) (let-values ([(dir base ign) (split-path path)]) (and (or (equal? base main-rkt) (equal? base main-ss)) (map (lambda (m) (unix-path->string (build-path dir m))) (remove "main" ((find-modules #f) dir '()))))))) (define (known-modules) (sort (foldl (find-modules #t) '() (current-library-collection-paths)) string. ;; Start date: Wed Mar 31, 2010 21:53 #lang racket/base (require syntax/modcode (for-syntax racket/base) racket/path) (provide get-namespace visit-module module-loader) (struct mod (name load-path timestamp depends) #:transparent) (define (make-mod name path ts code) (let ([deps (if code (apply append (map cdr (module-compiled-imports code))) null)]) (mod name (path->string path) ts deps))) (define loaded (make-hash)) (define (mod->path mod) (with-handlers ([exn? (lambda (_) #f)]) (let ([rp (module-path-index-resolve (module-path-index-join mod #f))]) (resolved-module-path-name rp)))) (define (visit-module mod) (dynamic-require mod #f) (check-latest mod)) (define (module-loader orig) (make-loader orig #f)) (define inhibit-eval (make-parameter #f)) (define (get-namespace mod) (let ([mod (cond [(symbol? mod) mod] [(string? mod) (find-module! (string->path mod) mod)] [(path? mod) (find-module! mod (path->string mod))] [else mod])]) (and mod (with-handlers ([exn? (lambda (_) #f)]) (parameterize ([inhibit-eval #t]) (module->namespace mod)))))) (define (find-module! path path-str) (let ([m (or (hash-ref loaded path #f) (let loop ([ps (remove path (resolve-paths path))] [seen '()]) (cond [(null? ps) #f] [(hash-ref loaded (car ps) #f) => (lambda (m) (add-paths! m (cdr ps)) (add-paths! m (cons path seen)) m)] [else (loop (cdr ps) (cons (car ps) seen))])))]) (list 'file (or (and m (mod-load-path m)) path-str)))) (define (add-paths! m ps) (for-each (lambda (p) (hash-set! loaded p m)) ps)) (define (resolve-paths path) (define (find root rest) (let* ([alt-root (resolve-path root)] [same? (equal? root alt-root)]) (cond [(null? rest) (cons root (if same? '() `(,alt-root)))] [else (let* ([c (car rest)] [cs (cdr rest)] [rps (find (build-path root c) cs)]) (if same? rps (append rps (find (build-path alt-root c) cs))))]))) (let ([cmps (explode-path path)]) (find (car cmps) (cdr cmps)))) (define (notify re? path) (when re? (fprintf (current-error-port) " [re-loading ~a]\n" path))) (define (module-name? name) (and name (not (and (pair? name) (not (car name)))))) (define (module-code re? name path) (get-module-code path "compiled" (lambda (e) (parameterize ([compile-enforce-module-constants #f]) (compile-syntax e))) (lambda (ext loader?) (load-extension ext) #f) #:notify (lambda (chosen) (notify re? chosen)))) (define ((make-loader orig re?) path name) (when (inhibit-eval) (raise (make-exn:fail "namespace not found" (current-continuation-marks)))) (if (module-name? name) ;; Module load: (with-handlers ([(lambda (exn) (and (pair? name) (exn:get-module-code? exn))) ;; Load-handler protocol: quiet failure when a ;; submodule is not found (lambda (exn) (void))]) (let* ([code (module-code re? name path)] [dir (or (current-load-relative-directory) (current-directory))] [path (path->complete-path path dir)] [path (normal-case-path (simplify-path path))]) (define-values (ts real-path) (get-timestamp path)) (add-paths! (make-mod name path ts code) (resolve-paths path)) (parameterize ([current-module-declare-source real-path]) (eval code)))) ;; Not a module: (begin (notify re? path) (orig path name)))) (define (get-timestamp path) (let ([ts (file-or-directory-modify-seconds path #f (lambda () #f))]) (if ts (values ts path) (if (regexp-match? #rx#"[.]rkt$" (path->bytes path)) (let* ([alt-path (path-replace-suffix path #".ss")] [ts (file-or-directory-modify-seconds alt-path #f (lambda () #f))]) (if ts (values ts alt-path) (values -inf.0 path))) (values -inf.0 path))))) (define (check-latest mod) (define mpi (module-path-index-join mod #f)) (define done (make-hash)) (let loop ([mpi mpi]) (define rindex (module-path-index-resolve mpi)) (define rpath (resolved-module-path-name rindex)) (define path (if (pair? rpath) (car rpath) rpath)) (when (path? path) (define npath (normal-case-path path)) (unless (hash-ref done npath #f) (hash-set! done npath #t) (define mod (hash-ref loaded rpath #f)) (when mod (for-each loop (mod-depends mod)) (define-values (ts actual-path) (get-timestamp npath)) (when (> ts (mod-timestamp mod)) (define orig (current-load/use-compiled)) (parameterize ([current-load/use-compiled (make-loader orig #f)] [current-module-declare-name rindex] [current-module-declare-source actual-path]) ((make-loader orig #f) npath (mod-name mod))))))))) geiser-0.8.1/scheme/racket/geiser/server.rkt0000644000175000017500000000067712607252416017144 0ustar jaojao;;; server.rkt -- REPL server ;; Copyright (c) 2010 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sat Nov 06, 2010 15:15 #lang racket/base (require geiser/user) (provide start-geiser) geiser-0.8.1/scheme/racket/geiser/locations.rkt0000644000175000017500000000334412607252416017623 0ustar jaojao;;; locations.rkt -- locating symbols ;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sun Apr 26, 2009 19:43 #lang racket (provide symbol-location symbol-location* module-location symbol-module symbol-module-name) (require geiser/utils geiser/modules) (define (symbol-location* sym) (let* ([id (namespace-symbol->identifier sym)] [binding (and id (identifier-binding id))]) (if (list? binding) (cons (cadr binding) (resolved-module-path-name (module-path-index-resolve (car binding)))) (cons sym #f)))) (define (switch-extension path) (if (regexp-match? "\\.rkt$" path) (regexp-replace "\\.rkt$" path ".ss") (regexp-replace "\\.ss$" path ".rkt"))) (define (make-location name path line) (let* ([path (if (path? path) (path->string path) #f)] [path (and path (if (file-exists? path) path (switch-extension path)))]) (list (cons "name" name) (cons "file" (or path '())) (cons "line" (or line '()))))) (define (symbol-location sym) (let* ([loc (symbol-location* sym)] [name (car loc)] [path (cdr loc)]) (if path (make-location name path #f) (module-location sym)))) (define symbol-module (compose cdr symbol-location*)) (define symbol-module-name (compose module-path-name->name symbol-module)) (define (module-location sym) (make-location sym (module-spec->path-name sym) 1)) geiser-0.8.1/scheme/racket/geiser/eval.rkt0000644000175000017500000000462312607252416016560 0ustar jaojao;;; eval.rkt -- evaluation ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sun Apr 26, 2009 00:44 #lang racket (provide eval-in load-file macroexpand add-to-load-path make-repl-reader call-with-result) (require geiser/enter geiser/modules geiser/images) (require errortrace/errortrace-lib) (define last-result (void)) (define last-namespace (make-parameter (current-namespace))) (define (exn-key e) (vector-ref (struct->vector e) 0)) (define (set-last-error e) (set! last-result `((error (key . ,(exn-key e))))) (display (exn-message e)) (newline) (newline) (parameterize ([error-context-display-depth 10]) (print-error-trace (current-output-port) e))) (define (write-value v) (with-output-to-string (lambda () (maybe-write-image v)))) (define (set-last-result . vs) (set! last-result `((result ,@(map write-value vs))))) (define (call-with-result thunk) (set-last-result (void)) (let ([output (with-output-to-string (lambda () (parameterize ([current-error-port (current-output-port)]) (with-handlers ([exn? set-last-error]) (call-with-values thunk set-last-result)))))]) (append last-result `(,(cons 'output output))))) (define (eval-in form spec lang . non-top) (write (call-with-result (lambda () (eval (if (null? non-top) (cons '#%top-interaction form) form) (module-spec->namespace spec lang))))) (newline)) (define (load-file file) (load-module file (current-output-port) (last-namespace))) (define (macroexpand form . all) (let ([all (and (not (null? all)) (car all))]) (with-output-to-string (lambda () (pretty-print (syntax->datum ((if all expand expand-once) form))))))) (define (add-to-load-path p) (when (string? p) (let ([p (string->path p)] [cps (current-library-collection-paths)]) (unless (member p cps) (current-library-collection-paths (cons p cps))))) #t) (define (make-repl-reader reader) (lambda () (last-namespace (current-namespace)) (reader))) geiser-0.8.1/scheme/racket/geiser/startup.rkt0000644000175000017500000000072312607252416017330 0ustar jaojao;;; startup.rkt -- entry point ;; Copyright (C) 2009, 2010, 2013, 2014 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sat Apr 25, 2009 22:36 ;; (require errortrace) (require geiser/user) (init-geiser-repl) geiser-0.8.1/scheme/racket/geiser/autodoc.rkt0000644000175000017500000002756412607252416017300 0ustar jaojao;;; autodoc.rkt -- suport for autodoc echo ;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sun May 03, 2009 14:45 #lang racket (provide autodoc symbol-documentation module-exports update-signature-cache preload-help get-help) (require racket/help geiser/utils geiser/modules geiser/locations) (define loader-thread #f) (define (preload-help) (set! loader-thread (thread (lambda () (with-output-to-string (lambda () (help meh-i-dont-exist))))))) (define here (current-namespace)) (define (get-help symbol mod) (when loader-thread (thread-wait loader-thread) (set! loader-thread #f)) (if (eq? symbol mod) (get-mod-help mod) (with-handlers ([exn? (lambda (_) (eval `(help ,symbol) here))]) (eval `(help ,symbol #:from ,(ensure-module-spec mod)) here)))) (define (get-mod-help mod) (let-values ([(ids syns) (module-identifiers mod)]) (let ([sym (cond [(not (null? syns)) (car syns)] [(not (null? ids)) (car ids)] [else #f])]) (and sym (get-help sym mod))))) (define (symbol-documentation sym) (let* ([val (value sym (symbol-module sym))] [sign (autodoc* sym)]) (and sign (list (cons "signature" (autodoc* sym #f)) (cons "docstring" (docstring sym val sign)))))) (define (docstring sym val sign) (let* ([mod (assoc "module" (cdr sign))] [mod (if mod (cdr mod) "")] [id (namespace-symbol->identifier sym)] [desc (if (identifier? id) (format "~%~%~a" (describe id sym)) "")]) (if val (format "A ~a in module ~a.~a~a~a" (if (procedure? val) "procedure" "variable") mod (if (procedure? val) "" (format "~%~%Value:~%~% ~a" val)) (if (has-contract? val) (format "~%~%Contract:~%~% ~a" (contract-name (value-contract val))) "") desc) (format "An identifier in module ~a.~a" mod desc)))) ;; Lifted from Eli's interactive.rkt (define (describe id s) (define b (identifier-binding id)) (cond [(not b) (format "`~s' is a toplevel (or unbound) identifier." s)] [(eq? b 'lexical) (format "`~s' is a lexical identifier." s)] [(or (not (list? b)) (not (= 7 (length b)))) "*** internal error, racket changed ***"] [else (let-values ([(source-mod source-id nominal-source-mod nominal-source-id source-phase import-phase nominal-export-phase) (apply values b)]) (let ([aliased (not (eq? s source-id))] [for-syn (eqv? source-phase 1)] [amod (not (equal? source-mod nominal-source-mod))] [aid (not (eq? s nominal-source-id))]) (if (or aliased for-syn amod aid) (string-append "Defined" (if for-syn " for syntax" "") (if aliased (format " as `~s' " source-id) "") (if amod (format " in module ~a\nand required~a in module ~a" (module-path-index->name source-mod) (if (eqv? import-phase 1) "-for-syntax" "") (module-path-index->name nominal-source-mod)) "") (if aid (format ",\nwhere it is defined as `~s'" nominal-source-id) "") ".") "")))])) (define (value id mod) (with-handlers ([exn? (const #f)]) (dynamic-require mod id (const #f)))) (define (autodoc ids) (map (lambda (id) (or (autodoc* id) (list id))) (if (list? ids) ids '()))) (define (autodoc* id (extra #t)) (define (val) (with-handlers ([exn? (const "")]) (parameterize ([error-print-width 60]) (format "~.a" (namespace-variable-value id))))) (and (symbol? id) (let* ([loc (symbol-location* id)] [name (car loc)] [path (cdr loc)] [sgns (and path (find-signatures path name id))] [value (if (and extra sgns (not (list? sgns))) (list (cons "value" (val))) '())] [mod (if (and extra sgns path) (list (cons "module" (module-path-name->name path))) '())]) (and sgns `(,id ("name" . ,name) ("args" ,@(if (list? sgns) (map format-signature sgns) '())) ,@value ,@mod))))) (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)) (struct signature (required optional keys rest)) (define (find-signatures path name local-name) (let ([path (if (path? path) (path->string path) path)]) (hash-ref! (hash-ref! signatures path (lambda () (parse-signatures path))) name (lambda () (infer-signatures local-name))))) (define (parse-signatures path) (let ([result (make-hasheq)]) (with-handlers ([exn? (lambda (e) result)]) (with-input-from-file path (lambda () (parameterize ([read-accept-reader #t]) (let loop ([stx (read-syntax path)]) (cond [(eof-object? stx) void] [(syntax->datum stx) => (lambda (datum) (parse-datum! datum result) (loop (read-syntax path)))] [else void])))))) result)) (define (parse-datum! datum store) (with-handlers ([exn? (lambda (_) void)]) (match datum [`(module ,name ,lang (#%module-begin . ,forms)) (for-each (lambda (f) (parse-datum! f store)) forms)] [`(module ,name ,lang . ,forms) (for-each (lambda (f) (parse-datum! f store)) forms)] [`(define ((,name . ,formals) . ,_) . ,_) (add-signature! name formals store)] [`(define (,name . ,formals) . ,_) (add-signature! name formals store)] [`(define ,name (lambda ,formals . ,_)) (add-signature! name formals store)] [`(define ,name (case-lambda ,clauses ...)) (for-each (lambda (c) (add-signature! name (car c) store)) (reverse clauses))] [`(,(or 'struct 'define-struct) ,name ,(? symbol? _) ,(list formals ...) . ,_) (add-signature! name formals store)] [`(,(or 'struct 'define-struct) ,name ,(list formals ...) . ,_) (add-signature! name formals store)] [`(define-for-syntax (,name . ,formals) . ,_) (add-signature! name formals store)] [`(define-for-syntax ,name (lambda ,formals . ,_)) (add-signature! name formals store)] [`(define-syntax-rule (,name . ,formals) . ,_) (add-signature! name formals store)] [`(define-syntax ,name (syntax-rules ,specials . ,clauses)) (for-each (lambda (c) (add-syntax-signature! name (cdar c) store)) (reverse clauses))] [`(define-syntax ,name (lambda ,_ (syntax-case ,_ . ,clauses))) (for-each (lambda (c) (add-syntax-signature! name (cdar c) store)) (reverse clauses))] [`(define-type ,_ . ,cases) (for-each (lambda (c) (add-signature! (car c) (cdr c) store)) cases)] [_ void]))) (define (add-signature! name formals store) (when (symbol? name) (hash-set! store name (cons (parse-formals formals) (hash-ref store name '()))))) (define (add-syntax-signature! name formals store) (when (symbol? name) (hash-set! store name (cons (signature formals '() '() #f) (hash-ref store name '()))))) (define (parse-formals formals) (let loop ([formals formals] [req '()] [opt '()] [keys '()]) (cond [(null? formals) (signature (reverse req) (reverse opt) (reverse keys) #f)] [(symbol? formals) (signature (reverse req) (reverse opt) (reverse keys) formals)] [(pair? (car formals)) (loop (cdr formals) req (cons (car formals) opt) keys)] [(keyword? (car formals)) (let* ((kname (car formals)) (arg-id (cadr formals)) (name (if (pair? arg-id) (list kname (cadr arg-id)) (list kname)))) (loop (cddr formals) req opt (cons name keys)))] [else (loop (cdr formals) (cons (car formals) req) opt keys)]))) (define (infer-signatures name) (with-handlers ([exn:fail:syntax? (const `(,(signature '(...) '() '() #f)))] [exn:fail:contract:variable? (const #f)]) (let ([v (namespace-variable-value name)]) (if (procedure? v) (arity->signatures (procedure-arity v)) 'variable)))) (define (arity->signatures arity) (define (args count) (build-list count (const '_))) (define (arity->signature arity) (cond [(number? arity) (signature (args arity) '() '() #f)] [(arity-at-least? arity) (signature (args (arity-at-least-value arity)) '() '() 'rest)])) (define (conseq? lst) (cond [(< (length lst) 2) (number? (car lst))] [(and (number? (car lst)) (number? (cadr lst)) (eqv? (+ 1 (car lst)) (cadr lst))) (conseq? (cdr lst))] [else #f])) (cond [(and (list? arity) (conseq? arity)) (let ((mi (apply min arity)) (ma (apply max arity))) (list (signature (args mi) (args (- ma mi)) '() #f)))] [(list? arity) (map arity->signature arity)] [else (list (arity->signature arity))])) (define (update-signature-cache path (form #f)) (when (and (string? path) (or (not form) (and (list? form) (not (null? form)) (memq (car form) '(define-syntax-rule struct define-syntax define set! define-struct))))) (hash-remove! signatures path))) (define (module-exports mod) (define (contracted id) (let ([v (value id mod)]) (if (has-contract? v) (list id (cons "info" (contract-name (value-contract v)))) (entry id)))) (define (entry id) (let ((sign (eval `(,autodoc* ',id #f) (module-spec->namespace mod #f #f)))) (if sign (list id (cons "signature" sign)) (list id)))) (define (classify-ids ids) (let loop ([ids ids] [procs '()] [vars '()]) (cond [(null? ids) `(("procs" ,@(map entry (reverse procs))) ("vars" ,@(map list (reverse vars))))] [(procedure? (value (car ids) mod)) (loop (cdr ids) (cons (car ids) procs) vars)] [else (loop (cdr ids) procs (cons (car ids) vars))]))) (let-values ([(ids syn) (module-identifiers mod)]) `(,@(classify-ids ids) ("syntax" ,@(map contracted syn)) ("modules" ,@(map list (or (submodules mod) '())))))) geiser-0.8.1/scheme/racket/geiser/utils.rkt0000644000175000017500000000144112607252416016764 0ustar jaojao;;; utils.rkt -- generic utilities ;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sun May 03, 2009 03:09 #lang racket (provide pair->list keyword->symbol symbol->keyword) (define (pair->list pair) (let loop ([d pair] [s '()]) (cond [(null? d) (reverse s)] [(symbol? d) (reverse (cons d s))] [else (loop (cdr d) (cons (car d) s))]))) (define keyword->symbol (compose string->symbol keyword->string)) (define (symbol->keyword sym) (string->keyword (format "~a" sym))) geiser-0.8.1/dir0000644000175000017500000000115212607252416011607 0ustar jaojaoThis is the file .../info/dir, which contains the topmost node of the Info hierarchy, called (dir)Top. The first time you invoke Info you start off looking at this node.  File: dir, Node: Top This is the top of the INFO tree This (the Directory node) gives a menu of major topics. Typing "q" exits, "?" lists all Info commands, "d" returns here, "h" gives a primer for first-timers, "mEmacs" visits the Emacs manual, etc. In Emacs, you can click mouse button 2 on a menu item or cross reference to select it. * Menu: Emacs * Geiser: (geiser). Emacs environment for Scheme hacking. geiser-0.8.1/geiser-autodoc.el0000644000175000017500000002052212607252416014344 0ustar jaojao;; geiser-autodoc.el -- autodoc mode ;; Copyright (C) 2009, 2010, 2011, 2012, 2015 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sun Feb 08, 2009 19:44 (require 'geiser-eval) (require 'geiser-syntax) (require 'geiser-custom) (require 'geiser-base) (require 'eldoc) ;;; Customization: (defgroup geiser-autodoc nil "Options for displaying autodoc strings in the echo area." :group 'geiser) (geiser-custom--defface autodoc-current-arg 'font-lock-variable-name-face geiser-autodoc "highlighting current argument in autodoc messages") (geiser-custom--defface autodoc-identifier 'font-lock-function-name-face geiser-autodoc "highlighting procedure name in autodoc messages") (geiser-custom--defcustom geiser-autodoc-delay 0.3 "Delay before autodoc messages are fetched and displayed, in seconds." :type 'number :group 'geiser-autodoc) (geiser-custom--defcustom geiser-autodoc-display-module-p t "Whether to display procedure module in autodoc strings." :type 'boolean :group 'geiser-autodoc) (geiser-custom--defcustom geiser-autodoc-identifier-format "%s:%s" "Format for displaying module and procedure or variable name, in that order, when `geiser-autodoc-display-module-p' is on." :type 'string :group 'geiser-autodoc) ;;; Procedure arguments: (make-variable-buffer-local (defvar geiser-autodoc--cached-signatures nil)) (defsubst geiser-autodoc--clean-cache () (setq geiser-autodoc--cached-signatures nil)) (defun geiser-autodoc--show-signatures (ret) (let ((res (geiser-eval--retort-result ret)) (signs)) (when res (dolist (item res) (push (cons (format "%s" (car item)) (cdr item)) signs)) (let ((str (geiser-autodoc--autodoc (geiser-syntax--scan-sexps) signs))) (when (not (string-equal str eldoc-last-message)) (eldoc-message str))) (setq geiser-autodoc--cached-signatures signs)))) (defun geiser-autodoc--get-signatures (funs) (when funs (let ((m (format "'(%s)" (mapconcat 'identity funs " ")))) (geiser-eval--send `(:eval (:ge autodoc (:scm ,m))) 'geiser-autodoc--show-signatures))) (and (or (assoc (car funs) geiser-autodoc--cached-signatures) (assoc (cadr funs) geiser-autodoc--cached-signatures)) geiser-autodoc--cached-signatures)) (defun geiser-autodoc--sanitize-args (args) (cond ((null args) nil) ((listp args) (cons (car args) (geiser-autodoc--sanitize-args (cdr args)))) (t '("...")))) (defun geiser-autodoc--format-arg (a) (cond ((and (listp a) (geiser-syntax--keywordp (car a))) (if (and (cdr a) (listp (cdr a))) (format "(#%s %s)" (car a) (geiser-syntax--display (cadr a))) (format "(#%s)" (car a)))) (t (geiser-syntax--display a)))) (defun geiser-autodoc--insert-arg-group (args current &optional pos) (when args (insert " ")) (dolist (a (geiser-autodoc--sanitize-args args)) (let ((p (point))) (insert (geiser-autodoc--format-arg a)) (when (or (and (numberp pos) (numberp current) (setq current (1+ current)) (= (1+ pos) current)) (and (geiser-syntax--keywordp current) (listp a) (geiser-syntax--symbol-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) (defun geiser-autodoc--insert-args (args pos prev) (let ((cpos 1) (reqs (cdr (assoc "required" args))) (opts (mapcar (lambda (a) (if (and (symbolp a) (not (equal (symbol-name a) "..."))) (list a) a)) (cdr (assoc "optional" args)))) (keys (cdr (assoc "key" args)))) (setq cpos (geiser-autodoc--insert-arg-group reqs cpos (and (not (zerop pos)) pos))) (setq cpos (geiser-autodoc--insert-arg-group opts cpos pos)) (geiser-autodoc--insert-arg-group keys prev nil))) (defsubst geiser-autodoc--id-name (proc module) (let ((str (if module (format geiser-autodoc-identifier-format module proc) (format "%s" proc)))) (propertize str 'face 'geiser-font-lock-autodoc-identifier))) (defun geiser-autodoc--str* (full-signature) (let ((geiser-font-lock-autodoc-current-arg 'default)) (geiser-autodoc--str (list (car full-signature)) full-signature))) (defsubst geiser-autodoc--value-str (proc module value) (let ((name (geiser-autodoc--id-name proc module))) (if value (format "%s => %s" name value) name))) (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--value-str proc module (cdr (assoc "value" signature))) (save-current-buffer (set-buffer (geiser-syntax--font-lock-buffer)) (erase-buffer) (insert (format "(%s" (geiser-autodoc--id-name proc module))) (let ((pos (or (cadr desc) 0)) (prev (car (cddr desc)))) (dolist (a args) (when (not (member a (cdr (member a args)))) (geiser-autodoc--insert-args a pos prev) (insert " |")))) (delete-char -2) (insert ")") (buffer-substring (point-min) (point)))))) (defun geiser-autodoc--autodoc (path &optional signs) (let ((signs (or signs (geiser-autodoc--get-signatures (mapcar 'car path)))) (p (car path)) (s)) (while (and p (not s)) (unless (setq s (cdr (assoc (car p) signs))) (setq p (car path)) (setq path (cdr path)))) (when s (geiser-autodoc--str p s)))) ;;; Autodoc functions: (make-variable-buffer-local (defvar geiser-autodoc--inhibit-function nil)) (defsubst geiser-autodoc--inhibit () (and geiser-autodoc--inhibit-function (funcall geiser-autodoc--inhibit-function))) (defsubst geiser-autodoc--inhibit-autodoc () (setq geiser-autodoc--inhibit-function (lambda () t))) (defsubst geiser-autodoc--disinhibit-autodoc () (setq geiser-autodoc--inhibit-function nil)) (defsubst geiser-autodoc--autodoc-at-point () (geiser-autodoc--autodoc (geiser-syntax--scan-sexps))) (defun geiser-autodoc--eldoc-function () (condition-case e (and (not (geiser-autodoc--inhibit)) (geiser-autodoc--autodoc-at-point)) (error (format "Autodoc not available (%s)" (error-message-string e))))) (defun geiser-autodoc-show () "Show the signature or value of the symbol at point in the echo area." (interactive) (message (geiser-autodoc--autodoc-at-point))) ;;; Autodoc mode: (make-variable-buffer-local (defvar geiser-autodoc-mode-string " A" "Modeline indicator for geiser-autodoc-mode")) (define-minor-mode geiser-autodoc-mode "Toggle Geiser's Autodoc mode. With no argument, this command toggles the mode. Non-null prefix argument turns on the mode. Null prefix argument turns off the mode. When Autodoc mode is enabled, a synopsis of the word at point is displayed in the minibuffer." :init-value nil :lighter geiser-autodoc-mode-string :group 'geiser-autodoc (set (make-local-variable 'eldoc-documentation-function) (when geiser-autodoc-mode 'geiser-autodoc--eldoc-function)) (set (make-local-variable 'eldoc-minor-mode-string) nil) (set (make-local-variable 'eldoc-idle-delay) geiser-autodoc-delay) (eldoc-mode (if geiser-autodoc-mode 1 -1)) (when (called-interactively-p nil) (message "Geiser Autodoc %s" (if geiser-autodoc-mode "enabled" "disabled")))) (defadvice eldoc-display-message-no-interference-p (after geiser-autodoc--message-ok-p) (when geiser-autodoc-mode (setq ad-return-value (and ad-return-value ;; Display arglist only when the minibuffer is ;; inactive, e.g. not on `C-x C-f'. Lifted from slime. (not (active-minibuffer-window))))) ad-return-value) (provide 'geiser-autodoc) geiser-0.8.1/geiser-image.el0000644000175000017500000000777112607252416014003 0ustar jaojao;; geiser-image.el -- support for image display ;; Copyright (c) 2012, 2015 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Authors: Michael Wilber, Jose Antonio Ortega Ruiz ;; Start date: Sun Sep 02, 2012 00:00 (require 'geiser-custom) (require 'geiser-base) (require 'geiser-impl) ;;; Customization: (defgroup geiser-image nil "Options for image displaying." :group 'geiser) (geiser-custom--defcustom geiser-image-viewer "display" "Which system image viewer program to invoke upon M-x `geiser-view-last-image'." :type 'string :group 'geiser-image) (geiser-custom--defcustom geiser-image-cache-keep-last 10 "How many images to keep in geiser's image cache." :type 'integer :group 'geiser-image) (geiser-custom--defcustom geiser-image-cache-dir nil "Default directory where generated images are stored. If nil,the system wide tmp dir will be used." :type 'path :group 'geiser-image) (geiser-custom--defface image-button 'button geiser-image "image buttons in terminal buffers") (geiser-impl--define-caller geiser-image--cache-dir image-cache-dir () "Directory where generated images are stored. If this function returns nil, no images are generated.") (defun geiser-image--list-cache () "List all the images in the image cache." (let ((cdir (geiser-image--cache-dir nil))) (and cdir (file-directory-p cdir) (let ((files (directory-files-and-attributes cdir t "geiser-img-[0-9]*.png"))) (mapcar 'car (sort files (lambda (a b) (< (float-time (nth 6 a)) (float-time (nth 6 b)))))))))) (defun geiser-image--clean-cache () "Clean all except for the last `geiser-image-cache-keep-last' images in `geiser-image--cache-dir'." (interactive) (dolist (f (butlast (geiser-image--list-cache) geiser-image-cache-keep-last)) (delete-file f))) (defun geiser-image--display (file) (start-process "Geiser image view" nil geiser-image-viewer file)) (defun geiser-image--button-action (button) (let ((file (button-get button 'geiser-image-file))) (when (file-exists-p file) (geiser-image--display file)))) (define-button-type 'geiser-image--button 'action 'geiser-image--button-action 'follow-link t) (defun geiser-image--insert-button (file) (insert-text-button "[image]" :type 'geiser-image--button 'face 'geiser-font-lock-image-button 'geiser-image-file file 'help-echo "Click to display image")) (defun geiser-image--replace-images (inline-images-p auto-p) "Replace all image patterns with actual images" (let ((seen 0)) (with-silent-modifications (save-excursion (goto-char (point-min)) (while (re-search-forward "\"?#\"?" nil t) (setq seen (+ 1 seen)) (let* ((file (match-string 1)) (begin (match-beginning 0)) (end (match-end 0))) (delete-region begin end) (goto-char begin) (if (and inline-images-p (display-images-p)) (insert-image (create-image file) "[image]") (geiser-image--insert-button file) (when auto-p (geiser-image--display file))))))) seen)) (defun geiser-view-last-image (n) "Open the last displayed image in the system's image viewer. With prefix arg, open the N-th last shown image in the system's image viewer." (interactive "p") (let ((images (reverse (geiser-image--list-cache)))) (if (>= (length images) n) (geiser-image--display (nth (- n 1) images)) (error "There aren't %d recent images" n)))) (provide 'geiser-image) geiser-0.8.1/geiser-reload.el0000644000175000017500000000501112607252416014150 0ustar jaojao;; geiser-reload.el -- unload/load geiser packages ;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sat Aug 22, 2009 23:04 (require 'geiser-repl) (require 'geiser-mode) (require 'geiser-custom) (require 'geiser-base) (require 'geiser) (require 'geiser-load nil t) (require 'geiser-install nil t) ;;; Reload: (defmacro geiser--features-list () (quote '( geiser-mode geiser-repl geiser-doc geiser-xref geiser-compile geiser-debug geiser-company geiser-edit geiser-completion geiser-autodoc geiser-eval geiser-connection geiser-syntax geiser-menu geiser-inf geiser-impl geiser-image geiser-custom geiser-log geiser-popup geiser-base geiser-version geiser-install geiser ))) (defun geiser-unload () "Unload all Geiser modules." (interactive) (let ((fs (geiser--features-list))) (unload-feature 'geiser-reload t) (dolist (f fs) (when (featurep f) (unload-feature f t))) (remove-hook 'scheme-mode-hook 'geiser-mode--maybe-activate))) (defun geiser-reload (&optional arg) "Reload Geiser. With prefix arg, prompts for the DIRECTORY from which Geiser should be 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))) (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 ((memo (geiser-custom--memoized-state)) (repls (geiser-repl--repl-list)) (buffers (geiser-mode--buffers))) (geiser-unload) (setq load-path (remove old-dir load-path)) (add-to-list 'load-path dir) (mapc (lambda (x) (set (car x) (cdr x))) memo) (require 'geiser-reload) (geiser-repl--restore repls) (geiser-mode--restore buffers) (message "Geiser reloaded!")))) (provide 'geiser-reload) geiser-0.8.1/geiser-menu.el0000644000175000017500000001266512607252416013663 0ustar jaojao;;; geiser-menu.el -- menu and keymaps definition ;; Copyright (c) 2010, 2012 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sat Jun 12, 2010 03:01 (require 'geiser-custom) (require 'geiser-base) ;;; Customization: (geiser-custom--defcustom geiser-global-menu-always-on-p nil "Whether the Geiser menu is always visible." :type 'boolean :group 'geiser) ;;; Top-level menu (defmacro geiser-menu--add-item (keymap map kd) (cond ((or (eq '-- kd) (eq 'line kd)) `(geiser-menu--add-line ,map)) ((stringp (car kd)) `(geiser-menu--add-basic-item ,keymap ,map ,kd)) ((eq 'menu (car kd)) `(geiser-menu--add-submenu ,(cadr kd) ,keymap ,map ,(cddr kd))) ((eq 'custom (car kd)) `(geiser-menu--add-custom ,(nth 1 kd) ,(nth 2 kd) ,keymap ,map)) ((eq 'mode (car kd)) `(geiser-menu--mode-toggle ,(nth 1 kd) ,(nth 2 kd) ,(nth 3 kd) ,keymap ,map)) (t (error "Bad item form: %s" kd)))) (defmacro geiser-menu--add-basic-item (keymap map kd) (let* ((title (nth 0 kd)) (binding (nth 1 kd)) (cmd (nth 2 kd)) (hlp (nth 3 kd)) (item (make-symbol title)) (hlp (and (stringp hlp) (list :help hlp))) (rest (or (and hlp (nthcdr 4 kd)) (nthcdr 3 kd))) (binding (if (listp binding) binding (list binding)))) `(progn (define-key ,map [,item] '(menu-item ,title ,cmd ,@hlp ,@rest)) ,@(and (car binding) `((put ',cmd :advertised-binding ,(car binding)))) ,@(mapcar (lambda (b) `(define-key ,keymap ,b ',cmd)) binding)))) (defmacro geiser-menu--add-items (keymap map keys) `(progn ,@(mapcar (lambda (k) (list 'geiser-menu--add-item keymap map k)) (reverse keys)))) (defmacro geiser-menu--add-submenu (name keymap map keys) (let ((ev (make-symbol name)) (map2 (make-symbol "map2"))) `(progn (let ((,map2 (make-sparse-keymap ,name))) (define-key ,map [,ev] (cons ,name ,map2)) (geiser-menu--add-items ,keymap ,map2 ,keys))))) (defvar geiser-menu--line-counter 0) (defun geiser-menu--add-line (&optional map) (let ((line (make-symbol (format "line%s" (setq geiser-menu--line-counter (1+ geiser-menu--line-counter)))))) (define-key (or map global-map) `[,line] `(menu-item "--single-line")))) (defmacro geiser-menu--add-custom (title group keymap map) `(geiser-menu--add-item ,keymap ,map (,title nil (lambda () (interactive) (customize-group ',group))))) (defmacro geiser-menu--mode-toggle (title bindings mode keymap map) `(geiser-menu--add-item ,keymap ,map (,title ,bindings ,mode :button (:toggle . (and (boundp ',mode) ,mode))))) (defmacro geiser-menu--defmenu (name keymap &rest keys) (let ((mmap (make-symbol "mmap"))) `(progn (let ((,mmap (make-sparse-keymap "Geiser"))) (define-key ,keymap [menu-bar ,name] (cons "Geiser" ,mmap)) (define-key ,mmap [customize] (cons "Customize" geiser-menu--custom-customize)) (define-key ,mmap [switch] (cons "Switch to" geiser-menu--custom-switch)) (define-key ,mmap [Run] (cons "Run" geiser-menu--custom-run)) (geiser-menu--add-line ,mmap) (geiser-menu--add-items ,keymap ,mmap ,keys) ,mmap)))) (put 'geiser-menu--defmenu 'lisp-indent-function 2) ;;; Shared entries (defvar geiser-menu--custom-map (make-sparse-keymap "Geiser")) (defvar geiser-menu--custom-run (make-sparse-keymap "Run")) (defvar geiser-menu--custom-switch (make-sparse-keymap "Switch")) (defvar geiser-menu--custom-customize (make-sparse-keymap "Customize")) (define-key geiser-menu--custom-map [customize] (cons "Customize" geiser-menu--custom-customize)) (define-key geiser-menu--custom-map [switch] (cons "Switch to" geiser-menu--custom-switch)) (define-key geiser-menu--custom-map [run] (cons "Run" geiser-menu--custom-run)) (defun geiser-menu--add-global-custom (title group) (define-key geiser-menu--custom-customize `[,(make-symbol title)] (cons title `(lambda () (interactive) (customize-group ',group))))) (defun geiser-menu--add-impl (name runner switcher) (let ((title (capitalize (format "%s" name))) (group (intern (format "geiser-%s" name)))) (define-key geiser-menu--custom-run `[,name] `(menu-item ,title ,runner :enable (geiser-impl--active-p ',name))) (define-key geiser-menu--custom-switch `[,name] `(menu-item ,title ,switcher :enable (geiser-repl--repl/impl ',name))) (geiser-menu--add-global-custom title group))) (geiser-menu--add-global-custom "Geiser" 'geiser) (provide 'geiser-menu) geiser-0.8.1/geiser-mode.el0000644000175000017500000003276012607252416013641 0ustar jaojao;; geiser-mode.el -- minor mode for scheme buffers ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sun Feb 08, 2009 15:13 (require 'geiser-repl) (require 'geiser-menu) (require 'geiser-doc) (require 'geiser-compile) (require 'geiser-completion) (require 'geiser-company) (require 'geiser-xref) (require 'geiser-edit) (require 'geiser-autodoc) (require 'geiser-debug) (require 'geiser-syntax) (require 'geiser-impl) (require 'geiser-eval) (require 'geiser-popup) (require 'geiser-custom) (require 'geiser-base) ;;; Customization: (defgroup geiser-mode nil "Mode enabling Geiser abilities in Scheme buffers &co.." :group 'geiser) (geiser-custom--defcustom geiser-mode-auto-p t "Whether `geiser-mode' should be active by default in all scheme buffers." :group 'geiser-mode :type 'boolean) (geiser-custom--defcustom geiser-mode-start-repl-p nil "Whether a REPL should be automatically started if one is not active when `geiser-mode' is activated in a buffer." :group 'geiser-mode :type 'boolean) (geiser-custom--defcustom geiser-mode-autodoc-p t "Whether `geiser-autodoc-mode' gets enabled by default in Scheme buffers." :group 'geiser-mode :group 'geiser-autodoc :type 'boolean) (geiser-custom--defcustom geiser-mode-company-p t "Whether to use company-mode for completion, if available." :group 'geiser-mode :type 'boolean) (geiser-custom--defcustom geiser-mode-smart-tab-p nil "Whether `geiser-smart-tab-mode' gets enabled by default in Scheme buffers." :group 'geiser-mode :type 'boolean) ;;; Evaluation commands: (defun geiser--go-to-repl () (switch-to-geiser nil nil (current-buffer)) (push-mark) (goto-char (point-max))) (defun geiser-eval-region (start end &optional and-go raw nomsg) "Eval the current region in the Geiser REPL. With prefix, goes to the REPL buffer afterwards (as `geiser-eval-region-and-go')" (interactive "rP") (save-restriction (narrow-to-region start end) (check-parens)) (geiser-debug--send-region nil start end (and and-go 'geiser--go-to-repl) (not raw) nomsg)) (defun geiser-eval-region-and-go (start end) "Eval the current region in the Geiser REPL and visit it afterwads." (interactive "r") (geiser-eval-region start end t)) (geiser-impl--define-caller geiser-eval--bounds eval-bounds () "A pair with the bounds of a buffer to be evaluated, defaulting to (cons (point-min) . (point-max)).") (defun geiser-eval-buffer (&optional and-go raw nomsg) "Eval the current buffer in the Geiser REPL. With prefix, goes to the REPL buffer afterwards (as `geiser-eval-buffer-and-go')" (interactive "P") (let* ((bounds (geiser-eval--bounds geiser-impl--implementation)) (from (or (car bounds) (point-min))) (to (or (cdr bounds) (point-max)))) (geiser-eval-region from to and-go raw nomsg))) (defun geiser-eval-buffer-and-go () "Eval the current buffer in the Geiser REPL and visit it afterwads." (interactive) (geiser-eval-buffer t)) (defun geiser-eval-definition (&optional and-go) "Eval the current definition in the Geiser REPL. With prefix, goes to the REPL buffer afterwards (as `geiser-eval-definition-and-go')" (interactive "P") (save-excursion (end-of-defun) (let ((end (point))) (beginning-of-defun) (geiser-eval-region (point) end and-go t)))) (defun geiser-eval-definition-and-go () "Eval the current definition in the Geiser REPL and visit it afterwads." (interactive) (geiser-eval-definition t)) (defun geiser-eval-last-sexp (print-to-buffer-p) "Eval the previous sexp in the Geiser REPL. With a prefix, print the result of the evaluation to the buffer." (interactive "P") (let* ((ret (geiser-eval-region (save-excursion (backward-sexp) (point)) (point) nil t print-to-buffer-p)) (str (geiser-eval--retort-result-str ret (when print-to-buffer-p "")))) (when (and print-to-buffer-p (not (string= "" str))) (push-mark) (insert str)))) (defun geiser-compile-definition (&optional and-go) "Compile the current definition in the Geiser REPL. With prefix, goes to the REPL buffer afterwards (as `geiser-eval-definition-and-go')" (interactive "P") (save-excursion (end-of-defun) (let ((end (point))) (beginning-of-defun) (geiser-debug--send-region t (point) end (and and-go 'geiser--go-to-repl) t)))) (defun geiser-compile-definition-and-go () "Compile the current definition in the Geiser REPL and visit it afterwads." (interactive) (geiser-compile-definition t)) (defun geiser-expand-region (start end &optional all raw) "Macro-expand the current region and display it in a buffer. With prefix, recursively macro-expand the resulting expression." (interactive "rP") (geiser-debug--expand-region start end all (not raw))) (defun geiser-expand-definition (&optional all) "Macro-expand the current definition. With prefix, recursively macro-expand the resulting expression." (interactive "P") (save-excursion (end-of-defun) (let ((end (point))) (beginning-of-defun) (geiser-expand-region (point) end all t)))) (defun geiser-expand-last-sexp (&optional all) "Macro-expand the previous sexp. With prefix, recursively macro-expand the resulting expression." (interactive "P") (geiser-expand-region (save-excursion (backward-sexp) (point)) (point) all t)) (defun geiser-set-scheme () "Associates current buffer with a given Scheme implementation." (interactive) (let ((impl (geiser-impl--read-impl))) (geiser-impl--set-buffer-implementation impl) (geiser-repl--set-up-repl impl))) (defun geiser-mode-switch-to-repl (arg) "Switches to Geiser REPL. With prefix, try to enter the current buffer's module." (interactive "P") (if arg (switch-to-geiser-module (geiser-eval--get-module) (current-buffer)) (switch-to-geiser nil nil (current-buffer)))) (defun geiser-mode-switch-to-repl-and-enter () "Switches to Geiser REPL and enters current buffer's module." (interactive) (geiser-mode-switch-to-repl t)) (defun geiser-restart-repl () "Restarts the REPL associated with the current buffer." (interactive) (let ((b (current-buffer))) (geiser-mode-switch-to-repl nil) (comint-kill-subjob) (sit-for 0.1) ;; ugly hack; but i don't care enough to fix it (call-interactively 'run-geiser) (sit-for 0.2) ;; ditto (goto-char (point-max)) (pop-to-buffer b))) (defun geiser-squarify (n) "Toggle between () and [] for current form. With numeric prefix, perform that many toggles, forward for positive values and backward for negative." (interactive "p") (let ((pared (and (boundp 'paredit-mode) paredit-mode)) (fwd (> n 0)) (steps (abs n))) (when (and pared (fboundp 'paredit-mode)) (paredit-mode -1)) (unwind-protect (save-excursion (unless (looking-at-p "\\s(") (backward-up-list)) (while (> steps 0) (let ((p (point)) (round (looking-at-p "("))) (forward-sexp) (backward-delete-char 1) (insert (if round "]" ")")) (goto-char p) (delete-char 1) (insert (if round "[" "(")) (setq steps (1- steps)) (backward-char) (condition-case nil (progn (when fwd (forward-sexp 2)) (backward-sexp)) (error (setq steps 0)))))) (when (and pared (fboundp 'paredit-mode)) (paredit-mode 1))))) (defun geiser-insert-lambda (&optional full) "Insert λ at point. With prefix, inserts (λ ())." (interactive "P") (if (not full) (insert (make-char 'greek-iso8859-7 107)) (insert "(" (make-char 'greek-iso8859-7 107) " ())") (backward-char 2))) ;;; Geiser mode: (make-variable-buffer-local (defvar geiser-mode-string nil "Modeline indicator for geiser-mode")) (defun geiser-mode--lighter () (or geiser-mode-string (format " %s" (or (geiser-impl--impl-str) "G")))) (defvar geiser-mode-map (make-sparse-keymap)) (define-minor-mode geiser-mode "Toggle Geiser's mode. With no argument, this command toggles the mode. Non-null prefix argument turns on the mode. Null prefix argument turns off the mode. When Geiser mode is enabled, a host of nice utilities for interacting with the Geiser REPL is at your disposal. \\{geiser-mode-map}" :init-value nil :lighter (:eval (geiser-mode--lighter)) :group 'geiser-mode :keymap geiser-mode-map (when geiser-mode (geiser-impl--set-buffer-implementation nil t)) (setq geiser-autodoc-mode-string "/A") (setq geiser-smart-tab-mode-string "/T") (geiser-company--setup (and geiser-mode geiser-mode-company-p)) (geiser-completion--setup geiser-mode) (when geiser-mode-autodoc-p (geiser-autodoc-mode (if geiser-mode 1 -1))) (when geiser-mode-smart-tab-p (geiser-smart-tab-mode (if geiser-mode 1 -1))) (geiser-syntax--add-kws) (when (and geiser-mode geiser-mode-start-repl-p (not (geiser-repl--connection*))) (save-window-excursion (run-geiser geiser-impl--implementation)))) (defun turn-on-geiser-mode () "Enable `geiser-mode' (in a Scheme buffer)." (interactive) (geiser-mode 1)) (defun turn-off-geiser-mode () "Disable `geiser-mode' (in a Scheme buffer)." (interactive) (geiser-mode -1)) (defun geiser-mode--maybe-activate () (when (and geiser-mode-auto-p (eq major-mode 'scheme-mode)) (turn-on-geiser-mode))) ;;; Keys: (geiser-menu--defmenu geiserm geiser-mode-map ("Eval sexp before point" "\C-x\C-e" geiser-eval-last-sexp) ("Eval definition" "\M-\C-x" geiser-eval-definition) ("Eval definition and go" "\C-c\M-e" geiser-eval-definition-and-go) ("Eval region" "\C-c\C-r" geiser-eval-region :enable mark-active) ("Eval region and go" "\C-c\M-r" geiser-eval-region-and-go geiser-eval-region :enable mark-active) ("Eval buffer" "\C-c\C-b" geiser-eval-buffer) ("Eval buffer and go" "\C-c\M-b" geiser-eval-buffer-and-go) ;; ("Compile definition" "\C-c\M-c" geiser-compile-definition) ;; ("Compile definition and go" "\C-c\C-c" geiser-compile-definition-and-go) (menu "Macroexpand" ("Sexp before point" ("\C-c\C-m\C-e" "\C-c\C-me") geiser-expand-last-sexp) ("Region" ("\C-c\C-m\C-r" "\C-c\C-mr") geiser-expand-region) ("Definition" ("\C-c\C-m\C-x" "\C-c\C-mx") geiser-expand-definition)) -- ("Symbol documentation" ("\C-c\C-d\C-d" "\C-c\C-dd") geiser-doc-symbol-at-point :enable (geiser--symbol-at-point)) ("Short symbol documentation" ("\C-c\C-d\C-s" "\C-c\C-ds") geiser-autodoc-show :enable (geiser--symbol-at-point)) ("Module documentation" ("\C-c\C-d\C-m" "\C-c\C-dm") geiser-doc-module) ("Symbol manual lookup" ("\C-c\C-d\C-i" "\C-c\C-di") geiser-doc-look-up-manual :enable (geiser-doc--manual-available-p)) (mode "Autodoc mode" ("\C-c\C-d\C-a" "\C-c\C-da") geiser-autodoc-mode) -- ("Compile buffer" "\C-c\C-k" geiser-compile-current-buffer) ("Switch to REPL" "\C-c\C-z" geiser-mode-switch-to-repl) ("Switch to REPL and enter module" "\C-c\C-a" geiser-mode-switch-to-repl-and-enter) ("Set Scheme..." "\C-c\C-s" geiser-set-scheme) -- ("Edit symbol at point" "\M-." geiser-edit-symbol-at-point :enable (geiser--symbol-at-point)) ("Go to previous definition" "\M-," geiser-pop-symbol-stack) ("Complete symbol" ((kbd "M-TAB")) completion-at-point :enable (geiser--symbol-at-point)) ("Complete module name" ((kbd "M-`") (kbd "C-.")) geiser-completion--complete-module) ("Edit module" ("\C-c\C-e\C-m" "\C-c\C-em") geiser-edit-module) ("Add to load path..." ("\C-c\C-e\C-l" "\C-c\C-el") geiser-add-to-load-path) ("Toggle ()/[]" ("\C-c\C-e\C-[" "\C-c\C-e[") geiser-squarify) ("Insert λ" ("\C-c\\" "\C-c\C-\\") geiser-insert-lambda) -- ("Callers" ((kbd "C-c <")) geiser-xref-callers :enable (and (geiser-eval--supported-p 'callers) (geiser--symbol-at-point))) ("Callees" ((kbd "C-c >")) geiser-xref-callees :enable (and (geiser-eval--supported-p 'callees) (geiser--symbol-at-point))) -- (mode "Smart TAB mode" nil geiser-smart-tab-mode) -- (custom "Customize Geiser mode" geiser-mode)) (define-key geiser-mode-map [menu-bar scheme] 'undefined) ;; (geiser-mode--triple-chord ?x ?m 'geiser-xref-generic-methods) ;;; Reload support: (defun geiser-mode--buffers () (let ((buffers)) (dolist (buffer (buffer-list)) (when (buffer-live-p buffer) (set-buffer buffer) (when geiser-mode (push (cons buffer geiser-impl--implementation) buffers)))) buffers)) (defun geiser-mode--restore (buffers) (dolist (b buffers) (when (buffer-live-p (car b)) (set-buffer (car b)) (when (cdr b) (geiser-impl--set-buffer-implementation (cdr b))) (geiser-mode 1)))) (defun geiser-mode-unload-function () (dolist (b (geiser-mode--buffers)) (with-current-buffer (car b) (geiser-mode nil)))) (provide 'geiser-mode) geiser-0.8.1/geiser.el0000644000175000017500000000743212607252416012715 0ustar jaojao;;; geiser.el --- GNU Emacs and Scheme talk to each other ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Autoloads and basic setup for geiser. ;;; Locations: ;;;###autoload (defconst geiser-elisp-dir (file-name-directory load-file-name) "Directory containing Geiser's Elisp files.") ;;;###autoload (defconst geiser-scheme-dir (let ((d (expand-file-name "./scheme/" geiser-elisp-dir))) (if (file-directory-p d) d (expand-file-name "../scheme/" geiser-elisp-dir))) "Directory containing Geiser's Scheme files.") ;;;###autoload (when (not (member geiser-elisp-dir load-path)) (add-to-list 'load-path geiser-elisp-dir)) ;;; Autoloads: ;;;###autoload (autoload 'geiser-version "geiser-version" "Echo Geiser's version." t) ;;;###autoload (autoload 'geiser-unload "geiser-reload" "Unload all Geiser code." t) ;;;###autoload (autoload 'geiser-reload "geiser-reload" "Reload Geiser code." t) ;;;###autoload (autoload 'geiser "geiser-repl" "Start a Geiser REPL, or switch to a running one." t) ;;;###autoload (autoload 'run-geiser "geiser-repl" "Start a Geiser REPL." t) ;;;###autoload (autoload 'geiser-connect "geiser-repl" "Start a Geiser REPL connected to a remote server." t) ;;;###autoload (autoload 'geiser-connect-local "geiser-repl" "Start a Geiser REPL connected to a remote server over a Unix-domain socket." t) ;;;###autoload (autoload 'switch-to-geiser "geiser-repl" "Switch to a running one Geiser REPL." t) ;;;###autoload (autoload 'run-guile "geiser-guile" "Start a Geiser Guile REPL." t) ;;;###autoload (autoload 'switch-to-guile "geiser-guile" "Start a Geiser Guile REPL, or switch to a running one." t) ;;;###autoload (autoload 'connect-to-guile "geiser-guile" "Connect to a remote Geiser Guile REPL." t) ;;;###autoload (autoload 'run-racket "geiser-racket" "Start a Geiser Racket REPL." t) ;;;###autoload (autoload 'run-gracket "geiser-racket" "Start a Geiser GRacket REPL." t) ;;;###autoload (autoload 'switch-to-racket "geiser-racket" "Start a Geiser Racket REPL, or switch to a running one." t) ;;;###autoload (autoload 'connect-to-racket "geiser-racket" "Connect to a remote Geiser Racket REPL." t) ;;;###autoload (autoload 'run-chicken "geiser-chicken" "Start a Geiser Chicken REPL." t) ;;;###autoload (autoload 'switch-to-chicken "geiser-chicken" "Start a Geiser Chicken REPL, or switch to a running one." t) ;;;###autoload (autoload 'connect-to-chicken "geiser-chicken" "Connect to a remote Geiser Chicken REPL." t) ;;;###autoload (autoload 'geiser-mode "geiser-mode" "Minor mode adding Geiser REPL interaction to Scheme buffers." t) ;;;###autoload (autoload 'turn-on-geiser-mode "geiser-mode" "Enable Geiser's mode (useful in Scheme buffers)." t) ;;;###autoload (autoload 'turn-off-geiser-mode "geiser-mode" "Disable Geiser's mode (useful in Scheme buffers)." t) ;;;###autoload (autoload 'geiser-mode--maybe-activate "geiser-mode") ;;;###autoload (mapc (lambda (group) (custom-add-load group (symbol-name group)) (custom-add-load 'geiser (symbol-name group))) '(geiser geiser-repl geiser-autodoc geiser-doc geiser-debug geiser-faces geiser-mode geiser-guile geiser-image geiser-racket geiser-chicken geiser-implementation geiser-xref)) ;;; Setup: ;;;###autoload (add-hook 'scheme-mode-hook 'geiser-mode--maybe-activate) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.rkt\\'" . scheme-mode)) (provide 'geiser) ;;; geiser.el ends here geiser-0.8.1/geiser-connection.el0000644000175000017500000002206112607252416015045 0ustar jaojao;;; geiser-connection.el -- talking to a scheme process ;; Copyright (C) 2009, 2010, 2011, 2013 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sat Feb 07, 2009 21:11 ;; Connection datatype and functions for managing request queues ;; between emacs and inferior guile processes. (require 'geiser-log) (require 'geiser-syntax) (require 'geiser-base) (require 'geiser-impl) (require 'tq) ;;; Buffer connections: (make-variable-buffer-local (defvar geiser-con--connection nil)) (defun geiser-con--get-connection (buffer/proc) (if (processp buffer/proc) (geiser-con--get-connection (process-buffer buffer/proc)) (with-current-buffer buffer/proc geiser-con--connection))) ;;; Request datatype: (defun geiser-con--make-request (con str cont &optional sender-buffer) (list (cons :id (geiser-con--connection-inc-count con)) (cons :string str) (cons :continuation cont) (cons :buffer (or sender-buffer (current-buffer))) (cons :connection con))) (defsubst geiser-con--request-id (req) (cdr (assoc :id req))) (defsubst geiser-con--request-string (req) (cdr (assoc :string req))) (defsubst geiser-con--request-continuation (req) (cdr (assoc :continuation req))) (defsubst geiser-con--request-buffer (req) (cdr (assoc :buffer req))) (defsubst geiser-con--request-connection (req) (cdr (assoc :connection req))) (defsubst geiser-con--request-deactivate (req) (setcdr (assoc :continuation req) nil)) (defsubst geiser-con--request-deactivated-p (req) (null (cdr (assoc :continuation req)))) ;;; Connection datatype: (defun geiser-con--tq-create (process) (let ((tq (tq-create process))) (set-process-filter process `(lambda (p s) (geiser-con--tq-filter ',tq s))) tq)) (defun geiser-con--tq-filter (tq in) (when (buffer-live-p (tq-buffer tq)) (with-current-buffer (tq-buffer tq) (if (tq-queue-empty tq) (progn (geiser-log--error "Unexpected queue input:\n %s" in) (delete-region (point-min) (point-max))) (goto-char (point-max)) (insert in) (goto-char (point-min)) (when (re-search-forward (tq-queue-head-regexp tq) nil t) (unwind-protect (funcall (tq-queue-head-fn tq) (tq-queue-head-closure tq) (buffer-substring (point-min) (point))) (delete-region (point-min) (point-max)) (tq-queue-pop tq))))))) (defun geiser-con--combined-prompt (prompt debug) (format "\\(%s%s\\)" prompt (if debug (format "\\|%s" debug) ""))) (defun geiser-con--connection-eot-re (prompt debug) (geiser-con--combined-prompt (format "\n%s" prompt) (and debug (format "\n%s" debug)))) (defun geiser-con--make-connection (proc prompt debug-prompt) (list t (cons :filter (process-filter proc)) (cons :tq (geiser-con--tq-create proc)) (cons :tq-filter (process-filter proc)) (cons :eot (geiser-con--connection-eot-re prompt debug-prompt)) (cons :prompt prompt) (cons :debug-prompt debug-prompt) (cons :is-debugging nil) (cons :count 0) (cons :completed (make-hash-table :weakness 'value)))) (defsubst geiser-con--connection-process (c) (tq-process (cdr (assoc :tq c)))) (defsubst geiser-con--connection-filter (c) (cdr (assoc :filter c))) (defsubst geiser-con--connection-tq-filter (c) (cdr (assoc :tq-filter c))) (defsubst geiser-con--connection-tq (c) (cdr (assoc :tq c))) (defsubst geiser-con--connection-eot (c) (cdr (assoc :eot c))) (defsubst geiser-con--connection-prompt (c) (cdr (assoc :prompt c))) (defsubst geiser-con--connection-debug-prompt (c) (cdr (assoc :debug-prompt c))) (defsubst geiser-con--connection-is-debugging (c) (cdr (assoc :is-debugging c))) (defsubst geiser-con--connection-set-debugging (c d) (setcdr (assoc :is-debugging c) d)) (defun geiser-con--connection-update-debugging (c txt) (let* ((dp (geiser-con--connection-debug-prompt c)) (is-d (and (stringp dp) (string-match dp txt)))) (geiser-con--connection-set-debugging c is-d) is-d)) (defsubst geiser-con--connection-completed (c r) (geiser-con--request-deactivate r) (puthash (geiser-con--request-id r) r (cdr (assoc :completed c)))) (defsubst geiser-con--connection-completed-p (c id) (gethash id (cdr (assoc :completed c)))) (defun geiser-con--connection-inc-count (c) (let* ((cnt (assoc :count c)) (new (1+ (cdr cnt)))) (setcdr cnt new) new)) (defun geiser-con--has-entered-debugger (con answer) (and (not (geiser-con--connection-is-debugging con)) (let ((p (car (last (split-string answer "\n" t))))) (and p (geiser-con--connection-update-debugging con p))))) (defun geiser-con--connection-eot-p (con txt) (and txt (string-match-p (geiser-con--connection-eot con) txt))) (defun geiser-con--connection-close (con) (let ((tq (geiser-con--connection-tq con))) (and tq (tq-close tq)))) (defvar geiser-con--startup-prompt nil) (defun geiser-con--startup-prompt (p s) (setq geiser-con--startup-prompt (concat geiser-con--startup-prompt s)) nil) (defun geiser-con--connection-deactivate (c &optional no-wait) (when (car c) (let* ((tq (geiser-con--connection-tq c)) (proc (geiser-con--connection-process c)) (proc-filter (geiser-con--connection-filter c))) (unless no-wait (while (and (not (tq-queue-empty tq)) (accept-process-output proc 0.1)))) (set-process-filter proc proc-filter) (setcar c nil)))) (defun geiser-con--connection-activate (c) (when (not (car c)) (let* ((tq (geiser-con--connection-tq c)) (proc (geiser-con--connection-process c)) (tq-filter (geiser-con--connection-tq-filter c))) (while (accept-process-output proc 0.01)) (set-process-filter proc tq-filter) (setcar c t)))) ;;; Requests handling: (defun geiser-con--req-form (req answer) (let ((con (geiser-con--request-connection req))) (if (geiser-con--has-entered-debugger con answer) `((error (key . geiser-debugger)) (output . ,answer)) (condition-case err (let ((start (string-match "((\\(?:result)?\\|error\\) " answer))) (or (and start (car (read-from-string answer start))) `((error (key . retort-syntax)) (output . ,answer)))) (error `((error (key . geiser-con-error)) (output . ,(format "%s\n(%s)" answer (error-message-string err))))))))) (defun geiser-con--process-completed-request (req answer) (let ((cont (geiser-con--request-continuation req)) (id (geiser-con--request-id req)) (rstr (geiser-con--request-string req)) (form (geiser-con--req-form req answer)) (buffer (or (geiser-con--request-buffer req) (current-buffer))) (con (geiser-con--request-connection req))) (if (not cont) (geiser-log--warn "<%s> Droping result for request %S: %s" id rstr form) (condition-case cerr (with-current-buffer buffer (funcall cont form) (geiser-log--info "<%s>: processed" id)) (error (geiser-log--error "<%s>: continuation failed %S \n\t%s" id rstr cerr)))) (geiser-con--connection-completed con req))) (defun geiser-con--connection-add-request (c r) (geiser-log--info "REQUEST: <%s>: %s" (geiser-con--request-id r) (geiser-con--request-string r)) (geiser-con--connection-activate c) (tq-enqueue (geiser-con--connection-tq c) (concat (geiser-con--request-string r) "\n") (geiser-con--connection-eot c) r 'geiser-con--process-completed-request t)) ;;; Message sending interface: (defun geiser-con--send-string (con str cont &optional sbuf) (let ((req (geiser-con--make-request con str cont sbuf))) (geiser-con--connection-add-request con req) req)) (defvar geiser-connection-timeout 30000 "Time limit, in msecs, blocking on synchronous evaluation requests") (defun geiser-con--send-string/wait (con str cont &optional timeout sbuf) (save-current-buffer (let ((proc (and con (geiser-con--connection-process con)))) (unless proc (error "Geiser connection not active")) (let* ((req (geiser-con--send-string con str cont sbuf)) (id (geiser-con--request-id req)) (timeout (/ (or timeout geiser-connection-timeout) 1000.0))) (with-timeout (timeout (geiser-con--request-deactivate req)) (condition-case nil (while (and (geiser-con--connection-process con) (not (geiser-con--connection-completed-p con id))) (accept-process-output proc (/ timeout 10))) (error (geiser-con--request-deactivate req)))))))) (provide 'geiser-connection) geiser-0.8.1/bin/0000755000175000017500000000000012607252416011657 5ustar jaojaogeiser-0.8.1/bin/geiser-racket.sh0000755000175000017500000000131612607252416014744 0ustar jaojao#!/bin/bash #| topdir=$(dirname $0) elpa_scheme=$topdir/scheme in_scheme=$topdir/../scheme top=$(if [ -d $elpa_scheme ]; then echo $elpa_scheme; else echo $in_scheme; fi) exec racket -i -S "$top/racket" -l errortrace -cu "$0" ${1+"$@"} |# #lang racket/base (require (lib "cmdline.rkt")) (require geiser/server) (define port (make-parameter 0)) (define host (make-parameter #f (lambda (h) (and (string? h) h)))) (command-line "run-racket.sh" (current-command-line-arguments) (once-each (("-n" "--hostname") n "Network hostname, or #f for all interfaces" (host n)) (("-p" "--port") p "Geiser server port" (port (string->number p))))) (printf "Geiser server running at port ~a~%" (start-geiser (port) (host))) geiser-0.8.1/geiser-edit.el0000644000175000017500000002226312607252416013637 0ustar jaojao;;; geiser-edit.el -- scheme edit locations ;; Copyright (C) 2009, 2010, 2012, 2013 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Wed Feb 11, 2009 21:07 (require 'geiser-completion) (require 'geiser-eval) (require 'geiser-custom) (require 'geiser-base) (require 'etags) ;;; Customization: (defmacro geiser-edit--define-custom-visit (var group doc) `(geiser-custom--defcustom ,var nil ,doc :group ',group :type '(choice (const :tag "Other window" window) (const :tag "Other frame" frame) (const :tag "Current window" nil)))) (geiser-edit--define-custom-visit geiser-edit-symbol-method geiser-mode "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: (defun geiser-edit--visit-file (file method) (cond ((eq method 'window) (pop-to-buffer (find-file-noselect file t))) ((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) (cdr (assoc "name" loc))) (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) (geiser-edit--to-number (cdr (assoc "line" loc)))) (defsubst geiser-edit--location-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))) (defconst geiser-edit--def-re (regexp-opt '("define" "defmacro" "define-macro" "define-syntax" "define-syntax-rule" "-define-syntax" "-define" "define*" "define-method" "define-class" "define-struct"))) (defconst geiser-edit--def-re* (regexp-opt '("define-syntaxes" "define-values"))) (defsubst geiser-edit--def-re (thing) (format "(%s +(?%s\\_>" geiser-edit--def-re (regexp-quote (format "%s" thing)))) (defsubst geiser-edit--def-re* (thing) (format "(%s +([^)]*?\\_<%s\\_>" geiser-edit--def-re* (regexp-quote (format "%s" thing)))) (defsubst geiser-edit--symbol-re (thing) (format "\\_<%s\\_>" (regexp-quote (format "%s" thing)))) (defun geiser-edit--goto-line (symbol line) (goto-char (point-min)) (if (numberp 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) (re-search-forward (geiser-edit--symbol-re symbol) nil t)) (goto-char (match-beginning 0))))) (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)) (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) (when col (beginning-of-line) (forward-char col)) (cons (current-buffer) (point)))) (defsubst geiser-edit--try-edit (symbol ret &optional method) (geiser-edit--try-edit-location symbol (geiser-eval--retort-result ret) method)) ;;; 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)) (method (button-get button 'geiser-method))) (when loc (geiser-edit--try-edit-location nil loc method)))) (defun geiser-edit--make-link (beg end file line col &optional method) (make-button beg end :type 'geiser-edit--button 'geiser-method method 'geiser-location (geiser-edit--make-location 'error file line col) 'help-echo "Go to error location")) (defconst geiser-edit--default-file-rx "^[ \t]*\\([^<>:\n\"]+\\):\\([0-9]+\\):\\([0-9]+\\)") (defun geiser-edit--buttonize-files (&optional rx no-fill) (let ((rx (or rx geiser-edit--default-file-rx)) (fill-column (- (window-width) 2))) (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) 'window) (unless no-fill (fill-region (match-end 0) (point-at-eol))))))) (defun geiser-edit--open-next (&optional n reset) (interactive) (let* ((n (or n 1)) (nxt (if (< n 0) 'backward-button 'forward-button)) (msg (if (< n 0) "previous" "next")) (n (abs n)) (p (point)) (found nil)) (when reset (goto-char (point-min))) (while (> n 0) (let ((b (ignore-errors (funcall nxt 1)))) (unless b (setq n 0)) (when (and b (eq (button-type b) 'geiser-edit--button)) (setq n (- n 1)) (when (<= n 0) (setq found t) (push-button (point)))))) (unless found (goto-char p) (error "No %s error" msg)))) ;;; Visibility (defun geiser-edit--cloak (form) (intern (format "geiser-edit-cloak-%s" form))) (defun geiser-edit--hide (form) (geiser-edit--show form) (let ((cloak (geiser-edit--cloak form))) (save-excursion (goto-char (point-min)) (while (re-search-forward (format "(%s\\b" form) nil t) (let* ((beg (match-beginning 0)) (end (progn (ignore-errors (goto-char beg) (forward-sexp)) (point)))) (when (> end beg) (overlay-put (make-overlay beg end) 'invisible cloak))))) (add-to-invisibility-spec (cons cloak t)))) (defun geiser-edit--show (form) (let ((cloak (geiser-edit--cloak form))) (remove-overlays nil nil 'invisible cloak) (remove-from-invisibility-spec (cons cloak t)))) (defun geiser-edit--show-all () (remove-overlays) (setq buffer-invisibility-spec '(t))) (defun geiser-edit--toggle-visibility (form) (if (and (listp buffer-invisibility-spec) (assoc (geiser-edit--cloak form) buffer-invisibility-spec)) (geiser-edit--show form) (geiser-edit--hide form))) ;;; Commands: (defvar geiser-edit--symbol-history nil) (defun geiser-edit-symbol (symbol &optional method marker) "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) method) (when marker (ring-insert find-tag-marker-ring marker)))) (defun geiser-edit-symbol-at-point (&optional arg) "Opens a new window visiting the definition of the symbol at point. With prefix, asks for the symbol to edit." (interactive "P") (let* ((symbol (or (and (not arg) (geiser--symbol-at-point)) (geiser-completion--read-symbol "Edit symbol: "))) (cmd `(:eval (:ge symbol-location ',symbol))) (marker (point-marker))) (condition-case err (progn (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd)) (when marker (ring-insert find-tag-marker-ring marker))) (error (condition-case nil (geiser-edit-module-at-point) (error (error (error-message-string err)))))))) (defun geiser-pop-symbol-stack () "Pop back to where \\[geiser-edit-symbol-at-point] was last invoked." (interactive) (condition-case nil (pop-tag-mark) (error "No previous location for find symbol invocation"))) (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) method))) (defun geiser-edit-module-at-point () "Opens a new window visiting the module at point." (interactive) (let ((marker (point-marker))) (geiser-edit-module (or (geiser-completion--module-at-point) (geiser-completion--read-module))) (when marker (ring-insert find-tag-marker-ring marker)))) (provide 'geiser-edit) geiser-0.8.1/geiser-log.el0000644000175000017500000000601212607252416013465 0ustar jaojao;; geiser-log.el -- logging utilities ;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sat Feb 07, 2009 12:07 ;; Some utilities for maintaining a simple log buffer, mainly for ;; debugging purposes. (require 'geiser-popup) (require 'geiser-base) (require 'comint) ;;; Customization: (defvar geiser-log--buffer-name "*geiser messages*" "Name of the Geiser log buffer.") (defvar geiser-log--max-buffer-size 32000 "Maximum size of the Geiser messages log.") (defvar geiser-log--max-message-size 2048 "Maximum size of individual Geiser log messages.") (defvar geiser-log-verbose-p nil "Log purely informational messages. Useful for debugging.") (defvar geiser-log--inhibit-p nil "Set this to t to inhibit all log messages") ;;; Log buffer and mode: (define-derived-mode geiser-messages-mode fundamental-mode "Geiser Messages" "Simple mode for Geiser log messages buffer." (buffer-disable-undo) (add-hook 'after-change-functions '(lambda (b e len) (let ((inhibit-read-only t)) (when (> b geiser-log--max-buffer-size) (delete-region (point-min) b)))) nil t) (setq buffer-read-only t)) (geiser-popup--define log geiser-log--buffer-name geiser-messages-mode) ;;; Logging functions: (defun geiser-log--msg (type &rest args) (unless geiser-log--inhibit-p (geiser-log--with-buffer (goto-char (point-max)) (insert (geiser--shorten-str (format "\n%s: %s\n" type (apply 'format args)) geiser-log--max-message-size))))) (defsubst geiser-log--warn (&rest args) (apply 'geiser-log--msg 'WARNING args)) (defsubst geiser-log--error (&rest args) (apply 'geiser-log--msg 'ERROR args)) (defsubst geiser-log--info (&rest args) (when geiser-log-verbose-p (apply 'geiser-log--msg 'INFO args) "")) ;;; User commands: (defun geiser-show-logs (&optional arg) "Show Geiser log messages. With prefix, activates all logging levels." (interactive "P") (when arg (setq geiser-log-verbose-p t)) (geiser-log--pop-to-buffer)) (defun geiser-log-clear () "Clean all logs." (interactive) (geiser-log--with-buffer (delete-region (point-min) (point-max)))) (defun geiser-log-toggle-verbose () "Toggle verbose logs" (interactive) (setq geiser-log-verbose-p (not geiser-log-verbose-p)) (message "Geiser verbose logs %s" (if geiser-log-verbose-p "enabled" "disabled"))) (defun geiser-log--deactivate () (interactive) (setq geiser-log-verbose-p nil) (when (eq (current-buffer) (geiser-log--buffer)) (View-quit))) (define-key geiser-messages-mode-map "c" 'geiser-log-clear) (define-key geiser-messages-mode-map "Q" 'geiser-log--deactivate) (provide 'geiser-log) geiser-0.8.1/geiser-custom.el0000644000175000017500000000373012607252416014222 0ustar jaojao;;; geiser-custom.el -- customization utilities ;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sat Feb 14, 2009 21:49 (require 'font-lock) (require 'geiser-base) ;;; Customization group: (defgroup geiser nil "Geiser framework for Scheme-Emacs interaction." :group 'languages) ;;; Faces: (defgroup geiser-faces nil "Faces used by Geiser." :group 'geiser :group 'faces) (defmacro geiser-custom--defface (face def group doc) (declare (doc-string 4)) (let ((face (intern (format "geiser-font-lock-%s" face)))) `(defface ,face (face-default-spec ,def) ,(format "Face for %s." doc) :group ',group :group 'geiser-faces))) (put 'geiser-custom--defface 'lisp-indent-function 1) ;;; Reload support: (defvar geiser-custom--memoized-vars nil) (defun geiser-custom--memoize (name) (add-to-list 'geiser-custom--memoized-vars name)) (defmacro geiser-custom--defcustom (name &rest body) (declare (doc-string 3) (debug (name body))) `(progn (geiser-custom--memoize ',name) (defcustom ,name ,@body))) (defun geiser-custom--memoized-state () (let ((result)) (dolist (name geiser-custom--memoized-vars result) (when (boundp name) (push (cons name (symbol-value name)) result))))) (put 'geiser-custom--defcustom 'lisp-indent-function 2) (defconst geiser-custom-font-lock-keywords (eval-when-compile `((,(concat "(\\(geiser-custom--\\(?:defcustom\\|defface\\)\\)\\_>" "[ \t'\(]*" "\\(\\(?:\\sw\\|\\s_\\)+\\)?") (1 font-lock-keyword-face) (2 font-lock-variable-name-face nil t))))) (font-lock-add-keywords 'emacs-lisp-mode geiser-custom-font-lock-keywords) (provide 'geiser-custom) geiser-0.8.1/geiser-racket.el0000644000175000017500000003307212607252416014163 0ustar jaojao;; geiser-racket.el -- geiser support for Racket scheme ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sat Apr 25, 2009 21:13 (require 'geiser-edit) (require 'geiser-doc) (require 'geiser-eval) (require 'geiser-image) (require 'geiser-syntax) (require 'geiser-custom) (require 'geiser-base) (require 'geiser) (require 'compile) (eval-when-compile (require 'cl)) ;;; Customization: (defgroup geiser-racket nil "Customization for Geiser's Racket flavour." :group 'geiser) (geiser-custom--defcustom geiser-racket-binary (cond ((eq system-type 'windows-nt) "Racket.exe") (t "racket")) "Name to use to call the racket executable when starting a REPL." :type '(choice string (repeat string)) :group 'geiser-racket) (geiser-custom--defcustom geiser-racket-gracket-binary (cond ((eq system-type 'windows-nt) "GRacket-text.exe") (t "gracket-text")) "Name to use to call the gracket executable when starting a REPL. This executable is used by `run-gracket', and, if `geiser-racket-use-gracket-p' is set to t, by `run-racket'." :type '(choice string (repeat string)) :group 'geiser-racket) (geiser-custom--defcustom geiser-racket-collects nil "A list of paths to be added to racket's collection directories." :type '(repeat file) :group 'geiser-racket) (geiser-custom--defcustom geiser-racket-init-file "~/.racket-geiser" "Initialization file with user code for the racket REPL." :type 'string :group 'geiser-racket) (geiser-custom--defcustom geiser-racket-use-gracket-p nil "Whether to use the gracket binary to start Racket REPLs." :type 'boolean :group 'geiser-racket) (geiser-custom--defcustom geiser-racket-extra-keywords '("provide" "require" "unless" "when" "with-handlers") "Extra keywords highlighted in Racket buffers." :type '(repeat string) :group 'geiser-racket) (geiser-custom--defcustom geiser-racket-case-sensitive-p t "Non-nil means keyword highlighting is case-sensitive." :type 'boolean :group 'geiser-racket) ;;; REPL support: (defsubst geiser-racket--real-binary () (if geiser-racket-use-gracket-p geiser-racket-gracket-binary geiser-racket-binary)) (defun geiser-racket--binary () (let ((binary (geiser-racket--real-binary))) (if (listp binary) (car binary) binary))) (defun geiser-racket--parameters () "Return a list with all parameters needed to start racket. This function uses `geiser-racket-init-file' if it exists." (let ((init-file (and (stringp geiser-racket-init-file) (expand-file-name geiser-racket-init-file))) (binary (geiser-racket--real-binary)) (rackdir (expand-file-name "racket/" geiser-scheme-dir))) `("-i" "-q" "-S" ,rackdir ,@(apply 'append (mapcar (lambda (p) (list "-S" p)) geiser-racket-collects)) ,@(and (listp binary) (cdr binary)) ,@(and init-file (file-readable-p init-file) (list "-f" init-file)) "-f" ,(expand-file-name "geiser/startup.rkt" rackdir)))) (defconst geiser-racket--prompt-regexp "\\(mzscheme\\|racket\\)@[^ ]*> ") ;;; Remote REPLs (defun connect-to-racket () "Start a Racket REPL connected to a remote process. The remote process needs to be running a REPL server started using start-geiser, a procedure in the geiser/server module." (interactive) (geiser-connect 'racket)) ;;; Evaluation support: (defconst geiser-racket--module-re "^(module[+*]? +\\([^ ]+\\)\\W+\\([^ ]+\\)?") (defun geiser-racket--explicit-module () (save-excursion (geiser-syntax--pop-to-top) (and (looking-at geiser-racket--module-re) (let ((mod (match-string-no-properties 1)) (lang (match-string-no-properties 2))) (cons (geiser-syntax--form-from-string mod) (geiser-syntax--form-from-string lang)))))) (defun geiser-racket--language () (or (cdr (geiser-racket--explicit-module)) (save-excursion (goto-char (point-min)) (if (re-search-forward "^#lang +\\([^ ]+\\)" nil t) (geiser-syntax--form-from-string (match-string-no-properties 1)))) "#f")) (defun geiser-racket--implicit-module (&optional pos) (save-excursion (goto-char (point-min)) (when (re-search-forward "^#lang " nil t) (if pos (progn (end-of-line) (list (point))) (buffer-file-name))))) (defun geiser-racket--eval-bounds () (geiser-racket--implicit-module t)) (defun geiser-racket--find-module () (let ((bf (geiser-racket--implicit-module)) (sub (car (geiser-racket--explicit-module)))) (cond ((and (not bf) (not sub)) nil) ((and (not bf) sub) sub) (sub `(submod (file ,bf) ,sub)) (t bf)))) (defun geiser-racket--enter-command (module) (when (or (stringp module) (listp module)) (cond ((zerop (length module)) ",enter #f") ((or (listp module) (file-name-absolute-p module)) (format ",enter %S" module)) (t (format ",enter %s" module))))) (defun geiser-racket--geiser-procedure (proc &rest args) (case proc ((eval compile) (format ",geiser-eval %s %s %s" (or (car args) "#f") (geiser-racket--language) (mapconcat 'identity (cdr args) " "))) ((load-file compile-file) (format ",geiser-load %S" (geiser-racket--find-module))) ((no-values) ",geiser-no-values") (t (format ",apply geiser:%s (%s)" proc (mapconcat 'identity args " "))))) (defun geiser-racket--get-module (&optional module) (cond ((null module) (or (geiser-racket--find-module) :f)) ((symbolp module) module) ((and (stringp module) (file-name-absolute-p module)) module) ((stringp module) (make-symbol module)) (t nil))) (defun geiser-racket--symbol-begin (module) (save-excursion (skip-syntax-backward "^'-()>") (point))) (defun geiser-racket--import-command (module) (and (stringp module) (not (zerop (length module))) (format "(require %s)" module))) (defun geiser-racket--exit-command () (comint-send-eof) (get-buffer-process (current-buffer))) (defconst geiser-racket--binding-forms '("for" "for/list" "for/hash" "for/hasheq" "for/and" "for/or" "for/lists" "for/first" "for/last" "for/fold" "for:" "for/list:" "for/hash:" "for/hasheq:" "for/and:" "for/or:" "for/lists:" "for/first:" "for/last:" "for/fold:" "define-syntax-rule")) (defconst geiser-racket--binding-forms* '("for*" "for*/list" "for*/lists" "for*/hash" "for*/hasheq" "for*/and" "for*/or" "for*/first" "for*/last" "for*/fold" "for*:" "for*/list:" "for*/lists:" "for*/hash:" "for*/hasheq:" "for*/and:" "for*/or:" "for*/first:" "for*/last:" "for*/fold:")) ;;; External help (defsubst geiser-racket--get-help (symbol module) (geiser-eval--send/wait `(:scm ,(format ",help %s %s" symbol module)))) (defun geiser-racket--external-help (id module) (message "Looking up manual for '%s'..." id) (let* ((ret (geiser-racket--get-help id (format "%S" module))) (out (geiser-eval--retort-output ret)) (ret (if (and out (string-match " but provided by:\n +\\(.+\\)\n" out)) (geiser-racket--get-help id (match-string 1 out)) ret))) (unless (string-match "^Sending to web browser.+" (geiser-eval--retort-output ret)) (minibuffer-message "%s not found" (current-message))) t)) ;;; Error display (defconst geiser-racket--file-rxs '(nil "path:\"?\\([^>\"\n]+\\)\"?>" "module: \"\\([^>\"\n]+\\)\"")) (defconst geiser-racket--geiser-file-rx (format "^ *%s/?racket/geiser" (regexp-quote geiser-scheme-dir))) (defun geiser-racket--purge-trace () (save-excursion (while (re-search-forward geiser-racket--geiser-file-rx nil t) (kill-whole-line)))) (defun geiser-racket--display-error (module key msg) (when key (insert "Error: ") (geiser-doc--insert-button key nil 'racket) (newline 2)) (when msg (let ((p (point))) (insert msg) (let ((end (point))) (goto-char p) (when key (geiser-racket--purge-trace)) (mapc 'geiser-edit--buttonize-files geiser-racket--file-rxs) (goto-char end) (newline)))) (if (and msg (string-match "\\(.+\\)$" msg)) (match-string 1 msg) key)) ;;; Trying to ascertain whether a buffer is racket code: (defun geiser-racket--guess () (or (save-excursion (goto-char (point-min)) (re-search-forward "#lang " nil t)) (geiser-racket--explicit-module))) ;;; Keywords and syntax (defvar geiser-racket-font-lock-forms '(("^#lang\\>" . 0) ("\\[\\(else\\)\\>" . 1) ("(\\(define/match\\)\\W+[[(]?\\(\\w+\\)+\\b" (1 font-lock-keyword-face) (2 font-lock-function-name-face)))) (defun geiser-racket--keywords () (append geiser-racket-font-lock-forms (geiser-syntax--simple-keywords geiser-racket-extra-keywords))) (geiser-syntax--scheme-indent (begin0 1) (case-lambda: 0) (class* defun) (compound-unit/sig 0) (define: defun) (for 1) (for* 1) (for*/and 1) (for*/first 1) (for*/fold 2) (for*/hash 1) (for*/hasheq 1) (for*/hasheqv 1) (for*/last 1) (for*/list 1) (for*/lists 2) (for*/or 1) (for*/product 1) (for*/set 1) (for*/seteq 1) (for*/seteqv 1) (for*/sum 1) (for*/vector 1) (for/and 1) (for/first 1) (for/fold 2) (for/hash 1) (for/hasheq 1) (for/hasheqv 1) (for/last 1) (for/list 1) (for/lists 2) (for/or 1) (for/product 1) (for/set 1) (for/seteq 1) (for/seteqv 1) (for/sum 1) (for/vector 1) (instantiate 2) (interface 1) (lambda/kw 1) (lambda: 1) (let*-values: 1) (let+ 1) (let-values: 1) (let/cc: 1) (let: 1) (letrec-values: 1) (letrec: 1) (local 1) (match-let 1) (match-let-values 1) (match/values 1) (mixin 2) (module defun) (module+ defun) (module* defun) (parameterize-break 1) (quasisyntax/loc 1) (send* 1) (splicing-let 1) (splicing-let-syntax 1) (splicing-let-syntaxes 1) (splicing-let-values 1) (splicing-letrec 1) (splicing-letrec-syntax 1) (splicing-letrec-syntaxes 1) (splicing-letrec-syntaxes+values 1) (splicing-letrec-values 1) (splicing-local 1) (struct 1) (syntax-id-rules defun) (syntax/loc 1) (type-case defun) (unit defun) (unit/sig 2) (with-handlers 1) (with-handlers: 1)) ;;; REPL Startup (defvar geiser-racket-minimum-version "5.3") (defun geiser-racket--version (binary) (shell-command-to-string (format "%s -e '(display (version))'" binary))) (defvar geiser-racket--image-cache-dir nil) (defun geiser-racket--startup (remote) (set (make-local-variable 'compilation-error-regexp-alist) `(("^ *\\([^:(\t\n]+\\):\\([0-9]+\\):\\([0-9]+\\):" 1 2 3))) (compilation-setup t) (if geiser-image-cache-dir (geiser-eval--send/wait `(:eval (image-cache ,geiser-image-cache-dir) geiser/user)) (setq geiser-racket--image-cache-dir (geiser-eval--send/result '(:eval (image-cache) geiser/user))))) (defun geiser-racket--image-cache-dir () (or geiser-image-cache-dir geiser-racket--image-cache-dir)) ;;; Additional commands (defvar geiser-racket--submodule-history ()) (defun geiser-racket--submodule-form (name) (format "module[+*]? %s" (cond ((eq 1 name) "") ((numberp name) (read-string "Submodule name: " nil 'geiser-racket--submodule-history)) ((stringp name) name) (t "")))) (defun geiser-racket-toggle-submodules (&optional name) "Toggle visibility of submodule forms. Use a prefix to be asked for a submodule name." (interactive "p") (geiser-edit--toggle-visibility (geiser-racket--submodule-form name))) (defun geiser-racket-show-submodules (&optional name) "Unconditionally shows all submodule forms. Use a prefix to be asked for a submodule name." (interactive "p") (cond ((eq 1 name) (geiser-edit--show-all)) (t (geiser-edit--show (geiser-racket--submodule-form name))))) (defun geiser-racket-hide-submodules (&optional name) "Unconditionally hides all visible submodules. Use a prefix to be asked for a submodule name." (interactive "p") (geiser-edit--hide (geiser-racket--submodule-form name))) ;;; Implementation definition: (define-geiser-implementation racket (unsupported-procedures '(callers callees generic-methods)) (binary geiser-racket--binary) (minimum-version geiser-racket-minimum-version) (version-command geiser-racket--version) (arglist geiser-racket--parameters) (repl-startup geiser-racket--startup) (prompt-regexp geiser-racket--prompt-regexp) (marshall-procedure geiser-racket--geiser-procedure) (find-module geiser-racket--get-module) (enter-command geiser-racket--enter-command) (import-command geiser-racket--import-command) (exit-command geiser-racket--exit-command) (find-symbol-begin geiser-racket--symbol-begin) (eval-bounds geiser-racket--eval-bounds) (display-error geiser-racket--display-error) (external-help geiser-racket--external-help) (check-buffer geiser-racket--guess) (keywords geiser-racket--keywords) (image-cache-dir geiser-racket--image-cache-dir) (case-sensitive geiser-racket-case-sensitive-p) (binding-forms geiser-racket--binding-forms) (binding-forms* geiser-racket--binding-forms*)) (geiser-impl--add-to-alist 'regexp "\\.ss$" 'racket t) (geiser-impl--add-to-alist 'regexp "\\.rkt$" 'racket t) (defun run-gracket () "Start the Racket REPL using gracket instead of plain racket." (interactive) (let ((geiser-racket-use-gracket-p t)) (run-racket))) (provide 'geiser-racket) geiser-0.8.1/geiser-doc.el0000644000175000017500000004207212607252416013457 0ustar jaojao;;; geiser-doc.el -- accessing scheme-provided documentation ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sat Feb 14, 2009 14:09 (require 'geiser-edit) (require 'geiser-impl) (require 'geiser-completion) (require 'geiser-autodoc) (require 'geiser-eval) (require 'geiser-syntax) (require 'geiser-menu) (require 'geiser-popup) (require 'geiser-custom) (require 'geiser-base) (require 'button) ;;; Customization: (defgroup geiser-doc nil "Options for documentation buffers." :group 'geiser) (geiser-custom--defface doc-title 'bold geiser-doc "article titles in documentation buffers") (geiser-custom--defface doc-link 'link geiser-doc "links in documentation buffers") (geiser-custom--defface doc-button 'button geiser-doc "buttons in documentation buffers") ;;; Implementation (geiser-impl--define-caller geiser-doc--external-help external-help (symbol module) "By default, Geiser will display help about an identifier in a help buffer, after collecting the associated signature and docstring. You can provide an alternative function for displaying help (e.g. browse an HTML page) implementing this method.") ;;; Documentation browser history: (defvar geiser-doc-history-size 50) (defvar geiser-doc--history nil) (defun geiser-doc--make-history () (list nil ; current (make-ring geiser-doc-history-size) ; previous (make-ring geiser-doc-history-size))) ; next (setq geiser-doc--history (geiser-doc--make-history)) (eval-after-load "session" '(add-to-list 'session-globals-exclude 'geiser-doc--history)) (defsubst geiser-doc--history-current () (car geiser-doc--history)) (defsubst geiser-doc--history-previous-link () (ring-ref (cadr geiser-doc--history) 0)) (defsubst geiser-doc--history-next-link () (ring-ref (caddr geiser-doc--history) 0)) (defun geiser-doc--history-push (link) (unless (or (null link) (equal link (geiser-doc--history-current))) (when (not (null (geiser-doc--history-current))) (let ((next (geiser-doc--history-next))) (unless (equal link next) (when next (geiser-doc--history-previous)) (ring-insert (nth 1 geiser-doc--history) (car geiser-doc--history))))) (setcar geiser-doc--history link)) link) (defsubst geiser-doc--history-next-p () (not (ring-empty-p (nth 2 geiser-doc--history)))) (defun geiser-doc--history-next (&optional forget-current) (when (geiser-doc--history-next-p) (when (and (car geiser-doc--history) (not forget-current)) (ring-insert (nth 1 geiser-doc--history) (car geiser-doc--history))) (setcar geiser-doc--history (ring-remove (nth 2 geiser-doc--history) 0)))) (defsubst geiser-doc--history-previous-p () (not (ring-empty-p (nth 1 geiser-doc--history)))) (defun geiser-doc--history-previous (&optional forget-current) (when (geiser-doc--history-previous-p) (when (and (car geiser-doc--history) (not forget-current)) (ring-insert (nth 2 geiser-doc--history) (car geiser-doc--history))) (setcar geiser-doc--history (ring-remove (nth 1 geiser-doc--history) 0)))) ;;; Links (defsubst geiser-doc--make-link (target module impl) (list target module impl)) (defsubst geiser-doc--link-target (link) (nth 0 link)) (defsubst geiser-doc--link-module (link) (nth 1 link)) (defsubst geiser-doc--link-impl (link) (nth 2 link)) (defun geiser-doc--follow-link (link) (let ((target (geiser-doc--link-target link)) (module (geiser-doc--link-module link)) (impl (geiser-doc--link-impl link))) (when (and (or target module) impl) (with--geiser-implementation impl (if (null target) (geiser-doc-module module impl) (let ((geiser-eval--get-module-function (lambda (x) module))) (geiser-doc-symbol target module impl))))))) (make-variable-buffer-local (defvar geiser-doc--buffer-link nil)) (defsubst geiser-doc--implementation () (geiser-doc--link-impl geiser-doc--buffer-link)) (defun geiser-doc--button-action (button) (let ((link (button-get button 'geiser-link))) (when link (geiser-doc--follow-link link)))) (define-button-type 'geiser-doc--button 'action 'geiser-doc--button-action 'follow-link t) (defun geiser-doc--make-module-button (beg end module impl) (let ((link (geiser-doc--make-link nil module impl)) (help (format "Help for module %s" module))) (make-text-button beg end :type 'geiser-doc--button 'face 'geiser-font-lock-doc-link 'geiser-link link 'help-echo help))) (defun geiser-doc--insert-button (target module impl &optional sign) (let ((link (geiser-doc--make-link target module impl)) (text (format "%s" (or (and sign (geiser-autodoc--str* sign)) target module))) (help (format "%smodule %s" (if target (format "%s in " target) "") (or module "")))) (insert-text-button text :type 'geiser-doc--button 'face 'geiser-font-lock-doc-link 'geiser-link link 'help-echo help))) (defun geiser-doc--xbutton-action (button) (when geiser-doc--buffer-link (let ((kind (or (button-get button 'x-kind) 'source)) (target (geiser-doc--link-target geiser-doc--buffer-link)) (module (geiser-doc--link-module geiser-doc--buffer-link)) (impl (geiser-doc--link-impl geiser-doc--buffer-link))) (with--geiser-implementation impl (cond ((eq kind 'source) (if target (geiser-edit-symbol target nil (point-marker)) (geiser-edit-module module))) ((eq kind 'manual) (geiser-doc--external-help impl (or target module) module))))))) (define-button-type 'geiser-doc--xbutton 'action 'geiser-doc--xbutton-action 'face 'geiser-font-lock-doc-button 'follow-link t) (defun geiser-doc--insert-xbutton (&optional manual) (let ((label (if manual "[manual]" "[source]")) (help (if manual "Look up in Scheme manual" "Go to definition"))) (insert-text-button label :type 'geiser-doc--xbutton 'help-echo help 'x-kind (if manual 'manual 'source)))) (defun geiser-doc--insert-xbuttons (impl) (when (geiser-impl--method 'external-help impl) (geiser-doc--insert-xbutton t) (insert " ")) (geiser-doc--insert-xbutton)) (defun geiser-doc--insert-nav-button (next) (let* ((lnk (if next (geiser-doc--history-next-link) (geiser-doc--history-previous-link))) (what (geiser-doc--link-target lnk)) (what (or what (geiser-doc--link-module lnk))) (action (if next '(lambda (b) (geiser-doc-next)) '(lambda (b) (geiser-doc-previous))))) (insert-text-button (if next "[forward]" "[back]") 'action action 'help-echo (format "Previous help item (%s)" what) 'face 'geiser-font-lock-doc-button 'follow-link t))) ;;; Auxiliary functions: (defun geiser-doc--manual-available-p () (geiser-impl--method 'external-help geiser-impl--implementation)) (defun geiser-doc--module (&optional mod impl) (let ((impl (or impl (geiser-doc--link-impl geiser-doc--buffer-link))) (mod (or mod (geiser-doc--link-module geiser-doc--buffer-link)))) (geiser-impl--call-method 'find-module impl mod))) (defun geiser-doc--insert-title (title) (let ((p (point))) (insert (format "%s" title)) (fill-paragraph nil) (let ((indent-line-function 'lisp-indent-line)) (indent-region p (point))) (put-text-property p (point) 'face 'geiser-font-lock-doc-title) (newline))) (defun geiser-doc--insert-list (title lst module impl) (when lst (geiser-doc--insert-title title) (newline) (dolist (w lst) (let ((name (car w)) (signature (cdr (assoc "signature" w))) (info (cdr (assoc "info" w)))) (insert "\t- ") (if module (geiser-doc--insert-button name module impl signature) (geiser-doc--insert-button nil name impl)) (when info (insert (format " %s" info))) (newline))) (newline))) (defun geiser-doc--insert-footer (impl) (newline 2) (geiser-doc--insert-xbuttons impl) (let* ((prev (and (geiser-doc--history-previous-p) 8)) (nxt (and (geiser-doc--history-next-p) 10)) (len (max 1 (- (window-width) (- (point) (line-beginning-position)) (or prev 0) (or nxt 0))))) (when (or prev nxt) (insert (make-string len ?\ ))) (when prev (geiser-doc--insert-nav-button nil) (insert " ")) (when nxt (geiser-doc--insert-nav-button t)))) ;;; Commands: (defun geiser-doc--get-docstring (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)) :f))) (defun geiser-doc--buttonize-modules (impl) (save-excursion (goto-char (point-min)) (while (re-search-forward "in module \\([^.\n]+\\)[.\n ]" nil t) (geiser-doc--make-module-button (match-beginning 1) (match-end 1) (geiser-doc--module (match-string 1) impl) impl)))) (defun geiser-doc--render-docstring (docstring symbol &optional module impl) (erase-buffer) (geiser-doc--insert-title (geiser-autodoc--str* (cdr (assoc "signature" docstring)))) (newline) (insert (or (cdr (assoc "docstring" docstring)) "")) (geiser-doc--buttonize-modules impl) (setq geiser-doc--buffer-link (geiser-doc--history-push (geiser-doc--make-link symbol module impl))) (geiser-doc--insert-footer impl) (goto-char (point-min))) (defun geiser-doc-symbol (symbol &optional module impl) (let* ((impl (or impl geiser-impl--implementation)) (module (geiser-doc--module (or module (geiser-eval--get-module)) impl))) (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 (geiser-doc--render-docstring ds symbol module impl)) (geiser-doc--pop-to-buffer))))) (defun geiser-doc-symbol-at-point (&optional arg) "Get docstring for symbol at point. With prefix argument, ask for symbol (with completion)." (interactive "P") (let ((symbol (or (and (not arg) (geiser--symbol-at-point)) (geiser-completion--read-symbol "Symbol: " (geiser--symbol-at-point))))) (when symbol (geiser-doc-symbol symbol)))) (defun geiser-doc-look-up-manual (&optional arg) "Look up manual for symbol at point. With prefix argument, ask for the lookup symbol (with completion)." (interactive "P") (unless (geiser-doc--manual-available-p) (error "No manual available")) (let ((symbol (or (and (not arg) (geiser--symbol-at-point)) (geiser-completion--read-symbol "Symbol: ")))) (geiser-doc--external-help geiser-impl--implementation symbol (geiser-eval--get-module)))) (defconst geiser-doc--sections '(("Procedures:" "procs") ("Syntax:" "syntax") ("Variables:" "vars") ("Submodules:" "modules" t))) (defconst geiser-doc--sections-re (format "^%s\n" (regexp-opt (mapcar 'car geiser-doc--sections)))) (defun geiser-doc-module (&optional module impl) "Display information about a given module." (interactive) (let* ((impl (or impl geiser-impl--implementation)) (module (geiser-doc--module (or module (geiser-completion--read-module)) impl)) (msg (format "Retrieving documentation for %s ..." module)) (exports (progn (message "%s" msg) (geiser-doc--get-module-exports module)))) (if (not exports) (message "No information available for %s" module) (geiser-doc--with-buffer (erase-buffer) (geiser-doc--insert-title (format "%s" module)) (newline) (dolist (g geiser-doc--sections) (geiser-doc--insert-list (car g) (cdr (assoc (cadr g) exports)) (and (not (cddr g)) module) impl)) (setq geiser-doc--buffer-link (geiser-doc--history-push (geiser-doc--make-link nil module impl))) (geiser-doc--insert-footer impl) (goto-char (point-min))) (message "%s done" msg) (geiser-doc--pop-to-buffer)))) (defun geiser-doc-next-section () "Move to next section in this page." (interactive) (forward-line) (re-search-forward geiser-doc--sections-re nil t) (forward-line -1)) (defun geiser-doc-previous-section () "Move to previous section in this page." (interactive) (re-search-backward geiser-doc--sections-re nil t)) (defun geiser-doc-next (&optional forget-current) "Go to next page in documentation browser. With prefix, the current page is deleted from history." (interactive "P") (let ((link (geiser-doc--history-next forget-current))) (unless link (error "No next page")) (geiser-doc--follow-link link))) (defun geiser-doc-previous (&optional forget-current) "Go to previous page in documentation browser. With prefix, the current page is deleted from history." (interactive "P") (let ((link (geiser-doc--history-previous forget-current))) (unless link (error "No previous page")) (geiser-doc--follow-link link))) (defun geiser-doc-kill-page () "Kill current page if a previous or next one exists." (interactive) (condition-case nil (geiser-doc-previous t) (error (geiser-doc-next t)))) (defun geiser-doc-refresh () "Refresh the contents of current page." (interactive) (when geiser-doc--buffer-link (geiser-doc--follow-link geiser-doc--buffer-link))) (defun geiser-doc-clean-history () "Clean up the document browser history." (interactive) (when (y-or-n-p "Clean browsing history? ") (setq geiser-doc--history (geiser-doc--make-history)) (geiser-doc-refresh)) (message "")) ;;; Documentation browser and mode: (defun geiser-doc-edit-symbol-at-point () "Open definition of symbol at point." (interactive) (let* ((impl (geiser-doc--implementation)) (module (geiser-doc--module))) (unless (and impl module) (error "I don't know what module this buffer refers to.")) (with--geiser-implementation impl (geiser-edit-symbol-at-point)))) (defvar geiser-doc-mode-map nil) (setq geiser-doc-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) (set-keymap-parent map button-buffer-map) map)) (defun geiser-doc-switch-to-repl () (interactive) (switch-to-geiser nil nil (current-buffer))) (geiser-menu--defmenu doc geiser-doc-mode-map ("Next link" ("n") forward-button) ("Previous link" ("p") backward-button) ("Next section" ("N") geiser-doc-next-section) ("Previous section" ("P") geiser-doc-previous-section) -- ("Next page" ("f") geiser-doc-next "Next item" :enable (geiser-doc--history-next-p)) ("Previous page" ("b") geiser-doc-previous "Previous item" :enable (geiser-doc--history-previous-p)) -- ("Go to REPL" ("z" "\C-cz" "\C-c\C-z") geiser-doc-switch-to-repl) ("Refresh" ("g" "r") geiser-doc-refresh "Refresh current page") -- ("Edit symbol" ("." "\M-.") geiser-doc-edit-symbol-at-point :enable (geiser--symbol-at-point)) -- ("Kill item" "k" geiser-doc-kill-page "Kill this page") ("Clear history" "c" geiser-doc-clean-history) -- (custom "Browser options" geiser-doc) -- ("Quit" nil View-quit)) (defun geiser-doc-mode () "Major mode for browsing scheme documentation. \\{geiser-doc-mode-map}" (interactive) (kill-all-local-variables) (buffer-disable-undo) (setq truncate-lines t) (use-local-map geiser-doc-mode-map) (set-syntax-table scheme-mode-syntax-table) (setq mode-name "Geiser Doc") (setq major-mode 'geiser-doc-mode) (setq geiser-eval--get-module-function 'geiser-doc--module) (setq buffer-read-only t)) (geiser-popup--define doc "*Geiser documentation*" geiser-doc-mode) (provide 'geiser-doc) geiser-0.8.1/geiser-impl.el0000644000175000017500000003230612607252416013652 0ustar jaojao;; geiser-impl.el -- generic support for scheme implementations ;; Copyright (C) 2009, 2010, 2012, 2013, 2015 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should ;; have received a copy of the license along with this program. If ;; not, see . ;; Start date: Sat Mar 07, 2009 23:32 (require 'geiser-custom) (require 'geiser-base) (require 'help-fns) ;;; Customization: (defgroup geiser-implementation nil "Generic support for multiple Scheme implementations." :group 'geiser) (geiser-custom--defcustom geiser-default-implementation nil "Symbol naming the default Scheme implementation." :type 'symbol :group 'geiser-implementation) (geiser-custom--defcustom geiser-active-implementations '(guile racket chicken) "List of active installed Scheme implementations." :type '(repeat symbol) :group 'geiser-implementation) (geiser-custom--defcustom geiser-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-implementation) ;;; Implementation registry: (defvar geiser-impl--registry nil) (defvar geiser-impl--load-files nil) (defvar geiser-impl--method-docs nil) (defvar geiser-impl--local-methods nil) (defvar geiser-impl--local-variables nil) (geiser-custom--memoize 'geiser-impl--load-files) (make-variable-buffer-local (defvar geiser-impl--implementation nil)) (defsubst geiser-impl--impl-str (&optional impl) (let ((impl (or impl geiser-impl--implementation))) (and impl (capitalize (format "%s" impl))))) (defsubst geiser-impl--feature (impl) (intern (format "geiser-%s" impl))) (defsubst geiser-impl--load-impl (impl) (require (geiser-impl--feature impl) (cdr (assq impl geiser-impl--load-files)) t)) (defsubst geiser-impl--methods (impl) (cdr (assq impl geiser-impl--registry))) (defun geiser-impl--method (method &optional impl) (let ((impl (or impl geiser-impl--implementation geiser-default-implementation))) (cadr (assq method (geiser-impl--methods impl))))) (defun geiser-impl--call-method (method impl &rest args) (let ((fun (geiser-impl--method method impl))) (when (functionp fun) (apply fun args)))) (defun geiser-impl--method-doc (method doc user) (let* ((user (if user (format " Used via `%s'." user) "")) (extra-doc (format "%s%s" doc user))) (add-to-list 'geiser-impl--method-docs (cons method extra-doc)) (setq geiser-impl--method-docs (sort geiser-impl--method-docs (lambda (a b) (string< (symbol-name (car a)) (symbol-name (car b)))))) (put method 'function-documentation doc))) (defun geiser-implementation-help () "Shows a buffer with help on defining new supported Schemes." (interactive) (help-setup-xref (list #'geiser-implementation-help) t) (save-excursion (with-help-window (help-buffer) (princ "Geiser: supporting new Scheme implementations.\n\n") (princ "Use `define-geiser-implementation' to define ") (princ "new implementations") (princ "\n\n (define-geiser-implementation NAME &rest METHODS)\n\n") (princ (documentation 'define-geiser-implementation)) (princ "\n\nMethods used to define an implementation:\n\n") (dolist (m geiser-impl--method-docs) (let ((p (with-current-buffer (help-buffer) (point)))) (princ (format "%s: " (car m))) (princ (cdr m)) (with-current-buffer (help-buffer) (fill-region-as-paragraph p (point))) (princ "\n\n"))) (with-current-buffer standard-output (buffer-string))))) (defun geiser-impl--register-local-method (var-name method fallback doc) (add-to-list 'geiser-impl--local-methods (list var-name method fallback)) (geiser-impl--method-doc method doc var-name) (put var-name 'function-documentation doc)) (defun geiser-impl--register-local-variable (var-name method fallback doc) (add-to-list 'geiser-impl--local-variables (list var-name method fallback)) (geiser-impl--method-doc method doc var-name) (put var-name 'variable-documentation doc)) (defmacro geiser-impl--define-caller (fun-name method arglist doc) (let ((impl (make-symbol "implementation-name"))) `(progn (defun ,fun-name ,(cons impl arglist) ,doc (geiser-impl--call-method ',method ,impl ,@arglist)) (geiser-impl--method-doc ',method ,doc ',fun-name)))) (put 'geiser-impl--define-caller 'lisp-indent-function 3) (defun geiser-impl--register (file impl methods) (let ((current (assq impl geiser-impl--registry))) (if current (setcdr current methods) (push (cons impl methods) geiser-impl--registry)) (push (cons impl file) geiser-impl--load-files))) (defsubst geiser-activate-implementation (impl) (add-to-list 'geiser-active-implementations impl)) (defsubst geiser-deactivate-implementation (impl) (setq geiser-active-implementations (delq impl geiser-active-implementations))) (defsubst geiser-impl--active-p (impl) (memq impl geiser-active-implementations)) ;;; Defining implementations: (defun geiser-impl--normalize-method (m) (when (and (listp m) (= 2 (length m)) (symbolp (car m))) (if (functionp (cadr m)) m `(,(car m) (lambda (&rest) ,(cadr m)))))) (defun geiser-impl--define (file name parent methods) (let* ((methods (mapcar 'geiser-impl--normalize-method methods)) (methods (delq nil methods)) (inherited-methods (and parent (geiser-impl--methods parent))) (methods (append methods (dolist (m methods inherited-methods) (setq inherited-methods (assq-delete-all m inherited-methods)))))) (geiser-impl--register file name methods))) (defmacro define-geiser-implementation (name &rest methods) "Defines a new supported Scheme implementation. NAME can be either an unquoted symbol naming the implementation, or a two-element list (NAME PARENT), with PARENT naming another registered implementation from which to borrow methods not defined in METHODS. After NAME come the methods, each one a two element list of the form (METHOD-NAME FUN-OR-VAR), where METHOD-NAME is one of the needed methods (for a list, execute `geiser-implementation-help') and a value, variable name or function name implementing it. Omitted method names will return nil to their callers. Here's how a typical call to this macro looks like: (define-geiser-implementation guile (binary geiser-guile--binary) (arglist geiser-guile--parameters) (repl-startup geiser-guile--startup) (prompt-regexp geiser-guile--prompt-regexp) (debugger-prompt-regexp geiser-guile--debugger-prompt-regexp) (enter-debugger geiser-guile--enter-debugger) (marshall-procedure geiser-guile--geiser-procedure) (find-module geiser-guile--get-module) (enter-command geiser-guile--enter-command) (exit-command geiser-guile--exit-command) (import-command geiser-guile--import-command) (find-symbol-begin geiser-guile--symbol-begin) (display-error geiser-guile--display-error) (display-help) (check-buffer geiser-guile--guess) (keywords geiser-guile--keywords) (case-sensitive geiser-guile-case-sensitive-p)) This macro also defines a runner function (run-NAME) and a switcher (switch-to-NAME), and provides geiser-NAME." (let ((name (if (listp name) (car name) name)) (parent (and (listp name) (cadr name)))) (unless (symbolp name) (error "Malformed implementation name: %s" name)) (let ((runner (intern (format "run-%s" name))) (switcher (intern (format "switch-to-%s" name))) (runner-doc (format "Start a new %s REPL." name)) (switcher-doc (format "Switch to a running %s REPL, or start one." name)) (ask (make-symbol "ask"))) `(progn (geiser-impl--define ,load-file-name ',name ',parent ',methods) (require 'geiser-repl) (require 'geiser-menu) (defun ,runner () ,runner-doc (interactive) (run-geiser ',name)) (defun ,switcher (&optional ,ask) ,switcher-doc (interactive "P") (switch-to-geiser ,ask ',name)) (geiser-menu--add-impl ',name ',runner ',switcher))))) (defun geiser-impl--add-to-alist (kind what impl &optional append) (add-to-list 'geiser-implementations-alist (list (list kind what) impl) append)) ;;; Trying to guess the scheme implementation: (make-variable-buffer-local (defvar geiser-scheme-implementation nil "Set this buffer local variable to specify the Scheme implementation to be used by Geiser.")) (put 'geiser-scheme-implementation 'safe-local-variable 'symbolp) (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)))) (defvar geiser-impl--impl-prompt-history nil) (defun geiser-impl--read-impl (&optional prompt impls non-req) (let* ((impls (or impls geiser-active-implementations)) (impls (mapcar 'symbol-name impls)) (prompt (or prompt "Scheme implementation: "))) (intern (completing-read prompt impls nil (not non-req) nil geiser-impl--impl-prompt-history (and (car impls) (car impls)))))) (geiser-impl--define-caller geiser-impl--check-buffer check-buffer () "Method called without arguments that should check whether the current buffer contains Scheme code of the given implementation.") (defun geiser-impl--guess (&optional prompt) (or geiser-impl--implementation (progn (hack-local-variables) (and (memq geiser-scheme-implementation geiser-active-implementations) geiser-scheme-implementation)) (and (null (cdr geiser-active-implementations)) (car geiser-active-implementations)) (catch 'impl (dolist (impl geiser-active-implementations) (when (geiser-impl--check-buffer impl) (throw 'impl impl))) (let ((bn (buffer-file-name))) (when bn (dolist (x geiser-implementations-alist) (when (and (memq (cadr x) geiser-active-implementations) (geiser-impl--match-impl (car x) bn)) (throw 'impl (cadr x))))))) geiser-default-implementation (and prompt (geiser-impl--read-impl)))) ;;; Using implementations: (defsubst geiser-impl--registered-method (impl method fallback) (let ((m (geiser-impl--method method impl))) (if (fboundp m) m (or fallback (error "%s not defined for %s implementation" method impl))))) (defsubst geiser-impl--registered-value (impl method fallback) (let ((m (geiser-impl--method method impl))) (if (functionp m) (funcall m) fallback))) (defun geiser-impl--set-buffer-implementation (&optional impl prompt) (let ((impl (or impl (geiser-impl--guess prompt)))) (when impl (unless (geiser-impl--load-impl impl) (error "Cannot find %s implementation" impl)) (setq geiser-impl--implementation impl) (dolist (m geiser-impl--local-methods) (set (make-local-variable (nth 0 m)) (geiser-impl--registered-method impl (nth 1 m) (nth 2 m)))) (dolist (m geiser-impl--local-variables) (set (make-local-variable (nth 0 m)) (geiser-impl--registered-value impl (nth 1 m) (nth 2 m))))))) (defmacro with--geiser-implementation (impl &rest body) (let* ((mbindings (mapcar (lambda (m) `(,(nth 0 m) (geiser-impl--registered-method ,impl ',(nth 1 m) ',(nth 2 m)))) geiser-impl--local-methods)) (vbindings (mapcar (lambda (m) `(,(nth 0 m) (geiser-impl--registered-value ,impl ',(nth 1 m) ',(nth 2 m)))) geiser-impl--local-variables)) (ibindings `((geiser-impl--implementation ,impl))) (bindings (append ibindings mbindings vbindings))) `(let* ,bindings ,@body))) (put 'with--geiser-implementation 'lisp-indent-function 1) ;;; Reload support: (defun geiser-impl-unload-function () (dolist (imp (mapcar (lambda (i) (geiser-impl--feature (car i))) geiser-impl--registry)) (when (featurep imp) (unload-feature imp t)))) (provide 'geiser-impl)