├── .gitignore ├── README.md ├── ros_emacs_utils ├── CMakeLists.txt └── package.xml ├── rosemacs ├── CMakeLists.txt ├── manifest.rnc ├── package.xml ├── poll-rosnode ├── poll-rostopic ├── rng-schemas.xml ├── rosbag-view-mode.el ├── rosemacs-config.el.in ├── rosemacs.el ├── roslaunch.rnc └── snippets │ └── c++-mode │ ├── rh.yasnippet │ ├── roscpp.yasnippet │ ├── rosmain.yasnippet │ └── rostest.yasnippet ├── roslisp_repl ├── CMakeLists.txt ├── package.xml ├── repl-config.el └── roslisp_repl ├── slime_ros ├── CMakeLists.txt ├── package.xml ├── sbclrc-ros.in ├── slime-config.el.in └── slime_ros_init └── slime_wrapper ├── CMakeLists.txt ├── package.xml └── slime ├── .gitref ├── .travis.yml ├── CONTRIBUTING.md ├── Makefile ├── NEWS ├── PROBLEMS ├── README.md ├── contrib ├── Makefile ├── README.md ├── bridge.el ├── inferior-slime.el ├── slime-asdf.el ├── slime-autodoc.el ├── slime-banner.el ├── slime-c-p-c.el ├── slime-cl-indent.el ├── slime-clipboard.el ├── slime-compiler-notes-tree.el ├── slime-editing-commands.el ├── slime-enclosing-context.el ├── slime-fancy-inspector.el ├── slime-fancy-trace.el ├── slime-fancy.el ├── slime-fontifying-fu.el ├── slime-fuzzy.el ├── slime-highlight-edits.el ├── slime-hyperdoc.el ├── slime-indentation.el ├── slime-listener-hooks.el ├── slime-macrostep.el ├── slime-mdot-fu.el ├── slime-media.el ├── slime-mrepl.el ├── slime-package-fu.el ├── slime-parse.el ├── slime-presentation-streams.el ├── slime-presentations.el ├── slime-quicklisp.el ├── slime-references.el ├── slime-repl.el ├── slime-ros.el ├── slime-sbcl-exts.el ├── slime-scheme.el ├── slime-scratch.el ├── slime-snapshot.el ├── slime-sprof.el ├── slime-trace-dialog.el ├── slime-tramp.el ├── slime-typeout-frame.el ├── slime-xref-browser.el ├── swank-arglists.lisp ├── swank-asdf.lisp ├── swank-c-p-c.lisp ├── swank-clipboard.lisp ├── swank-fancy-inspector.lisp ├── swank-fuzzy.lisp ├── swank-goo.goo ├── swank-hyperdoc.lisp ├── swank-ikarus.ss ├── swank-indentation.lisp ├── swank-jolt.k ├── swank-kawa.scm ├── swank-larceny.scm ├── swank-listener-hooks.lisp ├── swank-macrostep.lisp ├── swank-media.lisp ├── swank-mit-scheme.scm ├── swank-mlworks.sml ├── swank-mrepl.lisp ├── swank-package-fu.lisp ├── swank-presentation-streams.lisp ├── swank-presentations.lisp ├── swank-quicklisp.lisp ├── swank-r6rs.scm ├── swank-repl.lisp ├── swank-ros.lisp ├── swank-sbcl-exts.lisp ├── swank-snapshot.lisp ├── swank-sprof.lisp ├── swank-trace-dialog.lisp ├── swank-util.lisp ├── swank.rb └── test │ ├── slime-autodoc-tests.el │ ├── slime-c-p-c-tests.el │ ├── slime-cl-indent-test.txt │ ├── slime-enclosing-context-tests.el │ ├── slime-fontifying-fu-tests.el │ ├── slime-indentation-tests.el │ ├── slime-macrostep-tests.el │ ├── slime-mdot-fu-tests.el │ ├── slime-parse-tests.el │ ├── slime-presentations-tests.el │ └── slime-repl-tests.el ├── doc ├── .cvsignore ├── Makefile ├── contributors.texi ├── slime-refcard.tex ├── slime-small.eps ├── slime.css ├── slime.texi └── texinfo-tabulate.awk ├── lib ├── .nosearch ├── cl-lib.el ├── ert-x.el ├── ert.el ├── hyperspec.el └── macrostep.el ├── metering.lisp ├── nregex.lisp ├── packages.lisp ├── sbcl-pprint-patch.lisp ├── slime-autoloads.el ├── slime-tests.el ├── slime.el ├── start-swank.lisp ├── swank-loader.lisp ├── swank.asd ├── swank.lisp ├── swank ├── abcl.lisp ├── allegro.lisp ├── backend.lisp ├── ccl.lisp ├── clasp.lisp ├── clisp.lisp ├── cmucl.lisp ├── corman.lisp ├── ecl.lisp ├── gray.lisp ├── lispworks.lisp ├── match.lisp ├── mezzano.lisp ├── mkcl.lisp ├── rpc.lisp ├── sbcl.lisp ├── scl.lisp ├── source-file-cache.lisp └── source-path-parser.lisp └── xref.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *# 3 | rosemacs/rosemacs-config.el 4 | slime_ros/sbclrc-ros 5 | slime_ros/slime-config.el -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ros_emacs_utils 2 | ==================== 3 | 4 | This is a collection of packages to work on ROS-based software from Emacs. 5 | 6 | Supported are the versions of Emacs >= 24.3. For older versions please use the 7 | [older-than-emacs24.3 branch](https://github.com/code-iai/ros_emacs_utils/tree/older-than-emacs24.3). 8 | 9 | The repo contains a ```rosemacs``` package, which provides functions for starting a roscore, 10 | monitoring ROS nodes etc (with corresponding Emacs key bindings). 11 | And, in addition to that, it has a number of packages to simplify 12 | development of roslisp-based packages. Among them is 13 | a wrapper for Slime (Lisp interactive development environment) called ```slime_wrapper```, 14 | a contrib for Slime to work with ROS ```slime_ros```, 15 | and a Slime REPL called ```roslisp_repl```, configured to start slime, slime_ros and setup roslisp. 16 | 17 | This document only gives you instructions on installation. 18 | For other information consult the official wiki pages of the packages: 19 | [rosemacs](http://wiki.ros.org/rosemacs) for non Lisp programmers 20 | and [roslisp_repl](http://wiki.ros.org/roslisp_repl) otherwise. 21 | 22 | 23 | ## Not a Common Lisp programmer 24 | 25 | If you don't work with Common Lisp and just use Emacs for C++ or Python 26 | or Java or Lisp dialects other than Common Lisp or whatever else, 27 | you just need to add the following lines to your [Emacs initialization file](http://www.emacswiki.org/emacs/InitFile) (init.el or similar): 28 | 29 | ```lisp 30 | (add-to-list 'load-path "/opt/ros/DISTRO/share/emacs/site-lisp") 31 | (require 'rosemacs-config) 32 | ``` 33 | where ```DISTRO``` is the name of your ROS distribution, e.g. ```indigo```. 34 | 35 | ## Common Lisp programmer 36 | 37 | Currently, we are using an alternative branch of slime, which has not been merged into master yet. The version we use is distributed with the ROS Debian packages. Unfortunately, that means that our ROS Debian package of slime (`ros-indigo-slime-wrapper`) and official Debian of slime (`slime`) can collide. 38 | 39 | **It is strongly recommended to only use the ROS Debian package of `slime`, i.e.: `sudo apt-get purge slime` if you installed one before.** 40 | 41 | ### For users 42 | 43 | If you work with roslisp, all you need to do is to start ```roslisp_repl``` in the terminal. 44 | 45 | If you want to start the REPL from inside of your Emacs process, add the following to your Emacs init script: 46 | 47 | ```lisp 48 | (require 'slime-config "PATH_TO_SLIME_ROS/slime-config.el") 49 | ``` 50 | where ```PATH_TO_SLIME_ROS``` is what ```rospack find slime_ros``` gives you, e.g. ```"/opt/ros/indigo/share/slime_ros"```, or ```"YOUR_CATKIN_WS/src/ros_emacs_utils/slime_ros"``` 51 | if you're installing from source. After that line you can add the usual Slime 52 | customization commands, like setting the ```inferior-lisp-program``` or 53 | turning off the ```slime-startup-animation``` etc. 54 | 55 | Then you need to run 56 | ```bash 57 | $ rosrun slime_ros slime_ros_init 58 | ``` 59 | which will create ```.sbclrc-ros``` in your home directory 60 | and add an entry into your ```.sbclrs``` to load ```.sbclrc-ros```. 61 | 62 | Once set up, you can start the REPL from your Emacs by pressing ```M-x slime```, 63 | which means holding the ```Alt``` key and pressing ```x``` and then typing 64 | ```slime``` . 65 | 66 | ### For developers 67 | 68 | There is one detail to take into account when **compiling ros_emacs_utils from source**: 69 | in order for the code to work you not only need to run ```catkin_make``` on the packages, 70 | but also install them (```catkin_make install```). 71 | 72 | Why do we need to ```catkin_make install```? (Skip the next two paragraphs if you don't care.) 73 | 74 | All the packages have their Emacs Lisp part contained in a single or multiple ```*.el``` files. 75 | During installation of the packages those files are being copied 76 | into ```YOUR_INSTALL_DIR/share/emacs/site-lisp```. Therefore, you need to tell Emacs 77 | in the initialization script to add that directory to the Emacs ```load-path``` 78 | in a recursive way. That is done in ```rosemacs-config.el```. 79 | 80 | In addition to the Emacs Lisp part, all the packages except ```rosemacs``` 81 | have a Common Lisp part, and all the ```*.lisp``` files are being copied 82 | into ```YOUR_INSTALL_DIR/share/common-lisp/source```, 83 | this replicates the Debian approach to installing Emacs Lisp and Common Lisp files. 84 | Therefore, you need to tell your Common Lisp compiler, actually linker, i.e. ASDF, 85 | to search for systems in that directory. That is done in ```.sbclrc```, 86 | or, more correctly, in ```.sbclrc-ros```. As you can see, right now only SBCL is supported. 87 | The original file can be found in your ```slime_ros``` ROS package under the name ```sbclrc-ros```. 88 | When starting the ```roslisp_repl``` executable, ```slime_ros_init``` is called, 89 | which in its turn copies ```sbclrc-ros``` into the home directory, 90 | and adds a necessary entry into ```.sbclrc```. 91 | Check the ```slime_ros_init``` executable from ```slime_ros``` package for more info. 92 | 93 | ## System requirements 94 | 95 | * Emacs24.3+ 96 | * For Common Lisp developers: SBCL as the preferred compiler 97 | 98 | 99 | ## FAQ 100 | 101 | * Q: Why doesn't my ```roslisp_repl``` start properly / find ```rosemacs```? 102 | * A: Probably because you didn't install the ```ros_emacs_utils``` packages, 103 | e.g. ```catkin_make install``` them. 104 | Just follow the directions in the error pop up winodw (or echo buffer) of your Emacs. 105 | 106 | - 107 | 108 | * Q: It says component "swank" cannot be found. 109 | * A: There might be something wrong in your ```.sbclrc``` or ```.sbclrc-ros```. 110 | Try calling ```rosrun slime_ros slime_ros_init``` if you haven't done that yet. 111 | (When starting REPL through ```roslisp_repl``` the script is called automatically.) 112 | 113 | - 114 | 115 | * Q: It still doesn't work! 116 | * A: Please file a bug report on Github. 117 | -------------------------------------------------------------------------------- /ros_emacs_utils/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.0.2) 2 | project(ros_emacs_utils) 3 | find_package(catkin REQUIRED) 4 | catkin_metapackage() 5 | -------------------------------------------------------------------------------- /ros_emacs_utils/package.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | ros_emacs_utils 4 | 0.4.18 5 | 6 | A metapackage of Emacs utils for ROS. 7 | Only there for simplifying the release process. 8 | 9 | 10 | Gayane Kazhoyan 11 | BSD 12 | http://github.com/code-iai/ros_emacs_utils 13 | 14 | catkin 15 | rosemacs 16 | roslisp_repl 17 | slime_wrapper 18 | slime_ros 19 | 20 | 21 | 22 | 23 | 24 | -------------------------------------------------------------------------------- /rosemacs/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | 2 | cmake_minimum_required(VERSION 3.0.2) 3 | project(rosemacs) 4 | 5 | find_package(catkin REQUIRED) 6 | catkin_package() 7 | 8 | ############### 9 | ## Configure ## 10 | ############### 11 | 12 | configure_file( 13 | ${PROJECT_SOURCE_DIR}/rosemacs-config.el.in 14 | ${PROJECT_SOURCE_DIR}/rosemacs-config.el) 15 | 16 | ############# 17 | ## Install ## 18 | ############# 19 | 20 | install(FILES rosemacs.el rosbag-view-mode.el rosemacs-config.el 21 | DESTINATION ${CATKIN_GLOBAL_SHARE_DESTINATION}/emacs/site-lisp) 22 | 23 | install(PROGRAMS poll-rosnode poll-rostopic 24 | DESTINATION ${CATKIN_GLOBAL_SHARE_DESTINATION}/emacs/site-lisp) 25 | 26 | install(FILES manifest.rnc roslaunch.rnc rng-schemas.xml 27 | DESTINATION ${CATKIN_GLOBAL_SHARE_DESTINATION}/emacs/site-lisp) 28 | 29 | foreach(subdir 30 | c++-mode) 31 | install(DIRECTORY snippets/${subdir} 32 | DESTINATION ${CATKIN_GLOBAL_SHARE_DESTINATION}/emacs/site-lisp/snippets) 33 | endforeach() 34 | -------------------------------------------------------------------------------- /rosemacs/manifest.rnc: -------------------------------------------------------------------------------- 1 | # A RELAX NG schema for manifest.xml files 2 | grammar { 3 | start = package 4 | package = element package { 5 | description & 6 | author & 7 | license & 8 | review & 9 | url & 10 | (depend* & platform* & rosdep* & export*) 11 | } 12 | description = element description { 13 | attribute brief { text }?, 14 | text 15 | } 16 | author = element author { text } 17 | license = element license { text } 18 | review = element review { 19 | attribute status { text }, 20 | attribute notes { text } 21 | } 22 | url = element url { text } 23 | depend = element depend { attribute package { text } } 24 | export = element export { text & nodelet? } 25 | nodelet = element nodelet { attribute plugin } 26 | rosdep = element rosdep { attribute name { text } } 27 | platform = element platform { 28 | attribute os { text }, 29 | attribute version { text } 30 | } 31 | } 32 | 33 | -------------------------------------------------------------------------------- /rosemacs/package.xml: -------------------------------------------------------------------------------- 1 | 2 | rosemacs 3 | 0.4.18 4 | ROS tools for those who live in Emacs. 5 | 6 | Bhaskara Marthi 7 | Gayane Kazhoyan 8 | BSD 9 | http://www.ros.org/wiki/rosemacs 10 | https://github.com/code-iai/ros_emacs_utils 11 | 12 | catkin 13 | emacs 14 | 15 | -------------------------------------------------------------------------------- /rosemacs/poll-rosnode: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | # Used by rosemacs rosnode mode to keep track of current ros rosnode 3 | 4 | while [ 1 ] 5 | do 6 | echo "BEGIN ROSNODE LIST" 7 | rosnode list 8 | echo "END ROSNODE LIST" 9 | sleep $1 10 | done 11 | -------------------------------------------------------------------------------- /rosemacs/poll-rostopic: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | # Used by rosemacs rostopic mode to keep track of current ros topics 3 | 4 | while [ 1 ] 5 | do 6 | echo "BEGIN ROSTOPIC LIST" 7 | rostopic list -v 8 | echo "END ROSTOPIC LIST" 9 | sleep $1 10 | done 11 | -------------------------------------------------------------------------------- /rosemacs/rng-schemas.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /rosemacs/rosbag-view-mode.el: -------------------------------------------------------------------------------- 1 | (define-derived-mode rosbag-view-mode 2 | fundamental-mode "Rosbag view mode" 3 | "Major mode for viewing ROS bag files. See view-mode documentation for more info. 4 | 5 | \\{rosbag-view-mode-map}" 6 | (let ((f (buffer-file-name))) 7 | (let ((buffer-read-only nil)) 8 | (erase-buffer) 9 | (message "Calling rosbag info") 10 | (call-process "rosbag" nil (current-buffer) nil 11 | "info" f) 12 | (set-buffer-modified-p nil)) 13 | (view-mode) 14 | (set-visited-file-name nil t) 15 | )) 16 | 17 | 18 | 19 | (provide 'rosbag-view-mode) -------------------------------------------------------------------------------- /rosemacs/rosemacs-config.el.in: -------------------------------------------------------------------------------- 1 | 2 | ;;; Recursively add relevant load paths 3 | (let ((default-directory "${CMAKE_INSTALL_PREFIX}/share/emacs/site-lisp")) 4 | (cond ((file-directory-p default-directory) 5 | (setq load-path 6 | (append 7 | (let ((load-path (copy-sequence load-path))) ;; Shadow 8 | (append 9 | (copy-sequence (normal-top-level-add-to-load-path '("."))) 10 | (normal-top-level-add-subdirs-to-load-path))) 11 | load-path))) 12 | (t 13 | (message-box "Can't find the .el files! 14 | Did you forget to install the ros_emacs_utils packages? 15 | If so, run \"catkin_make install\" in your catkin workspace 16 | or, if you prefer to only install the specific package, 17 | run \"catkin_make install --pkg PACKAGE\" where PACKAGE is 18 | rosemacs, slime_wrapper, slime_ros and roslisp_repl.")))) 19 | 20 | ;;; Default modes list. Mostly there to make sure Yasnippets work. 21 | ;;; Will overwrite the settings from your emacs init file, so be careful... 22 | (setq auto-mode-alist 23 | (append '(("\\.C$" . c++-mode) 24 | ("\\.cc$" . c++-mode) 25 | ("\\.c$" . c-mode) 26 | ("\\.h$" . c++-mode) 27 | ("makefile$" . makefile-mode) 28 | ("Makefile$" . makefile-mode) 29 | ("\\.asd" . lisp-mode) 30 | ("\\.launch" . xml-mode)) auto-mode-alist)) 31 | 32 | ;;; Yasnippets: templates for standard structures. E.g. wgh TAB in a *.h file. 33 | (if (require 'yasnippet nil 'noerror) 34 | (progn 35 | (add-to-list 'yas-snippet-dirs "${CMAKE_INSTALL_PREFIX}/share/emacs/site-lisp/snippets") 36 | (yas-global-mode 1)) 37 | (message "Yasnippet library is not installed. You can install it, e.g., with ELPA.")) 38 | 39 | ;;; Load / set up rosemacs 40 | (require 'rosemacs) 41 | (invoke-rosemacs) 42 | (global-set-key "\C-x\C-r" ros-keymap) 43 | 44 | (provide 'rosemacs-config) 45 | -------------------------------------------------------------------------------- /rosemacs/roslaunch.rnc: -------------------------------------------------------------------------------- 1 | # A RELAX NG schema for ros launch files 2 | grammar { 3 | start = launch 4 | launch = element launch { 5 | ( node* & param* & inc* & group* & rosparam* & env* & arg* & remap* & test* & machine* ) 6 | } 7 | group = element group { 8 | attribute ns { text }? & 9 | attribute clear_params { "true" | "false" }? & 10 | attribute if { text }? & 11 | attribute unless { text }? & 12 | ( node* & param* & inc* & group* & rosparam* & env* & arg* & remap* & test* & machine* ) 13 | } 14 | node = element node { 15 | attribute name { text } & 16 | attribute pkg { text } & 17 | attribute type { text } & 18 | attribute args { text }? & 19 | attribute machine { text }? & 20 | attribute respawn { "true" | "false" }? & 21 | attribute respawn_delay { text }? & 22 | attribute required { text }? & 23 | attribute ns { text }? & 24 | attribute clear_params { "true" | "false" }? & 25 | attribute output { "log" | "screen" }? & 26 | attribute cwd { "ROS_HOME" | "node" }? & 27 | attribute launch-prefix { text }? & 28 | attribute if { text }? & 29 | attribute unless { text }? & 30 | ( env* & param* & remap* & rosparam* ) 31 | } 32 | env = element env { 33 | attribute name { text } & 34 | attribute value { text } & 35 | attribute if { text }? & 36 | attribute unless { text }? 37 | } 38 | param = element param { 39 | attribute name { text } & 40 | attribute value { text }? & 41 | attribute type { "str" | "int" | "double" | "bool" | "yaml" }? & 42 | attribute textfile { text }? & 43 | attribute binfile { text}? & 44 | attribute command { text }? & 45 | attribute if { text }? & 46 | attribute unless { text }? 47 | } 48 | arg = element arg { 49 | attribute name { text } & 50 | attribute default { text }? & 51 | attribute value { text }? & 52 | attribute doc { text }? & 53 | attribute if { text }? & 54 | attribute unless { text }? 55 | } 56 | rosparam = element rosparam { 57 | attribute command { text }? & 58 | attribute file { text }? & 59 | attribute param { text }? & 60 | attribute ns { text }? & 61 | attribute subst_value { "true" | "false" }? & 62 | attribute if { text }? & 63 | attribute unless { text }? & 64 | ( text ) 65 | } 66 | machine = element machine { 67 | attribute if { text }? & 68 | attribute unless { text }? & 69 | attribute name { text } & 70 | attribute address { text } & 71 | attribute env-loader { text }* & 72 | attribute default { "true" | "false" | "never" }? & 73 | attribute user { text }? & 74 | attribute password { text }? & 75 | attribute timeout { text }? & 76 | attribute if { text }? & 77 | attribute unless { text }? 78 | } 79 | remap = element remap { 80 | attribute from { text } & 81 | attribute to { text } & 82 | attribute if { text }? & 83 | attribute unless { text }? 84 | } 85 | inc = element include { 86 | attribute file { text } & 87 | attribute ns { text }? & 88 | attribute clear_params { "true" | "false" }? & 89 | attribute pass_all_args { "true" | "false" }? & 90 | attribute if { text }? & 91 | attribute unless { text }? & 92 | ( env* & arg* ) 93 | } 94 | test = element test { 95 | attribute pkg { text } & 96 | attribute test-name { text } & 97 | attribute type { text } & 98 | attribute name { text }? & 99 | attribute args { text }? & 100 | attribute clear_params { "true" | "false" }? & 101 | attribute cwd { text }? & 102 | attribute launch-prefix { text }? & 103 | attribute ns { text }? & 104 | attribute retry { text }? & 105 | attribute time-limit { text }? & 106 | attribute if { text }? & 107 | attribute unless { text }? & 108 | ( param* & remap* & rosparam* & env* ) 109 | } 110 | } 111 | -------------------------------------------------------------------------------- /rosemacs/snippets/c++-mode/rh.yasnippet: -------------------------------------------------------------------------------- 1 | # -*- mode: snippet -*- 2 | # name: header file with include guards, namespace 3 | # expand-env: ((pkg (ros-package-for-buffer (current-buffer) t)) (fname (file-name-nondirectory (file-name-sans-extension (buffer-file-name (current-buffer)))))) 4 | # -- 5 | /** 6 | * \file 7 | * 8 | * ${1:FILE DESCRIPTION} 9 | * 10 | * \author ${2:AUTHOR} 11 | */ 12 | 13 | #ifndef `(upcase pkg)`_`(upcase fname)`_H 14 | #define `(upcase pkg)`_`(upcase fname)`_H 15 | 16 | namespace `pkg` 17 | { 18 | 19 | $0 20 | 21 | } // namespace 22 | 23 | #endif // include guard 24 | -------------------------------------------------------------------------------- /rosemacs/snippets/c++-mode/roscpp.yasnippet: -------------------------------------------------------------------------------- 1 | # -*- mode: snippet -*- 2 | # name: Ros source file 3 | # expand-env: ((pkg (ros-package-for-buffer (current-buffer) t)) (fname (file-name-nondirectory (file-name-sans-extension (buffer-file-name (current-buffer)))))) 4 | # -- 5 | /** 6 | * \file 7 | * 8 | * ${1:FILE DESCRIPTION} 9 | * 10 | * \author ${2:AUTHOR} 11 | */ 12 | 13 | #include <${3:INCLUDES}> 14 | 15 | namespace `pkg` 16 | { 17 | 18 | $0 19 | 20 | } // namespace 21 | -------------------------------------------------------------------------------- /rosemacs/snippets/c++-mode/rosmain.yasnippet: -------------------------------------------------------------------------------- 1 | # -*- mode: snippet -*- 2 | # name: main() for a ros node 3 | # -- 4 | int main (int argc, char** argv) 5 | { 6 | ros::init(argc, argv, "`(file-name-nondirectory (file-name-sans-extension (buffer-file-name (current-buffer))))`"); 7 | ${1:NODE_CLASS} node; 8 | ros::spin(); 9 | return 0; 10 | } -------------------------------------------------------------------------------- /rosemacs/snippets/c++-mode/rostest.yasnippet: -------------------------------------------------------------------------------- 1 | # -*- mode: snippet -*- 2 | # name: Ros test source file 3 | # expand-env: ((pkg (ros-package-for-buffer (current-buffer) t)) (fname (file-name-nondirectory (file-name-sans-extension (buffer-file-name (current-buffer)))))) 4 | # -- 5 | /** 6 | * \file 7 | * 8 | * ${1:FILE DESCRIPTION} 9 | * 10 | * \author ${2:AUTHOR} 11 | */ 12 | 13 | #include <${3:INCLUDES}> 14 | 15 | namespace `pkg` 16 | { 17 | 18 | $0 19 | 20 | } // namespace 21 | -------------------------------------------------------------------------------- /roslisp_repl/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | 2 | cmake_minimum_required(VERSION 3.0.2) 3 | project(roslisp_repl) 4 | 5 | find_package(catkin REQUIRED) 6 | catkin_package() 7 | 8 | ############# 9 | ## Install ## 10 | ############# 11 | 12 | install(FILES repl-config.el 13 | DESTINATION ${CATKIN_PACKAGE_SHARE_DESTINATION}) 14 | 15 | install(PROGRAMS roslisp_repl 16 | DESTINATION ${CATKIN_GLOBAL_BIN_DESTINATION}) 17 | -------------------------------------------------------------------------------- /roslisp_repl/package.xml: -------------------------------------------------------------------------------- 1 | 2 | roslisp_repl 3 | 0.4.18 4 | 5 | This package provides a script that launches Emacs with Slime (the 6 | Superior Lisp Interaction Mode) ready for Lisp development and 7 | roslisp. 8 | 9 | 10 | Gayane Kazhoyan 11 | Lorenz Moesenlechner 12 | Public domain 13 | https://github.com/code-iai/ros_emacs_utils 14 | 15 | catkin 16 | slime_wrapper 17 | slime_ros 18 | sbcl 19 | roslisp 20 | rosemacs 21 | 22 | -------------------------------------------------------------------------------- /roslisp_repl/repl-config.el: -------------------------------------------------------------------------------- 1 | 2 | ;;; General configuration 3 | (customize-set-variable 'indent-tabs-mode nil) 4 | (setq default-tab-width 2) 5 | (global-font-lock-mode t) 6 | (setq query-replace-highlight t) 7 | (setq search-highlight t) 8 | (show-paren-mode 1) 9 | (global-set-key '[delete] 'delete-char) 10 | (setq minibuffer-max-depth nil) 11 | (autoload 'mwheel-install "mwheel" "Enable mouse wheel support.") 12 | ;; Enable copy-pasting between programs (Kill-ring <-> x11) 13 | (setq x-select-enable-clipboard t) 14 | (cond 15 | ((fboundp 'x-cut-buffer-or-selection-value) 16 | (setq interprogram-paste-function 'x-cut-buffer-or-selection-value)) 17 | ((fboundp 'x-selection-value) ;; emacs 24 or later 18 | (setq interprogram-paste-function 'x-selection-value)) 19 | (t (setq x-select-enable-clipboard nil))) ;; no connection to X server 20 | 21 | ;; initialize ELPA packages 22 | ;; this is useful, e.g., is someone installed yasnippet from ELPA 23 | (package-initialize) 24 | 25 | ;;; Start slime 26 | ;; ``slime-config`` is located in the ``slime_ros`` package. 27 | ;; It's path is passed to emacs through the -L argument of 28 | ;; the ``roslisp_repl`` executable. 29 | (require 'slime-config) 30 | 31 | ;; The following gets rid of the gray highlighting of uncompiled code 32 | ;; that can be confusing and annoying for the beginner Lispers. 33 | (add-hook 'slime-mode-hook (lambda () (slime-highlight-edits-mode 0))) 34 | 35 | ;; some key bindings to, e.g., enable easy autocompletion etc. 36 | (eval-after-load 'slime 37 | '(progn 38 | ;; Fix for M-, when using it with dired and A 39 | (define-key slime-mode-map (kbd "M-,") 40 | (lambda () 41 | (interactive) 42 | (condition-case nil 43 | (slime-pop-find-definition-stack) 44 | (error (tags-loop-continue))))) 45 | (global-set-key "\C-cs" 'slime-selector) 46 | (define-key slime-repl-mode-map (kbd "C-M-") 47 | 'slime-repl-delete-current-input) 48 | (define-key slime-mode-map "\r" 'newline-and-indent) 49 | (define-key slime-mode-map [tab] 50 | (lambda () 51 | (interactive) 52 | (slime-fuzzy-indent-and-complete-symbol))) 53 | (define-key slime-mode-map (kbd "M-a") 54 | (lambda () 55 | (interactive) 56 | (let ((ppss (syntax-ppss))) 57 | (if (nth 3 ppss) 58 | (goto-char (1+ (nth 8 ppss))) 59 | (progn 60 | (backward-up-list 1) 61 | (down-list 1)))))) 62 | (define-key slime-mode-map (kbd "M-e") 63 | (lambda () 64 | (interactive) 65 | (let ((ppss (syntax-ppss))) 66 | (if (nth 3 ppss) 67 | (progn 68 | (goto-char (nth 8 ppss)) 69 | (forward-sexp 1) 70 | (backward-char 1)) 71 | (progn 72 | (up-list 1) 73 | (backward-down-list 1)))))))) 74 | 75 | ;;; [ and ] should be handled paranthesis-like in lisp files. 76 | (modify-syntax-entry ?\[ "(] " lisp-mode-syntax-table) 77 | (modify-syntax-entry ?\] ")[ " lisp-mode-syntax-table) 78 | 79 | (slime) 80 | 81 | (delete-other-windows) 82 | 83 | ;;; Footer 84 | (provide 'repl-config) 85 | -------------------------------------------------------------------------------- /roslisp_repl/roslisp_repl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | SLIME_ROS_DIR=$(rospack find slime_ros) 4 | ${SLIME_ROS_DIR}/slime_ros_init 5 | 6 | ROSLISP_REPL_DIR=$(rospack find roslisp_repl) 7 | emacs -q -L ${ROSLISP_REPL_DIR} -L ${SLIME_ROS_DIR} --eval "(require 'repl-config)" 8 | -------------------------------------------------------------------------------- /slime_ros/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | 2 | cmake_minimum_required(VERSION 3.0.2) 3 | project(slime_ros) 4 | 5 | find_package(catkin REQUIRED) 6 | catkin_package() 7 | 8 | ############### 9 | ## Configure ## 10 | ############### 11 | 12 | configure_file( 13 | ${PROJECT_SOURCE_DIR}/sbclrc-ros.in 14 | ${PROJECT_SOURCE_DIR}/sbclrc-ros) 15 | configure_file( 16 | ${PROJECT_SOURCE_DIR}/slime-config.el.in 17 | ${PROJECT_SOURCE_DIR}/slime-config.el) 18 | 19 | ############# 20 | ## Install ## 21 | ############# 22 | 23 | install(FILES slime-config.el sbclrc-ros 24 | DESTINATION ${CATKIN_PACKAGE_SHARE_DESTINATION}) 25 | 26 | install(PROGRAMS slime_ros_init 27 | DESTINATION ${CATKIN_PACKAGE_SHARE_DESTINATION}) 28 | -------------------------------------------------------------------------------- /slime_ros/package.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | slime_ros 4 | 0.4.18 5 | Extensions for slime to assist in working with ROS packages 6 | 7 | Gayane Kazhoyan 8 | Bhaskara Marthi 9 | Public Domain 10 | https://github.com/code-iai/ros_emacs_utils 11 | 12 | catkin 13 | rosemacs 14 | slime_wrapper 15 | sbcl 16 | roslisp 17 | 18 | -------------------------------------------------------------------------------- /slime_ros/sbclrc-ros.in: -------------------------------------------------------------------------------- 1 | ;;; AUTOGENERATED FILE, PLEASE DO NOT EDIT: USE ~/.sbclrc INSTEAD 2 | 3 | ;;; asdf source registry entries 4 | (require 'asdf) 5 | (pushnew #p"${CMAKE_INSTALL_PREFIX}/share/common-lisp/source/" 6 | asdf:*central-registry* :test #'equal) 7 | -------------------------------------------------------------------------------- /slime_ros/slime-config.el.in: -------------------------------------------------------------------------------- 1 | 2 | (when (< emacs-major-version 24) 3 | (error "ERROR! (slime-config.el): Emacs versions smaller than 24 are not supported by the current implementation of Slime. Sorry. Please make sure your default Emacs version is 24.")) 4 | 5 | (add-to-list 'load-path "${CMAKE_INSTALL_PREFIX}/share/emacs/site-lisp") 6 | (require 'rosemacs-config) 7 | 8 | (require 'slime-autoloads) 9 | ;; (setq slime-backend "swank-loader.lisp") 10 | (add-hook 'inferior-lisp-mode-hook (lambda () (inferior-slime-mode 1))) 11 | 12 | ;; If you don't like the highlighting of new uncompiled code, uncomment this: 13 | ;; (add-hook 'slime-mode-hook (lambda () (slime-highlight-edits-mode 0))) 14 | 15 | (setq inferior-lisp-program "/usr/bin/sbcl --dynamic-space-size 4096") 16 | (setq slime-lisp-implementations nil) 17 | 18 | (setq slime-contribs '(slime-repl 19 | slime-autodoc 20 | slime-c-p-c 21 | slime-editing-commands 22 | slime-fancy-inspector 23 | slime-fancy-trace 24 | slime-fuzzy 25 | slime-presentations 26 | slime-scratch 27 | slime-references 28 | slime-package-fu 29 | slime-fontifying-fu 30 | slime-trace-dialog 31 | slime-asdf 32 | slime-indentation 33 | slime-xref-browser 34 | slime-highlight-edits 35 | slime-ros)) 36 | 37 | (setq slime-complete-symbol-function 'slime-fuzzy-complete-symbol) 38 | 39 | (provide 'slime-config) 40 | -------------------------------------------------------------------------------- /slime_ros/slime_ros_init: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | SLIME_ROS_DIR=$(rospack find slime_ros) 4 | 5 | [ -f ${HOME}/.sbclrc ] && grep -Fq "###sbclrc-ros###" ${HOME}/.sbclrc || 6 | echo " 7 | ;;; AUTOGENERATED PART. PLEASE DO NOT DELETE THIS AND THE FOLLOWING 2 LINES 8 | ;;; ###sbclrc-ros### SLIME ROS RELATED STUFF 9 | (load (merge-pathnames (make-pathname :name \".sbclrc-ros\") (user-homedir-pathname))) 10 | " >> ${HOME}/.sbclrc 11 | 12 | cp ${SLIME_ROS_DIR}/sbclrc-ros ${HOME}/.sbclrc-ros 13 | -------------------------------------------------------------------------------- /slime_wrapper/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.0.2) 2 | project(slime_wrapper) 3 | find_package(catkin REQUIRED) 4 | catkin_package() 5 | 6 | ############# 7 | ## Install ## 8 | ############# 9 | 10 | install(DIRECTORY slime 11 | DESTINATION ${CATKIN_GLOBAL_SHARE_DESTINATION}/emacs/site-lisp) 12 | -------------------------------------------------------------------------------- /slime_wrapper/package.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | slime_wrapper 4 | 0.4.18 5 | ROS wrapper for slime 6 | 7 | Gayane Kazhoyan 8 | Public domain 9 | http://common-lisp.net/project/slime 10 | https://github.com/code-iai/ros_emacs_extensions 11 | 12 | catkin 13 | emacs 14 | 15 | -------------------------------------------------------------------------------- /slime_wrapper/slime/.gitref: -------------------------------------------------------------------------------- 1 | 413e43573b2201e384f791bf348fad42e7b5b415 -------------------------------------------------------------------------------- /slime_wrapper/slime/.travis.yml: -------------------------------------------------------------------------------- 1 | language: emacs 2 | 3 | env: 4 | # we test emacs23 with sbcl only 5 | - "CHECK_TARGET=check LISP=sbcl EMACS=emacs23" 6 | - "CHECK_TARGET=check-fancy LISP=sbcl EMACS=emacs23" 7 | 8 | # for emacs24, use more combinations 9 | - "CHECK_TARGET=check LISP=sbcl EMACS=emacs24" 10 | #- "CHECK_TARGET=check LISP=cmucl EMACS=emacs24" 11 | - "CHECK_TARGET=check LISP=ccl EMACS=emacs24" 12 | - "CHECK_TARGET=check-fancy LISP=sbcl EMACS=emacs24" 13 | #- "CHECK_TARGET=check-fancy LISP=cmucl EMACS=emacs24" 14 | - "CHECK_TARGET=check-fancy LISP=ccl EMACS=emacs24" 15 | 16 | # also, for emacs24/sbcl test some more contribs in isolation 17 | - "CHECK_TARGET=check-repl LISP=sbcl EMACS=emacs24" 18 | - "CHECK_TARGET=check-indentation LISP=sbcl EMACS=emacs24" 19 | 20 | install: 21 | - curl https://raw.githubusercontent.com/luismbo/cl-travis/master/install.sh | bash 22 | - if [ "$EMACS" = "emacs23" ]; then 23 | sudo apt-get -qq update && 24 | sudo apt-get -qq -f install && 25 | sudo apt-get -qq install emacs23-nox; 26 | fi 27 | - if [ "$EMACS" = "emacs24" ]; then 28 | sudo add-apt-repository -y ppa:cassou/emacs && 29 | sudo apt-get -qq update && 30 | sudo apt-get -qq -f install && 31 | sudo apt-get -qq install emacs24-nox; 32 | fi 33 | 34 | script: 35 | - make LISP=$LISP EMACS=$EMACS $CHECK_TARGET 36 | 37 | notifications: 38 | email: 39 | recipients: 40 | - slime-cvs@common-lisp.net 41 | # on_success: always # for testing 42 | -------------------------------------------------------------------------------- /slime_wrapper/slime/CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # The SLIME Hacker's Handbook 2 | 3 | ## Lisp code file structure 4 | 5 | The Lisp code is organised into these files: 6 | 7 | * `swank-backend.lisp`: Definition of the interface to non-portable 8 | features. Stand-alone. 9 | 10 | * `swank-.lisp`: Backend implementation for a specific 11 | Common Lisp system. Uses swank-backend.lisp. 12 | 13 | * `swank.lisp`: The top-level server program, built from the other 14 | components. Uses swank-backend.lisp as an interface to the actual 15 | backends. 16 | 17 | * `slime.el`: The Superior Lisp Inferior Mode for Emacs, i.e. the 18 | Emacs frontend that the user actually interacts with and that connects 19 | to the SWANK server to send expressions to, and retrieve information 20 | from the running Common Lisp system. 21 | 22 | * `contrib/*.lisp`: Lisp related code for add-ons to SLIME that are 23 | maintained by their respective authors. Consult contrib/README for 24 | more information. 25 | 26 | ## Test Suite 27 | 28 | The Makefile includes a `check` target to run the ERT-based test 29 | suite. This can give a pretty good sanity-check for your changes 30 | 31 | Some backends do not pass the full test suite because of missing 32 | features. In these cases the test suite is still useful to ensure that 33 | changes don't introduce new errors. CMUCL historically passes the full 34 | test suite so it makes a good sanity check for fundamental changes 35 | (e.g. to the protocol). 36 | 37 | Running the test suite, adding new cases, and increasing the number of 38 | cases that backends support are all very good for karma. 39 | 40 | 41 | ## Source code layout 42 | 43 | We use a special source file layout to take advantage of some fancy 44 | Emacs features: outline-mode and "narrowing". 45 | 46 | ### Outline structure 47 | 48 | Our source files have a hierarchical structure using comments like 49 | these: 50 | 51 | ```el 52 | ;;;; Heading 53 | ;;;;; Subheading 54 | ... etc 55 | ``` 56 | 57 | We do this as a nice way to structure the program. We try to keep each 58 | (sub)section small enough to fit in your head: typically around 50-200 59 | lines of code each. Each section usually begins with a brief 60 | introduction, followed by its highest-level functions, followed by 61 | their subroutines. This is a pleasing shape for a source file to have. 62 | 63 | Of course the comments mean something to Emacs too. One handy usage is 64 | to bring up a hyperlinked "table of contents" for the source file 65 | using this command: 66 | 67 | ```el 68 | (defun show-outline-structure () 69 | "Show the outline-mode structure of the current buffer." 70 | (interactive) 71 | (occur (concat "^" outline-regexp))) 72 | ``` 73 | 74 | Another is to use `outline-minor-mode` to fold away certain parts of 75 | the buffer. See the `Outline Mode` section of the Emacs manual for 76 | details about that. 77 | 78 | ### Pagebreak characters (^L) 79 | 80 | We partition source files into chunks using pagebreak characters. Each 81 | chunk is a substantial piece of code that can be considered in 82 | isolation, that could perhaps be a separate source file if we were 83 | fanatical about small source files (rather than big ones!) 84 | 85 | The page breaks usually go in the same place as top-level outline-mode 86 | headings, but they don't have to. They're flexible. 87 | 88 | In the old days, when `slime.el` was less than 100 pages long, these 89 | page breaks were helpful when printing it out to read. Now they're 90 | useful for something else: narrowing. 91 | 92 | You can use `C-x n p` (`narrow-to-page`) to "zoom in" on a 93 | pagebreak-delimited section of the file as if it were a separate 94 | buffer in itself. You can then use `C-x n w` (`widen`) to "zoom out" and 95 | see the whole file again. This is tremendously helpful for focusing 96 | your attention on one part of the program as if it were its own file. 97 | 98 | (This file contains some page break characters. If you're reading in 99 | Emacs you can press `C-x n p` to narrow to this page, and then later 100 | `C-x n w` to make the whole buffer visible again.) 101 | 102 | 103 | ## Coding style 104 | 105 | We like the fact that each function in SLIME will fit on a single 106 | screen (80x20), and would like to preserve this property! Beyond that 107 | we're not dogmatic :-) 108 | 109 | In early discussions we all made happy noises about the advice in 110 | Norvig and Pitman's 111 | [Tutorial on Good Lisp Programming Style](http://www.norvig.com/luv-slides.ps). 112 | 113 | For Emacs Lisp, we try to follow the _Tips and Conventions_ in 114 | Appendix D of the GNU Emacs Lisp Reference Manual (see Info file 115 | `elisp`, node `Tips`). 116 | 117 | We use Emacs conventions for docstrings: the first line should be a 118 | complete sentence to make the output of `apropos` look good. We also 119 | use imperative verbs. 120 | 121 | Now that XEmacs support is gone, rewrites using packages in GNU 122 | Emacs's core get extra karma. 123 | 124 | Customization variables complicate testing and therefore we only add 125 | new ones after careful consideration. Adding new customization 126 | variables is bad for karma. 127 | 128 | We generally neither use nor recommend eval-after-load. 129 | 130 | The biggest problem with SLIME's code base is feature creep. Keep in 131 | mind that the Right Thing isn't always the Smart Thing. If you can't 132 | find an elegant solution to a problem then you're probably solving the 133 | wrong problem. It's often a good idea to simplify the problem and to 134 | ignore rarely needed cases. 135 | 136 | _Remember that to rewrite a program better is the sincerest form of 137 | code appreciation. When you can see a way to rewrite a part of SLIME 138 | better, please do so!_ 139 | 140 | 141 | 142 | ## Pull requests 143 | 144 | * Read [how to properly contribute to open source projects on Github][1]. 145 | * Use a topic branch to easily amend a pull request later, if necessary. 146 | * Open a [pull request][2] that relates to *only* one subject with a 147 | clear title and description in grammatically correct, complete 148 | sentences. 149 | * Write [good commit messages][3]. 150 | 151 | [1]: http://gun.io/blog/how-to-github-fork-branch-and-pull-request 152 | [2]: https://help.github.com/articles/using-pull-requests 153 | [3]: http://chris.beams.io/posts/git-commit/ 154 | -------------------------------------------------------------------------------- /slime_wrapper/slime/Makefile: -------------------------------------------------------------------------------- 1 | ### Makefile for SLIME 2 | # 3 | # This file is in the public domain. 4 | 5 | # Variables 6 | # 7 | EMACS=emacs 8 | LISP=sbcl 9 | 10 | LOAD_PATH=-L . 11 | 12 | ELFILES := slime.el slime-autoloads.el slime-tests.el $(wildcard lib/*.el) 13 | ELCFILES := $(ELFILES:.el=.elc) 14 | 15 | default: compile contrib-compile 16 | 17 | all: compile 18 | 19 | help: 20 | @printf "\ 21 | Main targets\n\ 22 | all -- see compile\n\ 23 | compile -- compile .el files\n\ 24 | check -- run tests in batch mode\n\ 25 | clean -- delete generated files\n\ 26 | doc-help -- print help about doc targets\n\ 27 | help-vars -- print info about variables\n\ 28 | help -- print this message\n" 29 | 30 | help-vars: 31 | @printf "\ 32 | Main make variables:\n\ 33 | EMACS -- program to start Emacs ($(EMACS))\n\ 34 | LISP -- program to start Lisp ($(LISP))\n\ 35 | SELECTOR -- selector for ERT tests ($(SELECTOR))\n" 36 | 37 | # Compilation 38 | # 39 | slime.elc: slime.el lib/hyperspec.elc 40 | 41 | %.elc: %.el 42 | $(EMACS) -Q $(LOAD_PATH) --batch -f batch-byte-compile $< 43 | 44 | compile: $(ELCFILES) 45 | 46 | # Automated tests 47 | # 48 | SELECTOR=t 49 | 50 | check: compile 51 | $(EMACS) -Q --batch $(LOAD_PATH) \ 52 | --eval "(require 'slime-tests)" \ 53 | --eval "(slime-setup)" \ 54 | --eval "(setq inferior-lisp-program \"$(LISP)\")" \ 55 | --eval '(slime-batch-test (quote $(SELECTOR)))' 56 | 57 | # run tests interactively 58 | # 59 | # FIXME: Not terribly useful until bugs in ert-run-tests-interactively 60 | # are fixed. 61 | test: compile 62 | $(EMACS) -Q -nw $(LOAD_PATH) \ 63 | --eval "(require 'slime-tests)" \ 64 | --eval "(slime-setup)" \ 65 | --eval "(setq inferior-lisp-program \"$(LISP)\")" \ 66 | --eval '(slime-batch-test (quote $(SELECTOR)))' 67 | 68 | compile-swank: 69 | echo '(load "swank-loader.lisp")' '(swank-loader:init :setup nil)' \ 70 | | $(LISP) 71 | 72 | run-swank: 73 | { echo \ 74 | '(load "swank-loader.lisp")' \ 75 | '(swank-loader:init)' \ 76 | '(swank:create-server)' \ 77 | && cat; } \ 78 | | $(LISP) 79 | 80 | elpa-slime: 81 | echo "Not implemented yet: elpa-slime target" && exit 255 82 | 83 | elpa: elpa-slime contrib-elpa 84 | 85 | # Cleanup 86 | # 87 | FASLREGEX = .*\.\(fasl\|ufasl\|sse2f\|lx32fsl\|abcl\|fas\|lib\|trace\)$$ 88 | 89 | clean-fasls: 90 | find . -regex '$(FASLREGEX)' -exec rm -v {} \; 91 | [ ! -d ~/.slime/fasl ] || rm -rf ~/.slime/fasl 92 | 93 | clean: clean-fasls 94 | find . -iname '*.elc' -exec rm {} \; 95 | 96 | 97 | # Contrib stuff. Should probably also go to contrib/ 98 | # 99 | MAKECONTRIB=$(MAKE) -C contrib EMACS="$(EMACS)" LISP="$(LISP)" 100 | contrib-check-% check-%: 101 | $(MAKECONTRIB) $(@:contrib-%=%) 102 | contrib-elpa: 103 | $(MAKECONTRIB) elpa-all 104 | contrib-compile: 105 | $(MAKECONTRIB) compile 106 | 107 | # Doc 108 | # 109 | doc-%: 110 | $(MAKE) -C doc $(@:doc-%=%) 111 | doc: doc-help 112 | 113 | .PHONY: clean elpa compile check doc dist 114 | -------------------------------------------------------------------------------- /slime_wrapper/slime/PROBLEMS: -------------------------------------------------------------------------------- 1 | Known problems with SLIME -*- outline -*- 2 | 3 | * Common to all backends 4 | 5 | ** Caution: network security 6 | 7 | The `M-x slime' command has Lisp listen on a TCP socket and wait for 8 | Emacs to connect, which typically takes on the order of one second. If 9 | someone else were to connect to this socket then they could use the 10 | SLIME protocol to control the Lisp process. 11 | 12 | The listen socket is bound on the loopback interface in all Lisps that 13 | support this. This way remote hosts are unable to connect. 14 | 15 | ** READ-CHAR-NO-HANG is broken 16 | 17 | READ-CHAR-NO-HANG doesn't work properly for slime-input-streams. Due 18 | to the way we request input from Emacs it's not possible to repeatedly 19 | poll for input. To get any input you have to call READ-CHAR (or a 20 | function which calls READ-CHAR). 21 | 22 | * Backend-specific problems 23 | 24 | ** CMUCL 25 | 26 | The default communication style :SIGIO is reportedly unreliable with 27 | certain libraries (like libSDL) and certain platforms (like Solaris on 28 | Sparc). It generally works very well on x86 so it remains the default. 29 | 30 | ** SBCL 31 | 32 | The latest released version of SBCL at the time of packaging should 33 | work. Older or newer SBCLs may or may not work. Do not use 34 | multithreading with unpatched 2.4 Linux kernels. There are also 35 | problems with kernel versions 2.6.5 - 2.6.10. 36 | 37 | The (v)iew-source command in the debugger can only locate exact source 38 | forms for code compiled at (debug 2) or higher. The default level is 39 | lower and SBCL itself is compiled at a lower setting. Thus only 40 | defun-granularity is available with default policies. 41 | 42 | ** LispWorks 43 | 44 | On Windows, SLIME hangs when calling foreign functions or certain 45 | other functions. The reason for this problem is unknown. 46 | 47 | We only support latin1 encoding. (Unicode wouldn't be hard to add.) 48 | 49 | ** Allegro CL 50 | 51 | Interrupting Allegro with C-c C-b can be slow. This is caused by the 52 | a relatively large process-quantum: 2 seconds by default. Allegro 53 | responds much faster if mp:*default-process-quantum* is set to 0.1. 54 | 55 | ** CLISP 56 | 57 | We require version 2.49 or higher. We also require socket support, so 58 | you may have to start CLISP with "clisp -K full". 59 | 60 | Under Windows, interrupting (with C-c C-b) doesn't work. Emacs sends 61 | a SIGINT signal, but the signal is either ignored or CLISP exits 62 | immediately. 63 | 64 | On Windows, CLISP may refuse to parse filenames like 65 | "C:\\DOCUME~1\\johndoe\\LOCALS~1\\Temp\\slime.1424" when we actually 66 | mean C:\Documents and Settings\johndoe\Local Settings\slime.1424. As 67 | a workaround, you could set slime-to-lisp-filename-function to some 68 | function that returns a string that is accepted by CLISP. 69 | 70 | Function arguments and local variables aren't displayed properly in 71 | the backtrace. Changes to CLISP's C code are needed to fix this 72 | problem. Interpreted code is usually easer to debug. 73 | 74 | M-. (find-definition) only works if the fasl file is in the same 75 | directory as the source file. 76 | 77 | The arglist doesn't include the proper names only "fake symbols" like 78 | `arg1'. 79 | 80 | ** Armed Bear Common Lisp 81 | 82 | The ABCL support is still new and experimental. 83 | 84 | ** Corman Common Lisp 85 | 86 | We require version 2.51 or higher, with several patches (available at 87 | http://www.grumblesmurf.org/lisp/corman-patches). 88 | 89 | The only communication style currently supported is NIL. 90 | 91 | Interrupting (with C-c C-b) doesn't work. 92 | 93 | The tracing, stepping and XREF commands are not implemented along with 94 | some debugger functionality. 95 | -------------------------------------------------------------------------------- /slime_wrapper/slime/README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://img.shields.io/travis/slime/slime/master.svg)](https://travis-ci.org/slime/slime) [![MELPA](http://melpa.org/packages/slime-badge.svg?)](http://melpa.org/#/slime) [![MELPA Stable](http://stable.melpa.org/packages/slime-badge.svg?)](http://stable.melpa.org/#/slime) 2 | 3 | Overview 4 | -------- 5 | 6 | SLIME is the Superior Lisp Interaction Mode for Emacs. 7 | 8 | SLIME extends Emacs with support for interactive programming in Common 9 | Lisp. The features are centered around slime-mode, an Emacs minor-mode that 10 | complements the standard lisp-mode. While lisp-mode supports editing Lisp 11 | source files, slime-mode adds support for interacting with a running Common 12 | Lisp process for compilation, debugging, documentation lookup, and so on. 13 | 14 | For much more information, consult [the manual][1]. 15 | 16 | 17 | Quick setup instructions 18 | ------------------------ 19 | 20 | 1. [Set up the MELPA repository][2], if you haven't already, and install 21 | SLIME using `M-x package-install RET slime RET`. 22 | 23 | 2. Add the following lines to your `~/.emacs` file, filling in in 24 | the appropriate filenames: 25 | 26 | ```el 27 | ;; Set your lisp system and, optionally, some contribs 28 | (setq inferior-lisp-program "/opt/sbcl/bin/sbcl") 29 | (setq slime-contribs '(slime-fancy)) 30 | ``` 31 | 32 | 3. Use `M-x slime` to fire up and connect to an inferior Lisp. SLIME will 33 | now automatically be available in your Lisp source buffers. 34 | 35 | If you'd like to contribute to SLIME, you will want to instead follow 36 | the manual's instructions on [how to install SLIME via Git][7]. 37 | 38 | 39 | Contribs 40 | -------- 41 | 42 | SLIME comes with additional contributed packages or "contribs". 43 | Contribs can be selected via the `slime-contribs` list. 44 | 45 | The most-often used contrib is `slime-fancy`, which primarily installs a 46 | popular set of other contributed packages. It includes a better REPL, and 47 | many more nice features. 48 | 49 | 50 | License 51 | ------- 52 | 53 | SLIME is free software. All files, unless explicitly stated otherwise, are 54 | public domain. 55 | 56 | 57 | Contact 58 | ------- 59 | 60 | If you have problems, first have a look at the list of 61 | [known issues and workarounds][6]. 62 | 63 | Questions and comments are best directed to the mailing list at 64 | `slime-devel@common-lisp.net`, but you have to [subscribe][3] first. The 65 | mailing list archive is also available on [Gmane][4]. 66 | 67 | See the [CONTRIBUTING.md][5] file for instructions on how to contribute. 68 | 69 | 70 | 71 | 72 | [1]: http://common-lisp.net/project/slime/doc/html/ 73 | [2]: http://melpa.org/#/getting-started 74 | [3]: http://www.common-lisp.net/project/slime/#mailinglist 75 | [4]: http://news.gmane.org/gmane.lisp.slime.devel 76 | [5]: https://github.com/slime/slime/blob/master/CONTRIBUTING.md 77 | [6]: https://github.com/slime/slime/issues?labels=workaround&state=closed 78 | [7]: http://common-lisp.net/project/slime/doc/html/Installation.html#Installing-from-Git 79 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/Makefile: -------------------------------------------------------------------------------- 1 | ### Makefile for contribs 2 | # 3 | # This file is in the public domain. 4 | 5 | EMACS=emacs 6 | LISP=sbcl 7 | 8 | LOAD_PATH=-L . -L .. 9 | CONTRIBS = $(patsubst slime-%.el,%,$(wildcard slime-*.el)) 10 | CONTRIB_TESTS = $(patsubst test/slime-%-tests.el,%,$(wildcard test/slime-*.el)) 11 | SLIME_VERSION=$(shell grep "Version:" ../slime.el | grep -E -o "[0-9.]+$$") 12 | 13 | ELFILES := $(shell find . -type f -iname "*.el") 14 | ELCFILES := $(patsubst %.el,%.elc,$(ELFILES)) 15 | 16 | %.elc: %.el 17 | $(EMACS) -Q $(LOAD_PATH) --batch -f batch-byte-compile $< 18 | 19 | compile: $(ELCFILES) 20 | $(EMACS) -Q --batch $(LOAD_PATH) \ 21 | --eval "(batch-byte-recompile-directory 0)" . 22 | 23 | # ELPA builds for contribs 24 | # 25 | $(CONTRIBS:%=elpa-%): CONTRIB=$(@:elpa-%=%) 26 | $(CONTRIBS:%=elpa-%): CONTRIB_EL=$(CONTRIB:%=slime-%.el) 27 | $(CONTRIBS:%=elpa-%): CONTRIB_CL=$(CONTRIB:%=swank-%.lisp) 28 | $(CONTRIBS:%=elpa-%): CONTRIB_VERSION=$(shell ( \ 29 | grep "Version:" $(CONTRIB_EL) \ 30 | || echo $(SLIME_VERSION) \ 31 | ) | grep -E -o "[0-9.]+$$" ) 32 | $(CONTRIBS:%=elpa-%): PACKAGE=$(CONTRIB:%=slime-%-$(CONTRIB_VERSION)) 33 | $(CONTRIBS:%=elpa-%): PACKAGE_EL=$(CONTRIB:%=slime-%-pkg.el) 34 | $(CONTRIBS:%=elpa-%): ELPA_DIR=elpa/$(PACKAGE) 35 | $(CONTRIBS:%=elpa-%): compile 36 | elpa_dir=$(ELPA_DIR) 37 | mkdir -p $$elpa_dir; \ 38 | emacs --batch $(CONTRIB_EL) \ 39 | --eval "(require 'cl-lib)" \ 40 | --eval "(search-forward \"define-slime-contrib\")" \ 41 | --eval "(up-list -1)" \ 42 | --eval "(pp \ 43 | (pcase (read (point-marker)) \ 44 | (\`(define-slime-contrib ,name ,docstring . ,rest) \ 45 | \`(define-package ,name \"$(CONTRIB_VERSION)\" \ 46 | ,docstring \ 47 | ,(cons '(slime \"$(SLIME_VERSION)\") \ 48 | (cl-loop for form in rest \ 49 | when (eq :slime-dependencies (car form)) \ 50 | append (cl-loop for contrib in (cdr form) \ 51 | if (atom contrib) \ 52 | collect \ 53 | \`(,contrib \"$(SLIME_VERSION)\") \ 54 | else \ 55 | collect contrib))))))))" > \ 56 | $$elpa_dir/$(PACKAGE_EL); \ 57 | cp $(CONTRIB_EL) $$elpa_dir; \ 58 | [ -r $(CONTRIB_CL) ] && cp $(CONTRIB_CL) $$elpa_dir; \ 59 | ls $$elpa_dir 60 | cd elpa && tar cvf $(PACKAGE).tar $(PACKAGE) 61 | rm -rf $(ELPA_DIR) 62 | 63 | elpa-all: $(CONTRIBS:%=elpa-%) 64 | 65 | $(CONTRIB_TESTS:%=check-%): CONTRIB_NAME=$(patsubst check-%,slime-%,$@) 66 | $(CONTRIB_TESTS:%=check-%): SELECTOR=(quote (tag contrib)) 67 | $(CONTRIB_TESTS:%=check-%): compile 68 | $(EMACS) -Q --batch $(LOAD_PATH) -L test \ 69 | --eval "(require (quote slime))" \ 70 | --eval "(slime-setup (quote ($(CONTRIB_NAME))))" \ 71 | --eval "(require \ 72 | (intern \ 73 | (format \"%s-tests\" (quote $(CONTRIB_NAME)))))" \ 74 | --eval '(setq inferior-lisp-program "$(LISP)")' \ 75 | --eval "(slime-batch-test $(SELECTOR))" 76 | 77 | check-all: $(CONTRIB_TESTS:%=check-%) 78 | 79 | check-fancy: compile 80 | $(EMACS) -Q --batch $(LOAD_PATH) -L test \ 81 | --eval "(setq debug-on-error t)" \ 82 | --eval "(require (quote slime))" \ 83 | --eval "(slime-setup (quote (slime-fancy)))" \ 84 | --eval "(mapc (lambda (sym) \ 85 | (require \ 86 | (intern (format \"%s-tests\" sym)) \ 87 | nil t)) \ 88 | (slime-contrib-all-dependencies \ 89 | (quote slime-fancy)))" \ 90 | --eval '(setq inferior-lisp-program "$(LISP)")' \ 91 | --eval '(slime-batch-test (quote (tag contrib)))' 92 | 93 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/README.md: -------------------------------------------------------------------------------- 1 | This directory contains source code which may be useful to some Slime 2 | users. `*.el` files are Emacs Lisp source and `*.lisp` files contain 3 | Common Lisp source code. If not otherwise stated in the file itself, 4 | the files are placed in the Public Domain. 5 | 6 | The components in this directory are more or less detached from the 7 | rest of Slime. They are essentially "add-ons". But Slime can also be 8 | used without them. The code is maintained by the respective authors. 9 | 10 | See the top level README.md for how to use packages in this directory. 11 | 12 | Finally, the contrib `slime-fancy` is specially noteworthy, as it 13 | represents a meta-contrib that'll load a bunch of commonly used 14 | contribs. Look into `slime-fancy.el` to find out which. 15 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/inferior-slime.el: -------------------------------------------------------------------------------- 1 | ;;; inferior-slime.el --- Minor mode with Slime keys for comint buffers 2 | ;; 3 | ;; Author: Luke Gorrie 4 | ;; License: GNU GPL (same license as Emacs) 5 | ;; 6 | ;;; Installation: 7 | ;; 8 | ;; Add something like this to your .emacs: 9 | ;; 10 | ;; (add-to-list 'load-path "") 11 | ;; (add-hook 'slime-load-hook (lambda () (require 'inferior-slime))) 12 | ;; (add-hook 'inferior-lisp-mode-hook (lambda () (inferior-slime-mode 1))) 13 | (require 'slime) 14 | (require 'cl-lib) 15 | 16 | (define-minor-mode inferior-slime-mode 17 | "\\\ 18 | Inferior SLIME mode: The Inferior Superior Lisp Mode for Emacs. 19 | 20 | This mode is intended for use with `inferior-lisp-mode'. It provides a 21 | subset of the bindings from `slime-mode'. 22 | 23 | \\{inferior-slime-mode-map}" 24 | :keymap 25 | ;; Fake binding to coax `define-minor-mode' to create the keymap 26 | '((" " 'undefined)) 27 | 28 | (slime-setup-completion) 29 | (setq-local tab-always-indent 'complete)) 30 | 31 | (defun inferior-slime-return () 32 | "Handle the return key in the inferior-lisp buffer. 33 | The current input should only be sent if a whole expression has been 34 | entered, i.e. the parenthesis are matched. 35 | 36 | A prefix argument disables this behaviour." 37 | (interactive) 38 | (if (or current-prefix-arg (inferior-slime-input-complete-p)) 39 | (comint-send-input) 40 | (insert "\n") 41 | (inferior-slime-indent-line))) 42 | 43 | (defun inferior-slime-indent-line () 44 | "Indent the current line, ignoring everything before the prompt." 45 | (interactive) 46 | (save-restriction 47 | (let ((indent-start 48 | (save-excursion 49 | (goto-char (process-mark (get-buffer-process (current-buffer)))) 50 | (let ((inhibit-field-text-motion t)) 51 | (beginning-of-line 1)) 52 | (point)))) 53 | (narrow-to-region indent-start (point-max))) 54 | (lisp-indent-line))) 55 | 56 | (defun inferior-slime-input-complete-p () 57 | "Return true if the input is complete in the inferior lisp buffer." 58 | (slime-input-complete-p (process-mark (get-buffer-process (current-buffer))) 59 | (point-max))) 60 | 61 | (defun inferior-slime-closing-return () 62 | "Send the current expression to Lisp after closing any open lists." 63 | (interactive) 64 | (goto-char (point-max)) 65 | (save-restriction 66 | (narrow-to-region (process-mark (get-buffer-process (current-buffer))) 67 | (point-max)) 68 | (while (ignore-errors (save-excursion (backward-up-list 1) t)) 69 | (insert ")"))) 70 | (comint-send-input)) 71 | 72 | (defun inferior-slime-change-directory (directory) 73 | "Set default-directory in the *inferior-lisp* buffer to DIRECTORY." 74 | (let* ((proc (slime-process)) 75 | (buffer (and proc (process-buffer proc)))) 76 | (when buffer 77 | (with-current-buffer buffer 78 | (cd-absolute directory))))) 79 | 80 | (defun inferior-slime-init-keymap () 81 | (let ((map inferior-slime-mode-map)) 82 | (set-keymap-parent map slime-parent-map) 83 | (slime-define-keys map 84 | ([return] 'inferior-slime-return) 85 | ([(control return)] 'inferior-slime-closing-return) 86 | ([(meta control ?m)] 'inferior-slime-closing-return) 87 | ;;("\t" 'slime-indent-and-complete-symbol) 88 | (" " 'slime-space)))) 89 | 90 | (inferior-slime-init-keymap) 91 | 92 | (defun inferior-slime-hook-function () 93 | (inferior-slime-mode 1)) 94 | 95 | (defun inferior-slime-switch-to-repl-buffer () 96 | (switch-to-buffer (process-buffer (slime-inferior-process)))) 97 | 98 | (defun inferior-slime-show-transcript (string) 99 | (remove-hook 'comint-output-filter-functions 100 | 'inferior-slime-show-transcript t) 101 | (with-current-buffer (process-buffer (slime-inferior-process)) 102 | (let ((window (display-buffer (current-buffer) t))) 103 | (set-window-point window (point-max))))) 104 | 105 | (defun inferior-slime-start-transcript () 106 | (let ((proc (slime-inferior-process))) 107 | (when proc 108 | (with-current-buffer (process-buffer proc) 109 | (add-hook 'comint-output-filter-functions 110 | 'inferior-slime-show-transcript 111 | nil t))))) 112 | 113 | (defun inferior-slime-stop-transcript () 114 | (let ((proc (slime-inferior-process))) 115 | (when proc 116 | (with-current-buffer (process-buffer (slime-inferior-process)) 117 | (run-with-timer 0.2 nil 118 | (lambda (buffer) 119 | (with-current-buffer buffer 120 | (remove-hook 'comint-output-filter-functions 121 | 'inferior-slime-show-transcript t))) 122 | (current-buffer)))))) 123 | 124 | (defun inferior-slime-init () 125 | (add-hook 'slime-inferior-process-start-hook 'inferior-slime-hook-function) 126 | (add-hook 'slime-change-directory-hooks 'inferior-slime-change-directory) 127 | (add-hook 'slime-transcript-start-hook 'inferior-slime-start-transcript) 128 | (add-hook 'slime-transcript-stop-hook 'inferior-slime-stop-transcript) 129 | (def-slime-selector-method ?r 130 | "SLIME Read-Eval-Print-Loop." 131 | (process-buffer (slime-inferior-process)))) 132 | 133 | (provide 'inferior-slime) 134 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-banner.el: -------------------------------------------------------------------------------- 1 | (require 'slime) 2 | (require 'slime-repl) 3 | 4 | (define-slime-contrib slime-banner 5 | "Persistent header line and startup animation." 6 | (:authors "Helmut Eller " 7 | "Luke Gorrie ") 8 | (:license "GPL") 9 | (:on-load (setq slime-repl-banner-function 'slime-startup-message)) 10 | (:on-unload (setq slime-repl-banner-function 'slime-repl-insert-banner))) 11 | 12 | (defcustom slime-startup-animation (fboundp 'animate-string) 13 | "Enable the startup animation." 14 | :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil)) 15 | :group 'slime-ui) 16 | 17 | (defcustom slime-header-line-p (boundp 'header-line-format) 18 | "If non-nil, display a header line in Slime buffers." 19 | :type 'boolean 20 | :group 'slime-repl) 21 | 22 | (defun slime-startup-message () 23 | (when slime-header-line-p 24 | (setq header-line-format 25 | (format "%s Port: %s Pid: %s" 26 | (slime-lisp-implementation-type) 27 | (slime-connection-port (slime-connection)) 28 | (slime-pid)))) 29 | (when (zerop (buffer-size)) 30 | (let ((welcome (concat "; SLIME " slime-version))) 31 | (if slime-startup-animation 32 | (animate-string welcome 0 0) 33 | (insert welcome))))) 34 | 35 | (provide 'slime-banner) 36 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-clipboard.el: -------------------------------------------------------------------------------- 1 | (require 'slime) 2 | (require 'slime-repl) 3 | (require 'cl-lib) 4 | (eval-when-compile 5 | (require 'cl)) ; lexical-let 6 | 7 | (define-slime-contrib slime-clipboard 8 | "This add a few commands to put objects into a clipboard and to 9 | insert textual references to those objects. 10 | 11 | The clipboard command prefix is C-c @. 12 | 13 | C-c @ + adds an object to the clipboard 14 | C-c @ @ inserts a reference to an object in the clipboard 15 | C-c @ ? displays the clipboard 16 | 17 | This package also also binds the + key in the inspector and 18 | debugger to add the object at point to the clipboard." 19 | (:authors "Helmut Eller ") 20 | (:license "GPL") 21 | (:swank-dependencies swank-clipboard)) 22 | 23 | (define-derived-mode slime-clipboard-mode fundamental-mode 24 | "Slime-Clipboard" 25 | "SLIME Clipboad Mode. 26 | 27 | \\{slime-clipboard-mode-map}") 28 | 29 | (slime-define-keys slime-clipboard-mode-map 30 | ("g" 'slime-clipboard-redisplay) 31 | ((kbd "C-k") 'slime-clipboard-delete-entry) 32 | ("i" 'slime-clipboard-inspect)) 33 | 34 | (defvar slime-clipboard-map (make-sparse-keymap)) 35 | 36 | (slime-define-keys slime-clipboard-map 37 | ("?" 'slime-clipboard-display) 38 | ("+" 'slime-clipboard-add) 39 | ("@" 'slime-clipboard-ref)) 40 | 41 | (define-key slime-mode-map (kbd "C-c @") slime-clipboard-map) 42 | (define-key slime-repl-mode-map (kbd "C-c @") slime-clipboard-map) 43 | 44 | (slime-define-keys slime-inspector-mode-map 45 | ("+" 'slime-clipboard-add-from-inspector)) 46 | 47 | (slime-define-keys sldb-mode-map 48 | ("+" 'slime-clipboard-add-from-sldb)) 49 | 50 | (defun slime-clipboard-add (exp package) 51 | "Add an object to the clipboard." 52 | (interactive (list (slime-read-from-minibuffer 53 | "Add to clipboard (evaluated): " 54 | (slime-sexp-at-point)) 55 | (slime-current-package))) 56 | (slime-clipboard-add-internal `(:string ,exp ,package))) 57 | 58 | (defun slime-clipboard-add-internal (datum) 59 | (slime-eval-async `(swank-clipboard:add ',datum) 60 | (lambda (result) (message "%s" result)))) 61 | 62 | (defun slime-clipboard-display () 63 | "Display the content of the clipboard." 64 | (interactive) 65 | (slime-eval-async `(swank-clipboard:entries) 66 | #'slime-clipboard-display-entries)) 67 | 68 | (defun slime-clipboard-display-entries (entries) 69 | (slime-with-popup-buffer ((slime-buffer-name :clipboard) 70 | :mode 'slime-clipboard-mode) 71 | (slime-clipboard-insert-entries entries))) 72 | 73 | (defun slime-clipboard-insert-entries (entries) 74 | (let ((fstring "%2s %3s %s\n")) 75 | (insert (format fstring "Nr" "Id" "Value") 76 | (format fstring "--" "--" "-----" )) 77 | (save-excursion 78 | (cl-loop for i from 0 for (ref . value) in entries do 79 | (slime-insert-propertized `(slime-clipboard-entry ,i 80 | slime-clipboard-ref ,ref) 81 | (format fstring i ref value)))))) 82 | 83 | (defun slime-clipboard-redisplay () 84 | "Update the clipboard buffer." 85 | (interactive) 86 | (lexical-let ((saved (point))) 87 | (slime-eval-async 88 | `(swank-clipboard:entries) 89 | (lambda (entries) 90 | (let ((inhibit-read-only t)) 91 | (erase-buffer) 92 | (slime-clipboard-insert-entries entries) 93 | (when (< saved (point-max)) 94 | (goto-char saved))))))) 95 | 96 | (defun slime-clipboard-entry-at-point () 97 | (or (get-text-property (point) 'slime-clipboard-entry) 98 | (error "No clipboard entry at point"))) 99 | 100 | (defun slime-clipboard-ref-at-point () 101 | (or (get-text-property (point) 'slime-clipboard-ref) 102 | (error "No clipboard ref at point"))) 103 | 104 | (defun slime-clipboard-inspect (&optional entry) 105 | "Inspect the current clipboard entry." 106 | (interactive (list (slime-clipboard-ref-at-point))) 107 | (slime-inspect (prin1-to-string `(swank-clipboard::clipboard-ref ,entry)))) 108 | 109 | (defun slime-clipboard-delete-entry (&optional entry) 110 | "Delete the current entry from the clipboard." 111 | (interactive (list (slime-clipboard-entry-at-point))) 112 | (slime-eval-async `(swank-clipboard:delete-entry ,entry) 113 | (lambda (result) 114 | (slime-clipboard-redisplay) 115 | (message "%s" result)))) 116 | 117 | (defun slime-clipboard-ref () 118 | "Ask for a clipboard entry number and insert a reference to it." 119 | (interactive) 120 | (slime-clipboard-read-entry-number #'slime-clipboard-insert-ref)) 121 | 122 | ;; insert a reference to clipboard entry ENTRY at point. The text 123 | ;; receives a special 'display property to make it look nicer. We 124 | ;; remove this property in a modification when a user tries to modify 125 | ;; he real text. 126 | (defun slime-clipboard-insert-ref (entry) 127 | (cl-destructuring-bind (ref . string) 128 | (slime-eval `(swank-clipboard:entry-to-ref ,entry)) 129 | (slime-insert-propertized 130 | `(display ,(format "#@%d%s" ref string) 131 | modification-hooks (slime-clipboard-ref-modified) 132 | rear-nonsticky t) 133 | (format "(swank-clipboard::clipboard-ref %d)" ref)))) 134 | 135 | (defun slime-clipboard-ref-modified (start end) 136 | (when (get-text-property start 'display) 137 | (let ((inhibit-modification-hooks t)) 138 | (save-excursion 139 | (goto-char start) 140 | (cl-destructuring-bind (dstart dend) (slime-property-bounds 'display) 141 | (unless (and (= start dstart) (= end dend)) 142 | (remove-list-of-text-properties 143 | dstart dend '(display modification-hooks)))))))) 144 | 145 | ;; Read a entry number. 146 | ;; Written in CPS because the display the clipboard before reading. 147 | (defun slime-clipboard-read-entry-number (k) 148 | (slime-eval-async 149 | `(swank-clipboard:entries) 150 | (slime-rcurry 151 | (lambda (entries window-config k) 152 | (slime-clipboard-display-entries entries) 153 | (let ((entry (unwind-protect 154 | (read-from-minibuffer "Entry number: " nil nil t) 155 | (set-window-configuration window-config)))) 156 | (funcall k entry))) 157 | (current-window-configuration) 158 | k))) 159 | 160 | (defun slime-clipboard-add-from-inspector () 161 | (interactive) 162 | (let ((part (or (get-text-property (point) 'slime-part-number) 163 | (error "No part at point")))) 164 | (slime-clipboard-add-internal `(:inspector ,part)))) 165 | 166 | (defun slime-clipboard-add-from-sldb () 167 | (interactive) 168 | (slime-clipboard-add-internal 169 | `(:sldb ,(sldb-frame-number-at-point) 170 | ,(sldb-var-number-at-point)))) 171 | 172 | (provide 'slime-clipboard) 173 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-fancy-inspector.el: -------------------------------------------------------------------------------- 1 | (eval-and-compile 2 | (require 'slime)) 3 | 4 | (define-slime-contrib slime-fancy-inspector 5 | "Fancy inspector for CLOS objects." 6 | (:authors "Marco Baringer and others") 7 | (:license "GPL") 8 | (:slime-dependencies slime-parse) 9 | (:swank-dependencies swank-fancy-inspector) 10 | (:on-load 11 | (add-hook 'slime-edit-definition-hooks 'slime-edit-inspector-part)) 12 | (:on-unload 13 | (remove-hook 'slime-edit-definition-hooks 'slime-edit-inspector-part))) 14 | 15 | (defun slime-inspect-definition () 16 | "Inspect definition at point" 17 | (interactive) 18 | (slime-inspect (slime-definition-at-point))) 19 | 20 | (defun slime-disassemble-definition () 21 | "Disassemble definition at point" 22 | (interactive) 23 | (slime-eval-describe `(swank:disassemble-form 24 | ,(slime-definition-at-point t)))) 25 | 26 | (defun slime-edit-inspector-part (name &optional where) 27 | (and (eq major-mode 'slime-inspector-mode) 28 | (cl-destructuring-bind (&optional property value) 29 | (slime-inspector-property-at-point) 30 | (when (eq property 'slime-part-number) 31 | (let ((location (slime-eval `(swank:find-definition-for-thing 32 | (swank:inspector-nth-part ,value)))) 33 | (name (format "Inspector part %s" value))) 34 | (when (and (consp location) 35 | (not (eq (car location) :error))) 36 | (slime-edit-definition-cont 37 | (list (make-slime-xref :dspec `(,name) 38 | :location location)) 39 | name 40 | where))))))) 41 | 42 | (provide 'slime-fancy-inspector) 43 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-fancy-trace.el: -------------------------------------------------------------------------------- 1 | (eval-and-compile 2 | (require 'slime)) 3 | 4 | (define-slime-contrib slime-fancy-trace 5 | "Enhanced version of slime-trace capable of tracing local functions, 6 | methods, setf functions, and other entities supported by specific 7 | swank:swank-toggle-trace backends. Invoke via C-u C-t." 8 | (:authors "Matthias Koeppe " 9 | "Tobias C. Rittweiler ") 10 | (:license "GPL") 11 | (:slime-dependencies slime-parse)) 12 | 13 | (defun slime-trace-query (spec) 14 | "Ask the user which function to trace; SPEC is the default. 15 | The result is a string." 16 | (cond ((null spec) 17 | (slime-read-from-minibuffer "(Un)trace: ")) 18 | ((stringp spec) 19 | (slime-read-from-minibuffer "(Un)trace: " spec)) 20 | ((symbolp spec) ; `slime-extract-context' can return symbols. 21 | (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string spec))) 22 | (t 23 | (slime-dcase spec 24 | ((setf n) 25 | (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string spec))) 26 | ((:defun n) 27 | (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string n))) 28 | ((:defgeneric n) 29 | (let* ((name (prin1-to-string n)) 30 | (answer (slime-read-from-minibuffer "(Un)trace: " name))) 31 | (cond ((and (string= name answer) 32 | (y-or-n-p (concat "(Un)trace also all " 33 | "methods implementing " 34 | name "? "))) 35 | (prin1-to-string `(:defgeneric ,n))) 36 | (t 37 | answer)))) 38 | ((:defmethod &rest _) 39 | (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string spec))) 40 | ((:call caller callee) 41 | (let* ((callerstr (prin1-to-string caller)) 42 | (calleestr (prin1-to-string callee)) 43 | (answer (slime-read-from-minibuffer "(Un)trace: " 44 | calleestr))) 45 | (cond ((and (string= calleestr answer) 46 | (y-or-n-p (concat "(Un)trace only when " calleestr 47 | " is called by " callerstr "? "))) 48 | (prin1-to-string `(:call ,caller ,callee))) 49 | (t 50 | answer)))) 51 | (((:labels :flet) &rest _) 52 | (slime-read-from-minibuffer "(Un)trace local function: " 53 | (prin1-to-string spec))) 54 | (t (error "Don't know how to trace the spec %S" spec)))))) 55 | 56 | (defun slime-toggle-fancy-trace (&optional using-context-p) 57 | "Toggle trace." 58 | (interactive "P") 59 | (let* ((spec (if using-context-p 60 | (slime-extract-context) 61 | (slime-symbol-at-point))) 62 | (spec (slime-trace-query spec))) 63 | (message "%s" (slime-eval `(swank:swank-toggle-trace ,spec))))) 64 | 65 | ;; override slime-toggle-trace-fdefinition 66 | (define-key slime-prefix-map "\C-t" 'slime-toggle-fancy-trace) 67 | 68 | (provide 'slime-fancy-trace) 69 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-fancy.el: -------------------------------------------------------------------------------- 1 | (require 'slime) 2 | 3 | (define-slime-contrib slime-fancy 4 | "Make SLIME fancy." 5 | (:authors "Matthias Koeppe " 6 | "Tobias C Rittweiler ") 7 | (:license "GPL") 8 | (:slime-dependencies slime-repl 9 | slime-autodoc 10 | slime-c-p-c 11 | slime-editing-commands 12 | slime-fancy-inspector 13 | slime-fancy-trace 14 | slime-fuzzy 15 | slime-mdot-fu 16 | slime-macrostep 17 | slime-presentations 18 | slime-scratch 19 | slime-references 20 | slime-package-fu 21 | slime-fontifying-fu 22 | slime-trace-dialog) 23 | (:on-load 24 | (slime-trace-dialog-init) 25 | (slime-repl-init) 26 | (slime-autodoc-init) 27 | (slime-c-p-c-init) 28 | (slime-editing-commands-init) 29 | (slime-fancy-inspector-init) 30 | (slime-fancy-trace-init) 31 | (slime-fuzzy-init) 32 | (slime-presentations-init) 33 | (slime-scratch-init) 34 | (slime-references-init) 35 | (slime-package-fu-init) 36 | (slime-fontifying-fu-init))) 37 | 38 | (provide 'slime-fancy) 39 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-highlight-edits.el: -------------------------------------------------------------------------------- 1 | (require 'slime) 2 | (require 'slime-parse) 3 | 4 | (define-slime-contrib slime-highlight-edits 5 | "Highlight edited, i.e. not yet compiled, code." 6 | (:authors "William Bland ") 7 | (:license "GPL") 8 | (:on-load (add-hook 'slime-mode-hook 'slime-activate-highlight-edits)) 9 | (:on-unload (remove-hook 'slime-mode-hook 'slime-activate-highlight-edits))) 10 | 11 | (defun slime-activate-highlight-edits () 12 | (slime-highlight-edits-mode 1)) 13 | 14 | (defface slime-highlight-edits-face 15 | `((((class color) (background light)) 16 | (:background "lightgray")) 17 | (((class color) (background dark)) 18 | (:background "dimgray")) 19 | (t (:background "yellow"))) 20 | "Face for displaying edit but not compiled code." 21 | :group 'slime-mode-faces) 22 | 23 | (define-minor-mode slime-highlight-edits-mode 24 | "Minor mode to highlight not-yet-compiled code." nil) 25 | 26 | (add-hook 'slime-highlight-edits-mode-on-hook 27 | 'slime-highlight-edits-init-buffer) 28 | 29 | (add-hook 'slime-highlight-edits-mode-off-hook 30 | 'slime-highlight-edits-reset-buffer) 31 | 32 | (defun slime-highlight-edits-init-buffer () 33 | (make-local-variable 'after-change-functions) 34 | (add-to-list 'after-change-functions 35 | 'slime-highlight-edits) 36 | (add-to-list 'slime-before-compile-functions 37 | 'slime-highlight-edits-compile-hook)) 38 | 39 | (defun slime-highlight-edits-reset-buffer () 40 | (setq after-change-functions 41 | (remove 'slime-highlight-edits after-change-functions)) 42 | (slime-remove-edits (point-min) (point-max))) 43 | 44 | ;; FIXME: what's the LEN arg for? 45 | (defun slime-highlight-edits (beg end &optional len) 46 | (save-match-data 47 | (when (and (slime-connected-p) 48 | (not (slime-inside-comment-p)) 49 | (not (slime-only-whitespace-p beg end))) 50 | (let ((overlay (make-overlay beg end))) 51 | (overlay-put overlay 'face 'slime-highlight-edits-face) 52 | (overlay-put overlay 'slime-edit t))))) 53 | 54 | (defun slime-remove-edits (start end) 55 | "Delete the existing Slime edit hilights in the current buffer." 56 | (save-excursion 57 | (goto-char start) 58 | (while (< (point) end) 59 | (dolist (o (overlays-at (point))) 60 | (when (overlay-get o 'slime-edit) 61 | (delete-overlay o))) 62 | (goto-char (next-overlay-change (point)))))) 63 | 64 | (defun slime-highlight-edits-compile-hook (start end) 65 | (when slime-highlight-edits-mode 66 | (let ((start (save-excursion (goto-char start) 67 | (skip-chars-backward " \t\n\r") 68 | (point))) 69 | (end (save-excursion (goto-char end) 70 | (skip-chars-forward " \t\n\r") 71 | (point)))) 72 | (slime-remove-edits start end)))) 73 | 74 | (defun slime-only-whitespace-p (beg end) 75 | "Contains the region from BEG to END only whitespace?" 76 | (save-excursion 77 | (goto-char beg) 78 | (skip-chars-forward " \n\t\r" end) 79 | (<= end (point)))) 80 | 81 | (provide 'slime-highlight-edits) 82 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-hyperdoc.el: -------------------------------------------------------------------------------- 1 | (require 'slime) 2 | (require 'url-http) 3 | (require 'browse-url) 4 | (eval-when-compile (require 'cl)) ; lexical-let 5 | 6 | (defvar slime-old-documentation-lookup-function 7 | slime-documentation-lookup-function) 8 | 9 | (define-slime-contrib slime-hyperdoc 10 | "Extensible C-c C-d h." 11 | (:authors "Tobias C Rittweiler ") 12 | (:license "GPL") 13 | (:swank-dependencies swank-hyperdoc) 14 | (:on-load 15 | (setq slime-documentation-lookup-function 'slime-hyperdoc-lookup)) 16 | (:on-unload 17 | (setq slime-documentation-lookup-function 18 | slime-old-documentation-lookup-function))) 19 | 20 | ;;; TODO: `url-http-file-exists-p' is slow, make it optional behaviour. 21 | 22 | (defun slime-hyperdoc-lookup-rpc (symbol-name) 23 | (slime-eval-async `(swank:hyperdoc ,symbol-name) 24 | (lexical-let ((symbol-name symbol-name)) 25 | #'(lambda (result) 26 | (slime-log-event result) 27 | (cl-loop with foundp = nil 28 | for (doc-type . url) in result do 29 | (when (and url (stringp url) 30 | (let ((url-show-status nil)) 31 | (url-http-file-exists-p url))) 32 | (message "Visiting documentation for %s `%s'..." 33 | (substring (symbol-name doc-type) 1) 34 | symbol-name) 35 | (browse-url url) 36 | (setq foundp t)) 37 | finally 38 | (unless foundp 39 | (error "Could not find documentation for `%s'." 40 | symbol-name))))))) 41 | 42 | (defun slime-hyperdoc-lookup (symbol-name) 43 | (interactive (list (slime-read-symbol-name "Symbol: "))) 44 | (if (memq :hyperdoc (slime-lisp-features)) 45 | (slime-hyperdoc-lookup-rpc symbol-name) 46 | (slime-hyperspec-lookup symbol-name))) 47 | 48 | (provide 'slime-hyperdoc) 49 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-indentation.el: -------------------------------------------------------------------------------- 1 | (require 'slime) 2 | (require 'slime-cl-indent) 3 | (require 'cl-lib) 4 | 5 | (define-slime-contrib slime-indentation 6 | "Contrib interfacing `slime-cl-indent' and SLIME." 7 | (:swank-dependencies swank-indentation) 8 | (:on-load 9 | (setq common-lisp-current-package-function 'slime-current-package))) 10 | 11 | (defun slime-update-system-indentation (symbol indent packages) 12 | (let ((list (gethash symbol common-lisp-system-indentation)) 13 | (ok nil)) 14 | (if (not list) 15 | (puthash symbol (list (cons indent packages)) 16 | common-lisp-system-indentation) 17 | (dolist (spec list) 18 | (cond ((equal (car spec) indent) 19 | (dolist (p packages) 20 | (unless (member p (cdr spec)) 21 | (push p (cdr spec)))) 22 | (setf ok t)) 23 | (t 24 | (setf (cdr spec) 25 | (cl-set-difference (cdr spec) packages :test 'equal))))) 26 | (unless ok 27 | (puthash symbol (cons (cons indent packages) 28 | list) 29 | common-lisp-system-indentation))))) 30 | 31 | (provide 'slime-indentation) 32 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-listener-hooks.el: -------------------------------------------------------------------------------- 1 | (require 'slime) 2 | (require 'cl-lib) 3 | 4 | (define-slime-contrib slime-listener-hooks 5 | "Enable slime integration in an application'w event loop" 6 | (:authors "Alan Ruttenberg , R. Mattes ") 7 | (:license "GPL") 8 | (:slime-dependencies slime-repl) 9 | (:swank-dependencies swank-listener-hooks)) 10 | 11 | (provide 'slime-listener-hooks) 12 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-macrostep.el: -------------------------------------------------------------------------------- 1 | ;;; slime-macrostep.el -- fancy macro-expansion via macrostep.el 2 | 3 | ;; Authors: Luís Oliveira 4 | ;; Jon Oddie " 39 | "Jon Oddie ") 40 | (:license "GPL") 41 | (:swank-dependencies swank-macrostep) 42 | (:on-load 43 | (easy-menu-add-item slime-mode-map '(menu-bar SLIME Debugging) 44 | ["Macro stepper..." macrostep-expand (slime-connected-p)] 45 | "Create Trace Buffer") 46 | (add-hook 'slime-mode-hook #'macrostep-slime-mode-hook) 47 | (define-key slime-mode-map (kbd "C-c M-e") #'macrostep-expand) 48 | (eval-after-load 'slime-repl 49 | '(progn 50 | (add-hook 'slime-repl-mode-hook #'macrostep-slime-mode-hook) 51 | (define-key slime-repl-mode-map (kbd "C-c M-e") #'macrostep-expand))))) 52 | 53 | (defun macrostep-slime-mode-hook () 54 | (setq macrostep-sexp-at-point-function #'macrostep-slime-sexp-at-point) 55 | (setq macrostep-environment-at-point-function #'macrostep-slime-context) 56 | (setq macrostep-expand-1-function #'macrostep-slime-expand-1) 57 | (setq macrostep-print-function #'macrostep-slime-insert) 58 | (setq macrostep-macro-form-p-function #'macrostep-slime-macro-form-p)) 59 | 60 | (defun macrostep-slime-sexp-at-point (&rest _ignore) 61 | (slime-sexp-at-point)) 62 | 63 | (defun macrostep-slime-context () 64 | (let (defun-start defun-end) 65 | (save-excursion 66 | (while 67 | (condition-case nil 68 | (progn (backward-up-list) t) 69 | (scan-error nil))) 70 | (setq defun-start (point)) 71 | (setq defun-end (scan-sexps (point) 1))) 72 | (list (buffer-substring-no-properties 73 | defun-start (point)) 74 | (buffer-substring-no-properties 75 | (scan-sexps (point) 1) defun-end)))) 76 | 77 | (defun macrostep-slime-expand-1 (string context) 78 | (slime-dcase 79 | (slime-eval 80 | `(swank-macrostep:macrostep-expand-1 81 | ,string ,macrostep-expand-compiler-macros ',context)) 82 | ((:error error-message) 83 | (error "%s" error-message)) 84 | ((:ok expansion positions) 85 | (list expansion positions)))) 86 | 87 | (defun macrostep-slime-insert (result _ignore) 88 | "Insert RESULT at point, indenting to match the current column." 89 | (cl-destructuring-bind (expansion positions) result 90 | (let ((start (point)) 91 | (column-offset (current-column))) 92 | (insert expansion) 93 | (macrostep-slime--propertize-macros start positions) 94 | (indent-rigidly start (point) column-offset)))) 95 | 96 | (defun macrostep-slime--propertize-macros (start-offset positions) 97 | "Put text properties on macro forms." 98 | (dolist (position positions) 99 | (cl-destructuring-bind (operator type start) 100 | position 101 | (let ((open-paren-position 102 | (+ start-offset start))) 103 | (put-text-property open-paren-position 104 | (1+ open-paren-position) 105 | 'macrostep-macro-start 106 | t) 107 | ;; this assumes that the operator starts right next to the 108 | ;; opening parenthesis. We could probably be more robust. 109 | (let ((op-start (1+ open-paren-position))) 110 | (put-text-property op-start 111 | (+ op-start (length operator)) 112 | 'font-lock-face 113 | (if (eq type :macro) 114 | 'macrostep-macro-face 115 | 'macrostep-compiler-macro-face))))))) 116 | 117 | (defun macrostep-slime-macro-form-p (string context) 118 | (slime-dcase 119 | (slime-eval 120 | `(swank-macrostep:macro-form-p 121 | ,string ,macrostep-expand-compiler-macros ',context)) 122 | ((:error error-message) 123 | (error "%s" error-message)) 124 | ((:ok result) 125 | result))) 126 | 127 | 128 | 129 | (provide 'slime-macrostep) 130 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-mdot-fu.el: -------------------------------------------------------------------------------- 1 | (require 'slime) 2 | (require 'cl-lib) 3 | 4 | (define-slime-contrib slime-mdot-fu 5 | "Making M-. work on local functions." 6 | (:authors "Tobias C. Rittweiler ") 7 | (:license "GPL") 8 | (:slime-dependencies slime-enclosing-context) 9 | (:on-load 10 | (add-hook 'slime-edit-definition-hooks 'slime-edit-local-definition)) 11 | (:on-unload 12 | (remove-hook 'slime-edit-definition-hooks 'slime-edit-local-definition))) 13 | 14 | 15 | (defun slime-edit-local-definition (name &optional where) 16 | "Like `slime-edit-definition', but tries to find the definition 17 | in a local function binding near point." 18 | (interactive (list (slime-read-symbol-name "Name: "))) 19 | (cl-multiple-value-bind (binding-name point) 20 | (cl-multiple-value-call #'cl-some #'(lambda (binding-name point) 21 | (when (cl-equalp binding-name name) 22 | (cl-values binding-name point))) 23 | (slime-enclosing-bound-names)) 24 | (when (and binding-name point) 25 | (slime-edit-definition-cont 26 | `((,binding-name 27 | ,(make-slime-buffer-location (buffer-name (current-buffer)) point))) 28 | name 29 | where)))) 30 | 31 | (provide 'slime-mdot-fu) 32 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-media.el: -------------------------------------------------------------------------------- 1 | (eval-and-compile 2 | (require 'slime)) 3 | 4 | (define-slime-contrib slime-media 5 | "Display things other than text in SLIME buffers" 6 | (:authors "Christophe Rhodes ") 7 | (:license "GPL") 8 | (:slime-dependencies slime-repl) 9 | (:swank-dependencies swank-media) 10 | (:on-load 11 | (add-hook 'slime-event-hooks 'slime-dispatch-media-event))) 12 | 13 | (defun slime-media-decode-image (image) 14 | (mapcar (lambda (image) 15 | (if (plist-get image :data) 16 | (plist-put image :data (base64-decode-string (plist-get image :data))) 17 | image)) 18 | image)) 19 | 20 | (defun slime-dispatch-media-event (event) 21 | (slime-dcase event 22 | ((:write-image image string) 23 | (let ((img (or (find-image (slime-media-decode-image image)) 24 | (create-image image)))) 25 | (slime-media-insert-image img string)) 26 | t) 27 | ((:popup-buffer bufname string mode) 28 | (slime-with-popup-buffer (bufname :connection t :package t) 29 | (when mode (funcall mode)) 30 | (princ string) 31 | (goto-char (point-min))) 32 | t) 33 | (t nil))) 34 | 35 | (defun slime-media-insert-image (image string &optional bol) 36 | (with-current-buffer (slime-output-buffer) 37 | (let ((marker (slime-output-target-marker :repl-result))) 38 | (goto-char marker) 39 | (slime-propertize-region `(face slime-repl-result-face 40 | rear-nonsticky (face)) 41 | (insert-image image string)) 42 | ;; Move the input-start marker after the REPL result. 43 | (set-marker marker (point))) 44 | (slime-repl-show-maximum-output))) 45 | 46 | (provide 'slime-media) 47 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-mrepl.el: -------------------------------------------------------------------------------- 1 | ;; An experimental implementation of multiple REPLs multiplexed over a 2 | ;; single Slime socket. M-x slime-new-mrepl creates a new REPL buffer. 3 | ;; 4 | (require 'slime) 5 | (require 'inferior-slime) ; inferior-slime-indent-lime 6 | (require 'cl-lib) 7 | 8 | (define-slime-contrib slime-mrepl 9 | "Multiple REPLs." 10 | (:authors "Helmut Eller ") 11 | (:license "GPL") 12 | (:swank-dependencies swank-mrepl)) 13 | 14 | (require 'comint) 15 | 16 | (defvar slime-mrepl-remote-channel nil) 17 | (defvar slime-mrepl-expect-sexp nil) 18 | 19 | (define-derived-mode slime-mrepl-mode comint-mode "mrepl" 20 | ;; idea lifted from ielm 21 | (unless (get-buffer-process (current-buffer)) 22 | (let* ((process-connection-type nil) 23 | (proc (start-process "mrepl (dummy)" (current-buffer) "hexl"))) 24 | (set-process-query-on-exit-flag proc nil))) 25 | (set (make-local-variable 'comint-use-prompt-regexp) nil) 26 | (set (make-local-variable 'comint-inhibit-carriage-motion) t) 27 | (set (make-local-variable 'comint-input-sender) 'slime-mrepl-input-sender) 28 | (set (make-local-variable 'comint-output-filter-functions) nil) 29 | (set (make-local-variable 'slime-mrepl-expect-sexp) t) 30 | ;;(set (make-local-variable 'comint-get-old-input) 'ielm-get-old-input) 31 | (set-syntax-table lisp-mode-syntax-table) 32 | ) 33 | 34 | (slime-define-keys slime-mrepl-mode-map 35 | ((kbd "RET") 'slime-mrepl-return) 36 | ([return] 'slime-mrepl-return) 37 | ;;((kbd "TAB") 'slime-indent-and-complete-symbol) 38 | ((kbd "C-c C-b") 'slime-interrupt) 39 | ((kbd "C-c C-c") 'slime-interrupt)) 40 | 41 | (defun slime-mrepl-process% () (get-buffer-process (current-buffer))) ;stupid 42 | (defun slime-mrepl-mark () (process-mark (slime-mrepl-process%))) 43 | 44 | (defun slime-mrepl-insert (string) 45 | (comint-output-filter (slime-mrepl-process%) string)) 46 | 47 | (slime-define-channel-type listener) 48 | 49 | (slime-define-channel-method listener :prompt (package prompt) 50 | (with-current-buffer (slime-channel-get self 'buffer) 51 | (slime-mrepl-prompt package prompt))) 52 | 53 | (defun slime-mrepl-prompt (package prompt) 54 | (setf slime-buffer-package package) 55 | (slime-mrepl-insert (format "%s%s> " 56 | (cl-case (current-column) 57 | (0 "") 58 | (t "\n")) 59 | prompt)) 60 | (slime-mrepl-recenter)) 61 | 62 | (defun slime-mrepl-recenter () 63 | (when (get-buffer-window) 64 | (recenter -1))) 65 | 66 | (slime-define-channel-method listener :write-result (result) 67 | (with-current-buffer (slime-channel-get self 'buffer) 68 | (goto-char (point-max)) 69 | (slime-mrepl-insert result))) 70 | 71 | (slime-define-channel-method listener :evaluation-aborted () 72 | (with-current-buffer (slime-channel-get self 'buffer) 73 | (goto-char (point-max)) 74 | (slime-mrepl-insert "; Evaluation aborted\n"))) 75 | 76 | (slime-define-channel-method listener :write-string (string) 77 | (slime-mrepl-write-string self string)) 78 | 79 | (defun slime-mrepl-write-string (self string) 80 | (with-current-buffer (slime-channel-get self 'buffer) 81 | (goto-char (slime-mrepl-mark)) 82 | (slime-mrepl-insert string))) 83 | 84 | (slime-define-channel-method listener :set-read-mode (mode) 85 | (with-current-buffer (slime-channel-get self 'buffer) 86 | (cl-ecase mode 87 | (:read (setq slime-mrepl-expect-sexp nil) 88 | (message "[Listener is waiting for input]")) 89 | (:eval (setq slime-mrepl-expect-sexp t))))) 90 | 91 | (defun slime-mrepl-return (&optional end-of-input) 92 | (interactive "P") 93 | (slime-check-connected) 94 | (goto-char (point-max)) 95 | (cond ((and slime-mrepl-expect-sexp 96 | (or (slime-input-complete-p (slime-mrepl-mark) (point)) 97 | end-of-input)) 98 | (comint-send-input)) 99 | ((not slime-mrepl-expect-sexp) 100 | (unless end-of-input 101 | (insert "\n")) 102 | (comint-send-input t)) 103 | (t 104 | (insert "\n") 105 | (inferior-slime-indent-line) 106 | (message "[input not complete]"))) 107 | (slime-mrepl-recenter)) 108 | 109 | (defun slime-mrepl-input-sender (proc string) 110 | (slime-mrepl-send-string (substring-no-properties string))) 111 | 112 | (defun slime-mrepl-send-string (string &optional command-string) 113 | (slime-mrepl-send `(:process ,string))) 114 | 115 | (defun slime-mrepl-send (msg) 116 | "Send MSG to the remote channel." 117 | (slime-send-to-remote-channel slime-mrepl-remote-channel msg)) 118 | 119 | (defun slime-new-mrepl () 120 | "Create a new listener window." 121 | (interactive) 122 | (let ((channel (slime-make-channel slime-listener-channel-methods))) 123 | (slime-eval-async 124 | `(swank-mrepl:create-mrepl ,(slime-channel.id channel)) 125 | (slime-rcurry 126 | (lambda (result channel) 127 | (cl-destructuring-bind (remote thread-id package prompt) result 128 | (pop-to-buffer (generate-new-buffer (slime-buffer-name :mrepl))) 129 | (slime-mrepl-mode) 130 | (setq slime-current-thread thread-id) 131 | (setq slime-buffer-connection (slime-connection)) 132 | (set (make-local-variable 'slime-mrepl-remote-channel) remote) 133 | (slime-channel-put channel 'buffer (current-buffer)) 134 | (slime-channel-send channel `(:prompt ,package ,prompt)))) 135 | channel)))) 136 | 137 | (defun slime-mrepl () 138 | (let ((conn (slime-connection))) 139 | (cl-find-if (lambda (x) 140 | (with-current-buffer x 141 | (and (eq major-mode 'slime-mrepl-mode) 142 | (eq (slime-current-connection) conn)))) 143 | (buffer-list)))) 144 | 145 | (def-slime-selector-method ?m 146 | "First mrepl-buffer" 147 | (or (slime-mrepl) 148 | (error "No mrepl buffer (%s)" (slime-connection-name)))) 149 | 150 | (provide 'slime-mrepl) 151 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-presentation-streams.el: -------------------------------------------------------------------------------- 1 | (eval-and-compile 2 | (require 'slime)) 3 | 4 | (define-slime-contrib slime-presentation-streams 5 | "Streams that allow attaching object identities to portions of 6 | output." 7 | (:authors "Alan Ruttenberg " 8 | "Matthias Koeppe " 9 | "Helmut Eller ") 10 | (:license "GPL") 11 | (:on-load 12 | (add-hook 'slime-connected-hook 'slime-presentation-streams-on-connected)) 13 | (:swank-dependencies swank-presentation-streams)) 14 | 15 | (defun slime-presentation-streams-on-connected () 16 | (slime-eval `(swank:init-presentation-streams))) 17 | 18 | (provide 'slime-presentation-streams) 19 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-quicklisp.el: -------------------------------------------------------------------------------- 1 | (require 'slime) 2 | (require 'cl-lib) 3 | 4 | ;;; bits of the following taken from slime-asdf.el 5 | 6 | (define-slime-contrib slime-quicklisp 7 | "Quicklisp support." 8 | (:authors "Matthew Kennedy ") 9 | (:license "GPL") 10 | (:slime-dependencies slime-repl) 11 | (:swank-dependencies swank-quicklisp)) 12 | 13 | ;;; Utilities 14 | 15 | (defgroup slime-quicklisp nil 16 | "Quicklisp support for Slime." 17 | :prefix "slime-quicklisp-" 18 | :group 'slime) 19 | 20 | (defvar slime-quicklisp-system-history nil 21 | "History list for Quicklisp system names.") 22 | 23 | 24 | 25 | (defun slime-read-quicklisp-system-name (&optional prompt default-value) 26 | "Read a Quick system name from the minibuffer, prompting with PROMPT." 27 | (let* ((completion-ignore-case nil) 28 | (prompt (or prompt "Quicklisp system")) 29 | (quicklisp-system-names (slime-eval `(swank:list-quicklisp-systems))) 30 | (prompt (concat prompt (if default-value 31 | (format " (default `%s'): " default-value) 32 | ": ")))) 33 | (completing-read prompt (slime-bogus-completion-alist quicklisp-system-names) 34 | nil nil nil 35 | 'slime-quicklisp-system-history default-value))) 36 | 37 | (defun slime-quicklisp-quickload (system) 38 | "Load a Quicklisp system." 39 | (slime-save-some-lisp-buffers) 40 | (slime-display-output-buffer) 41 | (slime-repl-shortcut-eval-async `(ql:quickload ,system))) 42 | 43 | ;;; REPL shortcuts 44 | 45 | (defslime-repl-shortcut slime-repl-quicklisp-quickload ("quicklisp-quickload" "ql") 46 | (:handler (lambda () 47 | (interactive) 48 | (slime-quicklisp-quickload (slime-read-quicklisp-system-name)))) 49 | (:one-liner "Load a system known to Quicklisp.")) 50 | 51 | (provide 'slime-quicklisp) 52 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-references.el: -------------------------------------------------------------------------------- 1 | (require 'slime) 2 | (require 'advice) 3 | (require 'slime-compiler-notes-tree) ; FIXME: actually only uses the tree bits, so that should be a library. 4 | 5 | (define-slime-contrib slime-references 6 | "Clickable references to documentation (SBCL only)." 7 | (:authors "Christophe Rhodes " 8 | "Luke Gorrie " 9 | "Tobias C. Rittweiler ") 10 | (:license "GPL") 11 | (:on-load 12 | (ad-enable-advice 'slime-note.message 'after 'slime-note.message+references) 13 | (ad-activate 'slime-note.message) 14 | (setq slime-tree-printer 'slime-tree-print-with-references) 15 | (add-hook 'sldb-extras-hooks 'sldb-maybe-insert-references)) 16 | (:on-unload 17 | (ad-disable-advice 'slime-note.message 'after 'slime-note.message+references) 18 | (ad-deactivate 'slime-note.message) 19 | (setq slime-tree-printer 'slime-tree-default-printer) 20 | (remove-hook 'sldb-extras-hooks 'sldb-maybe-insert-references))) 21 | 22 | (defcustom slime-sbcl-manual-root "http://www.sbcl.org/manual/" 23 | "*The base URL of the SBCL manual, for documentation lookup." 24 | :type '(choice (string :tag "HTML Documentation") 25 | (const :tag "Info Documentation" :info)) 26 | :group 'slime-mode) 27 | 28 | (defface sldb-reference-face 29 | (list (list t '(:underline t))) 30 | "Face for references." 31 | :group 'slime-debugger) 32 | 33 | 34 | ;;;;; SBCL-style references 35 | 36 | (defvar slime-references-local-keymap 37 | (let ((map (make-sparse-keymap "local keymap for slime references"))) 38 | (define-key map [mouse-2] 'slime-lookup-reference-at-mouse) 39 | (define-key map [return] 'slime-lookup-reference-at-point) 40 | map)) 41 | 42 | (defun slime-reference-properties (reference) 43 | "Return the properties for a reference. 44 | Only add clickability to properties we actually know how to lookup." 45 | (cl-destructuring-bind (where type what) reference 46 | (if (or (and (eq where :sbcl) (eq type :node)) 47 | (and (eq where :ansi-cl) 48 | (memq type '(:function :special-operator :macro 49 | :type :system-class 50 | :section :glossary :issue)))) 51 | `(slime-reference ,reference 52 | font-lock-face sldb-reference-face 53 | follow-link t 54 | mouse-face highlight 55 | help-echo "mouse-2: visit documentation." 56 | keymap ,slime-references-local-keymap)))) 57 | 58 | (defun slime-insert-reference (reference) 59 | "Insert documentation reference from a condition. 60 | See SWANK-BACKEND:CONDITION-REFERENCES for the datatype." 61 | (cl-destructuring-bind (where type what) reference 62 | (insert "\n" (slime-format-reference-source where) ", ") 63 | (slime-insert-propertized (slime-reference-properties reference) 64 | (slime-format-reference-node what)) 65 | (insert (format " [%s]" type)))) 66 | 67 | (defun slime-insert-references (references) 68 | (when references 69 | (insert "\nSee also:") 70 | (slime-with-rigid-indentation 2 71 | (mapc #'slime-insert-reference references)))) 72 | 73 | (defun slime-format-reference-source (where) 74 | (cl-case where 75 | (:amop "The Art of the Metaobject Protocol") 76 | (:ansi-cl "Common Lisp Hyperspec") 77 | (:sbcl "SBCL Manual") 78 | (t (format "%S" where)))) 79 | 80 | (defun slime-format-reference-node (what) 81 | (if (listp what) 82 | (mapconcat #'prin1-to-string what ".") 83 | what)) 84 | 85 | (defun slime-lookup-reference-at-point () 86 | "Browse the documentation reference at point." 87 | (interactive) 88 | (let ((refs (get-text-property (point) 'slime-reference))) 89 | (if (null refs) 90 | (error "No references at point") 91 | (cl-destructuring-bind (where type what) refs 92 | (cl-case where 93 | (:ansi-cl 94 | (cl-case type 95 | (:section 96 | (browse-url (funcall common-lisp-hyperspec-section-fun what))) 97 | (:glossary 98 | (browse-url (funcall common-lisp-hyperspec-glossary-function what))) 99 | (:issue 100 | (browse-url (common-lisp-issuex what))) 101 | (:special-operator 102 | (browse-url (common-lisp-special-operator (downcase name)))) 103 | (t 104 | (hyperspec-lookup what)))) 105 | (t 106 | (case slime-sbcl-manual-root 107 | (:info 108 | (info (format "(sbcl)%s" what))) 109 | (t 110 | (browse-url 111 | (format "%s#%s" slime-sbcl-manual-root 112 | (subst-char-in-string ?\ ?\- what))))))))))) 113 | 114 | (defun slime-lookup-reference-at-mouse (event) 115 | "Invoke the action pointed at by the mouse." 116 | (interactive "e") 117 | (cl-destructuring-bind (mouse-1 (w pos . _) . _) event 118 | (save-excursion 119 | (goto-char pos) 120 | (slime-lookup-reference-at-point)))) 121 | 122 | ;;;;; Hook into *SLIME COMPILATION* 123 | 124 | (defun slime-note.references (note) 125 | (plist-get note :references)) 126 | 127 | ;;; FIXME: `compilation-mode' will swallow the `mouse-face' 128 | ;;; etc. properties. 129 | (defadvice slime-note.message (after slime-note.message+references) 130 | (setq ad-return-value 131 | (concat ad-return-value 132 | (with-temp-buffer 133 | (slime-insert-references 134 | (slime-note.references (ad-get-arg 0))) 135 | (buffer-string))))) 136 | 137 | ;;;;; Hook into slime-compiler-notes-tree 138 | 139 | (defun slime-tree-print-with-references (tree) 140 | ;; for SBCL-style references 141 | (slime-tree-default-printer tree) 142 | (let ((note (plist-get (slime-tree.plist tree) 'note))) 143 | (when note 144 | (let ((references (slime-note.references note))) 145 | (when references 146 | (terpri (current-buffer)) 147 | (slime-insert-references references)))))) 148 | 149 | ;;;;; Hook into SLDB 150 | 151 | (defun sldb-maybe-insert-references (extra) 152 | (slime-dcase extra 153 | ((:references references) (slime-insert-references references) t) 154 | (t nil))) 155 | 156 | (provide 'slime-references) 157 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-ros.el: -------------------------------------------------------------------------------- 1 | (require 'slime) 2 | (require 'rosemacs) 3 | 4 | (define-slime-contrib slime-ros 5 | "Extension of slime for utilizing rosemacs features" 6 | (:authors "ROS Community") 7 | (:license "BSD") 8 | (:slime-dependencies slime-asdf) 9 | (:swank-dependencies swank-ros) 10 | (:on-load (add-hook 'slime-connected-hook 'slime-ros-load-manifest))) 11 | 12 | (defcustom slime-ros-completion-function 'completing-read 13 | "The completion function to be used for package and system 14 | completions. This variable can be set to `ido-completing-read' 15 | to enable `ido-mode' for ros packages." 16 | :type 'function 17 | :group 'rosemacs) 18 | 19 | (defvar slime-ros-package-history nil) 20 | 21 | (defun slime-ros-load-manifest () 22 | (let ((roslisp-path (ros-package-dir "roslisp"))) 23 | (when roslisp-path 24 | (slime-eval-async `(swank-ros:load-ros-manifest ,roslisp-path) 25 | (lambda (result) 26 | (message "Successfully loaded ros-load-manifest.")))))) 27 | 28 | (defun slime-ros-read-pkg-name (&optional prompt default-value) 29 | (cond ((not (slime-current-connection)) 30 | (message "Not connected.")) 31 | (t 32 | (let ((default (slime-eval `(cl:identity ros-load:*current-ros-package*)))) 33 | (ros-completing-read-package nil default slime-ros-completion-function))))) 34 | 35 | (defun slime-ros-replace-underscores (str) 36 | (replace-regexp-in-string "_" "-" str)) 37 | 38 | (defun slime-ros-get-systems-in-pkg (package &optional default-value prompt) 39 | (let* ((package-path (ros-package-path package)) 40 | (asd-files (append (ros-files-in-package package-path "asd" "asdf") 41 | (ros-files-in-package package-path "asd" "."))) 42 | (default2 (slime-ros-replace-underscores default-value)) 43 | (default (cond ((member default-value asd-files) default-value) 44 | ((member default2 asd-files) default2))) 45 | (prompt (concat (or prompt (format "ROS Package `%s', System" package)) 46 | (if default 47 | (format " (default `%s'): " default) 48 | ": ")))) 49 | (funcall slime-ros-completion-function 50 | prompt (mapcar #'car (slime-bogus-completion-alist asd-files)) 51 | nil nil nil nil default))) 52 | 53 | (defslime-repl-shortcut slime-repl-load-ros-system ("ros-load-system") 54 | (:handler (lambda () 55 | (interactive) 56 | (let* ((ros-pkg-name (slime-ros-read-pkg-name)) 57 | (path (ros-package-path ros-pkg-name)) 58 | (system-name (slime-ros-get-systems-in-pkg ros-pkg-name ros-pkg-name))) 59 | (slime-cd path) 60 | (setq default-directory path) 61 | (slime-eval `(cl:setf ros-load:*current-ros-package* ,ros-pkg-name)) 62 | (slime-oos system-name 'load-op))))) 63 | 64 | (defslime-repl-shortcut slime-repl-load-ros-system ("ros-test-system") 65 | (:handler (lambda () 66 | (interactive) 67 | (let* ((ros-pkg-name (slime-ros-read-pkg-name)) 68 | (system-name (slime-ros-get-systems-in-pkg ros-pkg-name ros-pkg-name))) 69 | (slime-eval `(cl:setf ros-load:*current-ros-package* ,ros-pkg-name)) 70 | (slime-oos system-name 'test-op))))) 71 | 72 | (provide 'slime-ros) 73 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-sbcl-exts.el: -------------------------------------------------------------------------------- 1 | (require 'slime) 2 | (require 'cl-lib) 3 | 4 | (define-slime-contrib slime-sbcl-exts 5 | "Misc extensions for SBCL" 6 | (:authors "Tobias C. Rittweiler ") 7 | (:license "GPL") 8 | (:slime-dependencies slime-references) 9 | (:swank-dependencies swank-sbcl-exts)) 10 | 11 | (defun slime-sbcl-bug-at-point () 12 | (save-excursion 13 | (save-match-data 14 | (unless (looking-at "#[0-9]\\{6\\}") 15 | (search-backward-regexp "#\\<" (line-beginning-position) t)) 16 | (when (looking-at "#[0-9]\\{6\\}") 17 | (buffer-substring-no-properties (match-beginning 0) (match-end 0)))))) 18 | 19 | (defun slime-read-sbcl-bug (prompt &optional query) 20 | "Either read a sbcl bug or choose the one at point. 21 | The user is prompted if a prefix argument is in effect, if there is no 22 | symbol at point, or if QUERY is non-nil." 23 | (let ((bug (slime-sbcl-bug-at-point))) 24 | (cond ((or current-prefix-arg query (not bug)) 25 | (slime-read-from-minibuffer prompt bug)) 26 | (t bug)))) 27 | 28 | (defun slime-visit-sbcl-bug (bug) 29 | "Visit the Launchpad site that describes `bug' (#nnnnnn)." 30 | (interactive (list (slime-read-sbcl-bug "Bug number (#nnnnnn): "))) 31 | (browse-url (format "http://bugs.launchpad.net/sbcl/+bug/%s" 32 | (substring bug 1)))) 33 | 34 | (provide 'slime-sbcl-exts) 35 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-scheme.el: -------------------------------------------------------------------------------- 1 | ;;; slime-scheme.el --- Support Scheme programs running under Common Lisp 2 | ;; 3 | ;; Authors: Matthias Koeppe 4 | ;; 5 | ;; License: GNU GPL (same license as Emacs) 6 | ;; 7 | ;;; Installation: 8 | ;; 9 | ;; Add this to your .emacs: 10 | ;; 11 | ;; (add-to-list 'load-path "") 12 | ;; (add-hook 'slime-load-hook (lambda () (require 'slime-scheme))) 13 | ;; 14 | (eval-and-compile 15 | (require 'slime)) 16 | 17 | (defun slime-scheme-mode-hook () 18 | (slime-mode 1)) 19 | 20 | (defun slime-scheme-indentation-update (symbol indent packages) 21 | ;; Does the symbol have an indentation value that we set? 22 | (when (equal (get symbol 'scheme-indent-function) 23 | (get symbol 'slime-scheme-indent)) 24 | (put symbol 'slime-scheme-indent indent) 25 | (put symbol 'scheme-indent-function indent))) 26 | 27 | 28 | ;;; Initialization 29 | 30 | (defun slime-scheme-init () 31 | (add-hook 'scheme-mode-hook 'slime-scheme-mode-hook) 32 | (add-hook 'slime-indentation-update-hooks 'slime-scheme-indentation-update) 33 | (add-to-list 'slime-lisp-modes 'scheme-mode)) 34 | 35 | (defun slime-scheme-unload () 36 | (remove-hook 'scheme-mode-hook 'slime-scheme-mode-hook) 37 | (remove-hook 'slime-indentation-update-hooks 'slime-scheme-indentation-update) 38 | (setq slime-lisp-modes (remove 'scheme-mode slime-lisp-modes))) 39 | 40 | (provide 'slime-scheme) 41 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-scratch.el: -------------------------------------------------------------------------------- 1 | ;;; slime-scratch.el 2 | 3 | (require 'slime) 4 | (require 'cl-lib) 5 | 6 | (define-slime-contrib slime-scratch 7 | "Imitate Emacs' *scratch* buffer" 8 | (:authors "Helmut Eller ") 9 | (:license "GPL") 10 | (:on-load 11 | (def-slime-selector-method ?s "*slime-scratch* buffer." 12 | (slime-scratch-buffer)))) 13 | 14 | 15 | ;;; Code 16 | 17 | (defvar slime-scratch-mode-map 18 | (let ((map (make-sparse-keymap))) 19 | (set-keymap-parent map lisp-mode-map) 20 | map)) 21 | 22 | (defun slime-scratch () 23 | (interactive) 24 | (slime-switch-to-scratch-buffer)) 25 | 26 | (defun slime-switch-to-scratch-buffer () 27 | (set-buffer (slime-scratch-buffer)) 28 | (unless (eq (current-buffer) (window-buffer)) 29 | (pop-to-buffer (current-buffer) t))) 30 | 31 | (defvar slime-scratch-file nil) 32 | 33 | (defun slime-scratch-buffer () 34 | "Return the scratch buffer, create it if necessary." 35 | (or (get-buffer (slime-buffer-name :scratch)) 36 | (with-current-buffer (if slime-scratch-file 37 | (find-file slime-scratch-file) 38 | (get-buffer-create (slime-buffer-name :scratch))) 39 | (rename-buffer (slime-buffer-name :scratch)) 40 | (lisp-mode) 41 | (use-local-map slime-scratch-mode-map) 42 | (slime-mode t) 43 | (current-buffer)))) 44 | 45 | (slime-define-keys slime-scratch-mode-map 46 | ("\C-j" 'slime-eval-print-last-expression)) 47 | 48 | (provide 'slime-scratch) 49 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-snapshot.el: -------------------------------------------------------------------------------- 1 | (eval-and-compile 2 | (require 'slime)) 3 | 4 | (define-slime-contrib slime-snapshot 5 | "Save&restore memory images without disconnecting" 6 | (:authors "Helmut Eller ") 7 | (:license "GPL v3") 8 | (:swank-dependencies swank-snapshot)) 9 | 10 | (defun slime-snapshot (filename &optional background) 11 | "Save a memory image to the file FILENAME." 12 | (interactive (list (read-file-name "Image file: ") 13 | current-prefix-arg)) 14 | (let ((file (expand-file-name filename))) 15 | (when (and (file-exists-p file) 16 | (not (yes-or-no-p (format "File exists %s. Overwrite it? " 17 | filename)))) 18 | (signal 'quit nil)) 19 | (slime-eval-with-transcript 20 | `(,(if background 21 | 'swank-snapshot:background-save-snapshot 22 | 'swank-snapshot:save-snapshot) 23 | ,file)))) 24 | 25 | (defun slime-restore (filename) 26 | "Restore a memory image stored in file FILENAME." 27 | (interactive (list (read-file-name "Image file: "))) 28 | ;; bypass event dispatcher because we don't expect a reply. FIXME. 29 | (slime-net-send `(:emacs-rex (swank-snapshot:restore-snapshot 30 | ,(expand-file-name filename)) 31 | nil t nil) 32 | (slime-connection))) 33 | 34 | (provide 'slime-snapshot) 35 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-tramp.el: -------------------------------------------------------------------------------- 1 | (require 'slime) 2 | (require 'tramp) 3 | (eval-when-compile (require 'cl)) ; lexical-let 4 | 5 | (define-slime-contrib slime-tramp 6 | "Filename translations for tramp" 7 | (:authors "Marco Baringer ") 8 | (:license "GPL") 9 | (:on-load 10 | (setq slime-to-lisp-filename-function #'slime-tramp-to-lisp-filename) 11 | (setq slime-from-lisp-filename-function #'slime-tramp-from-lisp-filename))) 12 | 13 | (defcustom slime-filename-translations nil 14 | "Assoc list of hostnames and filename translation functions. 15 | Each element is of the form (HOSTNAME-REGEXP TO-LISP FROM-LISP). 16 | 17 | HOSTNAME-REGEXP is a regexp which is applied to the connection's 18 | slime-machine-instance. If HOSTNAME-REGEXP maches then the 19 | corresponding TO-LISP and FROM-LISP functions will be used to 20 | translate emacs filenames and lisp filenames. 21 | 22 | TO-LISP will be passed the filename of an emacs buffer and must 23 | return a string which the underlying lisp understandas as a 24 | pathname. FROM-LISP will be passed a pathname as returned by the 25 | underlying lisp and must return something that emacs will 26 | understand as a filename (this string will be passed to 27 | find-file). 28 | 29 | This list will be traversed in order, so multiple matching 30 | regexps are possible. 31 | 32 | Example: 33 | 34 | Assuming you run emacs locally and connect to slime running on 35 | the machine 'soren' and you can connect with the username 36 | 'animaliter': 37 | 38 | (push (list \"^soren$\" 39 | (lambda (emacs-filename) 40 | (subseq emacs-filename (length \"/ssh:animaliter@soren:\"))) 41 | (lambda (lisp-filename) 42 | (concat \"/ssh:animaliter@soren:\" lisp-filename))) 43 | slime-filename-translations) 44 | 45 | See also `slime-create-filename-translator'." 46 | :type '(repeat (list :tag "Host description" 47 | (regexp :tag "Hostname regexp") 48 | (function :tag "To lisp function") 49 | (function :tag "From lisp function"))) 50 | :group 'slime-lisp) 51 | 52 | (defun slime-find-filename-translators (hostname) 53 | (cond ((cdr (cl-assoc-if (lambda (regexp) (string-match regexp hostname)) 54 | slime-filename-translations))) 55 | (t (list #'identity #'identity)))) 56 | 57 | (defun slime-make-tramp-file-name (username remote-host lisp-filename) 58 | "Old (with multi-hops) tramp compatability function" 59 | (if (boundp 'tramp-multi-methods) 60 | (tramp-make-tramp-file-name nil nil 61 | username 62 | remote-host 63 | lisp-filename) 64 | (tramp-make-tramp-file-name nil 65 | username 66 | remote-host 67 | lisp-filename))) 68 | 69 | (cl-defun slime-create-filename-translator (&key machine-instance 70 | remote-host 71 | username) 72 | "Creates a three element list suitable for push'ing onto 73 | slime-filename-translations which uses Tramp to load files on 74 | hostname using username. MACHINE-INSTANCE is a required 75 | parameter, REMOTE-HOST defaults to MACHINE-INSTANCE and USERNAME 76 | defaults to (user-login-name). 77 | 78 | MACHINE-INSTANCE is the value returned by slime-machine-instance, 79 | which is just the value returned by cl:machine-instance on the 80 | remote lisp. REMOTE-HOST is the fully qualified domain name (or 81 | just the IP) of the remote machine. USERNAME is the username we 82 | should login with. 83 | The functions created here expect your tramp-default-method or 84 | tramp-default-method-alist to be setup correctly." 85 | (lexical-let ((remote-host (or remote-host machine-instance)) 86 | (username (or username (user-login-name)))) 87 | (list (concat "^" machine-instance "$") 88 | (lambda (emacs-filename) 89 | (tramp-file-name-localname 90 | (tramp-dissect-file-name emacs-filename))) 91 | `(lambda (lisp-filename) 92 | (slime-make-tramp-file-name 93 | ,username 94 | ,remote-host 95 | lisp-filename))))) 96 | 97 | (defun slime-tramp-to-lisp-filename (filename) 98 | (funcall (if (slime-connected-p) 99 | (first (slime-find-filename-translators (slime-machine-instance))) 100 | 'identity) 101 | (expand-file-name filename))) 102 | 103 | (defun slime-tramp-from-lisp-filename (filename) 104 | (funcall (second (slime-find-filename-translators (slime-machine-instance))) 105 | filename)) 106 | 107 | (provide 'slime-tramp) 108 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-typeout-frame.el: -------------------------------------------------------------------------------- 1 | (require 'slime) 2 | (require 'slime-autodoc) 3 | (require 'cl-lib) 4 | 5 | (defvar slime-typeout-frame-unbind-stack ()) 6 | 7 | (define-slime-contrib slime-typeout-frame 8 | "Display messages in a dedicated frame." 9 | (:authors "Luke Gorrie ") 10 | (:license "GPL") 11 | (:on-load 12 | (unless (slime-typeout-tty-only-p) 13 | (add-hook 'slime-connected-hook 'slime-ensure-typeout-frame) 14 | (add-hook 'slime-autodoc-mode-hook 'slime-typeout-wrap-autodoc) 15 | (cl-loop for (var value) in 16 | '((slime-message-function slime-typeout-message) 17 | (slime-background-message-function slime-typeout-message)) 18 | do (slime-typeout-frame-init-var var value)))) 19 | (:on-unload 20 | (remove-hook 'slime-connected-hook 'slime-ensure-typeout-frame) 21 | (remove-hook 'slime-autodoc-mode-hook 'slime-typeout-wrap-autodoc) 22 | (cl-loop for (var value) in slime-typeout-frame-unbind-stack 23 | do (cond ((eq var 'slime-unbound) (makunbound var)) 24 | (t (set var value)))) 25 | (setq slime-typeout-frame-unbind-stack nil))) 26 | 27 | (defun slime-typeout-frame-init-var (var value) 28 | (push (list var (if (boundp var) (symbol-value var) 'slime-unbound)) 29 | slime-typeout-frame-unbind-stack) 30 | (set var value)) 31 | 32 | (defun slime-typeout-tty-only-p () 33 | (cond ((featurep 'xemacs) 34 | (null (remove 'tty (mapcar #'device-type (console-device-list))))) 35 | (t (not (window-system))))) 36 | 37 | 38 | ;;;; Typeout frame 39 | 40 | ;; When a "typeout frame" exists it is used to display certain 41 | ;; messages instead of the echo area or pop-up windows. 42 | 43 | (defvar slime-typeout-window nil 44 | "The current typeout window.") 45 | 46 | (defvar slime-typeout-frame-properties 47 | '((height . 10) (minibuffer . nil)) 48 | "The typeout frame properties (passed to `make-frame').") 49 | 50 | (defun slime-typeout-buffer () 51 | (with-current-buffer (get-buffer-create (slime-buffer-name :typeout)) 52 | (setq buffer-read-only t) 53 | (current-buffer))) 54 | 55 | (defun slime-typeout-active-p () 56 | (and slime-typeout-window 57 | (window-live-p slime-typeout-window))) 58 | 59 | (defun slime-typeout-message-aux (format-string &rest format-args) 60 | (slime-ensure-typeout-frame) 61 | (with-current-buffer (slime-typeout-buffer) 62 | (let ((inhibit-read-only t) 63 | (msg (apply #'format format-string format-args))) 64 | (unless (string= msg "") 65 | (erase-buffer) 66 | (insert msg))))) 67 | 68 | (defun slime-typeout-message (format-string &rest format-args) 69 | (apply #'slime-typeout-message-aux format-string format-args)) 70 | 71 | (defun slime-make-typeout-frame () 72 | "Create a frame for displaying messages (e.g. arglists)." 73 | (interactive) 74 | (let ((frame (make-frame slime-typeout-frame-properties))) 75 | (save-selected-window 76 | (select-window (frame-selected-window frame)) 77 | (switch-to-buffer (slime-typeout-buffer)) 78 | (setq slime-typeout-window (selected-window))))) 79 | 80 | (defun slime-ensure-typeout-frame () 81 | "Create the typeout frame unless it already exists." 82 | (interactive) 83 | (if (slime-typeout-active-p) 84 | (save-selected-window 85 | (select-window slime-typeout-window) 86 | (switch-to-buffer (slime-typeout-buffer))) 87 | (slime-make-typeout-frame))) 88 | 89 | (defun slime-typeout-wrap-autodoc () 90 | (setq eldoc-message-function 'slime-typeout-message-aux)) 91 | 92 | (provide 'slime-typeout-frame) 93 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/slime-xref-browser.el: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/code-iai/ros_emacs_utils/413e43573b2201e384f791bf348fad42e7b5b415/slime_wrapper/slime/contrib/slime-xref-browser.el -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-clipboard.lisp: -------------------------------------------------------------------------------- 1 | ;;; swank-clipboard.lisp --- Object clipboard 2 | ;; 3 | ;; Written by Helmut Eller in 2008. 4 | ;; License: Public Domain 5 | 6 | (defpackage :swank-clipboard 7 | (:use :cl) 8 | (:import-from :swank :defslimefun :with-buffer-syntax :dcase) 9 | (:export :add :delete-entry :entries :entry-to-ref :ref)) 10 | 11 | (in-package :swank-clipboard) 12 | 13 | (defstruct clipboard entries (counter 0)) 14 | 15 | (defvar *clipboard* (make-clipboard)) 16 | 17 | (defslimefun add (datum) 18 | (let ((value (dcase datum 19 | ((:string string package) 20 | (with-buffer-syntax (package) 21 | (eval (read-from-string string)))) 22 | ((:inspector part) 23 | (swank:inspector-nth-part part)) 24 | ((:sldb frame var) 25 | (swank/backend:frame-var-value frame var))))) 26 | (clipboard-add value) 27 | (format nil "Added: ~a" 28 | (entry-to-string (1- (length (clipboard-entries *clipboard*))))))) 29 | 30 | (defslimefun entries () 31 | (loop for (ref . value) in (clipboard-entries *clipboard*) 32 | collect `(,ref . ,(to-line value)))) 33 | 34 | (defslimefun delete-entry (entry) 35 | (let ((msg (format nil "Deleted: ~a" (entry-to-string entry)))) 36 | (clipboard-delete-entry entry) 37 | msg)) 38 | 39 | (defslimefun entry-to-ref (entry) 40 | (destructuring-bind (ref . value) (clipboard-entry entry) 41 | (list ref (to-line value 5)))) 42 | 43 | (defun clipboard-add (value) 44 | (setf (clipboard-entries *clipboard*) 45 | (append (clipboard-entries *clipboard*) 46 | (list (cons (incf (clipboard-counter *clipboard*)) 47 | value))))) 48 | 49 | (defun clipboard-ref (ref) 50 | (let ((tail (member ref (clipboard-entries *clipboard*) :key #'car))) 51 | (cond (tail (cdr (car tail))) 52 | (t (error "Invalid clipboard ref: ~s" ref))))) 53 | 54 | (defun clipboard-entry (entry) 55 | (elt (clipboard-entries *clipboard*) entry)) 56 | 57 | (defun clipboard-delete-entry (index) 58 | (let* ((list (clipboard-entries *clipboard*)) 59 | (tail (nthcdr index list))) 60 | (setf (clipboard-entries *clipboard*) 61 | (append (ldiff list tail) (cdr tail))))) 62 | 63 | (defun entry-to-string (entry) 64 | (destructuring-bind (ref . value) (clipboard-entry entry) 65 | (format nil "#@~d(~a)" ref (to-line value)))) 66 | 67 | (defun to-line (object &optional (width 75)) 68 | (with-output-to-string (*standard-output*) 69 | (write object :right-margin width :lines 1))) 70 | 71 | (provide :swank-clipboard) 72 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-hyperdoc.lisp: -------------------------------------------------------------------------------- 1 | (in-package :swank) 2 | 3 | (defslimefun hyperdoc (string) 4 | (let ((hyperdoc-package (find-package :hyperdoc))) 5 | (when hyperdoc-package 6 | (multiple-value-bind (symbol foundp symbol-name package) 7 | (parse-symbol string *buffer-package*) 8 | (declare (ignore symbol)) 9 | (when foundp 10 | (funcall (find-symbol (string :lookup) hyperdoc-package) 11 | (package-name (if (member package (cons *buffer-package* 12 | (package-use-list 13 | *buffer-package*))) 14 | *buffer-package* 15 | package)) 16 | symbol-name)))))) 17 | 18 | (provide :swank-hyperdoc) 19 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-ikarus.ss: -------------------------------------------------------------------------------- 1 | ;; swank-larceny.scm --- Swank server for Ikarus 2 | ;; 3 | ;; License: Public Domain 4 | ;; Author: Helmut Eller 5 | ;; 6 | ;; In a shell execute: 7 | ;; ikarus swank-ikarus.ss 8 | ;; and then `M-x slime-connect' in Emacs. 9 | ;; 10 | 11 | (library (swank os) 12 | (export getpid make-server-socket accept local-port close-socket) 13 | (import (rnrs) 14 | (only (ikarus foreign) make-c-callout dlsym dlopen 15 | pointer-set-c-long! pointer-ref-c-unsigned-short 16 | malloc free pointer-size) 17 | (rename (only (ikarus ipc) tcp-server-socket accept-connection 18 | close-tcp-server-socket) 19 | (tcp-server-socket make-server-socket) 20 | (close-tcp-server-socket close-socket)) 21 | (only (ikarus) 22 | struct-type-descriptor 23 | struct-type-field-names 24 | struct-field-accessor) 25 | ) 26 | 27 | (define libc (dlopen)) 28 | (define (cfun name return-type arg-types) 29 | ((make-c-callout return-type arg-types) (dlsym libc name))) 30 | 31 | (define getpid (cfun "getpid" 'signed-int '())) 32 | 33 | (define (accept socket codec) 34 | (let-values (((in out) (accept-connection socket))) 35 | (values (transcoded-port in (make-transcoder codec)) 36 | (transcoded-port out (make-transcoder codec))))) 37 | 38 | (define (socket-fd socket) 39 | (let ((rtd (struct-type-descriptor socket))) 40 | (do ((i 0 (+ i 1)) 41 | (names (struct-type-field-names rtd) (cdr names))) 42 | ((eq? (car names) 'fd) ((struct-field-accessor rtd i) socket))))) 43 | 44 | (define sockaddr_in/size 16) 45 | (define sockaddr_in/sin_family 0) 46 | (define sockaddr_in/sin_port 2) 47 | (define sockaddr_in/sin_addr 4) 48 | 49 | (define (local-port socket) 50 | (let* ((fd (socket-fd socket)) 51 | (addr (malloc sockaddr_in/size)) 52 | (size (malloc (pointer-size)))) 53 | (pointer-set-c-long! size 0 sockaddr_in/size) 54 | (let ((code (getsockname fd addr size)) 55 | (port (ntohs (pointer-ref-c-unsigned-short 56 | addr sockaddr_in/sin_port)))) 57 | (free addr) 58 | (free size) 59 | (cond ((= code -1) (error "getsockname failed")) 60 | (#t port))))) 61 | 62 | (define getsockname 63 | (cfun "getsockname" 'signed-int '(signed-int pointer pointer))) 64 | 65 | (define ntohs (cfun "ntohs" 'unsigned-short '(unsigned-short))) 66 | 67 | ) 68 | 69 | 70 | (library (swank sys) 71 | (export implementation-name eval-in-interaction-environment) 72 | (import (rnrs) 73 | (rnrs eval) 74 | (only (ikarus) interaction-environment)) 75 | 76 | (define (implementation-name) "ikarus") 77 | 78 | (define (eval-in-interaction-environment form) 79 | (eval form (interaction-environment))) 80 | 81 | ) 82 | 83 | (import (only (ikarus) load)) 84 | (load "swank-r6rs.scm") 85 | (import (swank)) 86 | (start-server #f) 87 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-indentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package :swank) 2 | 3 | (defvar *application-hints-tables* '() 4 | "A list of hash tables mapping symbols to indentation hints (lists 5 | of symbols and numbers as per cl-indent.el). Applications can add hash 6 | tables to the list to change the auto indentation slime sends to 7 | emacs.") 8 | 9 | (defun has-application-indentation-hint-p (symbol) 10 | (let ((default (load-time-value (gensym)))) 11 | (dolist (table *application-hints-tables*) 12 | (let ((indentation (gethash symbol table default))) 13 | (unless (eq default indentation) 14 | (return-from has-application-indentation-hint-p 15 | (values indentation t)))))) 16 | (values nil nil)) 17 | 18 | (defun application-indentation-hint (symbol) 19 | (let ((indentation (has-application-indentation-hint-p symbol))) 20 | (labels ((walk (indentation-spec) 21 | (etypecase indentation-spec 22 | (null nil) 23 | (number indentation-spec) 24 | (symbol (string-downcase indentation-spec)) 25 | (cons (cons (walk (car indentation-spec)) 26 | (walk (cdr indentation-spec))))))) 27 | (walk indentation)))) 28 | 29 | ;;; override swank version of this function 30 | (defun symbol-indentation (symbol) 31 | "Return a form describing the indentation of SYMBOL. 32 | 33 | The form is to be used as the `common-lisp-indent-function' property 34 | in Emacs." 35 | (cond 36 | ((has-application-indentation-hint-p symbol) 37 | (application-indentation-hint symbol)) 38 | ((and (macro-function symbol) 39 | (not (known-to-emacs-p symbol))) 40 | (let ((arglist (arglist symbol))) 41 | (etypecase arglist 42 | ((member :not-available) 43 | nil) 44 | (list 45 | (macro-indentation arglist))))) 46 | (t nil))) 47 | 48 | ;;; More complex version. 49 | (defun macro-indentation (arglist) 50 | (labels ((frob (list &optional base) 51 | (if (every (lambda (x) 52 | (member x '(nil "&rest") :test #'equal)) 53 | list) 54 | ;; If there was nothing interesting, don't return anything. 55 | nil 56 | ;; Otherwise substitute leading NIL's with 4 or 1. 57 | (let ((ok t)) 58 | (substitute-if (if base 59 | 4 60 | 1) 61 | (lambda (x) 62 | (if (and ok (not x)) 63 | t 64 | (setf ok nil))) 65 | list)))) 66 | (walk (list level &optional firstp) 67 | (when (consp list) 68 | (let ((head (car list))) 69 | (if (consp head) 70 | (let ((indent (frob (walk head (+ level 1) t)))) 71 | (cons (list* "&whole" (if (zerop level) 72 | 4 73 | 1) 74 | indent) (walk (cdr list) level))) 75 | (case head 76 | ;; &BODY is &BODY, this is clear. 77 | (&body 78 | '("&body")) 79 | ;; &KEY is tricksy. If it's at the base level, we want 80 | ;; to indent them normally: 81 | ;; 82 | ;; (foo bar quux 83 | ;; :quux t 84 | ;; :zot nil) 85 | ;; 86 | ;; If it's at a destructuring level, we want indent of 1: 87 | ;; 88 | ;; (with-foo (var arg 89 | ;; :foo t 90 | ;; :quux nil) 91 | ;; ...) 92 | (&key 93 | (if (zerop level) 94 | '("&rest" nil) 95 | '("&rest" 1))) 96 | ;; &REST is tricksy. If it's at the front of 97 | ;; destructuring, we want to indent by 1, otherwise 98 | ;; normally: 99 | ;; 100 | ;; (foo (bar quux 101 | ;; zot) 102 | ;; ...) 103 | ;; 104 | ;; but 105 | ;; 106 | ;; (foo bar quux 107 | ;; zot) 108 | (&rest 109 | (if (and (plusp level) firstp) 110 | '("&rest" 1) 111 | '("&rest" nil))) 112 | ;; &WHOLE and &ENVIRONMENT are skipped as if they weren't there 113 | ;; at all. 114 | ((&whole &environment) 115 | (walk (cddr list) level firstp)) 116 | ;; &OPTIONAL is indented normally -- and the &OPTIONAL marker 117 | ;; itself is not counted. 118 | (&optional 119 | (walk (cdr list) level)) 120 | ;; Indent normally, walk the tail -- but 121 | ;; unknown lambda-list keywords terminate the walk. 122 | (otherwise 123 | (unless (member head lambda-list-keywords) 124 | (cons nil (walk (cdr list) level)))))))))) 125 | (frob (walk arglist 0 t) t))) 126 | 127 | #+nil 128 | (progn 129 | (assert (equal '(4 4 ("&whole" 4 "&rest" 1) "&body") 130 | (macro-indentation '(bar quux (&rest slots) &body body)))) 131 | (assert (equal nil 132 | (macro-indentation '(a b c &rest more)))) 133 | (assert (equal '(4 4 4 "&body") 134 | (macro-indentation '(a b c &body more)))) 135 | (assert (equal '(("&whole" 4 1 1 "&rest" 1) "&body") 136 | (macro-indentation '((name zot &key foo bar) &body body)))) 137 | (assert (equal nil 138 | (macro-indentation '(x y &key z))))) 139 | 140 | (provide :swank-indentation) 141 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-larceny.scm: -------------------------------------------------------------------------------- 1 | ;; swank-larceny.scm --- Swank server for Larceny 2 | ;; 3 | ;; License: Public Domain 4 | ;; Author: Helmut Eller 5 | ;; 6 | ;; In a shell execute: 7 | ;; larceny -r6rs -program swank-larceny.scm 8 | ;; and then `M-x slime-connect' in Emacs. 9 | 10 | (library (swank os) 11 | (export getpid make-server-socket accept local-port close-socket) 12 | (import (rnrs) 13 | (primitives foreign-procedure 14 | ffi/handle->address 15 | ffi/string->asciiz 16 | sizeof:pointer 17 | sizeof:int 18 | %set-pointer 19 | %get-int)) 20 | 21 | (define getpid (foreign-procedure "getpid" '() 'int)) 22 | (define fork (foreign-procedure "fork" '() 'int)) 23 | (define close (foreign-procedure "close" '(int) 'int)) 24 | (define dup2 (foreign-procedure "dup2" '(int int) 'int)) 25 | 26 | (define bytevector-content-offset$ sizeof:pointer) 27 | 28 | (define execvp% (foreign-procedure "execvp" '(string boxed) 'int)) 29 | (define (execvp file . args) 30 | (let* ((nargs (length args)) 31 | (argv (make-bytevector (* (+ nargs 1) 32 | sizeof:pointer)))) 33 | (do ((offset 0 (+ offset sizeof:pointer)) 34 | (as args (cdr as))) 35 | ((null? as)) 36 | (%set-pointer argv 37 | offset 38 | (+ (ffi/handle->address (ffi/string->asciiz (car as))) 39 | bytevector-content-offset$))) 40 | (%set-pointer argv (* nargs sizeof:pointer) 0) 41 | (execvp% file argv))) 42 | 43 | (define pipe% (foreign-procedure "pipe" '(boxed) 'int)) 44 | (define (pipe) 45 | (let ((array (make-bytevector (* sizeof:int 2)))) 46 | (let ((r (pipe% array))) 47 | (values r (%get-int array 0) (%get-int array sizeof:int))))) 48 | 49 | (define (fork/exec file . args) 50 | (let ((pid (fork))) 51 | (cond ((= pid 0) 52 | (apply execvp file args)) 53 | (#t pid)))) 54 | 55 | (define (start-process file . args) 56 | (let-values (((r1 down-out down-in) (pipe)) 57 | ((r2 up-out up-in) (pipe)) 58 | ((r3 err-out err-in) (pipe))) 59 | (assert (= 0 r1)) 60 | (assert (= 0 r2)) 61 | (assert (= 0 r3)) 62 | (let ((pid (fork))) 63 | (case pid 64 | ((-1) 65 | (error "Failed to fork a subprocess.")) 66 | ((0) 67 | (close up-out) 68 | (close err-out) 69 | (close down-in) 70 | (dup2 down-out 0) 71 | (dup2 up-in 1) 72 | (dup2 err-in 2) 73 | (apply execvp file args) 74 | (exit 1)) 75 | (else 76 | (close down-out) 77 | (close up-in) 78 | (close err-in) 79 | (list pid 80 | (make-fd-io-stream up-out down-in) 81 | (make-fd-io-stream err-out err-out))))))) 82 | 83 | (define (make-fd-io-stream in out) 84 | (let ((write (lambda (bv start count) (fd-write out bv start count))) 85 | (read (lambda (bv start count) (fd-read in bv start count))) 86 | (closeit (lambda () (close in) (close out)))) 87 | (make-custom-binary-input/output-port 88 | "fd-stream" read write #f #f closeit))) 89 | 90 | (define write% (foreign-procedure "write" '(int ulong int) 'int)) 91 | (define (fd-write fd bytevector start count) 92 | (write% fd 93 | (+ (ffi/handle->address bytevector) 94 | bytevector-content-offset$ 95 | start) 96 | count)) 97 | 98 | (define read% (foreign-procedure "read" '(int ulong int) 'int)) 99 | (define (fd-read fd bytevector start count) 100 | ;;(printf "fd-read: ~a ~s ~a ~a\n" fd bytevector start count) 101 | (read% fd 102 | (+ (ffi/handle->address bytevector) 103 | bytevector-content-offset$ 104 | start) 105 | count)) 106 | 107 | (define (make-server-socket port) 108 | (let* ((args `("/bin/bash" "bash" 109 | "-c" 110 | ,(string-append 111 | "netcat -s 127.0.0.1 -q 0 -l -v " 112 | (if port 113 | (string-append "-p " (number->string port)) 114 | "")))) 115 | (nc (apply start-process args)) 116 | (err (transcoded-port (list-ref nc 2) 117 | (make-transcoder (latin-1-codec)))) 118 | (line (get-line err)) 119 | (pos (last-index-of line '#\]))) 120 | (cond (pos 121 | (let* ((tail (substring line (+ pos 1) (string-length line))) 122 | (port (get-datum (open-string-input-port tail)))) 123 | (list (car nc) (cadr nc) err port))) 124 | (#t (error "netcat failed: " line))))) 125 | 126 | (define (accept socket codec) 127 | (let* ((line (get-line (caddr socket))) 128 | (pos (last-index-of line #\]))) 129 | (cond (pos 130 | (close-port (caddr socket)) 131 | (let ((stream (cadr socket))) 132 | (let ((io (transcoded-port stream (make-transcoder codec)))) 133 | (values io io)))) 134 | (else (error "accept failed: " line))))) 135 | 136 | (define (local-port socket) 137 | (list-ref socket 3)) 138 | 139 | (define (last-index-of str chr) 140 | (let loop ((i (string-length str))) 141 | (cond ((<= i 0) #f) 142 | (#t (let ((i (- i 1))) 143 | (cond ((char=? (string-ref str i) chr) 144 | i) 145 | (#t 146 | (loop i)))))))) 147 | 148 | (define (close-socket socket) 149 | ;;(close-port (cadr socket)) 150 | #f 151 | ) 152 | 153 | ) 154 | 155 | (library (swank sys) 156 | (export implementation-name eval-in-interaction-environment) 157 | (import (rnrs) 158 | (primitives system-features 159 | aeryn-evaluator)) 160 | 161 | (define (implementation-name) "larceny") 162 | 163 | ;; see $LARCENY/r6rsmode.sch: 164 | ;; Larceny's ERR5RS and R6RS modes. 165 | ;; Code names: 166 | ;; Aeryn ERR5RS 167 | ;; D'Argo R6RS-compatible 168 | ;; Spanky R6RS-conforming (not yet implemented) 169 | (define (eval-in-interaction-environment form) 170 | (aeryn-evaluator form)) 171 | 172 | ) 173 | 174 | (import (rnrs) (rnrs eval) (larceny load)) 175 | (load "swank-r6rs.scm") 176 | (eval '(start-server #f) (environment '(swank))) 177 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-listener-hooks.lisp: -------------------------------------------------------------------------------- 1 | ;;; swank-listener-hooks.lisp --- listener with special hooks 2 | ;; 3 | ;; Author: Alan Ruttenberg 4 | 5 | ;; Provides *slime-repl-eval-hooks* special variable which 6 | ;; can be used for easy interception of SLIME REPL form evaluation 7 | ;; for purposes such as integration with application event loop. 8 | 9 | (in-package :swank) 10 | 11 | (eval-when (:compile-toplevel :load-toplevel :execute) 12 | (swank-require :swank-repl)) 13 | 14 | (defvar *slime-repl-advance-history* nil 15 | "In the dynamic scope of a single form typed at the repl, is set to nil to 16 | prevent the repl from advancing the history - * ** *** etc.") 17 | 18 | (defvar *slime-repl-suppress-output* nil 19 | "In the dynamic scope of a single form typed at the repl, is set to nil to 20 | prevent the repl from printing the result of the evalation.") 21 | 22 | (defvar *slime-repl-eval-hook-pass* (gensym "PASS") 23 | "Token to indicate that a repl hook declines to evaluate the form") 24 | 25 | (defvar *slime-repl-eval-hooks* nil 26 | "A list of functions. When the repl is about to eval a form, first try running each of 27 | these hooks. The first hook which returns a value which is not *slime-repl-eval-hook-pass* 28 | is considered a replacement for calling eval. If there are no hooks, or all 29 | pass, then eval is used.") 30 | 31 | (export '*slime-repl-eval-hooks*) 32 | 33 | (defslimefun repl-eval-hook-pass () 34 | "call when repl hook declines to evaluate the form" 35 | (throw *slime-repl-eval-hook-pass* *slime-repl-eval-hook-pass*)) 36 | 37 | (defslimefun repl-suppress-output () 38 | "In the dynamic scope of a single form typed at the repl, call to 39 | prevent the repl from printing the result of the evalation." 40 | (setq *slime-repl-suppress-output* t)) 41 | 42 | (defslimefun repl-suppress-advance-history () 43 | "In the dynamic scope of a single form typed at the repl, call to 44 | prevent the repl from advancing the history - * ** *** etc." 45 | (setq *slime-repl-advance-history* nil)) 46 | 47 | (defun %eval-region (string) 48 | (with-input-from-string (stream string) 49 | (let (- values) 50 | (loop 51 | (let ((form (read stream nil stream))) 52 | (when (eq form stream) 53 | (fresh-line) 54 | (finish-output) 55 | (return (values values -))) 56 | (setq - form) 57 | (if *slime-repl-eval-hooks* 58 | (setq values (run-repl-eval-hooks form)) 59 | (setq values (multiple-value-list (eval form)))) 60 | (finish-output)))))) 61 | 62 | (defun run-repl-eval-hooks (form) 63 | (loop for hook in *slime-repl-eval-hooks* 64 | for res = (catch *slime-repl-eval-hook-pass* 65 | (multiple-value-list (funcall hook form))) 66 | until (not (eq res *slime-repl-eval-hook-pass*)) 67 | finally (return 68 | (if (eq res *slime-repl-eval-hook-pass*) 69 | (multiple-value-list (eval form)) 70 | res)))) 71 | 72 | (defun %listener-eval (string) 73 | (clear-user-input) 74 | (with-buffer-syntax () 75 | (swank-repl::track-package 76 | (lambda () 77 | (let ((*slime-repl-suppress-output* :unset) 78 | (*slime-repl-advance-history* :unset)) 79 | (multiple-value-bind (values last-form) (%eval-region string) 80 | (unless (or (and (eq values nil) (eq last-form nil)) 81 | (eq *slime-repl-advance-history* nil)) 82 | (setq *** ** ** * * (car values) 83 | /// // // / / values)) 84 | (setq +++ ++ ++ + + last-form) 85 | (unless (eq *slime-repl-suppress-output* t) 86 | (funcall swank-repl::*send-repl-results-function* values))))))) 87 | nil) 88 | 89 | (setq swank-repl::*listener-eval-function* '%listener-eval) 90 | 91 | (provide :swank-listener-hooks) 92 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-media.lisp: -------------------------------------------------------------------------------- 1 | ;;; swank-media.lisp --- insert other media (images) 2 | ;; 3 | ;; Authors: Christophe Rhodes 4 | ;; 5 | ;; Licence: GPLv2 or later 6 | ;; 7 | 8 | (in-package :swank) 9 | 10 | ;; this file is empty of functionality. The slime-media contrib 11 | ;; allows swank to return messages other than :write-string as repl 12 | ;; results; this is used in the R implementation of swank to display R 13 | ;; objects with graphical representations (such as trellis objects) as 14 | ;; image presentations in the swank repl. In R, this is done by 15 | ;; having a hook function for the preparation of the repl results, in 16 | ;; addition to the already-existing hook for sending the repl results 17 | ;; (*send-repl-results-function*, used by swank-presentations.lisp). 18 | ;; The swank-media.R contrib implementation defines a generic function 19 | ;; for use as this hook, along with methods for commonly-encountered 20 | ;; graphical R objects. (This strategy is harder in CL, where methods 21 | ;; can only be defined if their specializers already exist; in R's S3 22 | ;; object system, methods are ordinary functions with a special naming 23 | ;; convention) 24 | 25 | (provide :swank-media) 26 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-mrepl.lisp: -------------------------------------------------------------------------------- 1 | ;;; swank-mrepl.lisp 2 | ;; 3 | ;; Licence: public domain 4 | 5 | (in-package :swank) 6 | (eval-when (:compile-toplevel :load-toplevel :execute) 7 | (let ((api '( 8 | *emacs-connection* 9 | channel 10 | channel-id 11 | define-channel-method 12 | defslimefun 13 | dcase 14 | log-event 15 | process-requests 16 | send-to-remote-channel 17 | use-threads-p 18 | wait-for-event 19 | with-bindings 20 | with-connection 21 | with-top-level-restart 22 | with-slime-interrupts 23 | ))) 24 | (eval `(defpackage #:swank-api 25 | (:use) 26 | (:import-from #:swank . ,api) 27 | (:export . ,api))))) 28 | 29 | (defpackage :swank-mrepl 30 | (:use :cl :swank-api) 31 | (:export #:create-mrepl)) 32 | 33 | (in-package :swank-mrepl) 34 | 35 | (defclass listener-channel (channel) 36 | ((remote :initarg :remote) 37 | (env :initarg :env) 38 | (mode :initform :eval) 39 | (tag :initform nil))) 40 | 41 | (defun package-prompt (package) 42 | (reduce (lambda (x y) (if (<= (length x) (length y)) x y)) 43 | (cons (package-name package) (package-nicknames package)))) 44 | 45 | (defslimefun create-mrepl (remote) 46 | (let* ((pkg *package*) 47 | (conn *emacs-connection*) 48 | (thread (if (use-threads-p) 49 | (spawn-listener-thread conn) 50 | nil)) 51 | (ch (make-instance 'listener-channel :remote remote :thread thread))) 52 | (setf (slot-value ch 'env) (initial-listener-env ch)) 53 | (when thread 54 | (swank/backend:send thread `(:serve-channel ,ch))) 55 | (list (channel-id ch) 56 | (swank/backend:thread-id (or thread (swank/backend:current-thread))) 57 | (package-name pkg) 58 | (package-prompt pkg)))) 59 | 60 | (defun initial-listener-env (listener) 61 | `((*package* . ,*package*) 62 | (*standard-output* . ,(make-listener-output-stream listener)) 63 | (*standard-input* . ,(make-listener-input-stream listener)))) 64 | 65 | (defun spawn-listener-thread (connection) 66 | (swank/backend:spawn 67 | (lambda () 68 | (with-connection (connection) 69 | (dcase (swank/backend:receive) 70 | ((:serve-channel c) 71 | (loop 72 | (with-top-level-restart (connection (drop-unprocessed-events c)) 73 | (process-requests nil))))))) 74 | :name "mrepl thread")) 75 | 76 | (defun drop-unprocessed-events (channel) 77 | (with-slots (mode) channel 78 | (let ((old-mode mode)) 79 | (setf mode :drop) 80 | (unwind-protect 81 | (process-requests t) 82 | (setf mode old-mode))) 83 | (send-prompt channel))) 84 | 85 | (define-channel-method :process ((c listener-channel) string) 86 | (log-event ":process ~s~%" string) 87 | (with-slots (mode remote) c 88 | (ecase mode 89 | (:eval (mrepl-eval c string)) 90 | (:read (mrepl-read c string)) 91 | (:drop)))) 92 | 93 | (defun mrepl-eval (channel string) 94 | (with-slots (remote env) channel 95 | (let ((aborted t)) 96 | (with-bindings env 97 | (unwind-protect 98 | (let ((result (with-slime-interrupts (read-eval-print string)))) 99 | (send-to-remote-channel remote `(:write-result ,result)) 100 | (setq aborted nil)) 101 | (setf env (loop for (sym) in env 102 | collect (cons sym (symbol-value sym)))) 103 | (cond (aborted 104 | (send-to-remote-channel remote `(:evaluation-aborted))) 105 | (t 106 | (send-prompt channel)))))))) 107 | 108 | (defun send-prompt (channel) 109 | (with-slots (env remote) channel 110 | (let ((pkg (or (cdr (assoc '*package* env)) *package*)) 111 | (out (cdr (assoc '*standard-output* env))) 112 | (in (cdr (assoc '*standard-input* env)))) 113 | (when out (force-output out)) 114 | (when in (clear-input in)) 115 | (send-to-remote-channel remote `(:prompt ,(package-name pkg) 116 | ,(package-prompt pkg)))))) 117 | 118 | (defun mrepl-read (channel string) 119 | (with-slots (tag) channel 120 | (assert tag) 121 | (throw tag string))) 122 | 123 | (defun read-eval-print (string) 124 | (with-input-from-string (in string) 125 | (setq / ()) 126 | (loop 127 | (let* ((form (read in nil in))) 128 | (cond ((eq form in) (return)) 129 | (t (setq / (multiple-value-list (eval (setq + form)))))))) 130 | (force-output) 131 | (if / 132 | (format nil "~{~s~%~}" /) 133 | "; No values"))) 134 | 135 | (defun make-listener-output-stream (channel) 136 | (let ((remote (slot-value channel 'remote))) 137 | (swank/backend:make-output-stream 138 | (lambda (string) 139 | (send-to-remote-channel remote `(:write-string ,string)))))) 140 | 141 | (defun make-listener-input-stream (channel) 142 | (swank/backend:make-input-stream (lambda () (read-input channel)))) 143 | 144 | (defun set-mode (channel new-mode) 145 | (with-slots (mode remote) channel 146 | (unless (eq mode new-mode) 147 | (send-to-remote-channel remote `(:set-read-mode ,new-mode))) 148 | (setf mode new-mode))) 149 | 150 | (defun read-input (channel) 151 | (with-slots (mode tag remote) channel 152 | (force-output) 153 | (let ((old-mode mode) 154 | (old-tag tag)) 155 | (setf tag (cons nil nil)) 156 | (set-mode channel :read) 157 | (unwind-protect 158 | (catch tag (process-requests nil)) 159 | (setf tag old-tag) 160 | (set-mode channel old-mode))))) 161 | 162 | (provide :swank-mrepl) 163 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-package-fu.lisp: -------------------------------------------------------------------------------- 1 | 2 | (in-package :swank) 3 | 4 | (defslimefun package= (string1 string2) 5 | (let* ((pkg1 (guess-package string1)) 6 | (pkg2 (guess-package string2))) 7 | (and pkg1 pkg2 (eq pkg1 pkg2)))) 8 | 9 | (defslimefun export-symbol-for-emacs (symbol-str package-str) 10 | (let ((package (guess-package package-str))) 11 | (when package 12 | (let ((*buffer-package* package)) 13 | (export `(,(from-string symbol-str)) package))))) 14 | 15 | (defslimefun unexport-symbol-for-emacs (symbol-str package-str) 16 | (let ((package (guess-package package-str))) 17 | (when package 18 | (let ((*buffer-package* package)) 19 | (unexport `(,(from-string symbol-str)) package))))) 20 | 21 | #+sbcl 22 | (defun list-structure-symbols (name) 23 | (let ((dd (sb-kernel:find-defstruct-description name ))) 24 | (list* name 25 | (sb-kernel:dd-default-constructor dd) 26 | (sb-kernel:dd-predicate-name dd) 27 | (sb-kernel::dd-copier-name dd) 28 | (mapcar #'sb-kernel:dsd-accessor-name 29 | (sb-kernel:dd-slots dd))))) 30 | 31 | #+ccl 32 | (defun list-structure-symbols (name) 33 | (let ((definition (gethash name ccl::%defstructs%))) 34 | (list* name 35 | (ccl::sd-constructor definition) 36 | (ccl::sd-refnames definition)))) 37 | 38 | (defun list-class-symbols (name) 39 | (let* ((class (find-class name)) 40 | (slots (swank-mop:class-direct-slots class))) 41 | (labels ((extract-symbol (name) 42 | (if (and (consp name) (eql (car name) 'setf)) 43 | (cadr name) 44 | name)) 45 | (slot-accessors (slot) 46 | (nintersection (copy-list (swank-mop:slot-definition-readers slot)) 47 | (copy-list (swank-mop:slot-definition-readers slot)) 48 | :key #'extract-symbol))) 49 | (list* (class-name class) 50 | (mapcan #'slot-accessors slots))))) 51 | 52 | (defslimefun export-structure (name package) 53 | (let ((*package* (guess-package package))) 54 | (when *package* 55 | (let* ((name (from-string name)) 56 | (symbols (cond #+(or sbcl ccl) 57 | ((or (not (find-class name nil)) 58 | (subtypep name 'structure-object)) 59 | (list-structure-symbols name)) 60 | (t 61 | (list-class-symbols name))))) 62 | (export symbols) 63 | symbols)))) 64 | 65 | (provide :swank-package-fu) 66 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-quicklisp.lisp: -------------------------------------------------------------------------------- 1 | ;;; swank-quicklisp.lisp -- Quicklisp support 2 | ;; 3 | ;; Authors: Matthew Kennedy 4 | ;; License: Public Domain 5 | ;; 6 | 7 | (in-package :swank) 8 | 9 | (defslimefun list-quicklisp-systems () 10 | "Returns the Quicklisp systems list." 11 | (if (member :quicklisp *features*) 12 | (let ((ql-dist-name (find-symbol "NAME" "QL-DIST")) 13 | (ql-system-list (find-symbol "SYSTEM-LIST" "QL"))) 14 | (mapcar ql-dist-name (funcall ql-system-list))) 15 | (error "Could not find Quicklisp already loaded."))) 16 | 17 | (provide :swank-quicklisp) 18 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-ros.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defpackage swank-ros 3 | (:use :cl) 4 | (:import-from :swank #:defslimefun) 5 | (:export #:load-ros-manifest)) 6 | 7 | (in-package :swank-ros) 8 | 9 | (defmethod asdf:perform :around ((o asdf:load-op) 10 | (c asdf:cl-source-file)) 11 | (handler-case (call-next-method o c) 12 | ;; If a fasl was stale, try to recompile and load (once). 13 | (sb-ext:invalid-fasl () 14 | (asdf:perform (make-instance 'asdf:compile-op) c) 15 | (call-next-method)))) 16 | 17 | ;;; Add appropriate paths for asdf to look for ros-load-manifest and load it 18 | (defslimefun load-ros-manifest (asdf-system-directory) 19 | (unless (asdf:find-system :ros-load-manifest nil) 20 | (let ((load-manifest-directory 21 | (parse-namestring 22 | (concatenate 'string (namestring asdf-system-directory) 23 | "/load-manifest/")))) 24 | (push load-manifest-directory asdf:*central-registry*))) 25 | (asdf:operate 'asdf:load-op :ros-load-manifest) 26 | (format t "~%ROS welcomes you!")) 27 | 28 | ;;; Redirect all the I/O from Swank SBCL process to standard I/O 29 | (setf swank:*globally-redirect-io* t) 30 | 31 | (provide :swank-ros) 32 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-sbcl-exts.lisp: -------------------------------------------------------------------------------- 1 | ;;; swank-sbcl-exts.lisp --- Misc extensions for SBCL 2 | ;; 3 | ;; Authors: Tobias C. Rittweiler 4 | ;; 5 | ;; License: Public Domain 6 | ;; 7 | 8 | (in-package :swank) 9 | 10 | (eval-when (:compile-toplevel :load-toplevel :execute) 11 | (swank-require :swank-arglists)) 12 | 13 | ;; We need to do this so users can place `slime-sbcl-exts' into their 14 | ;; ~/.emacs, and still use any implementation they want. 15 | #+sbcl 16 | (progn 17 | 18 | ;;; Display arglist of instructions. 19 | ;;; 20 | (defmethod compute-enriched-decoded-arglist ((operator-form (eql 'sb-assem:inst)) 21 | argument-forms) 22 | (flet ((decode-instruction-arglist (instr-name instr-arglist) 23 | (let ((decoded-arglist (decode-arglist instr-arglist))) 24 | ;; The arglist of INST is (instruction ...INSTR-ARGLIST...). 25 | (push 'sb-assem::instruction (arglist.required-args decoded-arglist)) 26 | (values decoded-arglist 27 | (list instr-name) 28 | t)))) 29 | (if (null argument-forms) 30 | (call-next-method) 31 | (destructuring-bind (instruction &rest args) argument-forms 32 | (declare (ignore args)) 33 | (let* ((instr-name 34 | (typecase instruction 35 | (arglist-dummy 36 | (string-upcase (arglist-dummy.string-representation instruction))) 37 | (symbol 38 | (string-downcase instruction)))) 39 | (instr-fn 40 | #+#.(swank/backend:with-symbol 'op-encoder-name 'sb-assem) 41 | (or (sb-assem::op-encoder-name instr-name) 42 | (sb-assem::op-encoder-name (string-upcase instr-name))) 43 | #+#.(swank/backend:with-symbol 'inst-emitter-symbol 'sb-assem) 44 | (sb-assem::inst-emitter-symbol instr-name) 45 | #+(and 46 | (not #.(swank/backend:with-symbol 'inst-emitter-symbol 'sb-assem)) 47 | #.(swank/backend:with-symbol '*assem-instructions* 'sb-assem)) 48 | (gethash instr-name sb-assem:*assem-instructions*))) 49 | (cond ((functionp instr-fn) 50 | (with-available-arglist (arglist) (arglist instr-fn) 51 | (decode-instruction-arglist instr-name arglist))) 52 | ((fboundp instr-fn) 53 | (with-available-arglist (arglist) (arglist instr-fn) 54 | ;; SB-ASSEM:INST invokes a symbolic INSTR-FN with 55 | ;; current segment and current vop implicitly. 56 | (decode-instruction-arglist instr-name 57 | (if (or (get instr-fn :macro) 58 | (macro-function instr-fn)) 59 | arglist 60 | (cddr arglist))))) 61 | (t 62 | (call-next-method)))))))) 63 | 64 | 65 | ) ; PROGN 66 | 67 | (provide :swank-sbcl-exts) 68 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-snapshot.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defpackage swank-snapshot 3 | (:use cl) 4 | (:export restore-snapshot save-snapshot background-save-snapshot) 5 | (:import-from swank defslimefun)) 6 | (in-package swank-snapshot) 7 | 8 | (defslimefun save-snapshot (image-file) 9 | (swank/backend:save-image image-file 10 | (let ((c swank::*emacs-connection*)) 11 | (lambda () (resurrect c)))) 12 | (format nil "Dumped lisp to ~A" image-file)) 13 | 14 | (defslimefun restore-snapshot (image-file) 15 | (let* ((conn swank::*emacs-connection*) 16 | (stream (swank::connection.socket-io conn)) 17 | (clone (swank/backend:dup (swank/backend:socket-fd stream))) 18 | (style (swank::connection.communication-style conn)) 19 | (repl (if (swank::connection.user-io conn) t)) 20 | (args (list "--swank-fd" (format nil "~d" clone) 21 | "--swank-style" (format nil "~s" style) 22 | "--swank-repl" (format nil "~s" repl)))) 23 | (swank::close-connection conn nil nil) 24 | (swank/backend:exec-image image-file args))) 25 | 26 | (defslimefun background-save-snapshot (image-file) 27 | (let ((connection swank::*emacs-connection*)) 28 | (flet ((complete (success) 29 | (let ((swank::*emacs-connection* connection)) 30 | (swank::background-message 31 | "Dumping lisp image ~A ~:[failed!~;succeeded.~]" 32 | image-file success))) 33 | (awaken () 34 | (resurrect connection))) 35 | (swank/backend:background-save-image image-file 36 | :restart-function #'awaken 37 | :completion-function #'complete) 38 | (format nil "Started dumping lisp to ~A..." image-file)))) 39 | 40 | (in-package :swank) 41 | 42 | (defun swank-snapshot::resurrect (old-connection) 43 | (setq *log-output* nil) 44 | (init-log-output) 45 | (clear-event-history) 46 | (setq *connections* (delete old-connection *connections*)) 47 | (format *error-output* "args: ~s~%" (command-line-args)) 48 | (let* ((fd (read-command-line-arg "--swank-fd")) 49 | (style (read-command-line-arg "--swank-style")) 50 | (repl (read-command-line-arg "--swank-repl")) 51 | (* (format *error-output* "fd=~s style=~s~%" fd style)) 52 | (stream (make-fd-stream fd nil)) 53 | (connection (make-connection nil stream style))) 54 | (let ((*emacs-connection* connection)) 55 | (when repl (swank-repl:create-repl nil)) 56 | (background-message "~A" "Lisp image restored")) 57 | (serve-requests connection) 58 | (simple-repl))) 59 | 60 | (defun read-command-line-arg (name) 61 | (let* ((args (command-line-args)) 62 | (pos (position name args :test #'equal))) 63 | (read-from-string (elt args (1+ pos))))) 64 | 65 | (in-package :swank-snapshot) 66 | 67 | (provide :swank-snapshot) 68 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-sprof.lisp: -------------------------------------------------------------------------------- 1 | ;;; swank-sprof.lisp 2 | ;; 3 | ;; Authors: Juho Snellman 4 | ;; 5 | ;; License: MIT 6 | ;; 7 | 8 | (in-package :swank) 9 | 10 | #+sbcl 11 | (eval-when (:compile-toplevel :load-toplevel :execute) 12 | (require :sb-sprof)) 13 | 14 | #+sbcl(progn 15 | 16 | (defvar *call-graph* nil) 17 | (defvar *node-numbers* nil) 18 | (defvar *number-nodes* nil) 19 | 20 | (defun frame-name (name) 21 | (if (consp name) 22 | (case (first name) 23 | ((sb-c::xep sb-c::tl-xep 24 | sb-c::&more-processor 25 | sb-c::top-level-form 26 | sb-c::&optional-processor) 27 | (second name)) 28 | (sb-pcl::fast-method 29 | (cdr name)) 30 | ((flet labels lambda) 31 | (let* ((in (member :in name))) 32 | (if (stringp (cadr in)) 33 | (append (ldiff name in) (cddr in)) 34 | name))) 35 | (t 36 | name)) 37 | name)) 38 | 39 | (defun pretty-name (name) 40 | (let ((*package* (find-package :common-lisp-user)) 41 | (*print-right-margin* most-positive-fixnum)) 42 | (format nil "~S" (frame-name name)))) 43 | 44 | (defun samples-percent (count) 45 | (sb-sprof::samples-percent *call-graph* count)) 46 | 47 | (defun node-values (node) 48 | (values (pretty-name (sb-sprof::node-name node)) 49 | (samples-percent (sb-sprof::node-count node)) 50 | (samples-percent (sb-sprof::node-accrued-count node)))) 51 | 52 | (defun filter-swank-nodes (nodes) 53 | (let ((swank-packages (load-time-value 54 | (mapcar #'find-package 55 | '(swank swank/rpc swank/mop 56 | swank/match swank/backend))))) 57 | (remove-if (lambda (node) 58 | (let ((name (sb-sprof::node-name node))) 59 | (and (symbolp name) 60 | (member (symbol-package name) swank-packages 61 | :test #'eq)))) 62 | nodes))) 63 | 64 | (defun serialize-call-graph (&key exclude-swank) 65 | (let ((nodes (sb-sprof::call-graph-flat-nodes *call-graph*))) 66 | (when exclude-swank 67 | (setf nodes (filter-swank-nodes nodes))) 68 | (setf nodes (sort (copy-list nodes) #'> 69 | ;; :key #'sb-sprof::node-count))) 70 | :key #'sb-sprof::node-accrued-count)) 71 | (setf *number-nodes* (make-hash-table)) 72 | (setf *node-numbers* (make-hash-table)) 73 | (loop for node in nodes 74 | for i from 1 75 | with total = 0 76 | collect (multiple-value-bind (name self cumulative) 77 | (node-values node) 78 | (setf (gethash node *node-numbers*) i 79 | (gethash i *number-nodes*) node) 80 | (incf total self) 81 | (list i name self cumulative total)) into list 82 | finally (return 83 | (let ((rest (- 100 total))) 84 | (return (append list 85 | `((nil "Elsewhere" ,rest nil nil))))))))) 86 | 87 | (defslimefun swank-sprof-get-call-graph (&key exclude-swank) 88 | (when (setf *call-graph* (sb-sprof:report :type nil)) 89 | (serialize-call-graph :exclude-swank exclude-swank))) 90 | 91 | (defslimefun swank-sprof-expand-node (index) 92 | (let* ((node (gethash index *number-nodes*))) 93 | (labels ((caller-count (v) 94 | (loop for e in (sb-sprof::vertex-edges v) do 95 | (when (eq (sb-sprof::edge-vertex e) node) 96 | (return-from caller-count (sb-sprof::call-count e)))) 97 | 0) 98 | (serialize-node (node count) 99 | (etypecase node 100 | (sb-sprof::cycle 101 | (list (sb-sprof::cycle-index node) 102 | (sb-sprof::cycle-name node) 103 | (samples-percent count))) 104 | (sb-sprof::node 105 | (let ((name (node-values node))) 106 | (list (gethash node *node-numbers*) 107 | name 108 | (samples-percent count))))))) 109 | (list :callers (loop for node in 110 | (sort (copy-list (sb-sprof::node-callers node)) #'> 111 | :key #'caller-count) 112 | collect (serialize-node node 113 | (caller-count node))) 114 | :calls (let ((edges (sort (copy-list (sb-sprof::vertex-edges node)) 115 | #'> 116 | :key #'sb-sprof::call-count))) 117 | (loop for edge in edges 118 | collect 119 | (serialize-node (sb-sprof::edge-vertex edge) 120 | (sb-sprof::call-count edge)))))))) 121 | 122 | (defslimefun swank-sprof-disassemble (index) 123 | (let* ((node (gethash index *number-nodes*)) 124 | (debug-info (sb-sprof::node-debug-info node))) 125 | (with-output-to-string (s) 126 | (typecase debug-info 127 | (sb-impl::code-component 128 | (sb-disassem::disassemble-memory (sb-vm::code-instructions debug-info) 129 | (sb-vm::%code-code-size debug-info) 130 | :stream s)) 131 | (sb-di::compiled-debug-fun 132 | (let ((component (sb-di::compiled-debug-fun-component debug-info))) 133 | (sb-disassem::disassemble-code-component component :stream s))) 134 | (t `(:error "No disassembly available")))))) 135 | 136 | (defslimefun swank-sprof-source-location (index) 137 | (let* ((node (gethash index *number-nodes*)) 138 | (debug-info (sb-sprof::node-debug-info node))) 139 | (or (when (typep debug-info 'sb-di::compiled-debug-fun) 140 | (let* ((component (sb-di::compiled-debug-fun-component debug-info)) 141 | (function (sb-kernel::%code-entry-points component))) 142 | (when function 143 | (find-source-location function)))) 144 | `(:error "No source location available")))) 145 | 146 | (defslimefun swank-sprof-start (&key (mode :cpu)) 147 | (sb-sprof:start-profiling :mode mode)) 148 | 149 | (defslimefun swank-sprof-stop () 150 | (sb-sprof:stop-profiling)) 151 | 152 | ) 153 | 154 | (provide :swank-sprof) 155 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/swank-util.lisp: -------------------------------------------------------------------------------- 1 | ;;; swank-util.lisp --- stuff of questionable utility 2 | ;; 3 | ;; License: public domain 4 | 5 | (in-package :swank) 6 | 7 | (defmacro do-symbols* ((var &optional (package '*package*) result-form) 8 | &body body) 9 | "Just like do-symbols, but makes sure a symbol is visited only once." 10 | (let ((seen-ht (gensym "SEEN-HT"))) 11 | `(let ((,seen-ht (make-hash-table :test #'eq))) 12 | (do-symbols (,var ,package ,result-form) 13 | (unless (gethash ,var ,seen-ht) 14 | (setf (gethash ,var ,seen-ht) t) 15 | (tagbody ,@body)))))) 16 | 17 | (defun classify-symbol (symbol) 18 | "Returns a list of classifiers that classify SYMBOL according to its 19 | underneath objects (e.g. :BOUNDP if SYMBOL constitutes a special 20 | variable.) The list may contain the following classification 21 | keywords: :BOUNDP, :FBOUNDP, :CONSTANT, :GENERIC-FUNCTION, 22 | :TYPESPEC, :CLASS, :MACRO, :SPECIAL-OPERATOR, and/or :PACKAGE" 23 | (check-type symbol symbol) 24 | (flet ((type-specifier-p (s) 25 | (or (documentation s 'type) 26 | (not (eq (type-specifier-arglist s) :not-available))))) 27 | (let (result) 28 | (when (boundp symbol) (push (if (constantp symbol) 29 | :constant :boundp) result)) 30 | (when (fboundp symbol) (push :fboundp result)) 31 | (when (type-specifier-p symbol) (push :typespec result)) 32 | (when (find-class symbol nil) (push :class result)) 33 | (when (macro-function symbol) (push :macro result)) 34 | (when (special-operator-p symbol) (push :special-operator result)) 35 | (when (find-package symbol) (push :package result)) 36 | (when (and (fboundp symbol) 37 | (typep (ignore-errors (fdefinition symbol)) 38 | 'generic-function)) 39 | (push :generic-function result)) 40 | result))) 41 | 42 | (defun symbol-classification-string (symbol) 43 | "Return a string in the form -f-c---- where each letter stands for 44 | boundp fboundp generic-function class macro special-operator package" 45 | (let ((letters "bfgctmsp") 46 | (result (copy-seq "--------"))) 47 | (flet ((flip (letter) 48 | (setf (char result (position letter letters)) 49 | letter))) 50 | (when (boundp symbol) (flip #\b)) 51 | (when (fboundp symbol) 52 | (flip #\f) 53 | (when (typep (ignore-errors (fdefinition symbol)) 54 | 'generic-function) 55 | (flip #\g))) 56 | (when (type-specifier-p symbol) (flip #\t)) 57 | (when (find-class symbol nil) (flip #\c) ) 58 | (when (macro-function symbol) (flip #\m)) 59 | (when (special-operator-p symbol) (flip #\s)) 60 | (when (find-package symbol) (flip #\p)) 61 | result))) 62 | 63 | (provide :swank-util) 64 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/test/slime-c-p-c-tests.el: -------------------------------------------------------------------------------- 1 | (require 'slime-c-p-c) 2 | (require 'slime-tests) 3 | 4 | (def-slime-test complete-symbol* 5 | (prefix expected-completions) 6 | "Find the completions of a symbol-name prefix." 7 | '(("cl:compile" (("cl:compile" "cl:compile-file" "cl:compile-file-pathname" 8 | "cl:compiled-function" "cl:compiled-function-p" 9 | "cl:compiler-macro" "cl:compiler-macro-function") 10 | "cl:compile")) 11 | ("cl:foobar" nil) 12 | ("swank::compile-file" (("swank::compile-file" 13 | "swank::compile-file-for-emacs" 14 | "swank::compile-file-if-needed" 15 | "swank::compile-file-output" 16 | "swank::compile-file-pathname") 17 | "swank::compile-file")) 18 | ("cl:m-v-l" (("cl:multiple-value-list" "cl:multiple-values-limit") "cl:multiple-value")) 19 | ("common-lisp" (("common-lisp-user:" "common-lisp:") "common-lisp"))) 20 | (let ((completions (slime-completions prefix))) 21 | (slime-test-expect "Completion set" expected-completions completions))) 22 | 23 | (def-slime-test complete-form 24 | (buffer-sexpr wished-completion &optional skip-trailing-test-p) 25 | "" 26 | '(("(defmethod arglist-dispatch *HERE*" 27 | "(defmethod arglist-dispatch (operator arguments) body...)") 28 | ("(with-struct *HERE*" 29 | "(with-struct (conc-name names...) obj body...)") 30 | ("(with-struct *HERE*" 31 | "(with-struct (conc-name names...) obj body...)") 32 | ("(with-struct (*HERE*" 33 | "(with-struct (conc-name names...)" t) 34 | ("(with-struct (foo. bar baz *HERE*" 35 | "(with-struct (foo. bar baz names...)" t)) 36 | (slime-check-top-level) 37 | (with-temp-buffer 38 | (lisp-mode) 39 | (setq slime-buffer-package "SWANK") 40 | (insert buffer-sexpr) 41 | (search-backward "*HERE*") 42 | (delete-region (match-beginning 0) (match-end 0)) 43 | (slime-complete-form) 44 | (slime-check-completed-form buffer-sexpr wished-completion) 45 | 46 | ;; Now the same but with trailing `)' for paredit users... 47 | (unless skip-trailing-test-p 48 | (erase-buffer) 49 | (insert buffer-sexpr) 50 | (search-backward "*HERE*") 51 | (delete-region (match-beginning 0) (match-end 0)) 52 | (insert ")") (backward-char) 53 | (slime-complete-form) 54 | (slime-check-completed-form (concat buffer-sexpr ")") wished-completion)) 55 | )) 56 | 57 | (defun slime-check-completed-form (buffer-sexpr wished-completion) 58 | (slime-test-expect (format "Completed form for `%s' is as expected" 59 | buffer-sexpr) 60 | wished-completion 61 | (buffer-string) 62 | 'equal)) 63 | 64 | (provide 'slime-c-p-c-tests) 65 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/test/slime-enclosing-context-tests.el: -------------------------------------------------------------------------------- 1 | (require 'slime-enclosing-context) 2 | (require 'slime-tests) 3 | (require 'cl-lib) 4 | 5 | (def-slime-test enclosing-context.1 6 | (buffer-sexpr wished-bound-names wished-bound-functions) 7 | "Check that finding local definitions work." 8 | '(("(flet ((,nil ())) 9 | (let ((bar 13) 10 | (,foo 42)) 11 | *HERE*))" 12 | ;; We used to return ,foo here, but we do not anymore. We 13 | ;; still return ,nil for the `slime-enclosing-bound-functions', 14 | ;; though. The first one is used for local M-., whereas the 15 | ;; latter is used for local autodoc. It does not seem too 16 | ;; important for local M-. to work on such names. \(The reason 17 | ;; that it does not work anymore, is that 18 | ;; `slime-symbol-at-point' now does TRT and does not return a 19 | ;; leading comma anymore.\) 20 | ("bar" nil nil) 21 | ((",nil" "()"))) 22 | ("(flet ((foo ())) 23 | (quux) 24 | (bar *HERE*))" 25 | ("foo") 26 | (("foo" "()")))) 27 | (slime-check-top-level) 28 | (with-temp-buffer 29 | (let ((tmpbuf (current-buffer))) 30 | (lisp-mode) 31 | (insert buffer-sexpr) 32 | (search-backward "*HERE*") 33 | (cl-multiple-value-bind (bound-names points) 34 | (slime-enclosing-bound-names) 35 | (slime-check "Check enclosing bound names" 36 | (cl-loop for name in wished-bound-names 37 | always (member name bound-names)))) 38 | (cl-multiple-value-bind (fn-names fn-arglists points) 39 | (slime-enclosing-bound-functions) 40 | (slime-check "Check enclosing bound functions" 41 | (cl-loop for (name arglist) in wished-bound-functions 42 | always (and (member name fn-names) 43 | (member arglist fn-arglists))))) 44 | ))) 45 | 46 | (provide 'slime-enclosing-context-tests) 47 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/test/slime-fontifying-fu-tests.el: -------------------------------------------------------------------------------- 1 | (require 'slime-fontifying-fu) 2 | (require 'slime-tests) 3 | 4 | (def-slime-test font-lock-magic (buffer-content) 5 | "Some testing for the font-lock-magic. *YES* should be 6 | highlighted as a suppressed form, *NO* should not." 7 | 8 | '(("(defun *NO* (x y) (+ x y))") 9 | ("(defun *NO*") 10 | ("*NO*) #-(and) (*YES*) (*NO* *NO*") 11 | ("\( 12 | \(defun *NO*") 13 | ("\) 14 | \(defun *NO* 15 | \( 16 | \)") 17 | ("#+#.foo 18 | \(defun *NO* (x y) (+ x y))") 19 | ("#+#.foo 20 | \(defun *NO* (x ") 21 | ("#+( 22 | \(defun *NO* (x ") 23 | ("#+(test) 24 | \(defun *NO* (x ") 25 | 26 | ("(eval-when (...) 27 | \(defun *NO* (x ") 28 | 29 | ("(eval-when (...) 30 | #+(and) 31 | \(defun *NO* (x ") 32 | 33 | ("#-(and) (defun *YES* (x y) (+ x y))") 34 | (" 35 | #-(and) (defun *YES* (x y) (+ x y)) 36 | #+(and) (defun *NO* (x y) (+ x y))") 37 | 38 | ("#+(and) (defun *NO* (x y) #-(and) (+ *YES* y))") 39 | ("#| #+(or) |# *NO*") 40 | ("#| #+(or) x |# *NO*") 41 | ("*NO* \"#| *NO* #+(or) x |# *NO*\" *NO*") 42 | ("#+#.foo (defun foo (bar)) 43 | #-(and) *YES* *NO* bar 44 | ") 45 | ("#+(foo) (defun foo (bar)) 46 | #-(and) *YES* *NO* bar") 47 | ("#| #+(or) |# *NO* foo 48 | #-(and) *YES* *NO*") 49 | ("#- (and) 50 | \(*YES*) 51 | \(*NO*) 52 | #-(and) 53 | \(*YES*) 54 | \(*NO*)") 55 | ("#+nil (foo) 56 | 57 | #-(and) 58 | #+nil ( 59 | asdf *YES* a 60 | fsdfad) 61 | 62 | \( asdf *YES* 63 | 64 | ) 65 | \(*NO*) 66 | 67 | ") 68 | ("*NO* 69 | 70 | #-(and) \(progn 71 | #-(and) 72 | (defun *YES* ...) 73 | 74 | #+(and) 75 | (defun *YES* ...) 76 | 77 | (defun *YES* ...) 78 | 79 | *YES* 80 | 81 | *YES* 82 | 83 | *YES* 84 | 85 | *YES* 86 | \) 87 | 88 | *NO*") 89 | ("#-(not) *YES* *NO* 90 | 91 | *NO* 92 | 93 | #+(not) *NO* *NO* 94 | 95 | *NO* 96 | 97 | #+(not a b c) *NO* *NO* 98 | 99 | *NO*")) 100 | (slime-check-top-level) 101 | (with-temp-buffer 102 | (insert buffer-content) 103 | (slime-initialize-lisp-buffer-for-test-suite 104 | :autodoc t :font-lock-magic t) 105 | ;; Can't use `font-lock-fontify-buffer' because for the case when 106 | ;; `jit-lock-mode' is enabled. Jit-lock-mode fontifies only on 107 | ;; actual display. 108 | (font-lock-default-fontify-buffer) 109 | (when (search-backward "*NO*" nil t) 110 | (slime-test-expect "Not suppressed by reader conditional?" 111 | 'slime-reader-conditional-face 112 | (get-text-property (point) 'face) 113 | #'(lambda (x y) (not (eq x y))))) 114 | (goto-char (point-max)) 115 | (when (search-backward "*YES*" nil t) 116 | (slime-test-expect "Suppressed by reader conditional?" 117 | 'slime-reader-conditional-face 118 | (get-text-property (point) 'face))))) 119 | 120 | (provide 'slime-fontifying-fu-tests) 121 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/test/slime-indentation-tests.el: -------------------------------------------------------------------------------- 1 | (require 'slime-indentation) 2 | (require 'slime-tests) 3 | 4 | (define-common-lisp-style "common-lisp-indent-test" 5 | ;; Used to specify a few complex indentation specs for testing. 6 | (:inherit "basic") 7 | (:indentation 8 | (complex-indent.1 ((&whole 4 (&whole 1 1 1 1 (&whole 1 1) &rest 1) 9 | &body) &body)) 10 | (complex-indent.2 (4 (&whole 4 &rest 1) &body)) 11 | (complex-indent.3 (4 &body)))) 12 | 13 | (defun slime-indentation-mess-up-indentation () 14 | (while (not (eobp)) 15 | (forward-line 1) 16 | (unless (looking-at "^$") 17 | (cl-case (random 2) 18 | (0 19 | ;; Delete all leading whitespace -- except for 20 | ;; comment lines. 21 | (while (and (looking-at " ") (not (looking-at " ;"))) 22 | (delete-char 1))) 23 | (1 24 | ;; Insert whitespace random. 25 | (let ((n (1+ (random 24)))) 26 | (while (> n 0) (cl-decf n) (insert " "))))))) 27 | (buffer-string)) 28 | 29 | (eval-and-compile 30 | (defun slime-indentation-test-form (test-name bindings expected) 31 | `(define-slime-ert-test ,test-name () 32 | ,(format "An indentation test named `%s'" test-name) 33 | (with-temp-buffer 34 | (lisp-mode) 35 | (setq indent-tabs-mode nil) 36 | (common-lisp-set-style "common-lisp-indent-test") 37 | (let ,(cons `(expected ,expected) bindings) 38 | (insert expected) 39 | (goto-char (point-min)) 40 | (let ((mess (slime-indentation-mess-up-indentation))) 41 | (when (string= mess expected) 42 | (ert-fail "Could not mess up indentation?")) 43 | (indent-region (point-min) (point-max)) 44 | (delete-trailing-whitespace) 45 | (should (equal expected (buffer-string)))))))) 46 | 47 | (defun slime-indentation-test-forms-for-file (file) 48 | (with-current-buffer 49 | (find-file-noselect (concat slime-path 50 | "/contrib/test/slime-cl-indent-test.txt")) 51 | (goto-char (point-min)) 52 | (cl-loop 53 | while (re-search-forward ";;; Test:[\t\n\s]*\\(.*\\)[\t\n\s]" nil t) 54 | for test-name = (intern (match-string-no-properties 1)) 55 | for bindings = 56 | (save-restriction 57 | (narrow-to-region (point) 58 | (progn (forward-comment 59 | (point-max)) 60 | (point))) 61 | (save-excursion 62 | (goto-char (point-min)) 63 | (cl-loop while 64 | (re-search-forward 65 | "\\([^\s]*\\)[\t\n\s]*:[\t\n\s]*\\(.*\\)[\t\n\s]" nil t) 66 | collect (list 67 | (intern (match-string-no-properties 1)) 68 | (car 69 | (read-from-string (match-string-no-properties 2))))))) 70 | for expected = (buffer-substring-no-properties (point) 71 | (scan-sexps (point) 72 | 1)) 73 | collect (slime-indentation-test-form test-name bindings expected))))) 74 | 75 | (defmacro slime-indentation-define-tests () 76 | `(progn 77 | ,@(slime-indentation-test-forms-for-file "slime-cl-indent-test.txt"))) 78 | 79 | (slime-indentation-define-tests) 80 | 81 | (provide 'slime-indentation-tests) 82 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/test/slime-mdot-fu-tests.el: -------------------------------------------------------------------------------- 1 | (require 'slime-mdot-fu) 2 | (require 'slime-tests) 3 | 4 | (def-slime-test find-local-definitions.1 5 | (buffer-sexpr definition target-regexp) 6 | "Check that finding local definitions work." 7 | '(((defun foo (x) 8 | (let ((y (+ x 1))) 9 | (- x y *HERE*))) 10 | y 11 | "(y (+ x 1))") 12 | 13 | ((defun bar (x) 14 | (flet ((foo (z) (+ x z))) 15 | (* x (foo *HERE*)))) 16 | foo 17 | "(foo (z) (+ x z))") 18 | 19 | ((defun quux (x) 20 | (flet ((foo (z) (+ x z))) 21 | (let ((foo (- 1 x))) 22 | (+ x foo *HERE*)))) 23 | foo 24 | "(foo (- 1 x)") 25 | 26 | ((defun zurp (x) 27 | (macrolet ((frob (x y) `(quux ,x ,y))) 28 | (frob x *HERE*))) 29 | frob 30 | "(frob (x y)")) 31 | (slime-check-top-level) 32 | (with-temp-buffer 33 | (let ((tmpbuf (current-buffer))) 34 | (insert (prin1-to-string buffer-sexpr)) 35 | (search-backward "*HERE*") 36 | (slime-edit-local-definition (prin1-to-string definition)) 37 | (slime-sync) 38 | (slime-check "Check that we didnt leave the temp buffer." 39 | (eq (current-buffer) tmpbuf)) 40 | (slime-check "Check that we are at the local definition." 41 | (looking-at (regexp-quote target-regexp)))))) 42 | 43 | (provide 'slime-mdot-fu-tests) 44 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/test/slime-parse-tests.el: -------------------------------------------------------------------------------- 1 | (require 'slime-parse) 2 | (require 'slime-tests) 3 | 4 | (defun slime-check-buffer-form (result-form) 5 | (slime-test-expect 6 | (format "Buffer form correct in `%s' (at %d)" (buffer-string) (point)) 7 | result-form 8 | (slime-parse-form-upto-point 10))) 9 | 10 | (def-slime-test form-up-to-point.1 11 | (buffer-sexpr result-form &optional skip-trailing-test-p) 12 | "" 13 | `(("(char= #\\(*HERE*" 14 | ("char=" "#\\(" ,slime-cursor-marker)) 15 | ("(char= #\\( *HERE*" 16 | ("char=" "#\\(" "" ,slime-cursor-marker)) 17 | ("(char= #\\) *HERE*" 18 | ("char=" "#\\)" "" ,slime-cursor-marker)) 19 | ("(char= #\\*HERE*" 20 | ("char=" "#\\" ,slime-cursor-marker) t) 21 | ("(defun*HERE*" 22 | ("defun" ,slime-cursor-marker)) 23 | ("(defun foo*HERE*" 24 | ("defun" "foo" ,slime-cursor-marker)) 25 | ("(defun foo (x y)*HERE*" 26 | ("defun" "foo" 27 | ("x" "y") ,slime-cursor-marker)) 28 | ("(defun foo (x y*HERE*" 29 | ("defun" "foo" 30 | ("x" "y" ,slime-cursor-marker))) 31 | ("(apply 'foo*HERE*" 32 | ("apply" "'foo" ,slime-cursor-marker)) 33 | ("(apply #'foo*HERE*" 34 | ("apply" "#'foo" ,slime-cursor-marker)) 35 | ("(declare ((vector bit *HERE*" 36 | ("declare" (("vector" "bit" "" ,slime-cursor-marker)))) 37 | ("(with-open-file (*HERE*" 38 | ("with-open-file" ("" ,slime-cursor-marker))) 39 | ("(((*HERE*" 40 | ((("" ,slime-cursor-marker)))) 41 | ("(defun #| foo #| *HERE*" 42 | ("defun" "" ,slime-cursor-marker)) 43 | ("(defun #-(and) (bar) f*HERE*" 44 | ("defun" "f" ,slime-cursor-marker)) 45 | ("(remove-if #'(lambda (x)*HERE*" 46 | ("remove-if" ("lambda" ("x") ,slime-cursor-marker))) 47 | ("`(remove-if ,(lambda (x)*HERE*" 48 | ("remove-if" ("lambda" ("x") ,slime-cursor-marker))) 49 | ("`(remove-if ,@(lambda (x)*HERE*" 50 | ("remove-if" ("lambda" ("x") ,slime-cursor-marker)))) 51 | (slime-check-top-level) 52 | (with-temp-buffer 53 | (lisp-mode) 54 | (insert buffer-sexpr) 55 | (search-backward "*HERE*") 56 | (delete-region (match-beginning 0) (match-end 0)) 57 | (slime-check-buffer-form result-form) 58 | (unless skip-trailing-test-p 59 | (insert ")") (backward-char) 60 | (slime-check-buffer-form result-form)) 61 | )) 62 | 63 | (provide 'slime-parse-tests) 64 | -------------------------------------------------------------------------------- /slime_wrapper/slime/contrib/test/slime-presentations-tests.el: -------------------------------------------------------------------------------- 1 | (require 'slime-presentations) 2 | (require 'slime-tests) 3 | (require 'slime-repl-tests "test/slime-repl-tests") 4 | 5 | (define-slime-ert-test pick-up-presentation-at-point () 6 | "Ensure presentations are found consistently." 7 | (cl-labels ((assert-it (point &optional negate) 8 | (let ((result 9 | (cl-first 10 | (slime-presentation-around-or-before-point point)))) 11 | (unless (if negate (not result) result) 12 | (ert-fail 13 | (format "Failed to pick up presentation at point %s" 14 | point)))))) 15 | (with-temp-buffer 16 | (slime-insert-presentation "1234567890" `(:inspected-part 42)) 17 | (insert " ") 18 | (assert-it 1) 19 | (assert-it 2) 20 | (assert-it 3) 21 | (assert-it 4) 22 | (assert-it 5) 23 | (assert-it 10) 24 | (assert-it 11) 25 | (assert-it 12 t)))) 26 | 27 | (def-slime-test (pretty-presentation-results (:fails-for "allegro")) 28 | (input result-contents) 29 | "Test some more simple situations dealing with print-width and stuff. 30 | 31 | Very much like `repl-test-2', but should be more stable when 32 | presentations are enabled, except in allegro." 33 | '(("\ 34 | (with-standard-io-syntax 35 | (write (make-list 15 :initial-element '(1 . 2)) :pretty t :right-margin 75) 36 | 0)" 37 | "\ 38 | SWANK> \ 39 | (with-standard-io-syntax 40 | (write (make-list 15 :initial-element '(1 . 2)) :pretty t :right-margin 75) 41 | 0) 42 | {((1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) 43 | (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2)) 44 | }0 45 | SWANK> *[]") 46 | ;; Two times to test the effect of FRESH-LINE. 47 | ("\ 48 | (with-standard-io-syntax 49 | (write (make-list 15 :initial-element '(1 . 2)) :pretty t :right-margin 75) 50 | 0)" 51 | "SWANK> \ 52 | (with-standard-io-syntax 53 | (write (make-list 15 :initial-element '(1 . 2)) :pretty t :right-margin 75) 54 | 0) 55 | {((1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) 56 | (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2) (1 . 2)) 57 | }0 58 | SWANK> *[]")) 59 | (slime-test-repl-test input result-contents)) 60 | 61 | (provide 'slime-presentations-tests) 62 | -------------------------------------------------------------------------------- /slime_wrapper/slime/doc/.cvsignore: -------------------------------------------------------------------------------- 1 | contributors.texi 2 | slime.aux 3 | slime.cp 4 | slime.dvi 5 | slime.fn 6 | slime.fns 7 | slime.info 8 | slime.ky 9 | slime.kys 10 | slime.log 11 | slime.pdf 12 | slime.pg 13 | slime.ps 14 | slime.tmp 15 | slime.toc 16 | slime.tp 17 | slime.vr 18 | slime.vrs 19 | slime.html 20 | html 21 | html.tgz 22 | -------------------------------------------------------------------------------- /slime_wrapper/slime/doc/Makefile: -------------------------------------------------------------------------------- 1 | # This file has been placed in the public domain. 2 | # 3 | # Where to put the info file(s). NB: the GNU Coding Standards (GCS) 4 | # and the Filesystem Hierarchy Standard (FHS) differ on where info 5 | # files belong. The GCS says /usr/local/info; the FHS says 6 | # /usr/local/share/info. Many distros obey the FHS, but people who 7 | # installed their emacs from source probably have a GCS-ish file 8 | # hierarchy. 9 | infodir=/usr/local/info 10 | 11 | # What command to use to install info file(s) 12 | INSTALL_CMD=install -m 644 13 | 14 | # Info files generated here. 15 | infofiles=slime.info 16 | 17 | TEXI = slime.texi contributors.texi 18 | 19 | help: 20 | @echo -e "\ 21 | Most important targets:\n\ 22 | all generate info, pdf, and html documents\n\ 23 | slime.info generate the slime.info file\n\ 24 | slime.html generate a single html file\n\ 25 | html/index.html generate on html file per node in html/ directory\n\ 26 | html.tgz create a tarball of all html files\n\ 27 | clean remove generated files" 28 | 29 | all: slime.info slime.pdf html/index.html 30 | 31 | slime.dvi: $(TEXI) 32 | texi2dvi slime.texi 33 | 34 | slime.ps: slime.dvi 35 | dvips -o $@ $< 36 | 37 | slime.info: $(TEXI) 38 | makeinfo $< 39 | 40 | slime.html: $(TEXI) 41 | texi2html --css-include=slime.css $< 42 | 43 | html/index.html: $(TEXI) 44 | makeinfo -o html --css-include=slime.css --html $< 45 | 46 | html.tgz: html/index.html 47 | tar -czf $@ html 48 | 49 | DOCDIR=/project/slime/public_html/doc 50 | # invoke this like: make CLUSER=heller publish 51 | publish: slime.pdf html.tgz 52 | scp slime.pdf html.tgz $(CLUSER)@common-lisp.net:$(DOCDIR) 53 | ssh $(CLUSER)@common-lisp.net "cd $(DOCDIR); tar -zxf html.tgz" 54 | 55 | slime.pdf: $(TEXI) 56 | texi2pdf $< 57 | 58 | slime-refcard.pdf: slime-refcard.tex 59 | texi2pdf $< 60 | 61 | install: install-info 62 | 63 | uninstall: uninstall-info 64 | 65 | # Create contributors.texi, a texinfo table listing all known 66 | # contributors of code. 67 | # 68 | # The gist of this horror show is that the contributor list is piped 69 | # into texinfo-tabulate.awk with one name per line, sorted 70 | # by number of contributions. 71 | LAST_CHANGELOG_COMMIT=ab6d1bd5c9d3c5b4a6299b8c864ce4acfd25cbcc 72 | contributors.texi: ../slime.el Makefile texinfo-tabulate.awk 73 | git show $(LAST_CHANGELOG_COMMIT):ChangeLog \ 74 | $(LAST_CHANGELOG_COMMIT):contrib/ChangeLog | \ 75 | sed -ne '/^[0-9]/{s/^[^ ]* *//; s/ *<.*//; p;}' | \ 76 | (cat; git log $(LAST_CHANGELOG_COMMIT).. --format='%aN') | \ 77 | sort | \ 78 | uniq -c | \ 79 | LC_ALL=C sort -nr | \ 80 | sed -e 's/^[^A-Z]*//; /^$$/d' | \ 81 | LC_ALL=C awk -f texinfo-tabulate.awk \ 82 | > $@ 83 | 84 | #.INTERMEDIATE: contributors.texi 85 | 86 | # Debian's install-info wants a --section argument. 87 | install-info: section=$(shell grep INFO-DIR-SECTION $(infofiles) | sed 's/INFO-DIR-SECTION //') 88 | install-info: slime.info 89 | mkdir -p $(infodir) 90 | $(INSTALL_CMD) $(infofiles) $(infodir)/$(infofiles) 91 | @if (install-info --version && \ 92 | install-info --version 2>&1 | sed 1q | grep -i -v debian) >/dev/null 2>&1; then \ 93 | echo "install-info --info-dir=$(infodir) $(infodir)/$(infofiles)";\ 94 | install-info --info-dir="$(infodir)" "$(infodir)/$(infofiles)" || :;\ 95 | else \ 96 | echo "install-info --infodir=$(infodir) --section $(section) $(section) $(infodir)/$(infofiles)" && \ 97 | install-info --infodir="$(infodir)" --section $(section) ${section} "$(infodir)/$(infofiles)" || :; fi 98 | 99 | uninstall-info: 100 | @if (install-info --version && \ 101 | install-info --version 2>&1 | sed 1q | grep -i -v debian) >/dev/null 2>&1; then \ 102 | echo "install-info --info-dir=$(infodir) --remove $(infodir)/$(infofiles)";\ 103 | install-info --info-dir="$(infodir)" --remove "$(infodir)/$(infofiles)" || :;\ 104 | else \ 105 | echo "install-info --infodir=$(infodir) --remove $(infodir)/$(infofiles)";\ 106 | install-info --infodir="$(infodir)" --remove "$(infodir)/$(infofiles)" || :; fi 107 | rm -f $(infodir)/$(infofiles) 108 | 109 | clean: 110 | rm -f contributors.texi 111 | rm -f slime.aux slime.cp slime.cps slime.fn slime.fns slime.ky 112 | rm -f slime.kys slime.log slime.pg slime.tmp slime.toc slime.tp 113 | rm -f slime.vr slime.vrs 114 | rm -f slime.info slime.pdf slime.dvi slime.ps slime.html 115 | rm -f slime-refcard.pdf slime-refcard.log slime-refcard.aux 116 | rm -rf html html.tgz 117 | -------------------------------------------------------------------------------- /slime_wrapper/slime/doc/contributors.texi: -------------------------------------------------------------------------------- 1 | @multitable @columnfractions 0.333333 0.333333 0.333333 2 | 3 | @item Helmut Eller @tab Tobias C. Rittweiler @tab Stas Boukarev 4 | @item Luke Gorrie @tab Matthias Koeppe @tab Nikodemus Siivola 5 | @item Marco Baringer @tab João Távora @tab Alan Ruttenberg 6 | @item Luís Oliveira @tab Mark Evenson @tab Christophe Rhodes 7 | @item Edi Weitz @tab Martin Simmons @tab Juho Snellman 8 | @item Attila Lendvai @tab Peter Seibel @tab Geo Carncross 9 | @item Douglas Crosher @tab Daniel Barlow @tab Wolfgang Jenkner 10 | @item Gábor Melis @tab Michael Weber @tab Didier Verna 11 | @item Stelian Ionescu @tab Lawrence Mitchell @tab Anton Kovalenko 12 | @item Terje Norderhaug @tab Brian Downing @tab Bill Clementson 13 | @item Andras Simon @tab Zach Beane @tab Ivan Shvedunov 14 | @item Francois-Rene Rideau @tab Espen Wiborg @tab António Menezes Leitão 15 | @item Adlai Chandrasekhar @tab Utz-Uwe Haus @tab Thomas Schilling 16 | @item Thomas F. Burdick @tab Takehiko Abe @tab Richard M Kreuter 17 | @item Raymond Toy @tab Matthew Danish @tab Mark Harig 18 | @item James Bielman @tab Harald Hanche-Olsen @tab Ariel Badichi 19 | @item Andreas Fuchs @tab Willem Broekema @tab Taylor R. Campbell 20 | @item Phil Hargett @tab Paulo Madeira @tab Lars Magne Ingebrigtsen 21 | @item John Paul Wallington @tab Joerg Hoehle @tab David Reitter 22 | @item Bryan O'Connor @tab Alan Shutko @tab Travis Cross 23 | @item Tobias Rittweiler @tab Tiago Maduro-Dias @tab Stefan Kamphausen 24 | @item Sean O'Rourke @tab Robert Lehr @tab Robert E. Brown 25 | @item Nathan Trapuzzano @tab Nathan Bird @tab Jouni K Seppanen 26 | @item Jan Moringen @tab Ivan Toshkov @tab Ian Eslick 27 | @item Geoff Wozniak @tab Gary King @tab Eric Blood 28 | @item Eduardo Muñoz @tab Christian Lynbech @tab Chris Capel 29 | @item Bjørn Nordbø @tab Bart Botta @tab Anton Vodonosov 30 | @item Alexey Dejneka @tab Alan Caulkins @tab Yaroslav Kavenchuk 31 | @item Wolfgang Mederle @tab Wojciech Kaczmarek @tab William Bland 32 | @item Vitaly Mayatskikh @tab Tom Pierce @tab Tim Daly Jr. 33 | @item Syohei YOSHIDA @tab Sven Van Caekenberghe @tab Svein Ove Aas 34 | @item Steve Smith @tab StanisBaw Halik @tab Samuel Freilich 35 | @item Russell McManus @tab Rui Patrocínio @tab Robert P. Goldman 36 | @item Robert Macomber @tab Robert Brown @tab Reini Urban 37 | @item R. Matthew Emerson @tab Pawel Ostrowski @tab Paul Collins 38 | @item Olof-Joachim Frahm @tab Neil Van Dyke @tab NIIMI Satoshi 39 | @item Mészáros Levente @tab Mikel Bancroft @tab Matthew D. Swank 40 | @item Matt Pillsbury @tab Masayuki Onjo @tab Mark Wooding 41 | @item Mark H. David @tab Marco Monteiro @tab Lynn Quam 42 | @item Levente Mészáros @tab Leo Liu @tab Lasse Rasinen 43 | @item Knut Olav Bøhmer @tab Kai Kaminski @tab Julian Stecklina 44 | @item Juergen Gmeiner @tab Jon Allen Boone @tab John Smith 45 | @item Johan Bockgård @tab Jan Rychter @tab James McIlree 46 | @item Ivan Boldyrev @tab Ignas Mikalajunas @tab Hannu Koivisto 47 | @item Gerd Flaig @tab Gail Zacharias @tab Frederic Brunel 48 | @item Dustin Long @tab Douglas Katzman @tab Daniel Koning 49 | @item Daniel Kochmański @tab Dan Weinreb @tab Dan Pierson 50 | @item Cyrus Harmon @tab Cecil Westerhof @tab Brian Mastenbrook 51 | @item Brandon Bergren @tab Bozhidar Batsov @tab Bob Halley 52 | @item Barry Fishman @tab B.Scott Michel @tab Andrew Myers 53 | @item Aleksandar Bakic @tab Alain Picard @tab Adam Bozanich 54 | @end multitable 55 | -------------------------------------------------------------------------------- /slime_wrapper/slime/doc/slime-refcard.tex: -------------------------------------------------------------------------------- 1 | \documentclass[a4paper,10pt]{article} 2 | 3 | \usepackage{textcomp} 4 | \usepackage{fullpage} 5 | \pagestyle{empty} 6 | 7 | 8 | \newcommand{\group}[1]{\bigskip\par\noindent\textbf{\large#1}\medskip} 9 | \newcommand{\subgroup}[1]{\medskip\par\noindent\textbf{#1}\smallskip} 10 | \newcommand{\key}[2]{\par\noindent\textbf{#1}\hfill{#2}} 11 | \newcommand{\meta}[1]{\textlangle{#1}\textrangle} 12 | 13 | \begin{document} 14 | 15 | \twocolumn[\LARGE\centering{SLIME Quick Reference Card}\vskip1cm] 16 | 17 | \group{Getting help in Emacs} 18 | 19 | \key{C-h \meta{key}}{describe function bound to \meta{key}} 20 | \key{C-h b}{list the current key-bindings for the focus buffer} 21 | \key{C-h m}{describe mode} 22 | \key{C-h l}{shows the keys you have pressed} 23 | \key{\meta{key} l}{what starts with \meta{key}} 24 | 25 | \group{Programming} 26 | 27 | \subgroup{Completion} 28 | 29 | \key{M-tab, C-c C-i, C-M-i}{complete symbol} 30 | \key{C-c C-s}{complete form} 31 | \key{C-c M-i}{fuzzy complete symbol} 32 | 33 | \subgroup{Closure} 34 | 35 | \key{C-c C-q}{close parens at point} 36 | \key{C-]}{close all sexp} 37 | 38 | \subgroup{Indentation} 39 | 40 | \key{C-c M-q}{reindent defun} 41 | \key{C-M-q}{indent sexp} 42 | 43 | \subgroup{Documentation} 44 | 45 | \key{spc}{insert a space, display argument list} 46 | \key{C-c C-d d}{describe symbol} 47 | \key{C-c C-f}{describe function} 48 | \key{C-c C-d a}{apropos search for regexp} 49 | \key{C-c C-d z}{apropos with internal symbols} 50 | \key{C-c C-d p}{apropos in package} 51 | \key{C-c C-d h}{hyperspec lookup} 52 | \key{C-c C-d ~}{format character hyperspec lookup} 53 | 54 | 55 | \subgroup{Cross reference} 56 | 57 | \key{C-c C-w c}{show function callers} 58 | \key{C-c C-w r}{show references to global variable} 59 | \key{C-c C-w b}{show bindings of a global variable} 60 | \key{C-c C-w s}{show assignments to a global variable} 61 | \key{C-c C-w m}{show expansions of a macro} 62 | \key{C-c \textless}{list callers of a function} 63 | \key{C-c \textgreater}{list callees of a function} 64 | 65 | \subgroup{Finding definitions} 66 | 67 | \key{M-.}{edit definition} 68 | \key{M-, or M-*}{pop definition stack} 69 | \key{C-x 4 .}{edit definition in other window} 70 | \key{C-x 5 .}{edit definition in other frame} 71 | 72 | \newpage 73 | 74 | \subgroup{Macro expansion commands} 75 | 76 | \key{C-c C-m or C-c RET}{macroexpand-1} 77 | \key{C-c M-m}{macroexpand-all} 78 | \key{C-c C-t}{toggle tracing of the function at point} 79 | 80 | \subgroup{Disassembly} 81 | 82 | \key{C-c M-d}{disassemble function definition} 83 | 84 | \group{Compilation} 85 | 86 | \key{C-c C-c}{compile defun} 87 | \key{C-c C-y}{call defun} 88 | \key{C-c C-k}{compile and load file} 89 | \key{C-c M-k}{compile file} 90 | \key{C-c C-l}{load file} 91 | \key{C-c C-z}{switch to output buffer} 92 | \key{M-n}{next note} 93 | \key{M-p}{previous note} 94 | \key{C-c M-c}{remove notes} 95 | 96 | \group{Evaluation} 97 | 98 | \key{C-M-x}{eval defun} 99 | \key{C-x C-e}{eval last expression} 100 | \key{C-c C-p}{eval \& pretty print last expression} 101 | \key{C-c C-r}{eval region} 102 | \key{C-x M-e}{eval last expression, display output} 103 | \key{C-c :}{interactive eval} 104 | \key{C-c E}{edit value} 105 | \key{C-c C-u}{undefine function} 106 | 107 | \group{Abort/Recovery} 108 | 109 | \key{C-c C-b}{interrupt (send SIGINT)} 110 | \key{C-c \~}{sync the current package and working directory} 111 | \key{C-c M-p}{set package in REPL} 112 | 113 | \group{Inspector} 114 | 115 | \key{C-c I}{inspect (from minibuffer)} 116 | \key{ret}{operate on point} 117 | \key{d}{describe} 118 | \key{l}{pop} 119 | \key{n}{next} 120 | \key{q}{quit} 121 | \key{M-ret}{copy down} 122 | 123 | \end{document} 124 | -------------------------------------------------------------------------------- /slime_wrapper/slime/doc/slime.css: -------------------------------------------------------------------------------- 1 | body { font-family: Georgia, serif; 2 | line-height: 1.3; 3 | padding-left: 5em; padding-right: 1em; 4 | padding-bottom: 1em; max-width: 60em; } 5 | table { border-collapse: collapse } 6 | span.roman { font-family: century schoolbook, serif; font-weight: normal; } 7 | h1, h2, h3, h4, h5, h6 { font-family: Helvetica, sans-serif } 8 | h4 { margin-top: 2.5em; } 9 | dfn { font-family: inherit; font-variant: italic; font-weight: bolder } 10 | var { font-variant: slanted; } 11 | td { padding-right: 1em; padding-left: 1em } 12 | sub { font-size: smaller } 13 | .node { padding: 0; margin: 0 } 14 | dd { padding-top: 1em; padding-bottom: 2em } 15 | pre.example { 16 | font-family: monospace; 17 | background-color: #E9FFE9; border: 1px solid #9D9; 18 | padding-top: 0.5em; padding-bottom: 0.5em; } 19 | a:link { color: #383; text-decoration: none; padding: 1px 2px 1px 2px; } 20 | a:visited { color: #161; text-decoration: none; padding: 1px 2px 1px 2px; } 21 | a:hover { color: #161; text-decoration: none; padding: 1px 1px 1px 1px; border: 1px solid #666; } 22 | a:focus { color: #161; text-decoration: none; padding: 1px 2px 1px 2px; border: none; } 23 | -------------------------------------------------------------------------------- /slime_wrapper/slime/doc/texinfo-tabulate.awk: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env awk -f 2 | # 3 | # Format input lines into a multi-column texinfo table. 4 | # Note: does not do texinfo-escaping of the input. 5 | 6 | # This code has been placed in the Public Domain. All warranties 7 | # are disclaimed. 8 | 9 | BEGIN { 10 | columns = 3; 11 | printf("@multitable @columnfractions"); 12 | for (i = 0; i < columns; i++) 13 | printf(" %f", 1.0/columns); 14 | print 15 | } 16 | 17 | { if (NR % columns == 1) printf("\n@item %s", $0); 18 | else printf(" @tab %s", $0); } 19 | 20 | END { printf("\n@end multitable\n"); } 21 | 22 | -------------------------------------------------------------------------------- /slime_wrapper/slime/lib/.nosearch: -------------------------------------------------------------------------------- 1 | ;; normal-top-level-add-subdirs-to-load-path needs this file 2 | -------------------------------------------------------------------------------- /slime_wrapper/slime/packages.lisp: -------------------------------------------------------------------------------- 1 | (defpackage swank/backend 2 | (:use cl) 3 | (:nicknames swank-backend) 4 | (:export *debug-swank-backend* 5 | *log-output* 6 | sldb-condition 7 | compiler-condition 8 | original-condition 9 | message 10 | source-context 11 | condition 12 | severity 13 | with-compilation-hooks 14 | make-location 15 | location 16 | location-p 17 | location-buffer 18 | location-position 19 | location-hints 20 | position-p 21 | position-pos 22 | print-output-to-string 23 | quit-lisp 24 | references 25 | unbound-slot-filler 26 | declaration-arglist 27 | type-specifier-arglist 28 | with-struct 29 | when-let 30 | defimplementation 31 | converting-errors-to-error-location 32 | make-error-location 33 | deinit-log-output 34 | ;; interrupt macro for the backend 35 | *pending-slime-interrupts* 36 | check-slime-interrupts 37 | *interrupt-queued-handler* 38 | ;; inspector related symbols 39 | emacs-inspect 40 | label-value-line 41 | label-value-line* 42 | boolean-to-feature-expression 43 | with-symbol 44 | choose-symbol 45 | ;; package helper for backend 46 | import-to-swank-mop 47 | import-swank-mop-symbols 48 | ;; 49 | default-directory 50 | set-default-directory 51 | frame-source-location 52 | restart-frame 53 | gdb-initial-commands 54 | sldb-break-on-return 55 | buffer-first-change 56 | 57 | profiled-functions 58 | unprofile-all 59 | profile-report 60 | profile-reset 61 | profile-package 62 | 63 | with-collected-macro-forms 64 | auto-flush-loop 65 | *auto-flush-interval*)) 66 | 67 | (defpackage swank/rpc 68 | (:use :cl) 69 | (:export 70 | read-message 71 | read-packet 72 | swank-reader-error 73 | swank-reader-error.packet 74 | swank-reader-error.cause 75 | write-message)) 76 | 77 | (defpackage swank/match 78 | (:use cl) 79 | (:export match)) 80 | 81 | ;; FIXME: rename to sawnk/mop 82 | (defpackage swank-mop 83 | (:use) 84 | (:export 85 | ;; classes 86 | standard-generic-function 87 | standard-slot-definition 88 | standard-method 89 | standard-class 90 | eql-specializer 91 | eql-specializer-object 92 | ;; standard-class readers 93 | class-default-initargs 94 | class-direct-default-initargs 95 | class-direct-slots 96 | class-direct-subclasses 97 | class-direct-superclasses 98 | class-finalized-p 99 | class-name 100 | class-precedence-list 101 | class-prototype 102 | class-slots 103 | specializer-direct-methods 104 | ;; generic function readers 105 | generic-function-argument-precedence-order 106 | generic-function-declarations 107 | generic-function-lambda-list 108 | generic-function-methods 109 | generic-function-method-class 110 | generic-function-method-combination 111 | generic-function-name 112 | ;; method readers 113 | method-generic-function 114 | method-function 115 | method-lambda-list 116 | method-specializers 117 | method-qualifiers 118 | ;; slot readers 119 | slot-definition-allocation 120 | slot-definition-documentation 121 | slot-definition-initargs 122 | slot-definition-initform 123 | slot-definition-initfunction 124 | slot-definition-name 125 | slot-definition-type 126 | slot-definition-readers 127 | slot-definition-writers 128 | slot-boundp-using-class 129 | slot-value-using-class 130 | slot-makunbound-using-class 131 | ;; generic function protocol 132 | compute-applicable-methods-using-classes 133 | finalize-inheritance)) 134 | 135 | (defpackage swank 136 | (:use cl swank/backend swank/match swank/rpc) 137 | (:export #:startup-multiprocessing 138 | #:start-server 139 | #:create-server 140 | #:stop-server 141 | #:restart-server 142 | #:ed-in-emacs 143 | #:inspect-in-emacs 144 | #:print-indentation-lossage 145 | #:invoke-slime-debugger 146 | #:swank-debugger-hook 147 | #:emacs-inspect 148 | ;;#:inspect-slot-for-emacs 149 | ;; These are user-configurable variables: 150 | #:*communication-style* 151 | #:*dont-close* 152 | #:*fasl-pathname-function* 153 | #:*log-events* 154 | #:*use-dedicated-output-stream* 155 | #:*dedicated-output-stream-port* 156 | #:*configure-emacs-indentation* 157 | #:*readtable-alist* 158 | #:*globally-redirect-io* 159 | #:*global-debugger* 160 | #:*sldb-quit-restart* 161 | #:*backtrace-printer-bindings* 162 | #:*default-worker-thread-bindings* 163 | #:*macroexpand-printer-bindings* 164 | #:*swank-pprint-bindings* 165 | #:*record-repl-results* 166 | #:*inspector-verbose* 167 | ;; This is SETFable. 168 | #:debug-on-swank-error 169 | ;; These are re-exported directly from the backend: 170 | #:buffer-first-change 171 | #:frame-source-location 172 | #:gdb-initial-commands 173 | #:restart-frame 174 | #:sldb-step 175 | #:sldb-break 176 | #:sldb-break-on-return 177 | #:profiled-functions 178 | #:profile-report 179 | #:profile-reset 180 | #:unprofile-all 181 | #:profile-package 182 | #:default-directory 183 | #:set-default-directory 184 | #:quit-lisp 185 | #:eval-for-emacs 186 | #:eval-in-emacs 187 | #:y-or-n-p-in-emacs 188 | #:*find-definitions-right-trim* 189 | #:*find-definitions-left-trim* 190 | #:*after-toggle-trace-hook* 191 | #:unredable-result 192 | #:unredable-result-p 193 | #:unredable-result-string 194 | #:parse-string 195 | #:from-string 196 | #:to-string 197 | #:*swank-debugger-condition*)) 198 | -------------------------------------------------------------------------------- /slime_wrapper/slime/slime-autoloads.el: -------------------------------------------------------------------------------- 1 | ;;; slime-autoloads.el --- autoload definitions for SLIME 2 | 3 | ;; Copyright (C) 2007 Helmut Eller 4 | 5 | ;; This file is protected by the GNU GPLv2 (or later), as distributed 6 | ;; with GNU Emacs. 7 | 8 | ;;; Commentary: 9 | 10 | ;; This code defines the necessary autoloads, so that we don't need to 11 | ;; load everything from .emacs. 12 | ;; 13 | ;; JT@14/01/09: FIXME: This file should be auto-generated with autoload cookies. 14 | 15 | ;;; Code: 16 | 17 | (autoload 'slime "slime" 18 | "Start a Lisp subprocess and connect to its Swank server." t) 19 | 20 | (autoload 'slime-mode "slime" 21 | "SLIME: The Superior Lisp Interaction (Minor) Mode for Emacs." t) 22 | 23 | (autoload 'slime-connect "slime" 24 | "Connect to a running Swank server." t) 25 | 26 | (autoload 'slime-selector "slime" 27 | "Select a new by type, indicated by a single character." t) 28 | 29 | (autoload 'hyperspec-lookup "lib/hyperspec" nil t) 30 | 31 | (autoload 'slime-lisp-mode-hook "slime") 32 | 33 | (autoload 'slime-scheme-mode-hook "slime") 34 | 35 | (defvar slime-contribs nil 36 | "A list of contrib packages to load with SLIME.") 37 | 38 | (autoload 'slime-setup "slime" 39 | "Setup some SLIME contribs.") 40 | 41 | (define-obsolete-variable-alias 'slime-setup-contribs 42 | 'slime-contribs "2.3.2") 43 | 44 | (add-hook 'lisp-mode-hook 'slime-lisp-mode-hook) 45 | 46 | (provide 'slime-autoloads) 47 | 48 | ;;; slime-autoloads.el ends here 49 | ;; Local Variables: 50 | ;; no-byte-compile: t 51 | ;; End: 52 | -------------------------------------------------------------------------------- /slime_wrapper/slime/start-swank.lisp: -------------------------------------------------------------------------------- 1 | ;;; This file is intended to be loaded by an implementation to 2 | ;;; get a running swank server 3 | ;;; e.g. sbcl --load start-swank.lisp 4 | ;;; 5 | ;;; Default port is 4005 6 | 7 | ;;; For additional swank-side configurations see 8 | ;;; 6.2 section of the Slime user manual. 9 | 10 | (load (merge-pathnames "swank-loader.lisp" *load-truename*)) 11 | 12 | (swank-loader:init 13 | :delete nil ; delete any existing SWANK packages 14 | :reload nil ; reload SWANK, even if the SWANK package already exists 15 | :load-contribs nil) ; load all contribs 16 | 17 | (swank:create-server :port 4005 18 | ;; if non-nil the connection won't be closed 19 | ;; after connecting 20 | :dont-close nil) 21 | -------------------------------------------------------------------------------- /slime_wrapper/slime/swank.asd: -------------------------------------------------------------------------------- 1 | ;;; -*- lisp -*- 2 | 3 | ;; ASDF system definition for loading the Swank server independently 4 | ;; of Emacs. 5 | ;; 6 | ;; This is only useful if you want to start a Swank server in a Lisp 7 | ;; processes that doesn't run under Emacs. Lisp processes created by 8 | ;; `M-x slime' automatically start the server. 9 | 10 | ;; Usage: 11 | ;; 12 | ;; (require :swank) 13 | ;; (swank:create-swank-server PORT) => ACTUAL-PORT 14 | ;; 15 | ;; (PORT can be zero to mean "any available port".) 16 | ;; Then the Swank server is running on localhost:ACTUAL-PORT. You can 17 | ;; use `M-x slime-connect' to connect Emacs to it. 18 | ;; 19 | ;; This code has been placed in the Public Domain. All warranties 20 | ;; are disclaimed. 21 | 22 | (defpackage :swank-loader 23 | (:use :cl)) 24 | 25 | (in-package :swank-loader) 26 | 27 | (defclass swank-loader-file (asdf:cl-source-file) ()) 28 | 29 | ;;;; after loading run init 30 | 31 | (defmethod asdf:perform ((o asdf:load-op) (f swank-loader-file)) 32 | (load (asdf::component-pathname f)) 33 | (funcall (read-from-string "swank-loader::init") :reload t)) 34 | 35 | (asdf:defsystem :swank 36 | :default-component-class swank-loader-file 37 | :components ((:file "swank-loader"))) 38 | -------------------------------------------------------------------------------- /slime_wrapper/slime/swank/rpc.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- indent-tabs-mode: nil; coding: latin-1-unix -*- 2 | ;;; 3 | ;;; swank-rpc.lisp -- Pass remote calls and responses between lisp systems. 4 | ;;; 5 | ;;; Created 2010, Terje Norderhaug 6 | ;;; 7 | ;;; This code has been placed in the Public Domain. All warranties 8 | ;;; are disclaimed. 9 | ;;; 10 | 11 | (in-package swank/rpc) 12 | 13 | 14 | ;;;;; Input 15 | 16 | (define-condition swank-reader-error (reader-error) 17 | ((packet :type string :initarg :packet 18 | :reader swank-reader-error.packet) 19 | (cause :type reader-error :initarg :cause 20 | :reader swank-reader-error.cause))) 21 | 22 | (defun read-message (stream package) 23 | (let ((packet (read-packet stream))) 24 | (handler-case (values (read-form packet package)) 25 | (reader-error (c) 26 | (error 'swank-reader-error 27 | :packet packet :cause c))))) 28 | 29 | (defun read-packet (stream) 30 | (let* ((length (parse-header stream)) 31 | (octets (read-chunk stream length))) 32 | (handler-case (swank/backend:utf8-to-string octets) 33 | (error (c) 34 | (error 'swank-reader-error 35 | :packet (asciify octets) 36 | :cause c))))) 37 | 38 | (defun asciify (packet) 39 | (with-output-to-string (*standard-output*) 40 | (loop for code across (etypecase packet 41 | (string (map 'vector #'char-code packet)) 42 | (vector packet)) 43 | do (cond ((<= code #x7f) (write-char (code-char code))) 44 | (t (format t "\\x~x" code)))))) 45 | 46 | (defun parse-header (stream) 47 | (parse-integer (map 'string #'code-char (read-chunk stream 6)) 48 | :radix 16)) 49 | 50 | (defun read-chunk (stream length) 51 | (let* ((buffer (make-array length :element-type '(unsigned-byte 8))) 52 | (count (read-sequence buffer stream))) 53 | (cond ((= count length) 54 | buffer) 55 | ((zerop count) 56 | (error 'end-of-file :stream stream)) 57 | (t 58 | (error "Short read: length=~D count=~D" length count))))) 59 | 60 | (defparameter *validate-input* nil 61 | "Set to true to require input that more strictly conforms to the protocol") 62 | 63 | (defun read-form (string package) 64 | (with-standard-io-syntax 65 | (let ((*package* package)) 66 | (if *validate-input* 67 | (validating-read string) 68 | (read-from-string string))))) 69 | 70 | (defun validating-read (string) 71 | (with-input-from-string (*standard-input* string) 72 | (simple-read))) 73 | 74 | (defun simple-read () 75 | "Read a form that conforms to the protocol, otherwise signal an error." 76 | (let ((c (read-char))) 77 | (case c 78 | (#\( (loop collect (simple-read) 79 | while (ecase (read-char) 80 | (#\) nil) 81 | (#\space t)))) 82 | (#\' `(quote ,(simple-read))) 83 | (t 84 | (cond 85 | ((digit-char-p c) 86 | (parse-integer 87 | (map 'simple-string #'identity 88 | (loop for ch = c then (read-char nil nil) 89 | while (and ch (digit-char-p ch)) 90 | collect ch 91 | finally (unread-char ch))))) 92 | ((or (member c '(#\: #\")) (alpha-char-p c)) 93 | (unread-char c) 94 | (read-preserving-whitespace)) 95 | (t (error "Invalid character ~:c" c))))))) 96 | 97 | 98 | ;;;;; Output 99 | 100 | (defun write-message (message package stream) 101 | (let* ((string (prin1-to-string-for-emacs message package)) 102 | (octets (handler-case (swank/backend:string-to-utf8 string) 103 | (error (c) (encoding-error c string)))) 104 | (length (length octets))) 105 | (write-header stream length) 106 | (write-sequence octets stream) 107 | (finish-output stream))) 108 | 109 | ;; FIXME: for now just tell emacs that we and an encoding problem. 110 | (defun encoding-error (condition string) 111 | (swank/backend:string-to-utf8 112 | (prin1-to-string-for-emacs 113 | `(:reader-error 114 | ,(asciify string) 115 | ,(format nil "Error during string-to-utf8: ~a" 116 | (or (ignore-errors (asciify (princ-to-string condition))) 117 | (asciify (princ-to-string (type-of condition)))))) 118 | (find-package :cl)))) 119 | 120 | (defun write-header (stream length) 121 | (declare (type (unsigned-byte 24) length)) 122 | ;;(format *trace-output* "length: ~d (#x~x)~%" length length) 123 | (loop for c across (format nil "~6,'0x" length) 124 | do (write-byte (char-code c) stream))) 125 | 126 | (defun switch-to-double-floats (x) 127 | (typecase x 128 | (double-float x) 129 | (float (coerce x 'double-float)) 130 | (null x) 131 | (list (loop for (x . cdr) on x 132 | collect (switch-to-double-floats x) into result 133 | until (atom cdr) 134 | finally (return (append result (switch-to-double-floats cdr))))) 135 | (t x))) 136 | 137 | (defun prin1-to-string-for-emacs (object package) 138 | (with-standard-io-syntax 139 | (let ((*print-case* :downcase) 140 | (*print-readably* nil) 141 | (*print-pretty* nil) 142 | (*package* package) 143 | ;; Emacs has only double floats. 144 | (*read-default-float-format* 'double-float)) 145 | (prin1-to-string (switch-to-double-floats object))))) 146 | 147 | 148 | #| TEST/DEMO: 149 | 150 | (defparameter *transport* 151 | (with-output-to-string (out) 152 | (write-message '(:message (hello "world")) *package* out) 153 | (write-message '(:return 5) *package* out) 154 | (write-message '(:emacs-rex NIL) *package* out))) 155 | 156 | *transport* 157 | 158 | (with-input-from-string (in *transport*) 159 | (loop while (peek-char T in NIL) 160 | collect (read-message in *package*))) 161 | 162 | |# 163 | -------------------------------------------------------------------------------- /slime_wrapper/slime/swank/source-file-cache.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Source-file cache 2 | ;;; 3 | ;;; To robustly find source locations in CMUCL and SBCL it's useful to 4 | ;;; have the exact source code that the loaded code was compiled from. 5 | ;;; In this source we can accurately find the right location, and from 6 | ;;; that location we can extract a "snippet" of code to show what the 7 | ;;; definition looks like. Emacs can use this snippet in a best-match 8 | ;;; search to locate the right definition, which works well even if 9 | ;;; the buffer has been modified. 10 | ;;; 11 | ;;; The idea is that if a definition previously started with 12 | ;;; `(define-foo bar' then it probably still does. 13 | ;;; 14 | ;;; Whenever we see that the file on disk has the same 15 | ;;; `file-write-date' as a location we're looking for we cache the 16 | ;;; whole file inside Lisp. That way we will still have the matching 17 | ;;; version even if the file is later modified on disk. If the file is 18 | ;;; later recompiled and reloaded then we replace our cache entry. 19 | ;;; 20 | ;;; This code has been placed in the Public Domain. All warranties 21 | ;;; are disclaimed. 22 | 23 | (defpackage swank/source-file-cache 24 | (:use cl) 25 | (:import-from swank/backend 26 | defimplementation buffer-first-change 27 | guess-external-format 28 | find-external-format) 29 | (:export 30 | get-source-code 31 | source-cache-get ;FIXME: isn't it odd that both are exported? 32 | 33 | *source-snippet-size* 34 | read-snippet 35 | read-snippet-from-string 36 | )) 37 | 38 | (in-package swank/source-file-cache) 39 | 40 | (defvar *cache-sourcecode* t 41 | "When true complete source files are cached. 42 | The cache is used to keep known good copies of the source text which 43 | correspond to the loaded code. Finding definitions is much more 44 | reliable when the exact source is available, so we cache it in case it 45 | gets edited on disk later.") 46 | 47 | (defvar *source-file-cache* (make-hash-table :test 'equal) 48 | "Cache of source file contents. 49 | Maps from truename to source-cache-entry structure.") 50 | 51 | (defstruct (source-cache-entry 52 | (:conc-name source-cache-entry.) 53 | (:constructor make-source-cache-entry (text date))) 54 | text date) 55 | 56 | (defimplementation buffer-first-change (filename) 57 | "Load a file into the cache when the user modifies its buffer. 58 | This is a win if the user then saves the file and tries to M-. into it." 59 | (unless (source-cached-p filename) 60 | (ignore-errors 61 | (source-cache-get filename (file-write-date filename)))) 62 | nil) 63 | 64 | (defun get-source-code (filename code-date) 65 | "Return the source code for FILENAME as written on DATE in a string. 66 | If the exact version cannot be found then return the current one from disk." 67 | (or (source-cache-get filename code-date) 68 | (read-file filename))) 69 | 70 | (defun source-cache-get (filename date) 71 | "Return the source code for FILENAME as written on DATE in a string. 72 | Return NIL if the right version cannot be found." 73 | (when *cache-sourcecode* 74 | (let ((entry (gethash filename *source-file-cache*))) 75 | (cond ((and entry (equal date (source-cache-entry.date entry))) 76 | ;; Cache hit. 77 | (source-cache-entry.text entry)) 78 | ((or (null entry) 79 | (not (equal date (source-cache-entry.date entry)))) 80 | ;; Cache miss. 81 | (if (equal (file-write-date filename) date) 82 | ;; File on disk has the correct version. 83 | (let ((source (read-file filename))) 84 | (setf (gethash filename *source-file-cache*) 85 | (make-source-cache-entry source date)) 86 | source) 87 | nil)))))) 88 | 89 | (defun source-cached-p (filename) 90 | "Is any version of FILENAME in the source cache?" 91 | (if (gethash filename *source-file-cache*) t)) 92 | 93 | (defun read-file (filename) 94 | "Return the entire contents of FILENAME as a string." 95 | (with-open-file (s filename :direction :input 96 | :external-format (or (guess-external-format filename) 97 | (find-external-format "latin-1") 98 | :default)) 99 | (let* ((string (make-string (file-length s))) 100 | (length (read-sequence string s))) 101 | (subseq string 0 length)))) 102 | 103 | ;;;; Snippets 104 | 105 | (defvar *source-snippet-size* 256 106 | "Maximum number of characters in a snippet of source code. 107 | Snippets at the beginning of definitions are used to tell Emacs what 108 | the definitions looks like, so that it can accurately find them by 109 | text search.") 110 | 111 | (defun read-snippet (stream &optional position) 112 | "Read a string of upto *SOURCE-SNIPPET-SIZE* characters from STREAM. 113 | If POSITION is given, set the STREAM's file position first." 114 | (when position 115 | (file-position stream position)) 116 | #+sbcl (skip-comments-and-whitespace stream) 117 | (read-upto-n-chars stream *source-snippet-size*)) 118 | 119 | (defun read-snippet-from-string (string &optional position) 120 | (with-input-from-string (s string) 121 | (read-snippet s position))) 122 | 123 | (defun skip-comments-and-whitespace (stream) 124 | (case (peek-char nil stream nil nil) 125 | ((#\Space #\Tab #\Newline #\Linefeed #\Page) 126 | (read-char stream) 127 | (skip-comments-and-whitespace stream)) 128 | (#\; 129 | (read-line stream) 130 | (skip-comments-and-whitespace stream)))) 131 | 132 | (defun read-upto-n-chars (stream n) 133 | "Return a string of upto N chars from STREAM." 134 | (let* ((string (make-string n)) 135 | (chars (read-sequence string stream))) 136 | (subseq string 0 chars))) 137 | --------------------------------------------------------------------------------