From 53d3959e1b41f6556c7311057afb3f69276fd8eb Mon Sep 17 00:00:00 2001 From: nik gaffney Date: Sat, 30 Jul 2022 19:15:38 +0200 Subject: [PATCH] changes for MELPA compatibility --- README.md | 15 +- el/Eldev | 1 + el/sclang-browser.el | 193 ++++++----- el/sclang-dev.el | 35 +- el/sclang-document.el | 14 +- el/sclang-help.el | 520 ++++++++++++++-------------- el/sclang-interp.el | 382 +++++++++++---------- el/sclang-keys.el | 26 +- el/sclang-language.el | 725 +++++++++++++++++++++------------------- el/sclang-menu.el | 15 +- el/sclang-minor-mode.el | 88 ++--- el/sclang-mode.el | 428 ++++++++++++------------ el/sclang-server.el | 120 ++++--- el/sclang-util.el | 36 +- el/sclang-vars.el.in | 1 + el/sclang-widgets.el | 67 ++-- el/sclang.el | 30 +- 17 files changed, 1471 insertions(+), 1225 deletions(-) diff --git a/README.md b/README.md index 21a949a..ef9f27d 100644 --- a/README.md +++ b/README.md @@ -7,8 +7,9 @@ SuperCollider/Emacs interface There are 3 options for installation: 1. Using SuperCollider Quarks (recommended) -2. From debian package `supercollider-emacs` -3. From source +2. Using an Emacs package manager +3. From debian package `supercollider-emacs` +4. From source Option #1 is the best cross-platform option, and is recommended. Whatever option you choose, *make sure not to mix installation methods*. In particular, do not @@ -61,9 +62,11 @@ exec-path. (setq exec-path (append exec-path '("/Applications/SuperCollider.app/Contents/MacOS/"))) ``` -#### Installing with an emacs package manager +### Install Option 2: Emacs package manager -It's completely possible to install with +The `sclang` package can be installed from [MELPA](https://melpa.org/#/sclang) and configured with [use-package](https://github.com/jwiegley/use-package). + +It's possible to install with [straight.el](https://github.com/raxod502/straight.el), [use-package](https://github.com/jwiegley/use-package), [doom](https://github.com/hlissner/doom-emacs), etc. Instructions for doing so @@ -71,7 +74,7 @@ are beyond the scope of this README, but note that `autoloads` are implemented for entry-point functions so if you like to have a speedy start-up time you can use the `:defer t` option. -### Install Option 2: Debian package +### Install Option 3: Debian package There is a debian package which provides emacs integration called `supercollider-emacs`. Option #1 will likely be more recent, but @@ -81,7 +84,7 @@ if you prefer you can install the package with: sudo apt install supercollider-emacs ``` -### Install Option 3: Installing from source +### Install Option 4: Installing from source If you are building SuperCollider from source, you can optionally compile and install this library along with it. The cmake `-DSC_EL` flag controls whether diff --git a/el/Eldev b/el/Eldev index 9ff63c3..5e2b2e6 100644 --- a/el/Eldev +++ b/el/Eldev @@ -4,3 +4,4 @@ ;; We use it for package development and running tests (eldev-use-plugin 'autoloads) +(eldev-use-package-archive 'melpa) diff --git a/el/sclang-browser.el b/el/sclang-browser.el index 749ccf7..3dac18b 100644 --- a/el/sclang-browser.el +++ b/el/sclang-browser.el @@ -1,5 +1,9 @@ -;; copyright 2003 stefan kersten +;;; sclang-browser.el --- SuperCollider documentation browser -*- coding: utf-8; lexical-binding: t -*- ;; +;; Copyright 2003 stefan kersten + +;;; License: + ;; 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 @@ -15,163 +19,184 @@ ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; USA -(require 'sclang-util) -(require 'view nil t) +;;; Commentary: +;; Browser for SuperCollider documentation. ;; TODO: better factoring -;; derive from view mode, make mode-map pluggable -;; define derived mode for completion, definition, help +;; - derive from view mode, make mode-map pluggable +;; - define derived mode for completion, definition, help +;; - update 'display-buffer-reuse-frames' +;; - update ‘view-return-to-alist’ -(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) +(require 'sclang-util) +(require 'view) -(defvar sclang-browser-mode-map (sclang-browser-fill-keymap (make-sparse-keymap))) +;;; Code: + +(defun sclang-browser-fill-keymap () + "Create keymap and bindings." + (let ((map (make-sparse-keymap))) + (set-keymap-parent map view-mode-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)) (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") +(defvar sclang-browser-link-function nil) +(defvar sclang-browser-return-method nil) (defun sclang-browser-beginning-of-link () + "Beginning of link." (interactive) (when (get-text-property (point) 'sclang-browser-link) (while (and (not (bobp)) - (get-text-property (point) 'sclang-browser-link)) + (get-text-property (point) 'sclang-browser-link)) (forward-char -1)) (unless (bobp) (forward-char 1)) (point))) (defun sclang-browser-next-link (&optional n) + "Next link (or N further)." (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) + (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)) + (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))))))) + (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 () + "Previous link." (interactive) (sclang-browser-next-link -1)) (defun sclang-browser-follow-link (&optional pos) + "Follow link (optionally POS)." (interactive) (let* ((pos (or pos (point))) - (data (get-text-property pos 'sclang-browser-link))) + (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))))))) + (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) + "Link. click. EVENT." (interactive "e") (let* ((start (event-start event)) - (window (car start)) - (pos (cadr start))) + (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'. + "Major mode for viewing hypertext and navigating references. +Entry to this mode runs the normal hook `sclang-browser-mode-hook' + Commands: \\{sclang-browser-mode-map}" (interactive) + (view-mode) (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) + (set (make-local-variable 'view-no-disable-on-exit) t) (run-hooks 'sclang-browser-mode-hook)) (defun sclang-browser-mode-setup () + "Setup sclang-browser-mode." (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))) + "Finish sclang-browser-mode." + (read-only-mode) + ;; ‘view-return-to-alist’ is an obsolete variable (as of 24.1) + ;;(setq view-return-to-alist + ;; (list (cons (selected-window) sclang-browser-return-method))) + (view-mode -1) (run-hooks 'sclang-browser-show-hook)) (defun sclang-browser-quit () + "Quit the sclang help browser." (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))) - ))) + "Make a link using LINK-TEXT (optional LINK-DATA and LINK-FUNCTION)." + (propertize link-text + 'mouse-face 'highlight + 'sclang-browser-link (cons link-function link-data))) (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)" + "Display browser using BUFFER-NAME and 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))) + (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))))) + ;; 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 is obsolete since 24.3 + ;; replace with something like + ;;+ (add-to-list 'display-buffer-alist + ;;+ '("." nil (reusable-frames . t))) + ;;- (display-buffer-reuse-frames + ;;- (cons (selected-window) 'quit-window)) + ((not (one-window-p t)) + (cons (selected-window) 'quit-window)) + ;; This variable is provided mainly for backward compatibility + ;; and should not be used in new code. + ;; (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) + "Display browser in BUFFER-NAME and run BODY." `(sclang-display-browser ,buffer-name (lambda () ,@body))) ;; ===================================================================== @@ -180,4 +205,4 @@ Commands: (provide 'sclang-browser) -;; EOF \ No newline at end of file +;;; sclang-browser.el ends here diff --git a/el/sclang-dev.el b/el/sclang-dev.el index 211082d..8e61119 100644 --- a/el/sclang-dev.el +++ b/el/sclang-dev.el @@ -1,3 +1,9 @@ +;;; sclang-dev.el --- IDE for working with SuperCollider -*- coding: utf-8; +;; +;; Copyright 2003 stefan kersten + +;;; License: + ;; 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 @@ -13,32 +19,25 @@ ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; USA + +;;; Commentary: +;; Edit SuperCollider help files. + (require 'sclang-util) (require 'sclang-interp) +;;; Code: + (sclang-set-command-handler - 'openDevSource - (lambda (file) - ) - ) + 'openDevSource + (lambda (file))) (defun sclang-edit-dev-source () "Edit the help file at the development location." -; (sclang-document-name . (prSetTitle (buffer-name))) (interactive) - (sclang-perform-command 'openDevSource (buffer-file-name)) - ) + ;; (sclang-document-name . (prSetTitle (buffer-name))) + (sclang-perform-command 'openDevSource (buffer-file-name))) (provide 'sclang-dev) -;(defun sclang-open-dev-source (file) -; "Open the help file at the development location." -; (if (sclang-html-file-p file) -; (html-mode) -; ;; (find-file file) -; ) -; (if ( sclang-sc-file-p file ) -; (sclang-mode) -; ) -; ) - +;;; sclang-dev.el ends here diff --git a/el/sclang-document.el b/el/sclang-document.el index ffb53cd..1e1b9cb 100644 --- a/el/sclang-document.el +++ b/el/sclang-document.el @@ -1,5 +1,9 @@ -;; copyright 2003 stefan kersten +;;; sclang-document.el --- IDE for working with SuperCollider -*- coding: utf-8; ;; +;; Copyright 2003 stefan kersten + +;;; License: + ;; 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 @@ -15,6 +19,12 @@ ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; USA + +;;; Commentary: +;; ??? + +;;; Code: + (provide 'sclang-document) -;; EOF \ No newline at end of file +;;; sclang-document.el ends here diff --git a/el/sclang-help.el b/el/sclang-help.el index 46e1c1a..0de1d98 100644 --- a/el/sclang-help.el +++ b/el/sclang-help.el @@ -1,5 +1,9 @@ -;; copyright 2003 stefan kersten +;;; sclang-help.el --- IDE for working with SuperCollider -*- coding: utf-8; ;; +;; Copyright 2003 stefan kersten + +;;; License: + ;; 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 @@ -15,11 +19,17 @@ ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; USA +;;; Commentary: +;; Access SuperCollider help files. + +;;; Code: + (eval-when-compile (require 'font-lock)) -;; (require 'w3m) ;; not needed during compilation +(require 'w3m) (require 'cl-lib) + (require 'sclang-util) (require 'sclang-interp) (require 'sclang-language) @@ -49,7 +59,7 @@ :type 'directory) (defcustom sclang-help-path (list sclang-system-help-dir - "~/.local/share/SuperCollider/Help") + "~/.local/share/SuperCollider/Help") "List of directories where SuperCollider help files are kept." :group 'sclang-interface :version "21.4" @@ -61,7 +71,7 @@ :type 'directory) (defconst sclang-extension-path (list sclang-system-extension-dir - "~/.local/share/SuperCollider/Extensions") + "~/.local/share/SuperCollider/Extensions") "List of SuperCollider extension directories.") (defcustom sclang-help-fill-column fill-column @@ -87,29 +97,32 @@ (defcustom sclang-help-filters '(("p\\.p\\([0-9]+\\)" . "#p\\1") ("

