move scel to editors

git-svn-id: https://supercollider.svn.sourceforge.net/svnroot/supercollider/trunk@8370 a380766d-ff14-0410-b294-a243070f3f08

README

@@ -0,0 +1,121 @@
+-*- text -*-
+------------------------------------------------------------------------
+SCEL -- SuperCollider/Emacs interface
+------------------------------------------------------------------------
+$Id"
+------------------------------------------------------------------------
+
+installation (requirements)
+---------------------------
+
+For the HTML help system, you will need emacs-w3m support.
+
+installation (default)
+-----------------------
+
+by default emacs-lisp files are installed in
+
+    $prefix/share/emacs/site-lisp
+
+SuperCollider files are put in
+
+    $prefix/share/SuperCollider/Extensions/scel
+
+the only thing you need to do is loading the sclang interface in your
+~/.emacs:
+
+    (require 'sclang)
+
+for the HTML help system to fully function also add
+	(require 'w3m)
+
+installation (detailed)
+------------------------
+
+put all *.el files in emacs' load-path. e.g. if you put them in
+~/emacs/, add the following lines to ~/.emacs (or whatever your init
+file is called):
+
+(add-to-list 'load-path "~/emacs")
+
+and then load the library:
+
+(require 'sclang)
+
+for the HTML help system to fully function also add
+	(require 'w3m)
+
+now put all *.sc files in sclang's library path, e.g. if you put them
+in a non-standard location, such as ~/SuperCollider/Emacs/, add the
+following to ~/.sclang.cfg:
+
++~/SuperCollider/Emacs
+
+(note normally this is not needed as they are put into sclang's library
+path during installation with scons).
+
+
+usage
+------
+
+in order to automatically start sclang when invoking emacs, use the
+following command line:
+
+$ emacs -sclang
+
+you're now ready to edit, inspect and execute sclang code!
+
+getting help
+-------------
+
+inside an sclang-mode buffer (e.g. by editing a .sc file), execute
+
+C-h m
+
+a window with key bindings in sclang-mode will pop up.
+
+C-x C-h lets you search for a help file
+
+C-M-h opens or switches to the Help browser (if no Help file has been opened, the default Help file will be opened)
+
+E copies the buffer, puts it in text mode and sclang-minor-mode, to enable you to edit the code parts to try out variations of the provided code in the help file. With C-M-h you can then return to the Help browser and browse further from the Help file.
+
+C-c C-e allows you to edit the source of the HTML file, for example if you want to improve it and commit it to the repository.
+
+To enable moving around in the help file with arrow keys add the following
+in your ~/.emacs:
+
+(eval-after-load "w3m"
+ '(progn
+ (define-key w3m-mode-map [left] 'backward-char)
+ (define-key w3m-mode-map [right] 'forward-char)
+ (define-key w3m-mode-map [up] 'previous-line)
+ (define-key w3m-mode-map [down] 'next-line)))
+
+This ensures that the arrow keys are just for moving through the document,
+and not from hyperlink to hyperlink, which is the default in w3m-mode.
+
+
+customization
+--------------
+
+to fine-tune the installation from within emacs' graphical
+customization interface, type
+
+M-x sclang-customize
+
+in particular, you will have to customize `sclang-runtime-directory'.
+
+server control
+---------------
+
+in the post buffer window, right-click on the server name; by default
+the two servers 'internal' and 'localhost' are available. you will get
+a menu with common server control operations.
+
+to select another server, step through the server list by
+left-clicking on the server name.
+
+servers instantiated from the language will automatically be available
+in the mode line.
+

el/sclang-browser.el

@@ -0,0 +1,183 @@
+;; copyright 2003 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
+
+(require 'sclang-util)
+(require 'view nil t)
+
+;; TODO: better factoring
+;; derive from view mode, make mode-map pluggable
+;; define derived mode for completion, definition, help
+
+(defun sclang-browser-fill-keymap (map)
+  (define-key map "\r" 'sclang-browser-follow-link)
+  (define-key map [mouse-2] 'sclang-browser-mouse-follow-link)
+  (define-key map "\t" 'sclang-browser-next-link)
+  (define-key map [backtab] 'sclang-browser-previous-link)
+  (define-key map [(shift tab)] 'sclang-browser-previous-link)
+  (define-key map [?q] 'sclang-browser-quit)
+  map)
+
+(defvar sclang-browser-mode-map (sclang-browser-fill-keymap (make-sparse-keymap)))
+(defvar sclang-browser-mode-hook nil)
+(defvar sclang-browser-show-hook nil)
+(defvar sclang-browser-link-function nil
+  "buffer local")
+(defvar sclang-browser-return-method nil
+  "buffer local")
+
+(defun sclang-browser-beginning-of-link ()
+  (interactive)
+  (when (get-text-property (point) 'sclang-browser-link)
+    (while (and (not (bobp))
+		(get-text-property (point) 'sclang-browser-link))
+      (forward-char -1))
+    (unless (bobp) (forward-char 1))
+    (point)))
+
+(defun sclang-browser-next-link (&optional n)
+  (interactive)
+  (let* ((n (or n 1))
+	 (prop 'sclang-browser-link)
+	 (fwd (>= n 0))
+	 (orig (point))
+	 (beg (if fwd (point-min) (point-max)))
+	 (end (if fwd (point-max) (point-min)))
+	 (inc (if fwd 1 -1))
+	 pos)
+    (when (get-text-property (point) prop)
+      (while (and (/= (point) beg)
+		  (get-text-property (point) prop))
+	(forward-char inc))
+      (if (= (point) beg) (goto-char end)))
+    (while (not (eq pos orig))
+      (cond ((get-text-property (point) prop)
+	     (sclang-browser-beginning-of-link)
+	     (setq pos orig))
+	    (t
+	     (if (= (point) end) (goto-char beg))
+	     (forward-char inc)
+	     (setq pos (point)))))))
+
+(defun sclang-browser-previous-link ()
+  (interactive)
+  (sclang-browser-next-link -1))
+
+(defun sclang-browser-follow-link (&optional pos)
+  (interactive)
+  (let* ((pos (or pos (point)))
+	 (data (get-text-property pos 'sclang-browser-link)))
+    (when (consp data)
+      (let ((fun (or (car data) sclang-browser-link-function))
+	    (arg (cdr data)))
+	(when (functionp fun)
+	  (condition-case nil
+	      (funcall fun arg)
+	    (error (sclang-message "Error in link function") nil)))))))
+
+(defun sclang-browser-mouse-follow-link (event)
+  (interactive "e")
+  (let* ((start (event-start event))
+	 (window (car start))
+	 (pos (cadr start)))
+    (with-current-buffer (window-buffer window)
+      (sclang-browser-follow-link pos))))
+
+(defun sclang-browser-mode ()
+  "Major mode for viewing hypertext and navigating references in it.
+Entry to this mode runs the normal hook `sclang-browser-mode-hook'.
+Commands:
+\\{sclang-browser-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map sclang-browser-mode-map)
+  (set-keymap-parent sclang-browser-mode-map view-mode-map)
+  (setq mode-name "Browser")
+  (setq major-mode 'sclang-browser-mode)
+  (set (make-local-variable 'sclang-browser-link-function) nil)
+  (set (make-local-variable 'sclang-browser-return-method) nil)
+  (set (make-local-variable 'font-lock-defaults) nil)
+  (view-mode)
+  (set (make-local-variable 'minor-mode-overriding-map-alist)
+       (list (cons 'view-mode sclang-browser-mode-map)))
+    (set (make-local-variable 'view-no-disable-on-exit) t)
+  (run-hooks 'sclang-browser-mode-hook))
+
+(defun sclang-browser-mode-setup ()
+  (sclang-browser-mode)
+  (setq buffer-read-only nil))
+
+(defun sclang-browser-mode-finish ()
+  (toggle-read-only 1)
+  (setq view-return-to-alist
+	(list (cons (selected-window) sclang-browser-return-method)))
+  (run-hooks 'sclang-browser-show-hook))
+
+(defun sclang-browser-quit ()
+  (interactive)
+  (when (eq major-mode 'sclang-browser-mode)
+    (kill-buffer (current-buffer))))
+
+(defun sclang-browser-make-link (link-text &optional link-data link-function)
+  (let ((map (make-sparse-keymap)))
+    (propertize link-text
+		'mouse-face 'highlight
+		;;'help-echo "mouse-2: follow link"
+		;;'keymap map
+		'sclang-browser-link (cons link-function link-data)
+		;;'sclang-browser-link-data link-data
+		;;'sclang-browser-link-function link-function)))
+		)))
+
+(defun sclang-display-browser (buffer-name output-function)
+  "header: what to insert in the buffer
+   link-list: list of (link-text link-function link-data)
+   link-function: function with args (link-text link-data)"
+  (let ((temp-buffer-setup-hook '(sclang-browser-mode-setup))
+	(temp-buffer-show-hook '(sclang-browser-mode-finish)))
+    (with-output-to-temp-buffer buffer-name
+      (with-current-buffer standard-output
+	;; record return method
+	(setq sclang-browser-return-method
+	      (cond ((special-display-p (buffer-name standard-output))
+		     ;; If the help output buffer is a special display buffer,
+		     ;; don't say anything about how to get rid of it.
+		     ;; First of all, the user will do that with the window
+		     ;; manager, not with Emacs.
+		     ;; Secondly, the buffer has not been displayed yet,
+		     ;; so we don't know whether its frame will be selected.
+		     (cons (selected-window) t))
+		    (display-buffer-reuse-frames
+		     (cons (selected-window) 'quit-window))
+		    ((not (one-window-p t))
+		     (cons (selected-window) 'quit-window))
+		    (pop-up-windows
+		     (cons (selected-window) t))
+		    (t
+		     (list (selected-window) (window-buffer)
+			   (window-start) (window-point)))))
+	(funcall output-function)))))
+
+(defmacro with-sclang-browser (buffer-name &rest body)
+  `(sclang-display-browser ,buffer-name (lambda () ,@body)))
+
+;; =====================================================================
+;; module setup
+;; =====================================================================
+
+(provide 'sclang-browser)
+
+;; EOF

el/sclang-document.el

@@ -0,0 +1,20 @@
+;; copyright 2003 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
+
+(provide 'sclang-document)
+
+;; EOF

el/sclang-help.el

@@ -0,0 +1,651 @@
+;; copyright 2003 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)
+  (require 'font-lock))
+
+;; (require 'w3m) ;; not needed during compilation
+(require 'sclang-util)
+(require 'sclang-interp)
+(require 'sclang-language)
+(require 'sclang-mode)
+(require 'sclang-vars)
+(require 'sclang-minor-mode)
+
+(defcustom sclang-help-directory "~/SuperCollider/Help"
+  "*Directory where the SuperCollider help files are kept. OBSOLETE."
+  :group 'sclang-interface
+  :version "21.3"
+  :type 'directory
+  :options '(:must-match))
+
+(defcustom sclang-help-path (list sclang-system-help-dir
+				  "~/share/SuperCollider/Help")
+  "*List of directories where SuperCollider help files are kept."
+  :group 'sclang-interface
+  :version "21.4"
+  :type '(repeat directory))
+
+(defconst sclang-extension-path (list sclang-system-extension-dir
+				      "~/share/SuperCollider/Extensions")
+  "List of SuperCollider extension directories.")
+
+(defcustom sclang-help-fill-column fill-column
+  "*Column beyond which automatic line-wrapping in RTF help files should happen."
+  :group 'sclang-interface
+  :version "21.3"
+  :type 'integer)
+
+(defcustom sclang-rtf-editor-program "ted"
+  "*Name of an RTF editor program used to edit SuperCollider help files."
+  :group 'sclang-programs
+  :version "21.3"
+  :type 'string)
+
+(defcustom sclang-html-editor-program "html"
+  "*Name of an HTML editor program used to edit SuperCollider help files."
+  :group 'sclang-programs
+  :version "21.3"
+  :type 'string)
+
+;; dynamically change certain html-tags when displaying in w3m-browser:
+
+(defcustom sclang-help-filters
+  '(("p\\.p\\([0-9]+\\)" . "#p\\1")
+    ("<p class=\"\\(.*\\)\">\\(.*\\)</p>" . "<div id=\"\\1\">\\2</div>"))
+  "list of pairs of (regexp . filter) defining html-tags to be replaced by the function sclang-help-substitute-for-filters"
+  :group 'sclang-interface
+  :type '(repeat (cons (string :tag "match") (string :tag "replacement"))))
+
+(defun sclang-help-substitute-for-filters (&rest args)
+  "substitute various tags in SCs html-docs"
+  (mapcar #'(lambda (filter)
+	      (let ((regexp (car filter))
+		    (to-string (cdr filter)))
+		(goto-char (point-min))
+		(while (re-search-forward regexp nil t)
+		  (replace-match to-string nil nil))))
+	  sclang-help-filters))
+
+;; w3m's content-filtering system
+(setq w3m-use-filter t)
+
+(eval-after-load "w3m-filter"
+  '(add-to-list 'w3m-filter-rules
+		;; run on all files read by w3m...
+                '(".*" sclang-help-substitute-for-filters)))
+
+
+;; dynamically change certain html-tags when displaying in w3m-browser:
+
+(defcustom sclang-help-filters
+  '(("p\\.p\\([0-9]+\\)" . "#p\\1")
+    ("<p class=\"\\(.*\\)\">\\(.*\\)</p>" . "<div id=\"\\1\">\\2</div>"))
+  "list of pairs of (regexp . filter) defining html-tags to be replaced by the function sclang-help-substitute-for-filters"
+  :group 'sclang-interface
+  :type '(repeat (cons (string :tag "match") (string :tag "replacement"))))
+
+(defun sclang-help-substitute-for-filters (&rest args)
+  "substitute various tags in SCs html-docs"
+  (mapcar #'(lambda (filter)
+	      (let ((regexp (car filter))
+		    (to-string (cdr filter)))
+		(goto-char (point-min))
+		(while (re-search-forward regexp nil t)
+		  (replace-match to-string nil nil))))
+	  sclang-help-filters))
+
+;; w3m's content-filtering system
+(setq w3m-use-filter t)
+
+(eval-after-load "w3m-filter"
+  '(add-to-list 'w3m-filter-rules
+		;; run on all files read by w3m...
+                '(".*" sclang-help-substitute-for-filters)))
+
+
+(defvar sclang-help-topic-alist nil
+  "Alist mapping help topics to file names.")
+
+(defvar sclang-help-topic-history nil
+  "List of recently invoked help topics.")
+;; (defvar sclang-help-topic-ring-length 32)
+;; (defvar sclang-help-topic-ring (make-ring sclang-help-topic-ring-length))
+
+(defconst sclang-special-help-topics
+  '(("/" . "division")
+    ("-" . "subtraction"))
+  "Alist of help topics with transcoded filenames.")
+
+(defvar sclang-help-file nil)
+(defvar sclang-current-help-file nil)
+(make-variable-buffer-local 'sclang-help-file)
+
+(defconst sclang-help-file-regexp
+  "\\(\\(\\(\\.help\\)?\\.\\(rtf\\|scd\\|html\\|htm\\)\\)\\|\\(\\.help\\.sc\\.html\\.htm\\)\\|\\.rtfd/TXT\\.rtf\\.html\\.htm\\)$"
+  "Regular expression matching help files.")
+
+;; =====================================================================
+;; utilities
+;; =====================================================================
+
+(defun sclang-get-help-file (topic)
+  (let ((topic (or (cdr (assoc topic sclang-special-help-topics)) topic)))
+    (cdr (assoc topic sclang-help-topic-alist))))
+
+(defun sclang-get-help-topic (file)
+  (let ((topic (car (rassoc file sclang-help-topic-alist))))
+    (or (car (rassoc topic sclang-special-help-topics)) topic)))
+
+(defun sclang-help-buffer-name (topic)
+  (sclang-make-buffer-name (concat "Help:" topic)))
+
+(defun sclang-rtf-file-p (file-name)
+  (let ((case-fold-search t))
+    (string-match ".*\\.rtf$" file)))
+
+;; ========= ADDITION for HTML help files
+(defun sclang-html-file-p (file-name)
+   (let ((case-fold-search t))
+     (string-match ".*\\.html$" file)))
+
+;; not quite working yet: would be better to combine with sclang-html-file-p
+;(defun sclang-htm-file-p (file-name)
+;   (let ((case-fold-search t))
+;     (string-match ".*\\.htm$" file)))
+
+(defun sclang-sc-file-p (file-name)
+  (let ((case-fold-search t))
+    (string-match ".*\\.sc$" file)))
+
+(defun sclang-scd-file-p (file-name)
+  (let ((case-fold-search t))
+    (string-match ".*\\.scd$" file)))
+
+(defun sclang-help-file-p (file-name)
+  (string-match sclang-help-file-regexp file-name))
+
+(defun sclang-help-topic-name (file-name)
+  (if (string-match sclang-help-file-regexp file-name)
+      (cons (file-name-nondirectory (replace-match "" nil nil file-name 1))
+	    file-name)))
+
+;; =====================================================================
+;; rtf parsing
+;; =====================================================================
+
+(defconst sclang-rtf-face-change-token "\0")
+
+(defun sclang-fill-rtf-syntax-table (table)
+  ;; character quote
+  (modify-syntax-entry ?\\ "/" table)
+  (modify-syntax-entry ?\" "." table)
+  (modify-syntax-entry ?\{ "(" table)
+  (modify-syntax-entry ?\} ")" table)
+  (modify-syntax-entry ?\( "." table)
+  (modify-syntax-entry ?\) "." table)
+  (modify-syntax-entry ?\[ "." table)
+  (modify-syntax-entry ?\] "." table)
+  table)
+
+(defvar sclang-rtf-syntax-table (sclang-fill-rtf-syntax-table (make-syntax-table))
+  "Syntax table used for RTF parsing.")
+
+(defvar sclang-rtf-font-map '((Helvetica . variable-pitch)
+			      (Helvetica-Bold . variable-pitch)
+			      (Monaco . nil)))
+
+(defstruct sclang-rtf-state
+  output font-table font face pos)
+
+(macrolet ((rtf-p (pos) `(plist-get (text-properties-at ,pos) 'rtf-p)))
+  (defun sclang-rtf-p (pos) (rtf-p pos))
+  (defun sclang-code-p (pos) (not (rtf-p pos))))
+
+(defmacro with-sclang-rtf-state-output (state &rest body)
+  `(with-current-buffer (sclang-rtf-state-output ,state)
+     ,@body))
+
+(defmacro sclang-rtf-state-add-font (state font-id font-name)
+  `(push (cons ,font-id (intern ,font-name)) (sclang-rtf-state-font-table ,state)))
+
+(defmacro sclang-rtf-state-apply (state)
+  (let ((pos (gensym))
+	(font (gensym))
+	(face (gensym)))
+    `(with-current-buffer (sclang-rtf-state-output ,state)
+       (let ((,pos (or (sclang-rtf-state-pos ,state) (point-min)))
+	     (,font (cdr (assq
+			  (cdr (assoc
+				(sclang-rtf-state-font ,state)
+				(sclang-rtf-state-font-table ,state)))
+			  sclang-rtf-font-map)))
+	     (,face (sclang-rtf-state-face ,state)))
+	 (when (> (point) ,pos)
+	   (if ,font
+	       (add-text-properties
+		,pos (point)
+		(list 'rtf-p t 'rtf-face (append (list ,font) ,face))))
+	   (setf (sclang-rtf-state-pos ,state) (point)))))))
+
+(defmacro sclang-rtf-state-set-font (state font)
+  `(progn
+     (sclang-rtf-state-apply ,state)
+     (setf (sclang-rtf-state-font ,state) ,font)))
+
+(defmacro sclang-rtf-state-push-face (state face)
+  (let ((list (gensym)))
+    `(let ((,list (sclang-rtf-state-face state)))
+       (sclang-rtf-state-apply ,state)
+       (unless (memq ,face ,list)
+	 (setf (sclang-rtf-state-face ,state)
+	       (append ,list (list ,face)))))))
+
+(defmacro sclang-rtf-state-pop-face (state face)
+  (let ((list (gensym)))
+    `(let* ((,list (sclang-rtf-state-face ,state)))
+       (sclang-rtf-state-apply ,state)
+       (setf (sclang-rtf-state-face ,state) (delq ,face ,list)))))
+
+(defun sclang-parse-rtf (state)
+  (while (not (eobp))
+    (cond ((looking-at "{")
+	   ;; container
+	   (let ((beg (point)))
+	     (with-syntax-table sclang-rtf-syntax-table
+	       (forward-list 1))
+	     (save-excursion
+	       (save-restriction
+		 (narrow-to-region (1+ beg) (1- (point)))
+		 (goto-char (point-min))
+		 (sclang-parse-rtf-container state)
+		 (widen)))))
+	  ((or (looking-at "\\\\\\([{}\\\n]\\)")
+	       (looking-at "\\\\\\([^\\ \n]+\\) ?"))
+	   ;; control
+	   (let ((end (match-end 0)))
+	     (sclang-parse-rtf-control state (match-string 1))
+	     (goto-char end)))
+	  ((looking-at "\\([^{\\\n]+\\)")
+	   ;; normal text
+	   (let ((end (match-end 0))
+		 (match (match-string 1)))
+	     (with-sclang-rtf-state-output state (insert match))
+	     (goto-char end)))
+	  (t
+	   ;; never reached (?)
+	   (forward-char 1)))))
+
+(defun sclang-parse-rtf-container (state)
+  (cond ((looking-at "\\\\rtf1")		; document
+	 (goto-char (match-end 0))
+	 (sclang-parse-rtf state))
+	((looking-at "\\\\fonttbl")		; font table
+	 (goto-char (match-end 0))
+	 (while (looking-at "\\\\\\(f[0-9]+\\)[^ ]* \\([^;]*\\);[^\\]*")
+	   (sclang-rtf-state-add-font state (match-string 1) (match-string 2))
+	   (goto-char (match-end 0))))
+	((looking-at "{\\\\NeXTGraphic \\([^\\]+\\.[a-z]+\\)") ; inline graphic
+	 (let* ((file (match-string 1))
+		(image (and file (create-image (expand-file-name file)))))
+	   (with-sclang-rtf-state-output
+	    state
+	    (if image
+		(insert-image image)
+	      (sclang-rtf-state-push-face state 'italic)
+	      (insert file)
+	      (sclang-rtf-state-pop-face state 'italic)))))
+	))
+
+(defun sclang-parse-rtf-control (state ctrl)
+  (let ((char (aref ctrl 0)))
+    (cond ((memq char '(?{ ?} ?\\))
+	   (with-sclang-rtf-state-output state (insert char)))
+	  ((or (eq char ?\n)
+	       (string= ctrl "par"))
+	   (sclang-rtf-state-apply state)
+	   (with-sclang-rtf-state-output
+	    state
+	    (when (sclang-rtf-p (line-beginning-position))
+	      (fill-region (line-beginning-position) (line-end-position)
+			   t t))
+	      (insert ?\n)))
+	  ((string= ctrl "tab")
+	   (with-sclang-rtf-state-output state (insert ?\t)))
+	  ((string= ctrl "b")
+	   (sclang-rtf-state-push-face state 'bold))
+	  ((string= ctrl "b0")
+	   (sclang-rtf-state-pop-face state 'bold))
+	  ((string-match "^f[0-9]+$" ctrl)
+	   (sclang-rtf-state-set-font state ctrl))
+	  )))
+
+(defun sclang-convert-rtf-buffer (output)
+  (let ((case-fold-search nil)
+	(fill-column sclang-help-fill-column))
+    (save-excursion
+      (goto-char (point-min))
+      (when (looking-at "{\\\\rtf1")
+	(let ((state (make-sclang-rtf-state)))
+	  (setf (sclang-rtf-state-output state) output)
+	  (sclang-parse-rtf state)
+	  (sclang-rtf-state-apply state))))))
+
+;; =====================================================================
+;; help mode
+;; =====================================================================
+
+(defun sclang-fill-help-syntax-table (table)
+  ;; make ?- be part of symbols for selection and sclang-symbol-at-point
+  (modify-syntax-entry ?- "_" table))
+
+(defun sclang-fill-help-mode-map (map)
+  (define-key map "\C-c}" 'bury-buffer)
+  (define-key map "\C-c\C-v" 'sclang-edit-help-file))
+
+(defmacro sclang-help-mode-limit-point-to-code (&rest body)
+  (let ((min (gensym))
+	(max (gensym))
+	(res (gensym)))
+    `(if (and (sclang-code-p (point))
+	      (not (or (bobp) (eobp)))
+	      (sclang-code-p (1- (point)))
+	      (sclang-code-p (1+ (point))))
+	 (let ((,min (previous-single-property-change (point) 'rtf-p (current-buffer) (point-min)))
+	       (,max (next-single-property-change (point) 'rtf-p (current-buffer) (point-max))))
+	   (let ((,res (progn ,@body)))
+	     (cond ((< (point) ,min) (goto-char ,min) nil)
+		   ((> (point) ,max) (goto-char ,max) nil)
+		   (t ,res)))))))
+
+(defun sclang-help-mode-beginning-of-defun (&optional arg)
+  (interactive "p")
+  (sclang-help-mode-limit-point-to-code (sclang-beginning-of-defun arg)))
+
+(defun sclang-help-mode-end-of-defun (&optional arg)
+  (interactive "p")
+  (sclang-help-mode-limit-point-to-code (sclang-end-of-defun arg)))
+
+(defun sclang-help-mode-fontify-region (start end loudly)
+  (flet ((fontify-code
+	  (start end loudly)
+	  (funcall 'font-lock-default-fontify-region start end loudly))
+	 (fontify-non-code
+	  (start end loudly)
+	  (while (< start end)
+	    (let ((value (plist-get (text-properties-at start) 'rtf-face))
+		  (end (next-single-property-change start 'rtf-face (current-buffer) end)))
+		(add-text-properties start end (list 'face (append '(variable-pitch) (list value))))
+		(setq start end)))))
+    (let ((modified (buffer-modified-p)) (buffer-undo-list t)
+	  (inhibit-read-only t) (inhibit-point-motion-hooks t)
+	  (inhibit-modification-hooks t)
+	  deactivate-mark buffer-file-name buffer-file-truename
+	  (pos start))
+      (unwind-protect
+	  (while (< pos end)
+	    (let ((end (next-single-property-change pos 'rtf-p (current-buffer) end)))
+	      (if (sclang-rtf-p pos)
+		  (fontify-non-code pos end loudly)
+		(fontify-code pos end loudly))
+	      (setq pos end)))
+	(when (and (not modified) (buffer-modified-p))
+	  (set-buffer-modified-p nil))))))
+
+
+(defun sclang-help-mode-indent-line ()
+  (if (sclang-code-p (point))
+      (sclang-indent-line)
+    (insert "\t")))
+
+(define-derived-mode sclang-help-mode sclang-mode "SCLangHelp"
+  "Major mode for displaying SuperCollider help files.
+\\{sclang-help-mode-map}"
+  (let ((file (or (buffer-file-name)
+		  (and (boundp 'sclang-current-help-file)
+		       sclang-current-help-file))))
+    (when file
+      (set-visited-file-name nil)
+      (setq buffer-auto-save-file-name nil)
+      (save-excursion
+	(when (sclang-rtf-file-p file)
+	  (let ((tmp-buffer (generate-new-buffer " *RTF*"))
+		(modified-p (buffer-modified-p)))
+	    (unwind-protect
+		(progn
+		  (sclang-convert-rtf-buffer tmp-buffer)
+		  (erase-buffer)
+		  (insert-buffer-substring tmp-buffer))
+	      (and (buffer-modified-p) (not modified-p) (set-buffer-modified-p nil))
+	      (kill-buffer tmp-buffer))))))
+    (set (make-local-variable 'sclang-help-file) file)
+    (setq font-lock-defaults
+	  (append font-lock-defaults
+		  '((font-lock-fontify-region-function . sclang-help-mode-fontify-region))))
+    (set (make-local-variable 'beginning-of-defun-function) 'sclang-help-mode-beginning-of-defun)
+    (set (make-local-variable 'indent-line-function) 'sclang-help-mode-indent-line)
+    ))
+
+;; =====================================================================
+;; help file access
+;; =====================================================================
+
+(defun sclang-skip-help-directory-p (path)
+  "Answer t if PATH should be skipped during help file indexing."
+  (let ((directory (file-name-nondirectory path)))
+    (reduce (lambda (a b) (or a b))
+	    (mapcar (lambda (regexp) (string-match regexp directory))
+		    '("^\.$" "^\.\.$" "^CVS$" "^\.svn$" "^_darcs$")))))
+
+(defun sclang-filter-help-directories (list)
+  "Remove paths to be skipped from LIST of directories."
+  (remove-if (lambda (x)
+	       (or (not (file-directory-p x))
+		   (sclang-skip-help-directory-p x)))
+	     list))
+
+(defun sclang-directory-files-save (directory &optional full match nosort)
+  "Return a list of names of files in DIRECTORY, or nil on error."
+  (condition-case nil
+      (directory-files directory full match nosort)
+    (error nil)))
+
+;; (defun sclang-extension-help-directories ()
+;;   "Build a list of help directories for extensions."
+;;   (flet ((flatten (seq)
+;; 		  (if (null seq)
+;; 		      seq
+;; 		    (if (listp seq)
+;; 			(reduce 'append (mapcar #'flatten seq))
+;; 		      (list seq)))))
+;;     (flatten
+;;      (mapcar
+;;       (lambda (dir)
+;; 	(mapcar
+;; 	 (lambda (dir)
+;; 	   (remove-if-not
+;; 	    'file-directory-p
+;; 	    (sclang-directory-files-save dir t "^[Hh][Ee][Ll][Pp]$" t)))
+;; 	 (sclang-filter-help-directories (sclang-directory-files-save dir t))))
+;;       sclang-extension-path))))
+
+;; (defun sclang-help-directories ()
+;;   "Answer list of help directories to be indexed."
+;;   (append sclang-help-path (sclang-extension-help-directories)))
+
+(defun sclang-help-directories ()
+  "Answer list of help directories to be indexed."
+  (append sclang-help-path sclang-extension-path))
+
+(defun sclang-make-help-topic-alist (dirs result)
+  "Build a help topic alist from directories in DIRS, with initial RESULT."
+  (if dirs
+      (let* ((files (sclang-directory-files-save (car dirs) t))
+	     (topics (remove-if 'null (mapcar 'sclang-help-topic-name files)))
+	     (new-dirs	(sclang-filter-help-directories files)))
+	(sclang-make-help-topic-alist
+	 (append new-dirs (cdr dirs))
+	 (append topics result)))
+    (sort result (lambda (a b) (string< (car a) (car b))))))
+
+(defun sclang-index-help-topics ()
+  "Build an index of help topics searching in the various help file locations."
+  (interactive)
+  (setq sclang-help-topic-alist nil)
+  (let ((case-fold-search nil)
+	(max-specpdl-size 10000)
+	(max-lisp-eval-depth 10000))
+    (sclang-message "Indexing help topics ...")
+    (setq sclang-help-topic-alist
+	  (sclang-make-help-topic-alist (sclang-help-directories) nil))
+    (sclang-message "Indexing help topics ... Done")))
+
+(defun sclang-edit-html-help-file ()
+  "Edit the help file associated with the current buffer.
+Switches w3m to edit mode (actually HTML mode)."
+  (interactive)
+  (w3m-edit-current-url)
+  )
+
+(defun sclang-edit-help-code ()
+  "Edit the help file to make code variations.
+Switches to text mode with sclang-minor-mode."
+  (interactive)
+  (w3m-copy-buffer)
+;;  (text-mode)
+  (sclang-mode)
+  (toggle-read-only)
+  (rename-buffer "*SC_Help:CodeEdit*")
+  )
+
+
+(defun sclang-edit-help-file ()
+  "Edit the help file associated with the current buffer.
+Either visit file internally (.sc) or start external editor (.rtf)."
+  (interactive)
+  (if (and (boundp 'sclang-help-file) sclang-help-file)
+      (let ((file sclang-help-file))
+	(if (file-exists-p file)
+	    (if (sclang-rtf-file-p file)
+		(start-process (sclang-make-buffer-name (format "HelpEditor:%s" file))
+			       nil sclang-rtf-editor-program file)
+	      (find-file file))
+	  (if (sclang-html-file-p file)
+	      (w3m-edit-current-url)
+	   ;; (find-file file)
+	   )
+	  (sclang-message "Help file not found")))
+    (sclang-message "Buffer has no associated help file")))
+
+(defun sclang-help-topic-at-point ()
+  "Answer the help topic at point, or nil if not found."
+  (save-excursion
+    (with-syntax-table sclang-help-mode-syntax-table
+      (let (beg end)
+	(skip-syntax-backward "w_")
+	(setq beg (point))
+	(skip-syntax-forward "w_")
+	(setq end (point))
+	(goto-char beg)
+	(car (assoc (buffer-substring-no-properties beg end)
+		    sclang-help-topic-alist))))))
+
+(defun sclang-goto-help-browser ()
+  "Switch to the *w3m* buffer to browse help files"
+  (interactive)
+  (let* ((buffer-name "*w3m*")
+	 (buffer (get-buffer buffer-name)))
+    (if buffer
+      (switch-to-buffer buffer)
+      ;; else
+      (let* ((buffer-name "*SC_Help:w3m*")
+	     (buffer2 (get-buffer buffer-name)))
+	(if buffer2
+	    (switch-to-buffer buffer2)
+	  ;; else
+	  (sclang-find-help "Help")
+	  )
+	)
+      )
+    (if buffer
+	(with-current-buffer buffer
+	  (rename-buffer "*SC_Help:w3m*")
+	  (sclang-help-minor-mode)
+	  ;;(setq buffer-read-only false)
+	  )
+      )
+;    (if buffer
+;	
+;      )
+    )
+  )
+
+(defun sclang-find-help (topic)
+  (interactive
+   (list
+    (let ((topic (or (and mark-active (buffer-substring-no-properties (region-beginning) (region-end)))
+		     (sclang-help-topic-at-point)
+		     "Help")))
+      (completing-read (format "Help topic%s: " (if (sclang-get-help-file topic)
+						    (format " (default %s)" topic) ""))
+		       sclang-help-topic-alist nil t nil 'sclang-help-topic-history topic))))
+  (let ((file (sclang-get-help-file topic)))
+    (if file
+	(if (file-exists-p file)
+	    (let* ((buffer-name (sclang-help-buffer-name topic))
+		   (buffer (get-buffer buffer-name)))
+	      (unless buffer
+		(if (sclang-html-file-p file)
+		     (w3m-find-file file)
+		   ;;  (sclang-goto-help-browser)
+		;; not a sclang-html file
+		(setq buffer (get-buffer-create buffer-name))
+		(with-current-buffer buffer
+		  (insert-file-contents file)
+		  (let ((sclang-current-help-file file)
+			(default-directory (file-name-directory file)))
+		    (sclang-help-mode))
+		  (set-buffer-modified-p nil)))
+	      (switch-to-buffer buffer))
+	      (if (sclang-html-file-p file)
+		  (sclang-goto-help-browser))
+	      )
+	  (sclang-message "Help file not found") nil)
+      (sclang-message "No help for \"%s\"" topic) nil)))
+
+;; =====================================================================
+;; module setup
+;; =====================================================================
+
+(add-hook 'sclang-library-startup-hook (lambda ()
+					 (condition-case nil
+					     (sclang-index-help-topics)
+					   (error nil))))
+(add-to-list 'auto-mode-alist '("\\.rtf$" . sclang-help-mode))
+;; ========= ADDITION for HTML help files?? ============
+;; (add-to-list 'auto-mode-alist '("\\.html$" . sclang-help-mode))
+;; (setq mm-text-html-renderer 'w3m)
+;;  (setq mm-inline-text-html-with-images t)
+;;  (setq mm-inline-text-html-with-w3m-keymap nil)
+;; =====================================================
+(sclang-fill-help-syntax-table sclang-help-mode-syntax-table)
+(sclang-fill-help-mode-map sclang-help-mode-map)
+
+(provide 'sclang-help)
+
+;; EOF

el/sclang-interp.el

@@ -0,0 +1,713 @@
+;; 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

el/sclang-keys.el

@@ -0,0 +1,42 @@
+;; copyright 2003 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
+
+;; (defvar sclang-key-table (make-char-table 'foo))
+
+;; (defun sclang-define-key (char beg end)
+;;   (interactive)
+;;   (sclang-eval-string (sclang-format "Emacs.defineKey(%o, %o)" char code))
+;;   (define-key (char-to-string char) sclang-key-mode-map 'sclang-execute-key))
+
+;; (defun sclang-execute-key (char)
+;;   (sclang-eval-string (sclang-format "Emacs.executeKey(%o)" char)))
+
+(require 'sclang-interp)
+
+(defun sclang-read-keys ()
+  (interactive)
+  (let (char)
+    (clear-this-command-keys)
+    (while t
+      (setq char (read-event))
+      (clear-this-command-keys)
+      (when (char-valid-p char)
+	(message "%s (%d)" (char-to-string char) char)
+	(sclang-eval-string (format "Emacs.keys.at(%d).value(%d)" char char))))))
+
+;; EOF
+

el/sclang-language.el

@@ -0,0 +1,804 @@
+;; 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))
+
+(require 'sclang-browser)
+(require 'sclang-interp)
+(require 'sclang-util)
+
+;; =====================================================================
+;; regexp utilities
+;; =====================================================================
+
+(defun sclang-regexp-group (regexp &optional addressable)
+  "Enclose REGEXP in grouping parentheses.
+
+If ADDRESSABLE is non-nil the group match data can be addressed
+separately after matching."
+  (concat "\\(" (unless addressable "?:") regexp "\\)"))
+
+(defun sclang-regexp-concat (&rest regexps)
+  "Concatenate REGEXPS by grouping.
+
+The expressions are joined as alternatives with the \\| operator."
+  (mapconcat 'sclang-regexp-group regexps "\\|"))
+
+;; =====================================================================
+;; some useful regular expressions
+;; =====================================================================
+
+(defconst sclang-symbol-regexp
+  "\\(?:\\sw\\|\\s_\\)*"
+  "Regular expression matching symbols.")
+
+(defconst sclang-identifier-regexp
+  (concat "[a-z]" sclang-symbol-regexp)
+  "Regular expression matching valid identifiers.")
+
+(defconst sclang-method-name-special-chars
+  "-!%&*+/<=>?@|"
+  "Regular expression matching special method name characters.")
+
+(defconst sclang-method-name-plain-regexp
+  (concat sclang-identifier-regexp "_?")
+  "Regular expression matching regular method names.")
+
+(defconst sclang-method-name-special-regexp
+  (concat
+   "[" (regexp-quote sclang-method-name-special-chars) "]+")
+   "Regular expression matching method names composed of special characters.")
+
+(defconst sclang-method-name-regexp
+  (sclang-regexp-concat
+   sclang-method-name-special-regexp
+   sclang-method-name-plain-regexp)
+  "Regular expression matching method names.")
+
+(defconst sclang-class-name-regexp
+  "\\(?:Meta_\\)?[A-Z]\\(?:\\sw\\|\\s_\\)*"
+  "Regular expression matching class names.")
+
+(defconst sclang-primitive-name-regexp
+  (concat "_[A-Z]" sclang-symbol-regexp)
+  "Regular expression matching primitive names.")
+
+(defconst sclang-symbol-name-regexp
+  (sclang-regexp-concat
+   sclang-method-name-regexp
+   sclang-class-name-regexp)
+  "Regular expression matching class and method names.")
+
+(defconst sclang-class-definition-regexp
+  (concat "^\\s *\\("
+	  sclang-class-name-regexp
+	  "\\)\\(?:\\s *:\\s *\\("
+	  sclang-class-name-regexp
+	  "\\)\\)?[[:space:]]*{")
+  "Regular expression matching class definitions.")
+
+(defconst sclang-method-definition-regexp
+  (concat "^\\s *\\*?\\(" sclang-method-name-regexp "\\)\\s *{")
+  "Regular expression matching method definitions.")
+
+(defconst sclang-block-regexp 
+  "^\\((\\)\\s *\\(?:/[/*]?.*\\)?"
+  "Regular expression matching the beginning of a code block.
+
+A block is enclosed by parentheses where the opening parenthesis must
+be at the beginning of a line to avoid ambiguities.")
+
+(defconst sclang-beginning-of-defun-regexp
+    (sclang-regexp-concat
+     sclang-class-definition-regexp
+     sclang-block-regexp)
+    "Regular expression matching the beginning of defuns.
+
+The match is either the start of a class definition
+\(`sclang-class-definition-regexp') or the beginning of a code block
+enclosed by parenthesis (`sclang-block-regexp').")
+
+(defconst sclang-method-definition-spec-regexp
+  (concat (sclang-regexp-group sclang-class-name-regexp t)
+	  "-"
+	  (sclang-regexp-group sclang-method-name-regexp t))
+  "Regular expression matching definition specifications.
+
+A specification is of the form <class-name>-<method-name>.")
+
+;; =====================================================================
+;; regexp building
+;; =====================================================================
+
+(defun sclang-make-class-definition-regexp (name)
+  "Return a regular expression matching the class definition NAME."
+  (concat "\\(" (regexp-quote name) "\\)"
+	  "\\(?:\\s *:\\s *\\(" sclang-class-name-regexp "\\)\\)?"
+	  "[[:space:]]*{"))
+
+(defun sclang-make-class-extension-regexp (name)
+  "Return a regular expression matching the class extension NAME."
+  (concat "\\+\\s *\\(" (regexp-quote name) "\\)"
+	  "\\s *{"))
+
+(defun sclang-make-method-definition-regexp (name)
+  "Return a regular expression matching the method definition NAME."
+  (concat "\\(" (regexp-quote name) "\\)\\s *{"))
+
+;; =====================================================================
+;; string matching
+;; =====================================================================
+
+(defun sclang-string-match (regexp string)
+  "Match REGEXP with STRING while preserving case."
+  (let ((case-fold-search nil))
+    (string-match regexp string)))
+
+(defun sclang-symbol-match (symbol-regexp string)
+  (sclang-string-match (concat "^" symbol-regexp "$") string))
+
+;; =====================================================================
+;; symbol name predicates
+;; =====================================================================
+
+(defun sclang-class-name-p (string)
+  (sclang-symbol-match sclang-class-name-regexp string))
+
+(defun sclang-meta-class-name-p (string)
+  (and (sclang-class-name-p string)
+       (sclang-string-match "^Meta_" string)))
+
+(defun sclang-method-name-p (string)
+  (sclang-symbol-match sclang-method-name-regexp string))
+
+(defun sclang-symbol-name-p (string)
+  (sclang-symbol-match sclang-symbol-name-regexp string))
+
+(defun sclang-method-name-setter-p (method-name)
+  (string-match "_$" method-name))
+
+(defun sclang-method-name-getter-p (method-name)
+  (not (sclang-method-name-setter-p method-name)))
+
+;; =====================================================================
+;; symbol name manipulation
+;; =====================================================================
+
+(defun sclang-method-name-setter (method-name)
+  (if (sclang-method-name-setter-p method-name)
+      method-name
+    (concat method-name "_")))
+
+(defun sclang-method-name-getter (method-name)
+  (if (sclang-method-name-setter-p method-name)
+      (substring method-name 0 (1- (length method-name)))
+    method-name))
+
+;; =====================================================================
+;; symbol table access
+;; =====================================================================
+
+(defcustom sclang-use-symbol-table t
+  "*Retrieve symbol table upon library initialization.
+
+Symbol table retrieval is performed each time the library is
+recompiled. This takes some time and the symbol table has to be held
+in memory, so it might be necessary to disable this option on
+low-resource systems."
+  :group 'sclang-interface
+  :version "21.3"
+  :type 'boolean)
+
+(defvar sclang-symbol-table nil
+  "List of all defined symbols.")
+
+(defvar sclang-symbol-history nil
+  "List of recent symbols read from the minibuffer.")
+
+(defvar sclang-symbol-table-file nil)
+
+(sclang-set-command-handler
+ 'symbolTable
+ (lambda (arg)
+   (when (and sclang-use-symbol-table arg)
+     (let ((file sclang-symbol-table-file))
+       (when (and file (file-exists-p file))
+	 (with-current-buffer (get-buffer-create (sclang-make-buffer-name "SymbolTable" t))
+	   (erase-buffer)
+	   (unwind-protect
+	       (insert-file-contents file)
+	     (delete-file file))
+	   (setq sclang-symbol-table-file nil)
+	   (goto-char (point-min))
+	   (let ((table (condition-case nil
+			    (read (current-buffer))
+			  (error nil))))
+	     (unless table (sclang-message "Couldn't retrieve symbol table."))
+	     (setq sclang-symbol-table (sort table 'string<))
+	     (sclang-update-font-lock))))))))
+
+(add-hook 'sclang-library-startup-hook
+	  (lambda ()
+	    (when sclang-use-symbol-table
+	      (let ((file (make-temp-file "sclang-symbol-table.")))
+		(when (and file (file-exists-p file))
+		  (setq sclang-symbol-table-file file)
+		  (sclang-perform-command 'symbolTable file))))))
+
+(add-hook 'sclang-library-shutdown-hook
+	  (lambda ()
+	    (setq sclang-symbol-table nil)
+	    (sclang-update-font-lock)))
+
+(defun sclang-get-symbol-completion-table ()
+  (mapcar (lambda (s) (cons s nil)) sclang-symbol-table))
+
+(defun sclang-make-symbol-completion-predicate (predicate)
+  (and predicate (lambda (assoc) (funcall predicate (car assoc)))))
+
+(defun sclang-get-symbol (string)
+  (if (and sclang-use-symbol-table sclang-symbol-table)
+      (car (member string sclang-symbol-table))
+    string))
+
+(defun sclang-read-symbol (prompt &optional default predicate require-match inherit-input-method)
+  (if sclang-use-symbol-table
+      (flet ((make-minibuffer-local-map
+	      (parent-keymap)
+	      (let ((map (make-sparse-keymap)))
+		(set-keymap-parent map parent-keymap)
+		;; override keys bound to valid symbols
+		(define-key map [??] 'self-insert-command)
+		map)))
+	(let ((symbol (sclang-get-symbol default))
+	      (minibuffer-local-completion-map (make-minibuffer-local-map
+						minibuffer-local-completion-map))
+	      (minibuffer-local-must-match-map (make-minibuffer-local-map
+						minibuffer-local-completion-map)))
+	  (completing-read (sclang-make-prompt-string prompt symbol)
+			   (sclang-get-symbol-completion-table)
+			   (sclang-make-symbol-completion-predicate predicate)
+			   require-match nil
+			   'sclang-symbol-history symbol
+			   inherit-input-method)))
+    (read-string (sclang-make-prompt-string prompt default) nil
+		 'sclang-symbol-history default inherit-input-method)))
+
+;; =====================================================================
+;; buffer movement
+;; =====================================================================
+
+(defun sclang-point-in-comment-p ()
+  "Return non-nil if point is inside a comment.
+
+Use font-lock information if font-lock-mode is enabled."
+  (if (and (boundp 'font-lock-mode) (eval 'font-lock-mode))
+      ;; use available information in font-lock-mode
+      (eq (get-text-property (point) 'face) 'font-lock-comment-face)
+    ;; else parse from the beginning
+    (save-excursion
+      (let ((beg (point)))
+	(beginning-of-defun)
+	(not (null (nth 4 (parse-partial-sexp (point) beg))))))))
+
+(defun sclang-beginning-of-defun (&optional arg)
+  (interactive "p")
+  (let ((case-fold-search nil)
+	(arg (or arg (prefix-numeric-value current-prefix-arg)))
+	(orig (point))
+	(success t))
+    (while (and success (> arg 0))
+      (setq success (re-search-backward sclang-beginning-of-defun-regexp
+					nil 'move))
+      (when (and success (not (sclang-point-in-comment-p)))
+	(goto-char (match-beginning 0))
+	(setq arg (1- arg))))
+    (while (and success (< arg 0))
+      (setq success (re-search-forward sclang-beginning-of-defun-regexp nil t))
+      (when (and success (not (sclang-point-in-comment-p)))
+	(goto-char (match-end 0))
+	(setq arg (1+ arg))))
+    (when success
+      (beginning-of-line)
+      (cond ((looking-at sclang-block-regexp) (goto-char (1- (match-end 1))))
+	    ((looking-at sclang-class-definition-regexp) (goto-char (1- (match-end 0)))))
+      t)))
+
+(defun sclang-point-in-defun-p ()
+  "Return non-nil if point is inside a defun.
+Return value is nil or (beg end) of defun."
+  (save-excursion
+    (let ((orig (point))
+	  beg end)
+      (and (progn (beginning-of-defun-raw 1) t)
+	   (setq beg (point))
+	   (condition-case nil (forward-list 1) (error nil))
+	   (setq end (point))
+	   (> (point) orig)
+	   (list beg end)))))
+
+(defun sclang-end-of-defun (&optional arg)
+  (interactive "p")
+  (let ((case-fold-search nil)
+	(arg (or arg (prefix-numeric-value current-prefix-arg)))
+	(success t)
+	n cur)
+    (while (and success (> arg 0))
+      (setq n (if (sclang-point-in-defun-p) 1 -1))
+      (setq cur (point))
+      (if (and (sclang-beginning-of-defun n)
+	       (condition-case nil (forward-list 1) (error nil)))
+	  (progn
+	    (setq arg (1- arg)))
+	(goto-char cur)
+	(setq success nil)))
+    (while (and success (< arg 0))
+      (setq n (if (sclang-point-in-defun-p) 2 1))
+      (setq cur (point))
+      (if (and (sclang-beginning-of-defun n)
+	       (condition-case nil (forward-list 1) (error nil)))
+	  (progn
+	    (backward-char 1)
+	    (setq arg (1+ arg)))
+	(goto-char cur)
+	(setq success nil)))
+    (when success
+      (forward-line 1) t)))
+
+;; =====================================================================
+;; buffer object access
+;; =====================================================================
+
+(defun sclang-symbol-at-point (&optional symbol-name-regexp)
+  "Return the symbol at point, or nil if not a valid symbol.
+
+The argument SYMBOL-NAME-REGEXP can be used to specify the type of
+symbol matched, candidates are `sclang-symbol-name-regexp' and
+`sclang-primitive-name-regexp', the default is
+`sclang-symbol-name-regexp'."
+  (save-excursion
+    (with-syntax-table sclang-mode-syntax-table
+      (let ((case-fold-search nil)
+	    beg end)
+	(cond ((looking-at sclang-method-name-special-regexp)
+	       (skip-chars-backward sclang-method-name-special-chars)
+	       (setq beg (point))
+	       (skip-chars-forward sclang-method-name-special-chars)
+	       (setq end (point)))
+	      (t
+	       (skip-syntax-backward "w_")
+	       (setq beg (point))
+	       (skip-syntax-forward "w_")
+	       (setq end (point))))
+	(goto-char beg)
+	(if (looking-at (or symbol-name-regexp sclang-symbol-name-regexp))
+	    (buffer-substring-no-properties beg end))))))
+
+(defun sclang-line-at-point ()
+  "Return the line at point."
+  (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
+
+(defun sclang-defun-at-point ()
+  "Return the defun at point.
+
+A defun may either be a class definition or a code block, see
+`sclang-beginning-of-defun-regexp'."
+  (save-excursion
+    (with-syntax-table sclang-mode-syntax-table
+      (multiple-value-bind (beg end) (sclang-point-in-defun-p)
+	(and beg end (buffer-substring-no-properties beg end))))))
+
+;; =====================================================================
+;; symbol completion
+;; =====================================================================
+
+(defun sclang-complete-symbol (&optional predicate)
+  "Perform completion on symbol preceding point.
+Compare that symbol against the known symbols.
+
+When called from a program, optional arg PREDICATE is a predicate
+determining which symbols are considered.
+If PREDICATE is nil, the context determines which symbols are
+considered.  If the symbol starts with an upper case letter,
+class name completion is performed, otherwise only selector names
+are considered."
+  (interactive)
+  (let* ((buffer (current-buffer))
+	 (end (point))
+	 (beg (save-excursion
+		(backward-sexp 1)
+		(skip-syntax-forward "'")
+		(point)))
+	 (pattern (buffer-substring-no-properties beg end))
+	 (case-fold-search nil)
+	 (table (sclang-get-symbol-completion-table))
+	 (predicate (or predicate
+			(if (sclang-class-name-p pattern)
+			    'sclang-class-name-p
+			  'sclang-method-name-p)))
+	 (completion (try-completion pattern table (lambda (assoc) (funcall predicate (car assoc))))))
+    (cond ((eq completion t))
+	  ((null completion)
+	   (sclang-message "Can't find completion for '%s'" pattern)
+	   (ding))
+	  ((not (string= pattern completion))
+	   (delete-region beg end)
+	   (insert completion))
+	  (t
+	   (sclang-message "Making completion list...")
+	   (let* ((list (all-completions pattern table (lambda (assoc) (funcall predicate (car assoc)))))
+		  (win (selected-window))
+		  (buffer-name (sclang-make-buffer-name "Completions"))
+		  (same-window-buffer-names (list buffer-name)))
+	     (setq list (sort list 'string<))
+	     (with-sclang-browser
+	      buffer-name
+	      (add-hook 'sclang-browser-show-hook (lambda () (sclang-browser-next-link)))
+	      (setq sclang-browser-link-function
+		    (lambda (arg)
+		      (sclang-browser-quit)
+		      (with-current-buffer (car arg)
+			(delete-region (car (cdr arg)) (point))
+			(insert (cdr (cdr arg))))))
+	      ;; (setq view-exit-action 'kill-buffer)
+	      (insert (format "Completions for '%s':\n\n" pattern))
+	      (dolist (x list)
+		(insert (sclang-browser-make-link x (cons buffer (cons beg x))))
+		(insert " \n"))))
+	   (sclang-message "Making completion list...%s" "done")))))
+
+;; =====================================================================
+;; introspection
+;; =====================================================================
+
+(defcustom sclang-definition-marker-ring-length 32
+  "*Length of marker ring `sclang-definition-marker-ring'."
+  :group 'sclang-interface
+  :version "21.3"
+  :type 'integer)
+
+(defvar sclang-definition-marker-ring
+  (make-ring sclang-definition-marker-ring-length)
+  "Ring of markers which are locations from which \\[sclang-find-definitions] was invoked.")
+
+;; really do that?
+(add-hook 'sclang-library-startup-hook
+	  (lambda ()
+	    (setq sclang-definition-marker-ring
+		  (make-ring sclang-definition-marker-ring-length))))
+
+(defun sclang-open-definition (name file pos &optional pos-func)
+  (let ((buffer (find-file file)))
+    (when (bufferp buffer)
+      (with-current-buffer buffer
+	(goto-char (or pos (point-min)))
+	(when (and nil (functionp pos-func))
+	  (let ((pos (funcall pos-func name)))
+	    (and pos (goto-char pos))))))
+    buffer))
+
+(defun sclang-pop-definition-mark ()
+  "Pop back to where \\[sclang-find-definition] or \\[sclang-find-reference] was last invoked."
+  (interactive)
+  (unless (ring-empty-p sclang-definition-marker-ring)
+    (let ((marker (ring-remove sclang-definition-marker-ring 0)))
+      (switch-to-buffer (or (marker-buffer marker)
+			    (error "The marked buffer has been deleted")))
+      (goto-char (marker-position marker))
+      (set-marker marker nil nil))))
+
+(defun sclang-browse-definitions (name definitions buffer-name header &optional pos-func)
+  (if (cdr definitions)
+      (let ((same-window-buffer-names (list buffer-name)))
+	(with-sclang-browser
+	 buffer-name
+	 ;; (setq view-exit-action 'kill-buffer)
+	 (setq sclang-browser-link-function
+	       (lambda (data)
+		 (sclang-browser-quit)
+		 (apply 'sclang-open-definition data)))
+	 (add-hook 'sclang-browser-show-hook (lambda () (sclang-browser-next-link)))
+	 (insert header)
+	 (insert "\n")
+	 (let ((max-width 0)
+	       format-string)
+	   (dolist (def definitions)
+	     (setq max-width (max (length (file-name-nondirectory (nth 1 def))) max-width)))
+	   (setq format-string (format "%%-%ds  %%s" max-width))
+	   (dolist (def definitions)
+	     (let ((string (format format-string
+				   (propertize (file-name-nondirectory (nth 1 def)) 'face 'bold)
+				   (nth 0 def)))
+		   (data (list name (nth 1 def) (nth 2 def) pos-func)))
+	       (insert (sclang-browser-make-link string data))
+	       (insert "\n"))))))
+    ;; single definition: jump directly
+    (let ((def (car definitions)))
+      (sclang-open-definition name (nth 1 def) (nth 2 def) pos-func))))
+
+(defun sclang-find-definitions (name)
+  "Find all definitions of symbol NAME."
+  (interactive
+   (list
+    (if current-prefix-arg
+	(read-string "Find definition: ")
+      (sclang-read-symbol "Find definitions of: "
+			  (sclang-symbol-at-point) nil t))))
+  (if (sclang-symbol-match sclang-method-definition-spec-regexp name)
+      (sclang-perform-command 'openDefinition name)
+    (if (sclang-get-symbol name)
+	(progn
+	  (ring-insert sclang-definition-marker-ring (point-marker))
+	  (if (sclang-class-name-p name)
+	      (sclang-perform-command 'classDefinitions name)
+	    (sclang-perform-command 'methodDefinitions name)))
+      (sclang-message "'%s' is undefined" name))))
+
+(sclang-set-command-handler
+ 'openDefinition
+ (lambda (assoc)
+   (let ((name (car assoc))
+	 (data (cdr assoc)))
+     (if data
+	 (sclang-open-definition nil (car data) (cadr data))
+       (sclang-message "'%s' is undefined" name)))))
+
+(sclang-set-command-handler
+ 'classDefinitions
+ (lambda (assoc)
+   (let ((name (car assoc))
+	 (data (cdr assoc)))
+     (if data
+	 (sclang-browse-definitions
+	  name data
+	  "*Definitions*" (format "Definitions of '%s'\n" name)
+	  (lambda (name)
+	    (let ((case-fold-search nil))
+	      ;; point is either
+	      ;;  - at a class definition
+	      ;;  - inside a class extension
+	      ;; so jump to the class name
+	      (when (or (looking-at (sclang-make-class-definition-regexp name))
+			(re-search-backward (sclang-make-class-extension-regexp name) nil t))
+		(match-beginning 1)))))
+       (sclang-message "No definitions of '%s'" name)))))
+
+(sclang-set-command-handler
+ 'methodDefinitions
+ (lambda (assoc)
+   (let ((name (car assoc))
+	 (data (cdr assoc)))
+     (if data
+	 (sclang-browse-definitions
+	  name data
+	  "*Definitions*" (format "Definitions of '%s'\n" name)
+	  (lambda (name)
+	    (let ((case-fold-search nil))
+	      (when (re-search-forward (sclang-make-method-definition-regexp name))
+		(match-beginning 1)))))
+       (sclang-message "No definitions of '%s'" name)))))
+
+(defun sclang-find-references (name)
+  "Find all references to symbol NAME."
+  (interactive
+   (list
+    (sclang-read-symbol "Find references to: "
+			(sclang-symbol-at-point) nil t)))
+  (if (sclang-get-symbol name)
+      (progn
+	(ring-insert sclang-definition-marker-ring (point-marker))
+	(sclang-perform-command 'methodReferences name))
+    (sclang-message "'%s' is undefined" name)))
+
+(sclang-set-command-handler
+ 'methodReferences
+ (lambda (assoc)
+   (let ((name (car assoc))
+	 (data (cdr assoc)))
+     (if data
+	 (sclang-browse-definitions
+	  name data
+	  "*References*" (format "References to '%s'\n" name)
+	  (lambda (name)
+	    (let ((case-fold-search nil))
+	      (when (re-search-forward (regexp-quote name))
+		(match-beginning 0)))))
+       (sclang-message "No references to '%s'" name)))))
+
+(defun sclang-show-method-args ()
+  "whooha. in full effect."
+  (interactive)
+  (let ((regexp (concat
+		 sclang-class-name-regexp
+		 "[ \t\n]*\\(?:\\.[ \t\n]*\\("
+		 sclang-method-name-regexp
+		 "\\)\\)?[ \t\n]*("))
+	(case-fold-search nil)
+	(beg (point)))
+    (save-excursion
+      (while (and (re-search-backward regexp nil t)
+		  (let ((class (save-match-data (sclang-get-symbol (sclang-symbol-at-point)))))
+		    (goto-char (1- (match-end 0)))
+		    (if (condition-case nil
+			    (save-excursion
+			      (forward-list 1)
+			      (> (point) beg))
+			  (error t))
+			(let ((method (sclang-get-symbol (or (match-string-no-properties 1) "new"))))
+			  (and class method
+			       (sclang-perform-command 'methodArgs class method)
+			       nil))
+		      (goto-char (match-beginning 0)) t)))))))
+
+(sclang-set-command-handler
+ 'methodArgs
+ (lambda (args)
+   (and args (message "%s" args))))
+
+(defun sclang-dump-interface (class)
+  "Dump interface of CLASS."
+  (interactive
+   (list
+    (let* ((symbol (sclang-symbol-at-point))
+	   (class (and (sclang-get-symbol symbol)
+		       (sclang-class-name-p symbol)
+		       symbol)))
+      (sclang-read-symbol "Dump interface of: "
+			  class 'sclang-class-name-p t))))
+  (sclang-eval-string (format "%s.dumpFullInterface" class)))
+
+;; =====================================================================
+;; cscope interface
+;; =====================================================================
+
+(defcustom sclang-source-directory nil
+  "Toplevel SuperCollider source directory.
+
+This variable is used by `sclang-find-primitive' to locate the cscope
+database."
+  :group 'sclang-interface
+  :version "21.4.1"
+  :type 'directory
+  :options '(must-match))
+
+(defun sclang-find-primitive (name)
+  "Find primitive name a cscope database.
+
+The database is searched in `sclang-source-directory', or the
+current-directory, iff `sclang-source-directoy' is nil."
+  (interactive
+   (let ((default (sclang-symbol-at-point sclang-primitive-name-regexp)))
+     (list (read-string (sclang-make-prompt-string "Find primitive: " default)
+			nil nil default))))
+  (if (require 'xcscope nil t)
+      (let ((cscope-initial-directory sclang-source-directory))
+	(cscope-find-this-text-string
+	 (if (string-match "^_" name) name (concat "_" name))))
+    (sclang-message "cscope not available")))
+
+;; =====================================================================
+;; sc-code formatting
+;; =====================================================================
+
+(defun sclang-list-to-string (list)
+  (mapconcat 'sclang-object-to-string list ", "))
+
+(defconst false 'false)
+
+(defun sclang-object-to-string (obj)
+  (cond ((null obj)
+	 "nil")
+	((eq false obj)
+	 "false")
+	((eq t obj)
+	 "true")
+	((symbolp obj)
+	 (format "'%s'" obj))
+	((listp obj)
+	 (format "[ %s ]" (sclang-list-to-string obj)))
+	(t (format "%S" obj))))
+
+(defun sclang-format (string &rest args)
+  "format chars:
+     %s - print string
+     %o - print object
+     %l - print argument list"
+  (let ((case-fold-search nil)
+	(i 0))
+    (save-match-data
+      (while (and (< i (length string))
+		  (string-match "%[los%]" string i))
+	(let* ((start (car (match-data)))
+	       (format (aref string (1+ start)))
+	       (arg (if args
+			(pop args)
+		      (error "Not enough arguments for format string")))
+	       (repl (cond ((eq ?o format)
+			    (sclang-object-to-string arg))
+			   ((eq ?l format)
+			    (if (listp arg)
+				(sclang-list-to-string arg)
+			      (sclang-object-to-string arg)))
+			   ((eq ?s format)
+			    (format "%s" arg))
+			   ((eq ?% format)
+			    (push arg args)
+			    "%"))))
+	  (setq string (replace-match repl t t string))
+	  (setq i (+ start (length repl)))))))
+  string)
+
+(defun sclang-format-pseq (items)
+  "Format ITEMS (a flat list of numbers or symbols) as a possibly nested Pseq.
+Looks for all repetitive patterns in ITEMS recursively.  Therefore, it is
+computationally expensive, especially when ITEMS is a long list.  If you don't
+want smart pattern guessing, use `sclang-format' directly to format your Pseq."
+  (flet ((find-reps (items)
+	   (let (r)
+	     (while items
+	       (let ((ret (car items))
+		     (skip 1)
+		     (rep (length items)))
+		 (catch 'match-found
+		   (while (>= rep 2)
+		     (let ((i (/ (length items) rep)))
+		       (while (> i 0)
+			 (let ((sublst (subseq items 0 i)))
+			   (when (catch 'equal
+				   (let ((a items))
+				     (loop repeat rep do
+					   (let ((b sublst))
+					     (while b
+					       (unless (eql (car b) (car a))
+						 (throw 'equal nil))
+					       (setq a (cdr a)
+						     b (cdr b)))))
+				     t))
+			     (setq ret (cons rep (if (> i 5)
+						     (find-reps sublst)
+						   sublst))
+				   skip (* i rep))
+			     (throw 'match-found t))
+			   (decf i))))
+		     (decf rep)))
+		 (accept-process-output nil 0 100)
+		 (message "Processed...%S" ret) ;; invent better progress info
+		 (setq r (append r (list ret))
+		       items (nthcdr skip items))))
+	     r))
+	 (elem-to-string (elem)
+	   (cond
+	    ((consp elem)
+	     (concat "Pseq([ "
+		     (mapconcat #'elem-to-string (cdr elem) ", ")
+		     (format " ], %d)" (car elem))))
+	    (t (sclang-object-to-string elem)))))
+    (let ((compressed (find-reps items)))
+      (if (and (= (length compressed) 1) (consp (car compressed)))
+	  (elem-to-string (car compressed))
+	(concat "Pseq([ "
+		(mapconcat #'elem-to-string compressed ", ")
+		" ], 1)")))))
+
+;; =====================================================================
+;; module setup
+;; =====================================================================
+
+(provide 'sclang-language)
+
+;; EOF

el/sclang-menu.el

@@ -0,0 +1,23 @@
+;; copyright 2003 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
+
+;; (sclang-set-command-handler
+;;  '_updateMenu
+;;  (lambda (arg)
+;;    (message "menu: %s" arg)))
+
+(provide 'sclang-menu)

el/sclang-minor-mode.el

@@ -0,0 +1,59 @@
+;;; sclang-minor-mode for use in help files
+;;; SuperCollider
+;;; (c) 2007, Marije Baalman - nescivi
+;;; released under GPL
+
+(easy-mmode-define-minor-mode sclang-minor-mode
+  "Toggle sclang-minor-mode.
+With no argument, this command toggles the mode. 
+Non-null prefix argument turns on the mode.
+Null prefix argument turns off the mode.
+
+When sclang-minor-mode is enabled, you can execute
+sclang code with the normal command C-c C-c and C-c C-x."
+ ;; The initial value.
+ nil
+ ;; The indicator for the mode line.
+ " sclang"
+ ;; The minor mode bindings.
+ '(("\C-c\C-c" . sclang-eval-region-or-line)
+   ("\C-c\C-x" . sclang-eval-region)
+   ("\C-\M-x" . sclang-eval-defun)	
+   ("\C-c\C-h" . sclang-find-help)
+   ("\C-\M-h"  . sclang-goto-help-browser)
+   ("\C-c\C-s" . sclang-main-stop)
+))
+
+(provide 'sclang-minor-mode)
+
+(easy-mmode-define-minor-mode sclang-help-minor-mode
+  "Toggle sclang-minor-mode.
+With no argument, this command toggles the mode. 
+Non-null prefix argument turns on the mode.
+Null prefix argument turns off the mode.
+
+When sclang-help-minor-mode is enabled, you can execute
+sclang code with the normal command C-c C-c and C-c C-x."
+ ;; The initial value.
+ nil
+ ;; The indicator for the mode line.
+ " sclang-help"
+ ;; The minor mode bindings.
+ '(("\C-c\C-c" . sclang-eval-region-or-line)
+   ("\C-c\C-x" . sclang-eval-region)
+   ("\C-\M-x" . sclang-eval-defun)
+   ("\C-c\C-h" . sclang-find-help)
+   ("\C-c\C-s" . sclang-main-stop)
+   ("\C-c\C-v" . sclang-edit-html-help-file)
+   ("E" . sclang-edit-help-code)
+))
+
+(provide 'sclang-help-minor-mode)
+
+(add-hook 'sclang-help-minor-mode-hook 'sclang-minor-hooks)
+(add-hook 'sclang-minor-mode-hook 'sclang-minor-hooks)
+
+(defun sclang-minor-hooks ()
+  (sclang-init-document)
+  (sclang-make-document)
+  )

el/sclang-mode.el

@@ -0,0 +1,687 @@
+;; 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)
+  (load "cl-seq" nil t)
+  (require 'font-lock))
+
+(require 'sclang-interp)
+(require 'sclang-language)
+
+(defun sclang-fill-syntax-table (table)
+  ;; string
+  (modify-syntax-entry ?\" "\"" table)
+  (modify-syntax-entry ?\' "\"" table) ; no string syntax class for single quotes
+  ;; expression prefix
+  (modify-syntax-entry ?~ "'" table)
+  ;; escape
+  (modify-syntax-entry ?\\ "\\" table)
+  ;; character quote
+  (modify-syntax-entry ?$  "/" table)
+  ;; symbol
+  (modify-syntax-entry ?_  "_" table)
+  ;; symbol/punctuation
+  (modify-syntax-entry ?!  "." table)
+  (modify-syntax-entry ?%  "." table)
+  (modify-syntax-entry ?&  "." table)
+  (modify-syntax-entry ?*  ". 23n" table)
+  (modify-syntax-entry ?+  "." table)
+  (modify-syntax-entry ?-  "." table)
+  (modify-syntax-entry ?/  ". 124b" table)
+  (modify-syntax-entry ?<  "." table)
+  (modify-syntax-entry ?=  "." table)
+  (modify-syntax-entry ?>  "." table)
+  (modify-syntax-entry ??  "." table)
+  (modify-syntax-entry ?@  "." table)
+  (modify-syntax-entry ?|  "." table)
+  ;; punctuation
+  (modify-syntax-entry ?:  "." table)
+  (modify-syntax-entry ?\; "." table)
+  (modify-syntax-entry ?\^ "." table)
+  ;; parenthesis
+  (modify-syntax-entry ?\( "()" table)
+  (modify-syntax-entry ?\) ")(" table)
+  (modify-syntax-entry ?\[ "(]" table)
+  (modify-syntax-entry ?\] ")[" table)
+  (modify-syntax-entry ?\{ "(}" table)
+  (modify-syntax-entry ?\} "){" table)
+  ;; comment end
+  (modify-syntax-entry ?\n "> b" table)
+  ;; Give CR the same syntax as newline, for selective-display
+  (modify-syntax-entry ?\^m "> b" table)
+  ;; return table
+  table)
+
+(defun sclang-mode-make-menu (title)
+  (easy-menu-create-menu
+   title
+   '(
+     ["Start Interpreter"	sclang-start :included (not (sclang-library-initialized-p))]
+     ["Restart Interpreter"	sclang-start :included (sclang-library-initialized-p)]
+     ["Stop Interpreter"	sclang-stop  :included (sclang-get-process)]
+     ["Kill Interpreter"	sclang-kill  :included (sclang-get-process)]
+     "-"
+     ["Show Post Buffer"	sclang-show-post-buffer]
+     ["Clear Post Buffer"	sclang-clear-post-buffer]
+     "-"
+     ["Switch To Workspace"	sclang-switch-to-workspace]
+     "-"
+     ["Evaluate Region"		sclang-eval-region]
+     ["Evaluate Line"		sclang-eval-region-or-line]
+     ["Evaluate Defun"		sclang-eval-defun]
+     ["Evaluate Expression ..."	sclang-eval-expression]
+     "-"
+     ["Find Definitions ..."	sclang-find-definitions]
+     ["Find References ..."	sclang-find-references]
+     ["Pop Mark"		sclang-pop-definition-mark]
+     ["Show Method Arguments"	sclang-show-method-args]
+     ["Dump Interface"		sclang-dump-interface]
+     "-"
+     ["Index Help Topics"	sclang-index-help-topics]
+     ["Find Help ..."		sclang-find-help]
+     ["Switch to Help Browser"  sclang-goto-help-browser]
+     "-"
+     ["Run Main"		sclang-main-run]
+     ["Stop Main"		sclang-main-stop]
+     ["Show Server Panels"	sclang-show-server-panel]
+     )))
+
+(defun sclang-fill-mode-map (map)
+  ;; process control
+  (define-key map "\C-c\C-l"			'sclang-start)
+  ;; post buffer control
+  (define-key map "\C-c<"			'sclang-clear-post-buffer)
+  (define-key map "\C-c>"			'sclang-show-post-buffer)
+  ;; workspace access
+  (define-key map "\C-c\C-w"			'sclang-switch-to-workspace)
+  ;; code evaluation
+  (define-key map "\C-c\C-c"			'sclang-eval-region-or-line)
+  (define-key map "\C-c\C-x"			'sclang-eval-region)
+  (define-key map "\C-\M-x"			'sclang-eval-defun)
+  (define-key map "\C-c\C-e"			'sclang-eval-expression)
+  ;; language information
+  (define-key map "\M-\t"			'sclang-complete-symbol)
+  (define-key map "\C-c:"			'sclang-find-definitions)
+  (define-key map "\C-c;"			'sclang-find-references)
+  (define-key map "\C-c}"			'sclang-pop-definition-mark)
+  (define-key map "\C-c\C-m"			'sclang-show-method-args)
+  (define-key map "\C-c{"			'sclang-dump-interface)
+  ;; documentation access
+  (define-key map "\C-c\C-h"			'sclang-find-help)
+  (define-key map "\C-\M-h"                     'sclang-goto-help-browser)
+  ;; language control
+  (define-key map "\C-c\C-r"			'sclang-main-run)
+  (define-key map "\C-c\C-s"			'sclang-main-stop)
+  (define-key map "\C-c\C-p"			'sclang-show-server-panel)
+  ;; electric characters
+  (define-key map "}"				'sclang-electric-brace)
+  (define-key map ")"				'sclang-electric-brace)
+  (define-key map "]"				'sclang-electric-brace)
+  (define-key map "/"				'sclang-electric-slash)
+  (define-key map "*"				'sclang-electric-star)
+  ;; menu
+  (let ((title "SCLang"))
+    (define-key map [menu-bar sclang] (cons title (sclang-mode-make-menu title))))
+  ;; return map
+  map)
+
+;; =====================================================================
+;; font-lock support
+;; =====================================================================
+
+(defvar sclang-font-lock-keyword-list 
+  '(
+    "arg"
+    "classvar"
+    "const"
+    "super"
+    "this"
+    "thisFunction"
+    "thisFunctionDef"
+    "thisMethod"
+    "thisProcess"
+    "thisThread"
+    "var"
+    )
+  "*List of keywords to highlight in SCLang mode.")
+
+(defvar sclang-font-lock-builtin-list
+  '(
+    "false"
+    "inf"
+    "nil"
+    "true"
+    )
+  "*List of builtins to highlight in SCLang mode.")
+
+(defvar sclang-font-lock-method-list
+  '(
+    "ar"
+    "for"
+    "forBy"
+    "if"
+    "ir"
+    "kr"
+    "loop"
+    "while"
+    )
+  "*List of methods to highlight in SCLang mode.")
+
+(defvar sclang-font-lock-error-list
+  '(
+    "die"
+    "error"
+    "exit"
+    "halt"
+    "verboseHalt"
+    "warn"
+    )
+  "*List of methods signalling errors or warnings.")
+
+(defvar sclang-font-lock-class-keywords nil)
+
+(defvar sclang-font-lock-keywords-1 nil
+  "Subdued level highlighting for SCLang mode.")
+
+(defvar sclang-font-lock-keywords-2 nil
+  "Medium level highlighting for SCLang mode.")
+
+(defvar sclang-font-lock-keywords-3 nil
+  "Gaudy level highlighting for SCLang mode.")
+
+(defconst sclang-font-lock-keywords nil
+  "Default expressions to highlight in SCLang mode.")
+
+(defconst sclang-font-lock-defaults '((sclang-font-lock-keywords
+				       sclang-font-lock-keywords-1
+				       sclang-font-lock-keywords-2
+				       sclang-font-lock-keywords-3
+				       )
+				      nil nil
+				      nil
+				      beginning-of-defun
+				      ))
+
+(defun sclang-font-lock-syntactic-face (state)
+  (cond ((eq (nth 3 state) ?')
+	 ;; symbol
+	 'font-lock-constant-face)
+	((nth 3 state)
+	 ;; string
+	 'font-lock-string-face)
+	((nth 4 state)
+	 ;; comment
+	 'font-lock-comment-face)))
+
+(defun sclang-font-lock-class-keyword-matcher (limit)
+  (let ((regexp (or sclang-font-lock-class-keywords
+		    (concat "\\<" sclang-class-name-regexp "\\>")))
+	(case-fold-search nil))
+    (re-search-forward regexp limit t)))
+
+(defun sclang-set-font-lock-keywords ()
+  (setq
+   ;; level 1
+   sclang-font-lock-keywords-1
+   (list
+    ;; keywords
+    (cons (regexp-opt sclang-font-lock-keyword-list'words)
+	  'font-lock-keyword-face)
+    ;; builtins
+    (cons (regexp-opt sclang-font-lock-builtin-list 'words)
+	  'font-lock-builtin-face)
+    ;; pi is a special case
+    (cons "\\<\\([0-9]+\\(\\.\\)\\)pi\\>" 'font-lock-builtin-face)
+    ;; constants
+    (cons "\\s/\\s\\?." 'font-lock-constant-face) ; characters
+    (cons (concat "\\\\\\(" sclang-symbol-regexp "\\)")
+	  'font-lock-constant-face)	; symbols
+    )
+   ;; level 2
+   sclang-font-lock-keywords-2
+   (append
+    sclang-font-lock-keywords-1
+    (list
+     ;; variables
+     (cons (concat "\\s'\\(" sclang-identifier-regexp "\\)")
+	   'font-lock-variable-name-face) ; environment variables
+     (cons (concat "\\<\\(" sclang-identifier-regexp "\\)\\>:")	; keyword arguments
+	   'font-lock-variable-name-face)
+     ;; method definitions
+     (cons sclang-method-definition-regexp
+	   (list 1 'font-lock-function-name-face))
+     ;; methods
+     (cons (regexp-opt sclang-font-lock-method-list 'words)
+	   'font-lock-function-name-face)
+     ;; errors
+     (cons (regexp-opt sclang-font-lock-error-list 'words)
+	   'font-lock-warning-face)
+     ))
+   ;; level 3
+   sclang-font-lock-keywords-3
+   (append
+    sclang-font-lock-keywords-2
+    (list
+     ;; classes
+     (cons 'sclang-font-lock-class-keyword-matcher 'font-lock-type-face)
+;;      (cons (concat "\\<" sclang-class-name-regexp "\\>") 'font-lock-type-face)
+     ))
+   ;; default level
+   sclang-font-lock-keywords sclang-font-lock-keywords-1
+   ))
+
+(defun sclang-update-font-lock ()
+  "Update font-lock information in all sclang-mode buffers."
+  (setq sclang-font-lock-class-keywords
+	(and sclang-symbol-table
+	     (let* ((list (remove-if
+			   (lambda (x) (or (not (sclang-class-name-p x))
+					   (sclang-string-match "^Meta_" x)))
+			   sclang-symbol-table))
+		    ;; need to set this for large numbers of classes
+		    (max-specpdl-size (* (length list) 2)))
+	       (condition-case nil
+		   (concat "\\<\\(?:Meta_\\)?\\(?:" (regexp-opt list) "\\)\\>")
+		 (error nil)))))
+  ;; too expensive
+  ;;   (dolist (buffer (buffer-list))
+  ;;     (with-current-buffer buffer
+  ;;       (and (eq major-mode 'sclang-mode)
+  ;; 	   (eq t (car font-lock-keywords))
+  ;; 	   (setq font-lock-keywords (cdr font-lock-keywords)))))
+  (if (eq major-mode 'sclang-mode)
+      (font-lock-fontify-buffer)))
+
+;; =====================================================================
+;; indentation
+;; =====================================================================
+
+(defcustom sclang-indent-level 4
+  "*Indentation offset for SCLang statements."
+  :group 'sclang-mode
+  :type 'integer)
+
+(defun sclang-indent-line ()
+  "Indent current line as sclang code.
+Return the amount the indentation changed by."
+  (let ((indent (calculate-sclang-indent))
+	beg shift-amt
+	(case-fold-search nil)
+	(pos (- (point-max) (point))))
+    (beginning-of-line)
+    (setq beg (point))
+    (skip-chars-forward " \t")
+    (setq shift-amt (- indent (current-column)))
+    (if (zerop shift-amt)
+	(if (> (- (point-max) pos) (point))
+	    (goto-char (- (point-max) pos)))
+      (delete-region beg (point))
+      (indent-to indent)
+      ;; if initial point was within line's indentation, position
+      ;; after the indentation, else stay at same point in text.
+      (if (> (- (point-max) pos) (point))
+	  (goto-char (- (point-max) pos))))
+    shift-amt))
+
+(defun calculate-sclang-indent (&optional parse-start)
+  "Return appropriate indentation for current line as sclang code.
+Returns the column to indent to."
+  (save-excursion
+    (beginning-of-line)
+    (let ((indent-point (point))
+	  (case-fold-search nil)
+	  state)
+      (if parse-start
+	  (goto-char parse-start)
+	(beginning-of-defun))
+      (while (< (point) indent-point)
+	(setq state (parse-partial-sexp (point) indent-point 0)))
+      (let* ((containing-sexp (nth 1 state))
+	     (inside-string-p (nth 3 state))
+	     (inside-comment-p (nth 4 state)))
+	(cond (inside-string-p
+	       ;; inside string: no change
+	       (current-indentation))
+	      ((integerp inside-comment-p)
+	       ;; inside comment
+	       (let ((base (if containing-sexp
+			       (save-excursion
+				 (goto-char containing-sexp)
+				 (+ (current-indentation) sclang-indent-level))
+			     0))
+		     (offset (* sclang-indent-level
+				(- inside-comment-p
+				   (if (save-excursion
+					 (back-to-indentation)
+					 (looking-at "\\*/"))
+				       1 0)))))
+		 (+ base offset)))
+	      ((null containing-sexp)
+	       ;; top-level: no indentation
+	       0)
+	      (t
+	       (back-to-indentation)
+	       (let ((open-paren (and (looking-at "\\s)")
+				      (matching-paren (char-after))))
+		     (indent (current-indentation)))
+		 (goto-char containing-sexp)
+		 (if (or (not open-paren) (eq open-paren (char-after)))
+		     (cond ((progn (beginning-of-line) (looking-at sclang-block-regexp)) 0)
+			   (open-paren (current-indentation))
+			   (t (+ (current-indentation) sclang-indent-level)))
+		   ;; paren mismatch: do nothing
+		   indent))))))))
+
+;; =====================================================================
+;; electric character commands
+;; =====================================================================
+
+(defun sclang-electric-brace (arg)
+  (interactive "*P")
+  (self-insert-command (prefix-numeric-value arg))
+  (and (save-excursion
+	 (beginning-of-line)
+	 (looking-at "\\s *\\s)"))
+       (indent-according-to-mode)))
+
+(defun sclang-electric-slash (arg)
+  (interactive "*P")
+  (let* ((char (char-before))
+	 (indent-p (or (eq char ?/)
+		       (eq char ?*))))
+    (self-insert-command (prefix-numeric-value arg))
+    (if indent-p (indent-according-to-mode))))
+
+(defun sclang-electric-star (arg)
+  (interactive "*P")
+  (let ((indent-p (eq (char-before) ?/)))
+    (self-insert-command (prefix-numeric-value arg))
+    (if indent-p (indent-according-to-mode))))
+
+;; =====================================================================
+;; document interface
+;; =====================================================================
+
+(defvar sclang-document-id nil)
+(defvar sclang-document-state nil)
+(defvar sclang-document-envir nil)
+
+(defvar sclang-document-counter 0)
+(defvar sclang-document-list nil)
+(defvar sclang-current-document nil
+  "Currently active document.")
+
+(defvar sclang-document-idle-timer nil)
+
+(defconst sclang-document-property-map
+  '((sclang-document-name . (prSetTitle (buffer-name)))
+    (sclang-document-path . (prSetFileName (buffer-file-name)))
+    (sclang-document-listener-p . (prSetIsListener (eq (current-buffer) (sclang-get-post-buffer))))
+    (sclang-document-editable-p . (prSetEditable (not buffer-read-only)))
+    (sclang-document-edited-p . (prSetEdited (buffer-modified-p)))))
+
+(defmacro sclang-next-document-id ()
+  `(incf sclang-document-counter))
+
+(defun sclang-document-list ()
+  sclang-document-list)
+
+(defun sclang-document-id (buffer)
+  (cdr (assq 'sclang-document-id (buffer-local-variables buffer))))
+
+(defun sclang-document-p (buffer)
+  (integerp (sclang-document-id buffer)))
+
+(defmacro with-sclang-document (buffer &rest body)
+  `(when (sclang-document-p buffer)
+     (with-current-buffer buffer
+       ,@body)))
+
+(defun sclang-get-document (id)
+  (find-if (lambda (doc) (eq id (sclang-document-id doc)))
+	   (sclang-document-list)))
+
+(defun sclang-init-document ()
+  (set (make-local-variable 'sclang-document-id) (sclang-next-document-id))
+  (set (make-local-variable 'sclang-document-envir) nil)
+  (dolist (assoc sclang-document-property-map)
+    (set (make-local-variable (car assoc)) nil))
+  (pushnew (current-buffer) sclang-document-list))
+
+(defun sclang-document-update-property-1 (assoc &optional force)
+  (when (consp assoc)
+    (let* ((key (car assoc))
+	   (prop (cdr assoc))
+	   (prev-value (eval key))
+	   (cur-value (eval (cadr prop))))
+      (when (or force (not (equal prev-value cur-value)))
+	(set key cur-value)
+	(sclang-perform-command-no-result
+	 'documentSetProperty sclang-document-id
+	 (car prop) cur-value)))))
+
+(defun sclang-document-update-property (key &optional force)
+  (sclang-document-update-property-1 (assq key sclang-document-property-map) force))
+
+(defun sclang-document-update-properties (&optional force)
+  (dolist (assoc sclang-document-property-map)
+    (sclang-document-update-property-1 assoc force)))
+
+(defun sclang-make-document ()
+  (sclang-perform-command-no-result 'documentNew sclang-document-id)
+  (sclang-document-update-properties t))
+  
+(defun sclang-close-document (buffer)
+  (with-sclang-document
+   buffer
+   (setq sclang-document-list (delq buffer sclang-document-list))
+   (sclang-perform-command-no-result
+    'documentClosed sclang-document-id)))
+
+(defun sclang-set-current-document (buffer &optional force)
+  (when (or force (not (eq buffer sclang-current-document)))
+    (setq sclang-current-document buffer)
+    (sclang-perform-command-no-result 'documentSetCurrent (sclang-document-id buffer))
+    t))
+
+(defun sclang-document-library-startup-hook-function ()
+  (dolist (buffer (sclang-document-list))
+    (with-current-buffer buffer
+      (sclang-make-document)))
+  (sclang-set-current-document (current-buffer) t))
+
+(defun sclang-document-kill-buffer-hook-function ()
+  (sclang-close-document (current-buffer)))
+
+(defun sclang-document-post-command-hook-function ()
+  (when (and (sclang-library-initialized-p)
+	     (sclang-document-p (current-buffer)))
+    (sclang-document-update-properties))
+  (sclang-set-current-document (current-buffer)))
+
+(defun sclang-document-change-major-mode-hook-function ()
+  (sclang-close-document (current-buffer)))
+
+;; =====================================================================
+;; command handlers
+;; =====================================================================
+
+(sclang-set-command-handler
+ '_documentOpen
+ (lambda (arg)
+   (multiple-value-bind (file-name region-start region-length) arg
+     (let ((buffer (get-file-buffer file-name)))
+       (unless buffer
+	 (setf buffer (find-file-noselect file-name)))
+       (when buffer
+	 (unless (sclang-document-p buffer)
+	   (with-current-buffer buffer (sclang-mode)))
+	 (goto-char (max (point-min) (min (point-max) region-start)))
+	 ;; TODO: how to activate region in transient-mark-mode?
+	 (sclang-document-id buffer))))))
+
+(sclang-set-command-handler
+ '_documentNew
+ (lambda (arg)
+   (multiple-value-bind (name str make-listener) arg
+     (let ((buffer (generate-new-buffer name)))
+       (with-current-buffer buffer
+	 (insert str)
+	 (set-buffer-modified-p nil)
+	 (sclang-mode))
+       (sclang-document-id buffer)))))
+
+(sclang-set-command-handler
+ '_documentClose
+ (lambda (arg)
+   (let ((doc (and (integerp arg) (sclang-get-document arg))))
+     (and doc (kill-buffer doc)))
+   nil))
+
+(sclang-set-command-handler
+ '_documentRename
+ (lambda (arg)
+   (multiple-value-bind (id name) arg
+     (when (stringp name)
+       (let ((doc (and (integerp id) (sclang-get-document id))))
+	 (when doc
+	   (with-current-buffer doc
+	     (rename-buffer name t)
+	     (sclang-document-update-property 'sclang-document-name))))))
+   nil))
+
+(sclang-set-command-handler
+ '_documentSetEditable
+ (lambda (arg)
+   (multiple-value-bind (id flag) arg
+     (let ((doc (and (integerp id) (sclang-get-document id))))
+       (when doc
+	 (with-current-buffer doc
+	   (setq buffer-read-only (not flag))
+	   (sclang-document-update-property 'sclang-editable-p)))))
+   nil))
+
+(sclang-set-command-handler
+ '_documentSwitchTo
+ (lambda (arg)
+   (let ((doc (and (integerp arg) (sclang-get-document arg))))
+     (and doc (switch-to-buffer doc)))
+   nil))
+
+(sclang-set-command-handler
+ '_documentPutString
+(lambda (arg)
+   (multiple-value-bind (id str) arg
+     (let ((doc (and (integerp id) (sclang-get-document id))))
+       (when doc
+	 (with-current-buffer doc
+	 (insert str)
+	 )
+       nil)))))
+
+(sclang-set-command-handler
+ '_documentPopTo
+ (lambda (arg)
+   (let ((doc (and (integerp arg) (sclang-get-document arg))))
+     (and doc (display-buffer doc)))
+   nil))
+
+;; =====================================================================
+;; sclang-mode
+;; =====================================================================
+
+(defun sclang-mode-set-local-variables ()
+  (set (make-local-variable 'require-final-newline) nil)
+  ;; indentation
+  (set (make-local-variable 'indent-line-function)
+       'sclang-indent-line)
+  (set (make-local-variable 'tab-width) 4)
+  (set (make-local-variable 'indent-tabs-mode) t)
+  ;; comment formatting
+  (set (make-local-variable 'comment-start) "// ")
+  (set (make-local-variable 'comment-end) "")
+  (set (make-local-variable 'comment-column) 40)
+  (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|//+ *")
+  ;;        "\\(^\\|\\s-\\);?// *")
+  (set (make-local-variable 'comment-multi-line) t)
+  ;; parsing and movement
+  (set (make-local-variable 'parse-sexp-ignore-comments) t)
+  (set (make-local-variable 'beginning-of-defun-function)
+       'sclang-beginning-of-defun)
+  (set (make-local-variable 'end-of-defun-function)
+       'sclang-end-of-defun)
+  ;; paragraph formatting
+  ;;   (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
+  ;; mostly copied from c++-mode, seems to work
+  (set (make-local-variable 'paragraph-start)
+       "[ \t]*\\(//+\\|\\**\\)[ \t]*$\\|^")
+  (set (make-local-variable 'paragraph-separate) paragraph-start)
+  (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
+  (set (make-local-variable 'adaptive-fill-mode) t)
+  (set (make-local-variable 'adaptive-fill-regexp)
+       "[ \t]*\\(//+\\|\\**\\)[ \t]*\\([ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*\\)")
+  ;; font lock
+  (set (make-local-variable 'font-lock-syntactic-face-function)
+       'sclang-font-lock-syntactic-face)
+  (set (make-local-variable 'font-lock-defaults)
+       sclang-font-lock-defaults)
+  ;; ---
+  nil)
+
+(defvar sclang-mode-map (sclang-fill-mode-map (make-sparse-keymap))
+  "Keymap used in SuperCollider mode.")
+
+(defvar sclang-mode-syntax-table (sclang-fill-syntax-table (make-syntax-table))
+  "Syntax table used in SuperCollider mode.")
+
+(defcustom sclang-mode-hook nil
+  "*Hook run when entering SCLang mode."
+  :group 'sclang-mode
+  :type 'hook)
+
+(defun sclang-mode ()
+  "Major mode for editing SuperCollider language code.
+\\{sclang-mode-map}
+"
+  (interactive)
+  (kill-all-local-variables)
+  (set-syntax-table sclang-mode-syntax-table)
+  (use-local-map sclang-mode-map)
+  (setq mode-name "SCLang")
+  (setq major-mode 'sclang-mode)
+  (sclang-mode-set-local-variables)
+  (sclang-set-font-lock-keywords)
+  (sclang-init-document)
+  (sclang-make-document)
+  (run-hooks 'sclang-mode-hook))
+
+;; =====================================================================
+;; module initialization
+;; =====================================================================
+
+(add-to-list 'auto-mode-alist '("\\.\\(sc\\|scd\\)$" . sclang-mode))
+(add-to-list 'interpreter-mode-alist '("sclang" . sclang-mode))
+
+(add-hook 'sclang-library-startup-hook 'sclang-document-library-startup-hook-function)
+(add-hook 'kill-buffer-hook 'sclang-document-kill-buffer-hook-function)
+(add-hook 'post-command-hook 'sclang-document-post-command-hook-function)
+(add-hook 'change-major-mode-hook 'sclang-document-change-major-mode-hook-function)
+
+(provide 'sclang-mode)
+
+;; EOF

el/sclang-server.el

@@ -0,0 +1,277 @@
+;; 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-and-compile
+  (require 'cl))
+
+(defcustom sclang-server-panel "Server.default.makeWindow"
+  "*Expression to execute when `sclang-show-server-panel' is invoked."
+  :group 'sclang-interface
+  :type '(choice (const "Server.default.makeWindow")
+		 (const "\\SCUM.asClass.do { \\SCUM.asClass.desktop.showServerPanel }")
+		 string))
+
+(defvar sclang-server-alist nil
+  "Alist of currently defined synthesis servers.")
+
+(defvar sclang-default-server nil
+  "Default synthesis server.")
+
+(defvar sclang-current-server nil
+  "Currently selected synthesis server.")
+
+(defvar sclang-current-server-initialized nil
+  "Non nil when the current server has been initialized from the default server.")
+
+(defconst sclang-server-running-face
+  (let ((face (make-face 'sclang-server-running-face)))
+    (set-face-foreground face "red")
+    face)
+  "Face for highlighting a server's running state in the mode-line.")
+
+(defun sclang-get-server (&optional name)
+  (unless name (setq name sclang-current-server))
+  (cdr (assq name sclang-server-alist)))
+
+(defun sclang-set-server (&optional name)
+  (unless name (setq name sclang-current-server))
+  (setq sclang-current-server
+	(car (or (assq name sclang-server-alist)
+		 (car sclang-server-alist)))))
+
+(sclang-set-command-handler
+ '_updateServer
+ (lambda (arg)
+   (setq sclang-server-alist
+	 (sort (cdr arg) (lambda (a b) (string< (car a) (car b)))))
+   (setq sclang-default-server (car arg))
+   (unless sclang-current-server-initialized
+     ;; only set the current server automatically once after startup
+     (setq sclang-current-server-initialized t)
+     (sclang-set-server sclang-default-server))
+   (sclang-update-server-info)))
+
+(defun sclang-next-server ()
+  "Select next server for display."
+  (interactive)
+  (sclang-set-server)
+  (let ((list (or (cdr (member-if (lambda (assoc)
+				    (eq (car assoc) sclang-current-server))
+				  sclang-server-alist))
+		  sclang-server-alist)))
+    (setq sclang-current-server (car (car list))))
+  (sclang-update-server-info))
+
+(defun sclang-mouse-next-server (event)
+  "Select next server for display."
+  (interactive "e")
+  (sclang-next-server))
+
+(defun sclang-server-running-p (&optional name)
+  (plist-get (sclang-get-server name) 'running))
+
+(defun sclang-server-booting-p (&optional name)
+  (plist-get (sclang-get-server name) 'booting))
+
+(defun sclang-create-server-menu (title)
+  (easy-menu-create-menu
+   title
+   '(
+     ["Boot" sclang-server-boot]
+     ["Quit" sclang-server-quit]
+     "-"
+     ["Free All" sclang-server-free-all :active (sclang-server-running-p)]
+     ["Make Default" sclang-server-make-default]
+     )))
+
+(defun sclang-server-fill-mouse-map (map prefix)
+  (define-key map (vector prefix 'mouse-1) 'sclang-mouse-next-server)
+  (define-key map (vector prefix 'down-mouse-3) (sclang-create-server-menu "Commands"))
+  map)
+
+(defvar sclang-server-mouse-map (sclang-server-fill-mouse-map (make-sparse-keymap) 'mode-line)
+  "Keymap used for controlling servers in the mode line.")
+
+(defun sclang-server-fill-key-map (map)
+  "Fill server prefix map."
+  (define-key map [?b] 'sclang-server-boot)
+  (define-key map [?d] 'sclang-server-display-default)
+  (define-key map [?f] 'sclang-server-free-all)
+  (define-key map [?m] 'sclang-server-make-default)
+  (define-key map [?n] 'sclang-next-server)
+  (define-key map [?o] 'sclang-server-dump-osc)
+  (define-key map [?p] 'sclang-show-server-panel)
+  (define-key map [?q] 'sclang-server-quit)
+  (flet ((fill-record-map (map)
+			  (define-key map [?n] 'sclang-server-prepare-for-record)
+			  (define-key map [?p] 'sclang-server-pause-recording)
+			  (define-key map [?r] 'sclang-server-record)
+			  (define-key map [?s] 'sclang-server-stop-recording)
+			  map))
+    (define-key map [?r] (fill-record-map (make-sparse-keymap))))
+  map)
+
+(defvar sclang-server-key-map (sclang-server-fill-key-map (make-sparse-keymap))
+  "Keymap used for controlling servers.")
+
+(defun sclang-get-server-info-string ()
+  "Return a mode-line string for the current server."
+  (let* ((name (if sclang-current-server (symbol-name sclang-current-server) "-------"))
+	 (server (sclang-get-server))
+	 (running-p (if server (plist-get server 'running)))
+	 (string (propertize
+		  name
+		  'face (if running-p sclang-server-running-face)
+		  'help-echo "mouse-1: next server, mouse-3: command menu"
+		  'keymap sclang-server-mouse-map))
+	 ;; (make-mode-line-mouse-map 'mouse-1 'sclang-mouse-next-server)))
+	 (address (if (and server (not (eq (plist-get server 'type) 'internal)))
+		      (format " (%s)" (plist-get server 'address))
+		    ""))
+	 (info (if running-p
+		   (mapcar 'number-to-string
+			   (plist-get (sclang-get-server) 'info))
+		 '("---" "---" "----" "----" "----" "----"))))
+    (apply 'format "%s%s %3s|%3s %% u: %4s s: %4s g: %4s d: %4s" string address info)))
+
+(defvar sclang-server-info-string (sclang-get-server-info-string)
+  "Info string used in the post buffer mode line.")
+
+(defun sclang-update-server-info ()
+  (interactive)
+  (sclang-set-server)
+  (setq sclang-server-info-string (sclang-get-server-info-string))
+  (force-mode-line-update))
+
+;; =====================================================================
+;; language control
+;; =====================================================================
+
+(defun sclang-perform-server-command (command &rest args)
+  (sclang-eval-string
+   (sclang-format "Server.named.at(%o.asSymbol).performList(\\tryPerform, %o.asSymbol.asArray ++ %o)"
+		  sclang-current-server command args)
+   nil))
+
+(defun sclang-server-boot ()
+  "Boot the current server."
+  (interactive)
+  (sclang-perform-server-command "boot"))
+
+(defun sclang-server-reboot ()
+  "Reboot the current server."
+  (interactive)
+  (sclang-perform-server-command "reboot"))
+
+(defun sclang-server-quit ()
+  "Quit the current server."
+  (interactive)
+  (sclang-perform-server-command "quit"))
+
+(defun sclang-server-free-all ()
+  "Free all nodes on the current server."
+  (interactive)
+  (sclang-perform-server-command "freeAll"))
+
+(defun sclang-server-display-default ()
+  "Display default server."
+  (interactive)
+  (when sclang-default-server
+    (sclang-set-server sclang-default-server)
+    (sclang-update-server-info)))
+
+(defun sclang-server-make-default ()
+  "Make current server the default server."
+  (interactive)
+  (when sclang-current-server
+    (sclang-eval-string
+     (sclang-format "
+var server;
+server = Server.named.at(%o);
+if (server.notNil) {
+    Server.default = server;
+    thisProcess.interpreter.s = server;
+    \"Default server: %\n\".postf(server.name);
+};
+" sclang-current-server))
+    nil))
+
+(defun sclang-server-dump-osc (&optional code)
+  "Set the current server's dump OSC mode."
+  (interactive "P")
+  (sclang-perform-server-command "dumpOSC"
+				 (cond ((consp code) 0)
+				       ((null code) 1)
+				       (t code))))
+
+(defun sclang-server-prepare-for-record (&optional path)
+  "Prepare current server for recording a sound file."
+  (interactive
+   (list
+    (and current-prefix-arg (read-file-name "Record to file: "))))
+  (sclang-perform-server-command "prepareForRecord" path))
+
+(defun sclang-server-record ()
+  "Record a sound file on the current server."
+  (interactive)
+  (sclang-perform-server-command "record"))
+
+(defun sclang-server-pause-recording ()
+  "Pause recording on the current server."
+  (interactive)
+  (sclang-perform-server-command "pauseRecording"))
+
+(defun sclang-server-stop-recording ()
+  "Stop recording on the current server."
+  (interactive)
+  (sclang-perform-server-command "stopRecording"))
+
+(defun sclang-set-server-latency (lat)
+  "Set the current server's `latency' instance variable."
+  (interactive "nSet latency: ")
+  (sclang-perform-server-command "latency_" lat))
+
+(defun sclang-show-server-latency ()
+  "Show the current server's latency."
+  (interactive)
+  (let ((server (sclang-get-server)))
+    (message "%s" (and server (plist-get server 'latency)))))
+
+(defun sclang-show-server-panel ()
+  "Show graphical server panel if available."
+  (interactive)
+  (sclang-eval-string sclang-server-panel))
+
+;; =====================================================================
+;; module setup
+;; =====================================================================
+
+(add-hook 'sclang-mode-hook
+	  (lambda ()
+	    ;; install server mode line in post buffer
+	    (when (string= (buffer-name) sclang-post-buffer)
+	      (setq mode-line-format '("-" sclang-server-info-string)))
+	    ;; install server prefix keymap
+	    (define-key sclang-mode-map "\C-c\C-p" sclang-server-key-map)))
+
+(add-hook 'sclang-library-shutdown-hook
+	  (lambda ()
+	    (setq sclang-current-server-initialized nil)))
+
+(provide 'sclang-server)
+
+;; EOF

el/sclang-util.el

@@ -0,0 +1,86 @@
+;; 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
+
+(defun sclang-message (string &rest args)
+  (message "SCLang: %s" (apply 'format string args)))
+
+(defun sclang-make-buffer-name (string &optional private-p)
+  (concat (and private-p " ") "*SCLang:" string "*"))
+
+(defun sclang-make-prompt-string (prompt default)
+  (if (and default (string-match "\\(:\\)\\s *" prompt))
+      (replace-match
+       (format " (default %s):" default)
+       'fixedcase 'literal prompt 1)
+    prompt))
+
+(defun sclang-string-to-int32 (str)
+  "Convert first 4 bytes of str (network byteorder) to 32 bit integer."
+  (logior (lsh (logand (aref str 0) #XFF) 24)
+	  (lsh (logand (aref str 1) #XFF) 16)
+	  (lsh (logand (aref str 2) #XFF) 8)
+	  (logand (aref str 3) #XFF)))
+
+(defun sclang-int32-to-string (n)
+  "Convert 32 bit integer n to 4 byte string (network byte order)."
+  (let ((str (make-string 4 0)))
+    (aset str 0 (logand (lsh n -24) #XFF))
+    (aset str 1 (logand (lsh n -16) #XFF))
+    (aset str 2 (logand (lsh n  -8) #XFF))
+    (aset str 3 (logand          n  #XFF))
+    str))
+
+(defun sclang-compress-newlines (&optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (save-excursion
+      (goto-char (point-min))
+      (while (not (eobp))
+	(if (and (bolp) (eolp)
+		 (save-excursion
+		   (forward-line -1)
+		   (and (bolp) (eolp))))
+	    (delete-char 1)
+	  (forward-line 1))))))
+
+(eval-when-compile
+  (defmacro sclang-save-buffer-state (varlist &rest body)
+    "Bind variables according to VARLIST and eval BODY restoring buffer state."
+    `(let* ,(append varlist
+		    '((modified (buffer-modified-p)) (buffer-undo-list t)
+		      (inhibit-read-only t) (inhibit-point-motion-hooks t)
+		      (inhibit-modification-hooks t)
+		      deactivate-mark buffer-file-name buffer-file-truename))
+       (unwind-protect
+	   ,@body
+	 (when (and (not modified) (buffer-modified-p))
+	   (set-buffer-modified-p nil))))))
+
+;; (defun sclang-create-image (file-name &rest props)
+;;   (when (file-exists-p file-name)
+;;     (let ((coding-system-for-read 'no-conversion)
+;; 	  (coding-system-for-write 'no-conversion)
+;; 	  (inhibit-quit t))
+;;       (with-temp-buffer
+;; 	(when (equal 0 (call-process "anytopnm" file-name (list (current-buffer) nil)))
+;; 	  (apply
+;; 	   'create-image
+;; 	   (buffer-substring-no-properties (point-min) (point-max))
+;; 	   nil t props))))))
+
+(provide 'sclang-util)
+
+;; EOF

el/sclang-vars.el.in

@@ -0,0 +1,34 @@
+;;; sclang-vars.el --- Variables with build-time defaults
+
+;; Copyright (C) 2005  Free Software Foundation, Inc.
+
+;; Author: Mario Lang <mlang@delysid.org>
+
+;; This file 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, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(defconst sclang-system-data-dir "@PKG_DATA_DIR@"
+  "Installation dependent data directory.")
+
+(defconst sclang-system-help-dir "@PKG_DATA_DIR@/Help"
+  "Installation dependent help directory.")
+
+(defconst sclang-system-extension-dir "@PKG_DATA_DIR@/Extensions"
+  "Installation dependent extension directory.")
+
+(provide 'sclang-vars)
+;;; sclang-vars.el ends here

el/sclang-widgets.el

@@ -0,0 +1,162 @@
+;;; sclang-widgets.el --- Widget definitions for SCLang
+
+;; Copyright (C) 2005  Free Software Foundation, Inc.
+
+;; Author: mlang <mlang@delysid.org>
+;; Keywords: comm
+
+;; This file 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, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; 
+
+;;; Code:
+
+(eval-and-compile (require 'sclang-interp))
+
+(defvar sclang-widgets nil)
+(make-variable-buffer-local 'sclang-widgets)
+
+;; Button (not used yet)
+
+(define-widget 'sclang-button 'item
+  "A button."
+  :create #'sclang-widget-button-create
+  :action #'sclang-widget-button-action)
+
+(defun sclang-widget-button-create (widget)
+  "Create WIDGET at point in the current buffer."
+  (widget-specify-insert
+   (let ((from (point))
+	 button-begin button-end)
+     (setq button-begin (point))
+     (insert (widget-get-indirect widget :button-prefix))
+
+     (princ (nth (widget-get widget :value) (widget-get widget :states)) (current-buffer))
+
+     (insert (widget-get-indirect widget :button-suffix))
+     (setq button-end (point))
+
+     ;; Specify button, and insert value.
+     (and button-begin button-end
+	  (widget-specify-button widget button-begin button-end)))
+   (let ((from (point-min-marker))
+	 (to (point-max-marker)))
+     (set-marker-insertion-type from t)
+     (set-marker-insertion-type to nil)
+     (widget-put widget :from from)
+     (widget-put widget :to to)))
+  (widget-clear-undo))
+
+(defun sclang-widget-button-action (widget event)
+  (widget-value-set widget
+		    (if (>= (widget-get widget :value) (1- (length (widget-get widget :states))))
+			0
+		      (1+ (widget-get widget :value))))
+  (sclang-eval-string
+   (sclang-format "EmacsWidget.idmap[%o].valueFromEmacs(%o)"
+		  (widget-get widget :id) (widget-get widget :value))))
+
+(sclang-set-command-handler
+ '_widgetSetStates
+ (lambda (arg)
+   (multiple-value-bind (buffer id states value) arg
+     (with-current-buffer (get-buffer buffer)
+       (let ((widget (cdr (find id sclang-widgets :key 'car))))
+	 (widget-put widget :states states)
+	 (widget-value-set widget value)
+	 value)))))
+
+(define-widget 'sclang-slider 'default
+  "Slider widget."
+  :size 20
+  :create #'sclang-widget-slider-create
+  :button-prefix "["
+  :button-suffix "]"
+  :value 0.5
+  :value-get #'widget-value-value-get
+  :value-set #'sclang-widget-slider-value-set
+  :action (lambda (widget event)
+	    (let ((pos (if event (posn-point (event-start event)) (point))))
+	      (widget-value-set widget (/ (float (- pos (widget-get widget :from))) (widget-get widget :size))))))
+
+(defun sclang-widget-slider-create (widget)
+  "Create WIDGET at point in the current buffer."
+  (widget-specify-insert
+   (let ((from (point))
+	 (inhibit-redisplay t)
+	 button-begin button-end)
+     (setq button-begin (point))
+     (insert (widget-get-indirect widget :button-prefix))
+
+     (insert-char ?- (widget-get widget :size))
+     (backward-char (1+ (widget-put widget :current-pos (- (widget-get widget :size) (round (* (widget-get widget :value) (widget-get widget :size)))))))
+     (delete-char 1) (insert "|")
+     (goto-char (point-max))
+     (insert (widget-get-indirect widget :button-suffix))
+     (setq button-end (point))
+
+     ;; Specify button
+     (and button-begin button-end
+	  (widget-specify-button widget button-begin button-end)))
+   (let ((from (point-min-marker))
+	 (to (point-max-marker)))
+     (set-marker-insertion-type from t)
+     (set-marker-insertion-type to nil)
+     (widget-put widget :from from)
+     (widget-put widget :to to)))
+  (widget-clear-undo))
+
+(defun sclang-widget-slider-value-set (widget value)
+  (save-excursion
+    (let ((inhibit-read-only t))
+      (goto-char (widget-get widget :from))
+      (forward-char (widget-get widget :current-pos))
+      (insert "-") (delete-char 1)
+      (widget-put widget :value value)
+      (goto-char (widget-get widget :from))
+      (let ((n (round (* value (widget-get widget :size)))))
+	(widget-put widget :current-pos n)
+	(forward-char n)
+	(insert "|") (delete-char 1)))))
+
+;; Class Tree
+
+(require 'tree-widget)
+(define-widget 'sclang-class-tree 'tree-widget
+  "Widget for displaying the SCLang Class Tree."
+  :dynargs #'sclang-widget-class-tree-dynargs)
+
+(defun sclang-widget-class-tree-dynargs (widget)
+  (sclang-eval-sync (sclang-format "EmacsClassTree.dynargs(%o)"
+				   (widget-get widget :tag))))
+
+(define-widget 'sclang-file-position 'item
+  "File position link for the SCLang Class Tree widget."
+  :format "%[%t%]\n"
+  :action (lambda (widget event)
+	    (find-file-other-window (widget-get widget :filename))
+	    (goto-char (widget-get widget :char-pos))))
+
+(defun sclang-class-tree (class-name)
+  "Display a tree-view of the sub-classes and methods of CLASS-NAME."
+  (interactive
+   (list (sclang-read-symbol "Class: " "Object" #'sclang-class-name-p)))
+  (sclang-eval-string (format "EmacsClassBrowser(%s)" class-name)))
+
+(provide 'sclang-widgets)
+;;; sclang-widgets.el ends here

el/sclang.el

@@ -0,0 +1,71 @@
+;;; sclang.el --- IDE for working with the SuperCollider language
+;; copyright 2003 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
+
+;;; Code:
+(defgroup sclang nil
+  "IDE for working with the SuperCollider language."
+  :group 'languages)
+
+(defgroup sclang-mode nil
+  "Major mode for working with SuperCollider source code."
+  :group 'sclang)
+
+(defgroup sclang-minor-mode nil
+  "Minor mode for working with SuperCollider source code."
+  :group 'sclang)
+
+(defgroup sclang-interface nil
+  "Interface to the SuperCollider process."
+  :group 'sclang)
+
+(defgroup sclang-programs nil
+  "Paths to programs used by sclang-mode."
+  :group 'sclang-interface)
+
+(defgroup sclang-options nil
+  "Options for the SuperCollider process."
+  :group 'sclang-interface)
+
+(defun sclang-customize ()
+  "Customize sclang variables."
+  (interactive)
+  (customize-group 'sclang))
+
+(eval-and-compile
+  (require 'cl))
+
+(eval-and-compile
+  (let ((load-path
+	 (if (and (boundp 'byte-compile-dest-file)
+		  (stringp byte-compile-dest-file))
+	     (cons (file-name-directory byte-compile-dest-file) load-path)
+	   load-path)))
+    (require 'sclang-util)
+    (require 'sclang-browser)
+    (require 'sclang-interp)
+    (require 'sclang-language)
+    (require 'sclang-document)
+    (require 'sclang-mode)
+    (require 'sclang-minor-mode)
+    (require 'sclang-help)
+    (require 'sclang-server)
+    (require 'sclang-widgets)))
+
+(provide 'sclang)
+
+;;; sclang.el ends here

el/tree-widget.el

@@ -0,0 +1,806 @@
+;;; tree-widget.el --- Tree widget
+
+;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+
+;; Author: David Ponce <david@dponce.com>
+;; Maintainer: David Ponce <david@dponce.com>
+;; Created: 16 Feb 2001
+;; Keywords: extensions
+
+;; This file is part of GNU Emacs
+
+;; 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, 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; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+;;
+;; This library provide a tree widget useful to display data
+;; structures organized in a hierarchical order.
+;;
+;; The following properties are specific to the tree widget:
+;;
+;; :open
+;;    Set to non-nil to expand the tree.  By default the tree is
+;;    collapsed.
+;;
+;; :node
+;;    Specify the widget used to represent the value of a tree node.
+;;    By default this is an `item' widget which displays the
+;;    tree-widget :tag property value if defined, or a string
+;;    representation of the tree-widget value.
+;;
+;; :keep
+;;    Specify a list of properties to keep when the tree is collapsed
+;;    so they can be recovered when the tree is expanded.  This
+;;    property can be used in child widgets too.
+;;
+;; :expander (obsoletes :dynargs)
+;;    Specify a function to be called to dynamically provide the
+;;    tree's children in response to an expand request.  This function
+;;    will be passed the tree widget and must return a list of child
+;;    widgets.
+;;
+;;    *Please note:* Child widgets returned by the :expander function
+;;    are stored in the :args property of the tree widget.  To speed
+;;    up successive expand requests, the :expander function is not
+;;    called again when the :args value is non-nil.  To refresh child
+;;    values, it is necessary to set the :args property to nil, then
+;;    redraw the tree.
+;;
+;; :open-icon  (default `tree-widget-open-icon')
+;; :close-icon (default `tree-widget-close-icon')
+;; :empty-icon (default `tree-widget-empty-icon')
+;; :leaf-icon  (default `tree-widget-leaf-icon')
+;;    Those properties define the icon widgets associated to tree
+;;    nodes.  Icon widgets must derive from the `tree-widget-icon'
+;;    widget.  The :tag and :glyph-name property values are
+;;    respectively used when drawing the text and graphic
+;;    representation of the tree.  The :tag value must be a string
+;;    that represent a node icon, like "[+]" for example.  The
+;;    :glyph-name value must the name of an image found in the current
+;;    theme, like "close" for example (see also the variable
+;;    `tree-widget-theme').
+;;
+;; :guide      (default `tree-widget-guide')
+;; :end-guide  (default `tree-widget-end-guide')
+;; :no-guide   (default `tree-widget-no-guide')
+;; :handle     (default `tree-widget-handle')
+;; :no-handle  (default `tree-widget-no-handle')
+;;    Those properties define `item'-like widgets used to draw the
+;;    tree guide lines.  The :tag property value is used when drawing
+;;    the text representation of the tree.  The graphic look and feel
+;;    is given by the images named "guide", "no-guide", "end-guide",
+;;    "handle", and "no-handle" found in the current theme (see also
+;;    the variable `tree-widget-theme').
+;;
+;; These are the default :tag values for icons, and guide lines:
+;;
+;; open-icon    "[-]"
+;; close-icon   "[+]"
+;; empty-icon   "[X]"
+;; leaf-icon    ""
+;; guide        " |"
+;; no-guide     "  "
+;; end-guide    " `"
+;; handle       "-"
+;; no-handle    " "
+;;
+;; The text representation of a tree looks like this:
+;;
+;; [-] 1        (open-icon :node)
+;;  |-[+] 1.0   (guide+handle+close-icon :node)
+;;  |-[X] 1.1   (guide+handle+empty-icon :node)
+;;  `-[-] 1.2   (end-guide+handle+open-icon :node)
+;;     |- 1.2.1 (no-guide+no-handle+guide+handle+leaf-icon leaf)
+;;     `- 1.2.2 (no-guide+no-handle+end-guide+handle+leaf-icon leaf)
+;;
+;; By default, images will be used instead of strings to draw a
+;; nice-looking tree.  See the `tree-widget-image-enable',
+;; `tree-widget-themes-directory', and `tree-widget-theme' options for
+;; more details.
+
+;;; History:
+;;
+
+;;; Code:
+(eval-when-compile (require 'cl))
+(require 'wid-edit)
+
+;;; Customization
+;;
+(defgroup tree-widget nil
+  "Customization support for the Tree Widget library."
+  :version "22.1"
+  :group 'widgets)
+
+(defcustom tree-widget-image-enable
+  (not (or (featurep 'xemacs) (< emacs-major-version 21)))
+  "*Non-nil means that tree-widget will try to use images."
+  :type  'boolean
+  :group 'tree-widget)
+
+(defvar tree-widget-themes-load-path
+  '(load-path
+    (let ((dir (if (fboundp 'locate-data-directory)
+                   (locate-data-directory "tree-widget") ;; XEmacs
+                 data-directory)))
+      (and dir (list dir (expand-file-name "images" dir))))
+    )
+  "List of locations where to search for the themes sub-directory.
+Each element is an expression that will be evaluated to return a
+single directory or a list of directories to search.
+
+The default is to search in the `load-path' first, then in the
+\"images\" sub directory in the data directory, then in the data
+directory.
+The data directory is the value of the variable `data-directory' on
+Emacs, and what `(locate-data-directory \"tree-widget\")' returns on
+XEmacs.")
+
+(defcustom tree-widget-themes-directory "tree-widget"
+  "*Name of the directory where to look up for image themes.
+When nil use the directory where the tree-widget library is located.
+When a relative name is specified, try to locate that sub directory in
+the locations specified in `tree-widget-themes-load-path'.
+The default is to use the \"tree-widget\" relative name."
+  :type '(choice (const :tag "Default" "tree-widget")
+                 (const :tag "With the library" nil)
+                 (directory :format "%{%t%}:\n%v"))
+  :group 'tree-widget)
+
+(defcustom tree-widget-theme nil
+  "*Name of the theme where to look up for images.
+It must be a sub directory of the directory specified in variable
+`tree-widget-themes-directory'.  The default theme is \"default\".
+When an image is not found in a theme, it is searched in the default
+theme.
+
+A complete theme must at least contain images with these file names
+with a supported extension (see also `tree-widget-image-formats'):
+
+\"guide\"
+  A vertical guide line.
+\"no-guide\"
+  An invisible vertical guide line.
+\"end-guide\"
+  End of a vertical guide line.
+\"handle\"
+  Horizontal guide line that joins the vertical guide line to an icon.
+\"no-handle\"
+  An invisible handle.
+
+Plus images whose name is given by the :glyph-name property of the
+icon widgets used to draw the tree.  By default these images are used:
+
+\"open\"
+  Icon associated to an expanded tree.
+\"close\"
+  Icon associated to a collapsed tree.
+\"empty\"
+  Icon associated to an expanded tree with no child.
+\"leaf\"
+  Icon associated to a leaf node."
+  :type '(choice (const  :tag "Default" nil)
+                 (string :tag "Name"))
+  :group 'tree-widget)
+
+(defcustom tree-widget-image-properties-emacs
+  '(:ascent center :mask (heuristic t))
+  "*Default properties of Emacs images."
+  :type 'plist
+  :group 'tree-widget)
+
+(defcustom tree-widget-image-properties-xemacs
+  nil
+  "*Default properties of XEmacs images."
+  :type 'plist
+  :group 'tree-widget)
+
+(defcustom tree-widget-space-width 0.5
+  "Amount of space between an icon image and a node widget.
+Must be a valid space :width display property."
+  :group 'tree-widget
+  :type 'sexp)
+
+;;; Image support
+;;
+(eval-and-compile ;; Emacs/XEmacs compatibility stuff
+  (cond
+   ;; XEmacs
+   ((featurep 'xemacs)
+    (defsubst tree-widget-use-image-p ()
+      "Return non-nil if image support is currently enabled."
+      (and tree-widget-image-enable
+           widget-glyph-enable
+           (console-on-window-system-p)))
+    (defsubst tree-widget-create-image (type file &optional props)
+      "Create an image of type TYPE from FILE, and return it.
+Give the image the specified properties PROPS."
+      (apply 'make-glyph `([,type :file ,file ,@props])))
+    (defsubst tree-widget-image-formats ()
+      "Return the alist of image formats/file name extensions.
+See also the option `widget-image-file-name-suffixes'."
+      (delq nil
+            (mapcar
+             #'(lambda (fmt)
+                 (and (valid-image-instantiator-format-p (car fmt)) fmt))
+             widget-image-file-name-suffixes)))
+    )
+   ;; Emacs
+   (t
+    (defsubst tree-widget-use-image-p ()
+      "Return non-nil if image support is currently enabled."
+      (and tree-widget-image-enable
+           widget-image-enable
+           (display-images-p)))
+    (defsubst tree-widget-create-image (type file &optional props)
+      "Create an image of type TYPE from FILE, and return it.
+Give the image the specified properties PROPS."
+      (apply 'create-image `(,file ,type nil ,@props)))
+    (defsubst tree-widget-image-formats ()
+      "Return the alist of image formats/file name extensions.
+See also the option `widget-image-conversion'."
+      (delq nil
+            (mapcar
+             #'(lambda (fmt)
+                 (and (image-type-available-p (car fmt)) fmt))
+             widget-image-conversion)))
+    ))
+  )
+
+;; Buffer local cache of theme data.
+(defvar tree-widget--theme nil)
+
+(defsubst tree-widget-theme-name ()
+  "Return the current theme name, or nil if no theme is active."
+  (and tree-widget--theme (aref tree-widget--theme 0)))
+
+(defsubst tree-widget-set-theme (&optional name)
+  "In the current buffer, set the theme to use for images.
+The current buffer must be where the tree widget is drawn.
+Optional argument NAME is the name of the theme to use.  It defaults
+to the value of the variable `tree-widget-theme'.
+Does nothing if NAME is already the current theme."
+  (or name (setq name (or tree-widget-theme "default")))
+  (unless (string-equal name (tree-widget-theme-name))
+    (set (make-local-variable 'tree-widget--theme)
+         (make-vector 4 nil))
+    (aset tree-widget--theme 0 name)))
+
+(defun tree-widget--locate-sub-directory (name path)
+  "Locate the sub-directory NAME in PATH.
+Return the absolute name of the directory found, or nil if not found."
+  (let (dir elt)
+    (while (and (not dir) (consp path))
+      (setq elt  (condition-case nil (eval (car path)) (error nil))
+            path (cdr path))
+      (cond
+       ((stringp elt)
+        (setq dir (expand-file-name name elt))
+        (or (file-accessible-directory-p dir)
+            (setq dir nil)))
+       ((and elt (not (equal elt (car path))))
+        (setq dir (tree-widget--locate-sub-directory name elt)))))
+    dir))
+
+(defun tree-widget-themes-directory ()
+  "Locate the directory where to search for a theme.
+It is defined in variable `tree-widget-themes-directory'.
+Return the absolute name of the directory found, or nil if the
+specified directory is not accessible."
+  (let ((found (aref tree-widget--theme 1)))
+    (cond
+     ;; The directory was not found.
+     ((eq found 'void)
+      (setq found nil))
+     ;; The directory is available in the cache.
+     (found)
+     ;; Use the directory where this library is located.
+     ((null tree-widget-themes-directory)
+      (setq found (locate-library "tree-widget"))
+      (when found
+        (setq found (file-name-directory found))
+        (or (file-accessible-directory-p found)
+            (setq found nil))))
+     ;; Check accessibility of absolute directory name.
+     ((file-name-absolute-p tree-widget-themes-directory)
+      (setq found (expand-file-name tree-widget-themes-directory))
+      (or (file-accessible-directory-p found)
+          (setq found nil)))
+     ;; Locate a sub-directory in `tree-widget-themes-load-path'.
+     (t
+      (setq found (tree-widget--locate-sub-directory
+                   tree-widget-themes-directory
+                   tree-widget-themes-load-path))))
+    ;; Store the result in the cache for later use.
+    (aset tree-widget--theme 1 (or found 'void))
+    found))
+
+(defsubst tree-widget-set-image-properties (props)
+  "In current theme, set images properties to PROPS."
+  (aset tree-widget--theme 2 props))
+
+(defun tree-widget-image-properties (file)
+  "Return the properties of an image in current theme.
+FILE is the absolute file name of an image.
+
+If there is a \"tree-widget-theme-setup\" library in the theme
+directory, where is located FILE, load it to setup theme images
+properties.  Typically it should contain something like this:
+
+  (tree-widget-set-image-properties
+   (if (featurep 'xemacs)
+       '(:ascent center)
+     '(:ascent center :mask (heuristic t))
+     ))
+
+When there is no \"tree-widget-theme-setup\" library in the current
+theme directory, load the one from the default theme, if available.
+Default global properties are provided for respectively Emacs and
+XEmacs in the variables `tree-widget-image-properties-emacs', and
+`tree-widget-image-properties-xemacs'."
+  ;; If properties are in the cache, use them.
+  (let ((plist (aref tree-widget--theme 2)))
+    (unless plist
+      ;; Load tree-widget-theme-setup if available.
+      (load (expand-file-name "tree-widget-theme-setup"
+                              (file-name-directory file)) t t)
+      ;; If properties have been setup, use them.
+      (unless (setq plist (aref tree-widget--theme 2))
+        ;; Try from the default theme.
+        (load (expand-file-name "../default/tree-widget-theme-setup"
+                                (file-name-directory file)) t t)
+        ;; If properties have been setup, use them.
+        (unless (setq plist (aref tree-widget--theme 2))
+          ;; By default, use supplied global properties.
+          (setq plist (if (featurep 'xemacs)
+                          tree-widget-image-properties-xemacs
+                        tree-widget-image-properties-emacs))
+          ;; Setup the cache.
+          (tree-widget-set-image-properties plist))))
+    plist))
+
+(defconst tree-widget--cursors
+  ;; Pointer shapes when the mouse pointer is over inactive
+  ;; tree-widget images.  This feature works since Emacs 22, and
+  ;; ignored on older versions, and XEmacs.
+  '(
+    ("guide"     . arrow)
+    ("no-guide"  . arrow)
+    ("end-guide" . arrow)
+    ("handle"    . arrow)
+    ("no-handle" . arrow)
+    ))
+
+(defun tree-widget-lookup-image (name)
+  "Look up in current theme for an image with NAME.
+Search first in current theme, then in default theme (see also the
+variable `tree-widget-theme').
+Return the first image found having a supported format, or nil if not
+found."
+  (let ((default-directory (tree-widget-themes-directory)))
+    (when default-directory
+      (let (file (theme (tree-widget-theme-name)))
+        (catch 'found
+          (dolist (dir (if (string-equal theme "default")
+                           '("default") (list theme "default")))
+            (dolist (fmt (tree-widget-image-formats))
+              (dolist (ext (cdr fmt))
+                (setq file (expand-file-name (concat name ext) dir))
+                (and
+                 (file-readable-p file)
+                 (file-regular-p file)
+                 (throw
+                  'found
+                  (tree-widget-create-image
+                   (car fmt) file
+                   ;; Add the pointer shape
+                   (cons :pointer
+                         (cons
+                          (or (cdr (assoc name tree-widget--cursors))
+                              'hand)
+                          (tree-widget-image-properties file)))))))))
+          nil)))))
+
+(defun tree-widget-find-image (name)
+  "Find the image with NAME in current theme.
+NAME is an image file name sans extension.
+Return the image found, or nil if not found."
+  (when (tree-widget-use-image-p)
+    ;; Ensure there is an active theme.
+    (tree-widget-set-theme (tree-widget-theme-name))
+    (let ((image (assoc name (aref tree-widget--theme 3))))
+      ;; The image NAME is found in the cache.
+      (if image
+          (cdr image)
+        ;; Search the image in current, and default themes.
+        (prog1
+            (setq image (tree-widget-lookup-image name))
+          ;; Store image reference in the cache for later use.
+          (push (cons name image) (aref tree-widget--theme 3))))
+      )))
+
+;;; Widgets
+;;
+(defun tree-widget-button-click (event)
+  "Move to the position clicked on, and if it is a button, invoke it.
+EVENT is the mouse event received."
+  (interactive "e")
+  (mouse-set-point event)
+  (let ((pos (widget-event-point event)))
+    (if (get-char-property pos 'button)
+        (widget-button-click event))))
+
+(defvar tree-widget-button-keymap
+  (let ((km (make-sparse-keymap)))
+    (if (boundp 'widget-button-keymap)
+        ;; XEmacs
+        (progn
+          (set-keymap-parent km widget-button-keymap)
+          (define-key km [button1] 'tree-widget-button-click))
+      ;; Emacs
+      (set-keymap-parent km widget-keymap)
+      (define-key km [down-mouse-1] 'tree-widget-button-click))
+    km)
+  "Keymap used inside node buttons.
+Handle mouse button 1 click on buttons.")
+
+(define-widget 'tree-widget-icon 'push-button
+  "Basic widget other tree-widget icons are derived from."
+  :format        "%[%t%]"
+  :button-keymap tree-widget-button-keymap ; XEmacs
+  :keymap        tree-widget-button-keymap ; Emacs
+  :create        'tree-widget-icon-create
+  :action        'tree-widget-icon-action
+  :help-echo     'tree-widget-icon-help-echo
+  )
+
+(define-widget 'tree-widget-open-icon 'tree-widget-icon
+  "Icon for an expanded tree-widget node."
+  :tag        "[-]"
+  :glyph-name "open"
+  )
+
+(define-widget 'tree-widget-empty-icon 'tree-widget-icon
+  "Icon for an expanded tree-widget node with no child."
+  :tag        "[X]"
+  :glyph-name "empty"
+  )
+
+(define-widget 'tree-widget-close-icon 'tree-widget-icon
+  "Icon for a collapsed tree-widget node."
+  :tag        "[+]"
+  :glyph-name "close"
+  )
+
+(define-widget 'tree-widget-leaf-icon 'tree-widget-icon
+  "Icon for a tree-widget leaf node."
+  :tag        ""
+  :glyph-name "leaf"
+  :button-face 'default
+  )
+
+(define-widget 'tree-widget-guide 'item
+  "Vertical guide line."
+  :tag       " |"
+  ;;:tag-glyph (tree-widget-find-image "guide")
+  :format    "%t"
+  )
+
+(define-widget 'tree-widget-end-guide 'item
+  "End of a vertical guide line."
+  :tag       " `"
+  ;;:tag-glyph (tree-widget-find-image "end-guide")
+  :format    "%t"
+  )
+
+(define-widget 'tree-widget-no-guide 'item
+  "Invisible vertical guide line."
+  :tag       "  "
+  ;;:tag-glyph (tree-widget-find-image "no-guide")
+  :format    "%t"
+  )
+
+(define-widget 'tree-widget-handle 'item
+  "Horizontal guide line that joins a vertical guide line to a node."
+  :tag       "-"
+  ;;:tag-glyph (tree-widget-find-image "handle")
+  :format    "%t"
+  )
+
+(define-widget 'tree-widget-no-handle 'item
+  "Invisible handle."
+  :tag       " "
+  ;;:tag-glyph (tree-widget-find-image "no-handle")
+  :format    "%t"
+  )
+
+(define-widget 'tree-widget 'default
+  "Tree widget."
+  :format         "%v"
+  :convert-widget 'widget-types-convert-widget
+  :value-get      'widget-value-value-get
+  :value-delete   'widget-children-value-delete
+  :value-create   'tree-widget-value-create
+  :action         'tree-widget-action
+  :help-echo      'tree-widget-help-echo
+  :open-icon      'tree-widget-open-icon
+  :close-icon     'tree-widget-close-icon
+  :empty-icon     'tree-widget-empty-icon
+  :leaf-icon      'tree-widget-leaf-icon
+  :guide          'tree-widget-guide
+  :end-guide      'tree-widget-end-guide
+  :no-guide       'tree-widget-no-guide
+  :handle         'tree-widget-handle
+  :no-handle      'tree-widget-no-handle
+  )
+
+;;; Widget support functions
+;;
+(defun tree-widget-p (widget)
+  "Return non-nil if WIDGET is a tree-widget."
+  (let ((type (widget-type widget)))
+    (while (and type (not (eq type 'tree-widget)))
+      (setq type (widget-type (get type 'widget-type))))
+    (eq type 'tree-widget)))
+
+(defun tree-widget-node (widget)
+  "Return WIDGET's :node child widget.
+If not found, setup an `item' widget as default.
+Signal an error if the :node widget is a tree-widget.
+WIDGET is, or derives from, a tree-widget."
+  (let ((node (widget-get widget :node)))
+    (if node
+        ;; Check that the :node widget is not a tree-widget.
+        (and (tree-widget-p node)
+             (error "Invalid tree-widget :node %S" node))
+      ;; Setup an item widget as default :node.
+      (setq node `(item :tag ,(or (widget-get widget :tag)
+                                  (widget-princ-to-string
+                                   (widget-value widget)))))
+      (widget-put widget :node node))
+    node))
+
+(defun tree-widget-keep (arg widget)
+  "Save in ARG the WIDGET's properties specified by :keep."
+  (dolist (prop (widget-get widget :keep))
+    (widget-put arg prop (widget-get widget prop))))
+
+(defun tree-widget-children-value-save (widget &optional args node)
+  "Save WIDGET children values.
+WIDGET is, or derives from, a tree-widget.
+Children properties and values are saved in ARGS if non-nil, else in
+WIDGET's :args property value.  Properties and values of the
+WIDGET's :node sub-widget are saved in NODE if non-nil, else in
+WIDGET's :node sub-widget."
+  (let ((args (cons (or node (widget-get widget :node))
+                    (or args (widget-get widget :args))))
+        (children (widget-get widget :children))
+        arg child)
+    (while (and args children)
+      (setq arg      (car args)
+            args     (cdr args)
+            child    (car children)
+            children (cdr children))
+       (if (tree-widget-p child)
+;;;; The child is a tree node.
+           (progn
+             ;; Backtrack :args and :node properties.
+             (widget-put arg :args (widget-get child :args))
+             (widget-put arg :node (widget-get child :node))
+             ;; Save :open property.
+             (widget-put arg :open (widget-get child :open))
+             ;; The node is open.
+             (when (widget-get child :open)
+               ;; Save the widget value.
+               (widget-put arg :value (widget-value child))
+               ;; Save properties specified in :keep.
+               (tree-widget-keep arg child)
+               ;; Save children.
+               (tree-widget-children-value-save
+                child (widget-get arg :args) (widget-get arg :node))))
+;;;; Another non tree node.
+         ;; Save the widget value.
+         (widget-put arg :value (widget-value child))
+         ;; Save properties specified in :keep.
+         (tree-widget-keep arg child)))))
+
+;;; Widget creation
+;;
+(defvar tree-widget-before-create-icon-functions nil
+  "Hooks run before to create a tree-widget icon.
+Each function is passed the icon widget not yet created.
+The value of the icon widget :node property is a tree :node widget or
+a leaf node widget, not yet created.
+This hook can be used to dynamically change properties of the icon and
+associated node widgets.  For example, to dynamically change the look
+and feel of the tree-widget by changing the values of the :tag
+and :glyph-name properties of the icon widget.
+This hook should be local in the buffer setup to display widgets.")
+
+(defun tree-widget-icon-create (icon)
+  "Create the ICON widget."
+  (run-hook-with-args 'tree-widget-before-create-icon-functions icon)
+  (widget-put icon :tag-glyph
+              (tree-widget-find-image (widget-get icon :glyph-name)))
+  ;; Ensure there is at least one char to display the image.
+  (and (widget-get icon :tag-glyph)
+       (equal "" (or (widget-get icon :tag) ""))
+       (widget-put icon :tag " "))
+  (widget-default-create icon)
+  ;; Insert space between the icon and the node widget.
+  (insert-char ?  1)
+  (put-text-property
+   (1- (point)) (point)
+   'display (list 'space :width tree-widget-space-width)))
+
+(defun tree-widget-value-create (tree)
+  "Create the TREE tree-widget."
+  (let* ((node   (tree-widget-node tree))
+         (flags  (widget-get tree :tree-widget--guide-flags))
+         (indent (widget-get tree :indent))
+         ;; Setup widget's image support.  Looking up for images, and
+         ;; setting widgets' :tag-glyph is done here, to allow to
+         ;; dynamically change the image theme.
+         (widget-image-enable (tree-widget-use-image-p))     ; Emacs
+         (widget-glyph-enable widget-image-enable)           ; XEmacs
+         children buttons)
+    (and indent (not (widget-get tree :parent))
+         (insert-char ?\  indent))
+    (if (widget-get tree :open)
+;;;; Expanded node.
+        (let ((args     (widget-get tree :args))
+              (xpandr   (or (widget-get tree :expander)
+                            (widget-get tree :dynargs)))
+              (guide    (widget-get tree :guide))
+              (noguide  (widget-get tree :no-guide))
+              (endguide (widget-get tree :end-guide))
+              (handle   (widget-get tree :handle))
+              (nohandle (widget-get tree :no-handle))
+              (guidi    (tree-widget-find-image "guide"))
+              (noguidi  (tree-widget-find-image "no-guide"))
+              (endguidi (tree-widget-find-image "end-guide"))
+              (handli   (tree-widget-find-image "handle"))
+              (nohandli (tree-widget-find-image "no-handle")))
+          ;; Request children at run time, when not already done.
+          (when (and (not args) xpandr)
+            (setq args (mapcar 'widget-convert (funcall xpandr tree)))
+            (widget-put tree :args args))
+          ;; Defer the node widget creation after icon creation.
+          (widget-put tree :node (widget-convert node))
+          ;; Create the icon widget for the expanded tree.
+          (push (widget-create-child-and-convert
+                 tree (widget-get tree (if args :open-icon :empty-icon))
+                 ;; Pass the node widget to child.
+                 :node (widget-get tree :node))
+                buttons)
+          ;; Create the tree node widget.
+          (push (widget-create-child tree (widget-get tree :node))
+                children)
+          ;; Update the icon :node with the created node widget.
+          (widget-put (car buttons) :node (car children))
+          ;; Create the tree children.
+          (while args
+            (setq node (car args)
+                  args (cdr args))
+            (and indent (insert-char ?\  indent))
+            ;; Insert guide lines elements from previous levels.
+            (dolist (f (reverse flags))
+              (widget-create-child-and-convert
+               tree (if f guide noguide)
+               :tag-glyph (if f guidi noguidi))
+              (widget-create-child-and-convert
+               tree nohandle :tag-glyph nohandli))
+            ;; Insert guide line element for this level.
+            (widget-create-child-and-convert
+             tree (if args guide endguide)
+             :tag-glyph (if args guidi endguidi))
+            ;; Insert the node handle line
+            (widget-create-child-and-convert
+             tree handle :tag-glyph handli)
+            (if (tree-widget-p node)
+                ;; Create a sub-tree node.
+                (push (widget-create-child-and-convert
+                       tree node :tree-widget--guide-flags
+                       (cons (if args t) flags))
+                      children)
+              ;; Create the icon widget for a leaf node.
+              (push (widget-create-child-and-convert
+                     tree (widget-get tree :leaf-icon)
+                     ;; At this point the node widget isn't yet created.
+                     :node (setq node (widget-convert
+                                       node :tree-widget--guide-flags
+                                       (cons (if args t) flags)))
+                     :tree-widget--leaf-flag t)
+                    buttons)
+              ;; Create the leaf node widget.
+              (push (widget-create-child tree node) children)
+              ;; Update the icon :node with the created node widget.
+              (widget-put (car buttons) :node (car children)))))
+;;;; Collapsed node.
+      ;; Defer the node widget creation after icon creation.
+      (widget-put tree :node (widget-convert node))
+      ;; Create the icon widget for the collapsed tree.
+      (push (widget-create-child-and-convert
+             tree (widget-get tree :close-icon)
+             ;; Pass the node widget to child.
+             :node (widget-get tree :node))
+            buttons)
+      ;; Create the tree node widget.
+      (push (widget-create-child tree (widget-get tree :node))
+            children)
+      ;; Update the icon :node with the created node widget.
+      (widget-put (car buttons) :node (car children)))
+    ;; Save widget children and buttons.  The tree-widget :node child
+    ;; is the first element in :children.
+    (widget-put tree :children (nreverse children))
+    (widget-put tree :buttons  buttons)))
+
+;;; Widget callbacks
+;;
+(defsubst tree-widget-leaf-node-icon-p (icon)
+  "Return non-nil if ICON is a leaf node icon.
+That is, if its :node property value is a leaf node widget."
+  (widget-get icon :tree-widget--leaf-flag))
+
+(defun tree-widget-icon-action (icon &optional event)
+  "Handle the ICON widget :action.
+If ICON :node is a leaf node it handles the :action.  The tree-widget
+parent of ICON handles the :action otherwise.
+Pass the received EVENT to :action."
+  (let ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon)
+                                   :node :parent))))
+    (widget-apply node :action event)))
+
+(defun tree-widget-icon-help-echo (icon)
+  "Return the help-echo string of ICON.
+If ICON :node is a leaf node it handles the :help-echo.  The tree-widget
+parent of ICON handles the :help-echo otherwise."
+  (let* ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon)
+                                    :node :parent)))
+         (help-echo (widget-get node :help-echo)))
+    (if (functionp help-echo)
+        (funcall help-echo node)
+      help-echo)))
+
+(defvar tree-widget-after-toggle-functions nil
+  "Hooks run after toggling a tree-widget expansion.
+Each function is passed a tree-widget.  If the value of the :open
+property is non-nil the tree has been expanded, else collapsed.
+This hook should be local in the buffer setup to display widgets.")
+
+(defun tree-widget-action (tree &optional event)
+  "Handle the :action of the TREE tree-widget.
+That is, toggle expansion of the TREE tree-widget.
+Ignore the EVENT argument."
+  (let ((open (not (widget-get tree :open))))
+    (or open
+        ;; Before to collapse the node, save children values so next
+        ;; open can recover them.
+        (tree-widget-children-value-save tree))
+    (widget-put tree :open open)
+    (widget-value-set tree open)
+    (run-hook-with-args 'tree-widget-after-toggle-functions tree)))
+
+(defun tree-widget-help-echo (tree)
+  "Return the help-echo string of the TREE tree-widget."
+  (if (widget-get tree :open)
+      "Collapse node"
+    "Expand node"))
+
+(provide 'tree-widget)
+
+;; arch-tag: c3a1ada2-1663-41dc-9d16-2479ed8320e8
+;;; tree-widget.el ends here

sc/Emacs.sc

@@ -0,0 +1,320 @@
+// copyright 2003 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
+
+EmacsInterface {
+	classvar handlers;
+
+	*initClass {
+		handlers = IdentityDictionary.new;
+		this.initDefaultHandlers;
+	}
+
+	*put { | name, function |
+		handlers.put(name.asSymbol, function);
+	}
+	*at { | name |
+		^handlers.at(name)
+	}
+
+	*performCommand { | name, args |
+// 		[\performCommand, name, args].postln;
+		^handlers.atFail(name, { ^nil }).valueArray(args)
+	}
+
+	*makeSubListSorter { | index selector('<') |
+		^{ | a b | a[index].perform(selector, b[index]) }
+	}
+
+	*initDefaultHandlers {
+		this
+		.put(\symbolTable, { | fileName |
+			var result, dt;
+
+			dt = {
+				result = IdentitySet.new;
+				
+				Class.allClasses.do { | class |
+					if (class.isMetaClass.not) {
+						result.add(class.name);
+					};
+					class.methods.do { | method |
+						result.add(method.name);
+					};
+				};
+				
+				File.use(fileName, "w", { | file |
+					result.collectAs(_.asString, Array).storeLispOn(file);
+				});
+			}.bench(false);
+
+			"Emacs: Built symbol table in % seconds\n".postf(dt.asStringPrec(3));
+
+			true
+		})
+		.put(\openDefinition, { | name |
+			var class, method, res;
+			#class, method = name.split($-);
+			class = class.asSymbol.asClass;
+			if (class.notNil) {
+				if (method.isNil) {
+					res = [class.filenameSymbol.asString, class.charPos + 1];
+				} {
+					method = class.findMethod(method.asSymbol);
+					if (method.notNil) {
+						res = [method.filenameSymbol.asString, method.charPos + 1];
+					};
+				};
+			};
+			name -> res
+		})
+		.put(\classDefinitions, { | name |
+			var result, class, files;
+			
+			result = SortedList(8, this.makeSubListSorter(0, '<'));
+
+			if ((class = name.asSymbol.asClass).notNil) {
+				files = IdentitySet.new;
+				result.add([
+					"  " ++ name,
+					class.filenameSymbol.asString,
+					class.charPos + 1
+				]);
+				files.add(class.filenameSymbol);
+				class.methods.do { | method |
+					if (files.includes(method.filenameSymbol).not) {
+						result = result.add([
+							"+ " ++ name,
+							method.filenameSymbol.asString,
+							method.charPos + 1
+						]);
+						files.add(method.filenameSymbol);
+					}
+				}
+			};
+		
+			name -> result
+		})
+		.put(\methodDefinitions, { | name |
+			var result, symbol, getter, setter;
+		
+			result = SortedList(8, this.makeSubListSorter(0, '<'));
+			symbol = name.asSymbol;
+
+			Class.allClasses.do { | class |
+				class.methods.do { | method |
+					if (method.name === symbol) {
+						result.add([
+							class.name ++ "-" ++ name,
+							method.filenameSymbol.asString,
+							method.charPos + 1
+						])
+					}
+				}
+			};
+		
+			name -> result
+		})
+		.put(\methodReferences, { | name |
+			var result, references, methods;
+
+			result = SortedList(8, this.makeSubListSorter(0, '<'));
+			references = Class.findAllReferences(name.asSymbol);
+
+			if (references.notNil) {
+				methods = IdentitySet.new;
+				references.do { | funcDef |
+					var homeContext;
+					homeContext = funcDef.homeContext;
+					if (homeContext.isKindOf(Method)) {
+						methods.add(homeContext);
+					};
+				};
+				methods.do { | method |
+					result.add([
+						method.ownerClass.name ++ "-" ++ method.name,
+						method.filenameSymbol.asString,
+						method.charPos + 1
+					])
+				}
+			};
+
+			name -> result
+		})
+		.put(\methodArgs, { | className, methodName |
+			var stream, class, method;
+			var args, varArgs, lastIndex;
+
+			stream = CollStream.new;
+			class = className.asSymbol.asClass;
+
+			if (class.notNil) {
+				method = class.class.findRespondingMethodFor(methodName.asSymbol);
+				if (method.notNil and: { method.argNames.notNil }) {
+					args = method.argNames.copyToEnd(1);
+					varArgs = method.varArgs;
+					lastIndex = args.lastIndex;
+					
+					args.do({ | name, i |
+						var default;
+						if (varArgs and: { i == lastIndex }) {
+							stream << " ... ";
+						}{
+							if (i != 0) { stream << ", " };
+						};
+						stream << name;
+						default = method.prototypeFrame[i+1];
+						if (default.notNil) {
+							stream << "=" << default;
+						};
+					});
+				}
+			};
+
+			stream.collection;
+		})
+		.put('evalSCLang', #{|expr, time|
+			{[time, \ok, expr.interpret]}
+			.try{|e|
+				[time, \error, e.errorString]
+			}
+		})
+	}
+}
+
+Emacs {
+	classvar outStream, outFile, requestHandlers, requestAllocator;
+	classvar <menu, <>keys;
+	classvar <initialized = false;
+
+	// initialization
+	*initClass {
+		var outFileName, newServer;
+		Class.initClassTree(EmacsInterface);
+		Class.initClassTree(EmacsDocument);
+		Class.initClassTree(OSCresponder);
+		Class.initClassTree(Server);
+		requestHandlers = IdentityDictionary.new;
+		requestAllocator = StackNumberAllocator(0, 128);
+		keys = IdentityDictionary.new;
+		outFileName = "SCLANG_COMMAND_FIFO".getenv;
+		if (outFileName.isNil) {
+			"Emacs: No communication FIFO available.".postln;
+		}{
+			initialized = true;
+			Document.implementationClass = ScelDocument;
+			thisProcess.platform.declareFeature( \emacs );
+			outStream = CollStream.on(String.new);
+			outFile = File(outFileName, "w");
+			UI.registerForShutdown({
+				if (outFile.notNil) {
+					outFile.close;
+					outFile = nil
+				};
+			});
+			// initialize servers
+			newServer = { | server update |
+				SimpleController(server)
+				.put(\serverRunning, { this.updateServer })
+				.put(\counts, { this.updateServer });
+				server.startAliveThread;
+				if (update) { this.updateServer };
+			};
+			SimpleController(Server)
+				.put(\serverAdded, { | serverClass what server | newServer.value(server, true) });
+			Server.named.do(newServer.value(_, false));
+			this.updateServer;
+			// initialize lisp
+			"Emacs: Initializing lisp interface.".postln;
+			this.sendToLisp(\_init);
+		};
+	}
+
+	// lisp interface
+	*lispPerformCommand { | cmdName, args, send |
+		var result;
+		result = EmacsInterface.performCommand(cmdName, args);
+		if (send) {
+			this.sendToLisp(cmdName, result);
+		};
+		^result
+	}
+	*lispHandleCommandResult { | id, obj |
+		var handler;
+		handler = requestHandlers.at(id);
+		if (handler.notNil) {
+			requestAllocator.free(id);
+			handler.value(obj);
+		}
+	}
+
+	// sclang interface
+	*sendToLisp { | cmd, obj, handler=nil |
+		var id, str;
+		if (outFile.notNil) {
+			if (handler.notNil) {
+				id = requestAllocator.alloc;
+				if (id.notNil) {
+					requestHandlers.put(id, handler);
+				};
+			};
+			str = [cmd.asSymbol, obj, id].asLispString;
+			outFile.putInt32(str.size);
+			outFile.write(str);
+			outFile.flush;
+		}
+	}
+	*evalLispExpression { | expression, handler |
+		this.sendToLisp('_eval', expression.asLispExpression, handler);
+	}
+
+	// utilities
+	*readFileName { | handler |
+		this.evalLispExpression("(read-file-name \"Enter file name: \")", handler);
+	}
+	*message { | format ... args |
+		this.evalLispExpression(([\message, format] ++ args).asLispString);
+	}
+
+	*updateServer {
+		var result;
+		result = [Server.default.name];
+		Server.named.do { arg server;
+			result = result.add(
+				server.name -> [
+					'running', server.serverRunning,
+					'type',
+					if (server.inProcess) {\internal} {if (server.isLocal) {\local} {\remote}},
+					'address', server.addr.ip,
+					'client-id', server.clientID,
+					'latency', server.latency,
+					'notified', server.notified,
+					'dump-mode', server.dumpMode,
+					'info', [
+						(server.avgCPU ? 0.0).round(0.1),
+						(server.peakCPU ? 0.0).round(0.1),
+						server.numUGens ? 0,
+						server.numSynths ? 0,
+						server.numGroups ? 0,
+						server.numSynthDefs ? 0
+					]
+				]);
+		};
+		this.sendToLisp(\_updateServer, result)
+	}
+}
+
+// EOF

sc/EmacsBuffer.sc

@@ -0,0 +1,324 @@
+// Emacs Widget library bindings for SCLang
+
+EmacsBuffer { // Represents an Emacs buffer
+	classvar all;
+	var <name, <>onClose, <keymap;
+	*initClass {
+		Class.initClassTree(Emacs);
+		all = Dictionary.new;
+		Emacs.evalLispExpression(
+			[\require, [\quote, 'wid-edit']].asLispString,
+			{Emacs.evalLispExpression(
+				[\defvar, 'sclang-widgets', \nil,
+					"Maps IDs to Emacs widget objects."]
+				.asLispString,
+				{Emacs.evalLispExpression(
+					['make-variable-buffer-local', [\quote, 'sclang-widgets']]
+					.asLispString)})});
+	}
+	*new {|name="*SCWindow*"|
+		^super.newCopyArgs(name).init;
+	}
+	init {
+		all[name] = this;
+		keymap = Dictionary.new;
+		Emacs.evalLispExpression(
+			['with-current-buffer', ['get-buffer-create', name],
+				[\let, [['inhibit-read-only', \t]], ['erase-buffer']],
+				['use-local-map',
+					[\let, [[\map, ['make-sparse-keymap']]],
+						['set-keymap-parent', \map, 'widget-keymap'],
+						\map]],
+				['add-hook', [\quote, 'kill-buffer-hook'],
+					[\lambda, [],
+						['sclang-eval-string',
+							['sclang-format', "EmacsBuffer.killed(%o)",
+								['buffer-name']]]],
+					\nil, \t]].asLispString)
+	}
+	*at {|name| ^all[name] }
+	defineKey {|keySeq,func|
+		keymap.put(keySeq, func);
+		Emacs.evalLispExpression(
+			this.use(['local-set-key', keySeq,
+				[\lambda, [],
+					[\interactive],
+					['sclang-eval-string',
+						['sclang-format', "EmacsBuffer.at(%o).keymap.at(%o).value",
+							['buffer-name'], keySeq]]]]).asLispString)
+	}
+	front { Emacs.evalLispExpression(['switch-to-buffer', name].asLispString) }
+	use {|...args| ^['with-current-buffer', ['get-buffer', name]]++args }
+	insert {|string|
+		Emacs.evalLispExpression(
+			this.use(['widget-insert', string]).asLispString
+		)
+	}
+	goto {|position|
+		Emacs.evalLispExpression(
+			this.use(['goto-char', position]).asLispString
+		)
+	}
+	gotoBob {
+		Emacs.evalLispExpression(
+			this.use(['goto-char', ['point-min']]).asLispString
+		)
+	}
+	gotoEob {
+		Emacs.evalLispExpression(
+			this.use(['goto-char', ['point-max']]).asLispString
+		)
+	}
+	newline { this.insert("\n")	}
+	editableField {|tag, value, action|
+		EmacsEditableField(this, tag, value).action=action
+	}
+	button {|states, action, prefix="[", suffix="]"|
+		EmacsButton(this, states, action, prefix, suffix)
+	}
+	closeButton {
+		EmacsPushButton(this, "Close").action={this.free}
+	}
+	*killed {|name|
+		var buf;
+		buf = this.at(name);
+		if (buf.isNil.not) {
+			buf.onClose.value(buf);
+			all.removeAt(name);
+		}
+	}
+	free {
+		onClose.value(this);
+		all.removeAt(name);
+		Emacs.evalLispExpression(['kill-buffer', name].asLispString,
+			{super.free})
+	}
+}
+
+EmacsWidget {
+	classvar allocator, <idmap;
+	var <buffer, <type, <args, <id, <enabled;
+	*initClass {
+		allocator = StackNumberAllocator(0,1024);
+		idmap = Array.newClear(1024);
+	}
+	*new {|buffer, type ... args|
+		^super.newCopyArgs(buffer,type,args).init;
+	}
+	init {
+		id = allocator.alloc;
+		idmap[id] = this;
+		enabled = true;
+		Emacs.evalLispExpression(
+			buffer.use(
+				['add-to-list', [\quote, 'sclang-widgets'],
+					[\cons, id, ['widget-create', [\quote, type], ':id', id]++args]],
+				['widget-setup']).asLispString)
+	}
+	wPut {|argKey, argValue, handler|
+		Emacs.evalLispExpression(
+			buffer.use(['widget-put',
+				[\cdr, [\find, id, 'sclang-widgets', ':key', [\quote, \car]]],
+				(':'++argKey).asSymbol,
+				[\quote, argValue]]).asLispString, handler)
+	}
+	wValueSet {|argValue, handler|
+		Emacs.evalLispExpression(
+			buffer.use(['widget-value-set',
+				[\cdr, [\find, id, 'sclang-widgets', ':key', [\quote, \car]]],
+				argValue]).asLispString, handler)
+	}
+	enabled_ {|argValue, handler|
+		if (argValue) {
+			Emacs.evalLispExpression(
+				buffer.use(['widget-apply',
+					[\cdr, [\find, id, 'sclang-widgets', ':key', [\quote, \car]]],
+					':activate'], \nil).asLispString, {enabled=true;handler.value})
+		} {
+			Emacs.evalLispExpression(
+				buffer.use(['widget-apply',
+					[\cdr, [\find, id, 'sclang-widgets', ':key', [\quote, \car]]],
+					':deactivate'], \nil).asLispString, {enabled=false;handler.value})
+		}
+	}
+}
+
+EmacsPushButton : EmacsWidget {
+	var <>action;
+	*new {|buffer, tag|
+		^super.new(buffer, 'push-button', ':tag', tag, ':action',
+			[\lambda, [\widget, \event],
+				['sclang-eval-string',
+					['sclang-format', "EmacsWidget.idmap[%o].action.value",
+						['widget-get', \widget, ':id']]]])
+	}
+}
+
+EmacsEditableField : EmacsWidget {
+	var <>action;
+	*new {|buffer, tag, value=""|
+		^super.new(buffer, 'editable-field', ':tag', tag,
+			':format', "%{%t%}: %v",
+			':action',
+			[\lambda, [\widget, \event],
+				['sclang-eval-string',
+					['sclang-format', "EmacsWidget.idmap[%o].action.value(%o)",
+						['widget-get', \widget, ':id'],
+						['widget-value', \widget]]]],
+		value)
+	}
+}
+
+EmacsNumber : EmacsWidget {
+	var <>action, <>spec, <value;
+	*new {|buffer, tag, spec, action, value=0|
+		^super.new(buffer, \number, ':tag', tag,
+			':format', "%{%t%}: %v",
+			':min', spec.minval,
+			':max', spec.maxval,
+			':action',
+			[\lambda, [\widget, \event],
+				[\let, [[\val, ['widget-value', \widget]]],
+					[\cond,
+						[['>', \val, ['widget-get', \widget, ':max']],
+							[\error, "Too much"]],
+						[['<', \val, ['widget-get', \widget, ':min']],
+							[\error, "Too less"]],
+						[\t,
+							['sclang-eval-string',
+								['sclang-format', "EmacsWidget.idmap[%o].valueFromEmacs(%o)",
+									['widget-get', \widget, ':id'], \val]]]]]],
+			value).action_(action).spec_(spec).initValue(value)
+	}
+	valueFromEmacs {|argValue|
+		value = argValue;
+		action.value(value)
+	}
+	value_ {|argValue|
+		Emacs.evalLispExpression(
+			buffer.use(
+				['save-excursion',
+					['widget-value-set', [\cdr, [\find, id, 'sclang-widgets', ':key', [\quote, \car]]], argValue],
+					['widget-setup']],
+				argValue).asLispString,
+			{|result|value=result})
+	}
+	initValue {|argValue|value=argValue}
+}
+
+EmacsButton : EmacsWidget {
+	var <>action, <value, <states;
+	*new {|buffer, states=#[], action, prefix="[", suffix="]"|
+		^super.new(buffer, 'sclang-button',
+			':button-prefix', prefix,
+			':button-suffix', suffix,
+			':states', [\quote, states],
+			0).action_(action).initValue(0).initStates(states)
+	}
+	valueFromEmacs {|argValue|
+		value = argValue;
+		action.value(value)
+	}
+	value_ {|argValue|
+		this.wValueSet(argValue, {value = argValue});
+	}
+	states_ {|argStates|
+		states=argStates;
+		Emacs.sendToLisp(\_widgetSetStates, [buffer.name, id, states, value]);
+		/*		Emacs.evalLispExpression(
+			buffer.use(
+				[\let, [[\widget, [\cdr, [\find, id, 'sclang-widgets', ':key', [\quote, \car]]]],
+					[\states, [\quote, states]]],
+					['widget-put', \widget, ':states', \states],
+					['widget-value-set', \widget, [\nth, value, \states]]] 
+			).asLispString) */
+	}
+	initStates {|argStates|states=argStates}
+	initValue {|argValue|value=argValue}
+}
+
+EmacsText : EmacsWidget {
+	var <string, <size, <align;
+	*new {|buffer, string="", size, align=\center|
+		^super.new(buffer, \item, ':format', "%v", ':size', size?\nil, ':align', [\quote, align],
+			':value-create',
+			[\lambda, [\widget],
+				['let*', [
+					[\align, [\or, ['widget-get', \widget, ':align'], [\quote, \center]]],
+					[\string, ['widget-get', \widget, ':value']],
+					[\size, [\cond, [[\null, ['widget-get', \widget, ':size']], [\length, \string]],
+						[['<', ['widget-get', \widget, ':size'], [\length, \string]], [\length, \string]],
+						[\t, ['widget-get', \widget, ':size']]]]
+				],
+					[\insert,
+						[\cond,
+							[['=', \size, [\length, \string]], \string],
+							[['>', \size, [\length, \string]],
+								[\cond,
+									[[\eq, \align, [\quote, \left]],
+										[\concat, \string, ['make-string', ['-', \size, [\length, \string]], $ ]]],
+									[[\eq, \align, [\quote, \right]],
+										[\concat, ['make-string', ['-', \size, [\length, \string]], $ ], \string]],
+									[[\eq, \align, [\quote, \center]],
+										[\let, [[\half, ['/', ['-', \size, [\length, \string]], 2]]],
+											[\if, ['=', ['+', [\length, \string], ['*', \half, 2]], \size],
+												[\concat, ['make-string', \half, $ ], \string, ['make-string', \half, $ ]],
+												[\concat, ['make-string', \half, $ ], \string, ['make-string', \half, $ ], " "]]]]]]]]]],
+			string).initValue(size?string.size,align,string)
+	}
+	string_ {|argString|
+		string = argString.asString;
+		this.wValueSet(string);
+	}
+	size_ {|argSize|
+		this.wPut(\size, size=argSize, {this.wValueSet(string)})
+	}
+	align_ {|argAlign|
+		this.wPut(\align, align=argAlign, {this.wValueSet(string)})
+	}
+	initValue {|argSize,argAlign,argValue|size=argSize;align=argAlign;string=argValue}
+}
+
+EmacsClassTree : EmacsWidget {
+	*new {|buffer, className, open=true|
+		^super.new(buffer, 'sclang-class-tree', ':tag', className.asString,
+			':open', if(open){\t}{\nil},
+			':node', [\quote, ['sclang-file-position',
+				':filename', className.asSymbol.asClass.filenameSymbol.asString,
+				':char-pos', className.asSymbol.asClass.charPos+1,
+				':tag', className.asString]])
+	}
+	*dynargs {|className|
+		var class;
+		class = className.asSymbol.asClass;
+		^(class.subclasses.asArray.copy.sort{|a,b|a.name <= b.name}.collect{|sc|
+			['sclang-class-tree', ':tag', sc.name.asString,
+				':node', ['sclang-file-position',
+					':filename', sc.filenameSymbol.asString,
+					':char-pos', sc.charPos+1,
+					':tag', sc.name.asString]]})
+		++
+		(class.class.methods.asArray.copy.sort({|a,b| a.name <= b.name }).collect{|m|
+			['sclang-file-position',
+				':filename', m.filenameSymbol.asString,
+				':char-pos', m.charPos+1,
+				':tag', "*"++m.name.asString]})
+		++
+		(class.methods.asArray.copy.sort({|a,b| a.name <= b.name }).collect{|m|
+			['sclang-file-position',
+				':filename', m.filenameSymbol.asString,
+				':char-pos', m.charPos+1,
+				':tag', m.name.asString]})
+	}
+}
+
+EmacsClassBrowser {
+	var w, classTree;
+	*new {|class|
+		^super.newCopyArgs(EmacsBuffer("*"++class.asClass.name++"*")).init(class);
+	}
+	init {|class|
+		classTree=EmacsClassTree(w, class);
+		w.gotoBob.front;
+	}
+}

sc/EmacsDocument.sc

@@ -0,0 +1,307 @@
+// copyright 2003 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
+
+EmacsDocument
+// : Document
+{
+	classvar documentMap, <>current;
+	var <>sceld;
+	var title, path;
+	var dataptr;
+	var <isEdited, <isListener, <envir;
+
+	*initClass {
+		documentMap = IdentityDictionary.new;
+		Class.initClassTree(EmacsInterface);
+		Class.initClassTree(ScelDocument);
+		EmacsInterface
+		.put(\documentNew, { | id, makeEnvir |
+			var doc;
+			if (documentMap.includesKey(id).not) {
+				//				[\documentNew, id, makeEnvir].postln;
+				doc = this.prBasicNew.prInitFromLisp(id);
+				// is this necessary?? when is this the case??
+				if (makeEnvir.notNil) {
+					doc.envir = Environment.new;
+				};
+			};
+			nil
+		})
+		.put(\documentClosed, { | id |
+			this.documentDo(id, { | doc |
+// 				[\documentClosed, doc].postln;
+				doc.sceld.closed;
+			});
+			nil
+		})
+		.put(\documentSetCurrent, { | id |
+			if (current.notNil) {
+// 				[\didResignKey, current].postln;
+				current.didResignKey;
+			};
+			if (id.notNil) {
+				this.documentDo(id, { | doc |
+// 					[\didBecomeKey, doc].postln;
+					doc.didBecomeKey;
+				});
+			};
+			nil
+		})
+		.put(\documentSetProperty, { | id, msg, value |
+			this.documentDo(id, { | doc |
+// 				[\documentSetProperty, doc, msg, value].postln;
+				doc.perform(msg, value);
+			});
+			nil
+		});
+	}
+
+	*documentDo { | id, function |
+		var doc;
+		doc = documentMap.at(id);
+		^if (doc.notNil) {
+			function.value(doc);
+		}
+	}
+	*documentDoMsg { | id, selector ... args |
+		var doc;
+		doc = documentMap.at(id);
+		^if (doc.notNil) {
+			doc.performList(selector, args);
+		}
+	}
+
+	// lisp support
+	storeLispOn { | stream |
+		dataptr.storeLispOn(stream)
+	}
+
+	// printing
+	printOn { | stream |
+		super.printOn(stream);
+		stream << $( << this.title << $);
+	}
+
+	//document setup
+	title_ { | argName, completionFunc |
+		Emacs.sendToLisp(\_documentRename, [this, argName], {
+			completionFunc.value(this);
+		});
+	}
+
+	title{
+		^title;
+	}
+
+	background_ {arg color, rangestart= -1, rangesize = 0;
+	}	
+	stringColor_ {arg color, rangeStart = -1, rangeSize = 0;
+	}
+
+	//interaction:
+	front {
+		Emacs.sendToLisp(\_documentSwitchTo, this);
+	}
+	
+	unfocusedFront {
+		Emacs.sendToLisp(\_documentPopTo, this);
+	}
+	
+	syntaxColorize {
+		Emacs.sendToLisp(\_documentSyntaxColorize, this);
+	}
+	
+	selectRange { arg start=0, length=0;
+		//_TextWindow_SelectRange
+	}
+	prisEditable_{ | flag = true |
+		Emacs.sendToLisp(\_documentSetEditable, [this, flag]);
+	}
+	removeUndo{
+		Emacs.sendToLisp(\_documentRemoveUndo, this);
+	}
+
+	string{ arg rangestart, returnFunc, rangesize = 1;
+		var rangeend, resultString;
+		if ( rangestart.isNil,{
+			rangestart = '(point-min)';
+			rangeend = '(point-max)';
+		},{
+			rangeend = rangestart + rangesize;
+		});
+		Emacs.evalLispExpression(['with-current-buffer', title, [ 'buffer-substring-no-properties', rangestart, rangeend ]].asLispString;, { |result| returnFunc.value( result ); } );
+		^nil;
+	}
+
+	string_{|string|
+		Emacs.sendToLisp(\_documentPutString, [this, string]);
+	}
+	
+	/*	currentLine {
+		^""
+		}*/
+	
+	// environment support
+	/*	envir_ { | environment |
+		envir = environment;
+		if (this === current) {
+			envir.push;
+		}
+	}
+	*/
+
+	didBecomeKey {
+		if (envir.notNil) {
+			envir.push;
+		};
+		current = this;
+	}
+	
+	didResignKey {
+		if (envir === currentEnvironment) {
+			envir.pop;
+		};
+		if ( current === this, { current = nil } );
+		//super.didResignKey;
+	}	
+	
+
+	// PRIVATE
+	*prNewFromPath { | argPath, selectionStart, selectionLength, completionFunc |
+		argPath = Document.standardizePath(argPath);
+		Emacs.sendToLisp(
+			\_documentOpen,
+			[argPath, selectionStart + 1, selectionLength],
+			{ | id |
+				if (id.isNil) {
+			 		"Couldn't create document".warn;
+				}{
+					this.documentDo(id, completionFunc);
+				}
+			});
+	} 
+	*prNewFromString { | name, str, makeListener, completionFunc |
+		Emacs.sendToLisp(
+		 	\_documentNew,
+			[name, str, makeListener],
+			{ | id |
+				if (id.isNil) {
+					"Couldn't create document".warn;
+				}{
+					this.documentDo(id, completionFunc);
+				}
+			});
+	}
+	prInitFromLisp { | id |
+		dataptr = id;
+		this.prAdd;
+	}
+	prclose {
+		if (dataptr.notNil) {
+			Emacs.sendToLisp(\_documentClose, this);
+		}
+	}
+	prAdd {
+		ScelDocument.addToList( this );
+		//		allDocuments = allDocuments.add(this);
+		documentMap.put(dataptr, this);
+		//initAction.value(this);
+	}
+
+	prRemove {
+		ScelDocument.removeFromList( this );
+		//	allDocuments.remove(this);
+		documentMap.removeAt(dataptr);
+		dataptr = nil;
+	}
+
+	prGetTitle {
+		^title
+	}
+	prSetTitle { | argTitle |
+		title = argTitle;
+	}
+	
+	
+	prGetFileName {
+		^path
+	}
+	prSetFileName { | argPath |
+		path = argPath;
+		if (path.notNil) {
+			path = Document.standardizePath(path);
+		}
+	}
+	
+	prSetIsListener { | flag |
+		isListener = flag.notNil;
+	}
+	prSetEditable { | flag |
+		//		sceld.editable = flag.notNil;
+	}
+	prSetEdited { | flag |
+		isEdited = flag.notNil;
+	}
+
+	*prBasicNew { ^super.new }
+
+	// unimplemented methods
+/*
+	prGetBounds { | bounds | ^bounds }
+	prSetBounds { }
+	setFont { }
+	setTextColor { }
+	text {
+		^""
+	}
+	selectedText {
+		^""
+	}
+	rangeText { arg rangestart=0, rangesize=1; 
+		^""
+	}
+	prinsertText { arg dataptr, txt;
+	}
+	insertTextRange { arg string, rangestart, rangesize;
+	}
+	setBackgroundColor { }	
+	selectedRangeLocation {
+		^0
+	}
+	selectedRangeSize {
+		^0
+	}
+	prselectLine { arg line;
+	}
+
+	// invalid methods
+	initByIndex {
+		^this.shouldNotImplement(thisMethod)
+	}
+	prinitByIndex {
+		^this.shouldNotImplement(thisMethod)
+	}	
+	initLast {
+		^this.shouldNotImplement(thisMethod)
+	}
+	prGetLastIndex {
+		^this.shouldNotImplement(thisMethod)
+		}
+*/
+}
+
+// EOF

sc/ScelDocument.sc

@@ -0,0 +1,317 @@
+// copyright 2007 Marije Baalman (nescivi AT gmail DOT com)
+//
+// 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
+
+ScelDocument : Document{
+	var <thisdoc;
+	var cFuncs;
+	var checkCurrent;
+	var <envir;
+	var title_p, path_p;
+	var <>currentString;
+
+	*new{ | title = "Untitled", string = "", makeListener = false, toFront=true |
+		//		"ScelDocument.new".postln;
+		^super.prBasicNew.init( title, string, makeListener, toFront );
+	}
+
+	*open{  | path, selectionStart = 0, selectionLength = 0, toFront=true |
+		^super.prBasicNew.initFromPath( path, selectionStart, selectionLength, toFront );
+	}
+
+	*newFromEmacs{ |doc|
+		^this.prBasicNew.prinitFromEmacs( doc );
+	}
+
+	prinitFromEmacs{ |doc|
+		thisdoc = doc;
+		thisdoc.sceld = this;
+		checkCurrent = { |doc| if ( EmacsDocument.current === doc, { this.didBecomeKey } ); };
+		checkCurrent.value( doc );
+		^this;
+	}
+
+	initFromPath{ | path, selectionStart = 0, selectionLength = 0, toFront=true|
+		checkCurrent = { |doc| if ( EmacsDocument.current === doc, { this.didBecomeKey } ); };
+		cFuncs = [checkCurrent];
+		path_p = path;
+		title_p = path;
+		EmacsDocument.prNewFromPath(path, selectionStart, selectionLength, { |doc| thisdoc = doc; thisdoc.sceld = this; cFuncs.do{ |it| it.value(doc); } } );
+		if ( toFront, { this.front } );
+		^this
+	}
+
+	init{ |title, string, makeListener, toFront|
+		//		"ScelDocument.init".postln;
+		checkCurrent = { |doc| if ( EmacsDocument.current === doc, { this.didBecomeKey } ); };
+		cFuncs = [checkCurrent];
+		title_p = title;
+		EmacsDocument.prNewFromString(title, string, makeListener, { |doc| thisdoc = doc; thisdoc.sceld = this; cFuncs.do{ |it| it.value(doc)} });
+		if ( toFront, { this.front } );
+		^this
+	}
+
+	string_ { | argName, completFunc |
+		if ( thisdoc.notNil, { 
+			thisdoc.string_( argName, completFunc )
+		},{ 
+			cFuncs = cFuncs ++ { this.string_( argName, completFunc ) };  
+		});
+	}
+
+	title_ { | argName, completFunc |
+		if ( thisdoc.notNil, { 
+			thisdoc.title_( argName, completFunc )
+		},{ 
+			cFuncs = cFuncs ++ { this.title_( argName, completFunc ) };  
+		});
+	}
+
+	title{
+		if ( thisdoc.notNil, {
+			^thisdoc.title;
+		},{ 
+			^("***"++title_p++"***")
+		});
+	}
+
+	// printing
+	printOn { | stream |
+		super.printOn(stream);
+		stream << $( << this.title << $);
+	}
+
+	prGetFileName {
+		if ( thisdoc.notNil, {
+			^thisdoc.path;
+		},{ 
+			^path_p;
+		});
+	}
+	prSetFileName { | argPath |
+		"sceldoc.prSetFileName".postln;
+		if ( thisdoc.notNil, {
+			thisdoc.prSetFileName( argPath );
+		},{
+			cFuncs = cFuncs ++ { this.prSetFileName( argPath ) };  
+		});
+	}
+
+	prSetFileName_ { | argPath |
+		"sceldoc.prSetFileName_".postln;
+		path_p = argPath;
+	}
+
+	path_{ |path|
+		"sceldoc.path".postln;
+		this.prSetFileName( path );
+		//		if ( thisdoc.notNil, { thisdoc.path_( path ) },{ completionFuncs = completionFuncs ++ { this.path_( path ) };  });
+		//		^this
+	}
+
+	front {	
+		if ( thisdoc.notNil, { 
+			thisdoc.front
+		},{ 
+			cFuncs = cFuncs ++ { this.front };  
+		});
+	}
+
+	unfocusedFront { 
+		if ( thisdoc.notNil, { 
+			thisdoc.unfocusedFront;
+		},{
+			cFuncs = cFuncs ++ { this.unfocusedFront };  
+		});
+	}
+	syntaxColorize { 
+		if ( thisdoc.notNil, { 
+			thisdoc.syntaxColorize;
+		},{
+			cFuncs = cFuncs ++ { this.syntaxColorize };  
+		});
+	}
+	prisEditable_{ | flag = true | 
+		if ( thisdoc.notNil, { 
+			thisdoc.prisEditable_( flag );
+		},{
+			cFuncs = cFuncs ++ { this.prisEditable_( flag ) };
+		});
+		editable = flag;
+	}
+	
+	removeUndo{ 
+		if ( thisdoc.notNil, { 
+			thisdoc.removeUndo
+		},{
+			cFuncs = cFuncs ++ { this.removeUndo };  
+		});
+	}
+
+	envir_ { | environment |
+		envir = environment;
+		if (this === current) {
+			envir.push;
+		}
+	}
+
+	didBecomeKey {
+		if (envir.notNil) {
+			envir.push;
+		};
+		super.didBecomeKey;
+		EmacsDocument.current = this;
+	}
+
+	didResignKey {
+		if (envir === currentEnvironment) {
+			envir.pop;
+		};
+		super.didResignKey;
+	}
+
+	//	envir_ { | environment | thisdoc.envir_( environment ) }
+	//	didBecomeKey { thisdoc.didBecomeKey }
+	//	didResignKey { thisdoc.didResignKey }
+
+	closed {
+		thisdoc.prRemove;
+		onClose.value(this); // call user function
+		//		allDocuments.remove(this);
+		//		dataptr = nil;
+	}
+
+	isEdited { 
+		if ( thisdoc.notNil, {
+			^thisdoc.isEdited
+		},{
+			^false;  
+		});
+	}
+	//	isFront { thisdoc.isFront }
+	editable_{arg abool=true; this.prisEditable_( abool ) }
+
+	/* should maybe be this:
+	path{ 
+		if ( thisdoc.notNil, {
+			^^thisdoc.prGetFileName;
+		},{ 
+			^path_p;
+		});
+	*/
+	
+	path{^thisdoc.prGetFileName }
+	
+	*addToList{ |doc| 
+		var key, sceld; 
+		//		"adding to List".postln;
+		key = allDocuments.detectIndex( { |it| it.thisdoc === doc } );
+		if ( key.isNil,
+			{
+				sceld = ScelDocument.newFromEmacs( doc );
+				allDocuments = allDocuments.add(sceld);
+				initAction.value(sceld);
+			});
+	}
+	*removeFromList{ |doc|
+		var toremove;
+		toremove = allDocuments.detectIndex( { |it| it.thisdoc === doc }  );
+		if ( toremove.notNil,
+			{
+				allDocuments.removeAt(toremove);
+			});
+	}
+	
+	prclose { 
+		if ( thisdoc.notNil,{
+			thisdoc.prclose
+		},{
+			cFuncs = cFuncs ++ { this.prclose };  
+		});			
+	}
+
+	string {arg rangestart, rangesize = 1;
+		var cond;
+		currentString = nil;
+		thisdoc.string( rangestart, { |v| currentString = v }, rangesize );
+//		cond = Condition.new( { currentString.notNil } );
+//		cond.wait;
+		//		while ( { currentString.isNil }, {"wait for string".postln;} );
+		^currentString;
+	}
+	text {
+		^this.string;
+	}
+	rangeText { arg rangestart=0, rangesize=1; 
+		^this.string( rangestart, rangesize );
+	}
+
+	// not implemented:
+	selectRange { arg start=0, length=0; }
+	background_ {arg color, rangestart= -1, rangesize = 0;
+	}	
+	stringColor_ {arg color, rangeStart = -1, rangeSize = 0;
+	}
+	currentLine {
+		^""
+	}
+
+	prGetBounds { | bounds | ^bounds }
+	prSetBounds { }
+	setFont { }
+	setTextColor { }
+	selectedText {
+		^""
+	}
+	prinsertText { arg dataptr, txt;
+	}
+	insertTextRange { arg string, rangestart, rangesize;
+	}
+	setBackgroundColor { }	
+	selectedRangeLocation {
+		^0
+	}
+	selectedRangeSize {
+		^0
+	}
+	prselectLine { arg line;
+	}
+
+	bounds_{
+	}
+	
+	*current {
+		^EmacsDocument.current.sceld;
+	}	
+
+	*prGetIndexOfListener{
+		^this.allDocuments.detectIndex( { |doc| doc.title == "*SCLang:PostBuffer*" } );
+	}
+
+	// invalid methods
+	initByIndex {
+		^this.shouldNotImplement(thisMethod)
+	}
+	prinitByIndex {
+		^this.shouldNotImplement(thisMethod)
+	}	
+	initLast {
+		^this.shouldNotImplement(thisMethod)
+	}
+	prGetLastIndex {
+		^this.shouldNotImplement(thisMethod)
+	}
+}

sc/extBuffer.sc

@@ -0,0 +1,237 @@
++ Server {
+
+	makeWindow { arg w;
+		this.makeEmacsWindow( w );
+	}
+
+	makeEmacsWindow { arg w;
+		var active, booter, killer, makeDefault, running, booting, stopped;
+		var recorder, scoper;
+		var countsViews, ctlr;
+		var dumping=false, startDump, stopDump, stillRunning;
+		
+		if (emacsbuf.notNil, { ^emacsbuf.front });
+		
+		if(w.isNil,{
+			w = emacsbuf = EmacsBuffer("*" ++ name.asString ++ " server*");
+		});
+		
+		if(isLocal,{
+			booter = EmacsButton(w, ["Boot","Quit"]);
+			booter.action = { arg value; 
+				if(value == 1, {
+					booting.value;
+					this.boot;
+				});
+				if(value == 0,{
+					this.quit;
+				});
+			};
+			booter.value=serverRunning.binaryValue;
+			
+			killer = EmacsButton(w, ["K"], { Server.killAll });
+			killer.enabled = false;
+		});
+		
+		active = EmacsText(w, this.name.asString, 12, \center);
+		//		active.background = Color.black;
+		if(serverRunning,running,stopped);		
+
+		makeDefault = EmacsButton(w, ["-> default"], {
+			thisProcess.interpreter.s = this;
+			Server.default = this;
+		});
+
+		w.newline;
+		
+		recorder = EmacsButton(w, ["prepare rec","record >","stop []"], {
+			if (recorder.value == 1) {
+				this.prepareForRecord;
+			}{
+				if (recorder.value == 2) { this.record } { this.stopRecording };
+			};
+		});
+			
+		recorder.enabled = false;
+		
+		stillRunning = {
+			SystemClock.sched(0.2, { this.stopAliveThread });
+		};
+		w.defineKey("n", { this.queryAllNodes })
+		 .defineKey(" ", { if(serverRunning.not) { this.boot } })
+		 .defineKey("d", {
+			 startDump = { 
+				 this.dumpOSC(1);
+				 this.stopAliveThread;
+				 dumping = true;
+				 CmdPeriod.add(stillRunning);
+			 };
+			 stopDump = {
+				 this.dumpOSC(0);
+				 this.startAliveThread;
+				 dumping = false;
+				 CmdPeriod.remove(stillRunning);
+			 };
+			 if(dumping, stopDump, startDump)
+		 });
+		
+		if (isLocal, {
+			running = {
+				//				active.stringColor_(Color.red);
+				booter.value=1;
+				recorder.enabled = true;
+				killer.enabled = true;
+			};
+			stopped = {
+				//				active.stringColor_(Color.grey(0.3));
+				booter.value=0;
+				recorder.value=0;
+				recorder.enabled = false;
+				killer.enabled = false;
+			};
+			booting = {
+				//				active.stringColor_(Color.yellow(0.9));
+				//booter.setProperty(\value,0);
+			};
+			
+			w.onClose = {
+				emacsbuf = nil;
+				ctlr.remove;
+			};
+		},{	
+			running = {
+				//				active.background = Color.red;
+				recorder.enabled = true;
+			};
+			stopped = {
+				//				active.background = Color.black;
+				recorder.value=0;
+				recorder.enabled = false;
+			};
+			booting = {
+				//				active.background = Color.yellow;
+			};
+			w.onClose = {
+				this.stopAliveThread;
+				ctlr.remove;
+			};
+		});
+		if(serverRunning,running,stopped);
+			
+		w.newline;
+
+		countsViews = 
+		#[
+			"Avg CPU: ", "Peak CPU: ", 
+			"UGens: ", "Synths: ", "Groups: ", "SynthDefs: "
+		].collect({ arg name, i;
+			var label,numView, pctView;
+			label = EmacsText(w, name, 12, \right);
+		
+			if (i < 2, { 
+				numView = EmacsText(w, "?", 5, \right);
+				pctView = EmacsText(w, "%");
+			},{
+				numView = EmacsText(w, "?", 6, \left);
+			});
+			if (i == 1) { w.newline };
+			numView
+		});
+		
+		ctlr = SimpleController(this)
+			.put(\serverRunning, {	if(serverRunning,running,stopped) })
+			.put(\counts,{
+				countsViews.at(0).string = avgCPU.round(0.1);
+				countsViews.at(1).string = peakCPU.round(0.1);
+				countsViews.at(2).string = numUGens;
+				countsViews.at(3).string = numSynths;
+				countsViews.at(4).string = numGroups;
+				countsViews.at(5).string = numSynthDefs;
+			})
+			.put(\cmdPeriod,{
+				recorder.value=0;
+			});	
+		w.gotoBob;
+		w.front;
+		this.startAliveThread;
+	}
+}
+
++ SynthDesc {
+	makeWindow {
+		var w, s, startButton, sliders;
+		var id, cmdPeriodFunc;
+		var synthDesc;
+		var usefulControls, numControls;
+		var getSliderValues;
+
+		s = Server.default;
+				
+		usefulControls = controls.select {|controlName, i|
+			var ctlname;
+			ctlname = controlName.name;
+			(ctlname != "?") && (ctlname != "gate")
+		};
+		
+		numControls = usefulControls.size;
+		sliders = Array.newClear(numControls);
+		
+		id = s.nextNodeID; // generate a note id.
+		
+		// make the window
+		w = EmacsBuffer("*SynthDesc"+name++"*");
+		// add a button to start and stop the sound.
+		startButton = EmacsButton(w, ["Start","Stop"]);
+		w.newline;
+		getSliderValues = {
+			var envir;
+
+			envir = ();
+			usefulControls.do {|controlName, i|
+				var ctlname;
+				ctlname = controlName.name.asSymbol;
+				envir.put(ctlname, sliders[i].value);
+			};
+			envir.use {
+				msgFunc.valueEnvir
+			};
+		};
+		
+		startButton.action = {|value|
+				if (value == 1) {
+					// start sound
+					s.sendBundle(s.latency, ["/s_new", name, id, 0, 0] ++ getSliderValues.value);
+				};
+				if (value == 0) {
+					if (hasGate) {
+						// set gate to zero to cause envelope to release
+						s.sendMsg("/n_set", id, "gate", 0);
+					}{
+						s.sendMsg("/n_free", id);
+					};
+				};
+		};
+		
+		// create controls for all parameters
+		usefulControls.do {|controlName, i|
+			var ctlname, ctlname2, capname, spec;
+			ctlname = controlName.name;
+			capname = ctlname.copy; 
+			capname[0] = capname[0].toUpper;
+			spec = ctlname.asSymbol.asSpec;
+			sliders[i] = EmacsNumber(w, capname, spec?ControlSpec(-1e8,1e8),
+				{|ez| s.sendMsg("/n_set", id, ctlname, ez); }, controlName.defaultValue);
+		};
+			
+		// set start button to zero upon a cmd-period
+		cmdPeriodFunc = { startButton.value = 0; };
+		CmdPeriod.add(cmdPeriodFunc);
+		
+		// stop the sound when window closes and remove cmdPeriodFunc.
+		w.onClose = {
+			s.sendMsg("/n_free", id);
+			CmdPeriod.remove(cmdPeriodFunc);
+		};
+		w.front; // make window visible and front window.
+	}
+}

sc/extClassBrowser.sc

@@ -0,0 +1,5 @@
++ ClassBrowser{
+	openSVN{ |svnAddr|
+		Emacs.evalLispExpression(['w3m-browse-url', svnAddr].asLispString);
+	}
+}

sc/extDocument.sc

@@ -0,0 +1,73 @@
+// copyright 2003 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
+
+
++ Document {
+	// Document class for Emacs interface.
+	//	
+	// Delegates to ScelDocument, which delegates to EmacsDocument.
+
+	// moved to Emacs, upon startup
+	//  *implementationClass { ^ScelDocument }
+
+	// PRIVATE
+	//	*newFromIndex { ^this.shouldNotImplement(thisMethod) }
+	*prGetLast { ^allDocuments.last }
+}
+
+
++ String{
+	findHelpFile {
+		if ( Emacs.initialized) {
+			Emacs.evalLispExpression(['sclang-find-help', this].asLispString);
+		}
+	}
+
+	openHelpFile {
+		if ( Emacs.initialized) {
+			this.findHelpFile;
+		}
+	}
+
+	openHTMLFile {
+		if ( Emacs.initialized) {
+		//		this.findHelpFile;
+			Emacs.evalLispExpression(['w3m-browse-url', this].asLispString);
+		}
+	}
+}
+
++ Class{
+	openHelpFile {
+		if ( Emacs.initialized) {
+			this.asString.findHelpFile;
+		}
+	}
+}
+
++ Method{
+
+	openHelpFile {
+		if ( Emacs.initialized) {
+			this.asString.findHelpFile;
+		}
+	}
+}
+ 
+
+
+// EOF

sc/homeContext.sc

@@ -0,0 +1,5 @@
++ FunctionDef {
+	homeContext {
+		^if (context.isNil) { this } { context.homeContext }
+	}
+}

sc/storeLispOn.sc

@@ -0,0 +1,117 @@
+// copyright 2003 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
+
++ Object {
+	asLispString {
+		var stream;
+		stream = CollStream.new;
+		this.storeLispOn(stream);
+		^stream.collection
+	}
+	asLispExpression {
+		^this.asLispString
+	}
+	storeLispOn { arg stream;
+		stream << "#<" << this << ">"
+	}
+}
+
++ Symbol {
+	storeLispOn { arg stream;
+		stream.putAll(this.asString)
+	}
+}
+
++ String {
+	asLispExpression {
+		^this
+	}
+	storeLispOn { arg stream;
+		stream.put($").putAll(this.escapeChar($")).put($")
+	}
+}
+
++ Char {
+	storeLispOn { arg stream;
+		stream.putAll("?"++this)
+	}
+}
+
++ Color {
+	storeLispOn { arg stream;
+		("#"++(red*255).asInteger.asHexString(2)
+			++(green*255).asInteger.asHexString(2)
+			++(blue*255).asInteger.asHexString(2)).storeLispOn(stream)
+	}
+}
+
++ Number {
+	storeLispOn { arg stream;
+		stream << this
+	}
+}
+
++ Nil {
+	storeLispOn { arg stream;
+		stream << "nil"
+	}
+}
+
++ True {
+	storeLispOn { arg stream;
+		stream.put($t)
+	}
+}
+
++ False {
+	storeLispOn { arg stream;
+		nil.storeLispOn(stream)
+	}
+}
+
++ Association {
+	storeLispOn { arg stream;
+		stream.put($();
+		this.key.storeLispOn(stream);
+		stream.space.put($.).space;
+		this.value.storeLispOn(stream);
+		stream.put($));
+	}
+}
+
++ Collection {
+	lispDo { arg function;
+		this.do(function);
+	}
+
+	storeLispOn { arg stream;
+		stream.put($();
+		this.lispDo { arg x, i;
+			if (i != 0) { stream.space };
+			x.storeLispOn(stream);
+		};
+		stream.put($));
+	}
+}
+
++ Dictionary {
+	lispDo { arg function;
+		this.associationsDo(function)
+	}
+}
+
+// EOF