home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / interfaces / Emacs-cl-shell / cl-lucid.el < prev    next >
Encoding:
Text File  |  1991-03-25  |  19.1 KB  |  457 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;; FILE:          cl-lucid.el
  3. ;;; DESCRIPTION:   Extensions to cl-shell.el for Lucid Common Lisp
  4. ;;; AUTHOR:        Eero Simoncelli, 
  5. ;;;                Vision Science Group, 
  6. ;;;                MIT Media Laboratory.
  7. ;;; CREATED:       December, 1989
  8. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  9.  
  10. ;; GNU Emacs is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  12. ;; accepts responsibility to anyone for the consequences of using it
  13. ;; or for whether it serves any particular purpose or works at all,
  14. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  15. ;; License for full details.
  16.  
  17. ;; Everyone is granted permission to copy, modify and redistribute
  18. ;; GNU Emacs, but only under the conditions described in the
  19. ;; GNU Emacs General Public License.   A copy of this license is
  20. ;; supposed to have been given to you along with GNU Emacs so you
  21. ;; can know your rights and responsibilities.  It should be in a
  22. ;; file named COPYING.  Among other things, the copyright notice
  23. ;; and this notice must be preserved on all copies.
  24.  
  25. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26.  
  27. ;;; This file contains additional hacks for use with code in
  28. ;;; cl-shell.el when using Lucid Common Lisp.  It is loaded
  29. ;;; automatically by run-cl if :Lucid is on the *features* lisp in the
  30. ;;; Common Lisp environment.  We alter the code from cl-shell.el which
  31. ;;; sends things to lisp so that it records the proper source-file for
  32. ;;; object/function definitions.  We also provide access to Lucid's
  33. ;;; arglist and source-file capabilities.  This is made more useful if
  34. ;;; you load the file source-file-extensions.lisp into your CL world.
  35.  
  36. (require 'cl-shell)
  37. (require 'ehelp)
  38. (provide 'cl-lucid)            ;used in cl-pcl and cl-flavors
  39.  
  40. (define-key lisp-mode-map "\C-c\C-a" 'cl-arglist)
  41. (define-key cl-shell-mode-map "\C-c\C-a" 'cl-arglist)
  42.  
  43. ;;; Don't clobber the usual emacs find-tag command, which is sometimes
  44. ;;; useful.  It should, however, be fixed to handle multiple definitions.
  45. (define-key lisp-mode-map "\C-c," 'cl-edit-next-definition)
  46. (define-key cl-shell-mode-map "\C-c," 'cl-edit-next-definition)
  47. (define-key lisp-mode-map "\C-c." 'cl-edit-definition)
  48. (define-key cl-shell-mode-map "\C-c." 'cl-edit-definition)
  49.  
  50. ;;; Define numerical continuation args (C-c <digit>).
  51. (define-key lisp-mode-map     "\C-c0" 'cl-send-digit)
  52. (define-key cl-shell-mode-map "\C-c0" 'cl-send-digit)
  53. (define-key lisp-mode-map     "\C-c1" 'cl-send-digit)
  54. (define-key cl-shell-mode-map "\C-c1" 'cl-send-digit)
  55. (define-key lisp-mode-map     "\C-c2" 'cl-send-digit)
  56. (define-key cl-shell-mode-map "\C-c2" 'cl-send-digit)
  57. (define-key lisp-mode-map     "\C-c3" 'cl-send-digit)
  58. (define-key cl-shell-mode-map "\C-c3" 'cl-send-digit)
  59. (define-key lisp-mode-map     "\C-c4" 'cl-send-digit)
  60. (define-key cl-shell-mode-map "\C-c4" 'cl-send-digit)
  61. (define-key lisp-mode-map     "\C-c5" 'cl-send-digit)
  62. (define-key cl-shell-mode-map "\C-c5" 'cl-send-digit)
  63. (define-key lisp-mode-map     "\C-c6" 'cl-send-digit)
  64. (define-key cl-shell-mode-map "\C-c6" 'cl-send-digit)
  65. (define-key lisp-mode-map     "\C-c7" 'cl-send-digit)
  66. (define-key cl-shell-mode-map "\C-c7" 'cl-send-digit)
  67. (define-key lisp-mode-map     "\C-c8" 'cl-send-digit)
  68. (define-key cl-shell-mode-map "\C-c8" 'cl-send-digit)
  69. (define-key lisp-mode-map     "\C-c9" 'cl-send-digit)
  70. (define-key cl-shell-mode-map "\C-c9" 'cl-send-digit)
  71.  
  72. ;;; Add Lucid binary file extensions to the list of filename
  73. ;;; completions to be ignored by Emacs.  
  74. ;;; *** Should only do this if these are not already there (pushnew)!
  75. (setq completion-ignored-extensions
  76.       (append '(".sbin" ".sbin3" ".hbin")
  77.           completion-ignored-extensions))
  78.  
  79. ;;; Add some more special forms to the indentation list. 
  80. ;;; These will probably eventually be part of Common Lisp
  81. (put 'loop 'common-lisp-indent-hook 1)
  82.  
  83. (put 'define-condition 'common-lisp-indent-hook 1)
  84. (put 'handler-bind 'common-lisp-indent-hook 1)
  85. (put 'handler-case 'common-lisp-indent-hook 1)
  86. (put 'restart-bind 'common-lisp-indent-hook 1)
  87. (put 'restart-case 'common-lisp-indent-hook 1)
  88. (put 'with-simple-restart 'common-lisp-indent-hook 1)
  89.  
  90. ;;; ----------------- Modified cl-shell-mode variables ----------------
  91.  
  92. (setq *cl-prompt* "^> ")
  93.  
  94. (setq *cl-error-prompt* "^\\(->\\)+ ")
  95.  
  96. ;;; Set :if-source-only and :if-source-newer behavior to avoid
  97. ;;; prompting user when loading a file during a cl-compile-form!
  98. ;;; *** could make this compile, by setting if-source-only and 
  99. ;;; if-source-newer to :compile.
  100. (setq inferior-lisp-load-command 
  101.       "(load \"%s\" :verbose nil :if-source-only :load-source
  102.                     :if-source-newer :load-source)\n")
  103.  
  104. ;;; Use a quiet compile command.
  105. (setq cl-compile-command
  106.       "(compile-file \"%s\" :messages nil :file-messages nil)\n")
  107.  
  108. (defun cl-abort () (interactive) (cl-send-string ":a\n"))
  109.  
  110. (defun cl-backtrace () (interactive) (cl-send-string ":b\n"))
  111.  
  112. (defun cl-send-digit ()
  113.   (interactive)
  114.   (cl-send-string (concat (char-to-string last-input-char) "\n")))
  115.  
  116. ;;; ------------------ Arglists  ------------------
  117.  
  118. ;;; Ask Lucid for an arglist.  Pretty-pring it in package of symbol.
  119. ;;; Must be careful not to generate an error in here!  *** SHould this
  120. ;;; print the symbol too?  *** could use momentary-string-display to
  121. ;;; put it in the buffer ...
  122. (defun cl-arglist (symbol)
  123.   (interactive (cl-get-function-name "Arglist of: "))
  124.   (cl-send-request cl-help-stream-id (cl-get-buffer-package)
  125.     (format "(if (and (symbolp %s) (fboundp %s))
  126.                (let ((*package* (symbol-package %s)))
  127.                 (declare (special *package*))
  128.                 (write (lucid::arglist %s) :pretty t :level nil :length nil))
  129.               (format t \"%s does not seem to be a symbol with a function binding.\"))"
  130.        symbol symbol symbol symbol symbol)))
  131.  
  132. ;;; *** Could use the Emacs function function-called-at-point in help.el
  133. (defun cl-get-function-name (&optional prompt)
  134.   (let (f-name)
  135.     (save-excursion
  136.       (condition-case ()        ;catch bad sexp errors
  137.       (progn
  138.         (cond ((= (following-char) ?\() nil) ;leave point where it is.
  139.           (t (backward-up-list 1)))
  140.         (if (looking-at "(+") (goto-char (match-end 0)))
  141.         (setq f-name
  142.           (buffer-substring (point) (progn (forward-sexp 1) (point)))))
  143.     (error nil)))
  144.     (if (null f-name) (setq f-name (read-string (or prompt "Function name: "))))
  145.     (list (cl-add-quote f-name))))
  146.  
  147. ;;; This comes from help.el:
  148. (defun function-called-at-point ()
  149.   (condition-case ()
  150.       (save-excursion
  151.     (save-restriction
  152.       (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
  153.       (backward-up-list 1)
  154.       (forward-char 1)
  155.       (let (obj)
  156.         (setq obj (read (current-buffer)))
  157.         (and (symbolp obj) (fboundp obj) obj))))
  158.     (error nil)))
  159.  
  160. ;;; *** Could also modify cl-documentation to print the arglist first.
  161.  
  162. ;;; --------------------- Edit definition --------------------
  163.  
  164. ;;; *** This code is slightly broken because of CL package prefixing.
  165. ;;; It is a pain to make Emacs lisp deal with this - future versions
  166. ;;; will attempt to fix the problems...
  167.  
  168. ;;; Ask Lucid to get the source files and pass it back to Emacs as a
  169. ;;; list argument to cl-edit-multiple-definitions.  Note that this
  170. ;;; requires no special CL code - Lucid's get-source-file returns the
  171. ;;; desired list.  New types of object/function can be used by calling
  172. ;;; record-source-file with a type argument which is a list.  Several
  173. ;;; such extensions have been provided in the file
  174. ;;; source-file-extensions.lisp.  The first element of the list will
  175. ;;; be used to by Emacs index into the *cl-definition-regexp-alist* to
  176. ;;; get a regexp to search for the definition.  *** Should this do an
  177. ;;; apropos on symbol? (like the Emacs find-tag).
  178. (defun cl-edit-definition (symbol)
  179.   (interactive (cl-ask-for-symbol "Edit CL definition: "))
  180.   (cl-send-request cl-eval-stream-id (cl-get-buffer-package)
  181.       (format "(let ((*print-length* nil)
  182.                      (*print-level* nil))
  183.                  (format lisp:*standard-output*
  184.                          \"(cl-edit-multiple-definitions \\\"%s\\\"  '~S)\"
  185.                          (lucid::get-source-file %s nil t)))"
  186.           (substring symbol 1)    ;get rid of quote
  187.           symbol)))
  188.  
  189. ;;; *** Warning: the symbols used as keys for the alist are
  190. ;;; case-sensitive.  The extended definition type :STRUCT-FUNCTION is
  191. ;;; defined in source-file-extensions.lisp.  It allows Emacs to go to
  192. ;;; the defstruct when you ask to edit the definition of an accessor,
  193. ;;; constructor, etc.
  194. (setq *cl-definition-regexp-alist*
  195.       (append *cl-definition-regexp-alist*
  196.           '((FUNCTION . "(defun[ \t\n]*%s")
  197.         (VARIABLE . "(def\\(var\\|parameter\\|constant\\)[ \t\n]*%s")
  198.         (STRUCTURE . "(defstruct[ \t\n]*(?%s")
  199.         (TYPE  . "(deftype[ \t\n]*%s")
  200.         (:STRUCT-FUNCTION . cl-make-defstruct-regexp))))
  201.  
  202. ;;; For functions defined by side-effect of a defstruct, search for
  203. ;;; the defstruct instead of a function definition!
  204. (defun cl-make-defstruct-regexp (symbol type-spec)
  205.   (format "(defstruct[ \t\n]*(?%s" (cl-strip-package (car (cdr type-spec)))))
  206.  
  207. (defun cl-definition-regexp (symbol type-spec)
  208.   (setq symbol (cl-strip-package symbol))
  209.   (let* ((type (if (listp type-spec) (car type-spec) type-spec))
  210.      (regexp-or-func (cdr (assoc type *cl-definition-regexp-alist*))))
  211.     (cond ((null regexp-or-func)    ;default regexp
  212.        (format "(def[^ \t\n]*[ \t\n]*(?%s" symbol))
  213.       ((stringp regexp-or-func)
  214.        (format regexp-or-func symbol))
  215.       ((symbolp regexp-or-func)
  216.        (funcall regexp-or-func symbol type-spec)))))
  217.  
  218. ;;; This is called by CL with the symbol, and a list containing
  219. ;;; type-spec/filename pairs.  A type-spec is either a symbol like
  220. ;;; 'function or 'variable, or a list like '(:struct-function foo).
  221. ;;; See the alist *cl-definition-regexp-alist*.  If there are many
  222. ;;; source files, we allow the user to choose which definition to
  223. ;;; edit.
  224. (defun cl-edit-multiple-definitions (symbol type-spec-and-file-list)
  225.   (cond ((or (null type-spec-and-file-list) (eq type-spec-and-file-list 'NIL))
  226.      (message "No definitions recorded for %s" symbol))
  227.     ((= (length type-spec-and-file-list) 1)
  228.      (cl-goto-definition symbol (car type-spec-and-file-list)))
  229.     (t (let ((user-choice (cl-choose-definition symbol type-spec-and-file-list)))
  230.          (cond ((numberp user-choice)  ;user chose a definition to edit.
  231.             (setq cl-edit-next-definition-form
  232.               (list 'cl-edit-multiple-definitions
  233.                 symbol type-spec-and-file-list))
  234.             (setq user-choice
  235.               (max 0 (min (1- (length type-spec-and-file-list))
  236.                       user-choice)))
  237.             (cl-goto-definition
  238.              symbol (nth user-choice type-spec-and-file-list)))
  239.            ((eq user-choice 'edit-all) ;user wants to cycle through all
  240.             (cl-cycle-through-definitions symbol type-spec-and-file-list))
  241.            (t (message "Cancelled.")))))))
  242.  
  243. ;;; If user hits return, we just cycle through the definitions like
  244. ;;; the usual next-tag function.
  245. (defun cl-cycle-through-definitions (symbol type-spec-and-file-list)
  246.   (let ((type-spec-and-file (car type-spec-and-file-list))
  247.     (rest-of-list (cdr type-spec-and-file-list)))
  248.     (setq cl-edit-next-definition-form
  249.       (if rest-of-list
  250.           (list 'cl-cycle-through-definitions
  251.             symbol rest-of-list)
  252.           nil))
  253.     (cl-goto-definition symbol type-spec-and-file)))
  254.  
  255. ;;; Provide both standard and "electric" cursor movement keybindings.
  256. (defvar cl-choose-definition-map
  257.   (let ((map (make-keymap)))
  258.     (fillarray map 'cl-choose-definition-undefined)
  259.     ;;(suppress-keymap map) ;supress modifying keystrokes
  260.     (define-key map (char-to-string meta-prefix-char) (copy-keymap map))
  261.     (define-key map "\C-n" 'next-line)
  262.     (define-key map "\C-p" 'previous-line)
  263.     (define-key map "n" 'next-line)
  264.     (define-key map "p" 'previous-line)
  265.     (define-key map "\C-v" 'scroll-up)
  266.     (define-key map "\M-v" 'scroll-down)
  267.     (define-key map "d" 'scroll-up)
  268.     (define-key map "u" 'scroll-down)
  269.     (define-key map "\M-<" 'beginning-of-buffer)
  270.     (define-key map "\M->" 'end-of-buffer)
  271.     (define-key map "<" 'beginning-of-buffer)
  272.     (define-key map ">" 'end-of-buffer)
  273.     (define-key map "e" '(lambda () (interactive)
  274.               (throw 'exit (1- (count-lines 1 (point))))))
  275.     (define-key map "a" '(lambda () (interactive) (throw 'exit 'edit-all)))
  276.     (define-key map "\C-m" '(lambda () (interactive) (throw 'exit 'edit-all)))
  277.     (define-key map "q" '(lambda () (interactive) (throw 'exit 'quit)))
  278.     (define-key map "Q" '(lambda () (interactive) (throw 'exit 'quit)))
  279.     (define-key map "\C-g" '(lambda () (interactive) (throw 'exit 'quit)))    
  280.     map))
  281.  
  282. (defvar cl-choose-definition-error-message
  283.   "e to edit this def, <CR> or a to edit all sequentially, q to quit: ")
  284.  
  285. (defun cl-choose-definition-undefined ()
  286.   (interactive)
  287.   (message cl-choose-definition-error-message)
  288.   (beep))
  289. (put 'cl-choose-definition-undefined 'suppress-keymap t)
  290.  
  291. ;;; This asks the user to select a definition to edit.  Returns a
  292. ;;; number, or 'edit-all to indicate users choice.  Anything else is
  293. ;;; interpreted as a cancellation.  *** BUG: screws up current-buffer.
  294. (defun cl-choose-definition (symbol type-spec-and-file-list)
  295.   (save-window-excursion
  296.     (let ((buf (get-buffer-create "*CL definitions*"))
  297.       (first-spec-and-file))
  298.       (pop-to-buffer buf)
  299.       (use-local-map cl-choose-definition-map)
  300.       (erase-buffer)
  301.       (insert (format "Select a definition of %s to edit:\n" symbol))
  302.       (while type-spec-and-file-list
  303.     (setq first-spec-and-file (car type-spec-and-file-list))
  304.     (setq type-spec-and-file-list (cdr type-spec-and-file-list))
  305.     (insert (format "%s\n" first-spec-and-file)))
  306.       (goto-line 2)            ;put point on first definition
  307.       (catch 'exit
  308.     (unwind-protect
  309.          (Electric-command-loop
  310.           'exit
  311.           cl-choose-definition-error-message)
  312.       (message "")        ;get rid of minibuffer prompt
  313.       (condition-case ()    ;make sure user can get rid of this buffer!
  314.           (funcall (or default-major-mode 'fundamental-mode))
  315.         (error nil))
  316.       (bury-buffer buf))))))
  317.  
  318. ;;; Holds the form to be evaluated on a call to cl-edit-next-definition.
  319. (defvar cl-edit-next-definition-form nil)
  320.  
  321. (defun cl-edit-next-definition ()
  322.   (interactive)
  323.   (if (null cl-edit-next-definition-form)
  324.       (message "No more definitions to edit.")
  325.       (apply (car cl-edit-next-definition-form)
  326.          (cdr cl-edit-next-definition-form))))
  327.  
  328. ;;; Load the file into Emacs and goto the definition containing
  329. ;;; symbol.  type-and-file-spec should be an element of the list
  330. ;;; returned by CL from a call to get-source-file.
  331. (defun cl-goto-definition (symbol type-spec-and-file)
  332.   (let ((type-spec (car type-spec-and-file))
  333.     (filename (cdr type-spec-and-file)))
  334.     (cond ((null filename)        ;if defined at top-level.
  335.        (message "%s definition for %s has no source file."
  336.             type-spec symbol))
  337.       ((null (file-readable-p filename))
  338.        (message "Cannot open source file %s" filename))
  339.       (t
  340.        (let* ((buf (find-file-noselect (expand-file-name filename)))
  341.           regexp)
  342.          (if (get-buffer-window buf) ;already showing?
  343.          (set-buffer buf)
  344.          (pop-to-buffer buf))
  345.          (goto-char (point-min))
  346.          (setq regexp (cl-definition-regexp symbol type-spec))
  347.          (if (re-search-forward regexp nil t)
  348.          (goto-char (match-beginning 0))
  349.          (message "Can't find a %s definition for %s." type-spec symbol))
  350.          (select-window (get-buffer-window buf)))))))
  351.  
  352. ;;; -------------------- Modified lisp-mode buffer commands --------------------
  353.  
  354. ;;; We modify these to record the source file of functions correctly.
  355. ;;; This is done by rebinding the variable lucid::*source-pathname*.
  356. ;;; *** This is a bit gross.  We should come up with a clever macro to
  357. ;;; do this...
  358.  
  359. ;(defun cl-eval-form ()
  360. ;  "Send the current top-level sexp to the CL process created by
  361. ;M-x run-cl, moving to end of sexp.  If *cl-echo-commands* is non-nil,
  362. ;echo the sexp into cl-shell buffer."
  363. ;  (interactive)
  364. ;  (end-of-defun)            ;move to end of defun
  365. ;  (let* ((the-string 
  366. ;      (save-excursion        ;leave point at end of defun
  367. ;        (buffer-substring (progn (beginning-of-defun) (point))
  368. ;                  (progn (forward-sexp 1) (point)))))
  369. ;     (full-string
  370. ;      (concat "(let ((lucid::*source-pathname* \""  buffer-file-name  "\"))\n"
  371. ;          the-string
  372. ;          ")\n")))
  373. ;    (if *cl-echo-commands*
  374. ;    (cl-send-string-with-echo full-string the-string)
  375. ;    (cl-send-string (concat full-string "\n")))))
  376.  
  377. (defun cl-eval-region ()
  378.   "Send region between point and mark to CL process, without echoing."
  379.   (interactive)
  380.   ;; check that expressions are complete.  Take overhanging ones.
  381.   (let ((start (min (point) (mark)))
  382.     (end (max (point) (mark))))
  383.     (save-excursion
  384.       (goto-char start)
  385.       (setq end (progn
  386.           (while (and (< (point) end)
  387.                   (scan-sexps (point) 1))
  388.             (goto-char (scan-sexps (point) 1))
  389.             (skip-chars-forward " \t\n" end))
  390.           (point)))
  391.       (cl-send-string
  392.        (concat "(let ((lucid::*source-pathname* (truename \""
  393.            (expand-file-name buffer-file-name)
  394.            "\")))\n"))
  395.       (cl-send-region start end)
  396.       (cl-send-string "\n(values))\n")))) ;send final newline
  397.  
  398. (defun cl-compile-form ()
  399.   "Send the current top-level sexp to the CL process created by M-x
  400. run-cl, and compile it in the package of the current buffer.  The
  401. point is moved to the end of the sexp, and if *cl-echo-commands* is
  402. non-nil a shorthand expression is echoed to the *lisp* buffer."
  403.   (interactive)
  404.   (or (cl-process) (error "CL process is not running!"))
  405.   (end-of-defun)            ;move to end of sexp
  406.   (let ((cl-package (cl-get-buffer-package))
  407.     (source-file-name (expand-file-name buffer-file-name))
  408.     the-string fn-name)
  409.     (save-excursion            ;leave point at end of defun
  410.       (beginning-of-defun)
  411.       (setq the-string 
  412.         (buffer-substring (point) (save-excursion (forward-sexp 1) (point))))
  413.       ;; Set up fn-name and the-string, depending on compiling mode:
  414.       (if (null (looking-at cl-fast-compile-regexp))
  415.       (let ((filename (format "/tmp/emlisp%d" (process-id (cl-process))))
  416.         (buf (current-buffer)))
  417.         (setq fn-name 
  418.           (buffer-substring
  419.            (point)
  420.            (progn (forward-char 1) (forward-sexp 2) (point))))
  421.         (setq fn-name (concat fn-name " ... )"))
  422.         (set-buffer (get-buffer-create "*CL compilation*"))
  423.         (erase-buffer)
  424.         (insert (format "(in-package %s)\n" cl-package))
  425.         (insert (concat "(eval-when (compile load)
  426.                                (setq lucid::*source-pathname* (truename \""
  427.                 source-file-name
  428.                 "\")))\n\n"))
  429.         (insert the-string)
  430.         (insert "\n")        ;make sure there's a trailing newline
  431.         (write-region (point-min) (point-max) filename nil 'nomessage)
  432.         (setq the-string
  433.           (concat "(progn "
  434.               (format cl-compile-command filename)
  435.               (format inferior-lisp-load-command filename)
  436.               "(values))\n"))
  437.         (set-buffer buf))
  438.       (forward-char 1)        ;skip open paren
  439.       (forward-sexp 1)        ;skip "defun"
  440.       (skip-chars-forward " \t\n")    ;skip whitespace to function name
  441.       (setq fn-name (buffer-substring (point) (progn (forward-sexp 1) (point))))
  442.       (setq the-string
  443.         (cl-with-package cl-package
  444.                  (concat "(user::compile-def " the-string ")")))
  445.       (setq the-string
  446.         (concat "(let ((lucid::*source-pathname* (truename \""
  447.             source-file-name
  448.             "\")))\n"
  449.             the-string
  450.             ")"))))
  451.     (if *cl-echo-commands*
  452.     (cl-send-string-with-echo
  453.      the-string
  454.      (concat "(compile-def '" fn-name " :pkg " cl-package ")")
  455.      t)                ;no history recording
  456.     (cl-send-string (concat the-string "\n")))))
  457.