code.delx.au - gnu-emacs-elpa/blob - packages/shen-mode/inf-shen.el

   1 ;;; inferior-shen-mode --- an inferior-shen mode
   2
   3 ;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
   4
   5 ;; Authors: Michael Ilseman, Eric Schulte <schulte.eric@gmail.com>
   6 ;; Version: 0.1
   7 ;; Keywords: languages, shen, comint
   8 ;; Description: A major mode for editing shen source code
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; This file defines an inferior Shen mode.
  28
  29 ;;; Code:
  30 (eval-when-compile (require 'cl))
  31 (require 'comint)
  32 (require 'shen-mode)
  33
  34 ;;;###autoload
  35 (defvar inferior-shen-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'"
  36   "*What not to save on inferior Shen's input history.
  37 Input matching this regexp is not saved on the input history in Inferior Shen
  38 mode.  Default is whitespace followed by 0 or 1 single-letter colon-keyword
  39 \(as in :a, :c, etc.)")
  40
  41 (defvar inferior-shen-mode-map
  42   (let ((map (make-sparse-keymap)))
  43     (set-keymap-parent map comint-mode-map)
  44     ;; (set-keymap-parent inferior-shen-mode-map shen-mode-shared-map)
  45     (define-key map "\C-x\C-e" 'shen-eval-last-sexp)
  46     (define-key map "\C-c\C-l" 'shen-load-file)
  47     (define-key map "\C-c\C-k" 'shen-compile-file)
  48     (define-key map "\C-c\C-a" 'shen-show-arglist)
  49     (define-key map "\C-c\C-d" 'shen-describe-sym)
  50     (define-key map "\C-c\C-f" 'shen-show-function-documentation)
  51     (define-key map "\C-c\C-v" 'shen-show-variable-documentation)
  52     map))
  53
  54 ;; These commands augment Shen mode, so you can process Shen code in
  55 ;; the source files.
  56 (define-key shen-mode-map "\M-\C-x"  'shen-eval-defun)     ; Gnu convention
  57 (define-key shen-mode-map "\C-x\C-e" 'shen-eval-last-sexp) ; Gnu convention
  58 (define-key shen-mode-map "\C-c\C-e" 'shen-eval-defun)
  59 (define-key shen-mode-map "\C-c\C-r" 'shen-eval-region)
  60 (define-key shen-mode-map "\C-c\C-c" 'shen-compile-defun)
  61 (define-key shen-mode-map "\C-c\C-z" 'switch-to-shen)
  62 (define-key shen-mode-map "\C-c\C-l" 'shen-load-file)
  63 (define-key shen-mode-map "\C-c\C-k" 'shen-compile-file)  ; "kompile" file
  64 (define-key shen-mode-map "\C-c\C-a" 'shen-show-arglist)
  65 (define-key shen-mode-map "\C-c\C-d" 'shen-describe-sym)
  66 (define-key shen-mode-map "\C-c\C-f" 'shen-show-function-documentation)
  67 (define-key shen-mode-map "\C-c\C-v" 'shen-show-variable-documentation)
  68
  69
  70 ;; This function exists for backwards compatibility.
  71 ;; Previous versions of this package bound commands to C-c <letter>
  72 ;; bindings, which is not allowed by the gnumacs standard.
  73
  74 ;;  "This function binds many inferior-shen commands to C-c <letter> bindings,
  75 ;;where they are more accessible. C-c <letter> bindings are reserved for the
  76 ;;user, so these bindings are non-standard. If you want them, you should
  77 ;;have this function called by the inferior-shen-load-hook:
  78 ;;    (setq inferior-shen-load-hook '(inferior-shen-install-letter-bindings))
  79 ;;You can modify this function to install just the bindings you want."
  80 (defun inferior-shen-install-letter-bindings ()
  81   (define-key shen-mode-map "\C-ce" 'shen-eval-defun-and-go)
  82   (define-key shen-mode-map "\C-cr" 'shen-eval-region-and-go)
  83   (define-key shen-mode-map "\C-cc" 'shen-compile-defun-and-go)
  84   (define-key shen-mode-map "\C-cz" 'switch-to-shen)
  85   (define-key shen-mode-map "\C-cl" 'shen-load-file)
  86   (define-key shen-mode-map "\C-ck" 'shen-compile-file)
  87   (define-key shen-mode-map "\C-ca" 'shen-show-arglist)
  88   (define-key shen-mode-map "\C-cd" 'shen-describe-sym)
  89   (define-key shen-mode-map "\C-cf" 'shen-show-function-documentation)
  90   (define-key shen-mode-map "\C-cv" 'shen-show-variable-documentation)
  91
  92   (define-key inferior-shen-mode-map "\C-cl" 'shen-load-file)
  93   (define-key inferior-shen-mode-map "\C-ck" 'shen-compile-file)
  94   (define-key inferior-shen-mode-map "\C-ca" 'shen-show-arglist)
  95   (define-key inferior-shen-mode-map "\C-cd" 'shen-describe-sym)
  96   (define-key inferior-shen-mode-map "\C-cf" 'shen-show-function-documentation)
  97   (define-key inferior-shen-mode-map "\C-cv"
  98     'shen-show-variable-documentation))
  99
 100
 101 (defvar inferior-shen-program "shen"
 102   "*Program name for invoking an inferior Shen with for Inferior Shen mode.")
 103
 104 (defvar inferior-shen-load-command "(load \"%s\")\n"
 105   "*Format-string for building a Shen expression to load a file.
 106 This format string should use `%s' to substitute a file name
 107 and should result in a Shen expression that will command the inferior Shen
 108 to load that file.  The default works acceptably on most Shens.
 109 The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\n\"
 110 produces cosmetically superior output for this application,
 111 but it works only in Common Shen.")
 112
 113 (defvar inferior-shen-prompt "^[^> \n]*>+:? *"
 114   "Regexp to recognise prompts in the Inferior Shen mode.
 115 Defaults to \"^[^> \\n]*>+:? *\", which works pretty good for Lucid, kcl,
 116 and franz.  This variable is used to initialize `comint-prompt-regexp' in the
 117 Inferior Shen buffer.
 118
 119 This variable is only used if the variable
 120 `comint-use-prompt-regexp-instead-of-fields' is non-nil.
 121
 122 More precise choices:
 123 Lucid Common Shen: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
 124 franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
 125 kcl: \"^>+ *\"
 126
 127 This is a fine thing to set in your .emacs file.")
 128
 129 (defvar inferior-shen-buffer nil "*The current inferior-shen process buffer.
 130
 131 MULTIPLE PROCESS SUPPORT
 132 ===========================================================================
 133 To run multiple Shen processes, you start the first up
 134 with \\[inferior-shen].  It will be in a buffer named `*inferior-shen*'.
 135 Rename this buffer with \\[rename-buffer].  You may now start up a new
 136 process with another \\[inferior-shen].  It will be in a new buffer,
 137 named `*inferior-shen*'.  You can switch between the different process
 138 buffers with \\[switch-to-buffer].
 139
 140 Commands that send text from source buffers to Shen processes --
 141 like `shen-eval-defun' or `shen-show-arglist' -- have to choose a process
 142 to send to, when you have more than one Shen process around.  This
 143 is determined by the global variable `inferior-shen-buffer'.  Suppose you
 144 have three inferior Shens running:
 145     Buffer              Process
 146     foo                 inferior-shen
 147     bar                 inferior-shen<2>
 148     *inferior-shen*     inferior-shen<3>
 149 If you do a \\[shen-eval-defun] command on some Shen source code,
 150 what process do you send it to?
 151
 152 - If you're in a process buffer (foo, bar, or *inferior-shen*),
 153   you send it to that process.
 154 - If you're in some other buffer (e.g., a source file), you
 155   send it to the process attached to buffer `inferior-shen-buffer'.
 156 This process selection is performed by function `inferior-shen-proc'.
 157
 158 Whenever \\[inferior-shen] fires up a new process, it resets
 159 `inferior-shen-buffer' to be the new process's buffer.  If you only run
 160 one process, this does the right thing.  If you run multiple
 161 processes, you can change `inferior-shen-buffer' to another process
 162 buffer with \\[set-variable].")
 163
 164 (defvar inferior-shen-mode-hook '()
 165   "*Hook for customising Inferior Shen mode.")
 166
 167 (put 'inferior-shen-mode 'mode-class 'special)
 168
 169 (define-derived-mode inferior-shen-mode comint-mode "Inferior Shen"
 170   "Major mode for interacting with an inferior Shen process.
 171 Runs a Shen interpreter as a subprocess of Emacs, with Shen I/O through an
 172 Emacs buffer.  Variable `inferior-shen-program' controls which Shen interpreter
 173 is run.  Variables `inferior-shen-prompt', `inferior-shen-filter-regexp' and
 174 `inferior-shen-load-command' can customize this mode for different Shen
 175 interpreters.
 176
 177 For information on running multiple processes in multiple buffers, see
 178 documentation for variable `inferior-shen-buffer'.
 179
 180 \\{inferior-shen-mode-map}
 181
 182 Customisation: Entry to this mode runs the hooks on `comint-mode-hook' and
 183 `inferior-shen-mode-hook' (in that order).
 184
 185 You can send text to the inferior Shen process from other buffers containing
 186 Shen source.
 187     switch-to-shen switches the current buffer to the Shen process buffer.
 188     shen-eval-defun sends the current defun to the Shen process.
 189     shen-compile-defun compiles the current defun.
 190     shen-eval-region sends the current region to the Shen process.
 191     shen-compile-region compiles the current region.
 192
 193     Prefixing the shen-eval/compile-defun/region commands with
 194     a \\[universal-argument] causes a switch to the Shen process buffer after sending
 195     the text.
 196
 197 Commands:
 198 Return after the end of the process' output sends the text from the
 199     end of process to point.
 200 Return before the end of the process' output copies the sexp ending at point
 201     to the end of the process' output, and sends it.
 202 Delete converts tabs to spaces as it moves back.
 203 Tab indents for Shen; with argument, shifts rest
 204     of expression rigidly with the current line.
 205 C-M-q does Tab on each line starting within following expression.
 206 Paragraphs are separated only by blank lines.  Semicolons start comments.
 207 If you accidentally suspend your process, use \\[comint-continue-subjob]
 208 to continue it."
 209   (set (make-local-variable 'font-lock-defaults) '(shen-font-lock-keywords))
 210   (setq comint-prompt-regexp inferior-shen-prompt)
 211   (setq mode-line-process '(":%s"))
 212
 213   (setq comint-get-old-input (function shen-get-old-input))
 214   (setq comint-input-filter (function shen-input-filter)))
 215
 216 (defun shen-get-old-input ()
 217   "Return a string containing the sexp ending at point."
 218   (save-excursion
 219     (let ((end (point)))
 220       (backward-sexp)
 221       (buffer-substring (point) end))))
 222
 223 (defun shen-input-filter (str)
 224   "t if STR does not match `inferior-shen-filter-regexp'."
 225   (not (string-match inferior-shen-filter-regexp str)))
 226
 227 ;;;###autoload
 228 (defun inferior-shen (cmd)
 229   "Run an inferior Shen process, input and output via buffer `*inferior-shen*'.
 230 If there is a process already running in `*inferior-shen*', just switch
 231 to that buffer.
 232 With argument, allows you to edit the command line (default is value
 233 of `inferior-shen-program').  Runs the hooks from
 234 `inferior-shen-mode-hook' (after the `comint-mode-hook' is run).
 235 \(Type \\[describe-mode] in the process buffer for a list of commands.)"
 236   (interactive (list (if current-prefix-arg
 237                          (read-string "Run shen: " inferior-shen-program)
 238                        inferior-shen-program)))
 239   (if (not (comint-check-proc "*inferior-shen*"))
 240       (let ((cmdlist (split-string cmd)))
 241         (set-buffer (apply (function make-comint)
 242                            "inferior-shen" (car cmdlist) nil (cdr cmdlist)))
 243         (inferior-shen-mode)))
 244   (setq inferior-shen-buffer "*inferior-shen*")
 245   (pop-to-buffer "*inferior-shen*"))
 246 ;;;###autoload (add-hook 'same-window-buffer-names "*inferior-shen*")
 247
 248 ;;;###autoload
 249 (defalias 'run-shen 'inferior-shen)
 250
 251 (defcustom shen-pre-eval-hook '()
 252   "Hook to run on code before sending it to the inferior-shen-process.
 253 Functions on this hook will be called with an active region
 254 containing the shen source code about to be evaluated.")
 255
 256 (defun shen-remember-functions (start end)
 257   "Add functions defined between START and END to `shen-functions'."
 258   (interactive "r")
 259   (flet ((clean (text)
 260                 (when text
 261                   (set-text-properties 0 (length text) nil text) text)))
 262     (save-excursion
 263       (goto-char start)
 264       (let ((re (concat
 265                  "^(define[ \t]+\\(.+\\)[\n\r]" ; function name
 266                  "\\([ \t]*\\\\\\*[ \t]*\\([^\000]+?\\)[ \t]*\\*\\\\\\)?" ; doc
 267                  "[\n\r]?[ \t]*\\({\\(.+\\)}\\)?"))) ; type
 268         (while (re-search-forward re end t)
 269           (let ((name (intern (match-string 1)))
 270                 (doc (clean (match-string 3)))
 271                 (type (clean (match-string 5))))
 272             (add-to-list 'shen-functions (list name type doc))))))))
 273
 274 (add-hook 'shen-pre-eval-hook #'shen-remember-functions)
 275
 276 (defun check-balanced-parens (start end)
 277   "Check if parentheses in the region are balanced."
 278   (save-restriction (save-excursion
 279     (let ((deactivate-mark nil))
 280       (condition-case _
 281           (progn (narrow-to-region start end) (goto-char (point-min))
 282                  (while (/= 0 (- (point) (forward-list)))) t)
 283           (scan-error (signal 'scan-error '("Parentheses not balanced."))))))))
 284
 285 (add-hook 'shen-pre-eval-hook
 286           (lambda (start end)
 287             (condition-case err (check-balanced-parens start end)
 288               (error (unless (y-or-n-p (format "%s Eval anyway ?"
 289                                                (error-message-string err)))
 290                        (signal 'scan-error err))))))
 291
 292 (defun shen-eval-region (start end &optional and-go)
 293   "Send the current region to the inferior Shen process.
 294 Prefix argument means switch to the Shen buffer afterwards."
 295   (interactive "r\nP")
 296   (let ((before-input (marker-position (process-mark (inferior-shen-proc))))
 297         result)
 298
 299     (run-hook-with-args 'shen-pre-eval-hook start end)
 300     (comint-send-region (inferior-shen-proc) start end)
 301     (comint-send-string (inferior-shen-proc) "\n")
 302     (accept-process-output (inferior-shen-proc))
 303     (sit-for 0)
 304     (with-current-buffer inferior-shen-buffer
 305       (goto-char before-input)
 306       (setq result (buffer-substring (point) (point-at-eol)))
 307       (message "%s" result)
 308       (goto-char (process-mark (inferior-shen-proc))))
 309     (if and-go (switch-to-shen t))
 310     result))
 311
 312 (defun shen-eval-defun (&optional and-go)
 313   "Send the current defun to the inferior Shen process.
 314 Prefix argument means switch to the Shen buffer afterwards."
 315   (interactive "P")
 316   (let (result)
 317     (save-excursion
 318       (end-of-defun)
 319       (skip-chars-backward " \t\n\r\f") ;  Makes allegro happy
 320       (let ((end (point)))
 321         (beginning-of-defun)
 322         (setq result (shen-eval-region (point) end))))
 323     (if and-go (switch-to-shen t))
 324     result))
 325
 326 (defun shen-eval-last-sexp (&optional and-go)
 327   "Send the previous sexp to the inferior Shen process.
 328 Prefix argument means switch to the Shen buffer afterwards."
 329   (interactive "P")
 330   (shen-eval-region (save-excursion (backward-sexp) (point)) (point) and-go))
 331
 332 ;;; Common Shen COMPILE sux.
 333 (defun shen-compile-region (start end &optional and-go)
 334   "Compile the current region in the inferior Shen process.
 335 Prefix argument means switch to the Shen buffer afterwards."
 336   (interactive "r\nP")
 337   (comint-send-string
 338    (inferior-shen-proc)
 339    (format "(funcall (compile nil `(lambda () (progn 'compile %s))))\n"
 340            (buffer-substring start end)))
 341   (if and-go (switch-to-shen t)))
 342
 343 (defun shen-compile-defun (&optional and-go)
 344   "Compile the current defun in the inferior Shen process.
 345 Prefix argument means switch to the Shen buffer afterwards."
 346   (interactive "P")
 347   (save-excursion
 348     (end-of-defun)
 349     (skip-chars-backward " \t\n\r\f") ;  Makes allegro happy
 350     (let ((e (point)))
 351       (beginning-of-defun)
 352       (shen-compile-region (point) e)))
 353   (if and-go (switch-to-shen t)))
 354
 355 (defun switch-to-shen (eob-p)
 356   "Switch to the inferior Shen process buffer.
 357 With argument, positions cursor at end of buffer."
 358   (interactive "P")
 359   (if (get-buffer-process inferior-shen-buffer)
 360       (let ((pop-up-frames
 361              ;; Be willing to use another frame
 362              ;; that already has the window in it.
 363              (or pop-up-frames
 364                  (get-buffer-window inferior-shen-buffer t))))
 365         (pop-to-buffer inferior-shen-buffer))
 366       (run-shen inferior-shen-program))
 367   (when eob-p
 368          (push-mark)
 369     (goto-char (point-max))))
 370
 371
 372 ;; Now that shen-compile/eval-defun/region takes an optional prefix arg,
 373 ;; these commands are redundant. But they are kept around for the user
 374 ;; to bind if he wishes, for backwards functionality, and because it's
 375 ;; easier to type C-c e than C-u C-c C-e.
 376 (defun shen-eval-region-and-go (start end)
 377   "Send the current region to the inferior Shen, and switch to its buffer."
 378   (interactive "r")
 379   (shen-eval-region start end t))
 380
 381 (defun shen-eval-defun-and-go ()
 382   "Send the current defun to the inferior Shen, and switch to its buffer."
 383   (interactive)
 384   (shen-eval-defun t))
 385
 386 (defun shen-compile-region-and-go (start end)
 387   "Compile the current region in the inferior Shen, and switch to its buffer."
 388   (interactive "r")
 389   (shen-compile-region start end t))
 390
 391 (defun shen-compile-defun-and-go ()
 392   "Compile the current defun in the inferior Shen, and switch to its buffer."
 393   (interactive)
 394   (shen-compile-defun t))
 395
 396 ;; A version of the form in H. Shevis' soar-mode.el package. Less robust.
 397 ;; (defun shen-compile-sexp (start end)
 398 ;;   "Compile the s-expression bounded by START and END in the inferior shen.
 399 ;; If the sexp isn't a DEFUN form, it is evaluated instead."
 400 ;;   (cond ((looking-at "(defun\\s +")
 401 ;;       (goto-char (match-end 0))
 402 ;;       (let ((name-start (point)))
 403 ;;         (forward-sexp 1)
 404 ;;         (process-send-string "inferior-shen"
 405 ;;                              (format "(compile '%s #'(lambda "
 406 ;;                                      (buffer-substring name-start
 407 ;;                                                        (point)))))
 408 ;;       (let ((body-start (point)))
 409 ;;         (goto-char start) (forward-sexp 1) ; Can't use end-of-defun.
 410 ;;         (process-send-region "inferior-shen"
 411 ;;                              (buffer-substring body-start (point))))
 412 ;;       (process-send-string "inferior-shen" ")\n"))
 413 ;;      (t (shen-eval-region start end)))))
 414 ;;
 415 ;; (defun shen-compile-region (start end)
 416 ;;   "Each s-expression in the current region is compiled (if a DEFUN)
 417 ;; or evaluated (if not) in the inferior shen."
 418 ;;   (interactive "r")
 419 ;;   (save-excursion
 420 ;;     (goto-char start) (end-of-defun) (beginning-of-defun) ; error check
 421 ;;     (if (< (point) start) (error "region begins in middle of defun"))
 422 ;;     (goto-char start)
 423 ;;     (let ((s start))
 424 ;;       (end-of-defun)
 425 ;;       (while (<= (point) end) ; Zip through
 426 ;;      (shen-compile-sexp s (point)) ; compiling up defun-sized chunks.
 427 ;;      (setq s (point))
 428 ;;      (end-of-defun))
 429 ;;       (if (< s end) (shen-compile-sexp s end)))))
 430 ;;
 431 ;; End of HS-style code
 432
 433
 434 (defvar shen-prev-l/c-dir/file nil
 435   "Record last directory and file used in loading or compiling.
 436 This holds a cons cell of the form `(DIRECTORY . FILE)'
 437 describing the last `shen-load-file' or `shen-compile-file' command.")
 438
 439 (defvar shen-source-modes '(shen-mode)
 440   "*Used to determine if a buffer contains Shen source code.
 441 If it's loaded into a buffer that is in one of these major modes, it's
 442 considered a Shen source file by `shen-load-file' and `shen-compile-file'.
 443 Used by these commands to determine defaults.")
 444
 445 (defun shen-load-file (file-name)
 446   "Load a Shen file into the inferior Shen process."
 447   (interactive (comint-get-source "Load Shen file: " shen-prev-l/c-dir/file
 448                                   shen-source-modes nil)) ; NIL because LOAD
 449                                         ; doesn't need an exact name
 450   (comint-check-source file-name) ; Check to see if buffer needs saved.
 451   (setq shen-prev-l/c-dir/file (cons (file-name-directory    file-name)
 452                                      (file-name-nondirectory file-name)))
 453   (comint-send-string (inferior-shen-proc)
 454                       (format inferior-shen-load-command file-name))
 455   (switch-to-shen t))
 456
 457
 458 (defun shen-compile-file (file-name)
 459   "Compile a Shen file in the inferior Shen process."
 460   (interactive (comint-get-source "Compile Shen file: " shen-prev-l/c-dir/file
 461                                   shen-source-modes nil)) ; NIL = don't need
 462                                         ; suffix .shen
 463   (comint-check-source file-name) ; Check to see if buffer needs saved.
 464   (setq shen-prev-l/c-dir/file (cons (file-name-directory    file-name)
 465                                      (file-name-nondirectory file-name)))
 466   (comint-send-string (inferior-shen-proc) (concat "(compile-file \""
 467                                                    file-name
 468                                                    "\"\)\n"))
 469   (switch-to-shen t))
 470
 471
 472
 473 ;;; Documentation functions: function doc, var doc, arglist, and
 474 ;;; describe symbol.
 475 ;;; ===========================================================================
 476
 477 ;;; Command strings
 478 ;;; ===============
 479
 480 (defvar shen-function-doc-command
 481   "(let ((fn '%s))
 482      (format t \"Documentation for ~a:~&~a\"
 483              fn (documentation fn 'function))
 484      (values))\n"
 485   "Command to query inferior Shen for a function's documentation.")
 486
 487 (defvar shen-var-doc-command
 488   "(let ((v '%s))
 489      (format t \"Documentation for ~a:~&~a\"
 490              v (documentation v 'variable))
 491      (values))\n"
 492   "Command to query inferior Shen for a variable's documentation.")
 493
 494 (defvar shen-arglist-command
 495   "(let ((fn '%s))
 496      (format t \"Arglist for ~a: ~a\" fn (arglist fn))
 497      (values))\n"
 498   "Command to query inferior Shen for a function's arglist.")
 499
 500 (defvar shen-describe-sym-command
 501   "(describe '%s)\n"
 502   "Command to query inferior Shen for a variable's documentation.")
 503
 504
 505 ;;; Ancillary functions
 506 ;;; ===================
 507
 508 (defun shen-symprompt (prompt default)
 509   "Read a string from the user."
 510   (list (let* ((prompt (if default
 511                            (format "%s (default %s): " prompt default)
 512                          (concat prompt ": ")))
 513                (ans (read-string prompt)))
 514           (if (zerop (length ans)) default ans))))
 515
 516
 517 ;; Adapted from function-called-at-point in help.el.
 518 (defun shen-fn-called-at-pt ()
 519   "Return the name of the function called in the current call.
 520 The value is nil if it can't find one."
 521   (condition-case nil
 522       (save-excursion
 523         (save-restriction
 524           (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
 525           (backward-up-list 1)
 526           (forward-char 1)
 527           (let ((obj (read (current-buffer))))
 528             (and (symbolp obj) obj))))
 529     (error nil)))
 530
 531
 532 ;; Adapted from variable-at-point in help.el.
 533 (defun shen-var-at-pt ()
 534   (condition-case ()
 535       (save-excursion
 536         (forward-sexp -1)
 537         (skip-chars-forward "'")
 538         (let ((obj (read (current-buffer))))
 539           (and (symbolp obj) obj)))
 540     (error nil)))
 541
 542
 543 ;;; Documentation functions: fn and var doc, arglist, and symbol describe.
 544 ;;; ======================================================================
 545 (defun shen-show-function-documentation (fn)
 546   "Send a command to the inferior Shen to give documentation for function FN.
 547 See variable `shen-function-doc-command'."
 548   (interactive (shen-symprompt "Function doc" (shen-fn-called-at-pt)))
 549   (comint-proc-query (inferior-shen-proc)
 550                      (format shen-function-doc-command fn)))
 551
 552 (defun shen-show-variable-documentation (var)
 553   "Send a command to the inferior Shen to give documentation for function FN.
 554 See variable `shen-var-doc-command'."
 555   (interactive (shen-symprompt "Variable doc" (shen-var-at-pt)))
 556   (comint-proc-query (inferior-shen-proc) (format shen-var-doc-command var)))
 557
 558 (defun shen-show-arglist (fn)
 559   "Send a query to the inferior Shen for the arglist for function FN.
 560 See variable `shen-arglist-command'."
 561   (interactive (shen-symprompt "Arglist" (shen-fn-called-at-pt)))
 562   (comint-proc-query (inferior-shen-proc) (format shen-arglist-command fn)))
 563
 564 (defun shen-describe-sym (sym)
 565   "Send a command to the inferior Shen to describe symbol SYM.
 566 See variable `shen-describe-sym-command'."
 567   (interactive (shen-symprompt "Describe" (shen-var-at-pt)))
 568   (comint-proc-query (inferior-shen-proc)
 569                      (format shen-describe-sym-command sym)))
 570
 571 \f
 572 ;;  "Returns the current inferior Shen process.
 573 ;; See variable `inferior-shen-buffer'."
 574 (defun inferior-shen-proc ()
 575   (let ((proc (get-buffer-process (if (eq major-mode 'inferior-shen-mode)
 576                                       (current-buffer)
 577                                     inferior-shen-buffer))))
 578     (or proc
 579         (error "No Shen subprocess; see variable `inferior-shen-buffer'"))))
 580
 581
 582 ;;; Do the user's customisation...
 583 ;;;===============================
 584 (defvar inferior-shen-load-hook nil
 585   "This hook is run when the library `inf-shen' is loaded.
 586 This is a good place to put keybindings.")
 587
 588 (run-hooks 'inferior-shen-load-hook)
 589
 590 (provide 'inf-shen)
 591 ;;; inf-shen.el ends here