zzkt/scel
1
0
Fork 0
Code Issues 7 Pull requests Projects Activity Actions

Compare commits

base: zzkt:topic/ninja
Branches Tags
zzkt:main
zzkt:topic/ninja
..
compare: zzkt:main
Branches Tags
zzkt:main
zzkt:topic/ninja

30 commits
topic/ninj ... main

Author SHA1 Message Date
nik gaffney
59d5bdc8ca
ignore .dir-locals.el in cmake build 2022-08-19 13:31:57 +02:00
nik gaffney
875d328c18
correct load-path for cmake build 2022-08-19 13:14:17 +02:00
nik gaffney
e97fd18d31
ignore .dir-locals.el in cmake build 2022-08-18 13:30:23 +02:00
nik gaffney
5a5ff2b2b6
add local load-path to cmake build 2022-08-17 09:19:50 +02:00
nik gaffney
53d3959e1b changes for MELPA compatibility 2022-08-02 12:48:02 +02:00
nik gaffney
36eae66a3c MELPA CI checks 2022-08-02 12:34:51 +02:00
Marcin Pączkowski
d8296a9af5
Merge pull request #39 from jxa/packaging 
Allow installation via package managers
 2021-09-04 09:44:53 -07:00
Marcin Pączkowski
35b972f1a7
Update README.md 2021-09-04 09:41:16 -07:00
Marcin Pączkowski
057a1b30f2
Update README.md 2021-09-04 09:39:05 -07:00
John Andrews
cbd89755e8 README clarifications 
Also, autoload `sclang-customize`, as that should be able to be called
interactively regardless of whether sclang is started
 2021-09-04 09:46:59 -04:00
John Andrews
4852752d67 Add a test for the autoloading behavior 2021-08-19 21:23:54 -04:00
John Andrews
4e1c886b98 Move files back under /sc 2021-08-19 20:54:46 -04:00
John Andrews
fcfa17b6be Update readme 2021-08-19 20:53:11 -04:00
John Andrews
8503b2a3e2 Better autoloads 
Add autoloads which will cause whole sclang package to be loaded.
 2021-08-19 13:26:51 -04:00
John Andrews
19dfecc8ca Revert "Combine sclang-mode into the main sclang file" 
This reverts commit c414b9c7ab.
 2021-08-16 19:57:43 -04:00
John Andrews
daeb0106c5 Feedback from PR 2021-08-15 20:20:18 -04:00
John Andrews
5ac5150397 Rename sc directory so it only loads when calling from emacs 2021-08-15 16:29:46 -04:00
John Andrews
cf3e692bb5 Update installation docs 2021-08-10 21:04:10 -04:00
John Andrews
c414b9c7ab Combine sclang-mode into the main sclang file 
Because the only autoloaded function is sclang-mode, the sclang file was
not being evaluated. This made it impossible to use-package properly in
order to configure the package. Combining the files makes the most sense
as sclang.el wasn't doing much anyways.
 2021-08-09 22:34:47 -04:00
John Andrews
bc06627f24 Enable github CI workflow 2021-08-09 16:07:01 -04:00
John Andrews
9b160ec102 Fix the load issue by unwrapping requires 2021-08-09 12:05:52 -04:00
John Andrews
14157663b0 Add test to expose a load-time issue 
The issue manifests when sclang is compiled. Steps to reproduce in real
emacs config:
1. Install the package and compile it
2. Open a file with a `.sc` or `.scd` extension
3. Witness the error `(void-function sclang-make-buffer-name)`

Steps to reproduce with the test:
0. install [eldev](https://github.com/doublep/eldev#installation)
1. `eldev compile`
2. `eldev test`
 2021-08-09 11:57:27 -04:00
John Andrews
225e810bdd Add quark file 2021-07-25 19:54:35 -04:00
John Andrews
6cea8929e6 Conditionally respect sclang-vars 
Only when compiling with cmake will sclang-vars.el be written. This
commit moves relevant constants into customizable vars. Only if the
`sclang-system-data-dir` exists is it respected, otherwise it will guess
the proper location by looking at the system-type.

The purpose of this is to make it possible to build and distribute a
package independent of the SuperCollider build process, while ensuring
that those users who have become accustomed to the current install
process are not disrupted.
 2021-07-25 19:54:19 -04:00
Mario Lang
9d6067b2e5
Merge pull request #26 from supercollider/topic/ninja 
cmake: fix ninja toolchain
 2021-07-23 09:19:34 +02:00
Brian Heim
0e95a1884d
Merge pull request #25 from mlang/emacs25 
Use `cl-gensym' to fix Emacs 25 compatibility (Fixes #24)
 2020-04-02 09:05:01 -05:00
Mario Lang
6739aa327c Use `cl-gensym' to fix Emacs 25 compatibility (Fixes #24) 
`gensym' used to be an alias for `cl-gensym'.
It was replaced with a "native" implementation in subr.el with Emacs 26.1.
Go back to using `cl-gensym' to make sure Emacs 25 still works.
 2020-04-02 08:29:01 +02:00
TatriX
2de9ec1157 Update changelog 2020-03-25 23:16:01 +01:00
TatriX
8472f03dbf Use define-derived-mode from prog-mode and update auto-mode-alist 2020-03-25 23:14:32 +01:00
TatriX
7bfbd1929d scel: Add support for completion-at-point-functions and company-mode 2020-02-26 17:10:07 +01:00
38 changed files with 1826 additions and 1353 deletions
Show stats Expand all files Collapse all files

5
.dir-locals.el Normal file
View file

@ -0,0 +1,5 @@
;; setting for elisp mode and elisp linter
((emacs-lisp-mode . ((fill-column . 80)
(indent-tabs-mode . nil)
(elisp-lint-indent-specs . ((describe . 1)
(it . 1))))))

55
.github/workflows/test.yml vendored Normal file
View file

@ -0,0 +1,55 @@
name: CI
on:
push:
paths-ignore:
- '**.md'
pull_request:
paths-ignore:
- '**.md'
- '**.org'
jobs:
test:
runs-on: ubuntu-latest
strategy:
matrix:
emacs_version:
- 27.2
- 28.1
- snapshot
steps:
- name: Set up Emacs
uses: purcell/setup-emacs@master
with:
version: ${{matrix.emacs_version}}
- name: Install w3m
run: sudo apt-get install -y w3m
- name: Install Eldev
run: curl -fsSL https://raw.github.com/doublep/eldev/master/webinstall/github-eldev | sh
- name: Check out the elisp source code
uses: actions/checkout@v2
# - name: Lint source code with elisp-lint
# run: |
# cd el
# eldev -p -dtT -q lint elisp-lint
- name: Lint documentation with checkdoc
run: |
cd el
eldev -p -dtT lint doc
- name: Test the uncompiled source
run: |
cd el
eldev -p -dtT test
- name: Compile and run tests again
run: |
cd el
eldev compile
eldev -p -dtT test

4
.gitignore vendored Normal file
View file

@ -0,0 +1,4 @@
.DS_Store
*.elc
.eldev
/el/sclang-autoloads.el

16
CHANGELOG.md Normal file
View file

@ -0,0 +1,16 @@
# Changelog
All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
## [Unreleased]
### Added
- Ability to distribute via package managers
- Support for `completion-at-point-functions` and `company` via `company-capf`
### Changed
- `M-<tab>` or `C-M-i` is no longer bound to `sclang-complete-symbol`
to make builtin completion work as expected.
- `sclang-mode` is now derived from `prog-mode`.

2
CMakeLists.txt
View file

@ -1,4 +1,4 @@
add_subdirectory(el) add_subdirectory(el)
add_subdirectory(sc) add_subdirectory(sc/scide_scel)
install(DIRECTORY HelpSource install(DIRECTORY HelpSource
DESTINATION share/SuperCollider/Extensions/scide_scel/) DESTINATION share/SuperCollider/Extensions/scide_scel/)

203
README.md
View file

@ -1,83 +1,142 @@
Scel # scel - sclang-mode for emacs
====
SuperCollider/Emacs interface SuperCollider/Emacs interface
## Installation
Installation requirements There are 3 options for installation:
-------------------------
For the HTML help system, you will need emacs-w3m support. 1. Using SuperCollider Quarks (recommended)
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
install the Quark if you already have the supercollider-emacs package or if you
compiled SuperCollider with the `-DSC_EL=ON` option. Otherwise you will get an
error from SuperCollider about duplicated classes.
Installation (default) ### Install Option 1: SuperCollider's own package manager
----------------------
By default emacs-lisp files are installed in The repository contains two subprojects. `/el` contains the emacs-lisp
implementation. `/sc` contains the SuperCollider code required to
implement the Emacs interface. SuperCollider has its own package system
called Quarks, which we can use to install both halves.
`$prefix/share/emacs/site-lisp` Evaluate this code in the SuperCollider GUI by pasting it and pressing
shift+enter:
SuperCollider files are put in
`$prefix/share/SuperCollider/Extensions/scide_scel`
The only thing you need to do is loading the sclang interface in your `~/.emacs`:
``` supercollider
Quarks.install("https://github.com/supercollider/scel");
``` ```
The scel repository will be downloaded to your local file system and the path
will be added to your currently used `sclang_conf.yaml` file. (You can find its
location by evaluating `Platform.userConfigDir`)
Next, find out where scel was installed. You will use this install-path in your
emacs config.
``` supercollider
Quarks.folder.postln;
// -> /Users/<username>/Library/Application Support/SuperCollider/downloaded-quarks
```
Now in your emacs config, add the `/el` subdirectory to your load path
``` emacs-lisp
;; in ~/.emacs
;; Paste path from above, appending "/scel/el"
(add-to-list 'load-path "/Users/<username>/Library/Application Support/SuperCollider/downloaded-quarks/scel/el")
(require 'sclang)
```
#### On macOS
If `sclang` executable is not on your path, you may need to add it to your
exec-path.
``` emacs-lisp
;; in ~/.emacs
(setq exec-path (append exec-path '("/Applications/SuperCollider.app/Contents/MacOS/")))
```
### Install Option 2: Emacs package manager
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
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 3: Debian package
There is a debian package which provides emacs integration called
`supercollider-emacs`. Option #1 will likely be more recent, but
if you prefer you can install the package with:
``` shell
sudo apt install supercollider-emacs
```
### 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
scel will be compiled. On Linux machines `-DSC_EL=ON` by default. See the
supercollider README files for more info.
``` emacs-lisp
;; in ~/.emacs
(add-to-list 'load-path "/usr/local/share/emacs/site-lisp/SuperCollider/") ;; path will depend on your compilation settings
(require 'sclang) (require 'sclang)
``` ```
For the HTML help system to fully function also add ## Optional Installation Requirements
```
There are two options for SuperCollider help files. They can be opened in the
help browser that ships with SuperCollider, or if you prefer an emacs-only
workflow they can be opened using the w3m browser. The browse-in-emacs option
requires an additional dependency.
```emacs-lisp
;; in ~/.emacs
(require 'w3m) (require 'w3m)
``` ```
## Usage
Installation (detailed) The main function which starts interacting with the sclang interpreter is
----------------------- `sclang-start`. You can execute that anywhere with `M-x sclang-start`, or from
within a `.scd` buffer by pressing `C-c C-o`.
Put all `*.el` files in emacs' load-path. e.g. if you put them in If you know you want to launch sclang when you start emacs you can use the `-f`
`~/emacs/`, add the following lines to `~/.emacs` (or whatever your init option to execute that function right away:
file is called):
``` ``` shell
(add-to-list 'load-path "~/emacs") # in your terminal
(require 'sclang) emacs -f sclang-start
``` ```
for the HTML help system to fully function also add ## Configuration
```
(require 'w3m)
```
now put all `*.sc` files in sclang's library path, e.g. if you put them To fine-tune the installation from within emacs' graphical customization
in a non-standard location, such as `~/SuperCollider/Emacs`, add the interface, type:
following to `~/.config/SuperCollider/sclang_conf.yaml` (Linux) or `~/Library/Application Support/SuperCollider/sclang_conf.yaml` (macOS):
``` `M-x sclang-customize`
includePaths:
[~/SuperCollider/Emacs]
```
(note normally this is not needed as they are put into sclang's library NOTE: If you use an sclang configuration file different from the default
path during installation with scons). `sclang_conf.yaml`, you need to specify it in scel by customizing the
`sclang-library-configuration-file `variable. Otherwise, even after installing
the Quark in SuperCollider, you won't be able to run sclang code in emacs.
Usage ## Getting help
-----
In order to automatically start sclang when invoking emacs, use the following command line:
```
$> emacs -sclang
```
you're now ready to edit, inspect and execute sclang code!
Getting help
------------
Inside an sclang-mode buffer (e.g. by editing a .sc file), execute Inside an sclang-mode buffer (e.g. by editing a .sc file), execute
@ -87,11 +146,16 @@ and a window with key bindings in sclang-mode will pop up.
`C-x C-h` lets you search for a help file `C-x C-h` lets you search for a help file
`C-M-h` opens or switches to the Help browser (if no Help file has been opened, the default Help file will be opened). `C-M-h` opens or switches to the Help browser (if no Help file has been opened,
the default Help file will be opened).
`E` copies the buffer, puts it in text mode and sclang-minor-mode, to enable you to edit the code parts to try out variations of the provided code in the help file. With `C-M-h` you can then return to the Help browser and browse further from the Help file. `E` copies the buffer, puts it in text mode and sclang-minor-mode, to enable you
to edit the code parts to try out variations of the provided code in the help
file. With `C-M-h` you can then return to the Help browser and browse further
from the Help file.
`C-c C-e` allows you to edit the source of the HTML file, for example if you want to improve it and commit it to the repository. `C-c C-e` allows you to edit the source of the HTML file, for example if you
want to improve it and commit it to the repository.
To enable moving around in the help file with arrow keys add the following To enable moving around in the help file with arrow keys add the following
in your `~/.emacs`: in your `~/.emacs`:
@ -105,25 +169,18 @@ in your `~/.emacs`:
(define-key w3m-mode-map [down] 'next-line))) (define-key w3m-mode-map [down] 'next-line)))
``` ```
This ensures that the arrow keys are just for moving through the document, and not from hyperlink to hyperlink, which is the default in w3m-mode. This ensures that the arrow keys are just for moving through the document, and
not from hyperlink to hyperlink, which is the default in w3m-mode.
Customization ## Server control
-------------
To fine-tune the installation from within emacs' graphical customization interface, type: In the post buffer window, right-click on the server name; by default the two
servers `internal` and `localhost` are available. You will get a menu with
common server control operations.
`M-x sclang-customize` To select another server, step through the server list by left-clicking on the
server name.
In particular, you will have to customize `sclang-runtime-directory'. Servers instantiated from the language will automatically be available in the
mode line.
Server control
--------------
In the post buffer window, right-click on the server name; by default the two servers `internal` and `localhost` are available. You will get a menu with common server control operations.
To select another server, step through the server list by left-clicking on the server name.
Servers instantiated from the language will automatically be available
in the mode line.

5
el/.dir-locals.el Normal file
View file

@ -0,0 +1,5 @@
;; setting for elisp mode and elisp linter
((emacs-lisp-mode . ((fill-column . 80)
(indent-tabs-mode . nil)
(elisp-lint-indent-specs . ((describe . 1)
(it . 1))))))

32
el/CMakeLists.txt
View file

@ -1,10 +1,32 @@
option(SC_EL_BYTECOMPILE "Build emacs-based IDE." ON) option(SC_EL_BYTECOMPILE "Build emacs-based IDE." ON)
mark_as_advanced(SC_EL_BYTECOMPILE) mark_as_advanced(SC_EL_BYTECOMPILE)
set(PKG_DATA_DIR ${CMAKE_INSTALL_PREFIX}/share/SuperCollider)
file(GLOB scel_sources file(GLOB scel_sources
RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} *.el) RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} *.el)
set(PKG_DATA_DIR ${CMAKE_INSTALL_PREFIX}/share/SuperCollider) list(REMOVE_ITEM scel_sources ".dir-locals.el")
# if w3m in installed locally add to the load-path
file(GLOB local-load-path
LIST_DIRECTORIES true
"$ENV{HOME}/.emacs.d/site-lisp/w3m-*"
"$ENV{HOME}/.emacs.d/elpa/w3m-*")
foreach (path ${local-load-path})
if(NOT IS_DIRECTORY ${path})
list(REMOVE_ITEM local-load-path ${path})
endif()
endforeach()
list(APPEND local-load-path ${CMAKE_CURRENT_BINARY_DIR})
# convert to string of form " dir1 -L dir2 -L dir3 ..." when more than one dir
string(JOIN " -L " load-path ${local-load-path})
# build the argument string
string(CONCAT EMACS_ARGS "-batch -L " ${load-path} " -f batch-byte-compile")
configure_file(sclang-vars.el.in configure_file(sclang-vars.el.in
${CMAKE_CURRENT_BINARY_DIR}/sclang-vars.el) ${CMAKE_CURRENT_BINARY_DIR}/sclang-vars.el)
@ -17,6 +39,8 @@ set(all_scel_sources ${scel_sources} sclang-vars.el)
install (FILES ${scel_sources} ${CMAKE_CURRENT_BINARY_DIR}/sclang-vars.el install (FILES ${scel_sources} ${CMAKE_CURRENT_BINARY_DIR}/sclang-vars.el
DESTINATION share/emacs/site-lisp/SuperCollider) DESTINATION share/emacs/site-lisp/SuperCollider)
# the emacs command needs to be evaled due to layers of (un)escaping required to add load-path
if (SC_EL_BYTECOMPILE) if (SC_EL_BYTECOMPILE)
find_program(EMACS_EXECUTABLE emacs) find_program(EMACS_EXECUTABLE emacs)
if(NOT EMACS_EXECUTABLE) if(NOT EMACS_EXECUTABLE)
@ -25,10 +49,8 @@ if (SC_EL_BYTECOMPILE)
foreach (el ${all_scel_sources}) foreach (el ${all_scel_sources})
add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/${el}c add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/${el}c
COMMAND ${EMACS_EXECUTABLE} -batch VERBATIM
-L ${CMAKE_CURRENT_BINARY_DIR} COMMAND eval "${EMACS_EXECUTABLE} ${EMACS_ARGS} ${CMAKE_CURRENT_BINARY_DIR}/${el}"
-f batch-byte-compile
${CMAKE_CURRENT_BINARY_DIR}/${el}
DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/${el} DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/${el}
WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}
COMMENT "Creating byte-compiled Emacs lisp ${CMAKE_CURRENT_BINARY_DIR}/${el}c") COMMENT "Creating byte-compiled Emacs lisp ${CMAKE_CURRENT_BINARY_DIR}/${el}c")

7
el/Eldev Normal file
View file