\\(.*\\)

" . "
\\2
")) - "list of pairs of (regexp . filter) defining html-tags to be replaced by the function sclang-help-substitute-for-filters" + "Filters to replace html tags. +List of pairs of (regexp . filter) defining html-tags to be replaced +using 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" + "Substitute various tags in SCs html-docs. +Optional argument ARGS unused?" (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)) + (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) +;; checks if w3m-filter is loaded. Is `eval-after-load' necessary here? (eval-after-load "w3m-filter" '(add-to-list 'w3m-filter-rules - ;; run on all files read by w3m... + ;; 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.") @@ -136,40 +149,51 @@ ;; ===================================================================== (defun sclang-get-help-file (topic) + "Get the help file for 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) + "Get the help topic for 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) + "Set the help buffer name to TOPIC." (sclang-make-buffer-name (concat "Help:" topic))) +;; file predicate functions + (defun sclang-rtf-file-p (file) + "Does an rtf FILE exist?" (let ((case-fold-search t)) (string-match ".*\\.rtf$" file))) -;; ========= ADDITION for HTML help files (defun sclang-html-file-p (file) - (let ((case-fold-search t)) - (string-match ".*\\.html?$" file))) + "Does an html FILE exist?" + (let ((case-fold-search t)) + (string-match ".*\\.html?$" file))) (defun sclang-sc-file-p (file) + "Does an sc FILE exist?" (let ((case-fold-search t)) (string-match ".*\\.sc$" file))) (defun sclang-scd-file-p (file) + "Does an scd FILE exist?" (let ((case-fold-search t)) (string-match ".*\\.scd$" file))) (defun sclang-help-file-p (file) + "Is FILE a help file?" (string-match sclang-help-file-regexp file)) + (defun sclang-help-topic-name (file) - (if (string-match sclang-help-file-regexp file) - (cons (file-name-nondirectory (replace-match "" nil nil file 1)) - file))) + "Get the help topic from FILE." + (when (string-match sclang-help-file-regexp file) + (cons (file-name-nondirectory (replace-match "" nil nil file 1)) + file))) ;; ===================================================================== ;; rtf parsing @@ -178,7 +202,7 @@ (defconst sclang-rtf-face-change-token "\0") (defun sclang-fill-rtf-syntax-table (table) - ;; character quote + "Fill RTF syntax TABLE." (modify-syntax-entry ?\\ "/" table) (modify-syntax-entry ?\" "." table) (modify-syntax-entry ?\{ "(" table) @@ -193,8 +217,8 @@ "Syntax table used for RTF parsing.") (defvar sclang-rtf-font-map '((Helvetica . variable-pitch) - (Helvetica-Bold . variable-pitch) - (Monaco . nil))) + (Helvetica-Bold . variable-pitch) + (Monaco . nil))) (cl-defstruct sclang-rtf-state output font-table font face pos) @@ -204,197 +228,212 @@ (defun sclang-code-p (pos) (not (rtf-p pos)))) (defmacro with-sclang-rtf-state-output (state &rest body) + "Wrap rtf STATE output around BODY." `(with-current-buffer (sclang-rtf-state-output ,state) ,@body)) (defmacro sclang-rtf-state-add-font (state font-id font-name) + "Add font to STATE font table using FONT-ID and FONT-NAME." `(push (cons ,font-id (intern ,font-name)) (sclang-rtf-state-font-table ,state))) (defmacro sclang-rtf-state-apply (state) + "Apply STATE to rtf output." (let ((pos (cl-gensym)) - (font (cl-gensym)) - (face (cl-gensym))) + (font (cl-gensym)) + (face (cl-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))))))) + (,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) + "Set FONT in STATE." `(progn (sclang-rtf-state-apply ,state) (setf (sclang-rtf-state-font ,state) ,font))) (defmacro sclang-rtf-state-push-face (state face) + "Push FACE to STATE." (let ((list (cl-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))))))) + (setf (sclang-rtf-state-face ,state) + (append ,list (list ,face))))))) (defmacro sclang-rtf-state-pop-face (state face) + "Pop FACE from STATE." (let ((list (cl-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)) + "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))))) + ;; 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))))) - )) + "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) + "Parse RTF control chars. 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)) - ))) + (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) + "Convert rtf buffer. OUTPUT." (let ((case-fold-search nil) - (fill-column sclang-help-fill-column)) + (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)))))) + (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) + "Fill help syntax TABLE." ;; make ?- be part of symbols for selection and sclang-symbol-at-point (modify-syntax-entry ?- "_" table)) (defun sclang-fill-help-mode-map (map) + "Fill sclang help mode keymap 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) + "Limit point to code BODY." (let ((min (cl-gensym)) - (max (cl-gensym)) - (res (cl-gensym))) + (max (cl-gensym)) + (res (cl-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))))))) + (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) + "Move to beginning of function (or back ARG)." (interactive "p") (sclang-help-mode-limit-point-to-code (sclang-beginning-of-defun arg))) (defun sclang-help-mode-end-of-defun (&optional arg) + "Move to end of function (or forward ARG)." (interactive "p") (sclang-help-mode-limit-point-to-code (sclang-end-of-defun arg))) (defun sclang-help-mode-fontify-region (start end loudly) + "Fontify region from START to END and LOUDLY." (cl-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))))) + (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)) + (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)))))) + (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 () + "Indent sclang code in documentation." (if (sclang-code-p (point)) (sclang-indent-line) (insert "\t"))) @@ -403,30 +442,29 @@ "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)))) + (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) - (toggle-read-only 0) - (erase-buffer) - (insert-buffer-substring tmp-buffer)) - (and (buffer-modified-p) (not modified-p) (set-buffer-modified-p nil)) - (kill-buffer tmp-buffer)))))) + (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) + (read-only-mode) + (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)))) + (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) - )) + (set (make-local-variable 'indent-line-function) 'sclang-help-mode-indent-line))) ;; ===================================================================== ;; help file access @@ -436,17 +474,18 @@ "Answer t if PATH should be skipped during help file indexing." (let ((directory (file-name-nondirectory path))) (cl-some (lambda (regexp) (string-match regexp directory)) - '("^\.$" "^\.\.$" "^CVS$" "^\.svn$" "^_darcs$")))) + ;; skip "." ".." "CVS" ".svn" and "_darcs" directories + '("\\.\\'" "\\.\\.\\'" "^CVS\\'" "^\\.svn$" "^_darcs\\'")))) (defun sclang-filter-help-directories (list) "Remove paths to be skipped from LIST of directories." (cl-remove-if (lambda (x) - (or (not (file-directory-p x)) - (sclang-skip-help-directory-p x))) - list)) + (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." + "List files in DIRECTORY (optionally FULL MATCH NOSORT) or nil." (condition-case nil (directory-files directory full match nosort) (error nil))) @@ -454,20 +493,20 @@ ;; (defun sclang-extension-help-directories () ;; "Build a list of help directories for extensions." ;; (cl-flet ((flatten (seq) -;; (if (null seq) -;; seq -;; (if (listp seq) -;; (reduce 'append (mapcar #'flatten seq)) -;; (list 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)))) +;; (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 () @@ -482,11 +521,11 @@ "Build a help topic alist from directories in DIRS, with initial RESULT." (if dirs (let* ((files (sclang-directory-files-save (car dirs) t)) - (topics (remq nil (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))) + (topics (remq nil (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 () @@ -494,31 +533,28 @@ (interactive) (setq sclang-help-topic-alist nil) (let ((case-fold-search nil) - (max-specpdl-size 10000) - (max-lisp-eval-depth 10000)) + (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-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) - ) + (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." +Switches to text mode with `sclang-minor-mode'." (interactive) (w3m-copy-buffer) -;; (text-mode) + ;; (text-mode) (sclang-mode) - (toggle-read-only) - (rename-buffer "*SC_Help:CodeEdit*") - ) - + (read-only-mode) + (rename-buffer "*SC_Help:CodeEdit*")) (defun sclang-edit-help-file () "Edit the help file associated with the current buffer. @@ -526,16 +562,16 @@ 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"))) + (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 () @@ -543,45 +579,36 @@ Either visit file internally (.sc) or start external editor (.rtf)." (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)))))) + (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" + "Switch to the *w3m* buffer to browse help files." (interactive) (let* ((buffer-name "*w3m*") - (buffer (get-buffer buffer-name))) + (buffer (get-buffer buffer-name))) (if buffer - (switch-to-buffer 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") - ) - ) - ) + (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 -; -; ) - ) - ) + (with-current-buffer buffer + (rename-buffer "*SC_Help:w3m*") + ;;(setq buffer-read-only false) + (sclang-help-minor-mode))))) (defun sclang-find-help (topic) + "Find help for TOPIC." (interactive (list (let ((topic (or (and mark-active (buffer-substring-no-properties (region-beginning) (region-end))) @@ -609,17 +636,15 @@ Either visit file internally (.sc) or start external editor (.rtf)." (set-buffer-modified-p nil))) (switch-to-buffer buffer)) (if (sclang-html-file-p file) - (sclang-goto-help-browser)) - ) + (sclang-goto-help-browser))) (sclang-message "Help file not found") nil) (sclang-message "No help for \"%s\"" topic) nil))) (defun sclang-open-help-gui () - "Open SCDoc Help Browser" + "Open SCDoc Help Browser." (interactive) - (sclang-eval-string (sclang-format "Help.gui")) - ) + (sclang-eval-string (sclang-format "Help.gui"))) (defvar sclang-scdoc-topics (make-hash-table :size 16385) "List of all scdoc topics.") @@ -629,24 +654,23 @@ Either visit file internally (.sc) or start external editor (.rtf)." (lambda (list-of-symbols) (mapcar (lambda (arg) (puthash arg nil sclang-scdoc-topics)) - list-of-symbols) - )) + list-of-symbols))) (defun sclang-find-help-in-gui (topic) - "Search for topic in SCDoc Help Browser" + "Search for TOPIC in Help Browser." (interactive (list (let ((topic (sclang-symbol-at-point))) - (completing-read (format "Help topic%s: " (if topic - (format " (default %s)" topic) - "")) - sclang-scdoc-topics nil nil nil 'sclang-help-topic-history topic))) - ) + (completing-read + (format "Help topic%s: " (if topic + (format " (default %s)" topic) + "")) + sclang-scdoc-topics nil nil nil 'sclang-help-topic-history topic)))) (if topic - (sclang-eval-string (sclang-format "HelpBrowser.openHelpFor(%o)" topic)) - (sclang-eval-string (sclang-format "Help.gui")) - ) - ) + (sclang-eval-string + (sclang-format "HelpBrowser.openHelpFor(%o)" topic)) + (sclang-eval-string + (sclang-format "Help.gui")))) ;; ===================================================================== @@ -664,16 +688,18 @@ Either visit file internally (.sc) or start external editor (.rtf)." (lambda () (clrhash sclang-scdoc-topics))) -(add-to-list 'auto-mode-alist '("\\.rtf$" . sclang-help-mode)) +(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 +;;; sclang-help.el ends here diff --git a/el/sclang-interp.el b/el/sclang-interp.el index b836347..9eed6c0 100644 --- a/el/sclang-interp.el +++ b/el/sclang-interp.el @@ -1,5 +1,9 @@ -;; copyright 2003-2005 stefan kersten +;;; sclang-interp.el --- IDE for working with SuperCollider -*- coding: utf-8; ;; +;; Copyright 2003 stefan kersten + +;;; License: + ;; 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 @@ -15,6 +19,10 @@ ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; USA + +;;; Commentary: +;; SuperCollider interpreter interface + (require 'sclang-util) (require 'compile) @@ -24,6 +32,8 @@ ;; FIXME: everything will fail when renaming the post buffer! +;;; Code: + (defconst sclang-post-buffer (sclang-make-buffer-name "PostBuffer") "Name of the SuperCollider process output buffer.") @@ -34,7 +44,7 @@ "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]\+\\)" + "^\\(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 @@ -52,42 +62,44 @@ Default behavior is to only scroll when point is not at end of buffer." :type 'boolean) (defun sclang-get-post-buffer () + "Get or create the sclang post buffer." (get-buffer-create sclang-post-buffer)) (defmacro with-sclang-post-buffer (&rest body) + "BODY in the sclang post buffer." `(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)))) +;; (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)))))))) +;; (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))) +;; (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))))))) +;; (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. @@ -98,7 +110,7 @@ If EOB-P is non-nil, positions cursor at end of buffer." (when eob-p (goto-char (point-max)) (save-selected-window - (set-window-point window (point-max))))))) + (set-window-point window (point-max))))))) (defun sclang-clear-post-buffer () "Clear the output buffer." @@ -112,18 +124,19 @@ If EOB-P is non-nil, positions cursor at end of buffer." ;; setup sclang mode (sclang-mode) (set (make-local-variable 'font-lock-fontify-region-function) - (lambda (&rest args))) + (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))) + ;; see elisp docs for `make-variable-buffer-local' and `make-local-variable' use cases + (set (make-local-variable 'compilation-error-screen-columns) nil) + (set (make-local-variable 'compilation-error-regexp-alist) + (cons (list sclang-parse-error-regexp 2 3 4) compilation-error-regexp-alist)) + (set (make-local-variable 'compilation-parse-errors-function) + (lambda (limit-search find-at-least) + (compilation-parse-errors limit-search find-at-least))) + (set (make-local-variable 'compilation-parse-errors-filename-function) + (lambda (file-name) + file-name))) (sclang-clear-post-buffer) (sclang-show-post-buffer)) @@ -189,6 +202,7 @@ If EOB-P is non-nil, positions cursor at end of buffer." ;; ===================================================================== (defun sclang-get-process () + "Return the current sclang process." (get-process sclang-process)) ;; ===================================================================== @@ -217,16 +231,19 @@ If EOB-P is non-nil, positions cursor at end of buffer." ;; initialization (defun sclang-library-initialized-p () + "Is sclang library initialized?" (and (sclang-get-process) sclang-library-initialized-p)) (defun sclang-on-library-startup () + "Initialize sclang library." (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 () + "Library shutdown." (when sclang-library-initialized-p (run-hooks 'sclang-library-shutdown-hook) (setq sclang-library-initialized-p nil) @@ -237,6 +254,7 @@ If EOB-P is non-nil, positions cursor at end of buffer." ;; ===================================================================== (defun sclang-process-sentinel (proc msg) + "Process sentinel PROC MSG." (with-sclang-post-buffer (goto-char (point-max)) (insert @@ -248,47 +266,51 @@ If EOB-P is non-nil, positions cursor at end of buffer." (sclang-stop-command-process))) (defun sclang-process-filter (process string) + "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)) + (> (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)))))) + (= (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) + "Is STRING an sclang memory option?" (let ((case-fold-search nil)) (string-match "^[1-9][0-9]*[km]?$" string))) (defun sclang-port-option-p (number) + "Is NUMBER a valid sclang port?" (and (integerp number) (>= number 0) (<= number #XFFFF))) (defun sclang-make-options () + "Make options." (let ((default-directory "")) (nconc (when (and sclang-runtime-directory - (file-directory-p sclang-runtime-directory)) + (file-directory-p sclang-runtime-directory)) (list "-d" (expand-file-name sclang-runtime-directory))) (when (and sclang-library-configuration-file - (file-exists-p sclang-library-configuration-file)) + (file-exists-p sclang-library-configuration-file)) (list "-l" (expand-file-name sclang-library-configuration-file))) (when (sclang-memory-option-p sclang-heap-size) (list "-m" sclang-heap-size)) @@ -313,8 +335,8 @@ If EOB-P is non-nil, positions cursor at end of 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)))) + 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) @@ -334,11 +356,11 @@ If EOB-P is non-nil, positions cursor at end of buffer." (when (sclang-get-process) (process-send-eof sclang-process) (let ((tries 4) - (i 0)) + (i 0)) (while (and (sclang-get-process) - (< i tries)) - (cl-incf i) - (sit-for 0.5)))) + (< i tries)) + (cl-incf i) + (sit-for 0.5)))) (sclang-kill) (sclang-stop-command-process)) @@ -346,8 +368,7 @@ If EOB-P is non-nil, positions cursor at end of buffer." "Recompile class library." (interactive) (when (sclang-get-process) - (process-send-string sclang-process "\x18") - )) + (process-send-string sclang-process "\x18"))) ;; ===================================================================== ;; command process @@ -371,58 +392,63 @@ Change this if \"cat\" has a non-standard name or location." "Subprocess for receiving command results from sclang.") (defconst sclang-cmd-helper-proc "SCLang Command Helper" - "Dummy subprocess that will keep the command fifo open for writing - so reading does not fail automatically when sclang closes its own - writing end of the fifo") + "Dummy subprocess that will keep the command fifo open for writing. +This is needed so reading does not automatically fail when sclang +closes its own writing end of the fifo.") (defvar sclang-command-fifo nil "FIFO for communicating with the subprocess.") (defun sclang-delete-command-fifo () + "Delete the command fifo." (and sclang-command-fifo (file-exists-p sclang-command-fifo) (delete-file sclang-command-fifo))) (defun sclang-release-command-fifo () + "Release the command fifo." (sclang-delete-command-fifo) (setq sclang-command-fifo nil)) (defun sclang-create-command-fifo () + "Create the command fifo." (setq sclang-command-fifo (make-temp-name - (expand-file-name - "sclang-command-fifo." temporary-file-directory))) + (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))) + nil t t + sclang-command-fifo))) (unless (eq 0 res) (message "SCLang: Couldn't create command fifo") (setq sclang-command-fifo nil)))) (defun sclang-start-command-process () + "Start the command process." (sclang-create-command-fifo) (when sclang-command-fifo ;; start the dummy process to keep the fifo open (let ((process-connection-type nil)) (let ((proc (start-process-shell-command - sclang-cmd-helper-proc nil - (concat sclang-cat-program " > " sclang-command-fifo)))) - (set-process-query-on-exit-flag proc nil))) + sclang-cmd-helper-proc nil + (concat sclang-cat-program " > " sclang-command-fifo)))) + (set-process-query-on-exit-flag proc nil))) ;; 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-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) - (set-process-query-on-exit-flag proc nil))) + sclang-command-process nil + sclang-cat-program sclang-command-fifo))) + (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) + (set-process-query-on-exit-flag proc nil))) (unless (get-process sclang-command-process) (message "SCLang: Couldn't start command process")))) (defun sclang-stop-command-process () + "Stop the command process." (when (get-process sclang-cmd-helper-proc) (kill-process sclang-cmd-helper-proc) (delete-process sclang-cmd-helper-proc)) @@ -434,12 +460,13 @@ Change this if \"cat\" has a non-standard name or location." "Unprocessed command process output.") (defun sclang-command-process-filter (proc string) + "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))))) + (>= (length string) + (setq end (+ 4 (sclang-string-to-int32 string))))) (sclang-handle-command-result (read (decode-coding-string (substring string 4 end) 'utf-8))) (setq string (substring string end)))) @@ -452,59 +479,64 @@ Change this if \"cat\" has a non-standard name or location." ;; symbol property: sclang-command-handler (defun sclang-set-command-handler (symbol function) + "Set command handler SYMBOL to FUNCTION." (put symbol 'sclang-command-handler function)) (defun sclang-perform-command (symbol &rest args) + "Eval command SYMBOL with ARGS." (sclang-eval-string (sclang-format - "Emacs.lispPerformCommand(%o, %o, true)" - symbol args))) + "Emacs.lispPerformCommand(%o, %o, true)" + symbol args))) (defun sclang-perform-command-no-result (symbol &rest args) + "Eval command SYMBOL with ARGS. No result." (sclang-eval-string (sclang-format - "Emacs.lispPerformCommand(%o, %o, false)" - symbol args))) + "Emacs.lispPerformCommand(%o, %o, false)" + symbol args))) (defun sclang-default-command-handler (fun arg) - "Default command handler. + "Default command handler for FUN with ARG. Displays short message on error." - (condition-case nil + (condition-case err (funcall fun arg) - (error (sclang-message "Error in command handler") nil))) + (error (sclang-message + (format "Error in command handler: %s" err)) nil))) (defun sclang-debug-command-handler (fun arg) - "Debugging command handler. + "Debugging command handler for FUN with ARG. Enters debugger on error." (let ((debug-on-error t) - (debug-on-signal 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." + "Toggle debugging of command handler (or set 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)) + (if (or (and arg (> arg 0)) + (eq sclang-command-handler 'sclang-debug-command-handler)) + 'sclang-default-command-handler + 'sclang-debug-command-handler)) (sclang-message "Command handler debugging %s." - (if (eq sclang-command-handler 'sclang-debug-command-handler) - "enabled" - "disabled"))) + (if (eq sclang-command-handler 'sclang-debug-command-handler) + "enabled" + "disabled"))) (defun sclang-handle-command-result (list) + "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)))))) + (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))) ;; ===================================================================== @@ -520,61 +552,69 @@ With arg, activate debugging iff arg is positive." :type 'boolean) (defun sclang-send-string (token string &optional force) + "Send TOKEN STRING to sclang (optionally 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." + "Evaluate STRING with sclang 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." + "Evaluate STRING as SuperCollider code (suppress output if SILENT-P is non-nil)." (interactive "sEval: \nP") (sclang-eval-string string (not silent-p))) (defun sclang-eval-line (&optional silent-p) - "Execute the current line as SuperCollider code." + "Evaluate current line with sclang (suppress output if SILENT-P is non-nil)." (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)) - (forward-line 1)) + (/= (line-end-position) (point-max)) + (forward-line 1)) string)) (defun sclang-eval-region (&optional silent-p) - "Execute the region as SuperCollider code." + "Evaluate current region with sclang (suppress output if SILENT-P is non-nil)." (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) + "Evaluate current line or region (suppress output if SILENT-P is non-nil)." (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) + "Evaluate current function definition (suppress output if SILENT-P is non-nil)." (interactive "P") (let ((string (sclang-defun-at-point))) (when (and string (string-match "^(" string)) (sclang-eval-string string (not silent-p)) string))) +(defun sclang-eval-dwim () + "Evaluate line, region, function or buffer." + (interactive "P") + (or (sclang-eval-defun) + (sclang-eval-region-or-line))) + (defun sclang-eval-document (&optional silent-p) - "Execute the whole document as SuperCollider code." + "Evaluate current buffer with sclang (suppress output if SILENT-P is non-nil)." (interactive "P") (save-excursion - (mark-whole-buffer) (sclang-eval-string - (buffer-substring-no-properties (region-beginning) (region-end)) + (buffer-substring-no-properties (point-min) (point-max)) (not silent-p)))) (defvar sclang-eval-results nil @@ -585,21 +625,21 @@ if PRINT-P is non-nil. Return STRING if successful, otherwise nil." (lambda (arg) (push arg sclang-eval-results))) (defun sclang-eval-sync (string) - "Eval STRING in sclang and return result as a lisp value." + "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 (> (cl-decf tick) 0) - (not (setq elt (assoc time sclang-eval-results)))) - (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"))) + (let ((time (current-time)) (tick 10000) elt) + (sclang-perform-command 'evalSCLang string time) + (while (and (> (cl-decf tick) 0) + (not (setq elt (assoc time sclang-eval-results)))) + (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")))) ;; ===================================================================== @@ -613,7 +653,7 @@ if PRINT-P is non-nil. Return STRING if successful, otherwise nil." ;; (defun sclang-grep-help-files () ;; (interactive) ;; (let ((sclang-grep-prompt "Search help files: ") -;; (sclang-grep-files (mapcar 'cdr sclang-help-topic-alist))) +;; (sclang-grep-files (mapcar 'cdr sclang-help-topic-alist))) ;; (call-interactively 'sclang-grep-files))) ;; (defvar sclang-grep-history nil) @@ -630,16 +670,16 @@ if PRINT-P is non-nil. Return STRING if successful, otherwise nil." ;; (defun sclang-grep-files (regexp) ;; (interactive ;; (let ((grep-default (or (when current-prefix-arg (sclang-symbol-at-point)) -;; (car sclang-grep-history)))) +;; (car sclang-grep-history)))) ;; (list (read-from-minibuffer sclang-grep-prompt -;; grep-default -;; nil nil 'sclang-grep-history)))) +;; 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 " ")))) +;; " -n" +;; (and sclang-grep-case-fold-search " -i") +;; " -e" regexp +;; " " (mapconcat 'shell-quote-argument sclang-grep-files " ")))) ;; ===================================================================== ;; workspace @@ -653,47 +693,52 @@ if PRINT-P is non-nil. Return STRING if successful, otherwise nil." (defconst sclang-workspace-buffer (sclang-make-buffer-name "Workspace")) (defun sclang-fill-workspace-mode-map (map) + "Fill the workspace keymap MAP." (define-key map "\C-c}" 'bury-buffer)) (defun sclang-switch-to-workspace () + "Switch to SuperCollider workspace buffer." (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)))) + (sclang-mode) + ;; why a buffer local keymap? + (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)))) + (lambda () (and sclang-show-workspace-on-startup + (sclang-switch-to-workspace)))) ;; ===================================================================== ;; language control ;; ===================================================================== (defun sclang-main-run () + "Run sclang process." (interactive) (sclang-eval-string "thisProcess.run")) (defun sclang-main-stop () + "Stop sclang process." (interactive) (sclang-eval-string "thisProcess.stop")) @@ -718,27 +763,28 @@ if PRINT-P is non-nil. Return STRING if successful, otherwise nil." ;; add command line switches (add-to-list 'command-switch-alist - (cons "-sclang" - (lambda (switch) - (sclang-start)))) + (cons "-sclang" + (lambda (switch) + (sclang-start)))) (add-to-list 'command-switch-alist - (cons "-sclang-debug" - (lambda (switch) - (sclang-toggle-debug-command-handler 1)))) + (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)))))))) + (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 +;;; sclang-interp.el ends here diff --git a/el/sclang-keys.el b/el/sclang-keys.el index 1acee63..11b0c52 100644 --- a/el/sclang-keys.el +++ b/el/sclang-keys.el @@ -1,5 +1,9 @@ -;; copyright 2003 stefan kersten +;;; sclang-keys.el --- IDE for working with SuperCollider -*- coding: utf-8; ;; +;; Copyright 2003 stefan kersten + +;;; License: + ;; 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 @@ -15,6 +19,15 @@ ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; USA + +;;; Commentary: +;; Read & send keys between Emacs and SuperCollider + +;;; Code: +(eval-and-compile (require 'sclang-util) + (require 'sclang-interp)) + + ;; (defvar sclang-key-table (make-char-table 'foo)) ;; (defun sclang-define-key (char beg end) @@ -25,10 +38,9 @@ ;; (defun sclang-execute-key (char) ;; (sclang-eval-string (sclang-format "Emacs.executeKey(%o)" char))) -(eval-and-compile (require 'sclang-util) - (require 'sclang-interp)) (defun sclang-read-keys () + "Read and send keys between Emacs and SuperCollider." (interactive) (let (char) (clear-this-command-keys) @@ -36,8 +48,10 @@ (setq char (read-event)) (clear-this-command-keys) (when (characterp char) - (message "%s (%d)" (char-to-string char) char) - (sclang-eval-string (format "Emacs.keys.at(%d).value(%d)" char char)))))) + (message "%s (%d)" (char-to-string char) char) + (sclang-eval-string (format "Emacs.keys.at(%d).value(%d)" char char)))))) -;; EOF +(provide 'sclang-keys) + +;;; sclang-keys.el ends here diff --git a/el/sclang-language.el b/el/sclang-language.el index 4239355..2f53256 100644 --- a/el/sclang-language.el +++ b/el/sclang-language.el @@ -1,5 +1,9 @@ -;; copyright 2003-2005 stefan kersten +;;; sclang-language.el --- IDE for working with SuperCollider -*- coding: utf-8; ;; +;; Copyright 2003 stefan kersten + +;;; License: + ;; 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 @@ -15,14 +19,20 @@ ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; USA + +;;; Commentary: +;; Utilities for SuperCollider syntax + (require 'cl-lib) (require 'sclang-browser) (require 'sclang-interp) (require 'sclang-util) -;; ===================================================================== +;; =================================================================== ;; regexp utilities -;; ===================================================================== +;; =================================================================== + +;;; Code: (defun sclang-regexp-group (regexp &optional addressable) "Enclose REGEXP in grouping parentheses. @@ -37,9 +47,9 @@ separately after matching." The expressions are joined as alternatives with the \\| operator." (mapconcat 'sclang-regexp-group regexps "\\|")) -;; ===================================================================== +;; =================================================================== ;; some useful regular expressions -;; ===================================================================== +;; =================================================================== (defconst sclang-symbol-regexp "\\(?:\\sw\\|\\s_\\)*" @@ -60,7 +70,7 @@ The expressions are joined as alternatives with the \\| operator." (defconst sclang-method-name-special-regexp (concat "[" (regexp-quote sclang-method-name-special-chars) "]+") - "Regular expression matching method names composed of special characters.") + "Regular expression matching method names composed of special characters.") (defconst sclang-method-name-regexp (sclang-regexp-concat @@ -84,10 +94,10 @@ The expressions are joined as alternatives with the \\| operator." (defconst sclang-class-definition-regexp (concat "^\\s *\\(" - sclang-class-name-regexp - "\\)\\(?:\\s *:\\s *\\(" - sclang-class-name-regexp - "\\)\\)?[[:space:]]*{") + sclang-class-name-regexp + "\\)\\(?:\\s *:\\s *\\(" + sclang-class-name-regexp + "\\)\\)?[[:space:]]*{") "Regular expression matching class definitions.") (defconst sclang-method-definition-regexp @@ -102,10 +112,10 @@ 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. + (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 @@ -113,34 +123,34 @@ 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)) + "-" + (sclang-regexp-group sclang-method-name-regexp t)) "Regular expression matching definition specifications. A specification is of the form -.") -;; ===================================================================== +;; =================================================================== ;; 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:]]*{")) + "\\(?:\\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 *{")) + "\\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." @@ -148,54 +158,63 @@ A specification is of the form -.") (string-match regexp string))) (defun sclang-symbol-match (symbol-regexp string) + "Match SYMBOL-REGEXP in STRING." (sclang-string-match (concat "^" symbol-regexp "$") string)) -;; ===================================================================== +;; =================================================================== ;; symbol name predicates -;; ===================================================================== +;; =================================================================== (defun sclang-class-name-p (string) + "Is STRING an sclang class name?" (sclang-symbol-match sclang-class-name-regexp string)) (defun sclang-meta-class-name-p (string) + "Is STRING an sclang meta class name?" (and (sclang-class-name-p string) (sclang-string-match "^Meta_" string))) (defun sclang-method-name-p (string) + "Is STRING an sclang method name?" (sclang-symbol-match sclang-method-name-regexp string)) (defun sclang-symbol-name-p (string) + "Is STRING an sclang symbol name?" (sclang-symbol-match sclang-symbol-name-regexp string)) (defun sclang-method-name-setter-p (method-name) + "Is METHOD-NAME an sclang method name setter?" (string-match "_$" method-name)) (defun sclang-method-name-getter-p (method-name) + "Is METHOD-NAME an sclang method name getter?" (not (sclang-method-name-setter-p method-name))) -;; ===================================================================== +;; =================================================================== ;; symbol name manipulation -;; ===================================================================== +;; =================================================================== (defun sclang-method-name-setter (method-name) + "Return a method name setter for METHOD-NAME." (if (sclang-method-name-setter-p method-name) method-name (concat method-name "_"))) (defun sclang-method-name-getter (method-name) + "Return a method name getter for 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 +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 @@ -225,90 +244,93 @@ low-resource systems." (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)))))) + (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))) + (lambda () + (setq sclang-symbol-table nil) + (sclang-update-font-lock))) (defun sclang-get-symbol-completion-table () + "Get symbol completion table." (mapcar (lambda (s) (cons s nil)) sclang-symbol-table)) (defun sclang-make-symbol-completion-predicate (predicate) + "Make symbol completion PREDICATE." (and predicate (lambda (assoc) (funcall predicate (car assoc))))) (defun sclang-get-symbol (string) + "Get symbol named 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) +"Read symbol PROMPT (options DEFAULT PREDICATE REQUIRE-MATCH and INHERIT-INPUT-METHOD)." (if sclang-use-symbol-table (cl-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))) + (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))) + '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." + "Return non-nil if point is inside a comment." (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)))))))) + (beginning-of-defun) + (not (null (nth 4 (parse-partial-sexp (point) beg)))))))) (defun sclang-beginning-of-defun (&optional arg) + "Move to beginning of function (optionally ARG)." (interactive "p") (let ((case-fold-search nil) - (arg (or arg (prefix-numeric-value current-prefix-arg))) - (orig (point)) - (success t)) + (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)) + nil 'move)) (when (and success (not (sclang-point-in-comment-p))) - (goto-char (match-beginning 0)) - (setq arg (1- arg)))) + (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)))) + (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))))) + ((looking-at sclang-class-definition-regexp) (goto-char (1- (match-end 0))))) t))) (defun sclang-point-in-defun-p () @@ -316,44 +338,45 @@ Use font-lock information if font-lock-mode is enabled." Return value is nil or (beg end) of defun." (save-excursion (let ((orig (point)) - beg end) + beg end) (and (progn (end-of-line) (beginning-of-defun-raw 1) t) - (setq beg (point)) - (condition-case nil (forward-list 1) (error nil)) - (setq end (point)) - (list beg end))))) + (setq beg (point)) + (condition-case nil (forward-list 1) (error nil)) + (setq end (point)) + (list beg end))))) (defun sclang-end-of-defun (&optional arg) + "Move to end of function (optionally ARG)." (interactive "p") (let ((case-fold-search nil) - (arg (or arg (prefix-numeric-value current-prefix-arg))) - (success t) - n cur) + (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))) + (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))) + (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. @@ -365,20 +388,20 @@ symbol matched, candidates are `sclang-symbol-name-regexp' and (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)))))) + 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." @@ -392,11 +415,11 @@ A defun may either be a class definition or a code block, see (save-excursion (with-syntax-table sclang-mode-syntax-table (cl-multiple-value-bind (beg end) (sclang-point-in-defun-p) - (and beg end (buffer-substring-no-properties beg end)))))) + (and beg end (buffer-substring-no-properties beg end)))))) -;; ===================================================================== +;; =================================================================== ;; symbol completion -;; ===================================================================== +;; =================================================================== (defun sclang-complete-symbol (&optional predicate) "Perform completion on symbol preceding point. @@ -410,59 +433,59 @@ 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)))))) + (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"))))) + ((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"))))) (defun sclang-completion-at-point () "Function used for `completion-at-point-functions' in `sclang-mode'." (let* ((end (point)) - (beg (save-excursion - (backward-sexp 1) - (skip-syntax-forward "'") - (point))) - (pattern (buffer-substring-no-properties beg end)) - (case-fold-search nil) - (predicate (if (sclang-class-name-p pattern) + (beg (save-excursion + (backward-sexp 1) + (skip-syntax-forward "'") + (point))) + (pattern (buffer-substring-no-properties beg end)) + (case-fold-search nil) + (predicate (if (sclang-class-name-p pattern) #'sclang-class-name-p #'sclang-method-name-p))) (list beg @@ -471,9 +494,9 @@ are considered." :exclusive 'no :company-docsig #'identity))) -;; ===================================================================== +;; =================================================================== ;; introspection -;; ===================================================================== +;; =================================================================== (defcustom sclang-definition-marker-ring-length 32 "*Length of marker ring `sclang-definition-marker-ring'." @@ -487,18 +510,19 @@ are considered." ;; really do that? (add-hook 'sclang-library-startup-hook - (lambda () - (setq sclang-definition-marker-ring - (make-ring sclang-definition-marker-ring-length)))) + (lambda () + (setq sclang-definition-marker-ring + (make-ring sclang-definition-marker-ring-length)))) (defun sclang-open-definition (name file pos &optional pos-func) + "Open definition NAME in FILE at POS (optionally 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)))))) + (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 () @@ -507,35 +531,36 @@ are considered." (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"))) + (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) + "Browse definitions. NAME DEFINITIONS BUFFER-NAME HEADER (optionally 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")))))) + (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)))) @@ -545,61 +570,61 @@ are considered." (interactive (list (if current-prefix-arg - (read-string "Find definition: ") + (read-string "Find definition: ") (sclang-read-symbol "Find definitions of: " - (sclang-symbol-at-point) nil t)))) + (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))) + (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))) + (data (cdr assoc))) (if data - (sclang-open-definition nil (car data) (cadr 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))) + (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-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))) + (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-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) @@ -607,52 +632,52 @@ are considered." (interactive (list (sclang-read-symbol "Find references to: " - (sclang-symbol-at-point) nil t))) + (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)) + (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))) + (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-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." + "Show method args." (interactive) (let ((regexp (concat - sclang-class-name-regexp - "[ \t\n]*\\(?:\\.[ \t\n]*\\(" - sclang-method-name-regexp - "\\)\\)?[ \t\n]*(")) - (case-fold-search nil) - (beg (point))) + 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))))))) + (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 @@ -664,11 +689,11 @@ are considered." (interactive (list (let* ((symbol (sclang-symbol-at-point)) - (class (and (sclang-get-symbol symbol) - (sclang-class-name-p symbol) - symbol))) + (class (and (sclang-get-symbol symbol) + (sclang-class-name-p symbol) + symbol))) (sclang-read-symbol "Dump interface of: " - class 'sclang-class-name-p t)))) + class 'sclang-class-name-p t)))) (sclang-eval-string (format "%s.dumpFullInterface" class))) (defun sclang-dump-interface (class) @@ -676,16 +701,16 @@ are considered." (interactive (list (let* ((symbol (sclang-symbol-at-point)) - (class (and (sclang-get-symbol symbol) - (sclang-class-name-p symbol) - symbol))) + (class (and (sclang-get-symbol symbol) + (sclang-class-name-p symbol) + symbol))) (sclang-read-symbol "Dump interface of: " - class 'sclang-class-name-p t)))) + class 'sclang-class-name-p t)))) (sclang-eval-string (format "%s.dumpInterface" class))) -;; ===================================================================== +;; =================================================================== ;; cscope interface -;; ===================================================================== +;; =================================================================== (defcustom sclang-source-directory nil "Toplevel SuperCollider source directory. @@ -698,70 +723,73 @@ database." :options '(must-match)) (defun sclang-find-primitive (name) - "Find primitive name a cscope database. + "Find primitive NAME in 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)))) + 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)))) + ;; only fboundp when xcscope is loaded + (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) + "Convert sclang LIST to string." (mapconcat 'sclang-object-to-string list ", ")) -(defconst false 'false) +(defconst sclang-false 'false) (defun sclang-object-to-string (obj) + "Convert sclang object OBJ to string." (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)))) + "nil") + ((eq sclang-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" + "Format STRING using ARGS. +%s - print string +%o - print object +%l - print argument list" (let ((case-fold-search nil) - (i 0)) + (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-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) @@ -770,56 +798,57 @@ 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." (cl-labels ((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 (cl-subseq items 0 i))) - (when (catch 'equal - (let ((a items)) - (cl-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)) - (cl-decf i)))) - (cl-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 (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 (cl-subseq items 0 i))) + (when (catch 'equal + (let ((a items)) + (cl-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)) + (cl-decf i)))) + (cl-decf rep))) + (accept-process-output nil 0 100) + ;; invent better progress info + (message "Processed...%S" ret) + (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)"))))) + (elem-to-string (car compressed)) + (concat "Pseq([ " + (mapconcat #'elem-to-string compressed ", ") + " ], 1)"))))) -;; ===================================================================== +;; =================================================================== ;; module setup -;; ===================================================================== +;; =================================================================== (provide 'sclang-language) -;; EOF +;;; sclang-language.el ends here diff --git a/el/sclang-menu.el b/el/sclang-menu.el index 8ce7d4e..8ff39d1 100644 --- a/el/sclang-menu.el +++ b/el/sclang-menu.el @@ -1,5 +1,9 @@ -;; copyright 2003 stefan kersten +;;; sclang-menu.el --- IDE for working with SuperCollider -*- coding: utf-8; ;; +;; Copyright 2003 stefan kersten + +;;; License: + ;; 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 @@ -15,9 +19,16 @@ ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; USA +;;; Commentary: +;; Menus + +;;; Code: + ;; (sclang-set-command-handler ;; '_updateMenu ;; (lambda (arg) ;; (message "menu: %s" arg))) -(provide 'sclang-menu) \ No newline at end of file +(provide 'sclang-menu) + +;;; sclang-menu.el ends here diff --git a/el/sclang-minor-mode.el b/el/sclang-minor-mode.el index c5e2a47..6623933 100644 --- a/el/sclang-minor-mode.el +++ b/el/sclang-minor-mode.el @@ -1,7 +1,9 @@ -;;; sclang-minor-mode for use in help files -;;; SuperCollider -;;; (c) 2007, Marije Baalman - nescivi -;;; +;;; sclang-minor-mode.el --- IDE for working with SuperCollider -*- coding: utf-8; +;; +;; Copyright (c) 2007, Marije Baalman - nescivi + +;;; License: + ;;; 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 @@ -16,6 +18,12 @@ ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Commentary: +;; +;; sclang-minor-mode for use in help files + +;;; Code: (require 'sclang-util) (require 'sclang-mode) @@ -25,53 +33,55 @@ 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-d." - ;; 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-d" . 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) - ("\C-c\C-k" . sclang-edit-dev-source) -)) +When sclang-minor-mode is enabled, you can use the key sequences +\\\\[sclang-eval-region-or-line] or \\\\[sclang-eval-region] to eval sclang code." + ;; The initial value. + :init-value nil + ;; The indicator for the mode line. + :lighter " sclang" + ;; The minor mode bindings. + :keymap '(("\C-c\C-c" . sclang-eval-region-or-line) + ("\C-c\C-d" . 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) + ("\C-c\C-k" . sclang-edit-dev-source))) (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-d." - ;; 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-d" . 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) - ("\C-c\C-k" . sclang-edit-dev-source) -)) +When sclang-help-minor-mode is enabled, you can use the key sequences +\\\\[sclang-eval-region-or-line] or \\\\[sclang-eval-region] to eval sclang code." + ;; The initial value. + :init-value nil + ;; The indicator for the mode line. + :lighter " sclang-help" + ;; The minor mode bindings. + :keymap '(("\C-c\C-c" . sclang-eval-region-or-line) + ("\C-c\C-d" . 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) + ("\C-c\C-k" . sclang-edit-dev-source))) (provide 'sclang-help-minor-mode) +;; mode hooks +(defun sclang-minor-hooks () + "Sclang minor mode hooks." + (sclang-init-document) + (sclang-make-document)) + (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) - ) +;;; sclang-minor-mode.el ends here diff --git a/el/sclang-mode.el b/el/sclang-mode.el index 4263a54..9a8ddf0 100644 --- a/el/sclang-mode.el +++ b/el/sclang-mode.el @@ -1,5 +1,9 @@ -;; copyright 2003-2005 stefan kersten +;;; sclang-mode.el --- IDE for working with SuperCollider -*- coding: utf-8; ;; +;; Copyright 2003 stefan kersten + +;;; License: + ;; 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 @@ -15,12 +19,14 @@ ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; USA -;;; Code: +;;; Commentary: +;; sclang mode + +;;; Code: (require 'cl-lib) -;; Make byte-compiler happy by declaring external functions and -;; variables. +;; Keep byte-compiler happy by declaring external functions and variables. (declare-function company-mode "ext:company") (defvar company-backends) @@ -31,7 +37,7 @@ (require 'sclang-dev) (defun sclang-fill-syntax-table (table) - ;; string + "Fill the sclang syntax TABLE." (modify-syntax-entry ?\" "\"" table) (modify-syntax-entry ?\' "\"" table) ; no string syntax class for single quotes ;; expression prefix @@ -75,86 +81,88 @@ table) (defun sclang-mode-make-menu (title) + "Make mode menu with 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)] - ["Recompile Class Library" sclang-recompile :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] - ["Evaluate Document" sclang-eval-document] - "-" - ["Find Definitions ..." sclang-find-definitions] - ["Find References ..." sclang-find-references] - ["Pop Mark" sclang-pop-definition-mark] - ["Show Method Arguments" sclang-show-method-args] - ["Complete keyword" sclang-complete-symbol] - ["Dump Interface" sclang-dump-interface] - ["Dump Full Interface" sclang-dump-full-interface] - "-" - ["Index Help Topics" sclang-index-help-topics] - ["Find Help ..." sclang-find-help] - ["Switch to Help Browser" sclang-goto-help-browser] - ["Open Help GUI" sclang-open-help-gui] - "-" - ["Run Main" sclang-main-run] - ["Stop Main" sclang-main-stop] - ["Show Server Panels" sclang-show-server-panel] - ))) + '(["Start Interpreter" sclang-start :included (not (sclang-library-initialized-p))] + ["Restart Interpreter" sclang-start :included (sclang-library-initialized-p)] + ["Recompile Class Library" sclang-recompile :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] + ["Evaluate Document" sclang-eval-document] + "-" + ["Find Definitions ..." sclang-find-definitions] + ["Find References ..." sclang-find-references] + ["Pop Mark" sclang-pop-definition-mark] + ["Show Method Arguments" sclang-show-method-args] + ["Complete keyword" sclang-complete-symbol] + ["Dump Interface" sclang-dump-interface] + ["Dump Full Interface" sclang-dump-full-interface] + "-" + ["Index Help Topics" sclang-index-help-topics] + ["Find Help ..." sclang-find-help] + ["Switch to Help Browser" sclang-goto-help-browser] + ["Open Help GUI" sclang-open-help-gui] + "-" + ["Run Main" sclang-main-run] + ["Stop Main" sclang-main-stop] + ["Show Server Panels" sclang-show-server-panel]))) (defun sclang-fill-mode-map (map) + "Fill keymap MAP for sclang mode." + ;; NOTE: keybindings should follow the conventions in https://www.gnu.org/software/emacs/manual/html_node/elisp/Key-Binding-Conventions.html + ;; process control - (define-key map "\C-c\C-l" 'sclang-recompile) - (define-key map "\C-c\C-o" 'sclang-start) + (define-key map "\C-c\C-l" 'sclang-recompile) + (define-key map "\C-c\C-o" 'sclang-start) ;; post buffer control - (define-key map "\C-c<" 'sclang-clear-post-buffer) - (define-key map "\C-c>" 'sclang-show-post-buffer) + (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) + (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-d" 'sclang-eval-region) - (define-key map "\C-\M-x" 'sclang-eval-defun) - (define-key map "\C-c\C-e" 'sclang-eval-expression) - (define-key map "\C-c\C-f" 'sclang-eval-document) + (define-key map "\C-c\C-c" 'sclang-eval-region-or-line) + (define-key map "\C-c\C-d" 'sclang-eval-region) + (define-key map "\C-\M-x" 'sclang-eval-defun) + (define-key map "\C-c\C-e" 'sclang-eval-expression) + (define-key map "\C-c\C-f" 'sclang-eval-document) ;; language information - (define-key map "\C-c\C-n" '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-full-interface) - (define-key map "\C-c[" 'sclang-dump-interface) + (define-key map "\C-c\C-n" '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-full-interface) + (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) - (define-key map "\C-c\C-y" 'sclang-open-help-gui) - (define-key map "\C-ch" 'sclang-find-help-in-gui) + (define-key map "\C-c\C-?f" 'sclang-find-help) + (define-key map "\C-c\C-?g" 'sclang-goto-help-browser) + (define-key map "" 'sclang-open-help-gui) + (define-key map "" 'sclang-find-help-in-gui) ;; 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) - (define-key map "\C-c\C-k" 'sclang-edit-dev-source) + (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) + (define-key map "\C-c\C-k" 'sclang-edit-dev-source) ;; 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) + (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)))) + (define-key map [menu-bar sclang] (cons title (sclang-mode-make-menu title)))) ;; return map map) @@ -163,8 +171,7 @@ ;; ===================================================================== (defconst sclang-font-lock-keyword-list - '( - "arg" + '("arg" "classvar" "const" "super" @@ -174,22 +181,18 @@ "thisMethod" "thisProcess" "thisThread" - "var" - ) + "var") "*List of keywords to highlight in SCLang mode.") (defconst sclang-font-lock-builtin-list - '( - "false" + '("false" "inf" "nil" - "true" - ) + "true") "*List of builtins to highlight in SCLang mode.") (defconst sclang-font-lock-method-list - '( - "ar" + '("ar" "for" "forBy" "if" @@ -197,19 +200,16 @@ "kr" "tr" "loop" - "while" - ) + "while") "*List of methods to highlight in SCLang mode.") (defconst sclang-font-lock-error-list - '( - "die" + '("die" "error" "exit" "halt" "verboseHalt" - "warn" - ) + "warn") "*List of methods signalling errors or warnings.") (defvar sclang-font-lock-class-keywords nil) @@ -227,27 +227,27 @@ "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 - )) + 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) + "Return font lock face for 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))) + ;; 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) + "Font lock class keywords up to LIMIT." (let ((regexp (concat "\\<" sclang-class-name-regexp "\\>")) (case-fold-search nil) (continue t) @@ -264,23 +264,23 @@ res)) (defun sclang-set-font-lock-keywords () + "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) + 'font-lock-keyword-face) ;; builtins (cons (regexp-opt sclang-font-lock-builtin-list 'words) - 'font-lock-builtin-face) + '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 - ) + 'font-lock-constant-face)) ; symbols ;; level 2 sclang-font-lock-keywords-2 (append @@ -288,42 +288,38 @@ (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) + '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)) + (list 1 'font-lock-function-name-face)) ;; methods (cons (regexp-opt sclang-font-lock-method-list 'words) - 'font-lock-function-name-face) + 'font-lock-function-name-face) ;; errors (cons (regexp-opt sclang-font-lock-error-list 'words) - 'font-lock-warning-face) - )) + '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) - )) + (cons 'sclang-font-lock-class-keyword-matcher 'font-lock-type-face))) ;; default level - sclang-font-lock-keywords sclang-font-lock-keywords-1 - )) + sclang-font-lock-keywords sclang-font-lock-keywords-1)) (defun sclang-update-font-lock () - "Update font-lock information in all sclang-mode buffers." + "Update font-lock information in all `sclang-mode' buffers." ;; 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))))) + ;; (eq t (car font-lock-keywords)) + ;; (setq font-lock-keywords (cdr font-lock-keywords))))) (if (eq major-mode 'sclang-mode) - (font-lock-fontify-buffer))) + (font-lock-ensure (point-min) (point-max)))) ;; ===================================================================== ;; indentation @@ -337,95 +333,98 @@ (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)))) + (let ((indent (sclang-calculate-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))) + (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)))) + (goto-char (- (point-max) pos)))) shift-amt)) -(defun calculate-sclang-indent (&optional parse-start) - "Return appropriate indentation for current line as sclang code. +(defun sclang-calculate-indent (&optional parse-start) + "Return indentation for current line (optionally from PARSE-START). Returns the column to indent to." (save-excursion (beginning-of-line) (let ((indent-point (point)) - (case-fold-search nil) - state) + (case-fold-search nil) + state) (if parse-start - (goto-char parse-start) - (beginning-of-defun)) + (goto-char parse-start) + (beginning-of-defun)) (while (< (point) indent-point) - (setq state (parse-partial-sexp (point) indent-point 0))) + (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)))))))) + (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) + "Electrify brace ARG." (interactive "*P") (self-insert-command (prefix-numeric-value arg)) (and (save-excursion - (beginning-of-line) - (looking-at "\\s *\\s)")) + (beginning-of-line) + (looking-at "\\s *\\s)")) (indent-according-to-mode))) (defun sclang-electric-slash (arg) + "Electrify slash ARG." (interactive "*P") (let* ((char (char-before)) - (indent-p (or (eq char ?/) - (eq char ?*)))) + (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) + "Electrify star ARG." (interactive "*P") (let ((indent-p (eq (char-before) ?/))) (self-insert-command (prefix-numeric-value arg)) @@ -454,24 +453,30 @@ Returns the column to indent to." (sclang-document-edited-p . (prSetEdited (buffer-modified-p))))) (defmacro sclang-next-document-id () + "Return next document id." `(cl-incf sclang-document-counter)) (defun sclang-document-id (buffer) + "Document id of BUFFER." (cdr (assq 'sclang-document-id (buffer-local-variables buffer)))) (defun sclang-document-p (buffer) + "Is BUFFER an sclang document?" (integerp (sclang-document-id buffer))) (defmacro with-sclang-document (buffer &rest body) + "With sclang BUFFER BODY." `(when (sclang-document-p buffer) (with-current-buffer buffer ,@body))) (defun sclang-get-document (id) + "Return buffer with document ID or nil." (cl-find-if (lambda (buffer) (eq id (sclang-document-id buffer))) - sclang-document-list)) + sclang-document-list)) (defun sclang-init-document () + "Initialize 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) @@ -479,29 +484,34 @@ Returns the column to indent to." (cl-pushnew (current-buffer) sclang-document-list)) (defun sclang-document-update-property-1 (assoc &optional force) + "Update document property ASSOC (optionally FORCE)." (when (consp assoc) (let* ((key (car assoc)) - (prop (cdr assoc)) - (prev-value (eval key)) - (cur-value (eval (cadr prop)))) + (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))))) + (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) + "Update document property KEY (optionally FORCE)." (sclang-document-update-property-1 (assq key sclang-document-property-map) force)) (defun sclang-document-update-properties (&optional force) + "Update all document properties (optionally FORCE)." (dolist (assoc sclang-document-property-map) (sclang-document-update-property-1 assoc force))) (defun sclang-make-document () + "Make a new document." (sclang-perform-command-no-result 'documentNew sclang-document-id) (sclang-document-update-properties t)) (defun sclang-close-document (buffer) + "Close document in BUFFER." (with-sclang-document buffer (setq sclang-document-list (delq buffer sclang-document-list)) @@ -509,27 +519,32 @@ Returns the column to indent to." 'documentClosed sclang-document-id))) (defun sclang-set-current-document (buffer &optional force) + "Set current document to BUFFER (optionally 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 () + "Document library startup hook." (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 () + "Document kill buffer hook." (sclang-close-document (current-buffer))) (defun sclang-document-post-command-hook-function () + "Document post command hook." (when (and (sclang-library-initialized-p) - (sclang-document-p (current-buffer))) + (sclang-document-p (current-buffer))) (sclang-document-update-properties)) (sclang-set-current-document (current-buffer))) (defun sclang-document-change-major-mode-hook-function () + "Document change major mode hook." (sclang-close-document (current-buffer))) ;; ===================================================================== @@ -542,13 +557,13 @@ Returns the column to indent to." (cl-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))) + (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)))))) + (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 @@ -556,9 +571,9 @@ Returns the column to indent to." (cl-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)) + (insert str) + (set-buffer-modified-p nil) + (sclang-mode)) (sclang-document-id buffer))))) (sclang-set-command-handler @@ -574,10 +589,10 @@ Returns the column to indent to." (cl-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)))))) + (when doc + (with-current-buffer doc + (rename-buffer name t) + (sclang-document-update-property 'sclang-document-name)))))) nil)) (sclang-set-command-handler @@ -586,9 +601,9 @@ Returns the column to indent to." (cl-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))))) + (with-current-buffer doc + (setq buffer-read-only (not flag)) + (sclang-document-update-property 'sclang-editable-p))))) nil)) (sclang-set-command-handler @@ -600,14 +615,13 @@ Returns the column to indent to." (sclang-set-command-handler '_documentPutString -(lambda (arg) + (lambda (arg) (cl-multiple-value-bind (id str) arg (let ((doc (and (integerp id) (sclang-get-document id)))) (when doc - (with-current-buffer doc - (insert str) - ) - nil))))) + (with-current-buffer doc + (insert str)) + nil))))) (sclang-set-command-handler '_documentPopTo @@ -621,6 +635,7 @@ Returns the column to indent to." ;; ===================================================================== (defun sclang-mode-set-local-variables () + "Local variables." (set (make-local-variable 'require-final-newline) nil) ;; indentation (set (make-local-variable 'indent-line-function) @@ -700,4 +715,5 @@ Returns the column to indent to." (add-hook 'change-major-mode-hook 'sclang-document-change-major-mode-hook-function) (provide 'sclang-mode) -;;; sclang-mode ends here + +;;; sclang-mode.el ends here diff --git a/el/sclang-server.el b/el/sclang-server.el index 375c492..ffc567e 100644 --- a/el/sclang-server.el +++ b/el/sclang-server.el @@ -1,5 +1,9 @@ -;; copyright 2003-2005 stefan kersten +;;; sclang-server.el --- IDE for working with SuperCollider -*- coding: utf-8; ;; +;; Copyright 2003 stefan kersten + +;;; License: + ;; 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 @@ -15,18 +19,24 @@ ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; USA + +;;; Commentary: +;; Interface to the sclang server + (require 'cl-lib) (require 'sclang-util) (require 'sclang-interp) (require 'sclang-language) (require 'sclang-mode) +;;; Code: + (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)) + (const "\\SCUM.asClass.do { \\SCUM.asClass.desktop.showServerPanel }") + string)) (defvar sclang-server-alist nil "Alist of currently defined synthesis servers.") @@ -47,20 +57,22 @@ "Face for highlighting a server's running state in the mode-line.") (defun sclang-get-server (&optional name) + "Get sclang server (optionally by NAME)." (unless name (setq name sclang-current-server)) (cdr (assq name sclang-server-alist))) (defun sclang-set-server (&optional name) + "Set current sclang server (optionally by NAME)." (unless name (setq name sclang-current-server)) (setq sclang-current-server - (car (or (assq name sclang-server-alist) - (car sclang-server-alist))))) + (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-lessp (car a) (car b))))) + (sort (cdr arg) (lambda (a b) (string-lessp (car a) (car b))))) (setq sclang-default-server (car arg)) (unless sclang-current-server-initialized ;; only set the current server automatically once after startup @@ -73,24 +85,27 @@ (interactive) (sclang-set-server) (let ((list (or (cdr (cl-member-if (lambda (assoc) - (eq (car assoc) sclang-current-server)) - sclang-server-alist)) - sclang-server-alist))) + (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) +(defun sclang-mouse-next-server (_event) "Select next server for display." (interactive "e") (sclang-next-server)) (defun sclang-server-running-p (&optional name) + "Is the sclang server NAME running?" (plist-get (sclang-get-server name) 'running)) (defun sclang-server-booting-p (&optional name) + "Is the sclang server NAME running?" (plist-get (sclang-get-server name) 'booting)) (defun sclang-create-server-menu (title) + "Create the server menu with TITLE." (easy-menu-create-menu title '( @@ -101,6 +116,7 @@ ["Make Default" sclang-server-make-default]))) (defun sclang-server-fill-mouse-map (map prefix) + "Fill mouse MAP using 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) @@ -109,7 +125,7 @@ "Keymap used for controlling servers in the mode line.") (defun sclang-server-fill-key-map (map) - "Fill server prefix map." + "Fill server keymap MAP." (define-key map [?b] 'sclang-server-boot) (define-key map [?d] 'sclang-server-display-default) (define-key map [?f] 'sclang-server-free-all) @@ -119,11 +135,11 @@ (define-key map [?p] 'sclang-show-server-panel) (define-key map [?q] 'sclang-server-quit) (cl-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 [?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) @@ -133,27 +149,28 @@ (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)) - '("---" "---" "----" "----" "----" "----")))) + (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 () + "Update server info in the modeline." (interactive) (sclang-set-server) (setq sclang-server-info-string (sclang-get-server-info-string)) @@ -164,9 +181,11 @@ ;; ===================================================================== (defun sclang-perform-server-command (command &rest args) + "Perform server COMMAND with ARGS." (sclang-eval-string - (sclang-format "Server.named.at(%o.asSymbol).performList(\\tryPerform, %o.asSymbol.asArray ++ %o)" - sclang-current-server command args) + (sclang-format + "Server.named.at(%o.asSymbol).performList(\\tryPerform, %o.asSymbol.asArray ++ %o)" + sclang-current-server command args) nil)) (defun sclang-server-boot () @@ -213,15 +232,15 @@ if (server.notNil) { nil)) (defun sclang-server-dump-osc (&optional code) - "Set the current server's dump OSC mode." + "Set the current server's dump OSC mode (with optional CODE)." (interactive "P") (sclang-perform-server-command "dumpOSC" - (cond ((consp code) 0) - ((null code) 1) - (t code)))) + (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." + "Prepare current server for recording a sound file (with optional PATH)." (interactive (list (and current-prefix-arg (read-file-name "Record to file: ")))) @@ -242,10 +261,10 @@ if (server.notNil) { (interactive) (sclang-perform-server-command "stopRecording")) -(defun sclang-set-server-latency (lat) - "Set the current server's `latency' instance variable." +(defun sclang-set-server-latency (latency) + "Set the current server's LATENCY instance variable." (interactive "nSet latency: ") - (sclang-perform-server-command "latency_" lat)) + (sclang-perform-server-command "latency_" latency)) (defun sclang-show-server-latency () "Show the current server's latency." @@ -263,17 +282,18 @@ if (server.notNil) { ;; ===================================================================== (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))) + (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))) + (lambda () + (setq sclang-current-server-initialized nil))) + (provide 'sclang-server) -;; EOF +;;; sclang-server.el ends here diff --git a/el/sclang-util.el b/el/sclang-util.el index 8a0ea6f..615eb8a 100644 --- a/el/sclang-util.el +++ b/el/sclang-util.el @@ -1,7 +1,9 @@ -;;; package: sclang-util --- Utility helpers for sclang -;; -;; copyright 2003-2005 stefan kersten +;;; sclang-util.el --- Utility helpers for sclang -*- coding: utf-8; ;; +;; Copyright 2003-2005 stefan kersten + +;;; License: + ;; 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 @@ -17,13 +19,20 @@ ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; USA +;;; Commentary: +;; Utility helpers for sclang + +;;; Code: (defun sclang-message (string &rest args) + "Create a message from STRING with optional 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-buffer-name (name &optional private-p) + "Set the buffer name to NAME (optimally PRIVATE-P)." + (concat (and private-p " ") "*SCLang:" name "*")) (defun sclang-make-prompt-string (prompt default) + "Return a prompt string using PROMPT and DEFAULT." (if (and default (string-match "\\(:\\)\\s *" prompt)) (replace-match (format " (default %s):" default) @@ -31,22 +40,23 @@ 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) + "Convert first 4 bytes of STR (network byteorder) to 32 bit integer." + (logior (ash (logand (aref str 0) #XFF) 24) + (ash (logand (aref str 1) #XFF) 16) + (ash (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)." + "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 0 (logand (ash n -24) #XFF)) + (aset str 1 (logand (ash n -16) #XFF)) + (aset str 2 (logand (ash n -8) #XFF)) (aset str 3 (logand n #XFF)) str)) (defun sclang-compress-newlines (&optional buffer) + "Compress newlines (optionally in BUFFER)." (with-current-buffer (or buffer (current-buffer)) (save-excursion (goto-char (point-min)) diff --git a/el/sclang-vars.el.in b/el/sclang-vars.el.in index 96b1f62..867d6ac 100644 --- a/el/sclang-vars.el.in +++ b/el/sclang-vars.el.in @@ -35,4 +35,5 @@ Bound only when library is installed with SuperCollider.") (provide 'sclang-vars) + ;;; sclang-vars.el ends here diff --git a/el/sclang-widgets.el b/el/sclang-widgets.el index d5aa3c6..eda8bac 100644 --- a/el/sclang-widgets.el +++ b/el/sclang-widgets.el @@ -1,9 +1,8 @@ -;;; sclang-widgets.el --- Widget definitions for SCLang +;;; sclang-widgets.el --- Widget definitions for SCLang -*- coding: utf-8; lexical-binding: t -*- -;; Copyright (C) 2005 Free Software Foundation, Inc. +;; Copyright (C) 2005 Free Software Foundation, Inc. ;; Author: Mario Lang -;; 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 @@ -21,8 +20,8 @@ ;; Boston, MA 02110-1301, USA. ;;; Commentary: - ;; +;; Widget definitions for SCLang ;;; Code: @@ -31,6 +30,9 @@ (require 'sclang-language) (require 'sclang-interp) +(require 'widget) +(require 'wid-edit) + (defvar sclang-widgets nil) (make-variable-buffer-local 'sclang-widgets) @@ -45,34 +47,35 @@ "Create WIDGET at point in the current buffer." (widget-specify-insert (let ((from (point)) - button-begin button-end) - (setq button-begin (point)) + button-begin button-end) + (setq button-begin from) (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)) + (setq button-end from) ;; Specify button, and insert value. (and button-begin button-end - (widget-specify-button widget button-begin button-end))) + (widget-specify-button widget button-begin button-end))) (let ((from (point-min-marker)) - (to (point-max-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) +(defun sclang-widget-button-action (widget _event) + "Set button action for WIDGET." (widget-value-set widget - (if (>= (widget-get widget :value) (1- (length (widget-get widget :states)))) - 0 - (1+ (widget-get widget :value)))) + (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)))) + (widget-get widget :id) (widget-get widget :value)))) (sclang-set-command-handler '_widgetSetStates @@ -80,9 +83,9 @@ (cl-multiple-value-bind (buffer id states value) arg (with-current-buffer (get-buffer buffer) (let ((widget (cdr (cl-find id sclang-widgets :key 'car)))) - (widget-put widget :states states) - (widget-value-set widget value) - value))))) + (widget-put widget :states states) + (widget-value-set widget value) + value))))) (define-widget 'sclang-slider 'default "Slider widget." @@ -94,16 +97,16 @@ :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)))))) + (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)) + (inhibit-redisplay t) + button-begin button-end) + (setq button-begin from) (insert (widget-get-indirect widget :button-prefix)) (insert-char ?- (widget-get widget :size)) @@ -115,9 +118,9 @@ ;; Specify button (and button-begin button-end - (widget-specify-button widget button-begin button-end))) + (widget-specify-button widget button-begin button-end))) (let ((from (point-min-marker)) - (to (point-max-marker))) + (to (point-max-marker))) (set-marker-insertion-type from t) (set-marker-insertion-type to nil) (widget-put widget :from from) @@ -125,6 +128,7 @@ (widget-clear-undo)) (defun sclang-widget-slider-value-set (widget value) + "Set slider WIDGET to VALUE." (save-excursion (let ((inhibit-read-only t)) (goto-char (widget-get widget :from)) @@ -133,9 +137,9 @@ (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))))) + (widget-put widget :current-pos n) + (forward-char n) + (insert "|") (delete-char 1))))) ;; Class Tree @@ -145,15 +149,16 @@ :dynargs #'sclang-widget-class-tree-dynargs) (defun sclang-widget-class-tree-dynargs (widget) + "Class tree WIDGET." (sclang-eval-sync (sclang-format "EmacsClassTree.dynargs(%o)" - (widget-get widget :tag)))) + (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)))) + (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." @@ -161,5 +166,7 @@ (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 diff --git a/el/sclang.el b/el/sclang.el index edae1fb..8d6aecd 100644 --- a/el/sclang.el +++ b/el/sclang.el @@ -1,8 +1,15 @@ -;;; sclang.el --- IDE for working with the SuperCollider language -;; Copyright 2003 stefan kersten -;; Version: 1.0.0 -;; URL: https://github.com/supercollider/scel +;;; sclang.el --- IDE for working with SuperCollider -*- coding: utf-8; lexical-binding: t -*- ;; +;; Copyright 2003 stefan kersten +;; +;; Author: stefan kersten +;; Keywords: supercollider, multimedia, languages, tools +;; Version: 1.1.0 +;; Package-Requires: ((emacs "27.1") (w3m "0.0")) +;; URL: https://github.com/supercollider/scel + +;;; License: + ;; 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 @@ -22,10 +29,21 @@ ;; ;; This package provides code for interfacing with sclang and scsynth. ;; In order to be useful you need to install SuperCollider and the -;; sc-el Quark. See the README or https://github.com/supercollider/scel +;; sc-el Quark. See the README or https://github.com/supercollider/scel ;; for more information. +;; +;; Recent versions of w3m use tab-line which is only available after 27.1 +;; However sclang should work on Emacs 26.3 to 27.1 without the help browser. + +;;; Credits: +;; +;; stefan kersten +;; and everyone in... +;; git shortlog -s | sort -r | cut -c8- + ;;; Code: + (defgroup sclang nil "IDE for working with the SuperCollider language." :group 'languages) @@ -43,7 +61,7 @@ :group 'sclang) (defgroup sclang-programs nil - "Paths to programs used by sclang-mode." + "Paths to programs used by `sclang-mode'." :group 'sclang-interface) (defgroup sclang-options nil