/local-lisp/slime/slime.el
Emacs Lisp | 6535 lines | 5215 code | 853 blank | 467 comment | 221 complexity | a03978b2ffe6ea4e52b7e06603fc607d MD5 | raw file
Possible License(s): GPL-3.0, CC-BY-SA-4.0, GPL-2.0, Unlicense
Large files files are truncated, but you can click here to view the full file
- ;;; slime.el --- Superior Lisp Interaction Mode for Emacs
- ;;
- ;;;; License
- ;; Copyright (C) 2003 Eric Marsden, Luke Gorrie, Helmut Eller
- ;; Copyright (C) 2004,2005,2006 Luke Gorrie, Helmut Eller
- ;; Copyright (C) 2007,2008,2009 Helmut Eller, Tobias C. Rittweiler
- ;;
- ;; For a detailed list of contributors, see the manual.
- ;;
- ;; This program is free software; you can redistribute it and/or
- ;; modify it under the terms of the GNU General Public License as
- ;; published by the Free Software Foundation; either version 2 of
- ;; the License, or (at your option) any later version.
- ;;
- ;; This program is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;;
- ;; You should have received a copy of the GNU General Public
- ;; License along with this program; if not, write to the Free
- ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- ;; MA 02111-1307, USA.
- ;;;; Commentary
- ;;
- ;; This file contains extensions for programming in Common Lisp. The
- ;; main features are:
- ;;
- ;; A socket-based communication/RPC interface between Emacs and
- ;; Lisp, enabling introspection and remote development.
- ;;
- ;; The `slime-mode' minor-mode complementing `lisp-mode'. This new
- ;; mode includes many commands for interacting with the Common Lisp
- ;; process.
- ;;
- ;; A Common Lisp debugger written in Emacs Lisp. The debugger pops up
- ;; an Emacs buffer similar to the Emacs/Elisp debugger.
- ;;
- ;; A Common Lisp inspector to interactively look at run-time data.
- ;;
- ;; Trapping compiler messages and creating annotations in the source
- ;; file on the appropriate forms.
- ;;
- ;; SLIME should work with Emacs 22 and 23. If it works on XEmacs,
- ;; consider yourself lucky.
- ;;
- ;; In order to run SLIME, a supporting Lisp server called Swank is
- ;; required. Swank is distributed with slime.el and will automatically
- ;; be started in a normal installation.
- ;;;; Dependencies and setup
- (eval-and-compile
- (when (<= emacs-major-version 20)
- (error "Slime requires an Emacs version of 21, or above")))
- (eval-and-compile
- (require 'cl)
- (when (locate-library "hyperspec")
- (require 'hyperspec)))
- (require 'thingatpt)
- (require 'comint)
- (require 'timer)
- (require 'pp)
- (require 'hideshow)
- (require 'font-lock)
- (when (featurep 'xemacs)
- (require 'overlay))
- (require 'easymenu)
- (eval-when (compile)
- (require 'arc-mode)
- (require 'apropos)
- (require 'outline)
- (require 'etags)
- (require 'compile)
- (require 'gud))
- (eval-and-compile
- (defvar slime-path
- (let ((path (or (locate-library "slime") load-file-name)))
- (and path (file-name-directory path)))
- "Directory containing the Slime package.
- This is used to load the supporting Common Lisp library, Swank.
- The default value is automatically computed from the location of the
- Emacs Lisp package."))
- (defvar slime-lisp-modes '(lisp-mode))
- (defvar slime-setup-contribs nil)
- (defun slime-setup (&optional contribs)
- "Setup Emacs so that lisp-mode buffers always use SLIME.
- CONTRIBS is a list of contrib packages to load."
- (when (member 'lisp-mode slime-lisp-modes)
- (add-hook 'lisp-mode-hook 'slime-lisp-mode-hook))
- (setq slime-setup-contribs contribs)
- (slime-setup-contribs))
- (defun slime-setup-contribs ()
- "Load and initialize contribs."
- (when slime-setup-contribs
- (add-to-list 'load-path (expand-file-name "contrib" slime-path))
- (dolist (c slime-setup-contribs)
- (require c)
- (let ((init (intern (format "%s-init" c))))
- (when (fboundp init)
- (funcall init))))))
- (defun slime-lisp-mode-hook ()
- (slime-mode 1)
- (set (make-local-variable 'lisp-indent-function)
- 'common-lisp-indent-function))
- (eval-and-compile
- (defun slime-changelog-date (&optional interactivep)
- "Return the datestring of the latest entry in the ChangeLog file.
- Return nil if the ChangeLog file cannot be found."
- (interactive "p")
- (let ((changelog (concat slime-path "ChangeLog"))
- (date nil))
- (when (file-exists-p changelog)
- (with-temp-buffer
- (insert-file-contents-literally changelog nil 0 100)
- (goto-char (point-min))
- (setq date (symbol-name (read (current-buffer))))))
- (when interactivep
- (message "Slime ChangeLog dates %s." date))
- date)))
- (defvar slime-protocol-version nil)
- (setq slime-protocol-version
- (eval-when-compile (slime-changelog-date)))
- ;;;; Customize groups
- ;;
- ;;;;; slime
- (defgroup slime nil
- "Interaction with the Superior Lisp Environment."
- :prefix "slime-"
- :group 'applications)
- ;;;;; slime-ui
- (defgroup slime-ui nil
- "Interaction with the Superior Lisp Environment."
- :prefix "slime-"
- :group 'slime)
- (defcustom slime-truncate-lines t
- "Set `truncate-lines' in popup buffers.
- This applies to buffers that present lines as rows of data, such as
- debugger backtraces and apropos listings."
- :type 'boolean
- :group 'slime-ui)
- (defcustom slime-kill-without-query-p nil
- "If non-nil, kill SLIME processes without query when quitting Emacs.
- This applies to the *inferior-lisp* buffer and the network connections."
- :type 'boolean
- :group 'slime-ui)
- ;;;;; slime-lisp
- (defgroup slime-lisp nil
- "Lisp server configuration."
- :prefix "slime-"
- :group 'slime)
- (defcustom slime-backend "swank-loader.lisp"
- "The name of the Lisp file that loads the Swank server.
- This name is interpreted relative to the directory containing
- slime.el, but could also be set to an absolute filename."
- :type 'string
- :group 'slime-lisp)
- (defcustom slime-connected-hook nil
- "List of functions to call when SLIME connects to Lisp."
- :type 'hook
- :group 'slime-lisp)
- (defcustom slime-enable-evaluate-in-emacs nil
- "*If non-nil, the inferior Lisp can evaluate arbitrary forms in Emacs.
- The default is nil, as this feature can be a security risk."
- :type '(boolean)
- :group 'slime-lisp)
- (defcustom slime-lisp-host "127.0.0.1"
- "The default hostname (or IP address) to connect to."
- :type 'string
- :group 'slime-lisp)
- (defcustom slime-port 4005
- "Port to use as the default for `slime-connect'."
- :type 'integer
- :group 'slime-lisp)
- (defvar slime-net-valid-coding-systems
- '((iso-latin-1-unix nil "iso-latin-1-unix")
- (iso-8859-1-unix nil "iso-latin-1-unix")
- (binary nil "iso-latin-1-unix")
- (utf-8-unix t "utf-8-unix")
- (emacs-mule-unix t "emacs-mule-unix")
- (euc-jp-unix t "euc-jp-unix"))
- "A list of valid coding systems.
- Each element is of the form: (NAME MULTIBYTEP CL-NAME)")
- (defun slime-find-coding-system (name)
- "Return the coding system for the symbol NAME.
- The result is either an element in `slime-net-valid-coding-systems'
- of nil."
- (let ((probe (assq name slime-net-valid-coding-systems)))
- (when (and probe (if (fboundp 'check-coding-system)
- (ignore-errors (check-coding-system (car probe)))
- (eq (car probe) 'binary)))
- probe)))
- (defcustom slime-net-coding-system
- (car (find-if 'slime-find-coding-system
- slime-net-valid-coding-systems :key 'car))
- "Coding system used for network connections.
- See also `slime-net-valid-coding-systems'."
- :type (cons 'choice
- (mapcar (lambda (x)
- (list 'const (car x)))
- slime-net-valid-coding-systems))
- :group 'slime-lisp)
- ;;;;; slime-mode
- (defgroup slime-mode nil
- "Settings for slime-mode Lisp source buffers."
- :prefix "slime-"
- :group 'slime)
- (defcustom slime-find-definitions-function 'slime-find-definitions-rpc
- "Function to find definitions for a name.
- The function is called with the definition name, a string, as its
- argument."
- :type 'function
- :group 'slime-mode
- :options '(slime-find-definitions-rpc
- slime-etags-definitions
- (lambda (name)
- (append (slime-find-definitions-rpc name)
- (slime-etags-definitions name)))
- (lambda (name)
- (or (slime-find-definitions-rpc name)
- (and tags-table-list
- (slime-etags-definitions name))))))
- (defcustom slime-complete-symbol-function 'slime-simple-complete-symbol
- "*Function to perform symbol completion."
- :group 'slime-mode
- :type '(choice (const :tag "Simple" slime-simple-complete-symbol)
- (const :tag "Compound" slime-complete-symbol*)
- (const :tag "Fuzzy" slime-fuzzy-complete-symbol)))
- ;;;;; slime-mode-faces
- (defgroup slime-mode-faces nil
- "Faces in slime-mode source code buffers."
- :prefix "slime-"
- :group 'slime-mode)
- (defun slime-underline-color (color)
- "Return a legal value for the :underline face attribute based on COLOR."
- ;; In XEmacs the :underline attribute can only be a boolean.
- ;; In GNU it can be the name of a colour.
- (if (featurep 'xemacs)
- (if color t nil)
- color))
- (defface slime-error-face
- `((((class color) (background light))
- (:underline ,(slime-underline-color "red")))
- (((class color) (background dark))
- (:underline ,(slime-underline-color "red")))
- (t (:underline t)))
- "Face for errors from the compiler."
- :group 'slime-mode-faces)
- (defface slime-warning-face
- `((((class color) (background light))
- (:underline ,(slime-underline-color "orange")))
- (((class color) (background dark))
- (:underline ,(slime-underline-color "coral")))
- (t (:underline t)))
- "Face for warnings from the compiler."
- :group 'slime-mode-faces)
- (defface slime-style-warning-face
- `((((class color) (background light))
- (:underline ,(slime-underline-color "brown")))
- (((class color) (background dark))
- (:underline ,(slime-underline-color "gold")))
- (t (:underline t)))
- "Face for style-warnings from the compiler."
- :group 'slime-mode-faces)
- (defface slime-note-face
- `((((class color) (background light))
- (:underline ,(slime-underline-color "brown4")))
- (((class color) (background dark))
- (:underline ,(slime-underline-color "light goldenrod")))
- (t (:underline t)))
- "Face for notes from the compiler."
- :group 'slime-mode-faces)
- (defun slime-face-inheritance-possible-p ()
- "Return true if the :inherit face attribute is supported."
- (assq :inherit custom-face-attributes))
- (defface slime-highlight-face
- (if (slime-face-inheritance-possible-p)
- '((t (:inherit highlight :underline nil)))
- '((((class color) (background light))
- (:background "darkseagreen2"))
- (((class color) (background dark))
- (:background "darkolivegreen"))
- (t (:inverse-video t))))
- "Face for compiler notes while selected."
- :group 'slime-mode-faces)
- ;;;;; sldb
- (defgroup slime-debugger nil
- "Backtrace options and fontification."
- :prefix "sldb-"
- :group 'slime)
- (defmacro define-sldb-faces (&rest faces)
- "Define the set of SLDB faces.
- Each face specifiation is (NAME DESCRIPTION &optional PROPERTIES).
- NAME is a symbol; the face will be called sldb-NAME-face.
- DESCRIPTION is a one-liner for the customization buffer.
- PROPERTIES specifies any default face properties."
- `(progn ,@(loop for face in faces
- collect `(define-sldb-face ,@face))))
- (defmacro define-sldb-face (name description &optional default)
- (let ((facename (intern (format "sldb-%s-face" (symbol-name name)))))
- `(defface ,facename
- (list (list t ,default))
- ,(format "Face for %s." description)
- :group 'slime-debugger)))
- (define-sldb-faces
- (topline "the top line describing the error")
- (condition "the condition class")
- (section "the labels of major sections in the debugger buffer")
- (frame-label "backtrace frame numbers")
- (restart-type "restart names."
- (if (slime-face-inheritance-possible-p)
- '(:inherit font-lock-keyword-face)))
- (restart "restart descriptions")
- (restart-number "restart numbers (correspond to keystrokes to invoke)"
- '(:bold t))
- (frame-line "function names and arguments in the backtrace")
- (restartable-frame-line
- "frames which are surely restartable"
- '(:foreground "lime green"))
- (non-restartable-frame-line
- "frames which are surely not restartable")
- (detailed-frame-line
- "function names and arguments in a detailed (expanded) frame")
- (local-name "local variable names")
- (local-value "local variable values")
- (catch-tag "catch tags"))
- ;;;; Minor modes
- ;;;;; slime-mode
- (defvar slime-mode-indirect-map (make-sparse-keymap)
- "Empty keymap which has `slime-mode-map' as it's parent.
- This is a hack so that we can reinitilize the real slime-mode-map
- more easily. See `slime-init-keymaps'.")
- (define-minor-mode slime-mode
- "\\<slime-mode-map>\
- SLIME: The Superior Lisp Interaction Mode for Emacs (minor-mode).
- Commands to compile the current buffer's source file and visually
- highlight any resulting compiler notes and warnings:
- \\[slime-compile-and-load-file] - Compile and load the current buffer's file.
- \\[slime-compile-file] - Compile (but not load) the current buffer's file.
- \\[slime-compile-defun] - Compile the top-level form at point.
- Commands for visiting compiler notes:
- \\[slime-next-note] - Goto the next form with a compiler note.
- \\[slime-previous-note] - Goto the previous form with a compiler note.
- \\[slime-remove-notes] - Remove compiler-note annotations in buffer.
- Finding definitions:
- \\[slime-edit-definition] - Edit the definition of the function called at point.
- \\[slime-pop-find-definition-stack] - Pop the definition stack to go back from a definition.
- Documentation commands:
- \\[slime-describe-symbol] - Describe symbol.
- \\[slime-apropos] - Apropos search.
- \\[slime-disassemble-symbol] - Disassemble a function.
- Evaluation commands:
- \\[slime-eval-defun] - Evaluate top-level from containing point.
- \\[slime-eval-last-expression] - Evaluate sexp before point.
- \\[slime-pprint-eval-last-expression] - Evaluate sexp before point, pretty-print result.
- Full set of commands:
- \\{slime-mode-map}"
- nil
- nil
- slime-mode-indirect-map
- (slime-setup-command-hooks)
- (setq slime-modeline-string (slime-modeline-string)))
- ;;;;;; Modeline
- ;; For XEmacs only
- (make-variable-buffer-local
- (defvar slime-modeline-string nil
- "The string that should be displayed in the modeline."))
- (add-to-list 'minor-mode-alist
- `(slime-mode ,(if (featurep 'xemacs)
- 'slime-modeline-string
- '(:eval (slime-modeline-string)))))
- (defun slime-modeline-string ()
- "Return the string to display in the modeline.
- \"Slime\" only appears if we aren't connected. If connected,
- include package-name, connection-name, and possibly some state
- information."
- (let ((conn (slime-current-connection)))
- ;; Bail out early in case there's no connection, so we won't
- ;; implicitly invoke `slime-connection' which may query the user.
- (if (not conn)
- (and slime-mode " Slime")
- (let ((local (eq conn slime-buffer-connection))
- (pkg (slime-current-package)))
- (concat " "
- (if local "{" "[")
- (if pkg (slime-pretty-package-name pkg) "?")
- " "
- ;; ignore errors for closed connections
- (ignore-errors (slime-connection-name conn))
- (slime-modeline-state-string conn)
- (if local "}" "]"))))))
- (defun slime-pretty-package-name (name)
- "Return a pretty version of a package name NAME."
- (cond ((string-match "^#?:\\(.*\\)$" name)
- (match-string 1 name))
- ((string-match "^\"\\(.*\\)\"$" name)
- (match-string 1 name))
- (t name)))
- (defun slime-modeline-state-string (conn)
- "Return a string possibly describing CONN's state."
- (cond ((not (eq (process-status conn) 'open))
- (format " %s" (process-status conn)))
- ((let ((pending (length (slime-rex-continuations conn)))
- (sldbs (length (sldb-buffers conn))))
- (cond ((and (zerop sldbs) (zerop pending)) nil)
- ((zerop sldbs) (format " %s" pending))
- (t (format " %s/%s" pending sldbs)))))))
- (defmacro slime-recompute-modelines ()
- ;; Avoid a needless runtime funcall on GNU Emacs:
- (and (featurep 'xemacs) `(slime-xemacs-recompute-modelines)))
- (defun slime-xemacs-recompute-modelines ()
- (let (redraw-modeline)
- (walk-windows
- (lambda (object)
- (setq object (window-buffer object))
- (when (or (symbol-value-in-buffer 'slime-mode object)
- (symbol-value-in-buffer 'slime-popup-buffer-mode object))
- ;; Only do the unwind-protect of #'with-current-buffer if we're
- ;; actually interested in this buffer
- (with-current-buffer object
- (setq redraw-modeline
- (or (not (equal slime-modeline-string
- (setq slime-modeline-string
- (slime-modeline-string))))
- redraw-modeline)))))
- 'never 'visible)
- (and redraw-modeline (redraw-modeline t))))
- (and (featurep 'xemacs)
- (pushnew 'slime-xemacs-recompute-modelines pre-idle-hook))
- ;;;;; Key bindings
- (defvar slime-parent-map nil
- "Parent keymap for shared between all Slime related modes.")
- (defvar slime-parent-bindings
- '(("\M-." slime-edit-definition)
- ("\M-," slime-pop-find-definition-stack)
- ("\M-_" slime-edit-uses) ; for German layout
- ("\M-?" slime-edit-uses) ; for USian layout
- ("\C-x4." slime-edit-definition-other-window)
- ("\C-x5." slime-edit-definition-other-frame)
- ("\C-x\C-e" slime-eval-last-expression)
- ("\C-\M-x" slime-eval-defun)
- ;; Include PREFIX keys...
- ("\C-c" slime-prefix-map)))
- (defvar slime-prefix-map nil
- "Keymap for commands prefixed with `slime-prefix-key'.")
- (defvar slime-prefix-bindings
- '(("\C-r" slime-eval-region)
- (":" slime-interactive-eval)
- ("\C-e" slime-interactive-eval)
- ("E" slime-edit-value)
- ("\C-l" slime-load-file)
- ("\C-b" slime-interrupt)
- ("\M-d" slime-disassemble-symbol)
- ("\C-t" slime-toggle-trace-fdefinition)
- ("I" slime-inspect)
- ("\C-xt" slime-list-threads)
- ("\C-xn" slime-cycle-connections)
- ("\C-xc" slime-list-connections)
- ("<" slime-list-callers)
- (">" slime-list-callees)
- ;; Include DOC keys...
- ("\C-d" slime-doc-map)
- ;; Include XREF WHO-FOO keys...
- ("\C-w" slime-who-map)
- ))
- (defvar slime-editing-map nil
- "These keys are useful for buffers where the user can insert and
- edit s-exprs, e.g. for source buffers and the REPL.")
- (defvar slime-editing-keys
- `(;; Arglist display & completion
- ("\M-\t" slime-complete-symbol)
- (" " slime-space)
- ;; Evaluating
- ;;("\C-x\M-e" slime-eval-last-expression-display-output :inferior t)
- ("\C-c\C-p" slime-pprint-eval-last-expression)
- ;; Macroexpand
- ("\C-c\C-m" slime-macro/compiler-macro-expand-1)
- ("\C-c\M-m" slime-macroexpand-all)
- ;; Misc
- ("\C-c\C-u" slime-undefine-function)
- (,(kbd "C-M-.") slime-next-location)
- (,(kbd "C-M-,") slime-previous-location)
- ;; Obsolete, redundant bindings
- ("\C-c\C-i" slime-complete-symbol)
- ;;("\M-*" pop-tag-mark) ; almost to clever
- ))
- (defvar slime-mode-map nil
- "Keymap for slime-mode.")
- (defvar slime-keys
- '( ;; Compiler notes
- ("\M-p" slime-previous-note)
- ("\M-n" slime-next-note)
- ("\C-c\M-c" slime-remove-notes)
- ("\C-c\C-k" slime-compile-and-load-file)
- ("\C-c\M-k" slime-compile-file)
- ("\C-c\C-c" slime-compile-defun)))
- (defun slime-nop ()
- "The null command. Used to shadow currently-unused keybindings."
- (interactive)
- (call-interactively 'undefined))
- (defvar slime-doc-map nil
- "Keymap for documentation commands. Bound to a prefix key.")
- (defvar slime-doc-bindings
- '((?a slime-apropos)
- (?z slime-apropos-all)
- (?p slime-apropos-package)
- (?d slime-describe-symbol)
- (?f slime-describe-function)
- (?h slime-documentation-lookup)
- (?~ common-lisp-hyperspec-format)
- (?# common-lisp-hyperspec-lookup-reader-macro)))
-
- (defvar slime-who-map nil
- "Keymap for who-xref commands. Bound to a prefix key.")
- (defvar slime-who-bindings
- '((?c slime-who-calls)
- (?w slime-calls-who)
- (?r slime-who-references)
- (?b slime-who-binds)
- (?s slime-who-sets)
- (?m slime-who-macroexpands)
- (?a slime-who-specializes)))
- (defun slime-init-keymaps ()
- "(Re)initialize the keymaps for `slime-mode'."
- (interactive)
- (slime-init-keymap 'slime-doc-map t t slime-doc-bindings)
- (slime-init-keymap 'slime-who-map t t slime-who-bindings)
- (slime-init-keymap 'slime-prefix-map t nil slime-prefix-bindings)
- (slime-init-keymap 'slime-parent-map nil nil slime-parent-bindings)
- (slime-init-keymap 'slime-editing-map nil nil slime-editing-keys)
- (set-keymap-parent slime-editing-map slime-parent-map)
- (slime-init-keymap 'slime-mode-map nil nil slime-keys)
- (set-keymap-parent slime-mode-map slime-editing-map)
- (set-keymap-parent slime-mode-indirect-map slime-mode-map))
- (defun slime-init-keymap (keymap-name prefixp bothp bindings)
- (set keymap-name (make-sparse-keymap))
- (when prefixp (define-prefix-command keymap-name))
- (slime-bind-keys (eval keymap-name) bothp bindings))
- (defun slime-bind-keys (keymap bothp bindings)
- "Add BINDINGS to KEYMAP.
- If BOTHP is true also add bindings with control modifier."
- (loop for (key command) in bindings do
- (cond (bothp
- (define-key keymap `[,key] command)
- (unless (equal key ?h) ; But don't bind C-h
- (define-key keymap `[(control ,key)] command)))
- (t (define-key keymap key command)))))
- (slime-init-keymaps)
- (define-minor-mode slime-editing-mode
- "Minor mode which makes slime-editing-map available.
- \\{slime-editing-map}"
- nil
- nil
- slime-editing-map)
- ;;;; Setup initial `slime-mode' hooks
- (make-variable-buffer-local
- (defvar slime-pre-command-actions nil
- "List of functions to execute before the next Emacs command.
- This list of flushed between commands."))
- (defun slime-pre-command-hook ()
- "Execute all functions in `slime-pre-command-actions', then NIL it."
- (dolist (undo-fn slime-pre-command-actions)
- (funcall undo-fn))
- (setq slime-pre-command-actions nil))
- (defun slime-post-command-hook ()
- (when (null pre-command-hook) ; sometimes this is lost
- (add-hook 'pre-command-hook 'slime-pre-command-hook)))
- (defun slime-setup-command-hooks ()
- "Setup a buffer-local `pre-command-hook' to call `slime-pre-command-hook'."
- (slime-add-local-hook 'pre-command-hook 'slime-pre-command-hook)
- (slime-add-local-hook 'post-command-hook 'slime-post-command-hook))
- ;;;; Framework'ey bits
- ;;;
- ;;; This section contains some standard SLIME idioms: basic macros,
- ;;; ways of showing messages to the user, etc. All the code in this
- ;;; file should use these functions when applicable.
- ;;;
- ;;;;; Syntactic sugar
- (defmacro* when-let ((var value) &rest body)
- "Evaluate VALUE, if the result is non-nil bind it to VAR and eval BODY.
- \(fn (VAR VALUE) &rest BODY)"
- `(let ((,var ,value))
- (when ,var ,@body)))
- (put 'when-let 'lisp-indent-function 1)
- (defmacro destructure-case (value &rest patterns)
- "Dispatch VALUE to one of PATTERNS.
- A cross between `case' and `destructuring-bind'.
- The pattern syntax is:
- ((HEAD . ARGS) . BODY)
- The list of patterns is searched for a HEAD `eq' to the car of
- VALUE. If one is found, the BODY is executed with ARGS bound to the
- corresponding values in the CDR of VALUE."
- (let ((operator (gensym "op-"))
- (operands (gensym "rand-"))
- (tmp (gensym "tmp-")))
- `(let* ((,tmp ,value)
- (,operator (car ,tmp))
- (,operands (cdr ,tmp)))
- (case ,operator
- ,@(mapcar (lambda (clause)
- (if (eq (car clause) t)
- `(t ,@(cdr clause))
- (destructuring-bind ((op &rest rands) &rest body) clause
- `(,op (destructuring-bind ,rands ,operands
- . ,body)))))
- patterns)
- ,@(if (eq (caar (last patterns)) t)
- '()
- `((t (error "Elisp destructure-case failed: %S" ,tmp))))))))
- (put 'destructure-case 'lisp-indent-function 1)
- (defmacro slime-define-keys (keymap &rest key-command)
- "Define keys in KEYMAP. Each KEY-COMMAND is a list of (KEY COMMAND)."
- `(progn . ,(mapcar (lambda (k-c) `(define-key ,keymap . ,k-c))
- key-command)))
- (put 'slime-define-keys 'lisp-indent-function 1)
- (defmacro* with-struct ((conc-name &rest slots) struct &body body)
- "Like with-slots but works only for structs.
- \(fn (CONC-NAME &rest SLOTS) STRUCT &body BODY)"
- (flet ((reader (slot) (intern (concat (symbol-name conc-name)
- (symbol-name slot)))))
- (let ((struct-var (gensym "struct")))
- `(let ((,struct-var ,struct))
- (symbol-macrolet
- ,(mapcar (lambda (slot)
- (etypecase slot
- (symbol `(,slot (,(reader slot) ,struct-var)))
- (cons `(,(first slot) (,(reader (second slot))
- ,struct-var)))))
- slots)
- . ,body)))))
- (put 'with-struct 'lisp-indent-function 2)
- ;;;;; Very-commonly-used functions
- (defvar slime-message-function 'message)
- ;; Interface
- (defun slime-buffer-name (type &optional hidden)
- (assert (keywordp type))
- (concat (if hidden " " "")
- (format "*slime-%s*" (substring (symbol-name type) 1))))
- ;; Interface
- (defun slime-message (format &rest args)
- "Like `message' but with special support for multi-line messages.
- Single-line messages use the echo area."
- (apply slime-message-function format args))
- (defun slime-display-warning (message &rest args)
- (display-warning '(slime warning) (apply #'format message args)))
- (defvar slime-background-message-function 'slime-display-oneliner)
- ;; Interface
- (defun slime-background-message (format-string &rest format-args)
- "Display a message in passing.
- This is like `slime-message', but less distracting because it
- will never pop up a buffer or display multi-line messages.
- It should be used for \"background\" messages such as argument lists."
- (apply slime-background-message-function format-string format-args))
- (defun slime-display-oneliner (format-string &rest format-args)
- (let* ((msg (apply #'format format-string format-args)))
- (unless (minibuffer-window-active-p (minibuffer-window))
- (message "%s" (slime-oneliner msg)))))
- (defun slime-oneliner (string)
- "Return STRING truncated to fit in a single echo-area line."
- (substring string 0 (min (length string)
- (or (position ?\n string) most-positive-fixnum)
- (1- (frame-width)))))
- ;; Interface
- (defun slime-set-truncate-lines ()
- "Apply `slime-truncate-lines' to the current buffer."
- (when slime-truncate-lines
- (set (make-local-variable 'truncate-lines) t)))
- ;; Interface
- (defun slime-read-package-name (prompt &optional initial-value)
- "Read a package name from the minibuffer, prompting with PROMPT."
- (let ((completion-ignore-case t))
- (completing-read prompt (slime-bogus-completion-alist
- (slime-eval
- `(swank:list-all-package-names t)))
- nil t initial-value)))
- ;; Interface
- (defun slime-read-symbol-name (prompt &optional query)
- "Either read a symbol name or choose the one at point.
- The user is prompted if a prefix argument is in effect, if there is no
- symbol at point, or if QUERY is non-nil."
- (cond ((or current-prefix-arg query (not (slime-symbol-at-point)))
- (slime-read-from-minibuffer prompt (slime-symbol-at-point)))
- (t (slime-symbol-at-point))))
- ;; Interface
- (defmacro slime-propertize-region (props &rest body)
- "Execute BODY and add PROPS to all the text it inserts.
- More precisely, PROPS are added to the region between the point's
- positions before and after executing BODY."
- (let ((start (gensym)))
- `(let ((,start (point)))
- (prog1 (progn ,@body)
- (add-text-properties ,start (point) ,props)))))
- (put 'slime-propertize-region 'lisp-indent-function 1)
- (defun slime-add-face (face string)
- (add-text-properties 0 (length string) (list 'face face) string)
- string)
- (put 'slime-add-face 'lisp-indent-function 1)
- ;; Interface
- (defsubst slime-insert-propertized (props &rest args)
- "Insert all ARGS and then add text-PROPS to the inserted text."
- (slime-propertize-region props (apply #'insert args)))
- (defmacro slime-with-rigid-indentation (level &rest body)
- "Execute BODY and then rigidly indent its text insertions.
- Assumes all insertions are made at point."
- (let ((start (gensym)) (l (gensym)))
- `(let ((,start (point)) (,l ,(or level '(current-column))))
- (prog1 (progn ,@body)
- (slime-indent-rigidly ,start (point) ,l)))))
- (put 'slime-with-rigid-indentation 'lisp-indent-function 1)
- (defun slime-indent-rigidly (start end column)
- ;; Similar to `indent-rigidly' but doesn't inherit text props.
- (let ((indent (make-string column ?\ )))
- (save-excursion
- (goto-char end)
- (beginning-of-line)
- (while (and (<= start (point))
- (progn
- (insert-before-markers indent)
- (zerop (forward-line -1))))))))
- (defun slime-insert-indented (&rest strings)
- "Insert all arguments rigidly indented."
- (slime-with-rigid-indentation nil
- (apply #'insert strings)))
- (defun slime-property-bounds (prop)
- "Return two the positions of the previous and next changes to PROP.
- PROP is the name of a text property."
- (assert (get-text-property (point) prop))
- (let ((end (next-single-char-property-change (point) prop)))
- (list (previous-single-char-property-change end prop) end)))
- (defun slime-curry (fun &rest args)
- "Partially apply FUN to ARGS. The result is a new function.
- This idiom is preferred over `lexical-let'."
- `(lambda (&rest more) (apply ',fun (append ',args more))))
- (defun slime-rcurry (fun &rest args)
- "Like `slime-curry' but ARGS on the right are applied."
- `(lambda (&rest more) (apply ',fun (append more ',args))))
- ;;;;; Temporary popup buffers
- (defvar slime-popup-restore-data nil
- "Data needed when closing popup windows.
- This is used as buffer local variable.
- The format is (POPUP-WINDOW SELECTED-WINDOW OLD-BUFFER).
- POPUP-WINDOW is the window used to display the temp buffer.
- That window may have been reused or freshly created.
- SELECTED-WINDOW is the window that was selected before displaying
- the popup buffer.
- OLD-BUFFER is the buffer that was previously displayed in POPUP-WINDOW.
- OLD-BUFFER is nil if POPUP-WINDOW was newly created.
- See `view-return-to-alist' for a similar idea.")
- ;; keep compiler quiet
- (defvar slime-buffer-package)
- (defvar slime-buffer-connection)
- ;; Interface
- (defmacro* slime-with-popup-buffer ((name &key package connection select mode)
- &body body)
- "Similar to `with-output-to-temp-buffer'.
- Bind standard-output and initialize some buffer-local variables.
- Restore window configuration when closed.
- NAME is the name of the buffer to be created.
- PACKAGE is the value `slime-buffer-package'.
- CONNECTION is the value for `slime-buffer-connection'.
- MODE is the name of a major mode which will be enabled.
- If nil, no explicit connection is associated with
- the buffer. If t, the current connection is taken.
- "
- `(let* ((vars% (list ,(if (eq package t) '(slime-current-package) package)
- ,(if (eq connection t) '(slime-connection) connection)))
- (standard-output (slime-make-popup-buffer ,name vars% ,mode)))
- (with-current-buffer standard-output
- (prog1 (progn ,@body)
- (assert (eq (current-buffer) standard-output))
- (setq buffer-read-only t)
- (set-window-point (slime-display-popup-buffer ,(or select nil))
- (point))))))
- (put 'slime-with-popup-buffer 'lisp-indent-function 1)
- (defun slime-make-popup-buffer (name buffer-vars mode)
- "Return a temporary buffer called NAME.
- The buffer also uses the minor-mode `slime-popup-buffer-mode'."
- (with-current-buffer (get-buffer-create name)
- (kill-all-local-variables)
- (when mode
- (funcall mode))
- (setq buffer-read-only nil)
- (erase-buffer)
- (set-syntax-table lisp-mode-syntax-table)
- (slime-init-popup-buffer buffer-vars)
- (current-buffer)))
- (defun slime-init-popup-buffer (buffer-vars)
- (slime-popup-buffer-mode 1)
- (multiple-value-setq (slime-buffer-package slime-buffer-connection)
- buffer-vars))
- (defun slime-display-popup-buffer (select)
- "Display the current buffer.
- Save the selected-window in a buffer-local variable, so that we
- can restore it later."
- (let ((selected-window (selected-window))
- (old-windows))
- (walk-windows (lambda (w) (push (cons w (window-buffer w)) old-windows))
- nil t)
- (let ((new-window (display-buffer (current-buffer))))
- (unless slime-popup-restore-data
- (set (make-local-variable 'slime-popup-restore-data)
- (list new-window
- selected-window
- (cdr (find new-window old-windows :key #'car)))))
- (when select
- (select-window new-window))
- new-window)))
- (defun slime-close-popup-window ()
- (when slime-popup-restore-data
- (destructuring-bind (popup-window selected-window old-buffer)
- slime-popup-restore-data
- (kill-local-variable 'slime-popup-restore-data)
- (bury-buffer)
- (when (eq popup-window (selected-window))
- (cond ((and (not old-buffer) (not (one-window-p)))
- (delete-window popup-window))
- ((and old-buffer (buffer-live-p old-buffer))
- (set-window-buffer popup-window old-buffer))))
- (when (window-live-p selected-window)
- (select-window selected-window)))))
- (defmacro slime-save-local-variables (vars &rest body)
- (let ((vals (make-symbol "vals")))
- `(let ((,vals (mapcar (lambda (var)
- (if (slime-local-variable-p var)
- (cons var (eval var))))
- ',vars)))
- (prog1 (progn . ,body)
- (mapc (lambda (var+val)
- (when (consp var+val)
- (set (make-local-variable (car var+val)) (cdr var+val))))
- ,vals)))))
- (put 'slime-save-local-variables 'lisp-indent-function 1)
- (define-minor-mode slime-popup-buffer-mode
- "Mode for displaying read only stuff"
- nil
- nil
- '(("q" . slime-popup-buffer-quit-function)
- ;;("\C-c\C-z" . slime-switch-to-output-buffer)
- ("\M-." . slime-edit-definition)))
- (add-to-list 'minor-mode-alist
- `(slime-popup-buffer-mode
- ,(if (featurep 'xemacs)
- 'slime-modeline-string
- '(:eval (unless slime-mode
- (slime-modeline-string))))))
- (set-keymap-parent slime-popup-buffer-mode-map slime-parent-map)
- (make-variable-buffer-local
- (defvar slime-popup-buffer-quit-function 'slime-popup-buffer-quit
- "The function that is used to quit a temporary popup buffer."))
- (defun slime-popup-buffer-quit-function (&optional kill-buffer-p)
- "Wrapper to invoke the value of `slime-popup-buffer-quit-function'."
- (interactive)
- (funcall slime-popup-buffer-quit-function kill-buffer-p))
- ;; Interface
- (defun slime-popup-buffer-quit (&optional kill-buffer-p)
- "Get rid of the current (temp) buffer without asking.
- Restore the window configuration unless it was changed since we
- last activated the buffer."
- (interactive)
- (let ((buffer (current-buffer)))
- (slime-close-popup-window)
- (when kill-buffer-p
- (kill-buffer buffer))))
- ;;;;; Filename translation
- ;;;
- ;;; Filenames passed between Emacs and Lisp should be translated using
- ;;; these functions. This way users who run Emacs and Lisp on separate
- ;;; machines have a chance to integrate file operations somehow.
- (defvar slime-to-lisp-filename-function #'convert-standard-filename
- "Function to translate Emacs filenames to CL namestrings.")
- (defvar slime-from-lisp-filename-function #'identity
- "Function to translate CL namestrings to Emacs filenames.")
- (defun slime-to-lisp-filename (filename)
- "Translate the string FILENAME to a Lisp filename."
- (funcall slime-to-lisp-filename-function filename))
- (defun slime-from-lisp-filename (filename)
- "Translate the Lisp filename FILENAME to an Emacs filename."
- (funcall slime-from-lisp-filename-function filename))
- ;;;; Starting SLIME
- ;;;
- ;;; This section covers starting an inferior-lisp, compiling and
- ;;; starting the server, initiating a network connection.
- ;;;;; Entry points
- ;; We no longer load inf-lisp, but we use this variable for backward
- ;; compatibility.
- (defvar inferior-lisp-program "lisp"
- "*Program name for invoking an inferior Lisp with for Inferior Lisp mode.")
- (defvar slime-lisp-implementations nil
- "*A list of known Lisp implementations.
- The list should have the form:
- ((NAME (PROGRAM PROGRAM-ARGS...) &key KEYWORD-ARGS) ...)
- NAME is a symbol for the implementation.
- PROGRAM and PROGRAM-ARGS are strings used to start the Lisp process.
- For KEYWORD-ARGS see `slime-start'.
- Here's an example:
- ((cmucl (\"/opt/cmucl/bin/lisp\" \"-quiet\") :init slime-init-command)
- (acl (\"acl7\") :coding-system emacs-mule))")
- (defvar slime-default-lisp nil
- "*The name of the default Lisp implementation.
- See `slime-lisp-implementations'")
- ;; dummy definitions for the compiler
- (defvar slime-net-processes)
- (defvar slime-default-connection)
- (defun slime (&optional command coding-system)
- "Start an inferior^_superior Lisp and connect to its Swank server."
- (interactive)
- (let ((inferior-lisp-program (or command inferior-lisp-program))
- (slime-net-coding-system (or coding-system slime-net-coding-system)))
- (slime-start* (cond ((and command (symbolp command))
- (slime-lisp-options command))
- (t (slime-read-interactive-args))))))
- (defvar slime-inferior-lisp-program-history '()
- "History list of command strings. Used by `slime'.")
-
- (defun slime-read-interactive-args ()
- "Return the list of args which should be passed to `slime-start'.
- The rules for selecting the arguments are rather complicated:
- - In the most common case, i.e. if there's no prefix-arg in
- effect and if `slime-lisp-implementations' is nil, use
- `inferior-lisp-program' as fallback.
- - If the table `slime-lisp-implementations' is non-nil use the
- implementation with name `slime-default-lisp' or if that's nil
- the first entry in the table.
- - If the prefix-arg is `-', prompt for one of the registered
- lisps.
- - If the prefix-arg is positive, read the command to start the
- process."
- (let ((table slime-lisp-implementations))
- (cond ((not current-prefix-arg) (slime-lisp-options))
- ((eq current-prefix-arg '-)
- (let ((key (completing-read
- "Lisp name: " (mapcar (lambda (x)
- (list (symbol-name (car x))))
- table)
- nil t)))
- (slime-lookup-lisp-implementation table (intern key))))
- (t
- (destructuring-bind (program &rest program-args)
- (split-string (read-string
- "Run lisp: " inferior-lisp-program
- 'slime-inferior-lisp-program-history))
- (let ((coding-system
- (if (eq 16 (prefix-numeric-value current-prefix-arg))
- (read-coding-system "set slime-coding-system: "
- slime-net-coding-system)
- slime-net-coding-system)))
- (list :program program :program-args program-args
- :coding-system coding-system)))))))
- (defun slime-lisp-options (&optional name)
- (let ((table slime-lisp-implementations))
- (assert (or (not name) table))
- (cond (table (slime-lookup-lisp-implementation slime-lisp-implementations
- (or name slime-default-lisp
- (car (car table)))))
- (t (destructuring-bind (program &rest args)
- (split-string inferior-lisp-program)
- (list :program program :program-args args))))))
- (defun slime-lookup-lisp-implementation (table name)
- (destructuring-bind (name (prog &rest args) &rest keys) (assoc name table)
- (list* :name name :program prog :program-args args keys)))
- (defun* slime-start (&key (program inferior-lisp-program) program-args
- directory
- (coding-system slime-net-coding-system)
- (init 'slime-init-command)
- name
- (buffer "*inferior-lisp*")
- init-function
- env)
- "Start a Lisp process and connect to it.
- This function is intended for programmatic use if `slime' is not
- flexible enough.
- PROGRAM and PROGRAM-ARGS are the filename and argument strings
- for the subprocess.
- INIT is a function that should return a string to load and start
- Swank. The function will be called with the PORT-FILENAME and ENCODING as
- arguments. INIT defaults to `slime-init-command'.
- CODING-SYSTEM a symbol for the coding system. The default is
- slime-net-coding-system
- ENV environment variables for the subprocess (see `process-environment').
- INIT-FUNCTION function to call right after the connection is established.
- BUFFER the name of the buffer to use for the subprocess.
- NAME a symbol to describe the Lisp implementation
- DIRECTORY change to this directory before starting the process.
- "
- (let ((args (list :program program :program-args program-args :buffer buffer
- :coding-system coding-system :init init :name name
- :init-function init-function :env env)))
- (slime-check-coding-system coding-system)
- (when (slime-bytecode-stale-p)
- (slime-urge-bytecode-recompile))
- (let ((proc (slime-maybe-start-lisp program program-args env
- directory buffer)))
- (slime-inferior-connect proc args)
- (pop-to-buffer (process-buffer proc)))))
- (defun slime-start* (options)
- (apply #'slime-start options))
- (defun slime-connect (host port &optional coding-system)
- "Connect to a running Swank server. Return the connection."
- (interactive (list (read-from-minibuffer "Host: " slime-lisp-host)
- (read-from-minibuffer "Port: " (format "%d" slime-port)
- nil t)))
- (when (and (interactive-p) slime-net-processes
- (y-or-n-p "Close old connections first? "))
- (slime-disconnect-all))
- (message "Connecting to Swank on port %S.." port)
- (let ((coding-system (or coding-system slime-net-coding-system)))
- (slime-check-coding-system coding-system)
- (message "Connecting to Swank on port %S.." port)
- (let* ((process (slime-net-connect host port coding-system))
- (slime-dispatching-connection process))
- (slime-setup-connection process))))
- ;; FIXME: seems redundant
- (defun slime-start-and-init (options fun)
- (let* ((rest (plist-get options :init-function))
- (init (cond (rest `(lambda () (funcall ',rest) (funcall ',fun)))
- (t fun))))
- (slime-start* (plist-put (copy-list options) :init-function init))))
- ;;;;; Start inferior lisp
- ;;;
- ;;; Here is the protocol for starting SLIME:
- ;;;
- ;;; 0. Emacs recompiles/reloads slime.elc if it exists and is stale.
- ;;; 1. Emacs starts an inferior Lisp process.
- ;;; 2. Emacs tells Lisp (via stdio) to load and start Swank.
- ;;; 3. Lisp recompiles the Swank if needed.
- ;;; 4. Lisp starts the Swank server and writes its TCP port to a temp file.
- ;;; 5. Emacs reads the temp file to get the port and then connects.
- ;;; 6. Emacs prints a message of warm encouragement for the hacking ahead.
- ;;;
- ;;; Between steps 2-5 Emacs polls for the creation of the temp file so
- ;;; that it can make the connection. This polling may continue for a
- ;;; fair while if Swank needs recompilation.
- (defvar slime-connect-retry-timer nil
- "Timer object while waiting for an inferior-lisp to start.")
- ;;; Recompiling bytecode:
- (defun slime-bytecode-stale-p ()
- "Return true if slime.elc is older than slime.el."
- (when-let (libfile (locate-library "slime"))
- (let* ((basename (file-name-sans-extension libfile))
- (sourcefile (concat basename ".el"))
- (bytefile (concat basename ".elc")))
- (and (file-exists-p bytefile)
- (file-newer-than-file-p sourcefile bytefile)))))
- (defun slime-recompile-bytecode ()
- "Recompile and reload slime.
- Warning: don't use this in XEmacs, it seems to crash it!"
- (interactive)
- (let ((sourcefile (concat (file-name-sans-extension (locate-library "slime"))
- ".el")))
- (byte-compile-file sourcefile t)))
- (defun slime-urge-bytecode-recompile ()
- "Urge the user to recompile slime.elc.
- Return true if we have been given permission to continue."
- (cond ((featurep 'xemacs)
- ;; My XEmacs crashes and burns if I recompile/reload an elisp
- ;; file from itself. So they have to do it themself.
- (or (y-or-n-p "slime.elc is older than source. Continue? ")
- (signal 'quit nil)))
- ((y-or-n-p "slime.elc is older than source. Recompile first? ")
- (slime-recompile-bytecode))
- (t)))
- (defun slime-abort-connection ()
- "Abort connection the current connection attempt."
- (interactive)
- (cond (slime-connect-retry-timer
- (slime-cancel-connect-retry-timer)
- (message "Cancelled connection attempt."))
- (t (error "Not connecting"))))
- ;;; Starting the inferior Lisp and loading Swank:
- (defun slime-maybe-start-lisp (program program-args env directory buffer)
- "Return a new or existing inferior lisp process."
- (cond ((not (comint-check-proc buffer))
- (slime-start-lisp program program-args env directory buffer))
- ((slime-reinitialize-inferior-lisp-p program program-args env buffer)
- (when-let (conn (find (get-buffer-process buffer) slime-net-processes
- :key #'slime-inferior-process))
- (slime-net-close conn))
- (get-buffer-process buffer))
- (t (slime-start-lisp program program-args env directory
- (generate-new-buffer-name buffer)))))
- (defun slime-reinitialize-inferior-lisp-p (program program-args env buffer)
- (let ((args (slime-inferior-lisp-args (get-buffer-process buffer))))
- (and (equal (plist-get args :program) program)
- (equal (plist-get args :program-args) program-args)
- (equal (plist-get args :env) env)
- (not (y-or-n-p "Create an additional *inferior-lisp*? ")))))
- (defvar slime-inferior-process-start-hook nil
- "Hook called whenever a new process gets started.")
- (defun slime-start-lisp (program program-args env directory buffer)
- "Does the same as `inferior-lisp' but less ugly.
- Return the created process."
- (with-current-buffer (get-buffer-create buffer)
- (when directory
- (cd (expand-file-name directory)))
- (comint-mode)
- (let ((process-environment (append env process-environment))
- (process-connection-type nil))
- (comint-exec (current-buffer) "inferior-lisp" program nil program-args))
- (lisp-mode-variables t)
- (let ((proc (get-buffer-process (current-buffer))))
- (slime-set-query-on-exit-flag proc)
- (run-hooks 'slime-inferior-process-start-hook)
- proc)))
- (defun slime-inferior-connect (process args)
- "Start a Swank server in the inferior Lisp and connect."
- (slime-delete-swank-port-file 'quiet)
- (slime-start-swank-server process args)
- (slime-read-port-and-connect process nil))
- (defvar slime-inferior-lisp-args nil
- "A buffer local variable in the inferior proccess.
- See `slime-start'.")
- (defun slime-start-swank-server (process args)
- "Start a Swank server on the inferior lisp."
- (destructuring-bind (&key coding-system init &allow-other-keys) args
- (with-current-buffer (process-buffer process)
- (make-local-variable 'slime-inferior-lisp-args)
- (setq slime-inferior-lisp-args args)
- (let ((str (funcall init (slime-swank-port-file) coding-system)))
- (goto-char (process-mark process))
- (insert-before-markers str)
- (process-send-string process str)))))
- (defun slime-inferior-lisp-args (process)
- "Return the initial process arguments.
- See `slime-start'."
- (with-current-buffer (process-buffer process)
- slime-inferior-lisp-args))
- ;; XXX load-server & start-server used to be separated. maybe that was better.
- (defun slime-init-command (port-filename coding-system)
- "Return a string to initialize Lisp."
- (let ((loader (if (file-name-absolute-p slime-backend)
- slime-backend
- (concat slime-path slime-backend)))
- (encoding (slime-coding-system-cl-name coding-system)))
- ;; Return a single form to avoid problems with buffered input.
- (format "%S\n\n"
- `(progn
- (load ,(slime-to-lisp-filename (expand-file-name loader))
- :verbose t)
- (funcall (read-from-string "swank-loader:init"))
- (funcall (read-from-string "swank:start-server")
- ,(slime-to-lisp-filename port-filename)
- :coding-system ,encoding)))))
- (defun slime-swank-port-file ()
- "Filename where the SWANK server writes its TCP port number."
- (concat (file-name-as-directory (slime-temp-directory))
- (format "slime.%S" (ema…
Large files files are truncated, but you can click here to view the full file