714 lines
23 KiB
EmacsLisp
714 lines
23 KiB
EmacsLisp
|
;; copyright 2003-2005 stefan kersten <steve@k-hornz.de>
|
||
|
|
;;
|
||
|
|
;; This program is free software; you can redistribute it and/or
|
||
|
|
;; modify it under the terms of the GNU General Public License as
|
||
|
|
;; published by the Free Software Foundation; either version 2 of the
|
||
|
|
;; License, or (at your option) any later version.
|
||
|
|
;;
|
||
|
|
;; This program is distributed in the hope that it will be useful, but
|
||
|
|
;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
|
|
;; General Public License for more details.
|
||
|
|
;;
|
||
|
|
;; You should have received a copy of the GNU General Public License
|
||
|
|
;; along with this program; if not, write to the Free Software
|
||
|
|
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
|
||
|
|
;; USA
|
||
|
|
|
||
|
|
(eval-when-compile
|
||
|
|
(require 'cl))
|
||
|
|
|
||
|
|
(eval-and-compile
|
||
|
|
(require 'sclang-util))
|
||
|
|
|
||
|
|
;; =====================================================================
|
||
|
|
;; post buffer access
|
||
|
|
;; =====================================================================
|
||
|
|
|
||
|
|
;; FIXME: everything will fail when renaming the post buffer!
|
||
|
|
|
||
|
|
(defconst sclang-post-buffer (sclang-make-buffer-name "PostBuffer")
|
||
|
|
"Name of the SuperCollider process output buffer.")
|
||
|
|
|
||
|
|
(defconst sclang-bullet-latin-1 (string-to-char (decode-coding-string "\xa5" 'utf-8))
|
||
|
|
"Character for highlighting errors (latin-1).")
|
||
|
|
|
||
|
|
(defconst sclang-bullet-utf-8 (string-to-char (decode-coding-string "\xe2\x80\xa2" 'utf-8))
|
||
|
|
"Character for highlighting errors (utf-8).")
|
||
|
|
|
||
|
|
(defconst sclang-parse-error-regexp
|
||
|
|
"^\\(WARNING\\|ERROR\\): .*\n[\t ]*in file '\\([^']\+\\)'\n[\t ]*line \\([0-9]\+\\) char \\([0-9]\+\\)"
|
||
|
|
"Regular expression matching parse errors during library compilation.")
|
||
|
|
|
||
|
|
(defcustom sclang-max-post-buffer-size 0
|
||
|
|
"*Maximum number of characters to insert in post buffer.
|
||
|
|
Zero means no limit."
|
||
|
|
:group 'sclang-interface
|
||
|
|
:version "21.3"
|
||
|
|
:type 'integer)
|
||
|
|
|
||
|
|
(defcustom sclang-auto-scroll-post-buffer nil
|
||
|
|
"*Automatically scroll post buffer on output regardless of point position.
|
||
|
|
Default behavior is to only scroll when point is not at end of buffer."
|
||
|
|
:group 'sclang-interface
|
||
|
|
:version "21.3"
|
||
|
|
:type 'boolean)
|
||
|
|
|
||
|
|
(defun sclang-get-post-buffer ()
|
||
|
|
(get-buffer-create sclang-post-buffer))
|
||
|
|
|
||
|
|
(defmacro with-sclang-post-buffer (&rest body)
|
||
|
|
`(with-current-buffer (sclang-get-post-buffer)
|
||
|
|
,@body))
|
||
|
|
|
||
|
|
;; (defun sclang-post-string (string)
|
||
|
|
;; (with-sclang-post-buffer
|
||
|
|
;; (let ((eobp (mapcar (lambda (w)
|
||
|
|
;; (cons w (= (window-point w) (point-max))))
|
||
|
|
;; (get-buffer-window-list (current-buffer) nil t))))
|
||
|
|
;; (save-excursion
|
||
|
|
;; ;; insert STRING into process buffer
|
||
|
|
;; (goto-char (point-max))
|
||
|
|
;; (insert string))
|
||
|
|
;; (dolist (assoc eobp)
|
||
|
|
;; (when (cdr assoc)
|
||
|
|
;; (save-selected-window
|
||
|
|
;; (let ((window (car assoc)))
|
||
|
|
;; (select-window window)
|
||
|
|
;; (set-window-point window (point-max))
|
||
|
|
;; (recenter -1))))))))
|
||
|
|
|
||
|
|
;; (defun sclang-post-string (string &optional proc)
|
||
|
|
;; (let* ((buffer (process-buffer proc))
|
||
|
|
;; (window (display-buffer buffer)))
|
||
|
|
;; (with-current-buffer buffer
|
||
|
|
;; (let ((moving (= (point) (process-mark proc))))
|
||
|
|
;; (save-excursion
|
||
|
|
;; ;; Insert the text, advancing the process marker.
|
||
|
|
;; (goto-char (process-mark proc))
|
||
|
|
;; (insert string)
|
||
|
|
;; (set-marker (process-mark proc) (point)))
|
||
|
|
;; (when moving
|
||
|
|
;; (goto-char (process-mark proc))
|
||
|
|
;; (set-window-point window (process-mark proc)))))))
|
||
|
|
|
||
|
|
(defun sclang-show-post-buffer (&optional eob-p)
|
||
|
|
"Show SuperCollider process buffer.
|
||
|
|
If EOB-P is non-nil, positions cursor at end of buffer."
|
||
|
|
(interactive "P")
|
||
|
|
(with-sclang-post-buffer
|
||
|
|
(let ((window (display-buffer (current-buffer) :frame t)))
|
||
|
|
(when eob-p
|
||
|
|
(goto-char (point-max))
|
||
|
|
(save-selected-window
|
||
|
|
(set-window-point window (point-max)))))))
|
||
|
|
|
||
|
|
(defun sclang-clear-post-buffer ()
|
||
|
|
"Clear the output buffer."
|
||
|
|
(interactive)
|
||
|
|
(with-sclang-post-buffer (erase-buffer)))
|
||
|
|
|
||
|
|
(defun sclang-init-post-buffer ()
|
||
|
|
"Initialize post buffer."
|
||
|
|
(get-buffer-create sclang-post-buffer)
|
||
|
|
(with-sclang-post-buffer
|
||
|
|
;; setup sclang mode
|
||
|
|
(sclang-mode)
|
||
|
|
(set (make-local-variable 'font-lock-fontify-region-function)
|
||
|
|
(lambda (&rest args)))
|
||
|
|
;; setup compilation mode
|
||
|
|
(compilation-minor-mode)
|
||
|
|
(set (make-variable-buffer-local 'compilation-error-screen-columns) nil)
|
||
|
|
(set (make-variable-buffer-local 'compilation-error-regexp-alist)
|
||
|
|
(cons (list sclang-parse-error-regexp 2 3 4) compilation-error-regexp-alist))
|
||
|
|
(set (make-variable-buffer-local 'compilation-parse-errors-function)
|
||
|
|
(lambda (limit-search find-at-least)
|
||
|
|
(compilation-parse-errors limit-search find-at-least)))
|
||
|
|
(set (make-variable-buffer-local 'compilation-parse-errors-filename-function)
|
||
|
|
(lambda (file-name)
|
||
|
|
file-name)))
|
||
|
|
(sclang-clear-post-buffer)
|
||
|
|
(sclang-show-post-buffer))
|
||
|
|
|
||
|
|
;; =====================================================================
|
||
|
|
;; interpreter interface
|
||
|
|
;; =====================================================================
|
||
|
|
|
||
|
|
(defconst sclang-process "SCLang"
|
||
|
|
"Name of the SuperCollider interpreter subprocess.")
|
||
|
|
|
||
|
|
(defcustom sclang-program "sclang"
|
||
|
|
"*Name of the SuperCollider interpreter program."
|
||
|
|
:group 'sclang-programs
|
||
|
|
:version "21.3"
|
||
|
|
:type 'string)
|
||
|
|
|
||
|
|
(defcustom sclang-runtime-directory ""
|
||
|
|
"*Path to the SuperCollider runtime directory."
|
||
|
|
:group 'sclang-options
|
||
|
|
:version "21.3"
|
||
|
|
:type 'directory
|
||
|
|
:options '(:must-match))
|
||
|
|
|
||
|
|
(defcustom sclang-library-configuration-file ""
|
||
|
|
"*Path of the library configuration file."
|
||
|
|
:group 'sclang-options
|
||
|
|
:version "21.3"
|
||
|
|
:type 'file
|
||
|
|
:options '(:must-match))
|
||
|
|
|
||
|
|
(defcustom sclang-heap-size ""
|
||
|
|
"*Initial heap size."
|
||
|
|
:group 'sclang-options
|
||
|
|
:version "21.3"
|
||
|
|
:type 'string)
|
||
|
|
|
||
|
|
(defcustom sclang-heap-growth ""
|
||
|
|
"*Heap growth."
|
||
|
|
:group 'sclang-options
|
||
|
|
:version "21.3"
|
||
|
|
:type 'string)
|
||
|
|
|
||
|
|
(defcustom sclang-udp-port -1
|
||
|
|
"*UDP listening port."
|
||
|
|
:group 'sclang-options
|
||
|
|
:version "21.3"
|
||
|
|
:type 'integer)
|
||
|
|
|
||
|
|
(defcustom sclang-main-run nil
|
||
|
|
"*Call Main.run on startup."
|
||
|
|
:group 'sclang-options
|
||
|
|
:version "21.3"
|
||
|
|
:type 'boolean)
|
||
|
|
|
||
|
|
(defcustom sclang-main-stop nil
|
||
|
|
"*Call Main.stop on shutdown."
|
||
|
|
:group 'sclang-options
|
||
|
|
:version "21.3"
|
||
|
|
:type 'boolean)
|
||
|
|
|
||
|
|
;; =====================================================================
|
||
|
|
;; helper functions
|
||
|
|
;; =====================================================================
|
||
|
|
|
||
|
|
(defun sclang-get-process ()
|
||
|
|
(get-process sclang-process))
|
||
|
|
|
||
|
|
;; =====================================================================
|
||
|
|
;; library startup/shutdown
|
||
|
|
;; =====================================================================
|
||
|
|
|
||
|
|
(defvar sclang-library-initialized-p nil)
|
||
|
|
|
||
|
|
(defcustom sclang-library-startup-hook nil
|
||
|
|
"*Hook run after initialization of the SCLang process."
|
||
|
|
:group 'sclang-interface
|
||
|
|
:type 'hook)
|
||
|
|
|
||
|
|
(defcustom sclang-library-shutdown-hook nil
|
||
|
|
"*Hook run before deletion of the SCLang process."
|
||
|
|
:group 'sclang-interface
|
||
|
|
:type 'hook)
|
||
|
|
|
||
|
|
;; library initialization works like this:
|
||
|
|
;;
|
||
|
|
;; * emacs starts sclang with SCLANG_COMMAND_FIFO set in the environment
|
||
|
|
;; * sclang opens fifo for communication with emacs during class tree
|
||
|
|
;; initialization
|
||
|
|
;; * sclang sends '_init' command
|
||
|
|
;; * '_init' command handler calls sclang-on-library-startup to complete
|
||
|
|
;; initialization
|
||
|
|
|
||
|
|
(defun sclang-library-initialized-p ()
|
||
|
|
(and (sclang-get-process)
|
||
|
|
sclang-library-initialized-p))
|
||
|
|
|
||
|
|
(defun sclang-on-library-startup ()
|
||
|
|
(sclang-message "Initializing library...")
|
||
|
|
(setq sclang-library-initialized-p t)
|
||
|
|
(run-hooks 'sclang-library-startup-hook)
|
||
|
|
(sclang-message "Initializing library...done"))
|
||
|
|
|
||
|
|
(defun sclang-on-library-shutdown ()
|
||
|
|
(run-hooks 'sclang-library-shutdown-hook)
|
||
|
|
(setq sclang-library-initialized-p nil))
|
||
|
|
|
||
|
|
;; =====================================================================
|
||
|
|
;; process hooks
|
||
|
|
;; =====================================================================
|
||
|
|
|
||
|
|
(defun sclang-process-sentinel (proc msg)
|
||
|
|
(with-sclang-post-buffer
|
||
|
|
(goto-char (point-max))
|
||
|
|
(insert
|
||
|
|
(if (and (bolp) (eolp)) "\n" "\n\n")
|
||
|
|
(format "*** %s %s ***" proc (substring msg 0 -1))
|
||
|
|
"\n\n"))
|
||
|
|
(when (memq (process-status proc) '(exit signal))
|
||
|
|
(sclang-on-library-shutdown)))
|
||
|
|
|
||
|
|
(defun sclang-process-filter (process string)
|
||
|
|
(let ((buffer (process-buffer process)))
|
||
|
|
(with-current-buffer buffer
|
||
|
|
(when (and (> sclang-max-post-buffer-size 0)
|
||
|
|
(> (buffer-size) sclang-max-post-buffer-size))
|
||
|
|
(erase-buffer))
|
||
|
|
(let ((move-point (or sclang-auto-scroll-post-buffer
|
||
|
|
(= (point) (process-mark process)))))
|
||
|
|
(save-excursion
|
||
|
|
;; replace mac-roman bullet with unicode character
|
||
|
|
(subst-char-in-string sclang-bullet-latin-1 sclang-bullet-utf-8 string t)
|
||
|
|
;; insert the text, advancing the process marker.
|
||
|
|
(goto-char (process-mark process))
|
||
|
|
(insert string)
|
||
|
|
(set-marker (process-mark process) (point)))
|
||
|
|
(when move-point
|
||
|
|
(goto-char (process-mark process))
|
||
|
|
(walk-windows
|
||
|
|
(lambda (window)
|
||
|
|
(when (eq buffer (window-buffer window))
|
||
|
|
(set-window-point window (process-mark process))))
|
||
|
|
nil t))))))
|
||
|
|
|
||
|
|
;; =====================================================================
|
||
|
|
;; process startup/shutdown
|
||
|
|
;; =====================================================================
|
||
|
|
|
||
|
|
(defun sclang-memory-option-p (string)
|
||
|
|
(let ((case-fold-search nil))
|
||
|
|
(string-match "^[1-9][0-9]*[km]?$" string)))
|
||
|
|
|
||
|
|
(defun sclang-port-option-p (number)
|
||
|
|
(and (>= number 0) (<= number #XFFFF)))
|
||
|
|
|
||
|
|
(defun sclang-make-options ()
|
||
|
|
(let ((default-directory "")
|
||
|
|
(res ()))
|
||
|
|
(flet ((append-option
|
||
|
|
(option &optional value)
|
||
|
|
(setq res (append res (list option) (and value (list value))))))
|
||
|
|
(if (file-directory-p sclang-runtime-directory)
|
||
|
|
(append-option "-d" (expand-file-name sclang-runtime-directory)))
|
||
|
|
(if (file-exists-p sclang-library-configuration-file)
|
||
|
|
(append-option "-l" (expand-file-name sclang-library-configuration-file)))
|
||
|
|
(if (sclang-memory-option-p sclang-heap-size)
|
||
|
|
(append-option "-m" sclang-heap-size))
|
||
|
|
(if (sclang-memory-option-p sclang-heap-growth)
|
||
|
|
(append-option "-g" sclang-heap-growth))
|
||
|
|
(if (sclang-port-option-p sclang-udp-port)
|
||
|
|
(append-option "-u" (number-to-string sclang-udp-port)))
|
||
|
|
(if sclang-main-run
|
||
|
|
(append-option "-r"))
|
||
|
|
(if sclang-main-stop
|
||
|
|
(append-option "-s"))
|
||
|
|
res)))
|
||
|
|
|
||
|
|
(defun sclang-start ()
|
||
|
|
"Start SuperCollider process."
|
||
|
|
(interactive)
|
||
|
|
(sclang-stop)
|
||
|
|
(sit-for 1)
|
||
|
|
(sclang-init-post-buffer)
|
||
|
|
(sclang-start-command-process)
|
||
|
|
(let ((process-connection-type nil))
|
||
|
|
(let ((proc (apply 'start-process
|
||
|
|
sclang-process sclang-post-buffer
|
||
|
|
sclang-program (sclang-make-options))))
|
||
|
|
(set-process-sentinel proc 'sclang-process-sentinel)
|
||
|
|
(set-process-filter proc 'sclang-process-filter)
|
||
|
|
(set-process-coding-system proc 'mule-utf-8 'mule-utf-8)
|
||
|
|
(process-kill-without-query proc)
|
||
|
|
proc)))
|
||
|
|
|
||
|
|
(defun sclang-kill ()
|
||
|
|
"Kill SuperCollider process."
|
||
|
|
(interactive)
|
||
|
|
(when (sclang-get-process)
|
||
|
|
(kill-process sclang-process)
|
||
|
|
(delete-process sclang-process)))
|
||
|
|
|
||
|
|
(defun sclang-stop ()
|
||
|
|
"Stop SuperCollider process."
|
||
|
|
(interactive)
|
||
|
|
(when (sclang-get-process)
|
||
|
|
(process-send-eof sclang-process)
|
||
|
|
(let ((tries 4)
|
||
|
|
(i 0))
|
||
|
|
(while (and (sclang-get-process)
|
||
|
|
(< i tries))
|
||
|
|
(incf i)
|
||
|
|
(sit-for 0.5))))
|
||
|
|
(sclang-kill)
|
||
|
|
(sclang-release-command-fifo))
|
||
|
|
|
||
|
|
;; =====================================================================
|
||
|
|
;; command process
|
||
|
|
;; =====================================================================
|
||
|
|
|
||
|
|
(defcustom sclang-mkfifo-program "mkfifo"
|
||
|
|
"*Name of the \"mkfifo\" program.
|
||
|
|
|
||
|
|
Change this if \"mkfifo\" has a non-standard name or location."
|
||
|
|
:group 'sclang-programs
|
||
|
|
:type 'string)
|
||
|
|
|
||
|
|
(defcustom sclang-cat-program "cat"
|
||
|
|
"*Name of the \"cat\" program.
|
||
|
|
|
||
|
|
Change this if \"cat\" has a non-standard name or location."
|
||
|
|
:group 'sclang-programs
|
||
|
|
:type 'string)
|
||
|
|
|
||
|
|
(defconst sclang-command-process "SCLang Command"
|
||
|
|
"Subprocess for receiving command results from sclang.")
|
||
|
|
|
||
|
|
(defvar sclang-command-fifo nil
|
||
|
|
"FIFO for communicating with the subprocess.")
|
||
|
|
|
||
|
|
(defun sclang-delete-command-fifo ()
|
||
|
|
(and sclang-command-fifo
|
||
|
|
(file-exists-p sclang-command-fifo)
|
||
|
|
(delete-file sclang-command-fifo)))
|
||
|
|
|
||
|
|
(defun sclang-release-command-fifo ()
|
||
|
|
(sclang-delete-command-fifo)
|
||
|
|
(setq sclang-command-fifo nil))
|
||
|
|
|
||
|
|
(defun sclang-create-command-fifo ()
|
||
|
|
(setq sclang-command-fifo (make-temp-name
|
||
|
|
(expand-file-name
|
||
|
|
"sclang-command-fifo." temporary-file-directory)))
|
||
|
|
(sclang-delete-command-fifo)
|
||
|
|
(let ((res (call-process sclang-mkfifo-program
|
||
|
|
nil t t
|
||
|
|
sclang-command-fifo)))
|
||
|
|
(unless (eq 0 res)
|
||
|
|
(message "SCLang: Couldn't create command fifo")
|
||
|
|
(setq sclang-command-fifo nil))))
|
||
|
|
|
||
|
|
(defun sclang-command-process-sentinel (proc msg)
|
||
|
|
(and (memq (process-status proc) '(exit signal))
|
||
|
|
(sclang-release-command-fifo)))
|
||
|
|
|
||
|
|
(defun sclang-start-command-process ()
|
||
|
|
(sclang-create-command-fifo)
|
||
|
|
(when sclang-command-fifo
|
||
|
|
;; sclang gets the fifo path via the environment
|
||
|
|
(setenv "SCLANG_COMMAND_FIFO" sclang-command-fifo)
|
||
|
|
(let ((process-connection-type nil))
|
||
|
|
(let ((proc (start-process
|
||
|
|
sclang-command-process nil
|
||
|
|
sclang-cat-program sclang-command-fifo)))
|
||
|
|
(set-process-sentinel proc 'sclang-command-process-sentinel)
|
||
|
|
(set-process-filter proc 'sclang-command-process-filter)
|
||
|
|
;; this is important. use a unibyte stream without eol
|
||
|
|
;; conversion for communication.
|
||
|
|
(set-process-coding-system proc 'no-conversion 'no-conversion)
|
||
|
|
(process-kill-without-query proc)))
|
||
|
|
(unless (get-process sclang-command-process)
|
||
|
|
(message "SCLang: Couldn't start command process"))))
|
||
|
|
|
||
|
|
(defvar sclang-command-process-previous nil
|
||
|
|
"Unprocessed command process output.")
|
||
|
|
|
||
|
|
(defun sclang-command-process-filter (proc string)
|
||
|
|
(when sclang-command-process-previous
|
||
|
|
(setq string (concat sclang-command-process-previous string)))
|
||
|
|
(let (end)
|
||
|
|
(while (and (> (length string) 3)
|
||
|
|
(>= (length string)
|
||
|
|
(setq end (+ 4 (sclang-string-to-int32 string)))))
|
||
|
|
(sclang-handle-command-result (car (read-from-string string 4 end)))
|
||
|
|
(setq string (substring string end))))
|
||
|
|
(setq sclang-command-process-previous string))
|
||
|
|
|
||
|
|
;; =====================================================================
|
||
|
|
;; command interface
|
||
|
|
;; =====================================================================
|
||
|
|
|
||
|
|
;; symbol property: sclang-command-handler
|
||
|
|
|
||
|
|
(defun sclang-set-command-handler (symbol function)
|
||
|
|
(put symbol 'sclang-command-handler function))
|
||
|
|
|
||
|
|
(defun sclang-perform-command (symbol &rest args)
|
||
|
|
(sclang-eval-string (sclang-format
|
||
|
|
"Emacs.lispPerformCommand(%o, %o, true)"
|
||
|
|
symbol args)))
|
||
|
|
|
||
|
|
(defun sclang-perform-command-no-result (symbol &rest args)
|
||
|
|
(sclang-eval-string (sclang-format
|
||
|
|
"Emacs.lispPerformCommand(%o, %o, false)"
|
||
|
|
symbol args)))
|
||
|
|
|
||
|
|
(defun sclang-default-command-handler (fun arg)
|
||
|
|
"Default command handler.
|
||
|
|
Displays short message on error."
|
||
|
|
(condition-case nil
|
||
|
|
(funcall fun arg)
|
||
|
|
(error (sclang-message "Error in command handler") nil)))
|
||
|
|
|
||
|
|
(defun sclang-debug-command-handler (fun arg)
|
||
|
|
"Debugging command handler.
|
||
|
|
Enters debugger on error."
|
||
|
|
(let ((debug-on-error t)
|
||
|
|
(debug-on-signal t))
|
||
|
|
(funcall fun arg)))
|
||
|
|
|
||
|
|
(defvar sclang-command-handler 'sclang-default-command-handler
|
||
|
|
"Function called when handling command result.")
|
||
|
|
|
||
|
|
(defun sclang-toggle-debug-command-handler (&optional arg)
|
||
|
|
"Toggle debugging of command handler.
|
||
|
|
With arg, activate debugging iff arg is positive."
|
||
|
|
(interactive "P")
|
||
|
|
(setq sclang-command-handler
|
||
|
|
(if (or (and arg (> arg 0))
|
||
|
|
(eq sclang-command-handler 'sclang-debug-command-handler))
|
||
|
|
'sclang-default-command-handler
|
||
|
|
'sclang-default-command-handler))
|
||
|
|
(sclang-message "Command handler debugging %s."
|
||
|
|
(if (eq sclang-command-handler 'sclang-debug-command-handler)
|
||
|
|
"enabled"
|
||
|
|
"disabled")))
|
||
|
|
|
||
|
|
(defun sclang-handle-command-result (list)
|
||
|
|
(condition-case nil
|
||
|
|
(let ((fun (get (nth 0 list) 'sclang-command-handler))
|
||
|
|
(arg (nth 1 list))
|
||
|
|
(id (nth 2 list)))
|
||
|
|
(when (functionp fun)
|
||
|
|
(let ((res (funcall sclang-command-handler fun arg)))
|
||
|
|
(when id
|
||
|
|
(sclang-eval-string
|
||
|
|
(sclang-format "Emacs.lispHandleCommandResult(%o, %o)" id res))))))
|
||
|
|
(error nil)))
|
||
|
|
|
||
|
|
;; =====================================================================
|
||
|
|
;; code evaluation
|
||
|
|
;; =====================================================================
|
||
|
|
|
||
|
|
(defconst sclang-token-interpret-cmd-line (char-to-string #X1b))
|
||
|
|
(defconst sclang-token-interpret-print-cmd-line (char-to-string #X0c))
|
||
|
|
|
||
|
|
(defcustom sclang-eval-line-forward t
|
||
|
|
"*If non-nil `sclang-eval-line' advances to the next line."
|
||
|
|
:group 'sclang-interface
|
||
|
|
:type 'boolean)
|
||
|
|
|
||
|
|
(defun sclang-send-string (token string &optional force)
|
||
|
|
(let ((proc (sclang-get-process)))
|
||
|
|
(when (and proc (or (sclang-library-initialized-p) force))
|
||
|
|
(process-send-string proc (concat string token))
|
||
|
|
string)))
|
||
|
|
|
||
|
|
(defun sclang-eval-string (string &optional print-p)
|
||
|
|
"Send STRING to the sclang process for evaluation and print the result
|
||
|
|
if PRINT-P is non-nil. Return STRING if successful, otherwise nil."
|
||
|
|
(sclang-send-string
|
||
|
|
(if print-p sclang-token-interpret-print-cmd-line sclang-token-interpret-cmd-line)
|
||
|
|
string))
|
||
|
|
|
||
|
|
(defun sclang-eval-expression (string &optional silent-p)
|
||
|
|
"Execute STRING as SuperCollider code."
|
||
|
|
(interactive "sEval: \nP")
|
||
|
|
(sclang-eval-string string (not silent-p)))
|
||
|
|
|
||
|
|
(defun sclang-eval-line (&optional silent-p)
|
||
|
|
"Execute the current line as SuperCollider code."
|
||
|
|
(interactive "P")
|
||
|
|
(let ((string (sclang-line-at-point)))
|
||
|
|
(when string
|
||
|
|
(sclang-eval-string string (not silent-p)))
|
||
|
|
(and sclang-eval-line-forward
|
||
|
|
(/= (line-end-position) (point-max))
|
||
|
|
(next-line 1))
|
||
|
|
string))
|
||
|
|
|
||
|
|
(defun sclang-eval-region (&optional silent-p)
|
||
|
|
"Execute the region as SuperCollider code."
|
||
|
|
(interactive "P")
|
||
|
|
(sclang-eval-string
|
||
|
|
(buffer-substring-no-properties (region-beginning) (region-end))
|
||
|
|
(not silent-p)))
|
||
|
|
|
||
|
|
(defun sclang-eval-region-or-line (&optional silent-p)
|
||
|
|
(interactive "P")
|
||
|
|
(if (and transient-mark-mode mark-active)
|
||
|
|
(sclang-eval-region silent-p)
|
||
|
|
(sclang-eval-line silent-p)))
|
||
|
|
|
||
|
|
(defun sclang-eval-defun (&optional silent-p)
|
||
|
|
(interactive "P")
|
||
|
|
(let ((string (sclang-defun-at-point)))
|
||
|
|
(when (and string (string-match "^(" string))
|
||
|
|
(sclang-eval-string string (not silent-p))
|
||
|
|
string)))
|
||
|
|
|
||
|
|
(defvar sclang-eval-results nil
|
||
|
|
"Save results of sync SCLang evaluation.")
|
||
|
|
|
||
|
|
(sclang-set-command-handler
|
||
|
|
'evalSCLang
|
||
|
|
(lambda (arg) (push arg sclang-eval-results)))
|
||
|
|
|
||
|
|
(defun sclang-eval-sync (string)
|
||
|
|
"Eval STRING in sclang and return result as a lisp value."
|
||
|
|
(let ((proc (get-process sclang-command-process)))
|
||
|
|
(if (and (processp proc) (eq (process-status proc) 'run))
|
||
|
|
(let ((time (current-time)) (tick 10000) elt)
|
||
|
|
(sclang-perform-command 'evalSCLang string time)
|
||
|
|
(while (and (> (decf tick) 0)
|
||
|
|
(not (setq elt (find time sclang-eval-results
|
||
|
|
:key #'car :test #'equal))))
|
||
|
|
(accept-process-output proc 0 100))
|
||
|
|
(if elt
|
||
|
|
(prog1 (if (eq (nth 1 elt) 'ok)
|
||
|
|
(nth 2 elt)
|
||
|
|
(setq sclang-eval-results (delq elt sclang-eval-results))
|
||
|
|
(signal 'sclang-error (nth 2 elt)))
|
||
|
|
(setq sclang-eval-results (delq elt sclang-eval-results)))
|
||
|
|
(error "SCLang sync eval timeout")))
|
||
|
|
(error "SCLang Command process not running"))))
|
||
|
|
|
||
|
|
;; =====================================================================
|
||
|
|
;; searching
|
||
|
|
;; =====================================================================
|
||
|
|
|
||
|
|
;; (defun sclang-help-file-paths ()
|
||
|
|
;; "Return a list of help file paths."
|
||
|
|
|
||
|
|
|
||
|
|
;; (defun sclang-grep-help-files ()
|
||
|
|
;; (interactive)
|
||
|
|
;; (let ((sclang-grep-prompt "Search help files: ")
|
||
|
|
;; (sclang-grep-files (mapcar 'cdr sclang-help-topic-alist)))
|
||
|
|
;; (call-interactively 'sclang-grep-files)))
|
||
|
|
|
||
|
|
;; (defvar sclang-grep-history nil)
|
||
|
|
|
||
|
|
;; (defcustom sclang-grep-case-fold-search t
|
||
|
|
;; "*Non-nil if sclang-grep-files should ignore case."
|
||
|
|
;; :group 'sclang-interface
|
||
|
|
;; :version "21.4"
|
||
|
|
;; :type 'boolean)
|
||
|
|
|
||
|
|
;; (defvar sclang-grep-files nil)
|
||
|
|
;; (defvar sclang-grep-prompt "Grep: ")
|
||
|
|
|
||
|
|
;; (defun sclang-grep-files (regexp)
|
||
|
|
;; (interactive
|
||
|
|
;; (let ((grep-default (or (when current-prefix-arg (sclang-symbol-at-point))
|
||
|
|
;; (car sclang-grep-history))))
|
||
|
|
;; (list (read-from-minibuffer sclang-grep-prompt
|
||
|
|
;; grep-default
|
||
|
|
;; nil nil 'sclang-grep-history))))
|
||
|
|
;; (grep-compute-defaults)
|
||
|
|
;; (grep (concat grep-program
|
||
|
|
;; " -n"
|
||
|
|
;; (and sclang-grep-case-fold-search " -i")
|
||
|
|
;; " -e" regexp
|
||
|
|
;; " " (mapconcat 'shell-quote-argument sclang-grep-files " "))))
|
||
|
|
|
||
|
|
;; =====================================================================
|
||
|
|
;; workspace
|
||
|
|
;; =====================================================================
|
||
|
|
|
||
|
|
(defcustom sclang-show-workspace-on-startup t
|
||
|
|
"*If non-nil show the workspace buffer on library startup."
|
||
|
|
:group 'sclang-interface
|
||
|
|
:type 'boolean)
|
||
|
|
|
||
|
|
(defconst sclang-workspace-buffer (sclang-make-buffer-name "Workspace"))
|
||
|
|
|
||
|
|
(defun sclang-fill-workspace-mode-map (map)
|
||
|
|
(define-key map "\C-c}" 'bury-buffer))
|
||
|
|
|
||
|
|
(defun sclang-switch-to-workspace ()
|
||
|
|
(interactive)
|
||
|
|
(let ((buffer (get-buffer sclang-workspace-buffer)))
|
||
|
|
(unless buffer
|
||
|
|
(setq buffer (get-buffer-create sclang-workspace-buffer))
|
||
|
|
(with-current-buffer buffer
|
||
|
|
(sclang-mode)
|
||
|
|
(let ((map (make-sparse-keymap)))
|
||
|
|
(set-keymap-parent map sclang-mode-map)
|
||
|
|
(sclang-fill-workspace-mode-map map)
|
||
|
|
(use-local-map map))
|
||
|
|
(let ((line (concat "// " (make-string 69 ?=) "\n")))
|
||
|
|
(insert line)
|
||
|
|
(insert "// SuperCollider Workspace\n")
|
||
|
|
(insert line)
|
||
|
|
;; (insert "// using HTML Help: C-c C-h as usual, then switch to w3m buffer\n")
|
||
|
|
;; (insert "// and do M-x sclang-minor-mode in order te enable sclang code execution\n")
|
||
|
|
;; (insert line)
|
||
|
|
(insert "\n"))
|
||
|
|
(set-buffer-modified-p nil)
|
||
|
|
;; cwd to sclang-runtime-directory
|
||
|
|
(if (and sclang-runtime-directory
|
||
|
|
(file-directory-p sclang-runtime-directory))
|
||
|
|
(setq default-directory sclang-runtime-directory))))
|
||
|
|
(switch-to-buffer buffer)))
|
||
|
|
|
||
|
|
(add-hook 'sclang-library-startup-hook
|
||
|
|
(lambda () (and sclang-show-workspace-on-startup
|
||
|
|
(sclang-switch-to-workspace))))
|
||
|
|
|
||
|
|
;; =====================================================================
|
||
|
|
;; language control
|
||
|
|
;; =====================================================================
|
||
|
|
|
||
|
|
(defun sclang-main-run ()
|
||
|
|
(interactive)
|
||
|
|
(sclang-eval-string "thisProcess.run"))
|
||
|
|
|
||
|
|
(defun sclang-main-stop ()
|
||
|
|
(interactive)
|
||
|
|
(sclang-eval-string "thisProcess.stop"))
|
||
|
|
|
||
|
|
;; =====================================================================
|
||
|
|
;; default command handlers
|
||
|
|
;; =====================================================================
|
||
|
|
|
||
|
|
(sclang-set-command-handler '_init (lambda (arg) (sclang-on-library-startup)))
|
||
|
|
|
||
|
|
(sclang-set-command-handler
|
||
|
|
'_eval
|
||
|
|
(lambda (expr)
|
||
|
|
(when (stringp expr)
|
||
|
|
(eval (read expr)))))
|
||
|
|
|
||
|
|
;; =====================================================================
|
||
|
|
;; module setup
|
||
|
|
;; =====================================================================
|
||
|
|
|
||
|
|
;; shutdown process cleanly
|
||
|
|
(add-hook 'kill-emacs-hook (lambda () (sclang-stop)))
|
||
|
|
|
||
|
|
;; add command line switches
|
||
|
|
(add-to-list 'command-switch-alist
|
||
|
|
(cons "sclang"
|
||
|
|
(lambda (switch)
|
||
|
|
(sclang-start))))
|
||
|
|
|
||
|
|
(add-to-list 'command-switch-alist
|
||
|
|
(cons "sclang-debug"
|
||
|
|
(lambda (switch)
|
||
|
|
(sclang-toggle-debug-command-handler 1))))
|
||
|
|
|
||
|
|
(add-to-list 'command-switch-alist
|
||
|
|
(cons "scmail"
|
||
|
|
(lambda (switch)
|
||
|
|
(sclang-start)
|
||
|
|
(when command-line-args-left
|
||
|
|
(let ((file (pop command-line-args-left)))
|
||
|
|
(with-current-buffer (get-buffer-create sclang-workspace-buffer)
|
||
|
|
(and (file-exists-p file) (insert-file-contents file))
|
||
|
|
(set-buffer-modified-p nil)
|
||
|
|
(sclang-mode)
|
||
|
|
(switch-to-buffer (current-buffer))))))))
|
||
|
|
|
||
|
|
(provide 'sclang-interp)
|
||
|
|
|
||
|
|
;; EOF
|