editors/scel/el/sclang-interp.el

   1 ;; copyright 2003-2005 stefan kersten <steve@k-hornz.de>
   2 ;;
   3 ;; This program is free software; you can redistribute it and/or
   4 ;; modify it under the terms of the GNU General Public License as
   5 ;; published by the Free Software Foundation; either version 2 of the
   6 ;; License, or (at your option) any later version.
   7 ;;
   8 ;; This program is distributed in the hope that it will be useful, but
   9 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11 ;; General Public License for more details.
  12 ;;
  13 ;; You should have received a copy of the GNU General Public License
  14 ;; along with this program; if not, write to the Free Software
  15 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
  16 ;; USA
  17
  18 (eval-when-compile
  19   (require 'cl)
  20   (require 'sclang-util)
  21   (require 'compile)
  22   )
  23
  24 ;; =====================================================================
  25 ;; post buffer access
  26 ;; =====================================================================
  27
  28 ;; FIXME: everything will fail when renaming the post buffer!
  29
  30 (defconst sclang-post-buffer (sclang-make-buffer-name "PostBuffer")
  31   "Name of the SuperCollider process output buffer.")
  32
  33 (defconst sclang-bullet-latin-1 (string-to-char (decode-coding-string "\xa5" 'utf-8))
  34   "Character for highlighting errors (latin-1).")
  35
  36 (defconst sclang-bullet-utf-8 (string-to-char (decode-coding-string "\xe2\x80\xa2" 'utf-8))
  37   "Character for highlighting errors (utf-8).")
  38
  39 (defconst sclang-parse-error-regexp
  40   "^\\(WARNING\\|ERROR\\): .*\n[\t ]*in file '\\([^']\+\\)'\n[\t ]*line \\([0-9]\+\\) char \\([0-9]\+\\)"
  41   "Regular expression matching parse errors during library compilation.")
  42
  43 (defcustom sclang-max-post-buffer-size 0
  44   "*Maximum number of characters to insert in post buffer.
  45 Zero means no limit."
  46   :group 'sclang-interface
  47   :version "21.3"
  48   :type 'integer)
  49
  50 (defcustom sclang-auto-scroll-post-buffer nil
  51   "*Automatically scroll post buffer on output regardless of point position.
  52 Default behavior is to only scroll when point is not at end of buffer."
  53   :group 'sclang-interface
  54   :version "21.3"
  55   :type 'boolean)
  56
  57 (defun sclang-get-post-buffer ()
  58   (get-buffer-create sclang-post-buffer))
  59
  60 (defmacro with-sclang-post-buffer (&rest body)
  61   `(with-current-buffer (sclang-get-post-buffer)
  62      ,@body))
  63
  64 ;; (defun sclang-post-string (string)
  65 ;;   (with-sclang-post-buffer
  66 ;;    (let ((eobp (mapcar (lambda (w)
  67 ;;                       (cons w (= (window-point w) (point-max))))
  68 ;;                     (get-buffer-window-list (current-buffer) nil t))))
  69 ;;      (save-excursion
  70 ;;        ;; insert STRING into process buffer
  71 ;;        (goto-char (point-max))
  72 ;;        (insert string))
  73 ;;      (dolist (assoc eobp)
  74 ;;        (when (cdr assoc)
  75 ;;       (save-selected-window
  76 ;;         (let ((window (car assoc)))
  77 ;;           (select-window window)
  78 ;;           (set-window-point window (point-max))
  79 ;;           (recenter -1))))))))
  80
  81 ;; (defun sclang-post-string (string &optional proc)
  82 ;;   (let* ((buffer (process-buffer proc))
  83 ;;       (window (display-buffer buffer)))
  84 ;;     (with-current-buffer buffer
  85 ;;       (let ((moving (= (point) (process-mark proc))))
  86 ;;      (save-excursion
  87 ;;        ;; Insert the text, advancing the process marker.
  88 ;;        (goto-char (process-mark proc))
  89 ;;        (insert string)
  90 ;;        (set-marker (process-mark proc) (point)))
  91 ;;      (when moving
  92 ;;        (goto-char (process-mark proc))
  93 ;;        (set-window-point window (process-mark proc)))))))
  94
  95 (defun sclang-show-post-buffer (&optional eob-p)
  96   "Show SuperCollider process buffer.
  97 If EOB-P is non-nil, positions cursor at end of buffer."
  98   (interactive "P")
  99   (with-sclang-post-buffer
 100    (let ((window (display-buffer (current-buffer))))
 101      (when eob-p
 102        (goto-char (point-max))
 103        (save-selected-window
 104          (set-window-point window (point-max)))))))
 105
 106 (defun sclang-clear-post-buffer ()
 107   "Clear the output buffer."
 108   (interactive)
 109   (with-sclang-post-buffer (erase-buffer)))
 110
 111 (defun sclang-init-post-buffer ()
 112   "Initialize post buffer."
 113   (get-buffer-create sclang-post-buffer)
 114   (with-sclang-post-buffer
 115    ;; setup sclang mode
 116    (sclang-mode)
 117    (set (make-local-variable 'font-lock-fontify-region-function)
 118         (lambda (&rest args)))
 119    ;; setup compilation mode
 120    (compilation-minor-mode)
 121    (set (make-variable-buffer-local 'compilation-error-screen-columns) nil)
 122    (set (make-variable-buffer-local 'compilation-error-regexp-alist)
 123         (cons (list sclang-parse-error-regexp 2 3 4) compilation-error-regexp-alist))
 124    (set (make-variable-buffer-local 'compilation-parse-errors-function)
 125         (lambda (limit-search find-at-least)
 126           (compilation-parse-errors limit-search find-at-least)))
 127    (set (make-variable-buffer-local 'compilation-parse-errors-filename-function)
 128         (lambda (file-name)
 129           file-name)))
 130   (sclang-clear-post-buffer)
 131   (sclang-show-post-buffer))
 132
 133 ;; =====================================================================
 134 ;; interpreter interface
 135 ;; =====================================================================
 136
 137 (defconst sclang-process "SCLang"
 138   "Name of the SuperCollider interpreter subprocess.")
 139
 140 (defcustom sclang-program "sclang"
 141   "*Name of the SuperCollider interpreter program."
 142   :group 'sclang-programs
 143   :version "21.3"
 144   :type 'string)
 145
 146 (defcustom sclang-runtime-directory ""
 147   "*Path to the SuperCollider runtime directory."
 148   :group 'sclang-options
 149   :version "21.3"
 150   :type 'directory
 151   :options '(:must-match))
 152
 153 (defcustom sclang-library-configuration-file ""
 154   "*Path of the library configuration file."
 155   :group 'sclang-options
 156   :version "21.3"
 157   :type 'file
 158   :options '(:must-match))
 159
 160 (defcustom sclang-heap-size ""
 161   "*Initial heap size."
 162   :group 'sclang-options
 163   :version "21.3"
 164   :type 'string)
 165
 166 (defcustom sclang-heap-growth ""
 167   "*Heap growth."
 168   :group 'sclang-options
 169   :version "21.3"
 170   :type 'string)
 171
 172 (defcustom sclang-udp-port -1
 173   "*UDP listening port."
 174   :group 'sclang-options
 175   :version "21.3"
 176   :type 'integer)
 177
 178 (defcustom sclang-main-run nil
 179   "*Call Main.run on startup."
 180   :group 'sclang-options
 181   :version "21.3"
 182   :type 'boolean)
 183
 184 (defcustom sclang-main-stop nil
 185   "*Call Main.stop on shutdown."
 186   :group 'sclang-options
 187   :version "21.3"
 188   :type 'boolean)
 189
 190 ;; =====================================================================
 191 ;; helper functions
 192 ;; =====================================================================
 193
 194 (defun sclang-get-process ()
 195   (get-process sclang-process))
 196
 197 ;; =====================================================================
 198 ;; library startup/shutdown
 199 ;; =====================================================================
 200
 201 (defvar sclang-library-initialized-p nil)
 202
 203 (defcustom sclang-library-startup-hook nil
 204   "*Hook run after initialization of the SCLang process."
 205   :group 'sclang-interface
 206   :type 'hook)
 207
 208 (defcustom sclang-library-shutdown-hook nil
 209   "*Hook run before deletion of the SCLang process."
 210   :group 'sclang-interface
 211   :type 'hook)
 212
 213 ;; library initialization works like this:
 214 ;;
 215 ;; * emacs starts sclang with SCLANG_COMMAND_FIFO set in the environment
 216 ;; * sclang opens fifo for communication with emacs during class tree
 217 ;;   initialization
 218 ;; * sclang sends '_init' command
 219 ;; * '_init' command handler calls sclang-on-library-startup to complete
 220 ;;   initialization
 221
 222 (defun sclang-library-initialized-p ()
 223   (and (sclang-get-process)
 224        sclang-library-initialized-p))
 225
 226 (defun sclang-on-library-startup ()
 227   (sclang-message "Initializing library...")
 228   (setq sclang-library-initialized-p t)
 229   (run-hooks 'sclang-library-startup-hook)
 230   (sclang-message "Initializing library...done"))
 231
 232 (defun sclang-on-library-shutdown ()
 233   (when sclang-library-initialized-p
 234     (run-hooks 'sclang-library-shutdown-hook)
 235     (setq sclang-library-initialized-p nil)
 236     (sclang-message "Shutting down library...")))
 237
 238 ;; =====================================================================
 239 ;; process hooks
 240 ;; =====================================================================
 241
 242 (defun sclang-process-sentinel (proc msg)
 243   (with-sclang-post-buffer
 244    (goto-char (point-max))
 245    (insert
 246     (if (and (bolp) (eolp)) "\n" "\n\n")
 247     (format "*** %s %s ***" proc (substring msg 0 -1))
 248     "\n\n"))
 249   (when (memq (process-status proc) '(exit signal))
 250     (sclang-on-library-shutdown)
 251     (sclang-stop-command-process)))
 252
 253 (defun sclang-process-filter (process string)
 254   (let ((buffer (process-buffer process)))
 255     (with-current-buffer buffer
 256       (when (and (> sclang-max-post-buffer-size 0)
 257                  (> (buffer-size) sclang-max-post-buffer-size))
 258         (erase-buffer))
 259       (let ((move-point (or sclang-auto-scroll-post-buffer
 260                             (= (point) (process-mark process)))))
 261         (save-excursion
 262           ;; replace mac-roman bullet with unicode character
 263           (subst-char-in-string sclang-bullet-latin-1 sclang-bullet-utf-8 string t)
 264           ;; insert the text, advancing the process marker.
 265           (goto-char (process-mark process))
 266           (insert string)
 267           (set-marker (process-mark process) (point)))
 268         (when move-point
 269           (goto-char (process-mark process))
 270           (walk-windows
 271            (lambda (window)
 272              (when (eq buffer (window-buffer window))
 273                (set-window-point window (process-mark process))))
 274            nil t))))))
 275
 276 ;; =====================================================================
 277 ;; process startup/shutdown
 278 ;; =====================================================================
 279
 280 (defun sclang-memory-option-p (string)
 281   (let ((case-fold-search nil))
 282     (string-match "^[1-9][0-9]*[km]?$" string)))
 283
 284 (defun sclang-port-option-p (number)
 285   (and (>= number 0) (<= number #XFFFF)))
 286
 287 (defun sclang-make-options ()
 288   (let ((default-directory "")
 289         (res ()))
 290     (flet ((append-option
 291             (option &optional value)
 292             (setq res (append res (list option) (and value (list value))))))
 293       (if (file-directory-p sclang-runtime-directory)
 294           (append-option "-d" (expand-file-name sclang-runtime-directory)))
 295       (if (file-exists-p sclang-library-configuration-file)
 296           (append-option "-l" (expand-file-name sclang-library-configuration-file)))
 297       (if (sclang-memory-option-p sclang-heap-size)
 298           (append-option "-m" sclang-heap-size))
 299       (if (sclang-memory-option-p sclang-heap-growth)
 300           (append-option "-g" sclang-heap-growth))
 301       (if (sclang-port-option-p sclang-udp-port)
 302           (append-option "-u" (number-to-string sclang-udp-port)))
 303       (if sclang-main-run
 304           (append-option "-r"))
 305       (if sclang-main-stop
 306           (append-option "-s"))
 307       (append-option "-iscel")
 308       res)))
 309
 310 (defun sclang-start ()
 311   "Start SuperCollider process."
 312   (interactive)
 313   (sclang-stop)
 314   (sclang-on-library-shutdown)
 315   (sit-for 1)
 316   (sclang-init-post-buffer)
 317   (sclang-start-command-process)
 318   (let ((process-connection-type nil))
 319     (let ((proc (apply 'start-process
 320                        sclang-process sclang-post-buffer
 321                        sclang-program (sclang-make-options))))
 322       (set-process-sentinel proc 'sclang-process-sentinel)
 323       (set-process-filter proc 'sclang-process-filter)
 324       (set-process-coding-system proc 'mule-utf-8 'mule-utf-8)
 325       (set-process-query-on-exit-flag proc nil)
 326       proc)))
 327
 328 (defun sclang-kill ()
 329   "Kill SuperCollider process."
 330   (interactive)
 331   (when (sclang-get-process)
 332     (kill-process sclang-process)
 333     (delete-process sclang-process)))
 334
 335 (defun sclang-stop ()
 336   "Stop SuperCollider process."
 337   (interactive)
 338   (when (sclang-get-process)
 339     (process-send-eof sclang-process)
 340     (let ((tries 4)
 341           (i 0))
 342       (while (and (sclang-get-process)
 343                   (< i tries))
 344         (incf i)
 345         (sit-for 0.5))))
 346   (sclang-kill)
 347   (sclang-stop-command-process))
 348
 349 (defun sclang-recompile ()
 350   "Recompile class library."
 351   (interactive)
 352   (when (sclang-get-process)
 353     (process-send-string sclang-process "\x18")
 354     ))
 355
 356 ;; =====================================================================
 357 ;; command process
 358 ;; =====================================================================
 359
 360 (defcustom sclang-mkfifo-program "mkfifo"
 361   "*Name of the \"mkfifo\" program.
 362
 363 Change this if \"mkfifo\" has a non-standard name or location."
 364   :group 'sclang-programs
 365   :type 'string)
 366
 367 (defcustom sclang-cat-program "cat"
 368   "*Name of the \"cat\" program.
 369
 370 Change this if \"cat\" has a non-standard name or location."
 371   :group 'sclang-programs
 372   :type 'string)
 373
 374 (defconst sclang-command-process "SCLang Command"
 375   "Subprocess for receiving command results from sclang.")
 376
 377 (defconst sclang-cmd-helper-proc "SCLang Command Helper"
 378   "Dummy subprocess that will keep the command fifo open for writing
 379    so reading does not fail automatically when sclang closes its own
 380    writing end of the fifo")
 381
 382 (defvar sclang-command-fifo nil
 383   "FIFO for communicating with the subprocess.")
 384
 385 (defun sclang-delete-command-fifo ()
 386   (and sclang-command-fifo
 387        (file-exists-p sclang-command-fifo)
 388        (delete-file sclang-command-fifo)))
 389
 390 (defun sclang-release-command-fifo ()
 391   (sclang-delete-command-fifo)
 392   (setq sclang-command-fifo nil))
 393
 394 (defun sclang-create-command-fifo ()
 395   (setq sclang-command-fifo (make-temp-name
 396                               (expand-file-name
 397                                "sclang-command-fifo." temporary-file-directory)))
 398   (sclang-delete-command-fifo)
 399   (let ((res (call-process sclang-mkfifo-program
 400                            nil t t
 401                            sclang-command-fifo)))
 402     (unless (eq 0 res)
 403       (message "SCLang: Couldn't create command fifo")
 404       (setq sclang-command-fifo nil))))
 405
 406 (defun sclang-start-command-process ()
 407   (sclang-create-command-fifo)
 408   (when sclang-command-fifo
 409     ;; start the dummy process to keep the fifo open
 410     (let ((process-connection-type nil))
 411       (let ((proc (start-process-shell-command
 412         sclang-cmd-helper-proc nil
 413         (concat sclang-cat-program " > " sclang-command-fifo))))
 414             (set-process-query-on-exit-flag proc nil)))
 415     ;; sclang gets the fifo path via the environment
 416     (setenv "SCLANG_COMMAND_FIFO" sclang-command-fifo)
 417     (let ((process-connection-type nil))
 418       (let ((proc (start-process
 419                    sclang-command-process nil
 420                    sclang-cat-program sclang-command-fifo)))
 421         (set-process-filter proc 'sclang-command-process-filter)
 422         ;; this is important. use a unibyte stream without eol
 423         ;; conversion for communication.
 424         (set-process-coding-system proc 'no-conversion 'no-conversion)
 425         (set-process-query-on-exit-flag proc nil)))
 426     (unless (get-process sclang-command-process)
 427       (message "SCLang: Couldn't start command process"))))
 428
 429 (defun sclang-stop-command-process ()
 430   (when (get-process sclang-cmd-helper-proc)
 431     (kill-process sclang-cmd-helper-proc)
 432     (delete-process sclang-cmd-helper-proc))
 433   ;; the real command process should now quit automatically,
 434   ;; since there is no more writers to the command fifo
 435   (sclang-release-command-fifo))
 436
 437 (defvar sclang-command-process-previous nil
 438   "Unprocessed command process output.")
 439
 440 (defun sclang-command-process-filter (proc string)
 441   (when sclang-command-process-previous
 442     (setq string (concat sclang-command-process-previous string)))
 443   (let (end)
 444     (while (and (> (length string) 3)
 445                 (>= (length string)
 446                     (setq end (+ 4 (sclang-string-to-int32 string)))))
 447       (sclang-handle-command-result (car (read-from-string string 4 end)))
 448       (setq string (substring string end))))
 449   (setq sclang-command-process-previous string))
 450
 451 ;; =====================================================================
 452 ;; command interface
 453 ;; =====================================================================
 454
 455 ;; symbol property: sclang-command-handler
 456
 457 (defun sclang-set-command-handler (symbol function)
 458   (put symbol 'sclang-command-handler function))
 459
 460 (defun sclang-perform-command (symbol &rest args)
 461   (sclang-eval-string (sclang-format
 462                        "Emacs.lispPerformCommand(%o, %o, true)"
 463                        symbol args)))
 464
 465 (defun sclang-perform-command-no-result (symbol &rest args)
 466   (sclang-eval-string (sclang-format
 467                        "Emacs.lispPerformCommand(%o, %o, false)"
 468                        symbol args)))
 469
 470 (defun sclang-default-command-handler (fun arg)
 471   "Default command handler.
 472 Displays short message on error."
 473   (condition-case nil
 474       (funcall fun arg)
 475     (error (sclang-message "Error in command handler") nil)))
 476
 477 (defun sclang-debug-command-handler (fun arg)
 478   "Debugging command handler.
 479 Enters debugger on error."
 480   (let ((debug-on-error t)
 481         (debug-on-signal t))
 482     (funcall fun arg)))
 483
 484 (defvar sclang-command-handler 'sclang-default-command-handler
 485   "Function called when handling command result.")
 486
 487 (defun sclang-toggle-debug-command-handler (&optional arg)
 488   "Toggle debugging of command handler.
 489 With arg, activate debugging iff arg is positive."
 490   (interactive "P")
 491   (setq sclang-command-handler
 492         (if (or (and arg (> arg 0))
 493                 (eq sclang-command-handler 'sclang-debug-command-handler))
 494             'sclang-default-command-handler
 495           'sclang-default-command-handler))
 496   (sclang-message "Command handler debugging %s."
 497                   (if (eq sclang-command-handler 'sclang-debug-command-handler)
 498                       "enabled"
 499                     "disabled")))
 500
 501 (defun sclang-handle-command-result (list)
 502   (condition-case nil
 503       (let ((fun (get (nth 0 list) 'sclang-command-handler))
 504             (arg (nth 1 list))
 505             (id  (nth 2 list)))
 506         (when (functionp fun)
 507           (let ((res (funcall sclang-command-handler fun arg)))
 508             (when id
 509               (sclang-eval-string
 510                (sclang-format "Emacs.lispHandleCommandResult(%o, %o)" id res))))))
 511     (error nil)))
 512
 513 ;; =====================================================================
 514 ;; code evaluation
 515 ;; =====================================================================
 516
 517 (defconst sclang-token-interpret-cmd-line (char-to-string #X1b))
 518 (defconst sclang-token-interpret-print-cmd-line (char-to-string #X0c))
 519
 520 (defcustom sclang-eval-line-forward t
 521   "*If non-nil `sclang-eval-line' advances to the next line."
 522   :group 'sclang-interface
 523   :type 'boolean)
 524
 525 (defun sclang-send-string (token string &optional force)
 526   (let ((proc (sclang-get-process)))
 527     (when (and proc (or (sclang-library-initialized-p) force))
 528       (process-send-string proc (concat string token))
 529       string)))
 530
 531 (defun sclang-eval-string (string &optional print-p)
 532   "Send STRING to the sclang process for evaluation and print the result
 533 if PRINT-P is non-nil. Return STRING if successful, otherwise nil."
 534   (sclang-send-string
 535    (if print-p sclang-token-interpret-print-cmd-line sclang-token-interpret-cmd-line)
 536    string))
 537
 538 (defun sclang-eval-expression (string &optional silent-p)
 539   "Execute STRING as SuperCollider code."
 540   (interactive "sEval: \nP")
 541   (sclang-eval-string string (not silent-p)))
 542
 543 (defun sclang-eval-line (&optional silent-p)
 544   "Execute the current line as SuperCollider code."
 545   (interactive "P")
 546   (let ((string (sclang-line-at-point)))
 547     (when string
 548       (sclang-eval-string string (not silent-p)))
 549     (and sclang-eval-line-forward
 550          (/= (line-end-position) (point-max))
 551          (forward-line 1))
 552     string))
 553
 554 (defun sclang-eval-region (&optional silent-p)
 555   "Execute the region as SuperCollider code."
 556   (interactive "P")
 557   (sclang-eval-string
 558    (buffer-substring-no-properties (region-beginning) (region-end))
 559    (not silent-p)))
 560
 561 (defun sclang-eval-region-or-line (&optional silent-p)
 562   (interactive "P")
 563   (if (and transient-mark-mode mark-active)
 564       (sclang-eval-region silent-p)
 565     (sclang-eval-line silent-p)))
 566
 567 (defun sclang-eval-defun (&optional silent-p)
 568   (interactive "P")
 569   (let ((string (sclang-defun-at-point)))
 570     (when (and string (string-match "^(" string))
 571       (sclang-eval-string string (not silent-p))
 572       string)))
 573
 574 (defun sclang-eval-document (&optional silent-p)
 575   "Execute the whole document as SuperCollider code."
 576   (interactive "P")
 577   (save-excursion
 578     (mark-whole-buffer)
 579     (sclang-eval-string
 580      (buffer-substring-no-properties (region-beginning) (region-end))
 581      (not silent-p))))
 582
 583 (defvar sclang-eval-results nil
 584   "Save results of sync SCLang evaluation.")
 585
 586 (sclang-set-command-handler
 587  'evalSCLang
 588  (lambda (arg) (push arg sclang-eval-results)))
 589
 590 (defun sclang-eval-sync (string)
 591   "Eval STRING in sclang and return result as a lisp value."
 592   (let ((proc (get-process sclang-command-process)))
 593     (if (and (processp proc) (eq (process-status proc) 'run))
 594         (let ((time (current-time)) (tick 10000) elt)
 595           (sclang-perform-command 'evalSCLang string time)
 596           (while (and (> (decf tick) 0)
 597                       (not (setq elt (find time sclang-eval-results
 598                                            :key #'car :test #'equal))))
 599             (accept-process-output proc 0 100))
 600           (if elt
 601               (prog1 (if (eq (nth 1 elt) 'ok)
 602                          (nth 2 elt)
 603                        (setq sclang-eval-results (delq elt sclang-eval-results))
 604                        (signal 'sclang-error (nth 2 elt)))
 605                 (setq sclang-eval-results (delq elt sclang-eval-results)))
 606             (error "SCLang sync eval timeout")))
 607       (error "SCLang Command process not running"))))
 608
 609 ;; =====================================================================
 610 ;; searching
 611 ;; =====================================================================
 612
 613 ;; (defun sclang-help-file-paths ()
 614 ;;   "Return a list of help file paths."
 615
 616
 617 ;; (defun sclang-grep-help-files ()
 618 ;;   (interactive)
 619 ;;   (let ((sclang-grep-prompt "Search help files: ")
 620 ;;      (sclang-grep-files (mapcar 'cdr sclang-help-topic-alist)))
 621 ;;     (call-interactively 'sclang-grep-files)))
 622
 623 ;; (defvar sclang-grep-history nil)
 624
 625 ;; (defcustom sclang-grep-case-fold-search t
 626 ;;   "*Non-nil if sclang-grep-files should ignore case."
 627 ;;   :group 'sclang-interface
 628 ;;   :version "21.4"
 629 ;;   :type 'boolean)
 630
 631 ;; (defvar sclang-grep-files nil)
 632 ;; (defvar sclang-grep-prompt "Grep: ")
 633
 634 ;; (defun sclang-grep-files (regexp)
 635 ;;   (interactive
 636 ;;    (let ((grep-default (or (when current-prefix-arg (sclang-symbol-at-point))
 637 ;;                         (car sclang-grep-history))))
 638 ;;      (list (read-from-minibuffer sclang-grep-prompt
 639 ;;                               grep-default
 640 ;;                               nil nil 'sclang-grep-history))))
 641 ;;   (grep-compute-defaults)
 642 ;;   (grep (concat grep-program
 643 ;;              " -n"
 644 ;;              (and sclang-grep-case-fold-search " -i")
 645 ;;              " -e" regexp
 646 ;;              " " (mapconcat 'shell-quote-argument sclang-grep-files " "))))
 647
 648 ;; =====================================================================
 649 ;; workspace
 650 ;; =====================================================================
 651
 652 (defcustom sclang-show-workspace-on-startup t
 653   "*If non-nil show the workspace buffer on library startup."
 654   :group 'sclang-interface
 655   :type 'boolean)
 656
 657 (defconst sclang-workspace-buffer (sclang-make-buffer-name "Workspace"))
 658
 659 (defun sclang-fill-workspace-mode-map (map)
 660   (define-key map "\C-c}" 'bury-buffer))
 661
 662 (defun sclang-switch-to-workspace ()
 663   (interactive)
 664   (let ((buffer (get-buffer sclang-workspace-buffer)))
 665     (unless buffer
 666       (setq buffer (get-buffer-create sclang-workspace-buffer))
 667       (with-current-buffer buffer
 668         (sclang-mode)
 669         (let ((map (make-sparse-keymap)))
 670           (set-keymap-parent map sclang-mode-map)
 671           (sclang-fill-workspace-mode-map map)
 672           (use-local-map map))
 673         (let ((line (concat "// " (make-string 69 ?=) "\n")))
 674           (insert line)
 675           (insert "// SuperCollider Workspace\n")
 676           (insert line)
 677 ;;        (insert "// using HTML Help: C-c C-h as usual, then switch to w3m buffer\n")
 678 ;;        (insert "// and do M-x sclang-minor-mode in order te enable sclang code execution\n")
 679 ;;        (insert line)
 680           (insert "\n"))
 681         (set-buffer-modified-p nil)
 682         ;; cwd to sclang-runtime-directory
 683         (if (and sclang-runtime-directory
 684                  (file-directory-p sclang-runtime-directory))
 685             (setq default-directory sclang-runtime-directory))))
 686     (switch-to-buffer buffer)))
 687
 688 (add-hook 'sclang-library-startup-hook
 689           (lambda () (and sclang-show-workspace-on-startup
 690                           (sclang-switch-to-workspace))))
 691
 692 ;; =====================================================================
 693 ;; language control
 694 ;; =====================================================================
 695
 696 (defun sclang-main-run ()
 697   (interactive)
 698   (sclang-eval-string "thisProcess.run"))
 699
 700 (defun sclang-main-stop ()
 701   (interactive)
 702   (sclang-eval-string "thisProcess.stop"))
 703
 704 ;; =====================================================================
 705 ;; default command handlers
 706 ;; =====================================================================
 707
 708 (sclang-set-command-handler '_init (lambda (arg) (sclang-on-library-startup)))
 709
 710 (sclang-set-command-handler
 711  '_eval
 712  (lambda (expr)
 713    (when (stringp expr)
 714      (eval (read expr)))))
 715
 716 ;; =====================================================================
 717 ;; module setup
 718 ;; =====================================================================
 719
 720 ;; shutdown process cleanly
 721 (add-hook 'kill-emacs-hook (lambda () (sclang-stop)))
 722
 723 ;; add command line switches
 724 (add-to-list 'command-switch-alist
 725              (cons "-sclang"
 726                    (lambda (switch)
 727                      (sclang-start))))
 728
 729 (add-to-list 'command-switch-alist
 730              (cons "-sclang-debug"
 731                    (lambda (switch)
 732                      (sclang-toggle-debug-command-handler 1))))
 733
 734 (add-to-list 'command-switch-alist
 735              (cons "-scmail"
 736                    (lambda (switch)
 737                      (sclang-start)
 738                      (when command-line-args-left
 739                        (let ((file (pop command-line-args-left)))
 740                          (with-current-buffer (get-buffer-create sclang-workspace-buffer)
 741                            (and (file-exists-p file) (insert-file-contents file))
 742                            (set-buffer-modified-p nil)
 743                            (sclang-mode)
 744                            (switch-to-buffer (current-buffer))))))))
 745
 746 (provide 'sclang-interp)
 747
 748 ;; EOF