@ -0,0 +1,7 @@
; -*- mode: emacs-lisp; lexical-binding: t -*-
;
;; You can obtain eldev from https://github.com/doublep/eldev
;; We use it for package development and running tests
(eldev-use-plugin 'autoloads)
(eldev-use-package-archive 'melpa)

193
el/sclang-browser.el
View file

@ -1,5 +1,9 @@
;; copyright 2003 stefan kersten <steve@k-hornz.de> ;;; sclang-browser.el --- SuperCollider documentation browser -*- coding: utf-8; lexical-binding: t -*-
;; ;;
;; Copyright 2003 stefan kersten <steve@k-hornz.de>
;;; License:
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of the ;; 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 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
;; USA ;; USA
(require 'sclang-util) ;;; Commentary:
(require 'view nil t) ;; Browser for SuperCollider documentation.
;; TODO: better factoring ;; TODO: better factoring
;; derive from view mode, make mode-map pluggable ;; - derive from view mode, make mode-map pluggable
;; define derived mode for completion, definition, help ;; - define derived mode for completion, definition, help
;; - update 'display-buffer-reuse-frames'
;; - update ‘view-return-to-alist’
(defun sclang-browser-fill-keymap (map) (require 'sclang-util)
(define-key map "\r" 'sclang-browser-follow-link) (require 'view)
(define-key map [mouse-2] 'sclang-browser-mouse-follow-link)
(define-key map "\t" 'sclang-browser-next-link)
(define-key map [backtab] 'sclang-browser-previous-link)
(define-key map [(shift tab)] 'sclang-browser-previous-link)
(define-key map [?q] 'sclang-browser-quit)
map)
(defvar sclang-browser-mode-map (sclang-browser-fill-keymap (make-sparse-keymap))) ;;; 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-mode-hook nil)
(defvar sclang-browser-show-hook nil) (defvar sclang-browser-show-hook nil)
(defvar sclang-browser-link-function nil (defvar sclang-browser-link-function nil)
"buffer local") (defvar sclang-browser-return-method nil)
(defvar sclang-browser-return-method nil
"buffer local")
(defun sclang-browser-beginning-of-link () (defun sclang-browser-beginning-of-link ()
"Beginning of link."
(interactive) (interactive)
(when (get-text-property (point) 'sclang-browser-link) (when (get-text-property (point) 'sclang-browser-link)
(while (and (not (bobp)) (while (and (not (bobp))
(get-text-property (point) 'sclang-browser-link)) (get-text-property (point) 'sclang-browser-link))
(forward-char -1)) (forward-char -1))
(unless (bobp) (forward-char 1)) (unless (bobp) (forward-char 1))
(point))) (point)))
(defun sclang-browser-next-link (&optional n) (defun sclang-browser-next-link (&optional n)
"Next link (or N further)."
(interactive) (interactive)
(let* ((n (or n 1)) (let* ((n (or n 1))
(prop 'sclang-browser-link) (prop 'sclang-browser-link)
(fwd (>= n 0)) (fwd (>= n 0))
(orig (point)) (orig (point))
(beg (if fwd (point-min) (point-max))) (beg (if fwd (point-min) (point-max)))
(end (if fwd (point-max) (point-min))) (end (if fwd (point-max) (point-min)))
(inc (if fwd 1 -1)) (inc (if fwd 1 -1))
pos) pos)
(when (get-text-property (point) prop) (when (get-text-property (point) prop)
(while (and (/= (point) beg) (while (and (/= (point) beg)
(get-text-property (point) prop)) (get-text-property (point) prop))
(forward-char inc)) (forward-char inc))
(if (= (point) beg) (goto-char end))) (if (= (point) beg) (goto-char end)))
(while (not (eq pos orig)) (while (not (eq pos orig))
(cond ((get-text-property (point) prop) (cond ((get-text-property (point) prop)
(sclang-browser-beginning-of-link) (sclang-browser-beginning-of-link)
(setq pos orig)) (setq pos orig))
(t (t
(if (= (point) end) (goto-char beg)) (if (= (point) end) (goto-char beg))
(forward-char inc) (forward-char inc)
(setq pos (point))))))) (setq pos (point)))))))
(defun sclang-browser-previous-link () (defun sclang-browser-previous-link ()
"Previous link."
(interactive) (interactive)
(sclang-browser-next-link -1)) (sclang-browser-next-link -1))
(defun sclang-browser-follow-link (&optional pos) (defun sclang-browser-follow-link (&optional pos)
"Follow link (optionally POS)."
(interactive) (interactive)
(let* ((pos (or pos (point))) (let* ((pos (or pos (point)))
(data (get-text-property pos 'sclang-browser-link))) (data (get-text-property pos 'sclang-browser-link)))
(when (consp data) (when (consp data)
(let ((fun (or (car data) sclang-browser-link-function)) (let ((fun (or (car data) sclang-browser-link-function))
(arg (cdr data))) (arg (cdr data)))
(when (functionp fun) (when (functionp fun)
(condition-case nil (condition-case nil
(funcall fun arg) (funcall fun arg)
(error (sclang-message "Error in link function") nil))))))) (error (sclang-message "Error in link function") nil)))))))
(defun sclang-browser-mouse-follow-link (event) (defun sclang-browser-mouse-follow-link (event)
"Link. click. EVENT."
(interactive "e") (interactive "e")
(let* ((start (event-start event)) (let* ((start (event-start event))
(window (car start)) (window (car start))
(pos (cadr start))) (pos (cadr start)))
(with-current-buffer (window-buffer window) (with-current-buffer (window-buffer window)
(sclang-browser-follow-link pos)))) (sclang-browser-follow-link pos))))
(defun sclang-browser-mode () (defun sclang-browser-mode ()
"Major mode for viewing hypertext and navigating references in it. "Major mode for viewing hypertext and navigating references.
Entry to this mode runs the normal hook `sclang-browser-mode-hook'. Entry to this mode runs the normal hook `sclang-browser-mode-hook'
Commands: Commands:
\\{sclang-browser-mode-map}" \\{sclang-browser-mode-map}"
(interactive) (interactive)
(view-mode)
(kill-all-local-variables) (kill-all-local-variables)
(use-local-map sclang-browser-mode-map) (use-local-map sclang-browser-mode-map)
(set-keymap-parent sclang-browser-mode-map view-mode-map)
(setq mode-name "Browser") (setq mode-name "Browser")
(setq major-mode 'sclang-browser-mode) (setq major-mode 'sclang-browser-mode)
(set (make-local-variable 'sclang-browser-link-function) nil) (set (make-local-variable 'sclang-browser-link-function) nil)
(set (make-local-variable 'sclang-browser-return-method) nil) (set (make-local-variable 'sclang-browser-return-method) nil)
(set (make-local-variable 'font-lock-defaults) nil) (set (make-local-variable 'font-lock-defaults) nil)
(view-mode)
(set (make-local-variable 'minor-mode-overriding-map-alist) (set (make-local-variable 'minor-mode-overriding-map-alist)
(list (cons 'view-mode sclang-browser-mode-map))) (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)) (run-hooks 'sclang-browser-mode-hook))
(defun sclang-browser-mode-setup () (defun sclang-browser-mode-setup ()
"Setup sclang-browser-mode."
(sclang-browser-mode) (sclang-browser-mode)
(setq buffer-read-only nil)) (setq buffer-read-only nil))
(defun sclang-browser-mode-finish () (defun sclang-browser-mode-finish ()
(toggle-read-only 1) "Finish sclang-browser-mode."
(setq view-return-to-alist (read-only-mode)
(list (cons (selected-window) sclang-browser-return-method))) ;; ‘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)) (run-hooks 'sclang-browser-show-hook))
(defun sclang-browser-quit () (defun sclang-browser-quit ()
"Quit the sclang help browser."
(interactive) (interactive)
(when (eq major-mode 'sclang-browser-mode) (when (eq major-mode 'sclang-browser-mode)
(kill-buffer (current-buffer)))) (kill-buffer (current-buffer))))
(defun sclang-browser-make-link (link-text &optional link-data link-function) (defun sclang-browser-make-link (link-text &optional link-data link-function)
(let ((map (make-sparse-keymap))) "Make a link using LINK-TEXT (optional LINK-DATA and LINK-FUNCTION)."
(propertize link-text (propertize link-text
'mouse-face 'highlight 'mouse-face 'highlight
;;'help-echo "mouse-2: follow link" 'sclang-browser-link (cons link-function link-data)))
;;'keymap map
'sclang-browser-link (cons link-function link-data)
;;'sclang-browser-link-data link-data
;;'sclang-browser-link-function link-function)))
)))
(defun sclang-display-browser (buffer-name output-function) (defun sclang-display-browser (buffer-name output-function)
"header: what to insert in the buffer "Display browser using BUFFER-NAME and OUTPUT-FUNCTION.
link-list: list of (link-text link-function link-data) header: what to insert in the buffer.
link-function: function with args (link-text link-data)" 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)) (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-output-to-temp-buffer buffer-name
(with-current-buffer standard-output (with-current-buffer standard-output
;; record return method ;; record return method
(setq sclang-browser-return-method (setq sclang-browser-return-method
(cond ((special-display-p (buffer-name standard-output)) (cond ((special-display-p (buffer-name standard-output))
;; If the help output buffer is a special display buffer, ;; If the help output buffer is a special display buffer,
;; don't say anything about how to get rid of it. ;; don't say anything about how to get rid of it.
;; First of all, the user will do that with the window ;; First of all, the user will do that with the window
;; manager, not with Emacs. ;; manager, not with Emacs.
;; Secondly, the buffer has not been displayed yet, ;; Secondly, the buffer has not been displayed yet,
;; so we don't know whether its frame will be selected. ;; so we don't know whether its frame will be selected.
(cons (selected-window) t)) (cons (selected-window) t))
(display-buffer-reuse-frames ;; display-buffer-reuse-frames is obsolete since 24.3
(cons (selected-window) 'quit-window)) ;; replace with something like
((not (one-window-p t)) ;;+ (add-to-list 'display-buffer-alist
(cons (selected-window) 'quit-window)) ;;+ '("." nil (reusable-frames . t)))
(pop-up-windows ;;- (display-buffer-reuse-frames
(cons (selected-window) t)) ;;- (cons (selected-window) 'quit-window))
(t ((not (one-window-p t))
(list (selected-window) (window-buffer) (cons (selected-window) 'quit-window))
(window-start) (window-point))))) ;; This variable is provided mainly for backward compatibility
(funcall output-function))))) ;; 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) (defmacro with-sclang-browser (buffer-name &rest body)
"Display browser in BUFFER-NAME and run BODY."
`(sclang-display-browser ,buffer-name (lambda () ,@body))) `(sclang-display-browser ,buffer-name (lambda () ,@body)))
;; ===================================================================== ;; =====================================================================
@ -180,4 +205,4 @@ Commands:
(provide 'sclang-browser) (provide 'sclang-browser)
;; EOF ;;; sclang-browser.el ends here

38
el/sclang-dev.el
View file

@ -1,3 +1,9 @@
;;; sclang-dev.el --- IDE for working with SuperCollider -*- coding: utf-8;
;;
;; Copyright 2003 stefan kersten <steve@k-hornz.de>
;;; License:
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of the ;; published by the Free Software Foundation; either version 2 of the
@ -14,36 +20,24 @@
;; USA ;; USA
(eval-when-compile ;;; Commentary:
(require 'sclang-util) ;; Edit SuperCollider help files.
(require 'sclang-interp)
)
(require 'sclang-util)
(require 'sclang-interp)
;;; Code:
(sclang-set-command-handler (sclang-set-command-handler
'openDevSource 'openDevSource
(lambda (file) (lambda (file)))
)
)
(defun sclang-edit-dev-source () (defun sclang-edit-dev-source ()
"Edit the help file at the development location." "Edit the help file at the development location."
; (sclang-document-name . (prSetTitle (buffer-name)))
(interactive) (interactive)
(sclang-perform-command 'openDevSource (buffer-file-name)) ;; (sclang-document-name . (prSetTitle (buffer-name)))
) (sclang-perform-command 'openDevSource (buffer-file-name)))
(provide 'sclang-dev) (provide 'sclang-dev)
;(defun sclang-open-dev-source (file) ;;; sclang-dev.el ends here
; "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)
; )
; )

14
el/sclang-document.el
View file

@ -1,5 +1,9 @@
;; copyright 2003 stefan kersten <steve@k-hornz.de> ;;; sclang-document.el --- IDE for working with SuperCollider -*- coding: utf-8;
;; ;;
;; Copyright 2003 stefan kersten <steve@k-hornz.de>
;;; License:
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of the ;; 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 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
;; USA ;; USA
;;; Commentary:
;; ???
;;; Code:
(provide 'sclang-document) (provide 'sclang-document)
;; EOF ;;; sclang-document.el ends here

559
el/sclang-help.el
View file

@ -1,5 +1,9 @@
;; copyright 2003 stefan kersten <steve@k-hornz.de> ;;; sclang-help.el --- IDE for working with SuperCollider -*- coding: utf-8; -*-
;; ;;
;; Copyright 2003 stefan kersten <steve@k-hornz.de>
;;; License:
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of the ;; published by the Free Software Foundation; either version 2 of the
@ -15,34 +19,59 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
;; USA ;; USA
;;; Commentary:
;; Access SuperCollider help files.
;;; Code:
(eval-when-compile (eval-when-compile
(require 'font-lock)) (require 'font-lock))
;; (require 'w3m) ;; not needed during compilation (require 'w3m)
(require 'cl-lib) (require 'cl-lib)
(require 'sclang-util) (require 'sclang-util)
(require 'sclang-interp) (require 'sclang-interp)
(require 'sclang-language) (require 'sclang-language)
(require 'sclang-mode) (require 'sclang-mode)
(require 'sclang-vars) (require 'sclang-vars nil 'ignore-missing-file)
(require 'sclang-minor-mode) (require 'sclang-minor-mode)
(defcustom sclang-help-directory "~/SuperCollider/Help" (defun sclang-system-root ()
"*Directory where the SuperCollider help files are kept. OBSOLETE." "Find the common install location for the platform."
(cond
((boundp 'sclang-system-data-dir)
sclang-system-data-dir)
((eql 'darwin system-type)
(expand-file-name "~/Library/Application Support/SuperCollider"))
((and (eql 'gnu/linux system-type)
(file-exists-p "/usr/local/share/SuperCollider"))
"/usr/local/share/SuperCollider")
((eql 'gnu/linux system-type)
"/usr/share/SuperCollider")))
(defcustom sclang-system-help-dir (expand-file-name "Help" (sclang-system-root))
"Installation dependent help directory."
:group 'sclang-interface :group 'sclang-interface
:version "21.3" :type 'directory)
:type 'directory
:options '(:must-match))
(defcustom sclang-help-path (list sclang-system-help-dir (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." "List of directories where SuperCollider help files are kept."
:group 'sclang-interface :group 'sclang-interface
:version "21.4" :version "21.4"
:type '(repeat directory)) :type '(repeat directory))
(defcustom sclang-system-extension-dir (expand-file-name "Extensions" (sclang-system-root))
"Installation dependent extension directory."
:group 'sclang-interface
:type 'directory)
(defconst sclang-extension-path (list sclang-system-extension-dir (defconst sclang-extension-path (list sclang-system-extension-dir
"~/.local/share/SuperCollider/Extensions") "~/.local/share/SuperCollider/Extensions")
"List of SuperCollider extension directories.") "List of SuperCollider extension directories.")
(defcustom sclang-help-fill-column fill-column (defcustom sclang-help-fill-column fill-column
@ -68,29 +97,32 @@
(defcustom sclang-help-filters (defcustom sclang-help-filters
'(("p\\.p\\([0-9]+\\)" . "#p\\1") '(("p\\.p\\([0-9]+\\)" . "#p\\1")
("<p class=\"\\(.*\\)\">\\(.*\\)</p>" . "<div id=\"\\1\">\\2</div>")) ("<p class=\"\\(.*\\)\">\\(.*\\)</p>" . "<div id=\"\\1\">\\2</div>"))
"list of pairs of (regexp . filter) defining html-tags to be replaced by the function sclang-help-substitute-for-filters" "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 :group 'sclang-interface
:type '(repeat (cons (string :tag "match") (string :tag "replacement")))) :type '(repeat (cons (string :tag "match") (string :tag "replacement"))))
(defun sclang-help-substitute-for-filters (&rest args) (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) (mapcar #'(lambda (filter)
(let ((regexp (car filter)) (let ((regexp (car filter))
(to-string (cdr filter))) (to-string (cdr filter)))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward regexp nil t) (while (re-search-forward regexp nil t)
(replace-match to-string nil nil)))) (replace-match to-string nil nil))))
sclang-help-filters)) sclang-help-filters))
;; w3m's content-filtering system ;; w3m's content-filtering system
(setq w3m-use-filter t) (setq w3m-use-filter t)
;; checks if w3m-filter is loaded. Is `eval-after-load' necessary here?
(eval-after-load "w3m-filter" (eval-after-load "w3m-filter"
'(add-to-list 'w3m-filter-rules '(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))) '(".*" sclang-help-substitute-for-filters)))
(defvar sclang-help-topic-alist nil (defvar sclang-help-topic-alist nil
"Alist mapping help topics to file names.") "Alist mapping help topics to file names.")
@ -117,40 +149,51 @@
;; ===================================================================== ;; =====================================================================
(defun sclang-get-help-file (topic) (defun sclang-get-help-file (topic)
"Get the help file for TOPIC."
(let ((topic (or (cdr (assoc topic sclang-special-help-topics)) topic))) (let ((topic (or (cdr (assoc topic sclang-special-help-topics)) topic)))
(cdr (assoc topic sclang-help-topic-alist)))) (cdr (assoc topic sclang-help-topic-alist))))
(defun sclang-get-help-topic (file) (defun sclang-get-help-topic (file)
"Get the help topic for FILE."
(let ((topic (car (rassoc file sclang-help-topic-alist)))) (let ((topic (car (rassoc file sclang-help-topic-alist))))
(or (car (rassoc topic sclang-special-help-topics)) topic))) (or (car (rassoc topic sclang-special-help-topics)) topic)))
(defun sclang-help-buffer-name (topic) (defun sclang-help-buffer-name (topic)
"Set the help buffer name to TOPIC."
(sclang-make-buffer-name (concat "Help:" topic))) (sclang-make-buffer-name (concat "Help:" topic)))
;; file predicate functions
(defun sclang-rtf-file-p (file) (defun sclang-rtf-file-p (file)
"Does an rtf FILE exist?"
(let ((case-fold-search t)) (let ((case-fold-search t))
(string-match ".*\\.rtf$" file))) (string-match ".*\\.rtf$" file)))
;; ========= ADDITION for HTML help files
(defun sclang-html-file-p (file) (defun sclang-html-file-p (file)
(let ((case-fold-search t)) "Does an html FILE exist?"
(string-match ".*\\.html?$" file))) (let ((case-fold-search t))
(string-match ".*\\.html?$" file)))
(defun sclang-sc-file-p (file) (defun sclang-sc-file-p (file)
"Does an sc FILE exist?"
(let ((case-fold-search t)) (let ((case-fold-search t))
(string-match ".*\\.sc$" file))) (string-match ".*\\.sc$" file)))
(defun sclang-scd-file-p (file) (defun sclang-scd-file-p (file)
"Does an scd FILE exist?"
(let ((case-fold-search t)) (let ((case-fold-search t))
(string-match ".*\\.scd$" file))) (string-match ".*\\.scd$" file)))
(defun sclang-help-file-p (file) (defun sclang-help-file-p (file)
"Is FILE a help file?"
(string-match sclang-help-file-regexp file)) (string-match sclang-help-file-regexp file))
(defun sclang-help-topic-name (file) (defun sclang-help-topic-name (file)
(if (string-match sclang-help-file-regexp file) "Get the help topic from FILE."
(cons (file-name-nondirectory (replace-match "" nil nil file 1)) (when (string-match sclang-help-file-regexp file)
file))) (cons (file-name-nondirectory (replace-match "" nil nil file 1))
file)))
;; ===================================================================== ;; =====================================================================
;; rtf parsing ;; rtf parsing
@ -159,7 +202,7 @@
(defconst sclang-rtf-face-change-token "\0") (defconst sclang-rtf-face-change-token "\0")
(defun sclang-fill-rtf-syntax-table (table) (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) (modify-syntax-entry ?\" "." table)
(modify-syntax-entry ?\{ "(" table) (modify-syntax-entry ?\{ "(" table)
@ -174,8 +217,8 @@
"Syntax table used for RTF parsing.") "Syntax table used for RTF parsing.")
(defvar sclang-rtf-font-map '((Helvetica . variable-pitch) (defvar sclang-rtf-font-map '((Helvetica . variable-pitch)
(Helvetica-Bold . variable-pitch) (Helvetica-Bold . variable-pitch)
(Monaco . nil))) (Monaco . nil)))
(cl-defstruct sclang-rtf-state (cl-defstruct sclang-rtf-state
output font-table font face pos) output font-table font face pos)
@ -185,197 +228,212 @@
(defun sclang-code-p (pos) (not (rtf-p pos)))) (defun sclang-code-p (pos) (not (rtf-p pos))))
(defmacro with-sclang-rtf-state-output (state &rest body) (defmacro with-sclang-rtf-state-output (state &rest body)
"Wrap rtf STATE output around BODY."
`(with-current-buffer (sclang-rtf-state-output ,state) `(with-current-buffer (sclang-rtf-state-output ,state)
,@body)) ,@body))
(defmacro sclang-rtf-state-add-font (state font-id font-name) (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))) `(push (cons ,font-id (intern ,font-name)) (sclang-rtf-state-font-table ,state)))
(defmacro sclang-rtf-state-apply (state) (defmacro sclang-rtf-state-apply (state)
(let ((pos (gensym)) "Apply STATE to rtf output."
(font (gensym)) (let ((pos (cl-gensym))
(face (gensym))) (font (cl-gensym))
(face (cl-gensym)))
`(with-current-buffer (sclang-rtf-state-output ,state) `(with-current-buffer (sclang-rtf-state-output ,state)
(let ((,pos (or (sclang-rtf-state-pos ,state) (point-min))) (let ((,pos (or (sclang-rtf-state-pos ,state) (point-min)))
(,font (cdr (assq (,font (cdr (assq
(cdr (assoc (cdr (assoc
(sclang-rtf-state-font ,state) (sclang-rtf-state-font ,state)
(sclang-rtf-state-font-table ,state))) (sclang-rtf-state-font-table ,state)))
sclang-rtf-font-map))) sclang-rtf-font-map)))
(,face (sclang-rtf-state-face ,state))) (,face (sclang-rtf-state-face ,state)))
(when (> (point) ,pos) (when (> (point) ,pos)
(if ,font (if ,font
(add-text-properties (add-text-properties
,pos (point) ,pos (point)
(list 'rtf-p t 'rtf-face (append (list ,font) ,face)))) (list 'rtf-p t 'rtf-face (append (list ,font) ,face))))
(setf (sclang-rtf-state-pos ,state) (point))))))) (setf (sclang-rtf-state-pos ,state) (point)))))))
(defmacro sclang-rtf-state-set-font (state font) (defmacro sclang-rtf-state-set-font (state font)
"Set FONT in STATE."
`(progn `(progn
(sclang-rtf-state-apply ,state) (sclang-rtf-state-apply ,state)
(setf (sclang-rtf-state-font ,state) ,font))) (setf (sclang-rtf-state-font ,state) ,font)))
(defmacro sclang-rtf-state-push-face (state face) (defmacro sclang-rtf-state-push-face (state face)
(let ((list (gensym))) "Push FACE to STATE."
(let ((list (cl-gensym)))
`(let ((,list (sclang-rtf-state-face state))) `(let ((,list (sclang-rtf-state-face state)))
(sclang-rtf-state-apply ,state) (sclang-rtf-state-apply ,state)
(unless (memq ,face ,list) (unless (memq ,face ,list)
(setf (sclang-rtf-state-face ,state) (setf (sclang-rtf-state-face ,state)
(append ,list (list ,face))))))) (append ,list (list ,face)))))))
(defmacro sclang-rtf-state-pop-face (state face) (defmacro sclang-rtf-state-pop-face (state face)
(let ((list (gensym))) "Pop FACE from STATE."
(let ((list (cl-gensym)))
`(let* ((,list (sclang-rtf-state-face ,state))) `(let* ((,list (sclang-rtf-state-face ,state)))
(sclang-rtf-state-apply ,state) (sclang-rtf-state-apply ,state)
(setf (sclang-rtf-state-face ,state) (delq ,face ,list))))) (setf (sclang-rtf-state-face ,state) (delq ,face ,list)))))
(defun sclang-parse-rtf (state) (defun sclang-parse-rtf (state)
(while (not (eobp)) "Parse rtf STATE."
(while (not (eobp))
(cond ((looking-at "{") (cond ((looking-at "{")
;; container ;; container
(let ((beg (point))) (let ((beg (point)))
(with-syntax-table sclang-rtf-syntax-table (with-syntax-table sclang-rtf-syntax-table
(forward-list 1)) (forward-list 1))
(save-excursion (save-excursion
(save-restriction (save-restriction
(narrow-to-region (1+ beg) (1- (point))) (narrow-to-region (1+ beg) (1- (point)))
(goto-char (point-min)) (goto-char (point-min))
(sclang-parse-rtf-container state) (sclang-parse-rtf-container state)
(widen))))) (widen)))))
((or (looking-at "\\\\\\([{}\\\n]\\)") ((or (looking-at "\\\\\\([{}\\\n]\\)")
(looking-at "\\\\\\([^\\ \n]+\\) ?")) (looking-at "\\\\\\([^\\ \n]+\\) ?"))
;; control ;; control
(let ((end (match-end 0))) (let ((end (match-end 0)))
(sclang-parse-rtf-control state (match-string 1)) (sclang-parse-rtf-control state (match-string 1))
(goto-char end))) (goto-char end)))
((looking-at "\\([^{\\\n]+\\)") ((looking-at "\\([^{\\\n]+\\)")
;; normal text ;; normal text
(let ((end (match-end 0)) (let ((end (match-end 0))
(match (match-string 1))) (match (match-string 1)))
(with-sclang-rtf-state-output state (insert match)) (with-sclang-rtf-state-output state (insert match))
(goto-char end))) (goto-char end)))
(t (t
;; never reached (?) ;; never reached (?)
(forward-char 1))))) (forward-char 1)))))
(defun sclang-parse-rtf-container (state) (defun sclang-parse-rtf-container (state)
(cond ((looking-at "\\\\rtf1") ; document "Parse RTF container. STATE."
(goto-char (match-end 0)) (cond ((looking-at "\\\\rtf1") ; document
(sclang-parse-rtf state)) (goto-char (match-end 0))
((looking-at "\\\\fonttbl") ; font table (sclang-parse-rtf state))
(goto-char (match-end 0)) ((looking-at "\\\\fonttbl") ; font table
(while (looking-at "\\\\\\(f[0-9]+\\)[^ ]* \\([^;]*\\);[^\\]*") (goto-char (match-end 0))
(sclang-rtf-state-add-font state (match-string 1) (match-string 2)) (while (looking-at "\\\\\\(f[0-9]+\\)[^ ]* \\([^;]*\\);[^\\]*")
(goto-char (match-end 0)))) (sclang-rtf-state-add-font state (match-string 1) (match-string 2))
((looking-at "{\\\\NeXTGraphic \\([^\\]+\\.[a-z]+\\)") ; inline graphic (goto-char (match-end 0))))
(let* ((file (match-string 1)) ((looking-at "{\\\\NeXTGraphic \\([^\\]+\\.[a-z]+\\)") ; inline graphic
(image (and file (create-image (expand-file-name file))))) (let* ((file (match-string 1))
(with-sclang-rtf-state-output (image (and file (create-image (expand-file-name file)))))
state (with-sclang-rtf-state-output
(if image state
(insert-image image) (if image
(sclang-rtf-state-push-face state 'italic) (insert-image image)
(insert file) (sclang-rtf-state-push-face state 'italic)
(sclang-rtf-state-pop-face state 'italic))))) (insert file)
)) (sclang-rtf-state-pop-face state 'italic)))))))
(defun sclang-parse-rtf-control (state ctrl) (defun sclang-parse-rtf-control (state ctrl)
"Parse RTF control chars. STATE CTRL."
(let ((char (aref ctrl 0))) (let ((char (aref ctrl 0)))
(cond ((memq char '(?{ ?} ?\\)) (cond ((memq char '(?{ ?} ?\\))
(with-sclang-rtf-state-output state (insert char))) (with-sclang-rtf-state-output state (insert char)))
((or (eq char ?\n) ((or (eq char ?\n)
(string= ctrl "par")) (string= ctrl "par"))
(sclang-rtf-state-apply state) (sclang-rtf-state-apply state)
(with-sclang-rtf-state-output (with-sclang-rtf-state-output
state state
(when (sclang-rtf-p (line-beginning-position)) (when (sclang-rtf-p (line-beginning-position))
(fill-region (line-beginning-position) (line-end-position) (fill-region (line-beginning-position) (line-end-position)
t t)) t t))
(insert ?\n))) (insert ?\n)))
((string= ctrl "tab") ((string= ctrl "tab")
(with-sclang-rtf-state-output state (insert ?\t))) (with-sclang-rtf-state-output state (insert ?\t)))
((string= ctrl "b") ((string= ctrl "b")
(sclang-rtf-state-push-face state 'bold)) (sclang-rtf-state-push-face state 'bold))
((string= ctrl "b0") ((string= ctrl "b0")
(sclang-rtf-state-pop-face state 'bold)) (sclang-rtf-state-pop-face state 'bold))
((string-match "^f[0-9]+$" ctrl) ((string-match "^f[0-9]+$" ctrl)
(sclang-rtf-state-set-font state ctrl)) (sclang-rtf-state-set-font state ctrl)))))
)))
(defun sclang-convert-rtf-buffer (output) (defun sclang-convert-rtf-buffer (output)
"Convert rtf buffer. OUTPUT."
(let ((case-fold-search nil) (let ((case-fold-search nil)
(fill-column sclang-help-fill-column)) (fill-column sclang-help-fill-column))
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(when (looking-at "{\\\\rtf1") (when (looking-at "{\\\\rtf1")
(let ((state (make-sclang-rtf-state))) (let ((state (make-sclang-rtf-state)))
(setf (sclang-rtf-state-output state) output) (setf (sclang-rtf-state-output state) output)
(sclang-parse-rtf state) (sclang-parse-rtf state)
(sclang-rtf-state-apply state)))))) (sclang-rtf-state-apply state))))))
;; ===================================================================== ;; =====================================================================
;; help mode ;; help mode
;; ===================================================================== ;; =====================================================================
(defun sclang-fill-help-syntax-table (table) (defun sclang-fill-help-syntax-table (table)
"Fill help syntax TABLE."
;; make ?- be part of symbols for selection and sclang-symbol-at-point ;; make ?- be part of symbols for selection and sclang-symbol-at-point
(modify-syntax-entry ?- "_" table)) (modify-syntax-entry ?- "_" table))
(defun sclang-fill-help-mode-map (map) (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}" 'bury-buffer)
(define-key map "\C-c\C-v" 'sclang-edit-help-file)) (define-key map "\C-c\C-v" 'sclang-edit-help-file))
(defmacro sclang-help-mode-limit-point-to-code (&rest body) (defmacro sclang-help-mode-limit-point-to-code (&rest body)
(let ((min (gensym)) "Limit point to code BODY."
(max (gensym)) (let ((min (cl-gensym))
(res (gensym))) (max (cl-gensym))
(res (cl-gensym)))
`(if (and (sclang-code-p (point)) `(if (and (sclang-code-p (point))
(not (or (bobp) (eobp))) (not (or (bobp) (eobp)))
(sclang-code-p (1- (point))) (sclang-code-p (1- (point)))
(sclang-code-p (1+ (point)))) (sclang-code-p (1+ (point))))
(let ((,min (previous-single-property-change (point) 'rtf-p (current-buffer) (point-min))) (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)))) (,max (next-single-property-change (point) 'rtf-p (current-buffer) (point-max))))
(let ((,res (progn ,@body))) (let ((,res (progn ,@body)))
(cond ((< (point) ,min) (goto-char ,min) nil) (cond ((< (point) ,min) (goto-char ,min) nil)
((> (point) ,max) (goto-char ,max) nil) ((> (point) ,max) (goto-char ,max) nil)
(t ,res))))))) (t ,res)))))))
(defun sclang-help-mode-beginning-of-defun (&optional arg) (defun sclang-help-mode-beginning-of-defun (&optional arg)
"Move to beginning of function (or back ARG)."
(interactive "p") (interactive "p")
(sclang-help-mode-limit-point-to-code (sclang-beginning-of-defun arg))) (sclang-help-mode-limit-point-to-code (sclang-beginning-of-defun arg)))
(defun sclang-help-mode-end-of-defun (&optional arg) (defun sclang-help-mode-end-of-defun (&optional arg)
"Move to end of function (or forward ARG)."
(interactive "p") (interactive "p")
(sclang-help-mode-limit-point-to-code (sclang-end-of-defun arg))) (sclang-help-mode-limit-point-to-code (sclang-end-of-defun arg)))
(defun sclang-help-mode-fontify-region (start end loudly) (defun sclang-help-mode-fontify-region (start end loudly)
"Fontify region from START to END and LOUDLY."
(cl-flet ((fontify-code (cl-flet ((fontify-code
(start end loudly) (start end loudly)
(funcall 'font-lock-default-fontify-region start end loudly)) (funcall 'font-lock-default-fontify-region start end loudly))
(fontify-non-code (fontify-non-code
(start end loudly) (start end loudly)
(while (< start end) (while (< start end)
(let ((value (plist-get (text-properties-at start) 'rtf-face)) (let ((value (plist-get (text-properties-at start) 'rtf-face))
(end (next-single-property-change start 'rtf-face (current-buffer) end))) (end (next-single-property-change start 'rtf-face (current-buffer) end)))
(add-text-properties start end (list 'face (append '(variable-pitch) (list value)))) (add-text-properties start end (list 'face (append '(variable-pitch) (list value))))
(setq start end))))) (setq start end)))))
(let ((modified (buffer-modified-p)) (buffer-undo-list t) (let ((modified (buffer-modified-p)) (buffer-undo-list t)
(inhibit-read-only t) (inhibit-point-motion-hooks t) (inhibit-read-only t) (inhibit-point-motion-hooks t)
(inhibit-modification-hooks t) (inhibit-modification-hooks t)
deactivate-mark buffer-file-name buffer-file-truename deactivate-mark buffer-file-name buffer-file-truename
(pos start)) (pos start))
(unwind-protect (unwind-protect
(while (< pos end) (while (< pos end)
(let ((end (next-single-property-change pos 'rtf-p (current-buffer) end))) (let ((end (next-single-property-change pos 'rtf-p (current-buffer) end)))
(if (sclang-rtf-p pos) (if (sclang-rtf-p pos)
(fontify-non-code pos end loudly) (fontify-non-code pos end loudly)
(fontify-code pos end loudly)) (fontify-code pos end loudly))
(setq pos end))) (setq pos end)))
(when (and (not modified) (buffer-modified-p)) (when (and (not modified) (buffer-modified-p))
(set-buffer-modified-p nil)))))) (set-buffer-modified-p nil))))))
(defun sclang-help-mode-indent-line () (defun sclang-help-mode-indent-line ()
"Indent sclang code in documentation."
(if (sclang-code-p (point)) (if (sclang-code-p (point))
(sclang-indent-line) (sclang-indent-line)
(insert "\t"))) (insert "\t")))
@ -384,30 +442,29 @@
"Major mode for displaying SuperCollider help files. "Major mode for displaying SuperCollider help files.
\\{sclang-help-mode-map}" \\{sclang-help-mode-map}"
(let ((file (or (buffer-file-name) (let ((file (or (buffer-file-name)
(and (boundp 'sclang-current-help-file) (and (boundp 'sclang-current-help-file)
sclang-current-help-file)))) sclang-current-help-file))))
(when file (when file
(set-visited-file-name nil) (set-visited-file-name nil)
(setq buffer-auto-save-file-name nil) (setq buffer-auto-save-file-name nil)
(save-excursion (save-excursion
(when (sclang-rtf-file-p file) (when (sclang-rtf-file-p file)
(let ((tmp-buffer (generate-new-buffer " *RTF*")) (let ((tmp-buffer (generate-new-buffer " *RTF*"))
(modified-p (buffer-modified-p))) (modified-p (buffer-modified-p)))
(unwind-protect (unwind-protect
(progn (progn
(sclang-convert-rtf-buffer tmp-buffer) (sclang-convert-rtf-buffer tmp-buffer)
(toggle-read-only 0) (read-only-mode)
(erase-buffer) (erase-buffer)
(insert-buffer-substring tmp-buffer)) (insert-buffer-substring tmp-buffer))
(and (buffer-modified-p) (not modified-p) (set-buffer-modified-p nil)) (and (buffer-modified-p) (not modified-p) (set-buffer-modified-p nil))
(kill-buffer tmp-buffer)))))) (kill-buffer tmp-buffer))))))
(set (make-local-variable 'sclang-help-file) file) (set (make-local-variable 'sclang-help-file) file)
(setq font-lock-defaults (setq font-lock-defaults
(append font-lock-defaults (append font-lock-defaults
'((font-lock-fontify-region-function . sclang-help-mode-fontify-region)))) '((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 '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 ;; help file access
@ -417,17 +474,18 @@
"Answer t if PATH should be skipped during help file indexing." "Answer t if PATH should be skipped during help file indexing."
(let ((directory (file-name-nondirectory path))) (let ((directory (file-name-nondirectory path)))
(cl-some (lambda (regexp) (string-match regexp directory)) (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) (defun sclang-filter-help-directories (list)
"Remove paths to be skipped from LIST of directories." "Remove paths to be skipped from LIST of directories."
(cl-remove-if (lambda (x) (cl-remove-if (lambda (x)
(or (not (file-directory-p x)) (or (not (file-directory-p x))
(sclang-skip-help-directory-p x))) (sclang-skip-help-directory-p x)))
list)) list))
(defun sclang-directory-files-save (directory &optional full match nosort) (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 (condition-case nil
(directory-files directory full match nosort) (directory-files directory full match nosort)
(error nil))) (error nil)))
@ -435,20 +493,20 @@
;; (defun sclang-extension-help-directories () ;; (defun sclang-extension-help-directories ()
;; "Build a list of help directories for extensions." ;; "Build a list of help directories for extensions."
;; (cl-flet ((flatten (seq) ;; (cl-flet ((flatten (seq)
;; (if (null seq) ;; (if (null seq)
;; seq ;; seq
;; (if (listp seq) ;; (if (listp seq)
;; (reduce 'append (mapcar #'flatten seq)) ;; (reduce 'append (mapcar #'flatten seq))
;; (list seq))))) ;; (list seq)))))
;; (flatten ;; (flatten
;; (mapcar ;; (mapcar
;; (lambda (dir) ;; (lambda (dir)
;; (mapcar ;; (mapcar
;; (lambda (dir) ;; (lambda (dir)
;; (remove-if-not ;; (remove-if-not
;; 'file-directory-p ;; 'file-directory-p
;; (sclang-directory-files-save dir t "^[Hh][Ee][Ll][Pp]$" t))) ;; (sclang-directory-files-save dir t "^[Hh][Ee][Ll][Pp]$" t)))
;; (sclang-filter-help-directories (sclang-directory-files-save dir t)))) ;; (sclang-filter-help-directories (sclang-directory-files-save dir t))))
;; sclang-extension-path)))) ;; sclang-extension-path))))
;; (defun sclang-help-directories () ;; (defun sclang-help-directories ()
@ -463,11 +521,11 @@
"Build a help topic alist from directories in DIRS, with initial RESULT." "Build a help topic alist from directories in DIRS, with initial RESULT."
(if dirs (if dirs
(let* ((files (sclang-directory-files-save (car dirs) t)) (let* ((files (sclang-directory-files-save (car dirs) t))
(topics (remq nil (mapcar 'sclang-help-topic-name files))) (topics (remq nil (mapcar 'sclang-help-topic-name files)))
(new-dirs (sclang-filter-help-directories files))) (new-dirs (sclang-filter-help-directories files)))
(sclang-make-help-topic-alist (sclang-make-help-topic-alist
(append new-dirs (cdr dirs)) (append new-dirs (cdr dirs))
(append topics result))) (append topics result)))
(sort result (lambda (a b) (string< (car a) (car b)))))) (sort result (lambda (a b) (string< (car a) (car b))))))
(defun sclang-index-help-topics () (defun sclang-index-help-topics ()
@ -475,31 +533,28 @@
(interactive) (interactive)
(setq sclang-help-topic-alist nil) (setq sclang-help-topic-alist nil)
(let ((case-fold-search nil) (let ((case-fold-search nil)
(max-specpdl-size 10000) (max-specpdl-size 10000)
(max-lisp-eval-depth 10000)) (max-lisp-eval-depth 10000))
(sclang-message "Indexing help topics ...") (sclang-message "Indexing help topics ...")
(setq sclang-help-topic-alist (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"))) (sclang-message "Indexing help topics ... Done")))
(defun sclang-edit-html-help-file () (defun sclang-edit-html-help-file ()
"Edit the help file associated with the current buffer. "Edit the help file associated with the current buffer.
Switches w3m to edit mode (actually HTML mode)." Switches w3m to edit mode (actually HTML mode)."
(interactive) (interactive)
(w3m-edit-current-url) (w3m-edit-current-url))
)
(defun sclang-edit-help-code () (defun sclang-edit-help-code ()
"Edit the help file to make code variations. "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) (interactive)
(w3m-copy-buffer) (w3m-copy-buffer)
;; (text-mode) ;; (text-mode)
(sclang-mode) (sclang-mode)
(toggle-read-only) (read-only-mode)
(rename-buffer "*SC_Help:CodeEdit*") (rename-buffer "*SC_Help:CodeEdit*"))
)
(defun sclang-edit-help-file () (defun sclang-edit-help-file ()
"Edit the help file associated with the current buffer. "Edit the help file associated with the current buffer.
@ -507,16 +562,16 @@ Either visit file internally (.sc) or start external editor (.rtf)."
(interactive) (interactive)
(if (and (boundp 'sclang-help-file) sclang-help-file) (if (and (boundp 'sclang-help-file) sclang-help-file)
(let ((file sclang-help-file)) (let ((file sclang-help-file))
(if (file-exists-p file) (if (file-exists-p file)
(if (sclang-rtf-file-p file) (if (sclang-rtf-file-p file)
(start-process (sclang-make-buffer-name (format "HelpEditor:%s" file)) (start-process (sclang-make-buffer-name (format "HelpEditor:%s" file))
nil sclang-rtf-editor-program file) nil sclang-rtf-editor-program file)
(find-file file)) (find-file file))
(if (sclang-html-file-p file) (if (sclang-html-file-p file)
(w3m-edit-current-url) (w3m-edit-current-url)
;; (find-file file) ;; (find-file file)
) )
(sclang-message "Help file not found"))) (sclang-message "Help file not found")))
(sclang-message "Buffer has no associated help file"))) (sclang-message "Buffer has no associated help file")))
(defun sclang-help-topic-at-point () (defun sclang-help-topic-at-point ()
@ -524,45 +579,36 @@ Either visit file internally (.sc) or start external editor (.rtf)."
(save-excursion (save-excursion
(with-syntax-table sclang-help-mode-syntax-table (with-syntax-table sclang-help-mode-syntax-table
(let (beg end) (let (beg end)
(skip-syntax-backward "w_") (skip-syntax-backward "w_")
(setq beg (point)) (setq beg (point))
(skip-syntax-forward "w_") (skip-syntax-forward "w_")
(setq end (point)) (setq end (point))
(goto-char beg) (goto-char beg)
(car (assoc (buffer-substring-no-properties beg end) (car (assoc (buffer-substring-no-properties beg end)
sclang-help-topic-alist)))))) sclang-help-topic-alist))))))
(defun sclang-goto-help-browser () (defun sclang-goto-help-browser ()
"Switch to the *w3m* buffer to browse help files" "Switch to the *w3m* buffer to browse help files."
(interactive) (interactive)
(let* ((buffer-name "*w3m*") (let* ((buffer-name "*w3m*")
(buffer (get-buffer buffer-name))) (buffer (get-buffer buffer-name)))
(if buffer (if buffer
(switch-to-buffer buffer) (switch-to-buffer buffer)
;; else ;; else
(let* ((buffer-name "*SC_Help:w3m*") (let* ((buffer-name "*SC_Help:w3m*")
(buffer2 (get-buffer buffer-name))) (buffer2 (get-buffer buffer-name)))
(if buffer2 (if buffer2
(switch-to-buffer buffer2) (switch-to-buffer buffer2)
;; else ;; else
(sclang-find-help "Help") (sclang-find-help "Help"))))
)
)
)
(if buffer (if buffer
(with-current-buffer buffer (with-current-buffer buffer
(rename-buffer "*SC_Help:w3m*") (rename-buffer "*SC_Help:w3m*")
(sclang-help-minor-mode) ;;(setq buffer-read-only false)
;;(setq buffer-read-only false) (sclang-help-minor-mode)))))
)
)
; (if buffer
;
; )
)
)
(defun sclang-find-help (topic) (defun sclang-find-help (topic)
"Find help for TOPIC."
(interactive (interactive
(list (list
(let ((topic (or (and mark-active (buffer-substring-no-properties (region-beginning) (region-end))) (let ((topic (or (and mark-active (buffer-substring-no-properties (region-beginning) (region-end)))
@ -590,17 +636,15 @@ Either visit file internally (.sc) or start external editor (.rtf)."
(set-buffer-modified-p nil))) (set-buffer-modified-p nil)))
(switch-to-buffer buffer)) (switch-to-buffer buffer))
(if (sclang-html-file-p file) (if (sclang-html-file-p file)
(sclang-goto-help-browser)) (sclang-goto-help-browser)))
)
(sclang-message "Help file not found") nil) (sclang-message "Help file not found") nil)
(sclang-message "No help for \"%s\"" topic) nil))) (sclang-message "No help for \"%s\"" topic) nil)))
(defun sclang-open-help-gui () (defun sclang-open-help-gui ()
"Open SCDoc Help Browser" "Open SCDoc Help Browser."
(interactive) (interactive)
(sclang-eval-string (sclang-format "Help.gui")) (sclang-eval-string (sclang-format "Help.gui")))
)
(defvar sclang-scdoc-topics (make-hash-table :size 16385) (defvar sclang-scdoc-topics (make-hash-table :size 16385)
"List of all scdoc topics.") "List of all scdoc topics.")
@ -610,24 +654,23 @@ Either visit file internally (.sc) or start external editor (.rtf)."
(lambda (list-of-symbols) (lambda (list-of-symbols)
(mapcar (lambda (arg) (mapcar (lambda (arg)
(puthash arg nil sclang-scdoc-topics)) (puthash arg nil sclang-scdoc-topics))
list-of-symbols) list-of-symbols)))
))
(defun sclang-find-help-in-gui (topic) (defun sclang-find-help-in-gui (topic)
"Search for topic in SCDoc Help Browser" "Search for TOPIC in Help Browser."
(interactive (interactive
(list (list
(let ((topic (sclang-symbol-at-point))) (let ((topic (sclang-symbol-at-point)))
(completing-read (format "Help topic%s: " (if topic (completing-read
(format " (default %s)" topic) (format "Help topic%s: " (if topic
"")) (format " (default %s)" topic)
sclang-scdoc-topics nil nil nil 'sclang-help-topic-history topic))) ""))
) sclang-scdoc-topics nil nil nil 'sclang-help-topic-history topic))))
(if topic (if topic
(sclang-eval-string (sclang-format "HelpBrowser.openHelpFor(%o)" topic)) (sclang-eval-string
(sclang-eval-string (sclang-format "Help.gui")) (sclang-format "HelpBrowser.openHelpFor(%o)" topic))
) (sclang-eval-string
) (sclang-format "Help.gui"))))
;; ===================================================================== ;; =====================================================================
@ -645,16 +688,18 @@ Either visit file internally (.sc) or start external editor (.rtf)."
(lambda () (lambda ()
(clrhash sclang-scdoc-topics))) (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?? ============ ;; ========= ADDITION for HTML help files?? ============
;; (add-to-list 'auto-mode-alist '("\\.html$" . sclang-help-mode)) ;; (add-to-list 'auto-mode-alist '("\\.html$" . sclang-help-mode))
;; (setq mm-text-html-renderer 'w3m) ;; (setq mm-text-html-renderer 'w3m)
;; (setq mm-inline-text-html-with-images t) ;; (setq mm-inline-text-html-with-images t)
;; (setq mm-inline-text-html-with-w3m-keymap nil) ;; (setq mm-inline-text-html-with-w3m-keymap nil)
;; ===================================================== ;; =====================================================
(sclang-fill-help-syntax-table sclang-help-mode-syntax-table) (sclang-fill-help-syntax-table sclang-help-mode-syntax-table)
(sclang-fill-help-mode-map sclang-help-mode-map) (sclang-fill-help-mode-map sclang-help-mode-map)
(provide 'sclang-help) (provide 'sclang-help)
;; EOF ;;; sclang-help.el ends here

388
el/sclang-interp.el
View file

@ -1,5 +1,9 @@
;; copyright 2003-2005 stefan kersten <steve@k-hornz.de> ;;; sclang-interp.el --- IDE for working with SuperCollider -*- coding: utf-8;
;; ;;
;; Copyright 2003 stefan kersten <steve@k-hornz.de>
;;; License:
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of the ;; published by the Free Software Foundation; either version 2 of the
@ -15,9 +19,12 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
;; USA ;; USA
(eval-when-compile
(require 'sclang-util) ;;; Commentary:
(require 'compile)) ;; SuperCollider interpreter interface
(require 'sclang-util)
(require 'compile)
;; ===================================================================== ;; =====================================================================
;; post buffer access ;; post buffer access
@ -25,6 +32,8 @@
;; FIXME: everything will fail when renaming the post buffer! ;; FIXME: everything will fail when renaming the post buffer!
;;; Code:
(defconst sclang-post-buffer (sclang-make-buffer-name "PostBuffer") (defconst sclang-post-buffer (sclang-make-buffer-name "PostBuffer")
"Name of the SuperCollider process output buffer.") "Name of the SuperCollider process output buffer.")
@ -35,7 +44,7 @@
"Character for highlighting errors (utf-8).") "Character for highlighting errors (utf-8).")
(defconst sclang-parse-error-regexp (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.") "Regular expression matching parse errors during library compilation.")
(defcustom sclang-max-post-buffer-size 0 (defcustom sclang-max-post-buffer-size 0
@ -53,42 +62,44 @@ Default behavior is to only scroll when point is not at end of buffer."
:type 'boolean) :type 'boolean)
(defun sclang-get-post-buffer () (defun sclang-get-post-buffer ()
"Get or create the sclang post buffer."
(get-buffer-create sclang-post-buffer)) (get-buffer-create sclang-post-buffer))
(defmacro with-sclang-post-buffer (&rest body) (defmacro with-sclang-post-buffer (&rest body)
"BODY in the sclang post buffer."
`(with-current-buffer (sclang-get-post-buffer) `(with-current-buffer (sclang-get-post-buffer)
,@body)) ,@body))
;; (defun sclang-post-string (string) ;; (defun sclang-post-string (string)
;; (with-sclang-post-buffer ;; (with-sclang-post-buffer
;; (let ((eobp (mapcar (lambda (w) ;; (let ((eobp (mapcar (lambda (w)
;; (cons w (= (window-point w) (point-max)))) ;; (cons w (= (window-point w) (point-max))))
;; (get-buffer-window-list (current-buffer) nil t)))) ;; (get-buffer-window-list (current-buffer) nil t))))
;; (save-excursion ;; (save-excursion
;; ;; insert STRING into process buffer ;; ;; insert STRING into process buffer
;; (goto-char (point-max)) ;; (goto-char (point-max))
;; (insert string)) ;; (insert string))
;; (dolist (assoc eobp) ;; (dolist (assoc eobp)
;; (when (cdr assoc) ;; (when (cdr assoc)
;; (save-selected-window ;; (save-selected-window
;; (let ((window (car assoc))) ;; (let ((window (car assoc)))
;; (select-window window) ;; (select-window window)
;; (set-window-point window (point-max)) ;; (set-window-point window (point-max))
;; (recenter -1)))))))) ;; (recenter -1))))))))
;; (defun sclang-post-string (string &optional proc) ;; (defun sclang-post-string (string &optional proc)
;; (let* ((buffer (process-buffer proc)) ;; (let* ((buffer (process-buffer proc))
;; (window (display-buffer buffer))) ;; (window (display-buffer buffer)))
;; (with-current-buffer buffer ;; (with-current-buffer buffer
;; (let ((moving (= (point) (process-mark proc)))) ;; (let ((moving (= (point) (process-mark proc))))
;; (save-excursion ;; (save-excursion
;; ;; Insert the text, advancing the process marker. ;; ;; Insert the text, advancing the process marker.
;; (goto-char (process-mark proc)) ;; (goto-char (process-mark proc))
;; (insert string) ;; (insert string)
;; (set-marker (process-mark proc) (point))) ;; (set-marker (process-mark proc) (point)))
;; (when moving ;; (when moving
;; (goto-char (process-mark proc)) ;; (goto-char (process-mark proc))
;; (set-window-point window (process-mark proc))))))) ;; (set-window-point window (process-mark proc)))))))
(defun sclang-show-post-buffer (&optional eob-p) (defun sclang-show-post-buffer (&optional eob-p)
"Show SuperCollider process buffer. "Show SuperCollider process buffer.
@ -99,7 +110,7 @@ If EOB-P is non-nil, positions cursor at end of buffer."
(when eob-p (when eob-p
(goto-char (point-max)) (goto-char (point-max))
(save-selected-window (save-selected-window
(set-window-point window (point-max))))))) (set-window-point window (point-max)))))))
(defun sclang-clear-post-buffer () (defun sclang-clear-post-buffer ()
"Clear the output buffer." "Clear the output buffer."
@ -113,18 +124,19 @@ If EOB-P is non-nil, positions cursor at end of buffer."
;; setup sclang mode ;; setup sclang mode
(sclang-mode) (sclang-mode)
(set (make-local-variable 'font-lock-fontify-region-function) (set (make-local-variable 'font-lock-fontify-region-function)
(lambda (&rest args))) (lambda (&rest args)))
;; setup compilation mode ;; setup compilation mode
(compilation-minor-mode) (compilation-minor-mode)
(set (make-variable-buffer-local 'compilation-error-screen-columns) nil) ;; see elisp docs for `make-variable-buffer-local' and `make-local-variable' use cases
(set (make-variable-buffer-local 'compilation-error-regexp-alist) (set (make-local-variable 'compilation-error-screen-columns) nil)
(cons (list sclang-parse-error-regexp 2 3 4) compilation-error-regexp-alist)) (set (make-local-variable 'compilation-error-regexp-alist)
(set (make-variable-buffer-local 'compilation-parse-errors-function) (cons (list sclang-parse-error-regexp 2 3 4) compilation-error-regexp-alist))
(lambda (limit-search find-at-least) (set (make-local-variable 'compilation-parse-errors-function)
(compilation-parse-errors limit-search find-at-least))) (lambda (limit-search find-at-least)
(set (make-variable-buffer-local 'compilation-parse-errors-filename-function) (compilation-parse-errors limit-search find-at-least)))
(lambda (file-name) (set (make-local-variable 'compilation-parse-errors-filename-function)
file-name))) (lambda (file-name)
file-name)))
(sclang-clear-post-buffer) (sclang-clear-post-buffer)
(sclang-show-post-buffer)) (sclang-show-post-buffer))
@ -190,6 +202,7 @@ If EOB-P is non-nil, positions cursor at end of buffer."
;; ===================================================================== ;; =====================================================================
(defun sclang-get-process () (defun sclang-get-process ()
"Return the current sclang process."
(get-process sclang-process)) (get-process sclang-process))
;; ===================================================================== ;; =====================================================================
@ -218,16 +231,19 @@ If EOB-P is non-nil, positions cursor at end of buffer."
;; initialization ;; initialization
(defun sclang-library-initialized-p () (defun sclang-library-initialized-p ()
"Is sclang library initialized?"
(and (sclang-get-process) (and (sclang-get-process)
sclang-library-initialized-p)) sclang-library-initialized-p))
(defun sclang-on-library-startup () (defun sclang-on-library-startup ()
"Initialize sclang library."
(sclang-message "Initializing library...") (sclang-message "Initializing library...")
(setq sclang-library-initialized-p t) (setq sclang-library-initialized-p t)
(run-hooks 'sclang-library-startup-hook) (run-hooks 'sclang-library-startup-hook)
(sclang-message "Initializing library...done")) (sclang-message "Initializing library...done"))
(defun sclang-on-library-shutdown () (defun sclang-on-library-shutdown ()
"Library shutdown."
(when sclang-library-initialized-p (when sclang-library-initialized-p
(run-hooks 'sclang-library-shutdown-hook) (run-hooks 'sclang-library-shutdown-hook)
(setq sclang-library-initialized-p nil) (setq sclang-library-initialized-p nil)
@ -238,6 +254,7 @@ If EOB-P is non-nil, positions cursor at end of buffer."
;; ===================================================================== ;; =====================================================================
(defun sclang-process-sentinel (proc msg) (defun sclang-process-sentinel (proc msg)
"Process sentinel PROC MSG."
(with-sclang-post-buffer (with-sclang-post-buffer
(goto-char (point-max)) (goto-char (point-max))
(insert (insert
@ -249,47 +266,51 @@ If EOB-P is non-nil, positions cursor at end of buffer."
(sclang-stop-command-process))) (sclang-stop-command-process)))
(defun sclang-process-filter (process string) (defun sclang-process-filter (process string)
"Process filter PROCESS STRING."
(let ((buffer (process-buffer process))) (let ((buffer (process-buffer process)))
(with-current-buffer buffer (with-current-buffer buffer
(when (and (> sclang-max-post-buffer-size 0) (when (and (> sclang-max-post-buffer-size 0)
(> (buffer-size) sclang-max-post-buffer-size)) (> (buffer-size) sclang-max-post-buffer-size))
(erase-buffer)) (erase-buffer))
(let ((move-point (or sclang-auto-scroll-post-buffer (let ((move-point (or sclang-auto-scroll-post-buffer
(= (point) (process-mark process))))) (= (point) (process-mark process)))))
(save-excursion (save-excursion
;; replace mac-roman bullet with unicode character ;; replace mac-roman bullet with unicode character
(subst-char-in-string sclang-bullet-latin-1 sclang-bullet-utf-8 string t) (subst-char-in-string sclang-bullet-latin-1 sclang-bullet-utf-8 string t)
;; insert the text, advancing the process marker. ;; insert the text, advancing the process marker.
(goto-char (process-mark process)) (goto-char (process-mark process))
(insert string) (insert string)
(set-marker (process-mark process) (point))) (set-marker (process-mark process) (point)))
(when move-point (when move-point
(goto-char (process-mark process)) (goto-char (process-mark process))
(walk-windows (walk-windows
(lambda (window) (lambda (window)
(when (eq buffer (window-buffer window)) (when (eq buffer (window-buffer window))
(set-window-point window (process-mark process)))) (set-window-point window (process-mark process))))
nil t)))))) nil t))))))
;; ===================================================================== ;; =====================================================================
;; process startup/shutdown ;; process startup/shutdown
;; ===================================================================== ;; =====================================================================
(defun sclang-memory-option-p (string) (defun sclang-memory-option-p (string)
"Is STRING an sclang memory option?"
(let ((case-fold-search nil)) (let ((case-fold-search nil))
(string-match "^[1-9][0-9]*[km]?$" string))) (string-match "^[1-9][0-9]*[km]?$" string)))
(defun sclang-port-option-p (number) (defun sclang-port-option-p (number)
"Is NUMBER a valid sclang port?"
(and (integerp number) (>= number 0) (<= number #XFFFF))) (and (integerp number) (>= number 0) (<= number #XFFFF)))
(defun sclang-make-options () (defun sclang-make-options ()
"Make options."
(let ((default-directory "")) (let ((default-directory ""))
(nconc (nconc
(when (and sclang-runtime-directory (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))) (list "-d" (expand-file-name sclang-runtime-directory)))
(when (and sclang-library-configuration-file (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))) (list "-l" (expand-file-name sclang-library-configuration-file)))
(when (sclang-memory-option-p sclang-heap-size) (when (sclang-memory-option-p sclang-heap-size)
(list "-m" sclang-heap-size)) (list "-m" sclang-heap-size))
@ -303,6 +324,7 @@ If EOB-P is non-nil, positions cursor at end of buffer."
(list "-s")) (list "-s"))
(list "-iscel")))) (list "-iscel"))))
;;;###autoload (autoload 'sclang-start "sclang" "Start SuperCollider process." t)
(defun sclang-start () (defun sclang-start ()
"Start SuperCollider process." "Start SuperCollider process."
(interactive) (interactive)
@ -313,8 +335,8 @@ If EOB-P is non-nil, positions cursor at end of buffer."
(sclang-start-command-process) (sclang-start-command-process)
(let ((process-connection-type nil)) (let ((process-connection-type nil))
(let ((proc (apply 'start-process (let ((proc (apply 'start-process
sclang-process sclang-post-buffer sclang-process sclang-post-buffer
sclang-program (sclang-make-options)))) sclang-program (sclang-make-options))))
(set-process-sentinel proc 'sclang-process-sentinel) (set-process-sentinel proc 'sclang-process-sentinel)
(set-process-filter proc 'sclang-process-filter) (set-process-filter proc 'sclang-process-filter)
(set-process-coding-system proc 'mule-utf-8 'mule-utf-8) (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) (when (sclang-get-process)
(process-send-eof sclang-process) (process-send-eof sclang-process)
(let ((tries 4) (let ((tries 4)
(i 0)) (i 0))
(while (and (sclang-get-process) (while (and (sclang-get-process)
(< i tries)) (< i tries))
(cl-incf i) (cl-incf i)
(sit-for 0.5)))) (sit-for 0.5))))
(sclang-kill) (sclang-kill)
(sclang-stop-command-process)) (sclang-stop-command-process))
@ -346,8 +368,7 @@ If EOB-P is non-nil, positions cursor at end of buffer."
"Recompile class library." "Recompile class library."
(interactive) (interactive)
(when (sclang-get-process) (when (sclang-get-process)
(process-send-string sclang-process "\x18") (process-send-string sclang-process "\x18")))
))
;; ===================================================================== ;; =====================================================================
;; command process ;; command process
@ -371,58 +392,63 @@ Change this if \"cat\" has a non-standard name or location."
"Subprocess for receiving command results from sclang.") "Subprocess for receiving command results from sclang.")
(defconst sclang-cmd-helper-proc "SCLang Command Helper" (defconst sclang-cmd-helper-proc "SCLang Command Helper"
"Dummy subprocess that will keep the command fifo open for writing "Dummy subprocess that will keep the command fifo open for writing.
so reading does not fail automatically when sclang closes its own This is needed so reading does not automatically fail when sclang
writing end of the fifo") closes its own writing end of the fifo.")
(defvar sclang-command-fifo nil (defvar sclang-command-fifo nil
"FIFO for communicating with the subprocess.") "FIFO for communicating with the subprocess.")
(defun sclang-delete-command-fifo () (defun sclang-delete-command-fifo ()
"Delete the command fifo."
(and sclang-command-fifo (and sclang-command-fifo
(file-exists-p sclang-command-fifo) (file-exists-p sclang-command-fifo)
(delete-file sclang-command-fifo))) (delete-file sclang-command-fifo)))
(defun sclang-release-command-fifo () (defun sclang-release-command-fifo ()
"Release the command fifo."
(sclang-delete-command-fifo) (sclang-delete-command-fifo)
(setq sclang-command-fifo nil)) (setq sclang-command-fifo nil))
(defun sclang-create-command-fifo () (defun sclang-create-command-fifo ()
"Create the command fifo."
(setq sclang-command-fifo (make-temp-name (setq sclang-command-fifo (make-temp-name
(expand-file-name (expand-file-name
"sclang-command-fifo." temporary-file-directory))) "sclang-command-fifo." temporary-file-directory)))
(sclang-delete-command-fifo) (sclang-delete-command-fifo)
(let ((res (call-process sclang-mkfifo-program (let ((res (call-process sclang-mkfifo-program
nil t t nil t t
sclang-command-fifo))) sclang-command-fifo)))
(unless (eq 0 res) (unless (eq 0 res)
(message "SCLang: Couldn't create command fifo") (message "SCLang: Couldn't create command fifo")
(setq sclang-command-fifo nil)))) (setq sclang-command-fifo nil))))
(defun sclang-start-command-process () (defun sclang-start-command-process ()
"Start the command process."
(sclang-create-command-fifo) (sclang-create-command-fifo)
(when sclang-command-fifo (when sclang-command-fifo
;; start the dummy process to keep the fifo open ;; start the dummy process to keep the fifo open
(let ((process-connection-type nil)) (let ((process-connection-type nil))
(let ((proc (start-process-shell-command (let ((proc (start-process-shell-command
sclang-cmd-helper-proc nil sclang-cmd-helper-proc nil
(concat sclang-cat-program " > " sclang-command-fifo)))) (concat sclang-cat-program " > " sclang-command-fifo))))
(set-process-query-on-exit-flag proc nil))) (set-process-query-on-exit-flag proc nil)))
;; sclang gets the fifo path via the environment ;; sclang gets the fifo path via the environment
(setenv "SCLANG_COMMAND_FIFO" sclang-command-fifo) (setenv "SCLANG_COMMAND_FIFO" sclang-command-fifo)
(let ((process-connection-type nil)) (let ((process-connection-type nil))
(let ((proc (start-process (let ((proc (start-process
sclang-command-process nil sclang-command-process nil
sclang-cat-program sclang-command-fifo))) sclang-cat-program sclang-command-fifo)))
(set-process-filter proc 'sclang-command-process-filter) (set-process-filter proc 'sclang-command-process-filter)
;; this is important. use a unibyte stream without eol ;; this is important. use a unibyte stream without eol
;; conversion for communication. ;; conversion for communication.
(set-process-coding-system proc 'no-conversion 'no-conversion) (set-process-coding-system proc 'no-conversion 'no-conversion)
(set-process-query-on-exit-flag proc nil))) (set-process-query-on-exit-flag proc nil)))
(unless (get-process sclang-command-process) (unless (get-process sclang-command-process)
(message "SCLang: Couldn't start command process")))) (message "SCLang: Couldn't start command process"))))
(defun sclang-stop-command-process () (defun sclang-stop-command-process ()
"Stop the command process."
(when (get-process sclang-cmd-helper-proc) (when (get-process sclang-cmd-helper-proc)
(kill-process sclang-cmd-helper-proc) (kill-process sclang-cmd-helper-proc)
(delete-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.") "Unprocessed command process output.")
(defun sclang-command-process-filter (proc string) (defun sclang-command-process-filter (proc string)
"Command process filter PROC STRING."
(when sclang-command-process-previous (when sclang-command-process-previous
(setq string (concat sclang-command-process-previous string))) (setq string (concat sclang-command-process-previous string)))
(let (end) (let (end)
(while (and (> (length string) 3) (while (and (> (length string) 3)
(>= (length string) (>= (length string)
(setq end (+ 4 (sclang-string-to-int32 string))))) (setq end (+ 4 (sclang-string-to-int32 string)))))
(sclang-handle-command-result (sclang-handle-command-result
(read (decode-coding-string (substring string 4 end) 'utf-8))) (read (decode-coding-string (substring string 4 end) 'utf-8)))
(setq string (substring string end)))) (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 ;; symbol property: sclang-command-handler
(defun sclang-set-command-handler (symbol function) (defun sclang-set-command-handler (symbol function)
"Set command handler SYMBOL to FUNCTION."
(put symbol 'sclang-command-handler function)) (put symbol 'sclang-command-handler function))
(defun sclang-perform-command (symbol &rest args) (defun sclang-perform-command (symbol &rest args)
"Eval command SYMBOL with ARGS."
(sclang-eval-string (sclang-format (sclang-eval-string (sclang-format
"Emacs.lispPerformCommand(%o, %o, true)" "Emacs.lispPerformCommand(%o, %o, true)"
symbol args))) symbol args)))
(defun sclang-perform-command-no-result (symbol &rest args) (defun sclang-perform-command-no-result (symbol &rest args)
"Eval command SYMBOL with ARGS. No result."
(sclang-eval-string (sclang-format (sclang-eval-string (sclang-format
"Emacs.lispPerformCommand(%o, %o, false)" "Emacs.lispPerformCommand(%o, %o, false)"
symbol args))) symbol args)))
(defun sclang-default-command-handler (fun arg) (defun sclang-default-command-handler (fun arg)
"Default command handler. "Default command handler for FUN with ARG.
Displays short message on error." Displays short message on error."
(condition-case nil (condition-case err
(funcall fun arg) (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) (defun sclang-debug-command-handler (fun arg)
"Debugging command handler. "Debugging command handler for FUN with ARG.
Enters debugger on error." Enters debugger on error."
(let ((debug-on-error t) (let ((debug-on-error t)
(debug-on-signal t)) (debug-on-signal t))
(funcall fun arg))) (funcall fun arg)))
(defvar sclang-command-handler 'sclang-default-command-handler (defvar sclang-command-handler 'sclang-default-command-handler
"Function called when handling command result.") "Function called when handling command result.")
(defun sclang-toggle-debug-command-handler (&optional arg) (defun sclang-toggle-debug-command-handler (&optional arg)
"Toggle debugging of command handler. "Toggle debugging of command handler (or set with ARG).
With arg, activate debugging iff arg is positive." Activate debugging iff ARG is positive."
(interactive "P") (interactive "P")
(setq sclang-command-handler (setq sclang-command-handler
(if (or (and arg (> arg 0)) (if (or (and arg (> arg 0))
(eq sclang-command-handler 'sclang-debug-command-handler)) (eq sclang-command-handler 'sclang-debug-command-handler))
'sclang-default-command-handler 'sclang-default-command-handler
'sclang-default-command-handler)) 'sclang-debug-command-handler))
(sclang-message "Command handler debugging %s." (sclang-message "Command handler debugging %s."
(if (eq sclang-command-handler 'sclang-debug-command-handler) (if (eq sclang-command-handler 'sclang-debug-command-handler)
"enabled" "enabled"
"disabled"))) "disabled")))
(defun sclang-handle-command-result (list) (defun sclang-handle-command-result (list)
"Handle command result LIST."
(condition-case nil (condition-case nil
(let ((fun (get (nth 0 list) 'sclang-command-handler)) (let ((fun (get (nth 0 list) 'sclang-command-handler))
(arg (nth 1 list)) (arg (nth 1 list))
(id (nth 2 list))) (id (nth 2 list)))
(when (functionp fun) (when (functionp fun)
(let ((res (funcall sclang-command-handler fun arg))) (let ((res (funcall sclang-command-handler fun arg)))
(when id (when id
(sclang-eval-string (sclang-eval-string
(sclang-format "Emacs.lispHandleCommandResult(%o, %o)" id res)))))) (sclang-format "Emacs.lispHandleCommandResult(%o, %o)" id res))))))
(error nil))) (error nil)))
;; ===================================================================== ;; =====================================================================
@ -520,61 +552,69 @@ With arg, activate debugging iff arg is positive."
:type 'boolean) :type 'boolean)
(defun sclang-send-string (token string &optional force) (defun sclang-send-string (token string &optional force)
"Send TOKEN STRING to sclang (optionally FORCE)."
(let ((proc (sclang-get-process))) (let ((proc (sclang-get-process)))
(when (and proc (or (sclang-library-initialized-p) force)) (when (and proc (or (sclang-library-initialized-p) force))
(process-send-string proc (concat string token)) (process-send-string proc (concat string token))
string))) string)))
(defun sclang-eval-string (string &optional print-p) (defun sclang-eval-string (string &optional print-p)
"Send STRING to the sclang process for evaluation and print the result "Evaluate STRING with sclang and print the result if PRINT-P is non-nil.
if PRINT-P is non-nil. Return STRING if successful, otherwise nil." Return STRING if successful, otherwise nil."
(sclang-send-string (sclang-send-string
(if print-p sclang-token-interpret-print-cmd-line sclang-token-interpret-cmd-line) (if print-p sclang-token-interpret-print-cmd-line sclang-token-interpret-cmd-line)
string)) string))
(defun sclang-eval-expression (string &optional silent-p) (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") (interactive "sEval: \nP")
(sclang-eval-string string (not silent-p))) (sclang-eval-string string (not silent-p)))
(defun sclang-eval-line (&optional 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") (interactive "P")
(let ((string (sclang-line-at-point))) (let ((string (sclang-line-at-point)))
(when string (when string
(sclang-eval-string string (not silent-p))) (sclang-eval-string string (not silent-p)))
(and sclang-eval-line-forward (and sclang-eval-line-forward
(/= (line-end-position) (point-max)) (/= (line-end-position) (point-max))
(forward-line 1)) (forward-line 1))
string)) string))
(defun sclang-eval-region (&optional silent-p) (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") (interactive "P")
(sclang-eval-string (sclang-eval-string
(buffer-substring-no-properties (region-beginning) (region-end)) (buffer-substring-no-properties (region-beginning) (region-end))
(not silent-p))) (not silent-p)))
(defun sclang-eval-region-or-line (&optional 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") (interactive "P")
(if (and transient-mark-mode mark-active) (if (and transient-mark-mode mark-active)
(sclang-eval-region silent-p) (sclang-eval-region silent-p)
(sclang-eval-line silent-p))) (sclang-eval-line silent-p)))
(defun sclang-eval-defun (&optional silent-p) (defun sclang-eval-defun (&optional silent-p)
"Evaluate current function definition (suppress output if SILENT-P is non-nil)."
(interactive "P") (interactive "P")
(let ((string (sclang-defun-at-point))) (let ((string (sclang-defun-at-point)))
(when (and string (string-match "^(" string)) (when (and string (string-match "^(" string))
(sclang-eval-string string (not silent-p)) (sclang-eval-string string (not silent-p))
string))) 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) (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") (interactive "P")
(save-excursion (save-excursion
(mark-whole-buffer)
(sclang-eval-string (sclang-eval-string
(buffer-substring-no-properties (region-beginning) (region-end)) (buffer-substring-no-properties (point-min) (point-max))
(not silent-p)))) (not silent-p))))
(defvar sclang-eval-results nil (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))) (lambda (arg) (push arg sclang-eval-results)))
(defun sclang-eval-sync (string) (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))) (let ((proc (get-process sclang-command-process)))
(if (and (processp proc) (eq (process-status proc) 'run)) (if (and (processp proc) (eq (process-status proc) 'run))
(let ((time (current-time)) (tick 10000) elt) (let ((time (current-time)) (tick 10000) elt)
(sclang-perform-command 'evalSCLang string time) (sclang-perform-command 'evalSCLang string time)
(while (and (> (cl-decf tick) 0) (while (and (> (cl-decf tick) 0)
(not (setq elt (assoc time sclang-eval-results)))) (not (setq elt (assoc time sclang-eval-results))))
(accept-process-output proc 0 100)) (accept-process-output proc 0 100))
(if elt (if elt
(prog1 (if (eq (nth 1 elt) 'ok) (prog1 (if (eq (nth 1 elt) 'ok)
(nth 2 elt) (nth 2 elt)
(setq sclang-eval-results (delq elt sclang-eval-results)) (setq sclang-eval-results (delq elt sclang-eval-results))
(signal 'sclang-error (nth 2 elt))) (signal 'sclang-error (nth 2 elt)))
(setq sclang-eval-results (delq elt sclang-eval-results))) (setq sclang-eval-results (delq elt sclang-eval-results)))
(error "SCLang sync eval timeout"))) (error "SCLang sync eval timeout")))
(error "SCLang Command process not running")))) (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 () ;; (defun sclang-grep-help-files ()
;; (interactive) ;; (interactive)
;; (let ((sclang-grep-prompt "Search help files: ") ;; (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))) ;; (call-interactively 'sclang-grep-files)))
;; (defvar sclang-grep-history nil) ;; (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) ;; (defun sclang-grep-files (regexp)
;; (interactive ;; (interactive
;; (let ((grep-default (or (when current-prefix-arg (sclang-symbol-at-point)) ;; (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 ;; (list (read-from-minibuffer sclang-grep-prompt
;; grep-default ;; grep-default
;; nil nil 'sclang-grep-history)))) ;; nil nil 'sclang-grep-history))))
;; (grep-compute-defaults) ;; (grep-compute-defaults)
;; (grep (concat grep-program ;; (grep (concat grep-program
;; " -n" ;; " -n"
;; (and sclang-grep-case-fold-search " -i") ;; (and sclang-grep-case-fold-search " -i")
;; " -e" regexp ;; " -e" regexp
;; " " (mapconcat 'shell-quote-argument sclang-grep-files " ")))) ;; " " (mapconcat 'shell-quote-argument sclang-grep-files " "))))
;; ===================================================================== ;; =====================================================================
;; workspace ;; 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")) (defconst sclang-workspace-buffer (sclang-make-buffer-name "Workspace"))
(defun sclang-fill-workspace-mode-map (map) (defun sclang-fill-workspace-mode-map (map)
"Fill the workspace keymap MAP."
(define-key map "\C-c}" 'bury-buffer)) (define-key map "\C-c}" 'bury-buffer))
(defun sclang-switch-to-workspace () (defun sclang-switch-to-workspace ()
"Switch to SuperCollider workspace buffer."
(interactive) (interactive)
(let ((buffer (get-buffer sclang-workspace-buffer))) (let ((buffer (get-buffer sclang-workspace-buffer)))
(unless buffer (unless buffer
(setq buffer (get-buffer-create sclang-workspace-buffer)) (setq buffer (get-buffer-create sclang-workspace-buffer))
(with-current-buffer buffer (with-current-buffer buffer
(sclang-mode) (sclang-mode)
(let ((map (make-sparse-keymap))) ;; why a buffer local keymap?
(set-keymap-parent map sclang-mode-map) (let ((map (make-sparse-keymap)))
(sclang-fill-workspace-mode-map map) (set-keymap-parent map sclang-mode-map)
(use-local-map map)) (sclang-fill-workspace-mode-map map)
(let ((line (concat "// " (make-string 69 ?=) "\n"))) (use-local-map map))
(insert line) (let ((line (concat "// " (make-string 69 ?=) "\n")))
(insert "// SuperCollider Workspace\n") (insert line)
(insert line) (insert "// SuperCollider Workspace\n")
;; (insert "// using HTML Help: C-c C-h as usual, then switch to w3m buffer\n") (insert line)
;; (insert "// and do M-x sclang-minor-mode in order te enable sclang code execution\n") ;; (insert "// using HTML Help: C-c C-h as usual, then switch to w3m buffer\n")
;; (insert line) ;; (insert "// and do M-x sclang-minor-mode in order te enable sclang code execution\n")
(insert "\n")) ;; (insert line)
(set-buffer-modified-p nil) (insert "\n"))
;; cwd to sclang-runtime-directory (set-buffer-modified-p nil)
(if (and sclang-runtime-directory ;; cwd to sclang-runtime-directory
(file-directory-p sclang-runtime-directory)) (if (and sclang-runtime-directory
(setq default-directory sclang-runtime-directory)))) (file-directory-p sclang-runtime-directory))
(setq default-directory sclang-runtime-directory))))
(switch-to-buffer buffer))) (switch-to-buffer buffer)))
(add-hook 'sclang-library-startup-hook (add-hook 'sclang-library-startup-hook
(lambda () (and sclang-show-workspace-on-startup (lambda () (and sclang-show-workspace-on-startup
(sclang-switch-to-workspace)))) (sclang-switch-to-workspace))))
;; ===================================================================== ;; =====================================================================
;; language control ;; language control
;; ===================================================================== ;; =====================================================================
(defun sclang-main-run () (defun sclang-main-run ()
"Run sclang process."
(interactive) (interactive)
(sclang-eval-string "thisProcess.run")) (sclang-eval-string "thisProcess.run"))
(defun sclang-main-stop () (defun sclang-main-stop ()
"Stop sclang process."
(interactive) (interactive)
(sclang-eval-string "thisProcess.stop")) (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 command line switches
(add-to-list 'command-switch-alist (add-to-list 'command-switch-alist
(cons "-sclang" (cons "-sclang"
(lambda (switch) (lambda (switch)
(sclang-start)))) (sclang-start))))
(add-to-list 'command-switch-alist (add-to-list 'command-switch-alist
(cons "-sclang-debug" (cons "-sclang-debug"
(lambda (switch) (lambda (switch)
(sclang-toggle-debug-command-handler 1)))) (sclang-toggle-debug-command-handler 1))))
(add-to-list 'command-switch-alist (add-to-list 'command-switch-alist
(cons "-scmail" (cons "-scmail"
(lambda (switch) (lambda (switch)
(sclang-start) (sclang-start)
(when command-line-args-left (when command-line-args-left
(let ((file (pop command-line-args-left))) (let ((file (pop command-line-args-left)))
(with-current-buffer (get-buffer-create sclang-workspace-buffer) (with-current-buffer (get-buffer-create sclang-workspace-buffer)
(and (file-exists-p file) (insert-file-contents file)) (and (file-exists-p file) (insert-file-contents file))
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(sclang-mode) (sclang-mode)
(switch-to-buffer (current-buffer)))))))) (switch-to-buffer (current-buffer))))))))
(provide 'sclang-interp) (provide 'sclang-interp)
;; EOF ;;; sclang-interp.el ends here

26
el/sclang-keys.el
View file

@ -1,5 +1,9 @@
;; copyright 2003 stefan kersten <steve@k-hornz.de> ;;; sclang-keys.el --- IDE for working with SuperCollider -*- coding: utf-8;
;; ;;
;; Copyright 2003 stefan kersten <steve@k-hornz.de>
;;; License:
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of the ;; 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 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
;; USA ;; 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)) ;; (defvar sclang-key-table (make-char-table 'foo))
;; (defun sclang-define-key (char beg end) ;; (defun sclang-define-key (char beg end)
@ -25,10 +38,9 @@
;; (defun sclang-execute-key (char) ;; (defun sclang-execute-key (char)
;; (sclang-eval-string (sclang-format "Emacs.executeKey(%o)" char))) ;; (sclang-eval-string (sclang-format "Emacs.executeKey(%o)" char)))
(eval-and-compile (require 'sclang-util)
(require 'sclang-interp))
(defun sclang-read-keys () (defun sclang-read-keys ()
"Read and send keys between Emacs and SuperCollider."
(interactive) (interactive)
(let (char) (let (char)
(clear-this-command-keys) (clear-this-command-keys)
@ -36,8 +48,10 @@
(setq char (read-event)) (setq char (read-event))
(clear-this-command-keys) (clear-this-command-keys)
(when (characterp char) (when (characterp char)
(message "%s (%d)" (char-to-string char) char) (message "%s (%d)" (char-to-string char) char)
(sclang-eval-string (format "Emacs.keys.at(%d).value(%d)" char char)))))) (sclang-eval-string (format "Emacs.keys.at(%d).value(%d)" char char))))))
;; EOF
(provide 'sclang-keys)
;;; sclang-keys.el ends here

729
el/sclang-language.el
View file

File diff suppressed because it is too large Load diff

13
el/sclang-menu.el
View file

@ -1,5 +1,9 @@
;; copyright 2003 stefan kersten <steve@k-hornz.de> ;;; sclang-menu.el --- IDE for working with SuperCollider -*- coding: utf-8;
;; ;;
;; Copyright 2003 stefan kersten <steve@k-hornz.de>
;;; License:
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of the ;; 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 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
;; USA ;; USA
;;; Commentary:
;; Menus
;;; Code:
;; (sclang-set-command-handler ;; (sclang-set-command-handler
;; '_updateMenu ;; '_updateMenu
;; (lambda (arg) ;; (lambda (arg)
;; (message "menu: %s" arg))) ;; (message "menu: %s" arg)))
(provide 'sclang-menu) (provide 'sclang-menu)
;;; sclang-menu.el ends here

93
el/sclang-minor-mode.el
View file

@ -1,7 +1,9 @@
;;; sclang-minor-mode for use in help files ;;; sclang-minor-mode.el --- IDE for working with SuperCollider -*- coding: utf-8;
;;; SuperCollider ;;
;;; (c) 2007, Marije Baalman - nescivi <nescivi@gmail.com> ;; Copyright (c) 2007, Marije Baalman - nescivi <nescivi@gmail.com>
;;;
;;; License:
;;; This program is free software; you can redistribute it and/or modify ;;; 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 ;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or ;;; the Free Software Foundation; either version 2 of the License, or
@ -16,11 +18,14 @@
;;; along with this program; if not, write to the Free Software ;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(eval-when-compile
(require 'sclang-util)
(require 'sclang-mode)
)
;;; Commentary:
;;
;; sclang-minor-mode for use in help files
;;; Code:
(require 'sclang-util)
(require 'sclang-mode)
(easy-mmode-define-minor-mode sclang-minor-mode (easy-mmode-define-minor-mode sclang-minor-mode
"Toggle sclang-minor-mode. "Toggle sclang-minor-mode.
@ -28,53 +33,55 @@ With no argument, this command toggles the mode.
Non-null prefix argument turns on the mode. Non-null prefix argument turns on the mode.
Null prefix argument turns off the mode. Null prefix argument turns off the mode.
When sclang-minor-mode is enabled, you can execute When sclang-minor-mode is enabled, you can use the key sequences
sclang code with the normal command C-c C-c and C-c C-d." \\<sclang-minor-mode-map>\\[sclang-eval-region-or-line] or \\<sclang-minor-mode-map>\\[sclang-eval-region] to eval sclang code."
;; The initial value. ;; The initial value.
nil :init-value nil
;; The indicator for the mode line. ;; The indicator for the mode line.
" sclang" :lighter " sclang"
;; The minor mode bindings. ;; The minor mode bindings.
'(("\C-c\C-c" . sclang-eval-region-or-line) :keymap '(("\C-c\C-c" . sclang-eval-region-or-line)
("\C-c\C-d" . sclang-eval-region) ("\C-c\C-d" . sclang-eval-region)
("\C-\M-x" . sclang-eval-defun) ("\C-\M-x" . sclang-eval-defun)
("\C-c\C-h" . sclang-find-help) ("\C-c\C-h" . sclang-find-help)
("\C-\M-h" . sclang-goto-help-browser) ("\C-\M-h" . sclang-goto-help-browser)
("\C-c\C-s" . sclang-main-stop) ("\C-c\C-s" . sclang-main-stop)
("\C-c\C-k" . sclang-edit-dev-source) ("\C-c\C-k" . sclang-edit-dev-source)))
))
(provide 'sclang-minor-mode) (provide 'sclang-minor-mode)
(easy-mmode-define-minor-mode sclang-help-minor-mode (easy-mmode-define-minor-mode sclang-help-minor-mode
"Toggle sclang-minor-mode. "Toggle sclang-minor-mode.
With no argument, this command toggles the mode. With no argument, this command toggles the mode.
Non-null prefix argument turns on the mode. Non-null prefix argument turns on the mode.
Null prefix argument turns off the mode. Null prefix argument turns off the mode.
When sclang-help-minor-mode is enabled, you can execute When sclang-help-minor-mode is enabled, you can use the key sequences
sclang code with the normal command C-c C-c and C-c C-d." \\<sclang-minor-mode-map>\\[sclang-eval-region-or-line] or \\<sclang-minor-mode-map>\\[sclang-eval-region] to eval sclang code."
;; The initial value. ;; The initial value.
nil :init-value nil
;; The indicator for the mode line. ;; The indicator for the mode line.
" sclang-help" :lighter " sclang-help"
;; The minor mode bindings. ;; The minor mode bindings.
'(("\C-c\C-c" . sclang-eval-region-or-line) :keymap '(("\C-c\C-c" . sclang-eval-region-or-line)
("\C-c\C-d" . sclang-eval-region) ("\C-c\C-d" . sclang-eval-region)
("\C-\M-x" . sclang-eval-defun) ("\C-\M-x" . sclang-eval-defun)
("\C-c\C-h" . sclang-find-help) ("\C-c\C-h" . sclang-find-help)
("\C-c\C-s" . sclang-main-stop) ("\C-c\C-s" . sclang-main-stop)
("\C-c\C-v" . sclang-edit-html-help-file) ("\C-c\C-v" . sclang-edit-html-help-file)
("E" . sclang-edit-help-code) ("E" . sclang-edit-help-code)
("\C-c\C-k" . sclang-edit-dev-source) ("\C-c\C-k" . sclang-edit-dev-source)))
))
(provide 'sclang-help-minor-mode) (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-help-minor-mode-hook 'sclang-minor-hooks)
(add-hook 'sclang-minor-mode-hook 'sclang-minor-hooks) (add-hook 'sclang-minor-mode-hook 'sclang-minor-hooks)
(defun sclang-minor-hooks () ;;; sclang-minor-mode.el ends here
(sclang-init-document)
(sclang-make-document)
)

457
el/sclang-mode.el
View file

@ -1,5 +1,9 @@
;; copyright 2003-2005 stefan kersten <steve@k-hornz.de> ;;; sclang-mode.el --- IDE for working with SuperCollider -*- coding: utf-8;
;; ;;
;; Copyright 2003 stefan kersten <steve@k-hornz.de>
;;; License:
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of the ;; published by the Free Software Foundation; either version 2 of the
@ -15,18 +19,25 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
;; USA ;; USA
;;; Commentary:
;; sclang mode
;;; Code:
(require 'cl-lib) (require 'cl-lib)
(eval-when-compile ;; Keep byte-compiler happy by declaring external functions and variables.
(require 'font-lock) (declare-function company-mode "ext:company")
(require 'sclang-util)) (defvar company-backends)
(require 'font-lock)
(require 'sclang-util)
(require 'sclang-interp) (require 'sclang-interp)
(require 'sclang-language) (require 'sclang-language)
(require 'sclang-dev) (require 'sclang-dev)
(defun sclang-fill-syntax-table (table) (defun sclang-fill-syntax-table (table)
;; string "Fill the sclang syntax TABLE."
(modify-syntax-entry ?\" "\"" table) (modify-syntax-entry ?\" "\"" table)
(modify-syntax-entry ?\' "\"" table) ; no string syntax class for single quotes (modify-syntax-entry ?\' "\"" table) ; no string syntax class for single quotes
;; expression prefix ;; expression prefix
@ -70,87 +81,88 @@
table) table)
(defun sclang-mode-make-menu (title) (defun sclang-mode-make-menu (title)
"Make mode menu with TITLE."
(easy-menu-create-menu (easy-menu-create-menu
title title
'( '(["Start Interpreter" sclang-start :included (not (sclang-library-initialized-p))]
["Start Interpreter" sclang-start :included (not (sclang-library-initialized-p))] ["Restart Interpreter" sclang-start :included (sclang-library-initialized-p)]
["Restart Interpreter" sclang-start :included (sclang-library-initialized-p)] ["Recompile Class Library" sclang-recompile :included (sclang-library-initialized-p)]
["Recompile Class Library" sclang-recompile :included (sclang-library-initialized-p)] ["Stop Interpreter" sclang-stop :included (sclang-get-process)]
["Stop Interpreter" sclang-stop :included (sclang-get-process)] ["Kill Interpreter" sclang-kill :included (sclang-get-process)]
["Kill Interpreter" sclang-kill :included (sclang-get-process)] "-"
"-" ["Show Post Buffer" sclang-show-post-buffer]
["Show Post Buffer" sclang-show-post-buffer] ["Clear Post Buffer" sclang-clear-post-buffer]
["Clear Post Buffer" sclang-clear-post-buffer] "-"
"-" ["Switch To Workspace" sclang-switch-to-workspace]
["Switch To Workspace" sclang-switch-to-workspace] "-"
"-" ["Evaluate Region" sclang-eval-region]
["Evaluate Region" sclang-eval-region] ["Evaluate Line" sclang-eval-region-or-line]
["Evaluate Line" sclang-eval-region-or-line] ["Evaluate Defun" sclang-eval-defun]
["Evaluate Defun" sclang-eval-defun] ["Evaluate Expression ..." sclang-eval-expression]
["Evaluate Expression ..." sclang-eval-expression] ["Evaluate Document" sclang-eval-document]
["Evaluate Document" sclang-eval-document] "-"
"-" ["Find Definitions ..." sclang-find-definitions]
["Find Definitions ..." sclang-find-definitions] ["Find References ..." sclang-find-references]
["Find References ..." sclang-find-references] ["Pop Mark" sclang-pop-definition-mark]
["Pop Mark" sclang-pop-definition-mark] ["Show Method Arguments" sclang-show-method-args]
["Show Method Arguments" sclang-show-method-args] ["Complete keyword" sclang-complete-symbol]
["Complete keyword" sclang-complete-symbol] ["Dump Interface" sclang-dump-interface]
["Dump Interface" sclang-dump-interface] ["Dump Full Interface" sclang-dump-full-interface]
["Dump Full Interface" sclang-dump-full-interface] "-"
"-" ["Index Help Topics" sclang-index-help-topics]
["Index Help Topics" sclang-index-help-topics] ["Find Help ..." sclang-find-help]
["Find Help ..." sclang-find-help] ["Switch to Help Browser" sclang-goto-help-browser]
["Switch to Help Browser" sclang-goto-help-browser] ["Open Help GUI" sclang-open-help-gui]
["Open Help GUI" sclang-open-help-gui] "-"
"-" ["Run Main" sclang-main-run]
["Run Main" sclang-main-run] ["Stop Main" sclang-main-stop]
["Stop Main" sclang-main-stop] ["Show Server Panels" sclang-show-server-panel])))
["Show Server Panels" sclang-show-server-panel]
)))
(defun sclang-fill-mode-map (map) (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 ;; process control
(define-key map "\C-c\C-l" 'sclang-recompile) (define-key map "\C-c\C-l" 'sclang-recompile)
(define-key map "\C-c\C-o" 'sclang-start) (define-key map "\C-c\C-o" 'sclang-start)
;; post buffer control ;; post buffer control
(define-key map "\C-c<" 'sclang-clear-post-buffer) (define-key map "\C-c<" 'sclang-clear-post-buffer)
(define-key map "\C-c>" 'sclang-show-post-buffer) (define-key map "\C-c>" 'sclang-show-post-buffer)
;; workspace access ;; 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 ;; code evaluation
(define-key map "\C-c\C-c" 'sclang-eval-region-or-line) (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-c\C-d" 'sclang-eval-region)
(define-key map "\C-\M-x" 'sclang-eval-defun) (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-e" 'sclang-eval-expression)
(define-key map "\C-c\C-f" 'sclang-eval-document) (define-key map "\C-c\C-f" 'sclang-eval-document)
;; language information ;; language information
(define-key map "\C-c\C-n" 'sclang-complete-symbol) (define-key map "\C-c\C-n" 'sclang-complete-symbol)
(define-key map "\M-\t" 'sclang-complete-symbol) (define-key map "\C-c:" 'sclang-find-definitions)
(define-key map "\C-c:" 'sclang-find-definitions) (define-key map "\C-c;" 'sclang-find-references)
(define-key map "\C-c;" 'sclang-find-references) (define-key map "\C-c}" 'sclang-pop-definition-mark)
(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\C-m" 'sclang-show-method-args) (define-key map "\C-c{" 'sclang-dump-full-interface)
(define-key map "\C-c{" 'sclang-dump-full-interface) (define-key map "\C-c[" 'sclang-dump-interface)
(define-key map "\C-c[" 'sclang-dump-interface)
;; documentation access ;; documentation access
(define-key map "\C-c\C-h" 'sclang-find-help) (define-key map "\C-c\C-?f" 'sclang-find-help)
(define-key map "\C-\M-h" 'sclang-goto-help-browser) (define-key map "\C-c\C-?g" 'sclang-goto-help-browser)
(define-key map "\C-c\C-y" 'sclang-open-help-gui) (define-key map "" 'sclang-open-help-gui)
(define-key map "\C-ch" 'sclang-find-help-in-gui) (define-key map "" 'sclang-find-help-in-gui)
;; language control ;; language control
(define-key map "\C-c\C-r" 'sclang-main-run) (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-s" 'sclang-main-stop)
(define-key map "\C-c\C-p" 'sclang-show-server-panel) (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-k" 'sclang-edit-dev-source)
;; electric characters ;; 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-brace)
(define-key map "]" 'sclang-electric-brace) (define-key map "]" 'sclang-electric-brace)
(define-key map "/" 'sclang-electric-slash) (define-key map "/" 'sclang-electric-slash)
(define-key map "*" 'sclang-electric-star) (define-key map "*" 'sclang-electric-star)
;; menu ;; menu
(let ((title "SCLang")) (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 ;; return map
map) map)
@ -159,8 +171,7 @@
;; ===================================================================== ;; =====================================================================
(defconst sclang-font-lock-keyword-list (defconst sclang-font-lock-keyword-list
'( '("arg"
"arg"
"classvar" "classvar"
"const" "const"
"super" "super"
@ -170,22 +181,18 @@
"thisMethod" "thisMethod"
"thisProcess" "thisProcess"
"thisThread" "thisThread"
"var" "var")
)
"*List of keywords to highlight in SCLang mode.") "*List of keywords to highlight in SCLang mode.")
(defconst sclang-font-lock-builtin-list (defconst sclang-font-lock-builtin-list
'( '("false"
"false"
"inf" "inf"
"nil" "nil"
"true" "true")
)
"*List of builtins to highlight in SCLang mode.") "*List of builtins to highlight in SCLang mode.")
(defconst sclang-font-lock-method-list (defconst sclang-font-lock-method-list
'( '("ar"
"ar"
"for" "for"
"forBy" "forBy"
"if" "if"
@ -193,19 +200,16 @@
"kr" "kr"
"tr" "tr"
"loop" "loop"
"while" "while")
)
"*List of methods to highlight in SCLang mode.") "*List of methods to highlight in SCLang mode.")
(defconst sclang-font-lock-error-list (defconst sclang-font-lock-error-list
'( '("die"
"die"
"error" "error"
"exit" "exit"
"halt" "halt"
"verboseHalt" "verboseHalt"
"warn" "warn")
)
"*List of methods signalling errors or warnings.") "*List of methods signalling errors or warnings.")
(defvar sclang-font-lock-class-keywords nil) (defvar sclang-font-lock-class-keywords nil)
@ -223,27 +227,27 @@
"Default expressions to highlight in SCLang mode.") "Default expressions to highlight in SCLang mode.")
(defconst sclang-font-lock-defaults '((sclang-font-lock-keywords (defconst sclang-font-lock-defaults '((sclang-font-lock-keywords
sclang-font-lock-keywords-1 sclang-font-lock-keywords-1
sclang-font-lock-keywords-2 sclang-font-lock-keywords-2
sclang-font-lock-keywords-3 sclang-font-lock-keywords-3)
) nil nil
nil nil nil
nil beginning-of-defun))
beginning-of-defun
))
(defun sclang-font-lock-syntactic-face (state) (defun sclang-font-lock-syntactic-face (state)
"Return font lock face for STATE."
(cond ((eq (nth 3 state) ?') (cond ((eq (nth 3 state) ?')
;; symbol ;; symbol
'font-lock-constant-face) 'font-lock-constant-face)
((nth 3 state) ((nth 3 state)
;; string ;; string
'font-lock-string-face) 'font-lock-string-face)
((nth 4 state) ((nth 4 state)
;; comment ;; comment
'font-lock-comment-face))) 'font-lock-comment-face)))
(defun sclang-font-lock-class-keyword-matcher (limit) (defun sclang-font-lock-class-keyword-matcher (limit)
"Font lock class keywords up to LIMIT."
(let ((regexp (concat "\\<" sclang-class-name-regexp "\\>")) (let ((regexp (concat "\\<" sclang-class-name-regexp "\\>"))
(case-fold-search nil) (case-fold-search nil)
(continue t) (continue t)
@ -260,23 +264,23 @@
res)) res))
(defun sclang-set-font-lock-keywords () (defun sclang-set-font-lock-keywords ()
"Set font lock keywords."
(setq (setq
;; level 1 ;; level 1
sclang-font-lock-keywords-1 sclang-font-lock-keywords-1
(list (list
;; keywords ;; keywords
(cons (regexp-opt sclang-font-lock-keyword-list 'words) (cons (regexp-opt sclang-font-lock-keyword-list 'words)
'font-lock-keyword-face) 'font-lock-keyword-face)
;; builtins ;; builtins
(cons (regexp-opt sclang-font-lock-builtin-list 'words) (cons (regexp-opt sclang-font-lock-builtin-list 'words)
'font-lock-builtin-face) 'font-lock-builtin-face)
;; pi is a special case ;; pi is a special case
(cons "\\<\\([0-9]+\\(\\.\\)\\)pi\\>" 'font-lock-builtin-face) (cons "\\<\\([0-9]+\\(\\.\\)\\)pi\\>" 'font-lock-builtin-face)
;; constants ;; constants
(cons "\\s/\\s\\?." 'font-lock-constant-face) ; characters (cons "\\s/\\s\\?." 'font-lock-constant-face) ; characters
(cons (concat "\\\\\\(" sclang-symbol-regexp "\\)") (cons (concat "\\\\\\(" sclang-symbol-regexp "\\)")
'font-lock-constant-face) ; symbols 'font-lock-constant-face)) ; symbols
)
;; level 2 ;; level 2
sclang-font-lock-keywords-2 sclang-font-lock-keywords-2
(append (append
@ -284,42 +288,38 @@
(list (list
;; variables ;; variables
(cons (concat "\\s'\\(" sclang-identifier-regexp "\\)") (cons (concat "\\s'\\(" sclang-identifier-regexp "\\)")
'font-lock-variable-name-face) ; environment variables 'font-lock-variable-name-face) ; environment variables
(cons (concat "\\<\\(" sclang-identifier-regexp "\\)\\>:") ; keyword arguments (cons (concat "\\<\\(" sclang-identifier-regexp "\\)\\>:") ; keyword arguments
'font-lock-variable-name-face) 'font-lock-variable-name-face)
;; method definitions ;; method definitions
(cons sclang-method-definition-regexp (cons sclang-method-definition-regexp
(list 1 'font-lock-function-name-face)) (list 1 'font-lock-function-name-face))
;; methods ;; methods
(cons (regexp-opt sclang-font-lock-method-list 'words) (cons (regexp-opt sclang-font-lock-method-list 'words)
'font-lock-function-name-face) 'font-lock-function-name-face)
;; errors ;; errors
(cons (regexp-opt sclang-font-lock-error-list 'words) (cons (regexp-opt sclang-font-lock-error-list 'words)
'font-lock-warning-face) 'font-lock-warning-face)))
))
;; level 3 ;; level 3
sclang-font-lock-keywords-3 sclang-font-lock-keywords-3
(append (append
sclang-font-lock-keywords-2 sclang-font-lock-keywords-2
(list (list
;; classes ;; classes
(cons 'sclang-font-lock-class-keyword-matcher 'font-lock-type-face) (cons 'sclang-font-lock-class-keyword-matcher 'font-lock-type-face)))
;; (cons (concat "\\<" sclang-class-name-regexp "\\>") 'font-lock-type-face)
))
;; default level ;; 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 () (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 ;; too expensive
;; (dolist (buffer (buffer-list)) ;; (dolist (buffer (buffer-list))
;; (with-current-buffer buffer ;; (with-current-buffer buffer
;; (and (eq major-mode 'sclang-mode) ;; (and (eq major-mode 'sclang-mode)
;; (eq t (car font-lock-keywords)) ;; (eq t (car font-lock-keywords))
;; (setq font-lock-keywords (cdr font-lock-keywords))))) ;; (setq font-lock-keywords (cdr font-lock-keywords)))))
(if (eq major-mode 'sclang-mode) (if (eq major-mode 'sclang-mode)
(font-lock-fontify-buffer))) (font-lock-ensure (point-min) (point-max))))
;; ===================================================================== ;; =====================================================================
;; indentation ;; indentation
@ -333,95 +333,98 @@
(defun sclang-indent-line () (defun sclang-indent-line ()
"Indent current line as sclang code. "Indent current line as sclang code.
Return the amount the indentation changed by." Return the amount the indentation changed by."
(let ((indent (calculate-sclang-indent)) (let ((indent (sclang-calculate-indent))
beg shift-amt beg shift-amt
(case-fold-search nil) (case-fold-search nil)
(pos (- (point-max) (point)))) (pos (- (point-max) (point))))
(beginning-of-line) (beginning-of-line)
(setq beg (point)) (setq beg (point))
(skip-chars-forward " \t") (skip-chars-forward " \t")
(setq shift-amt (- indent (current-column))) (setq shift-amt (- indent (current-column)))
(if (zerop shift-amt) (if (zerop shift-amt)
(if (> (- (point-max) pos) (point)) (if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos))) (goto-char (- (point-max) pos)))
(delete-region beg (point)) (delete-region beg (point))
(indent-to indent) (indent-to indent)
;; if initial point was within line's indentation, position ;; if initial point was within line's indentation, position
;; after the indentation, else stay at same point in text. ;; after the indentation, else stay at same point in text.
(if (> (- (point-max) pos) (point)) (if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos)))) (goto-char (- (point-max) pos))))
shift-amt)) shift-amt))
(defun calculate-sclang-indent (&optional parse-start) (defun sclang-calculate-indent (&optional parse-start)
"Return appropriate indentation for current line as sclang code. "Return indentation for current line (optionally from PARSE-START).
Returns the column to indent to." Returns the column to indent to."
(save-excursion (save-excursion
(beginning-of-line) (beginning-of-line)
(let ((indent-point (point)) (let ((indent-point (point))
(case-fold-search nil) (case-fold-search nil)
state) state)
(if parse-start (if parse-start
(goto-char parse-start) (goto-char parse-start)
(beginning-of-defun)) (beginning-of-defun))
(while (< (point) indent-point) (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)) (let* ((containing-sexp (nth 1 state))
(inside-string-p (nth 3 state)) (inside-string-p (nth 3 state))
(inside-comment-p (nth 4 state))) (inside-comment-p (nth 4 state)))
(cond (inside-string-p (cond (inside-string-p
;; inside string: no change ;; inside string: no change
(current-indentation)) (current-indentation))
((integerp inside-comment-p) ((integerp inside-comment-p)
;; inside comment ;; inside comment
(let ((base (if containing-sexp (let ((base (if containing-sexp
(save-excursion (save-excursion
(goto-char containing-sexp) (goto-char containing-sexp)
(+ (current-indentation) sclang-indent-level)) (+ (current-indentation) sclang-indent-level))
0)) 0))
(offset (* sclang-indent-level (offset (* sclang-indent-level
(- inside-comment-p (- inside-comment-p
(if (save-excursion (if (save-excursion
(back-to-indentation) (back-to-indentation)
(looking-at "\\*/")) (looking-at "\\*/"))
1 0))))) 1 0)))))
(+ base offset))) (+ base offset)))
((null containing-sexp) ((null containing-sexp)
;; top-level: no indentation ;; top-level: no indentation
0) 0)
(t (t
(back-to-indentation) (back-to-indentation)
(let ((open-paren (and (looking-at "\\s)") (let ((open-paren (and (looking-at "\\s)")
(matching-paren (char-after)))) (matching-paren (char-after))))
(indent (current-indentation))) (indent (current-indentation)))
(goto-char containing-sexp) (goto-char containing-sexp)
(if (or (not open-paren) (eq open-paren (char-after))) (if (or (not open-paren) (eq open-paren (char-after)))
(cond ((progn (beginning-of-line) (looking-at sclang-block-regexp)) 0) (cond ((progn (beginning-of-line) (looking-at sclang-block-regexp)) 0)
(open-paren (current-indentation)) (open-paren (current-indentation))
(t (+ (current-indentation) sclang-indent-level))) (t (+ (current-indentation) sclang-indent-level)))
;; paren mismatch: do nothing ;; paren mismatch: do nothing
indent)))))))) indent))))))))
;; ===================================================================== ;; =====================================================================
;; electric character commands ;; electric character commands
;; ===================================================================== ;; =====================================================================
(defun sclang-electric-brace (arg) (defun sclang-electric-brace (arg)
"Electrify brace ARG."
(interactive "*P") (interactive "*P")
(self-insert-command (prefix-numeric-value arg)) (self-insert-command (prefix-numeric-value arg))
(and (save-excursion (and (save-excursion
(beginning-of-line) (beginning-of-line)
(looking-at "\\s *\\s)")) (looking-at "\\s *\\s)"))
(indent-according-to-mode))) (indent-according-to-mode)))
(defun sclang-electric-slash (arg) (defun sclang-electric-slash (arg)
"Electrify slash ARG."
(interactive "*P") (interactive "*P")
(let* ((char (char-before)) (let* ((char (char-before))
(indent-p (or (eq char ?/) (indent-p (or (eq char ?/)
(eq char ?*)))) (eq char ?*))))
(self-insert-command (prefix-numeric-value arg)) (self-insert-command (prefix-numeric-value arg))
(if indent-p (indent-according-to-mode)))) (if indent-p (indent-according-to-mode))))
(defun sclang-electric-star (arg) (defun sclang-electric-star (arg)
"Electrify star ARG."
(interactive "*P") (interactive "*P")
(let ((indent-p (eq (char-before) ?/))) (let ((indent-p (eq (char-before) ?/)))
(self-insert-command (prefix-numeric-value arg)) (self-insert-command (prefix-numeric-value arg))
@ -450,24 +453,30 @@ Returns the column to indent to."
(sclang-document-edited-p . (prSetEdited (buffer-modified-p))))) (sclang-document-edited-p . (prSetEdited (buffer-modified-p)))))
(defmacro sclang-next-document-id () (defmacro sclang-next-document-id ()
"Return next document id."
`(cl-incf sclang-document-counter)) `(cl-incf sclang-document-counter))
(defun sclang-document-id (buffer) (defun sclang-document-id (buffer)
"Document id of BUFFER."
(cdr (assq 'sclang-document-id (buffer-local-variables buffer)))) (cdr (assq 'sclang-document-id (buffer-local-variables buffer))))
(defun sclang-document-p (buffer) (defun sclang-document-p (buffer)
"Is BUFFER an sclang document?"
(integerp (sclang-document-id buffer))) (integerp (sclang-document-id buffer)))
(defmacro with-sclang-document (buffer &rest body) (defmacro with-sclang-document (buffer &rest body)
"With sclang BUFFER BODY."
`(when (sclang-document-p buffer) `(when (sclang-document-p buffer)
(with-current-buffer buffer (with-current-buffer buffer
,@body))) ,@body)))
(defun sclang-get-document (id) (defun sclang-get-document (id)
"Return buffer with document ID or nil."
(cl-find-if (lambda (buffer) (eq id (sclang-document-id buffer))) (cl-find-if (lambda (buffer) (eq id (sclang-document-id buffer)))
sclang-document-list)) sclang-document-list))
(defun sclang-init-document () (defun sclang-init-document ()
"Initialize document."
(set (make-local-variable 'sclang-document-id) (sclang-next-document-id)) (set (make-local-variable 'sclang-document-id) (sclang-next-document-id))
(set (make-local-variable 'sclang-document-envir) nil) (set (make-local-variable 'sclang-document-envir) nil)
(dolist (assoc sclang-document-property-map) (dolist (assoc sclang-document-property-map)
@ -475,29 +484,34 @@ Returns the column to indent to."
(cl-pushnew (current-buffer) sclang-document-list)) (cl-pushnew (current-buffer) sclang-document-list))
(defun sclang-document-update-property-1 (assoc &optional force) (defun sclang-document-update-property-1 (assoc &optional force)
"Update document property ASSOC (optionally FORCE)."
(when (consp assoc) (when (consp assoc)
(let* ((key (car assoc)) (let* ((key (car assoc))
(prop (cdr assoc)) (prop (cdr assoc))
(prev-value (eval key)) (prev-value (eval key))
(cur-value (eval (cadr prop)))) (cur-value (eval (cadr prop))))
(when (or force (not (equal prev-value cur-value))) (when (or force (not (equal prev-value cur-value)))
(set key cur-value) (set key cur-value)
(sclang-perform-command-no-result (sclang-perform-command-no-result
'documentSetProperty sclang-document-id 'documentSetProperty sclang-document-id
(car prop) cur-value))))) (car prop) cur-value)))))
(defun sclang-document-update-property (key &optional force) (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)) (sclang-document-update-property-1 (assq key sclang-document-property-map) force))
(defun sclang-document-update-properties (&optional force) (defun sclang-document-update-properties (&optional force)
"Update all document properties (optionally FORCE)."
(dolist (assoc sclang-document-property-map) (dolist (assoc sclang-document-property-map)
(sclang-document-update-property-1 assoc force))) (sclang-document-update-property-1 assoc force)))
(defun sclang-make-document () (defun sclang-make-document ()
"Make a new document."
(sclang-perform-command-no-result 'documentNew sclang-document-id) (sclang-perform-command-no-result 'documentNew sclang-document-id)
(sclang-document-update-properties t)) (sclang-document-update-properties t))
(defun sclang-close-document (buffer) (defun sclang-close-document (buffer)
"Close document in BUFFER."
(with-sclang-document (with-sclang-document
buffer buffer
(setq sclang-document-list (delq buffer sclang-document-list)) (setq sclang-document-list (delq buffer sclang-document-list))
@ -505,27 +519,32 @@ Returns the column to indent to."
'documentClosed sclang-document-id))) 'documentClosed sclang-document-id)))
(defun sclang-set-current-document (buffer &optional force) (defun sclang-set-current-document (buffer &optional force)
"Set current document to BUFFER (optionally FORCE)."
(when (or force (not (eq buffer sclang-current-document))) (when (or force (not (eq buffer sclang-current-document)))
(setq sclang-current-document buffer) (setq sclang-current-document buffer)
(sclang-perform-command-no-result 'documentSetCurrent (sclang-document-id buffer)) (sclang-perform-command-no-result 'documentSetCurrent (sclang-document-id buffer))
t)) t))
(defun sclang-document-library-startup-hook-function () (defun sclang-document-library-startup-hook-function ()
"Document library startup hook."
(dolist (buffer sclang-document-list) (dolist (buffer sclang-document-list)
(with-current-buffer buffer (with-current-buffer buffer
(sclang-make-document))) (sclang-make-document)))
(sclang-set-current-document (current-buffer) t)) (sclang-set-current-document (current-buffer) t))
(defun sclang-document-kill-buffer-hook-function () (defun sclang-document-kill-buffer-hook-function ()
"Document kill buffer hook."
(sclang-close-document (current-buffer))) (sclang-close-document (current-buffer)))
(defun sclang-document-post-command-hook-function () (defun sclang-document-post-command-hook-function ()
"Document post command hook."
(when (and (sclang-library-initialized-p) (when (and (sclang-library-initialized-p)
(sclang-document-p (current-buffer))) (sclang-document-p (current-buffer)))
(sclang-document-update-properties)) (sclang-document-update-properties))
(sclang-set-current-document (current-buffer))) (sclang-set-current-document (current-buffer)))
(defun sclang-document-change-major-mode-hook-function () (defun sclang-document-change-major-mode-hook-function ()
"Document change major mode hook."
(sclang-close-document (current-buffer))) (sclang-close-document (current-buffer)))
;; ===================================================================== ;; =====================================================================
@ -538,13 +557,13 @@ Returns the column to indent to."
(cl-multiple-value-bind (file-name region-start region-length) arg (cl-multiple-value-bind (file-name region-start region-length) arg
(let ((buffer (get-file-buffer file-name))) (let ((buffer (get-file-buffer file-name)))
(unless buffer (unless buffer
(setf buffer (find-file-noselect file-name))) (setf buffer (find-file-noselect file-name)))
(when buffer (when buffer
(unless (sclang-document-p buffer) (unless (sclang-document-p buffer)
(with-current-buffer buffer (sclang-mode))) (with-current-buffer buffer (sclang-mode)))
(goto-char (max (point-min) (min (point-max) region-start))) (goto-char (max (point-min) (min (point-max) region-start)))
;; TODO: how to activate region in transient-mark-mode? ;; TODO: how to activate region in transient-mark-mode?
(sclang-document-id buffer)))))) (sclang-document-id buffer))))))
(sclang-set-command-handler (sclang-set-command-handler
'_documentNew '_documentNew
@ -552,9 +571,9 @@ Returns the column to indent to."
(cl-multiple-value-bind (name str make-listener) arg (cl-multiple-value-bind (name str make-listener) arg
(let ((buffer (generate-new-buffer name))) (let ((buffer (generate-new-buffer name)))
(with-current-buffer buffer (with-current-buffer buffer
(insert str) (insert str)
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(sclang-mode)) (sclang-mode))
(sclang-document-id buffer))))) (sclang-document-id buffer)))))
(sclang-set-command-handler (sclang-set-command-handler
@ -570,10 +589,10 @@ Returns the column to indent to."
(cl-multiple-value-bind (id name) arg (cl-multiple-value-bind (id name) arg
(when (stringp name) (when (stringp name)
(let ((doc (and (integerp id) (sclang-get-document id)))) (let ((doc (and (integerp id) (sclang-get-document id))))
(when doc (when doc
(with-current-buffer doc (with-current-buffer doc
(rename-buffer name t) (rename-buffer name t)
(sclang-document-update-property 'sclang-document-name)))))) (sclang-document-update-property 'sclang-document-name))))))
nil)) nil))
(sclang-set-command-handler (sclang-set-command-handler
@ -582,9 +601,9 @@ Returns the column to indent to."
(cl-multiple-value-bind (id flag) arg (cl-multiple-value-bind (id flag) arg
(let ((doc (and (integerp id) (sclang-get-document id)))) (let ((doc (and (integerp id) (sclang-get-document id))))
(when doc (when doc
(with-current-buffer doc (with-current-buffer doc
(setq buffer-read-only (not flag)) (setq buffer-read-only (not flag))
(sclang-document-update-property 'sclang-editable-p))))) (sclang-document-update-property 'sclang-editable-p)))))
nil)) nil))
(sclang-set-command-handler (sclang-set-command-handler
@ -596,14 +615,13 @@ Returns the column to indent to."
(sclang-set-command-handler (sclang-set-command-handler
'_documentPutString '_documentPutString
(lambda (arg) (lambda (arg)
(cl-multiple-value-bind (id str) arg (cl-multiple-value-bind (id str) arg
(let ((doc (and (integerp id) (sclang-get-document id)))) (let ((doc (and (integerp id) (sclang-get-document id))))
(when doc (when doc
(with-current-buffer doc (with-current-buffer doc
(insert str) (insert str))
) nil)))))
nil)))))
(sclang-set-command-handler (sclang-set-command-handler
'_documentPopTo '_documentPopTo
@ -617,6 +635,7 @@ Returns the column to indent to."
;; ===================================================================== ;; =====================================================================
(defun sclang-mode-set-local-variables () (defun sclang-mode-set-local-variables ()
"Local variables."
(set (make-local-variable 'require-final-newline) nil) (set (make-local-variable 'require-final-newline) nil)
;; indentation ;; indentation
(set (make-local-variable 'indent-line-function) (set (make-local-variable 'indent-line-function)
@ -665,27 +684,29 @@ Returns the column to indent to."
:group 'sclang-mode :group 'sclang-mode
:type 'hook) :type 'hook)
(defun sclang-mode () ;;;###autoload (autoload 'sclang-mode "sclang" "Major mode for editing SuperCollider language" t)
(define-derived-mode sclang-mode prog-mode "SCLang"
"Major mode for editing SuperCollider language code. "Major mode for editing SuperCollider language code.
\\{sclang-mode-map} \\{sclang-mode-map}"
" :group 'sclang
(interactive) :syntax-table sclang-mode-syntax-table
(kill-all-local-variables)
(set-syntax-table sclang-mode-syntax-table)
(use-local-map sclang-mode-map)
(setq mode-name "SCLang")
(setq major-mode 'sclang-mode)
(sclang-mode-set-local-variables) (sclang-mode-set-local-variables)
(sclang-set-font-lock-keywords) (sclang-set-font-lock-keywords)
(sclang-init-document) (sclang-init-document)
(sclang-make-document) (sclang-make-document)
(run-hooks 'sclang-mode-hook))
;; Setup completion
(add-hook 'completion-at-point-functions
#'sclang-completion-at-point nil 'local)
(when (fboundp 'company-mode)
(add-to-list 'company-backends 'company-capf)))
;; ===================================================================== ;; =====================================================================
;; module initialization ;; module initialization
;; ===================================================================== ;; =====================================================================
(add-to-list 'auto-mode-alist '("\\.\\(sc\\|scd\\)$" . sclang-mode)) ;;;###autoload
(add-to-list 'auto-mode-alist '("\\.scd?\\'" . sclang-mode))
(add-to-list 'interpreter-mode-alist '("sclang" . sclang-mode)) (add-to-list 'interpreter-mode-alist '("sclang" . sclang-mode))
(add-hook 'sclang-library-startup-hook 'sclang-document-library-startup-hook-function) (add-hook 'sclang-library-startup-hook 'sclang-document-library-startup-hook-function)
@ -695,4 +716,4 @@ Returns the column to indent to."
(provide 'sclang-mode) (provide 'sclang-mode)
;; EOF ;;; sclang-mode.el ends here

130
el/sclang-server.el
View file

@ -1,5 +1,9 @@
;; copyright 2003-2005 stefan kersten <steve@k-hornz.de> ;;; sclang-server.el --- IDE for working with SuperCollider -*- coding: utf-8;
;; ;;
;; Copyright 2003 stefan kersten <steve@k-hornz.de>
;;; License:
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of the ;; published by the Free Software Foundation; either version 2 of the
@ -15,20 +19,24 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
;; USA ;; USA
(require 'cl-lib)
(eval-when-compile ;;; Commentary:
(require 'sclang-util) ;; Interface to the sclang server
(require 'sclang-interp)
(require 'sclang-language) (require 'cl-lib)
(require 'sclang-mode)) (require 'sclang-util)
(require 'sclang-interp)
(require 'sclang-language)
(require 'sclang-mode)
;;; Code:
(defcustom sclang-server-panel "Server.default.makeWindow" (defcustom sclang-server-panel "Server.default.makeWindow"
"Expression to execute when `sclang-show-server-panel' is invoked." "Expression to execute when `sclang-show-server-panel' is invoked."
:group 'sclang-interface :group 'sclang-interface
:type '(choice (const "Server.default.makeWindow") :type '(choice (const "Server.default.makeWindow")
(const "\\SCUM.asClass.do { \\SCUM.asClass.desktop.showServerPanel }") (const "\\SCUM.asClass.do { \\SCUM.asClass.desktop.showServerPanel }")
string)) string))
(defvar sclang-server-alist nil (defvar sclang-server-alist nil
"Alist of currently defined synthesis servers.") "Alist of currently defined synthesis servers.")
@ -49,20 +57,22 @@
"Face for highlighting a server's running state in the mode-line.") "Face for highlighting a server's running state in the mode-line.")
(defun sclang-get-server (&optional name) (defun sclang-get-server (&optional name)
"Get sclang server (optionally by NAME)."
(unless name (setq name sclang-current-server)) (unless name (setq name sclang-current-server))
(cdr (assq name sclang-server-alist))) (cdr (assq name sclang-server-alist)))
(defun sclang-set-server (&optional name) (defun sclang-set-server (&optional name)
"Set current sclang server (optionally by NAME)."
(unless name (setq name sclang-current-server)) (unless name (setq name sclang-current-server))
(setq sclang-current-server (setq sclang-current-server
(car (or (assq name sclang-server-alist) (car (or (assq name sclang-server-alist)
(car sclang-server-alist))))) (car sclang-server-alist)))))
(sclang-set-command-handler (sclang-set-command-handler
'_updateServer '_updateServer
(lambda (arg) (lambda (arg)
(setq sclang-server-alist (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)) (setq sclang-default-server (car arg))
(unless sclang-current-server-initialized (unless sclang-current-server-initialized
;; only set the current server automatically once after startup ;; only set the current server automatically once after startup
@ -75,24 +85,27 @@
(interactive) (interactive)
(sclang-set-server) (sclang-set-server)
(let ((list (or (cdr (cl-member-if (lambda (assoc) (let ((list (or (cdr (cl-member-if (lambda (assoc)
(eq (car assoc) sclang-current-server)) (eq (car assoc) sclang-current-server))
sclang-server-alist)) sclang-server-alist))
sclang-server-alist))) sclang-server-alist)))
(setq sclang-current-server (car (car list)))) (setq sclang-current-server (car (car list))))
(sclang-update-server-info)) (sclang-update-server-info))
(defun sclang-mouse-next-server (event) (defun sclang-mouse-next-server (_event)
"Select next server for display." "Select next server for display."
(interactive "e") (interactive "e")
(sclang-next-server)) (sclang-next-server))
(defun sclang-server-running-p (&optional name) (defun sclang-server-running-p (&optional name)
"Is the sclang server NAME running?"
(plist-get (sclang-get-server name) 'running)) (plist-get (sclang-get-server name) 'running))
(defun sclang-server-booting-p (&optional name) (defun sclang-server-booting-p (&optional name)
"Is the sclang server NAME running?"
(plist-get (sclang-get-server name) 'booting)) (plist-get (sclang-get-server name) 'booting))
(defun sclang-create-server-menu (title) (defun sclang-create-server-menu (title)
"Create the server menu with TITLE."
(easy-menu-create-menu (easy-menu-create-menu
title title
'( '(
@ -103,6 +116,7 @@
["Make Default" sclang-server-make-default]))) ["Make Default" sclang-server-make-default])))
(defun sclang-server-fill-mouse-map (map prefix) (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 'mouse-1) 'sclang-mouse-next-server)
(define-key map (vector prefix 'down-mouse-3) (sclang-create-server-menu "Commands")) (define-key map (vector prefix 'down-mouse-3) (sclang-create-server-menu "Commands"))
map) map)
@ -111,7 +125,7 @@
"Keymap used for controlling servers in the mode line.") "Keymap used for controlling servers in the mode line.")
(defun sclang-server-fill-key-map (map) (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 [?b] 'sclang-server-boot)
(define-key map [?d] 'sclang-server-display-default) (define-key map [?d] 'sclang-server-display-default)
(define-key map [?f] 'sclang-server-free-all) (define-key map [?f] 'sclang-server-free-all)
@ -121,11 +135,11 @@
(define-key map [?p] 'sclang-show-server-panel) (define-key map [?p] 'sclang-show-server-panel)
(define-key map [?q] 'sclang-server-quit) (define-key map [?q] 'sclang-server-quit)
(cl-flet ((fill-record-map (map) (cl-flet ((fill-record-map (map)
(define-key map [?n] 'sclang-server-prepare-for-record) (define-key map [?n] 'sclang-server-prepare-for-record)
(define-key map [?p] 'sclang-server-pause-recording) (define-key map [?p] 'sclang-server-pause-recording)
(define-key map [?r] 'sclang-server-record) (define-key map [?r] 'sclang-server-record)
(define-key map [?s] 'sclang-server-stop-recording) (define-key map [?s] 'sclang-server-stop-recording)
map)) map))
(define-key map [?r] (fill-record-map (make-sparse-keymap)))) (define-key map [?r] (fill-record-map (make-sparse-keymap))))
map) map)
@ -135,27 +149,28 @@
(defun sclang-get-server-info-string () (defun sclang-get-server-info-string ()
"Return a mode-line string for the current server." "Return a mode-line string for the current server."
(let* ((name (if sclang-current-server (symbol-name sclang-current-server) "-------")) (let* ((name (if sclang-current-server (symbol-name sclang-current-server) "-------"))
(server (sclang-get-server)) (server (sclang-get-server))
(running-p (if server (plist-get server 'running))) (running-p (if server (plist-get server 'running)))
(string (propertize (string (propertize
name name
'face (if running-p sclang-server-running-face) 'face (if running-p sclang-server-running-face)
'help-echo "mouse-1: next server, mouse-3: command menu" 'help-echo "mouse-1: next server, mouse-3: command menu"
'keymap sclang-server-mouse-map)) 'keymap sclang-server-mouse-map))
;; (make-mode-line-mouse-map 'mouse-1 'sclang-mouse-next-server))) ;; (make-mode-line-mouse-map 'mouse-1 'sclang-mouse-next-server)))
(address (if (and server (not (eq (plist-get server 'type) 'internal))) (address (if (and server (not (eq (plist-get server 'type) 'internal)))
(format " (%s)" (plist-get server 'address)) (format " (%s)" (plist-get server 'address))
"")) ""))
(info (if running-p (info (if running-p
(mapcar 'number-to-string (mapcar 'number-to-string
(plist-get (sclang-get-server) 'info)) (plist-get (sclang-get-server) 'info))
'("---" "---" "----" "----" "----" "----")))) '("---" "---" "----" "----" "----" "----"))))
(apply 'format "%s%s %3s|%3s %% u: %4s s: %4s g: %4s d: %4s" string address 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) (defvar sclang-server-info-string (sclang-get-server-info-string)
"Info string used in the post buffer mode line.") "Info string used in the post buffer mode line.")
(defun sclang-update-server-info () (defun sclang-update-server-info ()
"Update server info in the modeline."
(interactive) (interactive)
(sclang-set-server) (sclang-set-server)
(setq sclang-server-info-string (sclang-get-server-info-string)) (setq sclang-server-info-string (sclang-get-server-info-string))
@ -166,9 +181,11 @@
;; ===================================================================== ;; =====================================================================
(defun sclang-perform-server-command (command &rest args) (defun sclang-perform-server-command (command &rest args)
"Perform server COMMAND with ARGS."
(sclang-eval-string (sclang-eval-string
(sclang-format "Server.named.at(%o.asSymbol).performList(\\tryPerform, %o.asSymbol.asArray ++ %o)" (sclang-format
sclang-current-server command args) "Server.named.at(%o.asSymbol).performList(\\tryPerform, %o.asSymbol.asArray ++ %o)"
sclang-current-server command args)
nil)) nil))
(defun sclang-server-boot () (defun sclang-server-boot ()
@ -215,15 +232,15 @@ if (server.notNil) {
nil)) nil))
(defun sclang-server-dump-osc (&optional code) (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") (interactive "P")
(sclang-perform-server-command "dumpOSC" (sclang-perform-server-command "dumpOSC"
(cond ((consp code) 0) (cond ((consp code) 0)
((null code) 1) ((null code) 1)
(t code)))) (t code))))
(defun sclang-server-prepare-for-record (&optional path) (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 (interactive
(list (list
(and current-prefix-arg (read-file-name "Record to file: ")))) (and current-prefix-arg (read-file-name "Record to file: "))))
@ -244,10 +261,10 @@ if (server.notNil) {
(interactive) (interactive)
(sclang-perform-server-command "stopRecording")) (sclang-perform-server-command "stopRecording"))
(defun sclang-set-server-latency (lat) (defun sclang-set-server-latency (latency)
"Set the current server's `latency' instance variable." "Set the current server's LATENCY instance variable."
(interactive "nSet latency: ") (interactive "nSet latency: ")
(sclang-perform-server-command "latency_" lat)) (sclang-perform-server-command "latency_" latency))
(defun sclang-show-server-latency () (defun sclang-show-server-latency ()
"Show the current server's latency." "Show the current server's latency."
@ -265,17 +282,18 @@ if (server.notNil) {
;; ===================================================================== ;; =====================================================================
(add-hook 'sclang-mode-hook (add-hook 'sclang-mode-hook
(lambda () (lambda ()
;; install server mode line in post buffer ;; install server mode line in post buffer
(when (string= (buffer-name) sclang-post-buffer) (when (string= (buffer-name) sclang-post-buffer)
(setq mode-line-format '("-" sclang-server-info-string))) (setq mode-line-format '("-" sclang-server-info-string)))
;; install server prefix keymap ;; install server prefix keymap
(define-key sclang-mode-map "\C-c\C-p" sclang-server-key-map))) (define-key sclang-mode-map "\C-c\C-p" sclang-server-key-map)))
(add-hook 'sclang-library-shutdown-hook (add-hook 'sclang-library-shutdown-hook
(lambda () (lambda ()
(setq sclang-current-server-initialized nil))) (setq sclang-current-server-initialized nil)))
(provide 'sclang-server) (provide 'sclang-server)
;; EOF ;;; sclang-server.el ends here

36
el/sclang-util.el
View file

@ -1,5 +1,9 @@
;; copyright 2003-2005 stefan kersten <steve@k-hornz.de> ;;; sclang-util.el --- Utility helpers for sclang -*- coding: utf-8;
;; ;;
;; Copyright 2003-2005 stefan kersten <steve@k-hornz.de>
;;; License:
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of the ;; published by the Free Software Foundation; either version 2 of the
@ -15,13 +19,20 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
;; USA ;; USA
;;; Commentary:
;; Utility helpers for sclang
;;; Code:
(defun sclang-message (string &rest args) (defun sclang-message (string &rest args)
"Create a message from STRING with optional ARGS."
(message "SCLang: %s" (apply 'format string args))) (message "SCLang: %s" (apply 'format string args)))
(defun sclang-make-buffer-name (string &optional private-p) (defun sclang-make-buffer-name (name &optional private-p)
(concat (and private-p " ") "*SCLang:" string "*")) "Set the buffer name to NAME (optimally PRIVATE-P)."
(concat (and private-p " ") "*SCLang:" name "*"))
(defun sclang-make-prompt-string (prompt default) (defun sclang-make-prompt-string (prompt default)
"Return a prompt string using PROMPT and DEFAULT."
(if (and default (string-match "\\(:\\)\\s *" prompt)) (if (and default (string-match "\\(:\\)\\s *" prompt))
(replace-match (replace-match
(format " (default %s):" default) (format " (default %s):" default)
@ -29,22 +40,23 @@
prompt)) prompt))
(defun sclang-string-to-int32 (str) (defun sclang-string-to-int32 (str)
"Convert first 4 bytes of str (network byteorder) to 32 bit integer." "Convert first 4 bytes of STR (network byteorder) to 32 bit integer."
(logior (lsh (logand (aref str 0) #XFF) 24) (logior (ash (logand (aref str 0) #XFF) 24)
(lsh (logand (aref str 1) #XFF) 16) (ash (logand (aref str 1) #XFF) 16)
(lsh (logand (aref str 2) #XFF) 8) (ash (logand (aref str 2) #XFF) 8)
(logand (aref str 3) #XFF))) (logand (aref str 3) #XFF)))
(defun sclang-int32-to-string (n) (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))) (let ((str (make-string 4 0)))
(aset str 0 (logand (lsh n -24) #XFF)) (aset str 0 (logand (ash n -24) #XFF))
(aset str 1 (logand (lsh n -16) #XFF)) (aset str 1 (logand (ash n -16) #XFF))
(aset str 2 (logand (lsh n -8) #XFF)) (aset str 2 (logand (ash n -8) #XFF))
(aset str 3 (logand n #XFF)) (aset str 3 (logand n #XFF))
str)) str))
(defun sclang-compress-newlines (&optional buffer) (defun sclang-compress-newlines (&optional buffer)
"Compress newlines (optionally in BUFFER)."
(with-current-buffer (or buffer (current-buffer)) (with-current-buffer (or buffer (current-buffer))
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
@ -83,4 +95,4 @@
(provide 'sclang-util) (provide 'sclang-util)
;; EOF ;;; sclang-util.el ends here

19
el/sclang-vars.el.in
View file

@ -19,16 +19,21 @@
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA. ;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This file is included in the distribution in order to convey system
;; installation variables which are known at compile time, but only when
;; the library is installed with cmake along with SuperCollider source.
;;
;; When using the stand-alone package, this file can be ignored and
;; the constants it defines will have no effect.
;;; Code: ;;; Code:
(defconst sclang-system-data-dir "@PKG_DATA_DIR@" (defconst sclang-system-data-dir "@PKG_DATA_DIR@"
"Installation dependent data directory.") "Installation dependent data directory.
Bound only when library is installed with SuperCollider.")
(defconst sclang-system-help-dir "@PKG_DATA_DIR@/Help"
"Installation dependent help directory.")
(defconst sclang-system-extension-dir "@PKG_DATA_DIR@/Extensions"
"Installation dependent extension directory.")
(provide 'sclang-vars) (provide 'sclang-vars)
;;; sclang-vars.el ends here ;;; sclang-vars.el ends here

73
el/sclang-widgets.el
View file

@ -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 <mlang@blind.guru> ;; Author: Mario Lang <mlang@blind.guru>
;; Keywords: comm
;; This file is free software; you can redistribute it and/or modify ;; 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 ;; it under the terms of the GNU General Public License as published by
@ -21,15 +20,18 @@
;; Boston, MA 02110-1301, USA. ;; Boston, MA 02110-1301, USA.
;;; Commentary: ;;; Commentary:
;; ;;
;; Widget definitions for SCLang
;;; Code: ;;; Code:
(require 'cl-lib) (require 'cl-lib)
(eval-when-compile (require 'sclang-util) (require 'sclang-util)
(require 'sclang-language)) (require 'sclang-language)
(eval-and-compile (require 'sclang-interp)) (require 'sclang-interp)
(require 'widget)
(require 'wid-edit)
(defvar sclang-widgets nil) (defvar sclang-widgets nil)
(make-variable-buffer-local 'sclang-widgets) (make-variable-buffer-local 'sclang-widgets)
@ -45,34 +47,35 @@
"Create WIDGET at point in the current buffer." "Create WIDGET at point in the current buffer."
(widget-specify-insert (widget-specify-insert
(let ((from (point)) (let ((from (point))
button-begin button-end) button-begin button-end)
(setq button-begin (point)) (setq button-begin from)
(insert (widget-get-indirect widget :button-prefix)) (insert (widget-get-indirect widget :button-prefix))
(princ (nth (widget-get widget :value) (widget-get widget :states)) (current-buffer)) (princ (nth (widget-get widget :value) (widget-get widget :states)) (current-buffer))
(insert (widget-get-indirect widget :button-suffix)) (insert (widget-get-indirect widget :button-suffix))
(setq button-end (point)) (setq button-end from)
;; Specify button, and insert value. ;; Specify button, and insert value.
(and button-begin button-end (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)) (let ((from (point-min-marker))
(to (point-max-marker))) (to (point-max-marker)))
(set-marker-insertion-type from t) (set-marker-insertion-type from t)
(set-marker-insertion-type to nil) (set-marker-insertion-type to nil)
(widget-put widget :from from) (widget-put widget :from from)
(widget-put widget :to to))) (widget-put widget :to to)))
(widget-clear-undo)) (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 (widget-value-set widget
(if (>= (widget-get widget :value) (1- (length (widget-get widget :states)))) (if (>= (widget-get widget :value) (1- (length (widget-get widget :states))))
0 0
(1+ (widget-get widget :value)))) (1+ (widget-get widget :value))))
(sclang-eval-string (sclang-eval-string
(sclang-format "EmacsWidget.idmap[%o].valueFromEmacs(%o)" (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 (sclang-set-command-handler
'_widgetSetStates '_widgetSetStates
@ -80,9 +83,9 @@
(cl-multiple-value-bind (buffer id states value) arg (cl-multiple-value-bind (buffer id states value) arg
(with-current-buffer (get-buffer buffer) (with-current-buffer (get-buffer buffer)
(let ((widget (cdr (cl-find id sclang-widgets :key 'car)))) (let ((widget (cdr (cl-find id sclang-widgets :key 'car))))
(widget-put widget :states states) (widget-put widget :states states)
(widget-value-set widget value) (widget-value-set widget value)
value))))) value)))))
(define-widget 'sclang-slider 'default (define-widget 'sclang-slider 'default
"Slider widget." "Slider widget."
@ -94,16 +97,16 @@
:value-get #'widget-value-value-get :value-get #'widget-value-value-get
:value-set #'sclang-widget-slider-value-set :value-set #'sclang-widget-slider-value-set
:action (lambda (widget event) :action (lambda (widget event)
(let ((pos (if event (posn-point (event-start event)) (point)))) (let ((pos (if event (posn-point (event-start event)) (point))))
(widget-value-set widget (/ (float (- pos (widget-get widget :from))) (widget-get widget :size)))))) (widget-value-set widget (/ (float (- pos (widget-get widget :from))) (widget-get widget :size))))))
(defun sclang-widget-slider-create (widget) (defun sclang-widget-slider-create (widget)
"Create WIDGET at point in the current buffer." "Create WIDGET at point in the current buffer."
(widget-specify-insert (widget-specify-insert
(let ((from (point)) (let ((from (point))
(inhibit-redisplay t) (inhibit-redisplay t)
button-begin button-end) button-begin button-end)
(setq button-begin (point)) (setq button-begin from)
(insert (widget-get-indirect widget :button-prefix)) (insert (widget-get-indirect widget :button-prefix))
(insert-char ?- (widget-get widget :size)) (insert-char ?- (widget-get widget :size))
@ -115,9 +118,9 @@
;; Specify button ;; Specify button
(and button-begin button-end (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)) (let ((from (point-min-marker))
(to (point-max-marker))) (to (point-max-marker)))
(set-marker-insertion-type from t) (set-marker-insertion-type from t)
(set-marker-insertion-type to nil) (set-marker-insertion-type to nil)
(widget-put widget :from from) (widget-put widget :from from)
@ -125,6 +128,7 @@
(widget-clear-undo)) (widget-clear-undo))
(defun sclang-widget-slider-value-set (widget value) (defun sclang-widget-slider-value-set (widget value)
"Set slider WIDGET to VALUE."
(save-excursion (save-excursion
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(goto-char (widget-get widget :from)) (goto-char (widget-get widget :from))
@ -133,9 +137,9 @@
(widget-put widget :value value) (widget-put widget :value value)
(goto-char (widget-get widget :from)) (goto-char (widget-get widget :from))
(let ((n (round (* value (widget-get widget :size))))) (let ((n (round (* value (widget-get widget :size)))))
(widget-put widget :current-pos n) (widget-put widget :current-pos n)
(forward-char n) (forward-char n)
(insert "|") (delete-char 1))))) (insert "|") (delete-char 1)))))
;; Class Tree ;; Class Tree
@ -145,15 +149,16 @@
:dynargs #'sclang-widget-class-tree-dynargs) :dynargs #'sclang-widget-class-tree-dynargs)
(defun sclang-widget-class-tree-dynargs (widget) (defun sclang-widget-class-tree-dynargs (widget)
"Class tree WIDGET."
(sclang-eval-sync (sclang-format "EmacsClassTree.dynargs(%o)" (sclang-eval-sync (sclang-format "EmacsClassTree.dynargs(%o)"
(widget-get widget :tag)))) (widget-get widget :tag))))
(define-widget 'sclang-file-position 'item (define-widget 'sclang-file-position 'item
"File position link for the SCLang Class Tree widget." "File position link for the SCLang Class Tree widget."
:format "%[%t%]\n" :format "%[%t%]\n"
:action (lambda (widget event) :action (lambda (widget event)
(find-file-other-window (widget-get widget :filename)) (find-file-other-window (widget-get widget :filename))
(goto-char (widget-get widget :char-pos)))) (goto-char (widget-get widget :char-pos))))
(defun sclang-class-tree (class-name) (defun sclang-class-tree (class-name)
"Display a tree-view of the sub-classes and methods of 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))) (list (sclang-read-symbol "Class: " "Object" #'sclang-class-name-p)))
(sclang-eval-string (format "EmacsClassBrowser(%s)" class-name))) (sclang-eval-string (format "EmacsClassBrowser(%s)" class-name)))
(provide 'sclang-widgets) (provide 'sclang-widgets)
;;; sclang-widgets.el ends here ;;; sclang-widgets.el ends here

60
el/sclang.el
View file

@ -1,6 +1,15 @@
;;; sclang.el --- IDE for working with the SuperCollider language ;;; sclang.el --- IDE for working with SuperCollider -*- coding: utf-8; lexical-binding: t -*-
;; copyright 2003 stefan kersten <steve@k-hornz.de>
;; ;;
;; Copyright 2003 stefan kersten <steve@k-hornz.de>
;;
;; 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 ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of the ;; published by the Free Software Foundation; either version 2 of the
@ -16,7 +25,25 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
;; USA ;; USA
;;; Commentary:
;;
;; 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
;; 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 <steve@k-hornz.de>
;; and everyone in...
;; git shortlog -s | sort -r | cut -c8-
;;; Code: ;;; Code:
(defgroup sclang nil (defgroup sclang nil
"IDE for working with the SuperCollider language." "IDE for working with the SuperCollider language."
:group 'languages) :group 'languages)
@ -34,34 +61,29 @@
:group 'sclang) :group 'sclang)
(defgroup sclang-programs nil (defgroup sclang-programs nil
"Paths to programs used by sclang-mode." "Paths to programs used by `sclang-mode'."
:group 'sclang-interface) :group 'sclang-interface)
(defgroup sclang-options nil (defgroup sclang-options nil
"Options for the SuperCollider process." "Options for the SuperCollider process."
:group 'sclang-interface) :group 'sclang-interface)
;;;###autoload
(defun sclang-customize () (defun sclang-customize ()
"Customize sclang variables." "Customize sclang variables."
(interactive) (interactive)
(customize-group 'sclang)) (customize-group 'sclang))
(eval-and-compile (require 'sclang-util)
(let ((load-path (require 'sclang-browser)
(if (and (boundp 'byte-compile-dest-file) (require 'sclang-interp)
(stringp byte-compile-dest-file)) (require 'sclang-language)
(cons (file-name-directory byte-compile-dest-file) load-path) (require 'sclang-document)
load-path))) (require 'sclang-mode)
(require 'sclang-util) (require 'sclang-minor-mode)
(require 'sclang-browser) (require 'sclang-help)
(require 'sclang-interp) (require 'sclang-server)
(require 'sclang-language) (require 'sclang-widgets)
(require 'sclang-document)
(require 'sclang-mode)
(require 'sclang-minor-mode)
(require 'sclang-help)
(require 'sclang-server)
(require 'sclang-widgets)))
(provide 'sclang) (provide 'sclang)

1
el/test/fixtures/super-boring.scd vendored Normal file
View file

@ -0,0 +1 @@
{ WhiteNoise.ar(0.2!2); }.play;

12
el/test/sclang-mode-test.el Normal file
View file

@ -0,0 +1,12 @@
;; -*- no-byte-compile: t; lexical-binding: t; -*-
;;; test/sclang-mode-test.el
(ert-deftest sclang-autoloaded-functions ()
"Some functions should be callable interactively without requiring them"
(should (commandp 'sclang-start t))
(should (commandp 'sclang-mode t)))
(ert-deftest sclang-major-mode-init-test ()
"Loading a file with an scd extension should init sclang-mode"
(find-file "fixtures/super-boring.scd")
(should (eq 'sclang-mode major-mode)))

0
sc/CMakeLists.txt → sc/scide_scel/CMakeLists.txt
View file

0
sc/Document.sc → sc/scide_scel/Document.sc
View file

0
sc/Emacs.sc → sc/scide_scel/Emacs.sc
View file

0
sc/EmacsBuffer.sc → sc/scide_scel/EmacsBuffer.sc
View file

0
sc/EmacsDocument.sc → sc/scide_scel/EmacsDocument.sc
View file

0
sc/ScelDocument.sc → sc/scide_scel/ScelDocument.sc
View file

0
sc/extBuffer.sc → sc/scide_scel/extBuffer.sc
View file

0
sc/extClassBrowser.sc → sc/scide_scel/extClassBrowser.sc
View file

0
sc/extString.sc → sc/scide_scel/extString.sc
View file

0
sc/homeContext.sc → sc/scide_scel/homeContext.sc
View file

0
sc/storeLispOn.sc → sc/scide_scel/storeLispOn.sc
View file

5
scel.quark Normal file
View file

@ -0,0 +1,5 @@
(
name: "scel",
summary: "SuperCollider/Emacs interface",
version: "1.0.0",
)