├── .gitignore
├── README.md
└── extempore-mode.el


/.gitignore:
--------------------------------------------------------------------------------
1 | *.elc


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # Extempore Emacs Mode
 2 | 
 3 | A major mode for editing Extempore code. See the Extempore project page at
 4 | <http://github.com/digego/extempore> for more details.
 5 | 
 6 | ## Installation
 7 | 
 8 | Available through MELPA:
 9 | 
10 | - <kbd>M-x</kbd> `package-install` <kbd>RET</kbd> `extempore-mode`
11 |   <kbd>RET</kbd>
12 | 
13 | If you don't want to get it from MELPA, just download the file and use
14 | `package-install-file` (or even just `load`).
15 | 
16 |     (package-install-file "/path/to/extempore-mode.el")
17 | 
18 | ## Configuration
19 | 
20 | There are several config variables to tweak, but in most cases the defaults will
21 | be ok if you're just starting out. If you want to see them, hit <kbd>M-x</kbd>
22 | `customize` and look in the `extempore` group.
23 | 
24 | The only thing you might want to set out-of-the-box is `extempore-path`, so that
25 | you don't have to answer the "directory" prompt every time you call
26 | `switch-to-extempore`. You can do it through `customize` or set it directly in
27 | your init file like so:
28 | 
29 |     (setq extempore-path "/path/to/extempore/")
30 | 
31 | ## Usage
32 | 
33 | The most important commands are
34 | 
35 | - <kbd>M-x</kbd> `extempore-connect` (default keybinding <kbd>C-c</kbd>
36 |   <kbd>C-j</kbd>)
37 | 
38 | Connect the current `extempore-mode` buffer to a running Extempore
39 | process---this is necessary to begin sending code for evaluation. If called with
40 | a prefix arg, prompt for a host & port number to connect to, otherwise use the
41 | values of `extempore-default-host` (default `"localhost"`) and
42 | `extempore-default-port` (default `7099`).
43 | 
44 | An Extempore process may have multiple connected buffers, and each buffer can be
45 | connected to multiple Extempore processes.
46 | 
47 | - <kbd>M-x</kbd> `switch-to-extempore` (default keybinding <kbd>C-c</kbd>
48 |   <kbd>C-z</kbd>)
49 | 
50 | Switch to the Extempore process buffer running in Emacs. If not currently
51 | running, prompt to start one.
52 | 
53 | The most useful command for day-to-day use is:
54 | 
55 | - <kbd>M-x</kbd> `extempore-send-dwim` (default keybinding <kbd>C-M-x</kbd>)
56 | 
57 | which sends the Extempore top-level definition under point (or current region,
58 | if active) to the Extempore process connected to the current buffer.
59 | 
60 | ## Caveats
61 | 
62 | `extempore-mode` requires Emacs 24, because it inherits from `prog-mode` (via
63 | `lisp-mode`)
64 | 
65 | ## Licence
66 | 
67 | Copyright (C) 2021  Ben Swift
68 | 
69 | Permission is hereby granted, free of charge, to any person obtaining a copy
70 | of this software and associated documentation files (the "Software"), to deal
71 | in the Software without restriction, including without limitation the rights
72 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
73 | copies of the Software, and to permit persons to whom the Software is
74 | furnished to do so, subject to the following conditions:
75 | The above copyright notice and this permission notice shall be included in
76 | all copies or substantial portions of the Software.
77 | 
78 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
79 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
80 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
81 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
82 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
83 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
84 | THE SOFTWARE.
85 | 


--------------------------------------------------------------------------------
/extempore-mode.el:
--------------------------------------------------------------------------------
   1 | ;;; extempore-mode.el --- Emacs major mode for Extempore source files
   2 | ;; Author: Ben Swift <ben@benswift.me>
   3 | ;; Keywords: Extempore
   4 | ;; Version: 1.0
   5 | ;; Keywords: lisp, extempore
   6 | ;; URL: http://github.com/extemporelang/extempore-emacs-mode
   7 | ;; Package-Requires:((emacs "24.4"))
   8 | 
   9 | ;; Copyright (c) 2011-2015, Andrew Sorensen
  10 | 
  11 | ;; All rights reserved.
  12 | 
  13 | ;; Redistribution and use in source and binary forms, with or without
  14 | ;; modification, are permitted provided that the following conditions
  15 | ;; are met:
  16 | 
  17 | ;; 1. Redistributions of source code must retain the above copyright
  18 | ;;    notice, this list of conditions and the following disclaimer.
  19 | 
  20 | ;; 2. Redistributions in binary form must reproduce the above
  21 | ;;    copyright notice, this list of conditions and the following
  22 | ;;    disclaimer in the documentation and/or other materials provided
  23 | ;;    with the distribution.
  24 | 
  25 | ;; Neither the name of the authors nor other contributors may be used
  26 | ;; to endorse or promote products derived from this software without
  27 | ;; specific prior written permission.
  28 | 
  29 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  30 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  31 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  32 | ;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  33 | ;; COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  34 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
  35 | ;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  36 | ;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  37 | ;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
  38 | ;; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
  39 | ;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
  40 | ;; OF THE POSSIBILITY OF SUCH DAMAGE.
  41 | 
  42 | ;;; Commentary:
  43 | 
  44 | ;;    A major mode for editing Extempore code. See the Extempore project page at
  45 | ;;    http://github.com/digego/extempore for more details.
  46 | ;;
  47 | ;;  Installation
  48 | ;;
  49 | ;;    Available through MELPA:
  50 | ;;
  51 | ;;    M-x `package-install' RET `extempore-mode' RET
  52 | ;;
  53 | ;;    If you don't want to get it from MELPA, just download the file and use
  54 | ;;    `package-install-file'
  55 | ;;
  56 | ;;    (package-install-file "/path/to/extempore-mode.el")
  57 | ;;
  58 | ;;
  59 | ;;  Configuration
  60 | ;;
  61 | ;;    (optional) if you don't want to have to answer the "directory" prompt
  62 | ;;    every time you call `extempore-run', you can set the `extempore-path'
  63 | ;;    variable - note the trailing "/" - either in your init file or through the
  64 | ;;    customisation interface
  65 | ;;
  66 | ;;    (setq extempore-path "/path/to/extempore/")
  67 | ;;
  68 | ;;
  69 | ;;  Usage
  70 | ;;
  71 | ;;    The most important commands are:
  72 | ;;
  73 | ;;      M-x `extempore-connect' (C-c C-j)
  74 | ;;
  75 | ;;      M-x `switch-to-extempore' (C-c C-z)
  76 | ;;
  77 | ;;      M-x `extempore-send-dwim' (C-M-x)
  78 | ;;
  79 | ;;    For more usage instructions, see README.md
  80 | 
  81 | ;;; Code:
  82 | 
  83 | (require 'lisp-mode)
  84 | (require 'thingatpt)
  85 | (require 'eldoc)
  86 | (require 'cl-lib)
  87 | (require 'subr-x)
  88 | 
  89 | 
  90 | (defvar extempore-mode-syntax-table
  91 |   (let ((st (make-syntax-table))
  92 |         (i 0))
  93 |     ;; Symbol constituents
  94 |     (while (< i ?0)
  95 |       (modify-syntax-entry i "_   " st)
  96 |       (setq i (1+ i)))
  97 |     (setq i (1+ ?9))
  98 |     (while (< i ?A)
  99 |       (modify-syntax-entry i "_   " st)
 100 |       (setq i (1+ i)))
 101 |     (setq i (1+ ?Z))
 102 |     (while (< i ?a)
 103 |       (modify-syntax-entry i "_   " st)
 104 |       (setq i (1+ i)))
 105 |     (setq i (1+ ?z))
 106 |     (while (< i 128)
 107 |       (modify-syntax-entry i "_   " st)
 108 |       (setq i (1+ i)))
 109 |     ;; Whitespace
 110 |     (modify-syntax-entry ?\t "    " st)
 111 |     (modify-syntax-entry ?\n ">   " st)
 112 |     (modify-syntax-entry ?\f "    " st)
 113 |     (modify-syntax-entry ?\r "    " st)
 114 |     (modify-syntax-entry ?\s "    " st)
 115 |     ;; paren delimiters
 116 |     (modify-syntax-entry ?\( "()  " st)
 117 |     (modify-syntax-entry ?\) ")(  " st)
 118 |     ;; comment delimiters
 119 |     (modify-syntax-entry ?\; "<   " st)
 120 |     (modify-syntax-entry ?\" "\"   " st)
 121 |     (modify-syntax-entry ?' "'   " st)
 122 |     (modify-syntax-entry ?` "'   " st)
 123 |     ;; in xtlang, commas are used in type annotations
 124 |     (modify-syntax-entry ?, "_   " st)
 125 |     ;; Special characters
 126 |     (modify-syntax-entry ?@ "'   " st)
 127 |     (modify-syntax-entry ?# "'   " st)
 128 |     (modify-syntax-entry ?\\ "\\   " st)
 129 |     st))
 130 | 
 131 | (defvar extempore-mode-abbrev-table nil)
 132 | (define-abbrev-table 'extempore-mode-abbrev-table ())
 133 | 
 134 | (defvar extempore-imenu-generic-expression
 135 |   '(("scheme"
 136 |      "(\\(define\\|macro\\|define-macro\\)\\s-+(?\\(\\S-+\\)\\_>" 2)
 137 |     ("instrument"
 138 |      "(make-instrument\\s-+\\(\\S-+\\)\\_>" 1)
 139 |     ("lib" ;; bind-lib
 140 |      "(bind-lib\\s-+\\S-+\\s-+\\(\\S-+\\)\\_>" 1)
 141 |     ("type"
 142 |      "(bind-\\(type\\|alias\\)\\s-+\\(\\S-+\\)\\_>" 2)
 143 |     ("type" ;; bind-lib-type
 144 |      "(bind-lib-\\(type\\|alias\\)\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\_>" 3)
 145 |     ("val"
 146 |      "(bind-val\\s-+\\(\\S-+\\)\\_>" 1)
 147 |     ("val" ;; bind-lib-val
 148 |      "(bind-lib-val\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\_>" 2)
 149 |     ("func"
 150 |      "(bind-func\\s-+\\(static\\s-+\\)?\\(\\S-+\\)\\_>" 2)
 151 |     ("func" ;; bind-lib-func
 152 |      "(bind-lib-func\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\_>" 2))
 153 |   "Imenu generic expression for Extempore mode.  See `imenu-generic-expression'.")
 154 | 
 155 | (defun extempore-mode-variables ()
 156 |   (set-syntax-table extempore-mode-syntax-table)
 157 |   (setq local-abbrev-table extempore-mode-abbrev-table)
 158 |   (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
 159 |   (set (make-local-variable 'paragraph-separate) paragraph-start)
 160 |   (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
 161 |   (set (make-local-variable 'fill-paragraph-function) 'lisp-fill-paragraph)
 162 |   ;; Adaptive fill mode gets in the way of auto-fill,
 163 |   ;; and should make no difference for explicit fill
 164 |   ;; because lisp-fill-paragraph should do the job.
 165 |   (set (make-local-variable 'adaptive-fill-mode) nil)
 166 |   (set (make-local-variable 'indent-line-function) 'lisp-indent-line)
 167 |   (set (make-local-variable 'parse-sexp-ignore-comments) t)
 168 |   (set (make-local-variable 'outline-regexp) ";;; \\|(....")
 169 |   (set (make-local-variable 'comment-start) ";")
 170 |   (set (make-local-variable 'comment-add) 1)
 171 |   ;; Look within the line for a ; following an even number of backslashes
 172 |   ;; after either a non-backslash or the line beginning.
 173 |   (set (make-local-variable 'comment-start-skip)
 174 |        "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
 175 |   (set (make-local-variable 'font-lock-comment-start-skip) ";+ *")
 176 |   (set (make-local-variable 'comment-column) 40)
 177 |   (set (make-local-variable 'parse-sexp-ignore-comments) t)
 178 |   (set (make-local-variable 'lisp-indent-function) 'extempore-indent-function)
 179 |   ;; (set (make-local-variable 'imenu-case-fold-search) t)
 180 |   (setq imenu-generic-expression extempore-imenu-generic-expression)
 181 |   (set (make-local-variable 'font-lock-defaults)
 182 |        '(extempore-font-lock-keywords
 183 | 	 nil t (("+-*/,.<>=!?$%_&~^:" . "w") (?#. "w 14"))
 184 | 	 beginning-of-defun
 185 | 	 (font-lock-mark-block-function . mark-defun)
 186 | 	 (font-lock-syntactic-face-function
 187 | 	  . extempore-font-lock-syntactic-face-function)
 188 | 	 (parse-sexp-lookup-properties . t)
 189 | 	 (font-lock-extra-managed-props syntax-table)))
 190 |   (set (make-local-variable 'lisp-doc-string-elt-property)
 191 |        'extempore-doc-string-elt))
 192 | 
 193 | (defvar extempore-mode-map
 194 |   (let ((smap (make-sparse-keymap))
 195 |         (map (make-sparse-keymap "Extempore")))
 196 |     (set-keymap-parent smap lisp-mode-shared-map)
 197 |     (define-key smap [menu-bar extempore] (cons "Extempore" map))
 198 |     ;; (define-key map [extempore-run] '("Run Inferior Extempore" . extempore-run))
 199 |     (define-key map [uncomment-region]
 200 |       '("Uncomment Out Region" . (lambda (beg end)
 201 |                                    (interactive "r")
 202 |                                    (comment-region beg end '(4)))))
 203 |     (define-key map [comment-region] '("Comment Out Region" . comment-region))
 204 |     (define-key map [indent-region] '("Indent Region" . indent-region))
 205 |     (define-key map [indent-line] '("Indent Line" . lisp-indent-line))
 206 |     (put 'comment-region 'menu-enable 'mark-active)
 207 |     (put 'uncomment-region 'menu-enable 'mark-active)
 208 |     (put 'indent-region 'menu-enable 'mark-active)
 209 |     smap)
 210 |   "Keymap for Extempore mode.
 211 | All commands in `lisp-mode-shared-map' are inherited by this map.")
 212 | 
 213 | ;;;###autoload
 214 | (define-derived-mode extempore-mode prog-mode "Extempore"
 215 |   "Major mode for editing Extempore code. This mode has been
 216 | adapted from `scheme-mode'. Entry to this mode calls the value of
 217 | \\[extempore-mode-hook].
 218 | 
 219 | To switch to an inferior Extempore process (or start one if none
 220 | present) use \\[switch-to-extempore], which is bound to C-c C-z
 221 | by default.
 222 | 
 223 | To send the current definition to a running Extempore process, use
 224 | \\[extempore-send-definition].
 225 | "
 226 |   (extempore-mode-variables))
 227 | 
 228 | ;;;###autoload
 229 | (add-to-list 'auto-mode-alist '("\\.xtm$" . extempore-mode))
 230 | 
 231 | (defgroup extempore nil
 232 |   "Editing Extempore code."
 233 |   :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
 234 |   :group 'lisp)
 235 | 
 236 | (defcustom extempore-mode-hook nil
 237 |   "Normal hook run when entering `extempore-mode'.
 238 | See `run-hooks'."
 239 |   :type 'hook
 240 |   :group 'extempore)
 241 | 
 242 | (defcustom extempore-default-device-number nil
 243 |   "Default device (passed as Extempore's --device option)."
 244 |   :type 'integer
 245 |   :group 'extempore)
 246 | 
 247 | (defcustom extempore-default-host "localhost"
 248 |   "Default host where the extempore process is running."
 249 |   :type 'string
 250 |   :group 'extempore)
 251 | 
 252 | (defcustom extempore-default-port 7099
 253 |   "Default port where the extempore process is running."
 254 |   :type 'integer
 255 |   :group 'extempore)
 256 | 
 257 | (defcustom extempore-default-connection-type "TCP"
 258 |   "Default connection type (either \"TCP\" or \"TCP-OSC\"."
 259 |   :type 'string
 260 |   :group 'extempore)
 261 | 
 262 | (defcustom extempore-use-pretty-lambdas t
 263 |   "Use pretty (greek symbol) lambdas in buffer?"
 264 |   :type 'boolean
 265 |   :group 'extempore)
 266 | 
 267 | (defcustom extempore-tab-completion t
 268 |   "Use <TAB> key for (contextual) symbol completion"
 269 |   :type 'boolean
 270 |   :group 'extempore)
 271 | 
 272 | (defcustom extempore-path nil
 273 |   "Location of the extempore directory.
 274 | 
 275 | Used to be called `user-extempore-directory' and `extempore-share-directory'"
 276 |   :type 'string
 277 |   :group 'extempore)
 278 | 
 279 | (defalias 'user-extempore-directory 'extempore-path "Deprecated: use extempore-path instead")
 280 | (defalias 'extempore-share-directory 'extempore-path "Deprecated: use extempore-path instead")
 281 | 
 282 | (defcustom extempore-program-args nil
 283 |   "Arguments to pass to the extempore process started by `extempore-run'."
 284 |   :type 'string
 285 |   :group 'extempore)
 286 | 
 287 | (defface extempore-blink-face
 288 |   '((t (:foreground "#FF00FF" :background "#000000" :weight bold :inherit nil)))
 289 |   "Face used for 'blinking' code when it is evaluated."
 290 |   :group 'extempore)
 291 | 
 292 | (defface extempore-sb-blink-face
 293 |   '((t (:foreground "#00FFFF" :background "#000000" :weight bold :inherit nil)))
 294 |   "Face used for 'blinking' code in slave buffers."
 295 |   :group 'extempore)
 296 | 
 297 | ;; from emacs-starter-kit
 298 | 
 299 | (defface extempore-paren-face
 300 |   '((((class color) (background dark))
 301 |      (:foreground "grey50"))
 302 |     (((class color) (background light))
 303 |      (:foreground "grey55")))
 304 |   "Face used to dim parentheses in extempore."
 305 |   :group 'extempore)
 306 | 
 307 | (defun extempore-keybindings (keymap)
 308 |   "tries to stick with Emacs conventions where possible.
 309 | 
 310 | To restore the old C-x prefixed versions, add something like this to your .emacs
 311 | 
 312 |   (add-hook 'extempore-mode-hook
 313 |             (lambda ()
 314 |               (define-key extempore-mode-map (kbd \"C-x C-x\") 'extempore-send-dwim)
 315 |               (define-key extempore-mode-map (kbd \"C-x C-r\") 'extempore-send-buffer-or-region)
 316 |               (define-key extempore-mode-map (kbd \"C-x C-j\") 'extempore-connect)))
 317 | "
 318 |   (define-key keymap (kbd "C-c C-j") 'extempore-connect) ;'jack in'
 319 |   (define-key keymap (kbd "C-M-x") 'extempore-send-dwim)
 320 |   (define-key keymap (kbd "C-c C-c") 'extempore-send-definition)
 321 |   (define-key keymap (kbd "C-c M-e") 'extempore-send-definition-and-go)
 322 |   (define-key keymap (kbd "C-x C-e") 'extempore-send-last-sexp)
 323 |   (define-key keymap (kbd "C-c C-r") 'extempore-send-buffer-or-region)
 324 |   (define-key keymap (kbd "C-c M-r") 'extempore-send-buffer-or-region-and-go)
 325 |   (define-key keymap (kbd "C-c C-z") 'switch-to-extempore)
 326 |   (define-key keymap (kbd "C-c C-e") 'extempore-repl)
 327 |   (define-key keymap (kbd "C-c C-l") 'exlog-mode))
 328 | 
 329 | (extempore-keybindings extempore-mode-map)
 330 | 
 331 | (if extempore-tab-completion
 332 |     (define-key extempore-mode-map (kbd "TAB")
 333 |       '(lambda ()
 334 |          (interactive)
 335 |          (if (minibufferp)
 336 |              (unless (minibuffer-complete)
 337 |                (dabbrev-expand nil))
 338 |            (if mark-active
 339 |                (indent-region (region-beginning)
 340 |                               (region-end))
 341 |              (if (looking-at "\\_>")
 342 |                  (dabbrev-expand nil)
 343 |                (indent-for-tab-command)))))))
 344 | 
 345 | (defconst extempore-font-lock-keywords-scheme
 346 |   ;; scheme language builtin & function names - used for font locking
 347 |   ;; (colouring).
 348 |   ;; This list is curated by hand - it's usually pretty up to date,
 349 |   ;; but shouldn't be relied on as an Extempore language reference.
 350 |   (eval-when-compile
 351 |     (let ((extempore-builtin-names '("or" "and" "let" "lambda" "if" "else" "dotimes" "doloop" "while" "cond" "begin" "syntax-rules" "syntax" "map" "do" "letrec-syntax" "letrec" "eval" "apply" "quote" "quasiquote" "let-syntax" "let*" "for-each" "case" "call-with-output-file" "call-with-input-file" "call/cc" "call-with-current-continuation" "memzone" "letz" "catch"))
 352 |           (extempore-scheme-names '("set!" "caaaar" "cdaaar" "cadaar" "cddaar" "caadar" "cdadar" "caddar" "cdddar" "caaadr" "cdaadr" "cadadr" "cddadr" "caaddr" "cdaddr" "cadddr" "cddddr" "caaar" "cdaar" "cadar" "cddar" "caadr" "cdadr" "caddr" "cdddr" "caar" "cdar" "cadr" "cddr" "car" "cdr" "print" "println" "printout" "load" "gensym" "tracing" "make-closure" "defined?" "inexact->exact" "exp" "log" "sin" "cos" "tan" "asin" "acos" "atan" "sqrt" "expt" "floor" "ceiling" "truncate" "round" "+" "-" "*" "/" "%" "bitwise-not" "bitwise-and" "bitwise-or" "bitwise-eor" "bitwise-shift-left" "bitwise-shift-right" "quotient" "remainder" "modulo" "car" "cdr" "cons" "set-car!" "set-cdr!" "char->integer" "integer->char" "char-upcase" "char-downcase" "symbol->string" "atom->string" "string->symbol" "string->atom" "sexpr->string" "string->sexpr" "real->integer" "make-string" "string-length" "string-ref" "string-set!" "string-append" "substring" "vector" "make-vector" "vector-length" "vector-ref" "vector-set!" "not" "boolean?" "eof-object?" "null?" "=" "<" ">" "<=" ">=" "member" "equal?" "eq?" "eqv?" "symbol?" "number?" "string?" "integer?" "real?" "rational?" "char?" "char-alphabetic?" "char-numeric?" "char-whitespace?" "char-upper-case?" "char-lower-case?" "port?" "input-port?" "output-port?" "procedure?" "pair?" "list?" "environment?" "vector?" "cptr?" "eq?" "eqv?" "force" "write" "write-char" "display" "emit" "newline" "error" "reverse" "list*" "append" "put" "get" "quit" "new-segment" "oblist" "sexp-bounds-port" "current-output-port" "open-input-file" "open-output-file" "open-input-output-file" "open-input-string" "open-output-string" "open-input-output-string" "close-input-port" "close-output-port" "interaction-environment" "current-environment" "read" "read-char" "peek-char" "char-ready?" "set-input-port" "set-output-port" "length" "assq" "get-closure-code" "closure?" "macro?" "macro-expand" "foldl" "foldr")))
 353 |       (list
 354 |        ;; other type annotations (has to be first in list)
 355 |        '(":[]{}[[:alnum:]_<>,*:/|!-]+"
 356 |          (0 font-lock-type-face))
 357 |        ;; built-ins
 358 |        (list
 359 |         (concat
 360 |          "("
 361 |          (regexp-opt extempore-builtin-names t)
 362 |          "\\>")
 363 |         '(1 font-lock-keyword-face t))
 364 |        ;; float and int literals
 365 |        '("\\_<[-+]?[/.[:digit:]]+?\\_>"
 366 |          (0 font-lock-constant-face))
 367 |        ;; hex/oct/binary literals
 368 |        '("\\_<#[xob][0-9a-fA-F]+?\\_>"
 369 |          (0 font-lock-constant-face))
 370 |        ;; scientific notation e.g. 1 million = 1e6
 371 |        '("\\_<[[:digit:]]+?e[[:digit:]]+?\\_>"
 372 |          (0 font-lock-constant-face))
 373 |        ;; hack to make sure / gets highlighted as a function
 374 |        '("\\_</\\_>"
 375 |          (0 font-lock-function-name-face t))
 376 |        ;; boolean literals
 377 |        '("\\_<#[tf]\\_>"
 378 |          (0 font-lock-constant-face))
 379 |        ;; definitions
 380 |        (list (concat
 381 |               "(\\(define\\|macro\\|define-macro\\|define-syntax\\|make-instrument\\)\\_>\\s-*(?\\(\\sw+\\)?")
 382 |              '(1 font-lock-keyword-face)
 383 |              '(2 font-lock-function-name-face))
 384 |        ;; scheme functions
 385 |        (list
 386 |         (regexp-opt extempore-scheme-names 'symbols)
 387 |         '(1 font-lock-function-name-face))
 388 |        ;; It wouldn't be Scheme w/o named-let.
 389 |        '("(let\\s-+\\(\\sw+\\)"
 390 |          (1 font-lock-function-name-face))))))
 391 | 
 392 | (defconst extempore-font-lock-keywords-xtlang
 393 |   ;; xtlang language builtin names - used for font locking (colouring).
 394 |   ;; This list is curated by hand - it's usually pretty up to date,
 395 |   ;; but shouldn't be relied on as an Extempore language reference.
 396 |   (eval-when-compile
 397 |     (let ((extempore-xtlang-names '("random" "afill!" "pfill!" "tfill!" "vfill!" "array-fill!" "pointer-fill!" "tuple-fill!" "vector-fill!" "free" "array" "tuple" "list" "~" "cset!" "cref" "&" "bor" "ang-names" "<<" ">>" "nil" "printf" "sprintf" "null" "now" "pset!" "pref-ptr" "vset!" "vref" "aset!" "aref" "aref-ptr" "tset!" "tref" "tref-ptr" "salloc" "halloc" "zalloc" "alloc" "schedule" "exp" "log" "sin" "cos" "tan" "asin" "acos" "atan" "atan2" "sqrt" "expt" "floor" "ceiling" "truncate" "round" "llvm_printf" "push_zone" "pop_zone" "memzone" "callback" "llvm_sprintf" "make-array" "array-set!" "array-ref" "array-ref-ptr" "pointer-set!" "pointer-ref" "pointer-ref-ptr" "stack-alloc" "heap-alloc" "zone-alloc" "make-tuple" "tuple-set!" "tuple-ref" "tuple-ref-ptr" "closure-set!" "closure-ref" "pref" "pdref" "impc_null" "bitcast" "void" "ifret" "ret->" "clrun->" "make-env-zone" "make-env" "<>")))
 398 |       (list
 399 |        ;; xtlang "keywords"
 400 |        (list
 401 |         (regexp-opt extempore-xtlang-names 'symbols)
 402 |         '(1 font-lock-function-name-face))
 403 |        ;; bind-func
 404 |        '("(\\(bind-func\\)\\s-+\\([[:alnum:]_-]+\\)"
 405 |          (1 font-lock-keyword-face)
 406 |          (2 font-lock-function-name-face))
 407 |        '("(\\(bind-macro\\)"
 408 |          (1 font-lock-keyword-face))
 409 |        '("(\\(bind-poly\\)\\s-+\\([[:alnum:]_-]+\\)\\s-+\\([[:alnum:]_-]+\\)"
 410 |          (1 font-lock-keyword-face)
 411 |          (2 font-lock-constant-face t)
 412 |          (3 font-lock-function-name-face))
 413 |        
 414 |        ;; bind-alias
 415 |        '("(\\(bind-alias\\)\\s-+\\([[:alnum:]_-]+\\)\\s-+\\([]{}[[:alnum:]_<>,*:/|-]+\\)"
 416 |          (1 font-lock-keyword-face)
 417 |          (2 font-lock-function-name-face)
 418 |          (3 font-lock-type-face))
 419 |        ;; bind-type
 420 |        '("(\\(bind-type\\)\\s-+\\([[:alnum:]_-]+\\)\\s-+\\([]{}[[:alnum:]_<>,*:/|!-]+\\)"
 421 |          (1 font-lock-keyword-face)
 422 |          (2 font-lock-function-name-face)
 423 |          (3 font-lock-type-face))
 424 |        ;; bind-dylib
 425 |        '("(\\(bind-dylib\\)\\s-+\\([[:alnum:]_-]+\\)"
 426 |          (1 font-lock-keyword-face)
 427 |          (2 font-lock-constant-face))
 428 |        ;; bind-lib
 429 |        '("(\\(bind-lib\\)\\s-+\\([[:alnum:]_-]+\\)\\s-+\\([[:alnum:]_-]+\\)\\s-+\\([]{}[[:alnum:]_<>,*:/|-]+\\)"
 430 |          (1 font-lock-keyword-face)
 431 |          (2 font-lock-constant-face)
 432 |          (3 font-lock-function-name-face)
 433 |          (4 font-lock-type-face))
 434 |        ;; bind-lib-type
 435 |        '("(\\(bind-lib-type\\)\\s-+\\([[:alnum:]_-]+\\)\\s-+\\([[:alnum:]_-]+\\)\\s-+\\([]{}[[:alnum:]_<>,*:/|-]+\\)"
 436 |          (1 font-lock-keyword-face)
 437 |          (2 font-lock-constant-face)
 438 |          (3 font-lock-function-name-face)
 439 |          (4 font-lock-type-face))
 440 |        ;; bind-lib-func
 441 |        '("(\\(bind-lib-func\\)\\s-+\\([[:alnum:]_-]+\\)\\s-+\\([[:alnum:]_-]+\\)\\s-+\\([]{}[[:alnum:]_<>,*:/|-]+\\)"
 442 |          (1 font-lock-keyword-face)
 443 |          (2 font-lock-constant-face)
 444 |          (3 font-lock-function-name-face)
 445 |          (4 font-lock-type-face))
 446 |        ;; bind-val
 447 |        '("(\\(bind-val\\)\\s-+\\([[:alnum:]_-]+\\)\\s-+\\([]{}[[:alnum:]_<>,*:/|-]+\\)"
 448 |          (1 font-lock-keyword-face)
 449 |          (2 font-lock-function-name-face)
 450 |          (3 font-lock-type-face))
 451 |        ;; bind-lib-val
 452 |        '("(\\(bind-lib-val\\)\\s-+\\([[:alnum:]_-]+\\)\\s-+\\([[:alnum:]_-]+\\)\\s-+\\([]{}[[:alnum:]_<>,*:/|-]+\\)"
 453 |          (1 font-lock-keyword-face)
 454 |          (2 font-lock-constant-face)
 455 |          (3 font-lock-function-name-face)
 456 |          (4 font-lock-type-face))
 457 |        ;; cast
 458 |        '("(\\(cast\\|convert\\)\\s-+\\S-+\\s-+\\([^ \t)]?+\\))"
 459 |          (1 font-lock-keyword-face)
 460 |          (2 font-lock-type-face))
 461 |        '("(\\(constrain-genericfunc\\|specialize-genericfunc\\|specialize-generictype\\)\\s-+\\(\\S-+\\)\\s-+\\([^)]?+\\))"
 462 |          (1 font-lock-keyword-face)
 463 |          (2 font-lock-function-name-face)
 464 |          (3 font-lock-type-face))
 465 |        ;; type coercion stuff
 466 |        (list
 467 |         (concat
 468 |          "(" (regexp-opt
 469 |               (let ((types '("i1" "i8" "i16" "i32" "i64" "f" "d")))
 470 |                 (apply 'append (mapcar (lambda (a)
 471 |                                          (mapcar (lambda (b)
 472 |                                                    (concat a "to" b))
 473 |                                                  (remove a types)))
 474 |                                        types))) t) "\\>")
 475 |         '(1 font-lock-type-face))))))
 476 | 
 477 | ;; this conflicts with rainbow-delimiters. put it in your .emacs if
 478 | ;; you want it
 479 | 
 480 | ;; (font-lock-add-keywords 'extempore-mode
 481 | ;;                         '(("(\\|)" . 'extempore-paren-face)))
 482 | 
 483 | (defvar extempore-font-lock-keywords
 484 |   (append extempore-font-lock-keywords-scheme
 485 |           extempore-font-lock-keywords-xtlang)
 486 |   "Expressions to highlight in extempore-mode.")
 487 | 
 488 | (defconst extempore-sexp-comment-syntax-table
 489 |   (let ((st (make-syntax-table extempore-mode-syntax-table)))
 490 |     (modify-syntax-entry ?\; "." st)
 491 |     (modify-syntax-entry ?\n " " st)
 492 |     (modify-syntax-entry ?#  "'" st)
 493 |     st))
 494 | 
 495 | (put 'lambda 'extempore-doc-string-elt 2)
 496 | ;; Docstring's pos in a `define' depends on whether it's a var or fun def.
 497 | (put 'define 'extempore-doc-string-elt
 498 |      (lambda ()
 499 |        ;; The function is called with point right after "define".
 500 |        (forward-comment (point-max))
 501 |        (if (eq (char-after) ?\() 2 0)))
 502 | 
 503 | (defun extempore-font-lock-syntactic-face-function (state)
 504 |   (when (and (null (nth 3 state))
 505 | 	     (eq (char-after (nth 8 state)) ?#)
 506 | 	     (eq (char-after (1+ (nth 8 state))) ?\;))
 507 |     ;; It's a sexp-comment.  Tell parse-partial-sexp where it ends.
 508 |     (save-excursion
 509 |       (let ((pos (point))
 510 | 	    (end
 511 | 	     (condition-case err
 512 | 		 (let ((parse-sexp-lookup-properties nil))
 513 | 		   (goto-char (+ 2 (nth 8 state)))
 514 | 		   ;; FIXME: this doesn't handle the case where the sexp
 515 | 		   ;; itself contains a #; comment.
 516 | 		   (forward-sexp 1)
 517 | 		   (point))
 518 | 	       (scan-error (nth 2 err)))))
 519 | 	(when (< pos (- end 2))
 520 | 	  (put-text-property pos (- end 2)
 521 | 			     'syntax-table extempore-sexp-comment-syntax-table))
 522 | 	(put-text-property (- end 1) end 'syntax-table '(12)))))
 523 |   ;; Choose the face to use.
 524 |   (lisp-font-lock-syntactic-face-function state))
 525 | 
 526 | (defvar calculate-lisp-indent-last-sexp)
 527 | 
 528 | ;; FIXME this duplicates almost all of lisp-indent-function.
 529 | ;; Extract common code to a subroutine.
 530 | (defun extempore-indent-function (indent-point state)
 531 |   "Extempore mode function for the value of the variable `lisp-indent-function'.
 532 | This behaves like the function `lisp-indent-function', except that:
 533 | 
 534 | i) it checks for a non-nil value of the property `extempore-indent-function'
 535 | \(or the deprecated `extempore-indent-hook'), rather than `lisp-indent-function'.
 536 | 
 537 | ii) if that property specifies a function, it is called with three
 538 | arguments (not two), the third argument being the default (i.e., current)
 539 | indentation."
 540 |   (let ((normal-indent (current-column)))
 541 |     (goto-char (1+ (elt state 1)))
 542 |     (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
 543 |     (if (and (elt state 2)
 544 | 	     (not (looking-at "\\sw\\|\\s_")))
 545 | 	;; car of form doesn't seem to be a symbol
 546 | 	(progn
 547 | 	  (if (not (> (save-excursion (forward-line 1) (point))
 548 | 		      calculate-lisp-indent-last-sexp))
 549 | 	      (progn (goto-char calculate-lisp-indent-last-sexp)
 550 | 		     (beginning-of-line)
 551 | 		     (parse-partial-sexp (point)
 552 | 					 calculate-lisp-indent-last-sexp 0 t)))
 553 | 	  ;; Indent under the list or under the first sexp on the same
 554 | 	  ;; line as calculate-lisp-indent-last-sexp.  Note that first
 555 | 	  ;; thing on that line has to be complete sexp since we are
 556 | 	  ;; inside the innermost containing sexp.
 557 | 	  (backward-prefix-chars)
 558 | 	  (current-column))
 559 |       (let ((function (buffer-substring (point)
 560 | 					(progn (forward-sexp 1) (point))))
 561 | 	    method)
 562 | 	(setq method (or (get (intern-soft function) 'extempore-indent-function)
 563 | 			 (get (intern-soft function) 'extempore-indent-hook)))
 564 | 	(cond ((or (eq method 'defun)
 565 | 		   (and (null method)
 566 | 			(> (length function) 3)
 567 | 			(string-match "\\`def" function)))
 568 | 	       (lisp-indent-defform state indent-point))
 569 | 	      ((integerp method)
 570 | 	       (lisp-indent-specform method state
 571 | 				     indent-point normal-indent))
 572 | 	      (method
 573 |                (funcall method state indent-point normal-indent)))))))
 574 | 
 575 | 
 576 | ;;; 'let' is different in Scheme/xtlang
 577 | 
 578 | (defun would-be-symbol (string)
 579 |   (not (string-equal (substring string 0 1) "(")))
 580 | 
 581 | (defun next-sexp-as-string ()
 582 |   ;; Assumes that it is protected by a save-excursion
 583 |   (forward-sexp 1)
 584 |   (let ((the-end (point)))
 585 |     (backward-sexp 1)
 586 |     (buffer-substring (point) the-end)))
 587 | 
 588 | (defun extempore-let-indent (state indent-point normal-indent)
 589 |   (skip-chars-forward " \t")
 590 |   (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]")
 591 |       (lisp-indent-specform 2 state indent-point normal-indent)
 592 |     (lisp-indent-specform 1 state indent-point normal-indent)))
 593 | 
 594 | ;; (put 'begin 'extempore-indent-function 0), say, causes begin to be indented
 595 | ;; like defun if the first form is placed on the next line, otherwise
 596 | ;; it is indented like any other form (i.e. forms line up under first).
 597 | 
 598 | (put 'begin 'extempore-indent-function 0)
 599 | (put 'case 'extempore-indent-function 1)
 600 | (put 'delay 'extempore-indent-function 0)
 601 | (put 'dotimes 'extempore-indent-function 1)
 602 | (put 'doloop 'extempore-indent-function 1)
 603 | (put 'while 'extempore-indent-function 1)
 604 | (put 'lambda 'extempore-indent-function 1)
 605 | (put 'memzone 'extempore-indent-function 1)
 606 | (put 'bind-func 'extempore-indent-function 'defun)
 607 | (put 'bind-macro 'extempore-indent-function 'defun)
 608 | (put 'bind-poly 'extempore-indent-function 'defun)
 609 | (put 'bind-type 'extempore-indent-function 'defun)
 610 | (put 'bind-val 'extempore-indent-function 'defun)
 611 | (put 'bind-lib 'extempore-indent-function 'defun)
 612 | (put 'bind-dylib 'extempore-indent-function 'defun)
 613 | (put 'let 'extempore-indent-function 'extempore-let-indent)
 614 | (put 'letz 'extempore-indent-function 'extempore-let-indent)
 615 | (put 'let* 'extempore-indent-function 'extempore-let-indent)
 616 | (put 'letrec 'extempore-indent-function 'extempore-let-indent)
 617 | (put 'let-syntax 'extempore-indent-function 1)
 618 | (put 'letrec-syntax 'extempore-indent-function 1)
 619 | (put 'syntax-rules 'extempore-indent-function 1)
 620 | (put 'syntax-case 'extempore-indent-function 2) ; not r5rs
 621 | (put 'call-with-input-file 'extempore-indent-function 1)
 622 | (put 'with-input-from-file 'extempore-indent-function 1)
 623 | (put 'with-input-from-port 'extempore-indent-function 1)
 624 | (put 'call-with-output-file 'extempore-indent-function 1)
 625 | (put 'with-output-to-file 'extempore-indent-function 1)
 626 | (put 'with-output-to-port 'extempore-indent-function 1)
 627 | (put 'call-with-values 'extempore-indent-function 1) ; r5rs?
 628 | (put 'dynamic-wind 'extempore-indent-function 3) ; r5rs?
 629 | 
 630 | 
 631 | ;;; SLIP escape codes
 632 | ;; END       ?\300    /* indicates end of packet */
 633 | ;; ESC       ?\333    /* indicates byte stuffing */
 634 | ;; ESC_END   ?\334    /* ESC ESC_END means END data byte */
 635 | ;; ESC_ESC   ?\335    /* ESC ESC_ESC means ESC data byte */
 636 | 
 637 | (defun extempore-slip-process-filter (proc str)
 638 |   (message (extempore-slip-unescape-string str)))
 639 | 
 640 | ;; connection management
 641 | (make-variable-buffer-local 'mode-line-process)
 642 | (setq mode-line-process nil)
 643 | (make-variable-buffer-local 'extempore-connection-list)
 644 | (defvar extempore-connection-list)
 645 | (setq extempore-connection-list nil)
 646 | 
 647 | (defun extempore-update-mode-line ()
 648 |   (let ((nprocs (length extempore-connection-list))
 649 |         (gethostportstr ))
 650 |     (setq mode-line-process
 651 |           (if (< nprocs 1)
 652 |               ""
 653 |             (mapconcat
 654 |              'identity
 655 |              (mapcar (lambda (proc)
 656 |                        (let ((host (process-contact proc :host)))
 657 |                          (concat " "
 658 |                                  (if (string= host "localhost") "" (concat host ":"))
 659 |                                  (number-to-string (process-contact proc :service)))))
 660 |                      extempore-connection-list)
 661 |              "")))))
 662 | 
 663 | (defun extempore-sync-connections ()
 664 |   (interactive)
 665 |   (dolist (proc extempore-connection-list)
 666 |     (let ((res (process-status proc)))
 667 |       (unless (member res '(run open))
 668 |         (setq extempore-connection-list
 669 |                      (delete proc extempore-connection-list))
 670 |         (delete-process proc))))
 671 |   (extempore-update-mode-line))
 672 | 
 673 | (defun extempore-get-connection (host port)
 674 |   (cl-find-if (lambda (proc)
 675 | 		(and (string= host (process-contact proc :host))
 676 | 		     (= port (process-contact proc :service))))
 677 | 	      extempore-connection-list))
 678 | 
 679 | (defun extempore-new-connection (host port)
 680 |   (if (extempore-get-connection host port)
 681 |       (message "Already connected to Extempore at %s:%d" host port)
 682 |     (let ((proc (with-demoted-errors (open-network-stream "extempore" nil host port))))
 683 |         (if proc
 684 |             (progn
 685 |               (set-process-coding-system proc 'iso-latin-1-unix 'iso-latin-1-unix)
 686 |               (set-process-filter proc #'extempore-minibuffer-echo-filter)
 687 |               (add-to-list 'extempore-connection-list proc t)
 688 |               (extempore-update-mode-line))
 689 |           (message "Could not connect to Extempore at %s:%d" host port)))))
 690 | 
 691 | (defun extempore-disconnect (host port)
 692 |   "Terminate a specific connection to an Extempore process"
 693 |   (interactive
 694 |    (if extempore-connection-list
 695 |        (let ((read-host (ido-completing-read
 696 |                          "Hostname: " (cl-remove-duplicates
 697 |                                        (mapcar (lambda (proc)
 698 |                                                  (process-contact proc :host))
 699 |                                                extempore-connection-list)
 700 |                                        :test 'string=)
 701 |                          nil nil nil nil (process-contact (car extempore-connection-list) :host)))
 702 |              (read-port (string-to-number
 703 |                          (ido-completing-read
 704 |                           "Port: " (cl-remove-duplicates
 705 |                                     (mapcar (lambda (proc)
 706 |                                               (number-to-string
 707 |                                                (process-contact proc :service)))
 708 |                                             extempore-connection-list)
 709 |                                     :test 'string=)
 710 |                           nil nil nil nil (number-to-string (process-contact (car extempore-connection-list) :service))))))
 711 |          (list read-host read-port))
 712 |      (list nil nil)))
 713 |   (let ((proc (extempore-get-connection host port)))
 714 |     (if proc
 715 |         (progn (delete-process proc)
 716 |                (extempore-sync-connections))
 717 |       (message "No current connections to %s on port %d" host port))))
 718 | 
 719 | (defun extempore-disconnect-all ()
 720 |   "Terminate all connections (for this buffer)"
 721 |   (interactive)
 722 |   (dolist (proc extempore-connection-list)
 723 |     (delete-process proc))
 724 |   (setq extempore-connection-list nil)
 725 |   (extempore-update-mode-line))
 726 | 
 727 | (defvar extempore-connect-host-history-list nil)
 728 | (defvar extempore-connect-port-history-list nil)
 729 | 
 730 | (defun extempore-connect (prefix host port)
 731 |   "Connect to an Extempore process running on HOST and PORT.
 732 | 
 733 | When called with prefix arg, prompt for HOST and PORT, otherwise
 734 | just use `extempore-default-host':`extempore-default-port'"
 735 |   (interactive
 736 |    ;; get args interactively
 737 |    (if current-prefix-arg
 738 | 	   (list :prefix
 739 | 			 (ido-completing-read
 740 | 			  "Hostname: " (cl-remove-duplicates (cons extempore-default-host extempore-connect-host-history-list) :test #'string=) nil nil nil 'extempore-connect-host-history-list extempore-default-host)
 741 | 			 (string-to-number
 742 | 			  (ido-completing-read
 743 | 			   "Port: " (cl-remove-duplicates (append '("7099" "7098") extempore-connect-port-history-list) :test #'string=) nil nil nil 'extempore-connect-port-history-list (number-to-string extempore-default-port))))
 744 | 	 (list nil extempore-default-host extempore-default-port)))
 745 |   (extempore-sync-connections)
 746 |   (extempore-new-connection host port))
 747 | 
 748 | (defvar extempore-multiple-connection-list nil)
 749 | 
 750 | (defun extempore-connect-multiple ()
 751 |   "connect to multiple extempore processes
 752 | 
 753 | `extempore-multiple-connection-list' should be of the form
 754 | ((\"hostname1\" . port1) (\"hostname2\" . port2)) etc."
 755 |   (interactive)
 756 |   (if (local-variable-p 'extempore-multiple-connection-list)
 757 |       (dolist (host-port extempore-multiple-connection-list)
 758 |         (extempore-connect :prefix (car host-port) (cdr host-port)))))
 759 | 
 760 | (defun extempore-connect-port-range (host start count step)
 761 |   (interactive
 762 |    (list (ido-completing-read
 763 |           "Hostname: " (cl-remove-duplicates (cons extempore-default-host extempore-connect-host-history-list) :test #'string=) nil nil nil 'extempore-connect-host-history-list extempore-default-host)
 764 |          (string-to-number
 765 |           (ido-completing-read
 766 |            "Starting port: " (cl-remove-duplicates (append '("7099" "7098") extempore-connect-port-history-list) :test #'string=) nil nil nil 'extempore-connect-port-history-list (number-to-string extempore-default-port)))
 767 |          (string-to-number
 768 |           (ido-completing-read
 769 |            "Number of ports: " nil))
 770 |          (string-to-number
 771 |           (ido-completing-read
 772 |            "Port step: " nil nil nil "1"))))
 773 |   (dotimes (port count)
 774 |     (extempore-connect :prefix host (+ start (* step port)))))
 775 | 
 776 | ;;; SLIP escape codes
 777 | ;; END       ?\300    /* indicates end of packet */
 778 | ;; ESC       ?\333    /* indicates byte stuffing */
 779 | ;; ESC_END   ?\334    /* ESC ESC_END means END data byte */
 780 | ;; ESC_ESC   ?\335    /* ESC ESC_ESC means ESC data byte */
 781 | 
 782 | (defvar extempore-use-slip-tcp-connection nil)
 783 | (defvar extempore-slip-end-string (char-to-string ?\300))
 784 | (defvar extempore-slip-esc-string (char-to-string ?\333))
 785 | (defvar extempore-slip-esc-end-string (char-to-string ?\334))
 786 | (defvar extempore-slip-esc-esc-string (char-to-string ?\335))
 787 | (defvar extempore-slip-escaping-regexp
 788 |   (concat "[" extempore-slip-esc-string extempore-slip-end-string "]"))
 789 | (defvar extempore-slip-unescaping-regexp (concat extempore-slip-esc-string "."))
 790 | 
 791 | (defun extempore-slip-escape-string (str)
 792 |   (concat
 793 |    extempore-slip-end-string
 794 |    (replace-regexp-in-string extempore-slip-escaping-regexp
 795 |                              (lambda (s)
 796 |                                (if (string-equal s extempore-slip-end-string)
 797 |                                    (concat extempore-slip-esc-string
 798 |                                            extempore-slip-esc-end-string)
 799 |                                  (concat extempore-slip-esc-string
 800 |                                          extempore-slip-esc-esc-string)))
 801 |                              str)
 802 |    extempore-slip-end-string))
 803 | 
 804 | (defun extempore-slip-unescape-string (str)
 805 |   (if (and (string-equal (substring str 0 1)
 806 |                          extempore-slip-end-string)
 807 |            (string-equal (substring str -1)
 808 |                          extempore-slip-end-string))
 809 |       (replace-regexp-in-string extempore-slip-unescaping-regexp
 810 |                                 (lambda (s)
 811 |                                   (if (string-equal (substring s 1)
 812 |                                                     extempore-slip-esc-end-string)
 813 |                                       extempore-slip-end-string
 814 |                                     extempore-slip-esc-string))
 815 |                                 (substring str 1 -1))
 816 |     (progn (message "Dropping malformed SLIP packet.")
 817 |            nil)))
 818 | 
 819 | ;; correct escaping of eval strings
 820 | 
 821 | (defun extempore-make-crlf-evalstr (evalstr)
 822 |   (concat evalstr "\r\n"))
 823 | 
 824 | 
 825 | (defun extempore-make-slip-evalstr (evalstr)
 826 |   (extempore-slip-escape-string evalstr))
 827 | 
 828 | ;; sending code to the Extempore compiler
 829 | ;; from http://emacswiki.org/emacs/ElispCookbook
 830 | (defun chomp (str)
 831 |   "Chomp leading and tailing whitespace from STR."
 832 |   (while (string-match "\\`\n+\\|^\\s-+\\|\\s-+$\\|\n+\\'" str)
 833 |     (setq str (replace-match "" t t str)))
 834 |   str)
 835 | 
 836 | ;; 'blinking' defuns as they are evaluated
 837 | 
 838 | (defvar extempore-blink-duration 0.15)
 839 | 
 840 | (defun extempore-make-blink-overlay (face-sym)
 841 |   (let ((overlay (make-overlay 0 0)))
 842 |     (overlay-put overlay 'face face-sym)
 843 |     (overlay-put overlay 'priority 1000)
 844 |     overlay))
 845 | 
 846 | (defvar extempore-blink-overlay (extempore-make-blink-overlay 'extempore-blink-face)
 847 |   "overlay for highlighting currently evaluated region or line")
 848 | 
 849 | (defvar extempore-sb-blink-overlay (extempore-make-blink-overlay 'extempore-sb-blink-face) "slave buffer version")
 850 | 
 851 | ;; for blinking evals in slave buffers (see `extempore-sb-mode')
 852 | (defvar-local extempore-sb-eval-markers nil)
 853 | 
 854 | ;; sending definitions (code) from the Emacs buffer
 855 | 
 856 | ;;;;;;;;;;;;;;;;;;;;;;;;
 857 | ;; inferior extempore ;;
 858 | ;;;;;;;;;;;;;;;;;;;;;;;;
 859 | 
 860 | ;; (heavily) based cmuscheme.el by Olin Shivers, Extempore conversion
 861 | ;; work by Ben Swift
 862 | 
 863 | (require 'comint)
 864 | 
 865 | (defvar extempore-buffer)
 866 | 
 867 | (define-derived-mode inferior-extempore-mode comint-mode "Inferior Extempore"
 868 |   "Major mode for running an inferior Extempore process.
 869 | 
 870 | A Extempore process can be fired up with M-x extempore-run.
 871 | 
 872 | You can send text to the inferior Extempore process from other buffers containing
 873 | Extempore source.
 874 |     switch-to-extempore switches the current buffer to the Extempore process buffer.
 875 |     extempore-send-definition sends the current definition to the Extempore process.
 876 |     extempore-compile-definition compiles the current definition.
 877 |     extempore-send-region sends the current region to the Extempore process.
 878 |     extempore-compile-region compiles the current region.
 879 | 
 880 |     extempore-send-definition-and-go, extempore-compile-definition-and-go,
 881 |         extempore-send-region-and-go, and extempore-compile-region-and-go
 882 |         switch to the Extempore process buffer after sending their text.
 883 | For information on running multiple processes in multiple buffers, see
 884 | documentation for variable extempore-buffer.
 885 | 
 886 | Commands:
 887 | Return after the end of the process' output sends the text from the
 888 |     end of process to point.
 889 | Return before the end of the process' output copies the sexp ending at point
 890 |     to the end of the process' output, and sends it.
 891 | Delete converts tabs to spaces as it moves back.
 892 | Tab indents for Extempore; with argument, shifts rest
 893 |     of expression rigidly with the current line.
 894 | C-M-q does Tab on each line starting within following expression.
 895 | Paragraphs are separated only by blank lines.  Semicolons start comments.
 896 | If you accidentally suspend your process, use \\[comint-continue-subjob]
 897 | to continue it."
 898 |   (setq mode-line-process '(":%s")))
 899 | 
 900 | (defvar extempore-repl-mode-map
 901 |   (let ((m (make-sparse-keymap)))
 902 |     (define-key m (kbd "<return>") 'extempore-repl-return)
 903 |     (define-key m (kbd "C-c C-c") 'extempore-repl-reset-prompt)
 904 |     (define-key m (kbd "C-c C-z") 'switch-to-extempore)
 905 |     (define-key m (kbd "C-c C-l") 'extempore-repl-toggle-current-language)
 906 |     m))
 907 | 
 908 | (defvar-local extempore-repl-current-language 'scheme)
 909 | 
 910 | (define-derived-mode extempore-repl-mode comint-mode "Extempore REPL"
 911 |   "Major mode for running a REPL connected to an existing Extempore process."
 912 |   (setq-local comint-use-prompt-regexp t)
 913 |   (setq-local comint-prompt-regexp "^\\(scheme\\|xtlang\\)<[^>]*> +")
 914 |   (setq-local comint-input-sender (function extempore-repl-send))
 915 |   (setq-local comint-preoutput-filter-functions (list (function extempore-repl-preoutput-filter)))
 916 |   (setq-local comint-output-filter-functions (list (function ansi-color-process-output)
 917 |                                                    (function comint-postoutput-scroll-to-bottom)))
 918 |   (setq-local mode-line-process nil)
 919 |   (setq-local comint-get-old-input (function extempore-get-old-input))
 920 |   (face-remap-set-base 'comint-highlight-prompt nil))
 921 | 
 922 | (defun extempore-repl-toggle-current-language ()
 923 |   "toggle between scheme and xtlang"
 924 |   (interactive)
 925 |   (if (eq extempore-repl-current-language 'scheme)
 926 |       (setq-local extempore-repl-current-language 'xtlang)
 927 |     (setq-local extempore-repl-current-language 'scheme))
 928 |   (extempore-repl-reset-prompt))
 929 | 
 930 | (defun extempore-repl-send (proc string)
 931 |   (comint-simple-send proc
 932 |                       ;; if in xtlang mode (and not bind-{func,val,
 933 |                       ;; etc.} ing), wrap expression in a
 934 |                       ;; `call-as-xtlang' form
 935 |                       (format (if (and (eq extempore-repl-current-language 'xtlang)
 936 |                                        (not (string-match "^ *(bind-" string)))
 937 |                                   "(call-as-xtlang %s)\r"
 938 |                                 "%s\r")
 939 |                               string)))
 940 | 
 941 | (defun extempore-repl-propertized-prompt-string ()
 942 |   (let ((proc (get-buffer-process (current-buffer))))
 943 |     (format "\n%s<%s> "
 944 |             (if (eq extempore-repl-current-language 'xtlang)
 945 |                 (propertize "xtlang" 'font-lock-face 'font-lock-variable-name-face)
 946 |               (propertize "scheme" 'font-lock-face 'font-lock-type-face))
 947 |             (let ((host (process-contact proc :host))
 948 |                   (port (process-contact proc :service)))
 949 |               (concat
 950 |                (if (or (string= host "localhost")
 951 |                        (string= host "127.0.0.1"))
 952 |                    ""
 953 |                  (concat (propertize host
 954 |                                      'font-lock-face
 955 |                                      'font-lock-keyword-face)
 956 |                          ":"))
 957 |                (propertize (number-to-string port)
 958 |                            'font-lock-face
 959 |                            'font-lock-function-name-face))))))
 960 | 
 961 | (defun extempore-repl-preoutput-filter (string)
 962 |   (format "%s %s %s"
 963 |           (propertize "=>" 'font-lock-face 'font-lock-comment-face)
 964 |           (propertize (substring string 0 -1)
 965 |                       'font-lock-face
 966 |                       'font-lock-string-face)
 967 |           (extempore-repl-propertized-prompt-string)))
 968 | 
 969 | (defun extempore-repl-reset-prompt ()
 970 |   (interactive)
 971 |   (if (get-buffer-process (current-buffer))
 972 |       (progn
 973 |         (insert (extempore-repl-propertized-prompt-string))
 974 |         (comint-set-process-mark))
 975 |     (message "This REPL is dead: the connection to Extempore has been closed.")))
 976 | 
 977 | (defun extempore-repl-is-whitespace-or-comment (string)
 978 |   "Return non-nil if STRING is all whitespace or a comment."
 979 |   (or (string= string "")
 980 |       (string-match-p "\\`[ \t\n]*\\(?:;.*\\)*\\'" string)))
 981 | 
 982 | (defun extempore-repl-return ()
 983 |   "Only send current input if it is a syntactically correct s-expression, otherwise newline-and-indent."
 984 |   (interactive)
 985 |   (let ((edit-pos (point))
 986 |         (proc (get-buffer-process (current-buffer))))
 987 |     (if proc
 988 |         (progn
 989 |           (goto-char (process-mark proc))
 990 |           (if (extempore-repl-is-whitespace-or-comment (buffer-substring edit-pos (point)))
 991 |               
 992 |               (extempore-repl-reset-prompt)
 993 |             (let ((sexp-bounds (bounds-of-thing-at-point 'sexp)))
 994 |               (if sexp-bounds
 995 |                   (progn (set-mark (car sexp-bounds))
 996 |                          (goto-char (cdr sexp-bounds))
 997 |                          (comint-send-input))
 998 |                 (progn (goto-char edit-pos)
 999 |                        (newline-and-indent))))))
1000 |       (message "This REPL is dead: the connection to Extempore has been closed."))))
1001 | 
1002 | (defun extempore-get-old-input ()
1003 |   "Snarf the sexp ending at point."
1004 |   (save-excursion
1005 |     (let ((end (point)))
1006 |       (backward-sexp)
1007 |       (buffer-substring (point) end))))
1008 | 
1009 | ;;;###autoload
1010 | (defun extempore-repl (host port)
1011 |   (interactive
1012 |    (list (ido-completing-read
1013 |           "Hostname: " (cl-remove-duplicates (cons extempore-default-host extempore-connect-host-history-list) :test #'string=) nil nil nil 'extempore-connect-host-history-list extempore-default-host)
1014 |          (string-to-number
1015 |           (ido-completing-read
1016 |            "Port: " (cl-remove-duplicates (append '("7099" "7098") extempore-connect-port-history-list) :test #'string=) nil nil nil 'extempore-connect-port-history-list (number-to-string extempore-default-port)))))
1017 |   "Start an Extempore REPL connected to HOST on PORT."
1018 |   (let* ((repl-buffer-name (format "extempore REPL<%s:%d>" host port))
1019 |          (repl-buffer-name* (format "*%s*" repl-buffer-name)))
1020 |     (unless (comint-check-proc "*extempore*")
1021 |       (call-interactively #'extempore-run))
1022 |     (unless (and  (get-buffer repl-buffer-name*)
1023 |                   (get-buffer-process repl-buffer-name*)))
1024 |     (dotimes (i 25)
1025 |       (condition-case err
1026 |           (set-buffer (make-comint repl-buffer-name (cons host port)))
1027 |         (error
1028 |          (message (format  "Starting Extempore%s" (make-string i ?\.)))
1029 |          (sit-for 0.2))))
1030 |     (if (comint-check-proc "*extempore*")
1031 |         (extempore-repl-mode))
1032 | ; Report to user and go to the repl buffer if it's there
1033 |     (if  (and  (comint-check-proc "*extempore*"))
1034 |          (progn
1035 |            (pop-to-buffer (format "*%s*" repl-buffer-name))
1036 |            (message "extempore REPL ready."))
1037 |          (message "Could not Launch extempore REPL."))))
1038 | 
1039 | ;; for compatibility---this is what it used to be called
1040 | (defalias 'extempore-start-repl 'extempore-repl)
1041 | 
1042 | (defvar extempore-run-history-list nil)
1043 | 
1044 | (defun extempore-find-executable ()
1045 |   "find the `extempore' executable"
1046 |   (or (executable-find "extempore")
1047 |       (executable-find (concat extempore-path "extempore"))
1048 |       (error "Couldn't find extempore executable - have you set your `extempore-path' correctly?")))
1049 | 
1050 | ;;;###autoload
1051 | (defun extempore-run (program-args run-directory)
1052 |   "Run an inferior Extempore process, input and output via buffer `*extempore*'.
1053 | If there is a process already running in `*extempore*', switch to that buffer.
1054 | 
1055 | \(Type \\[describe-mode] in the process buffer for a list of commands.)"
1056 | 
1057 |   (interactive
1058 |    (list (read-string "Run: extempore " extempore-program-args extempore-run-history-list)
1059 | 		 (if (or current-prefix-arg (not extempore-path))
1060 | 			 (read-directory-name "in directory: ")
1061 | 		   extempore-path)))
1062 |   (unless (comint-check-proc "*extempore*")
1063 |     (with-current-buffer (get-buffer-create "*extempore*")
1064 |       (setq-local default-directory run-directory)
1065 |       (message (concat "Running: extempore " program-args))
1066 |       (apply #'make-comint
1067 |              "extempore"
1068 |              (extempore-find-executable)
1069 |              nil ;; no startfile
1070 |              (split-string-and-unquote program-args))
1071 |       (inferior-extempore-mode)
1072 | 	  ;; so as to not annoy evil users
1073 | 	  (when (fboundp 'evil-force-normal-state)
1074 | 		(evil-force-normal-state))))
1075 |   (setq extempore-buffer "*extempore*"))
1076 | 
1077 | (defun extempore-stop ()
1078 |   (interactive)
1079 |   (if (comint-check-proc "*extempore*")
1080 |       (with-current-buffer "*extempore*"
1081 |         (comint-interrupt-subjob))
1082 |     (message "Extempore is not currently running in buffer *extempore*")))
1083 | 
1084 | (defun extempore-send-region (start end)
1085 |   "Send the current region to the inferior Extempore process."
1086 |   (interactive "r")
1087 |   (if extempore-connection-list
1088 |       (let ((transient-mark-mode nil))
1089 |         (dolist (proc extempore-connection-list)
1090 |           (process-send-string proc
1091 |            (concat (buffer-substring-no-properties start end) "\r\n")))
1092 |         (extempore-blink-region extempore-blink-overlay start end))
1093 |     (error "This buffer is not connected to an Extempore process - you can connect it with `M-x extempore-connect' (C-c C-j)")))
1094 | 
1095 | (defun extempore-send-definition ()
1096 |   "Send the current definition to the inferior Extempore process."
1097 |   (interactive)
1098 |   (save-excursion
1099 |    (end-of-defun)
1100 |    (let ((end (point)))
1101 |      (beginning-of-defun)
1102 |      (extempore-send-region (point) end))))
1103 | 
1104 | (defun extempore-send-buffer ()
1105 |   "Send the current buffer to the inferior Extempore process
1106 | 
1107 | This function sends the top-level forms one-at a time to avoid
1108 | overflowing the REPL input buffer."
1109 |   (interactive)
1110 |   (let ((extempore-blink-duration 0.01))
1111 |     (save-excursion
1112 |       (goto-char (point-min))
1113 |       (while (re-search-forward "^(" (point-max) t)
1114 |         (extempore-send-definition)
1115 |         (redisplay)))))
1116 | 
1117 | (defun extempore-send-dwim ()
1118 |   "Send the current definition (or region, if active) to the inferior Extempore process"
1119 |   (interactive)
1120 |   (if (region-active-p)
1121 |       (extempore-send-region (region-beginning) (region-end))
1122 |     (extempore-send-definition)))
1123 | 
1124 | (defalias 'extempore-send-buffer-or-region #'extempore-send-dwim
1125 |   "compatibility alias---behaviour is not identical, but might do the job")
1126 | 
1127 | (defun extempore-send-last-sexp ()
1128 |   "Send the previous sexp to the inferior Extempore process."
1129 |   (interactive)
1130 |   (extempore-send-region (save-excursion (backward-sexp) (point)) (point)))
1131 | 
1132 | ;;;###autoload
1133 | (defun switch-to-extempore ()
1134 |   "Switch to the extempore process buffer and (unless prefix arg) position cursor at end of buffer."
1135 |   (interactive)
1136 |   (if (and extempore-buffer (comint-check-proc extempore-buffer))
1137 |       (progn
1138 | 		(pop-to-buffer extempore-buffer)
1139 | 		(push-mark)
1140 | 		(goto-char (point-max)))
1141 |     (extempore-interactively-start-process)))
1142 | 
1143 | (defun extempore-send-definition-and-go ()
1144 |   "Send the current definition to the inferior Extempore.
1145 | Then switch to the process buffer."
1146 |   (interactive)
1147 |   (extempore-send-definition)
1148 |   (switch-to-extempore))
1149 | 
1150 | (defvar extempore-prev-l/c-dir/file nil
1151 |   "Caches the last (directory . file) pair.
1152 | Caches the last pair used in the last `extempore-load-file' or
1153 | `extempore-compile-file' command.  Used for determining the default
1154 | in the next one.")
1155 | 
1156 | (defun extempore-load-file (file-name)
1157 |   "Load an Extempore (.xtm) file FILE-NAME into the inferior Extempore process."
1158 |   (interactive (comint-get-source "Load .xtm file: " extempore-prev-l/c-dir/file
1159 | 				  '(extempore-mode) t))
1160 |   (comint-check-source file-name) ; Check to see if buffer needs saved.
1161 |   (setq extempore-prev-l/c-dir/file (cons (file-name-directory    file-name)
1162 | 				       (file-name-nondirectory file-name)))
1163 |   (comint-send-string (extempore-proc) (concat "(sys:load \"" file-name "\"\)\n")))
1164 | 
1165 | 
1166 | (defvar extempore-buffer nil "*The current extempore process buffer.
1167 | 
1168 | MULTIPLE PROCESS SUPPORT
1169 | ===========================================================================
1170 | extempore.el supports, in a fairly simple fashion, running multiple Extempore
1171 | processes.  To run multiple Extempore processes, you start the first up with
1172 | \\[extempore-run].  It will be in a buffer named *extempore*.  Rename this buffer
1173 | with \\[rename-buffer].  You may now start up a new process with another
1174 | \\[extempore-run].  It will be in a new buffer, named *extempore*.  You can
1175 | switch between the different process buffers with \\[switch-to-buffer].
1176 | 
1177 | Commands that send text from source buffers to Extempore processes --
1178 | like `extempore-send-definition' or `extempore-compile-region' -- have to choose a
1179 | process to send to, when you have more than one Extempore process around.  This
1180 | is determined by the global variable `extempore-buffer'.  Suppose you
1181 | have three inferior Extempores running:
1182 |     Buffer	Process
1183 |     foo		extempore
1184 |     bar		extempore<2>
1185 |     *extempore*    extempore<3>
1186 | If you do a \\[extempore-send-definition-and-go] command on some Extempore source
1187 | code, what process do you send it to?
1188 | 
1189 | - If you're in a process buffer (foo, bar, or *extempore*),
1190 |   you send it to that process.
1191 | - If you're in some other buffer (e.g., a source file), you
1192 |   send it to the process attached to buffer `extempore-buffer'.
1193 | This process selection is performed by function `extempore-proc'.
1194 | 
1195 | Whenever \\[extempore-run] fires up a new process, it resets `extempore-buffer'
1196 | to be the new process's buffer.  If you only run one process, this will
1197 | do the right thing.  If you run multiple processes, you can change
1198 | `extempore-buffer' to another process buffer with \\[set-variable].
1199 | 
1200 | More sophisticated approaches are, of course, possible.  If you find yourself
1201 | needing to switch back and forth between multiple processes frequently,
1202 | you may wish to consider ilisp.el, a larger, more sophisticated package
1203 | for running inferior Lisp and Extempore processes.  The approach taken here is
1204 | for a minimal, simple implementation.  Feel free to extend it.")
1205 | 
1206 | (defun extempore-proc ()
1207 |   "Return the current Extempore process, starting one if necessary.
1208 | See variable `extempore-buffer'."
1209 |   (unless (and extempore-buffer
1210 |                (get-buffer extempore-buffer)
1211 |                (comint-check-proc extempore-buffer))
1212 |     (extempore-interactively-start-process))
1213 |   (or (extempore-get-process)
1214 |       (error "No current process.  See variable `extempore-buffer'")))
1215 | 
1216 | (defun extempore-get-process ()
1217 |   "Return the current Extempore process or nil if none is running."
1218 |   (get-buffer-process (if (eq major-mode 'inferior-extempore-mode)
1219 |                           (current-buffer)
1220 |                         extempore-buffer)))
1221 | 
1222 | (defun extempore-interactively-start-process (&optional _cmd)
1223 |   "Start an inferior Extempore process.  Return the process started.
1224 | Since this command is run implicitly, always ask the user for the
1225 | command to run."
1226 |   (save-window-excursion
1227 |     (call-interactively #'extempore-run))
1228 |   (display-buffer "*extempore*" #'display-buffer-pop-up-window))
1229 | 
1230 | ;;;;;;;;;;;
1231 | ;; eldoc ;;
1232 | ;;;;;;;;;;;
1233 | 
1234 | ;; this required for Emacs 25, see GH issue #243
1235 | (unless (fboundp 'eldoc-beginning-of-sexp)
1236 |   (defalias 'eldoc-beginning-of-sexp 'elisp--beginning-of-sexp))
1237 | 
1238 | (defcustom extempore-eldoc-active t
1239 |   "If non-nil, attempt to display live argument lists for the
1240 |   function under point."
1241 |   :type 'boolean
1242 |   :group 'extempore)
1243 | 
1244 | (defun extempore-fnsym-in-current-sexp ()
1245 |   (save-excursion
1246 |     (let ((argument-index (1- (eldoc-beginning-of-sexp))))
1247 |       ;; If we are at the beginning of function name, this will be -1.
1248 |       (when (< argument-index 0)
1249 | 	(setq argument-index 0))
1250 |       ;; Don't do anything if current word is inside a string.
1251 |       (if (= (or (char-after (1- (point))) 0) ?\") ;" (to stop ST2's string highlighting stuffing up)
1252 | 	  nil
1253 | 	(current-word)))))
1254 | 
1255 | (make-variable-buffer-local 'eldoc-documentation-function)
1256 | 
1257 | ;; currently doesn't actually return the symbol, but sends the request
1258 | ;; which is echoed back through whichever process filter is active
1259 | (defun extempore-eldoc-documentation-function ()
1260 |   (if (and extempore-connection-list extempore-eldoc-active)
1261 |       (let ((fnsym (extempore-fnsym-in-current-sexp)))
1262 |         ;; send the documentation request
1263 |         (if extempore-connection-list
1264 |             (process-send-string (car extempore-connection-list)
1265 |                                  (format  "(if (defined? 'xtmdoc-documentation-function) (xtmdoc-documentation-function \"%s\"))\r\n" fnsym)))
1266 |         ;; always return nil; docstring comes back through the process
1267 |         ;; filter
1268 |         nil)))
1269 | 
1270 | (defun extempore-process-docstring-form (form)
1271 |   (if form
1272 |       (let ((max-eldoc-string-length 120)
1273 |             (eldoc-string
1274 |              (concat (propertize (cdr (assoc 'category form))
1275 |                                  'face 'font-lock-keyword-face)
1276 |                      " "
1277 |                      (propertize (cdr (assoc 'name form))
1278 |                                  'face 'font-lock-function-name-face)
1279 |                      ""
1280 |                      (and (cdr (assoc 'type form))
1281 |                           (concat ":" (propertize (cdr (assoc 'type form))
1282 |                                                   'face 'font-lock-type-face)))
1283 |                      " "
1284 |                      (format "%s" (or (cdr (assoc 'args form))
1285 |                                       "()"))))
1286 |             (docstring (cdr (assoc 'docstring form))))
1287 |         (message
1288 |          "%s"
1289 |          (concat eldoc-string
1290 |                  (if (and docstring (< (length eldoc-string) max-eldoc-string-length))
1291 |                      (concat " - " (propertize (if (> (+ (length docstring)
1292 |                                                          (length eldoc-string))
1293 |                                                       (- max-eldoc-string-length 17))
1294 |                                                    (concat (substring docstring 0 (- max-eldoc-string-length
1295 |                                                                                      (length eldoc-string)
1296 |                                                                                      17))
1297 |                                                            "...")
1298 |                                                  docstring)
1299 |                                                'face 'font-lock-string-face))))))))
1300 | 
1301 | (defun extempore-minibuffer-echo-filter (proc retstr)
1302 |   (let ((str (replace-regexp-in-string "[%\n]" "" (substring retstr 0 -1))))
1303 |     (if (and (> (length str) 16)
1304 |              (string= "(xtmdoc-docstring" (substring str 0 17)))
1305 |         (if (not (string= "(xtmdoc-docstring-nodocstring)" str))
1306 |             (extempore-process-docstring-form (cdr-safe (ignore-errors (read str)))))
1307 |       (message str))))
1308 | 
1309 | (add-hook 'extempore-mode-hook
1310 |           '(lambda ()
1311 |              (turn-on-eldoc-mode)
1312 | 			 (setq-local eldoc-documentation-function
1313 | 						 'extempore-eldoc-documentation-function)))
1314 | 
1315 | ;; misc bits and pieces
1316 | (defun xpb1 (name duration)
1317 |   (interactive "sName: \nsDuration: ")
1318 |   (insert (concat "(define " name
1319 | 		  "\n  (lambda (beat dur)\n    "
1320 | 		  "(callback (*metro* (+ beat (* .5 " duration "))) '"
1321 | 		  name " (+ beat " duration ") " duration ")))\n\n"
1322 | 		  "(" name " (*metro* 'get-beat 4) " duration ")")))
1323 | 
1324 | ;; for greek symbol lambdas: from emacs-starter-kit
1325 | (if extempore-use-pretty-lambdas
1326 |     (font-lock-add-keywords
1327 |      nil `(("(?\\(lambda\\>\\)"
1328 | 	    (0 (progn (compose-region (match-beginning 1) (match-end 1)
1329 | 				      ,(make-char 'greek-iso8859-7 107))
1330 | 		      nil))))))
1331 | 
1332 | ;; useful for converting C header files to xtlang headers
1333 | (defun hex-to-decimal-at-point ()
1334 |   (interactive)
1335 |   (let ((hex-str (word-at-point)))
1336 |     (if hex-str
1337 | 	(progn (kill-word 1)
1338 | 	       (insert (number-to-string (string-to-number hex-str 16)))))))
1339 | 
1340 | ;; nb. it appears flycheck does not like the case macro, and will complain about malformed functions
1341 | (defun note-to-midi (str)
1342 |   (if (string-match "\\([a-gA-G]\\)\\(#\\|b\\)?\\(-?[0-9]\\)" str)
1343 |       (let ((pc (cl-case (mod (- (mod (string-to-char (match-string 1 str))
1344 |                                     16) 3) 7)
1345 |                    ((0) 0) ((1) 2) ((2) 4) ((3) 5) ((4) 7) ((5) 9) ((6) 11)))
1346 |              (offset (+ 12 (* (string-to-number (match-string 3 str))
1347 |                               12)))
1348 |              (sharp-flat (match-string 2 str)))
1349 |         (+ offset pc
1350 |            (if sharp-flat
1351 |                (if (string= sharp-flat "#") 1 -1)
1352 |              0)))))
1353 | 
1354 | (defun note-to-midi-at-point ()
1355 |   (interactive)
1356 |   (let ((note-str (looking-at "\\([a-gA-G]\\)\\(#\\|b\\)?\\([0-9]\\)")))
1357 |     (if note-str
1358 |         (let* ((data (match-data))
1359 |                (pc (cl-case (mod (- (mod (string-to-char (buffer-substring
1360 |                                                        (nth 2 data)
1361 |                                                        (nth 3 data)))
1362 |                                       16) 3) 7)
1363 |                      ((0) 0) ((1) 2) ((2) 4) ((3) 5) ((4) 7) ((5) 9) ((6) 11)))
1364 |                (offset (+ 12 (* (string-to-number (buffer-substring (nth 6 data)
1365 |                                                                   (nth 7 data)))
1366 |                                 12)))
1367 |                (sharp-flat (and (nth 4 data)
1368 |                                 (buffer-substring (nth 4 data)
1369 |                                                   (nth 5 data)))))
1370 |           (replace-match (number-to-string
1371 |                           (+ offset pc
1372 |                              (if sharp-flat
1373 |                                  (if (string= sharp-flat "#") 1 -1)
1374 |                                0))))))))
1375 | 
1376 | ;; interactive repeated evaluation of defun under point
1377 | (defvar extempore-repeated-eval-timer nil)
1378 | 
1379 | (defun extempore-start-repeated-eval (time-interval)
1380 |   "takes a time interval (in seconds)"
1381 |   (interactive "nTime interval (sec):")
1382 |   (setq extempore-repeated-eval-timer
1383 | 	(run-with-timer 0 time-interval 'extempore-send-definition)))
1384 | 
1385 | (defun extempore-stop-repeated-eval ()
1386 |   (interactive)
1387 |   (cancel-timer extempore-repeated-eval-timer)
1388 |   (setq extempore-repeated-eval-timer nil))
1389 | 
1390 | ;; processing compiler output for .xtmh files
1391 | (defun extempore-process-compiler-output (libname)
1392 |   (interactive "slibname: ")
1393 |   (unless (region-active-p)
1394 |     (error "You need to highlight the compiler output you want to process"))
1395 |   (let ((compiler-output (buffer-substring-no-properties (point) (mark)))
1396 |         (case-fold-search nil))
1397 |     (with-temp-buffer
1398 |       ;; bind-val
1399 |       (insert compiler-output)
1400 |       (goto-char (point-min))
1401 |       (while (search-forward-regexp "^SetValue:  \\(.*\\) >>> \\(.*\\)$" nil t)
1402 |         (replace-match (concat "(bind-lib-val " libname " \\1 \\2)") t))
1403 |       ;; bind-func
1404 |       (goto-char (point-min))
1405 |       (while (search-forward-regexp "^Compiled:  \\(.*\\) >>> \\(.*\\)$" nil t)
1406 |         (replace-match (concat "(bind-lib-func " libname " \\1 \\2)") t))
1407 |       ;; bind-type
1408 |       (goto-char (point-min))
1409 |       (while (search-forward-regexp "^DataType:  \\(.*\\) >>> \\(.*\\)$" nil t)
1410 |         (replace-match (concat "(bind-type \\1 \\2)") t))
1411 |       ;; bind-poly
1412 |       (goto-char (point-min))
1413 |       (while (search-forward-regexp "^Overload:  \\(.*\\) \\(.*\\) >>> \\(.*\\)$" nil t)
1414 |         (replace-match (concat "(bind-poly \\1 \\2)") t))
1415 |       ;; bind-alias (and replace aliases in output)
1416 |       (goto-char (point-min))
1417 |       (while (search-forward-regexp "^SetAlias:  \\(.*\\) >>> \\(.*\\)$" nil t)
1418 |         (let ((alias (match-string 1))
1419 |               (value (match-string 2)))
1420 |           (replace-match (concat "(bind-alias \\1 \\2)") t)
1421 |           (save-excursion
1422 |             (while (search-forward-regexp (format "\\<%s\\>" alias) nil t)
1423 |               (replace-match value t)))))
1424 |       ;; remove scheme stub lines
1425 |       (goto-char (point-min))
1426 |       (while (search-forward-regexp "^There is no scheme stub available for.*\n" nil t)
1427 |         (replace-match (concat "") t))
1428 |       ;; finish up
1429 |       (kill-region (point-min)
1430 |                    (point-max))
1431 |       (message "Processed output copied to kill ring."))))
1432 | 
1433 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1434 | ;; extempore slave buffer minor mode ;;
1435 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1436 | 
1437 | (defvar extempore-sb-mode)
1438 | (define-minor-mode extempore-sb-mode
1439 |   "This minor allows emacs to create a 'slave' buffer on
1440 | another (potentially remote) emacs instance.
1441 | 
1442 | This read-only slave buffer will stay in sync with the master,
1443 | showing the text and current window position of the 'master'
1444 | buffer."
1445 | 
1446 |   :global t
1447 |   :init-value nil
1448 |   :lighter " esb"
1449 |   :keymap nil
1450 |   :group 'extempore
1451 | 
1452 |   (if extempore-sb-mode
1453 |       (call-interactively #'extempore-sb-start)
1454 |     (extempore-sb-stop)))
1455 | 
1456 | (defun extempore-blink-region (overlay start end &optional buf)
1457 |   (move-overlay overlay start end buf)
1458 |   (if extempore-sb-mode
1459 |       (setq extempore-sb-eval-markers (cons start end)))
1460 |   (redisplay)
1461 |   (sleep-for extempore-blink-duration)
1462 |   (delete-overlay overlay))
1463 | 
1464 | 
1465 | (defcustom extempore-sb-server-port 8420
1466 |   "Port for the the extempore slave buffer server."
1467 |   :type 'integer
1468 |   :group 'extempore)
1469 | 
1470 | (defcustom extempore-sb-host-name user-login-name
1471 |   "Host name to use sending slave buffers around.
1472 | 
1473 | If you don't want to be prompted for this name each time, set the
1474 | `extempore-sb-host-name' variable, either through customize or in your
1475 | .emacs"
1476 |   :type 'string
1477 |   :group 'extempore)
1478 | 
1479 | (defvar extempore-sb-refresh-interval 0.1
1480 |   "The refresh interval (in seconds) for syncing the slave buffers")
1481 | 
1482 | (defvar extempore-sb-server nil)
1483 | 
1484 | (defun extempore-sb-stop ()
1485 |   (if extempore-sb-server
1486 |       (progn (delete-process extempore-sb-server)
1487 |              (setq extempore-sb-server nil)
1488 |              (cancel-function-timers #'extempore-sb-sync-slave-buffer)
1489 |              (extempore-sb-delete-all-connections)
1490 |              (message "Stopped esb server."))))
1491 | 
1492 | (defun extempore-sb-start (port)
1493 |   (interactive
1494 |    (list (string-to-number
1495 |           (ido-completing-read
1496 |            "Port: "
1497 |            (list (number-to-string extempore-sb-server-port))
1498 |            nil nil nil nil
1499 |            (number-to-string extempore-sb-server-port)))))
1500 |   (extempore-sb-stop)
1501 |   (extempore-sb-create-server port)
1502 |   (if (null extempore-sb-host-name)
1503 |       (setq extempore-sb-host-name
1504 |             (let ((default-host-name
1505 |                     (if (boundp 'user-login-name)
1506 |                         user-login-name
1507 |                       (if (functionp 'host-name)
1508 |                           (host-name)
1509 |                         "remote-host"))))
1510 |               (ido-completing-read
1511 |                "Your name: "
1512 |                (list default-host-name)
1513 |                nil nil nil nil
1514 |                default-host-name))))
1515 |   (message "Started esb server."))
1516 | 
1517 | (defun extempore-sb-create-server (port)
1518 |   (setq extempore-sb-server
1519 |         (make-network-process
1520 |          :name "extempore-sb-server"
1521 |          :buffer nil
1522 |          :coding 'iso-latin-1
1523 |          :service port
1524 |          :family 'ipv4
1525 |          :server t
1526 |          :sentinel #'extempore-sb-server-sentinel
1527 |          :filter #'extempore-sb-server-filter))
1528 |   (unless extempore-sb-server
1529 |     (message "esb error: couldn't start the server.")
1530 |     extempore-sb-server))
1531 | 
1532 | (defun extempore-sb-cleanup-dead-connections ()
1533 |   (interactive)
1534 |   (dolist (proc (process-list))
1535 |     (if (ignore-errors (string= (substring (process-name proc) 0 13)
1536 |                                 "extempore-sb-"))
1537 |         (unless (member (process-status proc) '(run open))
1538 |           (delete-process proc)))))
1539 | 
1540 | (defun extempore-sb-delete-all-connections ()
1541 |   (interactive)
1542 |   (dolist (proc (process-list))
1543 |     (if (ignore-errors (string= (substring (process-name proc) 0 13)
1544 |                                 "extempore-sb-"))
1545 |         (delete-process proc))))
1546 | 
1547 | (defun extempore-sb-server-sentinel (proc str)
1548 |   (message "esb: %s" str))
1549 | 
1550 | (defun extempore-sb-create-slave-buffer (proc buffer-name buffer-mode)
1551 |   (let ((buf (get-buffer-create buffer-name)))
1552 |     (set-process-buffer proc buf)
1553 |     (with-current-buffer buf
1554 |       (buffer-disable-undo)
1555 |       (read-only-mode 1)
1556 |       (if (fboundp buffer-mode) (funcall buffer-mode)))
1557 |     (message "esb: created slave buffer %s" buffer-name)
1558 |     buf))
1559 | 
1560 | (defun extempore-sb-update-slave-buffer (buf buffer-text pt eval-region)
1561 |   (with-current-buffer buf
1562 |     (let ((inhibit-read-only t)
1563 |           (curr-pt (point)))
1564 |       (delete-region (point-min) (point-max))
1565 |       (insert buffer-text)
1566 |       ;; if slave buffer is visible, and is not the current buffer,
1567 |       ;; have if follow the master (remote) cursor position
1568 |       (if (get-buffer-window buf)
1569 |           (progn (set-window-point (get-buffer-window buf)
1570 |                                    (if (eq (window-buffer) buf) curr-pt pt))
1571 |                  (if eval-region
1572 |                      (extempore-blink-region extempore-sb-blink-overlay
1573 |                                                   (car eval-region)
1574 |                                                   (cdr eval-region)
1575 |                                                   buf)))))))
1576 | 
1577 | ;; `extempore-sb-partial-data' is for handling buffer text recieved by
1578 | ;; the filter in multiple chunks
1579 | (make-variable-buffer-local 'extempore-sb-partial-data)
1580 | (defvar extempore-sb-partial-data nil)
1581 | 
1582 | (defun extempore-sb-server-filter (proc str)
1583 |   (let ((proc-buf (process-buffer proc)))
1584 |     (if (null proc-buf)
1585 |         (let ((data (ignore-errors (read str))))
1586 | 	  (if (and data (string= (car data) "esb-data"))
1587 | 	      (extempore-sb-create-slave-buffer proc (cadr data) (nth 2 data))))
1588 |       (with-current-buffer proc-buf
1589 |         (setq extempore-sb-partial-data (concat extempore-sb-partial-data str))
1590 | 	(if (not (ignore-errors (string= (substring extempore-sb-partial-data 0 11)
1591 | 					 "(\"esb-data\"")))
1592 | 	    (setq extempore-sb-partial-data nil)
1593 | 	  (let ((data (ignore-errors (read extempore-sb-partial-data))))
1594 | 	    (if data
1595 | 		(progn (setq extempore-sb-partial-data nil)
1596 | 		       (extempore-sb-dispatch-received-data proc-buf (cdr data))))))))))
1597 | 
1598 | ;; data list (only the cdr of this list passed to the dispatch function)
1599 | ;; ("esb-data" buffer-name major-mode position buffer-text eval-markers)
1600 | 
1601 | (defun extempore-sb-dispatch-received-data (buf data)
1602 |   (cond
1603 |    ((not (and (sequencep data) (= (length data) 5)))
1604 |     (setq extempore-sb-partial-data nil)
1605 |     (message "esb error: malformed buffer state recieved from remote host."))
1606 |    ((string= (buffer-name buf)
1607 |              (car data))
1608 |     (extempore-sb-update-slave-buffer buf
1609 |                                       (nth 3 data)
1610 |                                       (nth 2 data)
1611 |                                       (nth 4 data)))
1612 |    (t (message "esb error: received state from wrong buffer."))))
1613 | 
1614 | (defun extempore-sb-slave-buffer-name (buffer-name host-name)
1615 |   (concat buffer-name "@" host-name "<slave>"))
1616 | 
1617 | (defun extempore-sb-sync-slave-buffer (buf)
1618 |   (with-current-buffer buf
1619 |     (let ((proc (get-buffer-process buf)))
1620 |       (if proc
1621 |           (progn
1622 |             (process-send-string
1623 |              proc
1624 |              (prin1-to-string
1625 |               (list "esb-data"
1626 |                     (extempore-sb-slave-buffer-name
1627 |                      (buffer-name)
1628 |                      extempore-sb-host-name)
1629 |                     major-mode
1630 |                     (point)
1631 |                     (buffer-substring-no-properties (point-min) (point-max))
1632 |                     extempore-sb-eval-markers)))
1633 |             (setq extempore-sb-eval-markers nil))))))
1634 | 
1635 | (defun extempore-sb-setup-buffer (buf host port)
1636 |   (let ((proc (open-network-stream
1637 |                (concat "extempore-sb-push-to-" host ":" (number-to-string port))
1638 |                buf host port)))
1639 |     (if proc
1640 |         (progn
1641 |           (set-process-sentinel proc #'extempore-sb-server-sentinel)
1642 |           (with-current-buffer buf
1643 |             (process-send-string
1644 |              proc
1645 |              (prin1-to-string
1646 | 	      (list "esb-data"
1647 | 		    (extempore-sb-slave-buffer-name
1648 |                      (buffer-name)
1649 |                      extempore-sb-host-name)
1650 |                     major-mode
1651 |                     0
1652 |                     "setup"))))
1653 |           (message "esb: created slave buffer on %s:%s" host port))
1654 |       (message "esb: couldn't connect to %s:%s" host port))))
1655 | 
1656 | (make-variable-buffer-local 'extempore-sb-push-timer)
1657 | 
1658 | (defvar extempore-sb-push-timer)
1659 | (defun extempore-sb-start-timer (buf time-interval)
1660 |   (setq extempore-sb-push-timer
1661 |         (run-with-timer 0 time-interval #'extempore-sb-sync-slave-buffer buf)))
1662 | 
1663 | (defun extempore-sb-push-current-buffer (host port)
1664 |   (interactive
1665 |    (let ((read-host (ido-completing-read
1666 |                      "Hostname: "
1667 |                      (list "localhost")
1668 |                      nil nil nil nil
1669 |                      "localhost"))
1670 |          (read-port (string-to-number
1671 |                      (ido-completing-read
1672 |                       "Port: "
1673 |                       (list (number-to-string extempore-sb-server-port))
1674 |                       nil nil nil nil
1675 |                       (number-to-string extempore-sb-server-port)))))
1676 |      (list read-host read-port)))
1677 |   (extempore-sb-setup-buffer (current-buffer) host port)
1678 |   (extempore-sb-start-timer (current-buffer) extempore-sb-refresh-interval))
1679 | 
1680 | (defun extempore-sb-stop-pushing-current-buffer ()
1681 |   (interactive)
1682 |   (if (get-buffer-process (current-buffer))
1683 |       (progn (delete-process nil)
1684 |              (if extempore-sb-push-timer
1685 |                  (progn (cancel-timer extempore-sb-push-timer)
1686 |                         (setq extempore-sb-push-timer nil)))
1687 |              (message "esb: stopped syncing buffer: %s" (buffer-name)))
1688 |     (message "esb: not currently pushing this buffer")))
1689 | 
1690 | (defun extempore-sb-slave-buffer-p (buf)
1691 |   (let ((proc (get-buffer-process buf)))
1692 |     (if (and proc
1693 |              (ignore-errors (string= (substring (process-name proc) 0 13)
1694 |                                      "extempore-sb-")))
1695 |         t
1696 |       nil)))
1697 | 
1698 | (defun extempore-sb-toggle-current-buffer ()
1699 |   (interactive)
1700 |   (if (extempore-sb-slave-buffer-p (current-buffer))
1701 |       (extempore-sb-stop-pushing-current-buffer)
1702 |     (call-interactively #'extempore-sb-push-current-buffer)))
1703 | 
1704 | ;;;;;;;;;;;;;;;;;;;;;;
1705 | ;; extempore-parser ;;
1706 | ;;;;;;;;;;;;;;;;;;;;;;
1707 | 
1708 | ;; stuff for parsing C header files
1709 | 
1710 | ;; comments
1711 | 
1712 | (defun extempore-parser-handle-c-comments ()
1713 |   (interactive)
1714 |   (while (re-search-forward "/\\*" nil t)
1715 |     (if (not (looking-back ";;.*" (line-beginning-position)))
1716 |         (let ((comment-begin (- (point) 2)))
1717 |           (re-search-forward "\\*/" nil t)
1718 |           (comment-region comment-begin (point))))))
1719 | 
1720 | (defun extempore-parser-remove-ifdef-guards ()
1721 |   (interactive)
1722 |   (while (re-search-forward (regexp-opt (list "#if" "#ifdef" "#ifndef" "#else" "#elif" "#end" "#endif")) nil t)
1723 |     (if (not (looking-back ";;.*" (line-beginning-position)))
1724 |         (save-excursion
1725 |           (beginning-of-line)
1726 |           (insert ";; ")))))
1727 | 
1728 | ;; #define
1729 | 
1730 | (defun extempore-parser-translate-define (define-line)
1731 |   (let ((parsed-def (cl-remove-if (lambda (s) (string= s "#define"))
1732 |                                   (split-string define-line " " t))))
1733 |     (if (= (length parsed-def) 1)
1734 |         (concat ";; " define-line)
1735 |       (format "(bind-val %s i32 %s)"
1736 |               (car parsed-def)
1737 |               (let ((val-string (cadr parsed-def)))
1738 |                 (if (string-match "^0x" val-string)
1739 |                     (concat "#" (substring val-string 1))
1740 |                   val-string))))))
1741 | 
1742 | (defun extempore-parser-process-defines ()
1743 |   (interactive)
1744 |   (while (re-search-forward "#define" nil t)
1745 |     (if (not (looking-back ";;.*" (line-beginning-position)))
1746 |         (progn
1747 |           (beginning-of-line)
1748 |           (kill-line)
1749 |           (insert (extempore-parser-translate-define (current-kill 0)))))))
1750 | 
1751 | ;; function prototypes
1752 | 
1753 | (defun extempore-parser-extract-pointer-string (type-str)
1754 |   ;; TODO: should these numbers be multiplied, rather than added, in
1755 |   ;; the case of e.g. **var[][]
1756 |   (make-string (+ (length (and (string-match "*+" type-str)
1757 |                                (match-string-no-properties 0 type-str)))
1758 |                   (/ (length (and (string-match "\\(\\[\\]\\)+" type-str)
1759 |                                   (match-string-no-properties 0 type-str)))
1760 |                      2))
1761 |                ?\*))
1762 | 
1763 | (defun extempore-parser-map-c-type-to-xtlang-type (c-type)
1764 |   "currently assumes x86_64 architecture - and maps unsigned type to signed types (since xtlang has no unsigned types)"
1765 |   (let ((type-alist '(("char" . "i8")
1766 |                       ("unsigned char" . "i8")
1767 |                       ("short" . "i16")
1768 |                       ("unsigned short" . "i16")
1769 |                       ("int" . "i32")
1770 |                       ("unsigned int" . "i32")
1771 |                       ("long" . "i32")
1772 |                       ("unsigned long" . "i32")
1773 |                       ("long long" . "i64")
1774 |                       ("unsigned long long" . "i64")
1775 |                       ("int8_t" . "i8")
1776 |                       ("uint8_t" . "i8")
1777 |                       ("int16_t" . "i16")
1778 |                       ("uint16_t" . "i16")
1779 |                       ("int32_t" . "i32")
1780 |                       ("uint32_t" . "i32")
1781 |                       ("int64_t" . "i64")
1782 |                       ("uint64_t" . "i64")
1783 |                       ("float" . "float")
1784 |                       ("double" . "double")))
1785 |         (pointer-string (extempore-parser-extract-pointer-string c-type))
1786 |         (base-type (replace-regexp-in-string
1787 |                     "[[]]" "" (replace-regexp-in-string "[*]" "" c-type))))
1788 |     (concat (or (cdr-safe (assoc base-type type-alist))
1789 |                 base-type)
1790 |             pointer-string)))
1791 | 
1792 | (defun extempore-parser-type-from-function-arg (arg-str)
1793 |   (let ((elements (cl-remove-if (lambda (s) (member s (list "const" "struct")))
1794 |                                 (split-string arg-str " " t))))
1795 |     (cond ((= (length elements) 1)
1796 |            (extempore-parser-map-c-type-to-xtlang-type (car elements)))
1797 |           ((= (length elements) 2)
1798 |            (concat (extempore-parser-map-c-type-to-xtlang-type (car elements))
1799 |                    (extempore-parser-extract-pointer-string (cadr elements))))
1800 |           ((= (length elements) 3)
1801 |            (concat (extempore-parser-map-c-type-to-xtlang-type
1802 |                     (concat (car elements) " " (cadr elements)))
1803 |                    (extempore-parser-extract-pointer-string (nth 2 elements))))
1804 |           (t (message "cannot parse arg string: \"%s\"" arg-str)
1805 |              ""))))
1806 | 
1807 | (defun extempore-parser-parse-all-c-args (all-args)
1808 |   (if (or (string= all-args "")
1809 |           (string= all-args "void"))
1810 |       ""
1811 |     (concat ","
1812 |             (mapconcat #'extempore-parser-type-from-function-arg
1813 |                        (split-string all-args ",")
1814 |                        ","))))
1815 | 
1816 | ;; ;; here are some examples of strings which should parse correctly
1817 | ;; (extempore-parser-parse-all-c-args "GLfloat size")
1818 | ;; (extempore-parser-parse-all-c-args "GLsizei length, const GLvoid *pointer")
1819 | ;; (extempore-parser-parse-all-c-args "void")
1820 | ;; (extempore-parser-parse-all-c-args "const GLint *")
1821 | ;; (extempore-parser-parse-all-c-args "GLenum, const GLint *")
1822 | ;; (extempore-parser-parse-all-c-args "GLenum, GLenum, GLenum, GLenum, GLenum, GLenum")
1823 | ;; (extempore-parser-parse-all-c-args "")
1824 | ;; (extempore-parser-parse-all-c-args "float part[], float q[], float qm, int nop, int idimp, int nxv, int nyv")
1825 | ;; (extempore-parser-parse-all-c-args "unsigned short GLhalfARB")
1826 | ;; (extempore-parser-parse-all-c-args "GLFWmonitor* monitor, int* count")
1827 | 
1828 | ;; doesn't yet handle nested function calls
1829 | (defun extempore-parser-process-function-call ()
1830 |   (interactive)
1831 |   (if (re-search-forward "\s*\\([^(]+\\)(\\([^(]*?\\));?" nil :noerror)
1832 |       (progn
1833 |         (replace-match
1834 |          (save-match-data
1835 |            (format "(%s %s)"
1836 |                    (string-trim-left (match-string-no-properties 1))
1837 |                    (replace-regexp-in-string "[, ]+" " " (match-string-no-properties 2))))
1838 |          nil :literal)
1839 |         (indent-for-tab-command))))
1840 | 
1841 | (defun extempore-parser-process-function-arg-names ()
1842 |   (interactive)
1843 |   (if (re-search-forward "\s*(\\([^(]*?\\));?" nil :noerror)
1844 |       (progn
1845 |         (replace-match
1846 |          (save-match-data
1847 |            (format "(%s)"
1848 |                    (mapconcat (lambda (str) (car-safe (reverse (split-string str "[ \f\t\n\r\v*]+" :omit-nulls))))
1849 |                               (split-string (match-string-no-properties 1) "[][,]+" :omit-nulls)
1850 |                               " ")))
1851 |          nil :literal)
1852 |         (indent-for-tab-command))))
1853 | 
1854 | (defun extempore-parser-process-function-prototypes (libname ignore-tokens)
1855 |   (interactive
1856 |    (list (read-from-minibuffer "libname: ")
1857 |          (read-from-minibuffer "tokens to ignore: ")))
1858 |   (while (re-search-forward (format "^%s[ ]?\\(?:const \\|unsigned \\|extern \\)*\\([\\*[:word:]_]*\\) \\([\\*[:word:]_]*\\)[ ]?(\\(\\(?:.\\|\n\\)*?\\))"
1859 |                                     (if (string= ignore-tokens "")
1860 |                                         ""
1861 |                                       (concat (regexp-opt (split-string ignore-tokens " " t)) "?")))
1862 |                             nil
1863 |                             t)
1864 |     (if (not (looking-back ";;.*" (line-beginning-position)))
1865 |         (let* ((prototype-beginning (match-beginning 0))
1866 |                (return-type (match-string-no-properties 1))
1867 |                (function-name (match-string-no-properties 2))
1868 |                (arg-string (extempore-parser-parse-all-c-args (replace-regexp-in-string "[\n]" "" (match-string-no-properties 3))))
1869 |                (function-name-pointer-prefix (extempore-parser-extract-pointer-string function-name)))
1870 |           (kill-region prototype-beginning (line-end-position))
1871 |           (insert (format "(bind-lib %s %s [%s%s]*)"
1872 |                           libname
1873 |                           (substring function-name (length function-name-pointer-prefix))
1874 |                           (extempore-parser-map-c-type-to-xtlang-type
1875 |                            (concat return-type function-name-pointer-prefix))
1876 |                           arg-string))))))
1877 | 
1878 | ;; typedef
1879 | 
1880 | ;; only single-line, for multi-line example see
1881 | ;; `extempore-parser-process-function-prototypes'
1882 | (defun extempore-parser-process-function-pointer-typedefs ()
1883 |   (interactive)
1884 |   (while (re-search-forward "^typedef \\([\\*[:word:]]*\\) (\\(\\*[ ]?[[:word:]]*\\))[ ]?(\\(.*\\))"
1885 |                             nil t)
1886 |     (if (not (looking-back ";;.*" (line-beginning-position)))
1887 |         (let ((typedef-beginning (match-beginning 0))
1888 |               (return-type (match-string-no-properties 1))
1889 |               (alias-name (replace-regexp-in-string "[* ]" "" (match-string-no-properties 2)))
1890 |               (arg-string (extempore-parser-parse-all-c-args (replace-regexp-in-string "[\n]" "" (match-string-no-properties 3)))))
1891 |           (kill-region typedef-beginning (line-end-position))
1892 |           (insert (format "(bind-alias %s [%s%s]*)"
1893 |                           alias-name
1894 |                           return-type
1895 |                           arg-string))))))
1896 | 
1897 | ;; this is just for simple ones
1898 | (defun extempore-parser-process-typedefs ()
1899 |   (interactive)
1900 |   (while (re-search-forward "^typedef " nil t)
1901 |     (if (not (looking-back ";;.*" (line-beginning-position)))
1902 |         (progn (kill-region (match-beginning 0) (line-end-position))
1903 |                (let* ((typedef-string (replace-regexp-in-string ";" "" (substring (current-kill 0) 8)))
1904 |                       (newdef (car (reverse (split-string typedef-string " " t))))
1905 |                       (ptr-string (extempore-parser-extract-pointer-string newdef)))
1906 |                  (insert (format "(bind-alias %s %s)"
1907 |                                  (substring newdef (length ptr-string))
1908 |                                  (extempore-parser-type-from-function-arg typedef-string))))))))
1909 | 
1910 | (defun extempore-parser-process-current-buffer ()
1911 |   (interactive)
1912 |   (dolist (parse-fn (list #'extempore-parser-remove-ifdef-guards
1913 |                           #'extempore-parser-handle-c-comments
1914 |                           #'extempore-parser-process-defines
1915 |                           #'extempore-parser-process-typedefs
1916 |                           #'extempore-parser-process-function-pointer-typedefs
1917 |                           #'extempore-parser-process-function-prototypes))
1918 |     (goto-char (point-min))
1919 |     (call-interactively parse-fn)))
1920 | 
1921 | (provide 'extempore-mode)
1922 | 
1923 | ;;; extempore-mode.el ends here
1924 | 


--------------------------------------------------------------------------------