├── .gitignore
├── nix
    └── shell.nix
├── CHANGELOG.md
├── csound-skeleton.el
├── csound-manual-lookup.el
├── README.md
├── csound-util.el
├── csound-repl-interaction.el
├── dev-script
    └── xml-to-emacsdb.clj
├── csound-mode.el
├── test
    └── csound-mode-tests.el
├── csound-eldoc.el
├── csound-score.el
├── csound-font-lock.el
├── csound-indentation.el
└── csound-repl.el


/.gitignore:
--------------------------------------------------------------------------------
 1 | # -*- mode: gitignore; -*-
 2 | *~
 3 | \#*\#
 4 | /.emacs.desktop
 5 | /.emacs.desktop.lock
 6 | *.elc
 7 | auto-save-list
 8 | tramp
 9 | .\#*
10 | 
11 | # Org-mode
12 | .org-id-locations
13 | *_archive
14 | 
15 | # flymake-mode
16 | *_flymake.*
17 | 
18 | # eshell files
19 | /eshell/history
20 | /eshell/lastdir
21 | 
22 | # elpa packages
23 | /elpa/
24 | 
25 | # reftex files
26 | *.rel
27 | 
28 | # AUCTeX auto folder
29 | /auto/
30 | 
31 | # cask packages
32 | .cask/
33 | dist/
34 | 
35 | # Flycheck
36 | flycheck_*.el
37 | 
38 | # server auth directory
39 | /server/
40 | 
41 | # projectiles files
42 | .projectile
43 | 
44 | # directory configuration
45 | .dir-locals.el
46 | 
47 | #in development
48 | csound-interaction.el
49 | releases
50 | 
51 | #clj
52 | .nrepl-port
53 | 
54 | 
55 | # devfile
56 | test.csd
57 | 
58 | ### MacOS
59 | 
60 | .DS_Store
61 | 
62 | 


--------------------------------------------------------------------------------
/nix/shell.nix:
--------------------------------------------------------------------------------
 1 | with import <nixpkgs> {};
 2 | 
 3 | let init-el = pkgs.writeText "init.el" ''
 4 |     (setq byte-compile-error-on-warn t)
 5 |     (setq byte-compile--use-old-handlers nil)
 6 |     (setq-default indent-tabs-mode nil)
 7 |     (add-to-list 'load-path "./")
 8 |     (package-initialize)
 9 |     '';
10 |     emacs25WithPackages = (pkgs.emacsPackagesGen pkgs.emacs25).emacsWithPackages;
11 |     emacs25 = emacs25WithPackages (epkgs: (with epkgs.melpaPackages; [
12 |       shut-up
13 |       test-simple
14 |       multi
15 |       dash
16 |       highlight
17 |     ]));
18 |     emacs26WithPackages = (pkgs.emacsPackagesGen pkgs.emacs26).emacsWithPackages;
19 |     emacs26 = emacs26WithPackages (epkgs: (with epkgs.melpaPackages; [
20 |       shut-up
21 |       test-simple
22 |       multi
23 |       dash
24 |       highlight
25 |     ]));
26 | in stdenv.mkDerivation {
27 |   name = "csound-mode-test";
28 |   buildInputs = with pkgs; [
29 |     emacs25
30 |   ];
31 |   shellHook = ''
32 |     testEmacs25 () {
33 |       ${emacs25}/bin/emacs -nw -q -batch -l ${init-el} \
34 |         -l ert -l test/csound-mode-tests.el -f ert-run-tests-batch-and-exit
35 |     }
36 |     testEmacs26 () {
37 |       ${emacs26}/bin/emacs -nw -q -batch -l ${init-el} \
38 |         -l test-simple -l test/csound-mode-tests.el -f test-simple-run
39 |     }
40 |     export -f testEmacs25
41 |     export -f testEmacs26
42 |   '';
43 | }
44 | 


--------------------------------------------------------------------------------
/CHANGELOG.md:
--------------------------------------------------------------------------------
 1 | # Changelog
 2 | 
 3 | ## [master]
 4 | ### Minor Changes
 5 | - `csound-play-flags` and `csound-render-flags` customizeable variables added
 6 | 
 7 | ## [0.2.1]
 8 | ### Minor Changes
 9 | - bytecode compilation errors fixed
10 | - non-rainbow score syntax highlight improved
11 | - minidocs and syopsis updated
12 | - requiring highligh for missing hlt-highlight symbols
13 | - new flash colors
14 | 
15 | ## [0.2.0]
16 | ### Major Changes
17 | - Csound API Removed in favour of UDP (requires Csound 6.10+)
18 | - No more dependency on Emacs `modules`
19 | - `csound-repl-plot-ftgen` removed
20 | 
21 | ### Other Changes
22 | - Repl: +/. in p2 score snippets supported
23 | - Repl: + in p3 score snippet supported
24 | - Score: `csound-score--align-cols` improved to decrease col width as well
25 | - Indentation: `csound-indentation-aggressive-score` customizeable variable added
26 | - Font-lock: Bug causing slower font-locking fixed
27 | - Keybinding `C-c C-c` added for region evaluation
28 | - Repl: Newline in the prompt supported via <Ctrl-Return>
29 | - Repl: Completions added to the promt
30 | - Csound-mode repl welcome string prints the audio configuration from the csound-mode buffer
31 | 
32 | ## [0.1.2]
33 | - Font-lock: Single line comments within score repaired
34 | - Font-lock: p-field variables in light color mode are darker
35 | - Font-lock: multiline comment in score implemented
36 | - Font-lock: <CsLicense> xml tag added
37 | - Syntax-table: multiline and single-line not conflicting
38 | - Repl: csoundAPI Installation script now finds the makefile
39 | - Repl: add instance specific environment variable options
40 | - Score: all score events start immediately based on the lowest p2 value in block
41 | - Eldoc: functional syntax with specific rate, colon seperated, implemented
42 | 
43 | ## [0.1.1]
44 | 
45 | ### Bug fixes
46 | - Csound eldoc function was missing from the major-mode function
47 | 


--------------------------------------------------------------------------------
/csound-skeleton.el:
--------------------------------------------------------------------------------
 1 | ;;; csound-skeleton.el --- A major mode for interacting and coding Csound
 2 | 
 3 | ;; Copyright (C) 2017 - 2023  Hlöðver Sigurðsson
 4 | 
 5 | ;; Author: Hlöðver Sigurðsson <hlolli@gmail.com>
 6 | ;; Version: 0.2.9
 7 | ;; Package-Requires: ((emacs "25") (shut-up "0.3.2") (multi "2.0.1") (dash "2.16.0") (highlight "0"))
 8 | ;; URL: https://github.com/hlolli/csound-mode
 9 | 
10 | ;; This program is free software; you can redistribute it and/or modify
11 | ;; it under the terms of the GNU General Public License as published by
12 | ;; the Free Software Foundation, either version 3 of the License, or
13 | ;; (at your option) any later version.
14 | 
15 | ;; This program is distributed in the hope that it will be useful,
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 | ;; GNU General Public License for more details.
19 | 
20 | ;; You should have received a copy of the GNU General Public License
21 | ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
22 | 
23 | ;;; Commentary:
24 | ;;  Skeleton for when creating new .csd file.
25 | 
26 | ;; Initialize defaults values
27 | (defcustom csound-skeleton-default-sr 44100
28 |   "Set the default sr value when creating new csound file."
29 |   :type 'integer
30 |   :group 'csound-mode)
31 | 
32 | (defcustom csound-skeleton-default-ksmps 32
33 |   "Set the default ksmps value when creating new csound file."
34 |   :type 'integer
35 |   :group 'csound-mode)
36 | 
37 | (defcustom csound-skeleton-default-options "-odac"
38 |   "Set the default option flags when creating new csound file."
39 |   :type 'string
40 |   :group 'csound-mode)
41 | 
42 | (defcustom csound-skeleton-default-additional-header ""
43 |   "Set the default additional header information when creating new csound file."
44 |   :type 'string
45 |   :group 'csound-mode)
46 | 
47 | (define-skeleton csound-skeleton-new-csd
48 |   "Skeleton for auto-insert in csound-mode."
49 |   nil
50 |   "<CsoundSynthesizer>\n"
51 |   "<CsOptions>\n"
52 |   (concat csound-skeleton-default-options)
53 |   "\n</CsOptions>\n"
54 |   "<CsInstruments>\n\n"
55 |   (concat "sr = " (number-to-string csound-skeleton-default-sr) "\n")
56 |   (concat "ksmps = " (number-to-string csound-skeleton-default-ksmps) "\n")
57 |   "nchnls = 2\n"
58 |   "0dbfs = 1.0\n"
59 |   "\n"
60 |   (concat csound-skeleton-default-additional-header)
61 |   "\n\n"
62 |   "instr 1\n\nendin\n\n"
63 |   "</CsInstruments>\n"
64 |   "<CsScore>\n"
65 |   "i1 0 1\n"
66 |   "</CsScore>\n"
67 |   "</CsoundSynthesizer>\n")
68 | 
69 | (eval-when-compile
70 |   (define-auto-insert "\\.csd\\'"
71 |     [csound-skeleton-new-csd (lambda ()
72 | 			       (goto-line 11)
73 | 			       (run-with-idle-timer 0.15 nil
74 | 						    (lambda () (csound-font-lock-flush-buffer))))]))
75 | 
76 | (provide 'csound-skeleton)
77 | 
78 | ;;; csound-skeleton.el ends here
79 | 


--------------------------------------------------------------------------------
/csound-manual-lookup.el:
--------------------------------------------------------------------------------
 1 | ;;; csound-eldoc.el --- A major mode for interacting and coding Csound
 2 | ;;  Copyright (C) 2017 - 2023  Hlöðver Sigurðsson
 3 | 
 4 | ;; Author: Hlöðver Sigurðsson <hlolli@gmail.com>
 5 | ;; Version: 0.2.7
 6 | ;; Package-Requires: ((emacs "25") (shut-up "0.3.2") (multi "2.0.1") (dash "2.16.0") (highlight "0"))
 7 | ;; URL: https://github.com/hlolli/csound-mode
 8 | 
 9 | ;; This program is free software; you can redistribute it and/or modify
10 | ;; it under the terms of the GNU General Public License as published by
11 | ;; the Free Software Foundation, either version 3 of the License, or
12 | ;; (at your option) any later version.
13 | 
14 | ;; This program is distributed in the hope that it will be useful,
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 | ;; GNU General Public License for more details.
18 | 
19 | ;; You should have received a copy of the GNU General Public License
20 | ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
21 | 
22 | ;;; Commentary:
23 | 
24 | ;;  This module implements Csound manual lookup functionality for 
25 | ;;; csound-mode. 
26 | 
27 | ;;; Code:
28 | 
29 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 | ;;; Csound manual lookup
31 | ;;;
32 | ;;; DESCRIPTION
33 | ;;; This extension enables the interactive lookup of Csound functions in the
34 | ;;; Csound reference manual located at the Csound homepage.
35 | ;;; 
36 | ;;; TODO:
37 | ;;; - Implement a global variable referring to the Csound manual base url.
38 | ;;;   This might be handy e.g. when the manual is installed locally.
39 | ;;;
40 | ;;; AUTHOR
41 | ;;; Ruben Philipp
42 | ;;;
43 | ;;; CREATED
44 | ;;; 2023-12-26, Lütgendortmund
45 | ;;; 
46 | ;;; $$ Last modified:  16:40:01 Tue Oct 24 2023 CEST
47 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48 | 
49 | (require 'csound-opcodes)
50 | (require 'csound-util)
51 | (require 'cl-lib)
52 | (require 'browse-url)
53 | (require 'thingatpt)
54 | 
55 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
56 | ;;; The url to the Csound manual
57 | ;;; Customizing this could be useful e.g. when the manual is
58 | ;;; installed locally.
59 | ;;; RP  Wed Sep 20 19:51:22 2023
60 | (defcustom csound-manual-url
61 |   "https://csound.com/docs/manual/"
62 |   "The URL to the root directory of the Csound manual."
63 |   :group 'csound-mode-manual-lookup
64 |   :type 'string)
65 | 
66 | (defun csound-manual-lookup ()
67 |   (interactive)
68 |   (let* ((lemma (thing-at-point 'word 'no-properties))
69 |          (lookup-lemma (if (gethash lemma
70 |                                     csdoc-opcode-database)
71 |                            (downcase lemma)
72 |                          (read-string "Lookup function in Csound manual: "))))
73 |     (browse-url (concat csound-manual-url
74 |                         lookup-lemma
75 |                         ".html"))))
76 | 
77 | ;;; key binding
78 | 
79 | (eval-after-load 'csound-mode
80 |   '(define-key csound-mode-map (kbd "C-c C-d h") 'csound-manual-lookup))
81 | 
82 | 
83 | (provide 'csound-manual-lookup)
84 | 
85 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
86 | ;;; EOF csound-manual-lookup.el
87 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
  1 | [![License GPL 3][badge-license]][copying]
  2 | [![MELPA Stable](https://stable.melpa.org/packages/csound-mode-badge.svg)](https://stable.melpa.org/#/csound-mode)
  3 | [![Melpa Status](http://melpa.milkbox.net/packages/csound-mode-badge.svg)](http://melpa.milkbox.net/#/csound-mode)
  4 | 
  5 | 
  6 | # csound-mode
  7 | This package provides both a basic major mode for editing Csound files,
  8 | as well as a REPL for fast feedback when composing/sound-designing using Csound.
  9 | 
 10 | `csound-mode` provides a set of essential features for interactive development:
 11 | * REPL
 12 | * Interactive code evaluation
 13 | * Code completion
 14 | * ElDoc
 15 | * Indentation rules
 16 | * Syntax highlighting and rainbow delimited score parameters
 17 | 
 18 | ## Installation
 19 | 
 20 | You can install `csound-mode` from `MELPA` using the following command:
 21 | 
 22 | <kbd>M-x package-install [RET] csound-mode [RET]</kbd>
 23 | 
 24 | Alternatively, [download latest release.](https://github.com/hlolli/csound-mode/releases/download/v9.2.0/csound-mode-0.2.0.zip)
 25 | and add it manually to load-path like shown here:
 26 | 
 27 | ```el
 28 | ;; Change directory path according to csound-mode dir location.
 29 | (add-to-list 'load-path "~/.emacs.d/csound-mode/")
 30 | (require 'csound-mode)
 31 | ```
 32 | 
 33 | ## Requirements
 34 | 
 35 | - Emacs 25+
 36 | - Csound 6.10+ (any release/compilation after 1. December 2017)
 37 | 
 38 | ## Usage
 39 | 
 40 | `csound-mode` comes with major-mode-hooks, meaning that every time a csound file(.csd/.orc/.sco) is opened in emacs, `csound-mode` will be automatically loaded as major mode. While making it easier to install, this could potentially overwrite other major-mode you have set for csound files.
 41 | 
 42 | If you're using `csound-mode` directly from the git repo, and you happen to use the `use-package` macro. Then this could be used in your init.el file.
 43 | 
 44 | ```Clojure
 45 | (use-package csound-mode
 46 |   :mode (("\\.csd\\'" . csound-mode)
 47 |      ("\\.orc\\'" . csound-mode)
 48 |      ("\\.sco\\'" . csound-mode)
 49 |      ("\\.udo\\'" . csound-mode))
 50 |   :load-path "packages/csound-mode/")
 51 | ```
 52 | With more options
 53 | ```emacs-lisp
 54 | (use-package csound-mode
 55 |   :ensure t
 56 |   :custom
 57 |   (csound-skeleton-default-sr 96000)
 58 |   (csound-skeleton-default-ksmps 16)
 59 |   (csound-skeleton-default-options "-d -oadc -W -3")
 60 |   (csound-skeleton-default-additional-header "#include \"PATH/TO/YOU/UDOs.udo\"")
 61 |   :mode (("\\.csd\\'" . csound-mode)
 62 |          ("\\.orc\\'" . csound-mode)
 63 |          ("\\.sco\\'" . csound-mode)
 64 |          ("\\.udo\\'" . csound-mode))
 65 |   :load-path "~/.emacs.d/elpa/csound-mode/")
 66 | ```
 67 | 
 68 | ## Keybindings
 69 | <kbd>C-c C-p</kbd> `csound-play` Same as doing `csound filename -odac`
 70 | 
 71 | <kbd>C-c C-r</kbd> `csound-render` Same as doing `csound filename -o filename.wav`
 72 | 
 73 | <kbd>C-c C-z</kbd> `csound-repl-start`
 74 | 
 75 | <kbd>C-c C-k</kbd> `csound-abort-compilation` abort compilation (e.g. playback)
 76 | 
 77 | <kbd>C-M-x</kbd>/<kbd>C-c C-c</kbd> `csound-evaluate-region`
 78 | 
 79 | <kbd>C-x C-e</kbd> `csound-evaluate-line`
 80 | 
 81 | <kbd>C-c C-l</kbd> `csound-repl-interaction-evaluate-last-expression`
 82 | 
 83 | <kbd>C-c C-s</kbd> `csound-score-align-block` cursor needs to be within a score block
 84 | 
 85 | <kbd>M-.</kbd> `csound-score-find-instr-def` cursor needs to be within a score block
 86 | 
 87 | <kbd>C-c C-d h</kbd> `csound-manual-lookup` searches for a function definition in the Csound-manual
 88 | 
 89 | 
 90 | ## Run the tests
 91 | 
 92 | The tests depend on the package _test-simple.el_.
 93 | Run the tests locally from the command line
 94 | 
 95 | ```
 96 | emacs --batch --no-site-file --no-splash --load test/csound-mode-tests.el
 97 | ```
 98 | 
 99 | 
100 | 
101 | [badge-license]: https://img.shields.io/badge/license-GPL_3-green.svg
102 | [COPYING]: http://www.gnu.org/copyleft/gpl.html
103 | 


--------------------------------------------------------------------------------
/csound-util.el:
--------------------------------------------------------------------------------
  1 | ;;; csound-util.el --- A major mode for interacting and coding Csound
  2 | ;; Copyright (C) 2017 - 2023  Hlöðver Sigurðsson
  3 | 
  4 | ;; Author: Hlöðver Sigurðsson <hlolli@gmail.com>
  5 | ;; Version: 0.2.9
  6 | ;; Package-Requires: ((emacs "25") (shut-up "0.3.2") (multi "2.0.1") (dash "2.16.0") (highlight "0"))
  7 | ;; URL: https://github.com/hlolli/csound-mode
  8 | 
  9 | ;; This program is free software; you can redistribute it and/or modify
 10 | ;; it under the terms of the GNU General Public License as published by
 11 | ;; the Free Software Foundation, either version 3 of the License, or
 12 | ;; (at your option) any later version.
 13 | 
 14 | ;; This program is distributed in the hope that it will be useful,
 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 17 | ;; GNU General Public License for more details.
 18 | 
 19 | ;; You should have received a copy of the GNU General Public License
 20 | ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 21 | 
 22 | 
 23 | ;;; Commentary:
 24 | ;; Helper functions needed by various csound-mode files.
 25 | 
 26 | ;;; Code:
 27 | 
 28 | (require 'csound-opcodes)
 29 | (require 'dash)
 30 | 
 31 | (defun csound-util-chomp (str)
 32 |   "Chomp leading and tailing whitespace from STR."
 33 |   (while (string-match "\\`\n+\\|^\\s-+\\|\\s-+$\\|\n+\\'"
 34 | 		       str)
 35 |     (setq str (replace-match "" t t str)))
 36 |   str)
 37 | 
 38 | (defun csound-util-untab (str)
 39 |   (while (string-match "\t" str)
 40 |     (setq str (replace-match " " t t str)))
 41 |   str)
 42 | 
 43 | (defun csound-util-line-boundry ()
 44 |   "returns the end point of the line and stops befor the occurence of
 45 | a commentary"
 46 |   (let ((comment (save-excursion 
 47 |                    (search-forward ";" (line-end-position 1) t 1))) 
 48 | 	(multi-comment (save-excursion
 49 |                          (search-forward
 50 | 			  "/*" (line-end-position 1) t 1))))
 51 |     (cond
 52 |      (comment (1- comment))
 53 |      (multi-comment (1- (1- multi-comment)))
 54 |      (t (line-end-position 1)))))
 55 | 
 56 | (defun csound-util-remove-comment-in-string (string)
 57 |   "replaces comments in a string with an empty string and gives back the string without the
 58 | comments"
 59 |   (->> string
 60 |        (replace-regexp-in-string ";.*" "")
 61 |        (replace-regexp-in-string "/\\*\\(.\\|\n\\)*\\*/" "")))
 62 | 
 63 | (defun csound-util-recursive-count* (regex string start)
 64 |   "counts the appearence of the regex in the given string"
 65 |   (if (string-match regex string start)
 66 |       (+ 1 (csound-util-recursive-count* regex string (match-end 0)))
 67 |     0))
 68 | 
 69 | (defun csound-util-recursive-count (regex string start)
 70 |   "counts only the appearence of the regex in the given string with
 71 | comments removed"
 72 |   (csound-util-recursive-count* regex (csound-util-remove-comment-in-string string) start))
 73 | 
 74 | 
 75 | (defun csound-util--generate-random-uuid ()
 76 |   "Insert a random UUID.
 77 | Example of a UUID: 1df63142-a513-c850-31a3-535fc3520c3d
 78 | WARNING: this is a simple implementation.
 79 | The chance of generating the same UUID is much higher than a robust algorithm.."
 80 |   (format "%04x%04x-%04x-%04x-%04x-%06x%06x"
 81 | 	  (random (expt 16 4))
 82 | 	  (random (expt 16 4))
 83 | 	  (random (expt 16 4))
 84 | 	  (random (expt 16 4))
 85 | 	  (random (expt 16 4))
 86 | 	  (random (expt 16 6))
 87 | 	  (random (expt 16 6))))
 88 | 
 89 | (defun csound-util-strip-text-properties (txt)
 90 |   (set-text-properties 0 (length txt) nil txt)
 91 |   txt)
 92 | 
 93 | 
 94 | (defun csound-util-opcode-completion-at-point ()
 95 |   (let ((bounds (bounds-of-thing-at-point 'word)))
 96 |     (when bounds
 97 |       (list (car bounds)
 98 |             (cdr bounds)
 99 |             csdoc-opcode-database
100 |             :exclusive 'no
101 |             :company-docsig (lambda (cand)
102 | 			      (csound-util-chomp (replace-regexp-in-string
103 | 						  "\n\\|\s+" "\s"
104 | 						  (nth 3 (gethash cand csdoc-opcode-database)))))
105 |             :company-doc-buffer (lambda (cand)
106 | 				  (prin1-to-string (nth 11 (gethash cand csdoc-opcode-database))))
107 | 	    ;;:company-location (lambda (cand) (nth 11 (gethash cand csdoc-opcode-database)))
108 | 	    ))))
109 | 
110 | 
111 | (provide 'csound-util)
112 | 
113 | ;;; csound-util.el ends here
114 | 


--------------------------------------------------------------------------------
/csound-repl-interaction.el:
--------------------------------------------------------------------------------
  1 | ;;; csound-repl-interaction.el --- A major mode for interacting and coding Csound -*- lexical-binding: t; -*-
  2 | 
  3 | ;; Copyright (C) 2017 - 2023  Hlöðver Sigurðsson
  4 | 
  5 | ;; Author: Hlöðver Sigurðsson <hlolli@gmail.com>
  6 | ;; Version: 0.2.9
  7 | ;; Package-Requires: ((emacs "25") (shut-up "0.3.2") (multi "2.0.1") (dash "2.16.0") (highlight "0"))
  8 | ;; URL: https://github.com/hlolli/csound-mode
  9 | 
 10 | ;; This program is free software; you can redistribute it and/or modify
 11 | ;; it under the terms of the GNU General Public License as published by
 12 | ;; the Free Software Foundation, either version 3 of the License, or
 13 | ;; (at your option) any later version.
 14 | 
 15 | ;; This program is distributed in the hope that it will be useful,
 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18 | ;; GNU General Public License for more details.
 19 | 
 20 | ;; You should have received a copy of the GNU General Public License
 21 | ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 22 | 
 23 | ;;; Commentary:
 24 | 
 25 | ;; Here are all the functionalities that can be used
 26 | ;; when typing a command to the comint (csound-repl)
 27 | ;; prompt.
 28 | 
 29 | ;;; Code:
 30 | 
 31 | 
 32 | (require 'csound-score)
 33 | (require 'csound-util)
 34 | (require 'multi)
 35 | (require 'shut-up)
 36 | 
 37 | ;; (defun csound-repl-interaction--plot (table-num)
 38 | ;;   (if (not (eq 0 (shut-up
 39 | ;; 		   (shell-command "gnuplot --version"))))
 40 | ;;       (error "gnuplot was not found")
 41 | ;;     (let ((prev-buffer (buffer-name))
 42 | ;; 	  (tmp-filename (concat "/tmp/" (csound-util--generate-random-uuid) ".png"))
 43 | ;; 	  (table-str "")
 44 | ;; 	  (tab-size (csoundTableLength csound-repl--csound-instance table-num))
 45 | ;; 	  (index 0))
 46 | ;;       (if (eq -1 tab-size)
 47 | ;; 	  (error  "Table %d doesn't exist" table-num)
 48 | ;; 	(progn
 49 | ;; 	  (while (< index tab-size)
 50 | ;; 	    (setq table-str (concat table-str
 51 | ;; 				    (number-to-string index) " "
 52 | ;; 				    (number-to-string
 53 | ;; 				     (csoundTableGet
 54 | ;; 				      csound-repl--csound-instance
 55 | ;; 				      table-num index)) "\n")
 56 | ;; 		  index (1+ index)))
 57 | ;; 	  ;; (setq table-list (string-join table-list " "))
 58 | ;; 	  ;; (print table-list)
 59 | ;; 	  (shell-command
 60 | ;; 	   (concat
 61 | ;; 	    (format "echo '%s' |" table-str)
 62 | ;; 	    (format
 63 | ;; 	     (concat"gnuplot -e \"set term png size 480,320;"
 64 | ;; 		    (format "set title 'tbl: %s';" table-num)
 65 | ;; 		    "set tics font ', 10';"
 66 | ;; 		    "set lmargin at screen 0.15;"
 67 | ;; 		    "set output '%s';"
 68 | ;; 		    (format "set xrange [0:%s];" tab-size)
 69 | ;; 		    "plot '-' notitle with line;"
 70 | ;; 		    "\"")
 71 | ;; 	     tmp-filename)))
 72 | ;; 	  (csound-repl--insert-message (format "\nfile://%s" tmp-filename))
 73 | ;; 	  (if (string-equal prev-buffer csound-repl-buffer-name)
 74 | ;; 	      (funcall 'iimage-mode)
 75 | ;; 	    (progn
 76 | ;; 	      (switch-to-buffer-other-window csound-repl-buffer-name)
 77 | ;; 	      (with-current-buffer (buffer-name) (funcall 'iimage-mode))
 78 | ;; 	      (switch-to-buffer-other-window prev-buffer))))))))
 79 | 
 80 | (setq csound-repl-interaction--last-callback nil)
 81 | 
 82 | (defun csound-repl-interaction-input-message (csound-udp input)
 83 |   (let ((callback (lambda () (process-send-string csound-udp (concat "$" input)))))
 84 |     (funcall callback)
 85 |     (setq csound-repl-interaction--last-callback callback)))
 86 | 
 87 | (defmulti read-csound-repl (op _ &rest _)
 88 |   op)
 89 | 
 90 | (defmulti-method read-csound-repl 'i (_ csound-udp input)
 91 |   (csound-repl-interaction-input-message csound-udp (csound-score-trim-time input)))
 92 | 
 93 | (defmulti-method read-csound-repl 'f (_ csound-udp input)
 94 |   (csound-repl-interaction-input-message csound-udp input))
 95 | 
 96 | (defmulti-method-fallback read-csound-repl (_ csound-udp input)
 97 |   (process-send-string csound-udp input))
 98 | 
 99 | ;; (defmulti-method read-csound-repl 'table (_ csound-udp args)
100 | ;;   (let ((callback (lambda ()
101 | ;; 		    (csound-repl-interaction--plot
102 | ;; 		     (string-to-number (nth 1 args))))))
103 | ;;     (funcall callback)
104 | ;;     (setq csound-repl-interaction--last-callback callback)))
105 | 
106 | (defun csound-repl-interaction-evaluate-last-expression ()
107 |   "Evaluate the last expression typed into the repl."
108 |   (interactive)
109 |   (if csound-repl-interaction--last-callback
110 |       (funcall csound-repl-interaction--last-callback)
111 |     (message "Repl history is empty")))
112 | 
113 | (provide 'csound-repl-interaction)
114 | 
115 | ;;; csound-repl-interaction.el ends here
116 | 


--------------------------------------------------------------------------------
/dev-script/xml-to-emacsdb.clj:
--------------------------------------------------------------------------------
  1 | ;; Clojure script to generate csound-opcodes.el
  2 | ;; Some manual changes may be needed,
  3 | ;; Zerodbfs needs to be changed to 0dbfs
  4 | ;; `tab` and `tb` opcodes need to be split up
  5 | (ns xml-to-emacsdb
  6 |   (:require [clojure.java.io :as io]
  7 |             [clojure.xml :as xml]
  8 |             [clojure.string :as string]))
  9 | 
 10 | (def ELPA-requirements-prefix
 11 |   (let [mode (slurp "../csound-mode.el")
 12 |         mode (string/replace-first mode "csound-mode" "csound-opcodes")
 13 |         find-commentary-tag (.indexOf mode "Commentary:")]
 14 |     (str (subs mode 0 (+ 12 find-commentary-tag))
 15 |          ";; Auto generated database of opcodes extraced from the manual\n"
 16 |          ";;; Code:\n")))
 17 | 
 18 | (def ELPA-requirements-postfix
 19 |   ";;; csound-opcodes.el ends here")
 20 | 
 21 | (def OPCODE-XML-DIR "/home/hlolli/csound/manual/opcodes/")
 22 | 
 23 | (def quoted-ampersands
 24 |   (loop [docs (rest (file-seq (io/file OPCODE-XML-DIR)))
 25 |          xml-string ""]
 26 |     (if (empty? docs)
 27 |       xml-string
 28 |       (recur (rest docs)
 29 |              (str xml-string
 30 |                   (-> (string/replace
 31 |                        (slurp (first docs))
 32 |                        "&" "")
 33 |                       (string/replace "<command>" "")
 34 |                       (string/replace "</command>" "")))))))
 35 | 
 36 | (defn parse [s]
 37 |   (xml/parse
 38 |    (java.io.ByteArrayInputStream. (.getBytes s))))
 39 | 
 40 | (def parsed-docs (parse (str "<manual>" quoted-ampersands "</manual>")))
 41 | 
 42 | (defn find-synopsis [vek]
 43 |   (loop [v vek]
 44 |     (if (empty? v)
 45 |       "ERROR"
 46 |       (if (= (:tag (second (:content (first v)))) :synopsis)
 47 |         (apply str (seq (interpose "\n"
 48 |                                    (filter #(not (nil? %))
 49 |                                            (apply vector
 50 |                                                   (for [x (:content (first v))]
 51 |                                                     (when (= :synopsis (:tag x))
 52 |                                                       (-> (first (:content x))
 53 |                                                           (string/replace "\n" "")
 54 |                                                           (string/replace "\t" "")
 55 |                                                           (string/replace "\\" "")
 56 |                                                           (string/replace (re-pattern "\\s+") " ")
 57 |                                                           (string/trim)))))))))
 58 |         (recur (rest v))))))
 59 | 
 60 | (defn find-docstring [vek]
 61 |   (loop [v vek]
 62 |     (if (empty? v)
 63 |       ""
 64 |       (if (= (:tag (second (:content (first v)))) :refpurpose)
 65 |         (str (nth (:content (first v)) 3))
 66 |         (recur (rest v))))))
 67 | 
 68 | (defn fix-csound-names [id-str]
 69 |   (case id-str
 70 |     "Zerodbfs" "0dbfs"
 71 |     "notequal" "!="
 72 |     "equals" "=="
 73 |     id-str))
 74 | 
 75 | (def missing-opcodes
 76 |   (apply
 77 |    str
 78 |    (map
 79 |     #(format
 80 |       "(puthash \"%s\" '(:template \"%s\" :doc \"%s\") csdoc-opcode-database)\n"
 81 |       (nth % 0)
 82 |       (nth % 1)
 83 |       (nth % 2))
 84 |     [["schedkwhen" "schedkwhen ktrigger, kmintim, kmaxnum, kinsnum, kwhen, kdur [, ip4] [, ip5] [...]" "Adds a new score event generated by a k-rate trigger."]
 85 |      ["schedwhen" "schedwhen ktrigger, kinsnum, kwhen, kdur [, ip4] [, ip5] [...]"
 86 |       "Adds a new score event."]
 87 |      ["massign" "massign midichn, instr" "assigns midi channel to instrument"]
 88 |      ["event" "event \"scorechar\", kinsnum, kdelay, kdur, [, kp4] [, kp5] [, ...]" "Generates a score event from an instrument."]
 89 |      ["event_i" "event_i \"scorechar\", iinsnum, idelay, idur, [, ip4] [, ip5] [, ...]" "Generates a score event from an instrument."]
 90 |      ["prints" "prints \"string\" [, kval1] [, kval2] [...]" "Prints at init-time using a printf() style syntax."]
 91 |      ["printks" "printks \"string\", itime [, kval1] [, kval2] [...]" "Prints at k-rate using a printf() style syntax."]
 92 |      ["printks2" "printks2 \"string\", kval" "Prints a new value every time a control variable changes using a printf() style syntax."]])))
 93 | 
 94 | (defn spit-emacs-file []
 95 |   (spit "csound-opcodes.el"
 96 |         (loop [docs (:content parsed-docs)
 97 |                out ""]
 98 |           (if (empty? docs)
 99 |             (str
100 |              ELPA-requirements-prefix "\n"
101 |              "(setq csdoc-opcode-database (make-hash-table :test 'equal))\n"
102 |              out missing-opcodes
103 |              "\n (provide 'csound-opcodes)\n"
104 |              ELPA-requirements-postfix)
105 |             (let [doc (first docs)
106 |                   id (-> doc :attrs :id)
107 |                   id (fix-csound-names id)
108 |                   template (find-synopsis (-> doc :content))
109 |                   docstring (if-not (< 2 (count (-> doc :content)))
110 |                               ""
111 |                               (let [untrimmed (-> doc
112 |                                                   :content (nth 3)
113 |                                                   :content second
114 |                                                   :content first)]
115 |                                 (if (string? untrimmed)
116 |                                   (string/trim untrimmed)
117 |                                   (if (map? untrimmed)
118 |                                     (-> untrimmed
119 |                                         :content
120 |                                         first
121 |                                         string/trim)
122 |                                     (str "WTF: " untrimmed)))))]
123 |               (recur (rest docs)
124 |                      (let [strcand (format "(puthash \"%s\" '(:template \"%s\" :doc \"%s\") csdoc-opcode-database)"
125 |                                            id (str template)
126 |                                            (string/replace docstring "\"" "'"))]
127 |                        (if (or (re-find #"null" strcand)
128 |                                (re-find #"ERROR" strcand)
129 |                                (re-find #";" strcand))
130 |                          out (str out strcand "\n")))))))))
131 | 
132 | ;; (spit-emacs-file)
133 | 
134 | 
135 | ;; (:content ((:content (first (:content parsed-docs))) 3))
136 | ;; ((:content ((:content ((:content parsed-docs) 0)) 5)) 1)
137 | 
138 | 
139 | ;; DANGEROUS version bump function
140 | ;; find ./ -type f -exec sed -i -e 's/;; Version: 0\.1\.1/;; Version: 0.1.2/g' {} \;
141 | ;; OSX version bump
142 | ;; find ./ -type f -exec sed -i '' -e 's/;; Version: 0\.1\.1/;; Version: 0.1.2/g' {} \;
143 | 


--------------------------------------------------------------------------------
/csound-mode.el:
--------------------------------------------------------------------------------
  1 | ;;; csound-mode.el --- A major mode for interacting and coding Csound
  2 | ;;  Copyright (C) 2017 - 2023  Hlöðver Sigurðsson
  3 | 
  4 | ;; Author: Hlöðver Sigurðsson <hlolli@gmail.com>
  5 | ;; Version: 0.2.9
  6 | ;; Package-Requires: ((emacs "25") (shut-up "0.3.2") (multi "2.0.1") (dash "2.16.0") (highlight "0"))
  7 | ;; URL: https://github.com/hlolli/csound-mode
  8 | 
  9 | ;; This program is free software; you can redistribute it and/or modify
 10 | ;; it under the terms of the GNU General Public License as published by
 11 | ;; the Free Software Foundation, either version 3 of the License, or
 12 | ;; (at your option) any later version.
 13 | 
 14 | ;; This program is distributed in the hope that it will be useful,
 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 17 | ;; GNU General Public License for more details.
 18 | 
 19 | ;; You should have received a copy of the GNU General Public License
 20 | ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 21 | 
 22 | ;;; Commentary:
 23 | 
 24 | ;;  This file stores mode-specific bindings to `csound-mode`,
 25 | ;;  "offline" csound-interactions and major-mode definition,
 26 | ;;  syntax table.
 27 | 
 28 | ;;; Code:
 29 | 
 30 | 
 31 | (require 'font-lock)
 32 | (require 'cl-lib)
 33 | (require 'csound-eldoc)
 34 | (require 'csound-font-lock)
 35 | (require 'csound-repl)
 36 | (require 'csound-indentation)
 37 | (require 'csound-score)
 38 | (require 'csound-skeleton)
 39 | (require 'csound-util)
 40 | (require 'csound-manual-lookup)
 41 | (require 'dash)
 42 | (require 'shut-up)
 43 | 
 44 | 
 45 | (defgroup csound-mode nil
 46 |   "Tiny functionality enhancements for evaluating sexps."
 47 |   :prefix "csound-mode-"
 48 |   :group 'csound-mode)
 49 | 
 50 | (defvar csound-mode-syntax-table
 51 |   (let ((st (make-syntax-table)))
 52 |     (modify-syntax-entry ?_ "w" st)
 53 |     ;; (modify-syntax-entry ?+ "w" st)
 54 |     ;; (modify-syntax-entry ?- "w" st)
 55 |     (modify-syntax-entry ?. "w" st)
 56 |     (modify-syntax-entry ?! "w" st)
 57 |     (modify-syntax-entry ?% "-" st)
 58 |     (modify-syntax-entry ?\" "\"\"" st)
 59 |     ;; Comment syntax
 60 |     (modify-syntax-entry ?\; "<" st)
 61 |     (modify-syntax-entry ?\n ">" st)
 62 |     (modify-syntax-entry ?/ ". 12" st)
 63 |      (modify-syntax-entry ?\n "> " st)
 64 |     ;; good read: https://www.lunaryorn.com/posts/syntactic-fontification-in-emacs.html
 65 |     (modify-syntax-entry ?/ ". 14b" st)
 66 |     (modify-syntax-entry ?* ". 23b" st)
 67 |     st)
 68 |   "Syntax table for csound-mode")
 69 | 
 70 | (defcustom csound-play-flags "-odac"
 71 |   "Additional flags to pass to csound when playing the file in current buffer."
 72 |   :group 'csound-mode
 73 |   :type 'string)
 74 | 
 75 | (defcustom csound-render-flags ""
 76 |   "Additional flags to pass to csound when rendering csound to file."
 77 |   :group 'csound-mode
 78 |   :type 'string)
 79 | 
 80 | (defun csound-play ()
 81 |   "Play the csound file in current buffer."
 82 |   (interactive)
 83 |   (if csound-repl-start-server-p
 84 |       (compile (format "csound %s %s" csound-play-flags (buffer-file-name)))
 85 |     (process-send-string csound-repl--udp-client-proc
 86 |                          (buffer-substring
 87 |                           (point-min) (point-max)))))
 88 | 
 89 | 
 90 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 91 | ;;; csound-abort-compilation
 92 | ;;;
 93 | ;;; DESCRIPTION:
 94 | ;;; This function aborts the compilation of a Csound file. This is simply
 95 | ;;; done by killing the compilation process in the main compilation buffer
 96 | ;;; (i.e. *compilation*)
 97 | ;;;
 98 | ;;; TODO:
 99 | ;;; - Make this context-sensitive, in case multiple compilation buffers are
100 | ;;;   active in an Emacs session.
101 | ;;;
102 | ;;; author: Ruben Philipp
103 | ;;; created: 2023-12-26, Lütgendortmund
104 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
105 | 
106 | (defun csound-abort-compilation ()
107 |   (interactive)
108 |   (let ((current-buffer (current-buffer)))
109 |     (switch-to-buffer "*compilation*")
110 |     (kill-compilation)
111 |     (switch-to-buffer current-buffer)))
112 | 
113 | (eval-after-load 'csound-mode
114 |   '(define-key csound-mode-map (kbd "C-c C-k") 'csound-abort-compilation))
115 | 
116 | 
117 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
118 | 
119 | 
120 | (defun csound-render (bit filename)
121 |   "Render csound to file."
122 |   (interactive
123 |    (list
124 |     (read-string "File bit-value(16/24/32), defaults to 16: ")
125 |     (read-string (format "Filename, defaults to %s.wav: " (file-name-base)))))
126 |   ;;(compile (format "csound -o %s" (buffer-file-name)))
127 |   ;; (message "var1: %s var2: %s" var1 var2)
128 |   (let ((filename (if (string= "" filename)
129 |                       (concat (file-name-base) ".wav")
130 |                     filename)))
131 |     (if csound-repl-start-server-p
132 |         (compile (format "csound %s %s -o %s --format=%s %s"
133 |                          csound-render-flags
134 |                          (buffer-file-name)
135 |                          filename
136 |                          (-> (split-string filename "\\.")
137 |                              cl-rest cl-first)
138 |                          (cl-case (string-to-number bit)
139 |                            (32 "-f")
140 |                            (24 "-3")
141 |                            (t "-s"))))
142 |       (message "%s" "You did not start a csound server subprocess.
143 |            Configure rendering to a file in you CSD file's
144 |            <CsOptions> section." ))))
145 | 
146 | (defun csound-repl-start ()
147 |   "Start the csound-repl."
148 |   (interactive)
149 |   (if (and csound-repl-start-server-p
150 |            (not (executable-find "csound")))
151 |       (error "Csound is not installed on your computer")
152 |     (csound-repl--buffer-create)))
153 | 
154 | (defvar csound-mode-map nil)
155 | 
156 | (setq csound-mode-map
157 |       (let ((map (make-sparse-keymap)))
158 |         ;; Offline keybindings
159 |         (define-key map (kbd "C-c C-p") 'csound-play)
160 |         (define-key map (kbd "C-c C-r") 'csound-render)
161 |         ;; REPL Keybindings
162 |         (define-key map (kbd "C-c C-z") 'csound-repl-start)
163 |         (define-key map (kbd "C-M-x")   'csound-repl-evaluate-region)
164 |         (define-key map (kbd "C-c C-c") 'csound-repl-evaluate-region)
165 |         (define-key map (kbd "C-x C-e") 'csound-repl-evaluate-line)
166 |         (define-key map (kbd "C-c C-l") 'csound-repl-interaction-evaluate-last-expression)
167 |         ;; Utilities
168 |         (define-key map (kbd "C-c C-s") 'csound-score-align-block)
169 |         (define-key map (kbd "M-.")     'csound-score-find-instr-def)
170 | 	(define-key map (kbd "C-c C-n")   'csound-skeleton-new-csd)
171 |         ;; (define-key map (kbd "C-c C-f") 'csound-repl-plot-ftgen)
172 |         map))
173 | 
174 | ;;;###autoload
175 | (define-derived-mode csound-mode
176 |   fundamental-mode "Csound Mode"
177 |   "A major mode for interacting and coding Csound"
178 |   :syntax-table csound-mode-syntax-table
179 |   (setq-local eldoc-documentation-function 'csound-eldoc-function)
180 |   (setq-local comment-start ";; ")
181 |   ;; (setq-local comment-end "")
182 |   (setq-local indent-line-function 'csound-indentation-line)
183 | 
184 |   (setq-local compilation-scroll-output t)
185 |   (setq-local ad-redefinition-action 'accept)
186 |   (setq-local font-lock-comment-end-skip "\n")
187 |   (add-hook 'completion-at-point-functions #'csound-util-opcode-completion-at-point nil t)
188 |   ;; (add-hook 'skeleton-end-hook #'csound-font-lock-flush-buffer nil t)
189 |   (font-lock-add-keywords nil csound-font-lock-list t)
190 |   (shut-up
191 |     (with-silent-modifications
192 |       (csound-font-lock-flush-buffer)
193 |       (csound-font-lock--flush-score))))
194 | 
195 | ;;;###autoload
196 | (add-to-list 'auto-mode-alist `(,(concat "\\." (regexp-opt '("csd" "orc" "sco" "udo")) "\\'") . csound-mode))
197 | 
198 | (provide 'csound-mode)
199 | 
200 | ;;; csound-mode.el ends here
201 | 


--------------------------------------------------------------------------------
/test/csound-mode-tests.el:
--------------------------------------------------------------------------------
  1 | ;;; csound-mode-tests.el --- Test helper
  2 | 
  3 | ;;; Commentary: expects tab-mode to be turned off
  4 | ;;
  5 | 
  6 | ;;; Code:
  7 | 
  8 | (require 'ert-x)
  9 | (require 'cl-lib)
 10 | (require 'test-simple)
 11 | 
 12 | (note "Initializing test information")
 13 | 
 14 | (defmacro test-with-temp-buffer (content &rest body)
 15 |   "Evaluate BODY in a temporary buffer with CONTENT."
 16 |   (declare (debug t)
 17 |            (indent 1))
 18 |   `(with-temp-buffer
 19 |      (insert ,content)
 20 |      (csound-mode)
 21 |      ,@body))
 22 | 
 23 | (defun assert-string-equal (expected actual &optional fail-message test-info)
 24 |   "Expectation is that ACTUAL should be equal to EXPECTED."
 25 |   (assert-op 'string-equal expected actual fail-message test-info))
 26 | 
 27 | (test-simple-start)
 28 | 
 29 | (note "Make sure the file is found and opened without error")
 30 | 
 31 | (assert-t (load-file "./csound-mode.el")
 32 | 	  "Can't load csound-mode.el - are you in the right directory?" )
 33 | 
 34 | (note "Test for minor modes")
 35 | 
 36 | (test-with-temp-buffer ""
 37 |   (let ((active-modes))
 38 |     (declare (indent 2))
 39 |     (mapc (lambda (mode) (condition-case nil
 40 |                              (if (and (symbolp mode) (symbol-value mode))
 41 |                                  (add-to-list 'active-modes mode))
 42 |                            (error nil) ))
 43 |           minor-mode-list)
 44 |     (assert-t (memq 'eldoc-mode minor-mode-list))
 45 |     (assert-t (memq 'font-lock-mode minor-mode-list))))
 46 | 
 47 | (defvar example-csd-1
 48 |   "<CsoundSynthesizer>
 49 | <CsOptions>
 50 | -odac
 51 | </CsOptions>
 52 | <CsInstruments>
 53 | sr = 44100
 54 | ksmps = 32
 55 | nchnls = 2
 56 | 0dbfs = 1
 57 | instr 1
 58 | asig poscil .2, p4
 59 | out asig, asig
 60 | endin
 61 | </CsInstruments>
 62 | <CsScore>
 63 | i 1 0 2 1000
 64 | </CsScore>
 65 | </CsoundSynthesizer>")
 66 | 
 67 | (note "Test fontification")
 68 | 
 69 | (test-with-temp-buffer example-csd-1
 70 |   (goto-char (point-min))
 71 |   ;; <CsoundSynthesizer>
 72 |   (with-current-buffer (buffer-name)
 73 |     (assert-equal 'csound-font-lock-xml-tags (get-text-property (point) 'face)))
 74 |   ;; >sr = 44100
 75 |   (goto-line 6)
 76 |   (with-current-buffer (buffer-name)
 77 |     (assert-equal 'font-lock-builtin-face (get-text-property (point) 'face)))
 78 |   ;; sr = 44100<
 79 |   (goto-char (line-end-position))
 80 |   (with-current-buffer (buffer-name)
 81 |     (assert-nil (get-text-property (point) 'face))))
 82 | 
 83 | (defvar example-udo-1 ;; From https://github.com/kunstmusik/libsyi/blob/master/adsr140.udo
 84 |   "; Gated, Retriggerable Envelope Generator UDO (adsr140)
 85 | ; Based on design of Doepfer A-140 Envelope Generator Module
 86 | ; Code based on ADSR code by Nigel Redmon
 87 | ; (http://www.earlevel.com/main/2013/06/03/envelope-generators-adsr-code/)
 88 | ; Example by Steven Yi (2015.02.08)
 89 | opcode adsr140_calc_coef, k, kk
 90 | knum_samps, kratio xin
 91 | xout exp( -log((1.0 + kratio) / kratio) / knum_samps)
 92 | endop
 93 | /* Gated, Re-triggerable ADSR modeled after the Doepfer A-140 */
 94 | opcode adsr140, a, aakkkk
 95 | agate, aretrig, kattack, kdecay, ksustain, krelease xin
 96 | kstate init 0  ; 0 = attack, 1 = decay, 2 = sustain
 97 | klasttrig init -1
 98 | kval init 0.0
 99 | asig init 0
100 | kindx = 0
101 | kattack_base init 0
102 | kdecay_base init 0
103 | krelease_base init 0
104 | kattack_samps init 0
105 | kdecay_samps init 0
106 | krelease_samps init 0
107 | kattack_coef init 0
108 | kdecay_coef init 0
109 | ksustain_coef init 0
110 | klast_attack init -1
111 | klast_decay init -1
112 | klast_release init -1
113 | if (klast_attack != kattack) then
114 | klast_attack = kattack
115 | if(kattack > 0) then
116 | kattack_samps = kattack * sr
117 | kattack_coef = adsr140_calc_coef(kattack_samps, 0.3)
118 | kattack_base = (1.0 + 0.3) * (1 - kattack_coef)
119 | else
120 | kattack_samps = 0
121 | kattack_coef = 0
122 | kattack_base = 0
123 | endif
124 | endif
125 | if (klast_decay != kdecay) then
126 | klast_decay = kdecay
127 | kdecay_samps = kdecay * sr
128 | kdecay_coef = adsr140_calc_coef(kdecay_samps, 0.0001)
129 | kdecay_base = (ksustain - 0.0001) * (1.0 - kdecay_coef)
130 | endif
131 | if (klast_release != krelease) then
132 | klast_release = krelease
133 | krelease_samps = krelease * sr
134 | krelease_coef = adsr140_calc_coef(krelease_samps, 0.0001)
135 | krelease_base =  -0.0001 * (1.0 - krelease_coef)
136 | endif
137 | while (kindx < ksmps) do
138 | if (agate[kindx] > 0) then
139 | kretrig = aretrig[kindx]
140 | if (kretrig > 0 && klasttrig <= 0) then
141 | kstate = 0
142 | endif
143 | klasttrig = kretrig
144 | if (kstate == 0) then
145 | if(kattack <= 0) then
146 | kval = 1.0
147 | kstate = 1
148 | else
149 | kval = kattack_base + (kval * kattack_coef)
150 | if(kval >= 1.0) then
151 | kval = 1.0
152 | kstate = 1
153 | endif
154 | asig[kindx] = kval
155 | endif
156 | elseif (kstate == 1) then
157 | kval = kdecay_base + (kval * kdecay_coef)
158 | if(kval <= ksustain) then
159 | kval = ksustain
160 | kstate = 2
161 | endif
162 | asig[kindx] = kval
163 | else
164 | asig[kindx] = ksustain
165 | endif
166 | else ; in a release state
167 | kstate = 0
168 | if (kval == 0.0) then
169 | asig[kindx] = 0
170 | else
171 | ; releasing
172 | kval = krelease_base + (kval * krelease_coef)
173 | if(kval <= 0.0) then
174 | kval = 0.0
175 | endif
176 | asig[kindx] = kval
177 | endif
178 | endif
179 | kindx += 1
180 | od
181 | xout asig
182 | endop")
183 | 
184 | (defvar example-udo-1-expected
185 |   "; Gated, Retriggerable Envelope Generator UDO (adsr140)
186 | ; Based on design of Doepfer A-140 Envelope Generator Module
187 | ; Code based on ADSR code by Nigel Redmon
188 | ; (http://www.earlevel.com/main/2013/06/03/envelope-generators-adsr-code/)
189 | ; Example by Steven Yi (2015.02.08)
190 | opcode adsr140_calc_coef, k, kk
191 |   knum_samps, kratio xin
192 |   xout exp( -log((1.0 + kratio) / kratio) / knum_samps)
193 | endop
194 | /* Gated, Re-triggerable ADSR modeled after the Doepfer A-140 */
195 | opcode adsr140, a, aakkkk
196 |   agate, aretrig, kattack, kdecay, ksustain, krelease xin
197 |   kstate init 0  ; 0 = attack, 1 = decay, 2 = sustain
198 |   klasttrig init -1
199 |   kval init 0.0
200 |   asig init 0
201 |   kindx = 0
202 |   kattack_base init 0
203 |   kdecay_base init 0
204 |   krelease_base init 0
205 |   kattack_samps init 0
206 |   kdecay_samps init 0
207 |   krelease_samps init 0
208 |   kattack_coef init 0
209 |   kdecay_coef init 0
210 |   ksustain_coef init 0
211 |   klast_attack init -1
212 |   klast_decay init -1
213 |   klast_release init -1
214 |   if (klast_attack != kattack) then
215 |     klast_attack = kattack
216 |     if(kattack > 0) then
217 |       kattack_samps = kattack * sr
218 |       kattack_coef = adsr140_calc_coef(kattack_samps, 0.3)
219 |       kattack_base = (1.0 + 0.3) * (1 - kattack_coef)
220 |     else
221 |       kattack_samps = 0
222 |       kattack_coef = 0
223 |       kattack_base = 0
224 |     endif
225 |   endif
226 |   if (klast_decay != kdecay) then
227 |     klast_decay = kdecay
228 |     kdecay_samps = kdecay * sr
229 |     kdecay_coef = adsr140_calc_coef(kdecay_samps, 0.0001)
230 |     kdecay_base = (ksustain - 0.0001) * (1.0 - kdecay_coef)
231 |   endif
232 |   if (klast_release != krelease) then
233 |     klast_release = krelease
234 |     krelease_samps = krelease * sr
235 |     krelease_coef = adsr140_calc_coef(krelease_samps, 0.0001)
236 |     krelease_base =  -0.0001 * (1.0 - krelease_coef)
237 |   endif
238 |   while (kindx < ksmps) do
239 |     if (agate[kindx] > 0) then
240 |       kretrig = aretrig[kindx]
241 |       if (kretrig > 0 && klasttrig <= 0) then
242 |         kstate = 0
243 |       endif
244 |       klasttrig = kretrig
245 |       if (kstate == 0) then
246 |         if(kattack <= 0) then
247 |           kval = 1.0
248 |           kstate = 1
249 |         else
250 |           kval = kattack_base + (kval * kattack_coef)
251 |           if(kval >= 1.0) then
252 |             kval = 1.0
253 |             kstate = 1
254 |           endif
255 |           asig[kindx] = kval
256 |         endif
257 |       elseif (kstate == 1) then
258 |         kval = kdecay_base + (kval * kdecay_coef)
259 |         if(kval <= ksustain) then
260 |           kval = ksustain
261 |           kstate = 2
262 |         endif
263 |         asig[kindx] = kval
264 |       else
265 |         asig[kindx] = ksustain
266 |       endif
267 |     else ; in a release state
268 |       kstate = 0
269 |       if (kval == 0.0) then
270 |         asig[kindx] = 0
271 |       else
272 |         ; releasing
273 |         kval = krelease_base + (kval * krelease_coef)
274 |         if(kval <= 0.0) then
275 |           kval = 0.0
276 |         endif
277 |         asig[kindx] = kval
278 |       endif
279 |     endif
280 |     kindx += 1
281 |   od
282 |   xout asig
283 | endop")
284 | 
285 | (note "Test indentation")
286 | 
287 | (test-with-temp-buffer example-udo-1
288 |   (goto-char (point-min))
289 |   (indent-region (point-min) (point-max))
290 |   (assert-string-equal
291 |    example-udo-1-expected
292 |    (buffer-substring-no-properties (point-min) (point-max))))
293 | 
294 | (end-tests)
295 | 


--------------------------------------------------------------------------------
/csound-eldoc.el:
--------------------------------------------------------------------------------
  1 | ;;; csound-eldoc.el --- A major mode for interacting and coding Csound
  2 | ;;  Copyright (C) 2017 - 2023  Hlöðver Sigurðsson
  3 | 
  4 | ;; Author: Hlöðver Sigurðsson <hlolli@gmail.com>
  5 | ;; Version: 0.2.9
  6 | ;; Package-Requires: ((emacs "25") (shut-up "0.3.2") (multi "2.0.1") (dash "2.16.0") (highlight "0"))
  7 | ;; URL: https://github.com/hlolli/csound-mode
  8 | 
  9 | ;; This program is free software; you can redistribute it and/or modify
 10 | ;; it under the terms of the GNU General Public License as published by
 11 | ;; the Free Software Foundation, either version 3 of the License, or
 12 | ;; (at your option) any later version.
 13 | 
 14 | ;; This program is distributed in the hope that it will be useful,
 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 17 | ;; GNU General Public License for more details.
 18 | 
 19 | ;; You should have received a copy of the GNU General Public License
 20 | ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 21 | 
 22 | ;;; Commentary:
 23 | 
 24 | ;;  Eldoc functionality for csound-mode
 25 | 
 26 | ;;; Code:
 27 | 
 28 | 
 29 | (require 'csound-opcodes)
 30 | (require 'csound-util)
 31 | (require 'cl-lib)
 32 | 
 33 | (defun csound-eldoc-get-template (opcode-list)
 34 |   (let ((templ nil)
 35 |         (indx 0))
 36 |     (while (and (< indx (length opcode-list))
 37 |                 (eq templ nil))
 38 |       (when (eq :template (nth indx opcode-list))
 39 |         (setq templ t))
 40 |       (setq indx (1+ indx)))
 41 |     (if templ
 42 |         (nth indx opcode-list)
 43 |       "")))
 44 | 
 45 | (defun csound-eldoc-line-escape-count ()
 46 |   (save-excursion
 47 |     (let ((linenums 1))
 48 |       (while (search-backward-regexp "\\\\.*\n" (line-end-position -1) t)
 49 |         (setq linenums (1- linenums)))
 50 |       linenums)))
 51 | 
 52 | (defun csound-eldoc-statement ()
 53 |   (save-excursion
 54 |     (let ((countback (csound-eldoc-line-escape-count)))
 55 |       (buffer-substring
 56 |        (line-beginning-position countback)
 57 |        (csound-util-line-boundry)))))
 58 | 
 59 | (defun csound-eldoc-statement-list (string-statement)
 60 |   (split-string
 61 |    (csound-util-untab (csound-util-chomp string-statement))
 62 |    "\\(,+\s*\\)+\\|\\(\s+,*\\)+"))
 63 | 
 64 | (defun csound-eldoc-template-lookup (statement-list)
 65 |   (let ((result nil)
 66 |         (opdoce nil)
 67 |         (last-open-paren (save-excursion (search-backward "(" (line-beginning-position) t 1)))
 68 |         (last-close-paren (save-excursion (search-backward ")" (line-beginning-position) t 1)))
 69 |         (cand nil)
 70 |         (opcode nil)
 71 |         (rate-match nil)
 72 |         (rate-cand nil)
 73 |         (functional-syntax-p nil))
 74 |     ;; Functional syntax lookup
 75 |     (when (and last-open-paren
 76 |                (> last-open-paren
 77 |                   (or last-close-paren
 78 |                       (line-beginning-position))))
 79 |       (save-excursion (progn (setq cand (thing-at-point 'symbol (search-backward-regexp "(" (line-beginning-position) t 1)))
 80 |                              (when (= 1 (length cand))
 81 |                                (setq rate-cand cand))
 82 |                              (while (or (and (not cand)
 83 |                                              (not (eq (point) (line-beginning-position))))
 84 |                                         (= 1 (length cand)))
 85 |                                (setq cand (thing-at-point 'symbol))
 86 |                                (backward-char))
 87 |                              (when (gethash cand csdoc-opcode-database)
 88 |                                (setq result (csound-eldoc-get-template
 89 |                                              (gethash cand csdoc-opcode-database))
 90 |                                      opcode cand
 91 |                                      functional-syntax-p t)))))
 92 |     ;; Normal statement lookup
 93 |     (when (not result)
 94 |       (dolist (statement statement-list)
 95 |         (when (gethash statement csdoc-opcode-database)
 96 |           (setq result (csound-eldoc-get-template
 97 |                         (gethash statement csdoc-opcode-database))
 98 |                 opcode statement))))
 99 |     (when result
100 |       (let ((rate-list (split-string (replace-regexp-in-string "\n\s" "\n" result) "\n")))
101 |         (if (= (length rate-list) 1)
102 |             (list opcode (car rate-list) functional-syntax-p)
103 |           (let ((rate-candidate (or rate-cand (substring (car statement-list) 0 1))))
104 |             (dolist (xrate rate-list)
105 |               (when (string= rate-candidate (substring xrate 0 1))
106 |                 (setq rate-match xrate)))
107 |             (if rate-match
108 |                 (list opcode rate-match functional-syntax-p)
109 |               (list opcode (car rate-list) functional-syntax-p))))))))
110 | 
111 | 
112 | (defun csound-eldoc-argument-index (opcode-match opcode-index point-on-opcode?)
113 |   (if point-on-opcode?
114 |       0
115 |     (save-excursion
116 |       (let* ((statement (buffer-substring
117 |                          (line-beginning-position (csound-eldoc-line-escape-count))
118 |                          (point)))
119 |              (statement (replace-regexp-in-string "(.*)" "" statement))
120 |              (komma-format-list (split-string
121 |                                  (replace-regexp-in-string
122 |                                   opcode-match
123 |                                   (concat "," opcode-match ",")
124 |                                   statement)
125 |                                  ","))
126 |              (indx 0)
127 |              (pos nil))
128 |         (dolist (i komma-format-list)
129 |           (if (string= opcode-match i)
130 |               (setq indx 0
131 |                     pos t)
132 |             (if pos
133 |                 (setq indx (1+ indx))
134 |               (setq indx (1- indx)))))
135 |         indx))))
136 | 
137 | (defun csound-eldoc-opcode-index (opcode-match template-list)
138 |   (let ((indx 0)
139 |         (match? nil))
140 |     (while (and (< indx (length template-list))
141 |                 (not match?))
142 |       (if (string= (nth indx template-list)
143 |                    opcode-match)
144 |           (setq match? t)
145 |         (setq indx (1+ indx))))
146 |     indx))
147 | 
148 | 
149 | ;;;###autoload
150 | (defun csound-eldoc-function ()
151 |   "Returns a doc string appropriate for the current context, or nil."
152 |   (let* ((csound-statement (csound-eldoc-statement))
153 |          (statement-list (csound-eldoc-statement-list csound-statement))
154 |          (template-lookup (csound-eldoc-template-lookup statement-list)))
155 |     (when template-lookup
156 |       (let* ((opcode-match (car template-lookup))
157 |              (point-on-opcode? (string= opcode-match (thing-at-point 'symbol)))
158 |              (csound-template (replace-regexp-in-string
159 |                                "[^\\[]\\.\\.\\." ""
160 |                                (replace-regexp-in-string
161 |                                 "\\[, " "["
162 |                                 (nth 1 template-lookup))))
163 |              (template-list (csound-eldoc-statement-list csound-template))
164 |              (template-list-length (1- (length template-list)))
165 |              (opcode-index (csound-eldoc-opcode-index opcode-match template-list))
166 |              (template-list (if (nth 2 template-lookup)
167 |                                 (cl-subseq template-list opcode-index)
168 |                               template-list))
169 |              (argument-index (csound-eldoc-argument-index opcode-match opcode-index point-on-opcode?))
170 |              (infinite-args? (string= "[...]" (car (last template-list))))
171 |              (indx -1)
172 |              (list-index 0)
173 |              (eldocstr "")
174 |              (inf-arg nil))
175 |         (dolist (arg template-list)
176 |           (setq
177 |            inf-arg (if (and infinite-args?
178 |                             (< template-list-length argument-index))
179 |                        t nil)
180 |            eldocstr (concat eldocstr
181 |                             (when (string= arg opcode-match)
182 |                               (put-text-property 0 (length arg) 'face
183 |                                                  (list :foreground "#C70039"
184 |                                                        :weight (if point-on-opcode?
185 |                                                                    'bold 'normal))
186 |                                                  arg))
187 |                             (if (or (and (= indx argument-index)
188 |                                          ;;(string= arg (car (last template-list)))
189 |                                          (not point-on-opcode?))
190 |                                     (and inf-arg (string= "[...]" arg)))
191 |                                 (prog2 (put-text-property 0 (length arg) 'face '(:foreground "#A4FF00" :weight bold) arg)
192 |                                     arg)
193 |                               arg)
194 |                             (if (or (eq template-list-length list-index)
195 |                                     (string= arg opcode-match)
196 |                                     (string= opcode-match (nth (1+ list-index) template-list))
197 |                                     (string= "=" arg))
198 |                                 " "
199 |                               ", "))
200 |            indx (if (string= arg opcode-match) 1
201 |                   (if (string= "=" arg)
202 |                       indx
203 |                     (if (> 0 indx)
204 |                         (1- indx)
205 |                       (1+ indx))))
206 |            list-index (1+ list-index)))
207 |         (replace-regexp-in-string ",$" "" (csound-util-chomp eldocstr))))))
208 | 
209 | 
210 | (provide 'csound-eldoc)
211 | 
212 | ;;; csound-eldoc.el ends here
213 | 


--------------------------------------------------------------------------------
/csound-score.el:
--------------------------------------------------------------------------------
  1 | ;;; csound-score.el --- A major mode for interacting and coding Csound -*- lexical-binding: t; -*-
  2 | 
  3 | ;; Copyright (C) 2017 - 2023  Hlöðver Sigurðsson
  4 | 
  5 | ;; Author: Hlöðver Sigurðsson <hlolli@gmail.com>
  6 | ;; Version: 0.2.9
  7 | ;; Package-Requires: ((emacs "25") (shut-up "0.3.2") (multi "2.0.1") (dash "2.16.0") (highlight "0"))
  8 | ;; URL: https://github.com/hlolli/csound-mode
  9 | 
 10 | ;; This program is free software; you can redistribute it and/or modify
 11 | ;; it under the terms of the GNU General Public License as published by
 12 | ;; the Free Software Foundation, either version 3 of the License, or
 13 | ;; (at your option) any later version.
 14 | 
 15 | ;; This program is distributed in the hope that it will be useful,
 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18 | ;; GNU General Public License for more details.
 19 | 
 20 | ;; You should have received a copy of the GNU General Public License
 21 | ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 22 | 
 23 | ;;; Commentary:
 24 | 
 25 | ;; This fine includes all helpers and handling of csound-score events
 26 | ;; for interactive composition
 27 | 
 28 | ;;; Code:
 29 | 
 30 | (require 'csound-font-lock)
 31 | (require 'csound-util)
 32 | (require 'font-lock)
 33 | (require 'dash)
 34 | (require 'highlight)
 35 | 
 36 | (defun csound-score--align-cols (start end)
 37 |   (save-excursion
 38 |     (let ((line-end (line-number-at-pos end))
 39 |           (max-matrix '()))
 40 |       ;; Create matrix of max lengths
 41 |       (let ((statements (-> (buffer-substring start end)
 42 |                             (substring-no-properties)
 43 |                             (split-string "\n"))))
 44 |         (dolist (stm statements)
 45 |           ;; Remove comments and extra whitespaces
 46 |           (let* ((stm* (->> (replace-regexp-in-string "\\(;\\|//\\).*" "" stm)
 47 |                             csound-util-chomp
 48 |                             ;; replace space by _ in [expression]
 49 |                             (replace-regexp-in-string "\\[[^]]*]" #'(lambda (x) (replace-regexp-in-string "\\s-" "_" x)))
 50 |                             (replace-regexp-in-string "\\s-+" " ")))
 51 |                  (param-list (split-string stm* " "))
 52 |                  ;; (param-num (length param-list))
 53 |                  (max-matrix-len (length max-matrix))
 54 |                  (index 0))
 55 |             ;; (print stm*)
 56 |             (dolist (param param-list)
 57 |               (if (<= max-matrix-len index)
 58 |                   (setq max-matrix (append max-matrix (list (length param)))
 59 |                         index (1+ index))
 60 |                 (progn
 61 |                   (setf (nth index max-matrix)
 62 |                         (max (length param)
 63 |                              (nth index max-matrix)))
 64 |                   (setq index (1+ index))))))))
 65 |       ;; Align the block
 66 |       (goto-char start)
 67 |       (while (<= (line-number-at-pos) line-end)
 68 |         (beginning-of-line)
 69 |         ;; Add a space before comment if non
 70 |         (save-excursion
 71 |           (if (and (re-search-forward "\\(^\\|.\\)\\(;\\|//\\)" (line-end-position) t)
 72 |                    (save-match-data (string-match "\\S-" (match-string 1))))
 73 |             (replace-match "\\1 \\2")))
 74 |         ;; Align the line
 75 |         (let ((line-num (line-number-at-pos))
 76 |               (param-length 0)
 77 |               (index -1))
 78 |           (while (= (line-number-at-pos) line-num)
 79 |             ;; Align the parameter
 80 |             (let* ((margin-length (skip-chars-forward "[:space:]"))
 81 |                    (before-comment (looking-at ";\\|//"))
 82 |                    (spaces-to-add
 83 |                     (if (or (zerop param-length) (eolp))
 84 |                         ;; after line beginning or before line end
 85 |                         (- margin-length)
 86 |                       (- (if before-comment
 87 |                              ;; needed length before comment
 88 |                              (let ((subvec (nthcdr index max-matrix)))
 89 |                                (+ (apply #'+ subvec) (length subvec) 1))
 90 |                            ;; needed length before next parameter
 91 |                            (1+ (nth index max-matrix)))
 92 |                          ;; current length
 93 |                          (+ param-length margin-length)))))
 94 |               ;; Adjust the margin
 95 |               (if (< 0 spaces-to-add)
 96 |                   (insert (make-string spaces-to-add ?\040))
 97 |                 (delete-char spaces-to-add))
 98 |               (if before-comment
 99 |                   (forward-line)
100 |                 (let ((ex-length
101 |                        ;; length of [expression] before ]
102 |                        (if (looking-at "\\[") (skip-chars-forward "^]") 0)))
103 |                   ;; Move to the end of next parameter and get the length
104 |                   (setq param-length
105 |                         (+ ex-length (skip-chars-forward "^[:space:]")))
106 |                   (setq index (1+ index))))
107 |               ;; Exit loop at buffer end
108 |               (if (eobp)
109 |                   (setq line-num 0
110 |                         line-end 0)))))))))
111 | 
112 | (defun csound-score-align-block ()
113 |   "Align score block so that all parameter are of same space width."
114 |   (interactive)
115 |   (let ((re "^\\s-*[[:alpha:]$]"))
116 |     (if (save-excursion
117 |           ;; See if point is on an score event line
118 |           (beginning-of-line)
119 |           (re-search-forward re (line-end-position) t))
120 |         (let ((beginning-of-block
121 |                (save-excursion
122 |                  ;; Search for beginning of block
123 |                  (beginning-of-line)
124 |                  (while (re-search-backward re (line-beginning-position 0) t)
125 |                    (beginning-of-line))
126 |                  (point)))
127 |               (end-of-block
128 |                (save-excursion
129 |                  ;; Search for end of block
130 |                  (end-of-line)
131 |                  (while (re-search-forward re (line-end-position 2) t)
132 |                    (end-of-line))
133 |                  (point))))
134 |           (csound-score--align-cols beginning-of-block end-of-block)))))
135 | 
136 | (defun csound-score-trim-time (score-string)
137 |   (let ((trimmed-string (split-string
138 |                          (substring-no-properties
139 |                           score-string)
140 |                          "\n"))
141 |         (min-p2 0)
142 |         (closure-list '())
143 |         (final-str "")
144 |         ;; (lex-p2-list '())
145 |         (p2-list '())
146 |         (last-p3 0))
147 |     (dolist (event trimmed-string)
148 |       (let* ((lexical-p-list (split-string
149 |                               (replace-regexp-in-string
150 |                                "\\s-+" " " (csound-util-chomp event))
151 |                               " "))
152 |              (lex-last-p3 last-p3)
153 |              (lex-p2-list (cons (if (< 2 (length lexical-p-list))
154 |                                     (if (string-equal "+" (nth 2 lexical-p-list))
155 |                                         (if (car p2-list)
156 |                                             (+ (car p2-list) lex-last-p3)
157 |                                           last-p3)
158 |                                       (if (string-equal "." (nth 2 lexical-p-list))
159 |                                           (if (car p2-list)
160 |                                               (car p2-list)
161 |                                             0)
162 |                                         (string-to-number
163 |                                          (nth 2 lexical-p-list))))
164 |                                   0)
165 |                                 p2-list)))
166 |         (setq p2-list lex-p2-list
167 |               closure-list (cons
168 |                             (lambda (min-time)
169 |                               (setf (nth 2 lexical-p-list)
170 |                                     (number-to-string
171 |                                      (- (car lex-p2-list)
172 |                                         ;;(nth 2 lexical-p-list)
173 |                                         min-time)))
174 |                               ;; (message "%s lastp3: %s" lex-p2-list lex-last-p3)
175 |                               (string-join lexical-p-list " "))
176 |                             closure-list)
177 |               last-p3 (if (string-equal "." (nth 3 lexical-p-list))
178 |                           last-p3
179 |                         (string-to-number
180 |                          (nth 3 lexical-p-list))))))
181 |     ;; (message "p2-list: %s" p2-list)
182 |     (setq min-p2 (apply #'min p2-list)
183 |           closure-list (reverse closure-list))
184 |     (dolist (event-fn closure-list)
185 |       (setq final-str (concat final-str (funcall event-fn min-p2) "\n")))
186 |     ;; (message "%s" final-str)
187 |     final-str))
188 | 
189 | (defvar csound-score--last-start)
190 | 
191 | (defvar csound-score--last-end)
192 | 
193 | (defun csound-score--flash ()
194 |   (hlt-highlight-region
195 |    csound-score--last-start
196 |    csound-score--last-end
197 |    'font-lock-string-face)
198 |   (run-with-idle-timer
199 |    0.15
200 |    nil
201 |    (lambda ()
202 |      (hlt-unhighlight-region csound-score--last-start csound-score--last-end))))
203 | 
204 | (defun csound-score-find-instr-def ()
205 |   "For a score statement,
206 |    jump the cursor to where
207 |    its defined in the orchestra.
208 |    Sets a mark."
209 |   (interactive)
210 |   (let* ((instr-on-line (save-excursion
211 |                           (beginning-of-line)
212 |                           (search-forward-regexp "\\<i\\s-?\\(\\\".*\\\"\\|[0-9]+\\)"
213 |                                                  (line-end-position) t 1)
214 |                           (match-string-no-properties 1)))
215 |          (instr-on-line (replace-regexp-in-string "\\\"" "" instr-on-line))
216 |          (search-attempt (save-excursion
217 |                            (goto-char 0)
218 |                            (search-forward-regexp (format "\\<instr\\s-+%s" instr-on-line) nil t 1))))
219 |     (if search-attempt
220 |         (progn (goto-char search-attempt)
221 |                (setq csound-score--last-start (- (point) (length (thing-at-point 'symbol)))
222 |                      csound-score--last-end (1- (point)))
223 |                (csound-score--flash)
224 |                (recenter-top-bottom))
225 |       (message "instrument: %s not found in buffer" instr-on-line))))
226 | 
227 | 
228 | (provide 'csound-score)
229 | 
230 | ;;; csound-score.el ends here
231 | 


--------------------------------------------------------------------------------
/csound-font-lock.el:
--------------------------------------------------------------------------------
  1 | ;;; csound-font-lock.el --- A major mode for interacting and coding Csound
  2 | ;;  Copyright (C) 2017 - 2023  Hlöðver Sigurðsson
  3 | 
  4 | ;; Author: Hlöðver Sigurðsson <hlolli@gmail.com>
  5 | ;; Version: 0.2.9
  6 | ;; Package-Requires: ((emacs "25") (shut-up "0.3.2") (multi "2.0.1") (dash "2.16.0") (highlight "0"))
  7 | ;; URL: https://github.com/hlolli/csound-mode
  8 | 
  9 | ;; This program is free software; you can redistribute it and/or modify
 10 | ;; it under the terms of the GNU General Public License as published by
 11 | ;; the Free Software Foundation, either version 3 of the License, or
 12 | ;; (at your option) any later version.
 13 | 
 14 | ;; This program is distributed in the hope that it will be useful,
 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 17 | ;; GNU General Public License for more details.
 18 | 
 19 | ;; You should have received a copy of the GNU General Public License
 20 | ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 21 | 
 22 | ;;; Commentary:
 23 | ;;  Font lock functionalities for csound-mode, both
 24 | ;;  score and orchestra specific, manual fontifycation
 25 | ;;  hacks for rainbow delimited parameter fields as well.
 26 | 
 27 | ;;; Code:
 28 | 
 29 | (require 'font-lock)
 30 | (require 'csound-opcodes)
 31 | 
 32 | (defvar csound-font-lock--missing-faces '())
 33 | 
 34 | (defcustom csound-font-lock-rainbow-score-parameters-p nil
 35 |   "Color each parameter field for
 36 |    not events within CsScore/.sco"
 37 |   :type 'boolean
 38 |   :group 'csound-mode-font-lock)
 39 | 
 40 | (defface csound-font-lock-eval-flash
 41 |   '((((class color) (background light)) (:foreground "#999601" :background "#42ff42"))
 42 |     (((class color) (background dark)) (:background "#637863" :foreground "#00e4f0"))
 43 |     (t (:inverse-video t)))
 44 |   "Face for highlighting during evaluation."
 45 |   :group 'csound-mode-font-lock)
 46 | 
 47 | (defface csound-font-lock-eval-flash-error
 48 |   '((((class color)) (:foreground "#5e0d0d" :bold t))
 49 |     (t (:inverse-video t)))
 50 |   "Face for highlighting signaled errors during evaluation."
 51 |   :group 'csound-mode-font-lock)
 52 | 
 53 | (defface csound-font-lock-i-rate
 54 |   '((((class color)) (:inherit font-lock-variable-name-face)))
 55 |   "Face for i-rate variables (i)"
 56 |   :group 'csound-mode-font-lock)
 57 | 
 58 | (defface csound-font-lock-global-i-rate
 59 |   '((((class color)) (:inherit font-lock-variable-name-face :bold t)))
 60 |   "Face for global i-rates (gi)"
 61 |   :group 'csound-mode-font-lock)
 62 | 
 63 | (defface csound-font-lock-k-rate
 64 |   '((((class color)) (:inherit font-lock-function-name-face)))
 65 |   "Face for control rate variables in orchestra (k)"
 66 |   :group 'csound-mode-font-lock)
 67 | 
 68 | (defface csound-font-lock-global-k-rate
 69 |   '((((class color)) (:inherit font-lock-function-name-face :bold t)))
 70 |   "Face for global control rates (gk)"
 71 |   :group 'csound-mode-font-lock)
 72 | 
 73 | (defface csound-font-lock-f-rate
 74 |   '((((class color) (background light)) (:foreground "#999601"))
 75 |     (((class color) (background dark)) (:foreground "#85C4B5")))
 76 |   "Face for f-rates (f)"
 77 |   :group 'csound-mode-font-lock)
 78 | 
 79 | (defface csound-font-lock-global-f-rate
 80 |   '((((class color)) (:inherit csound-font-lock-f-rate :bold t)))
 81 |   "Face for global f-rates (gf)"
 82 |   :group 'csound-mode-font-lock)
 83 | 
 84 | (defface csound-font-lock-a-rate
 85 |   '((((class color)) (:inherit font-lock-constant-face)))
 86 |   "Face for a-rates (a)"
 87 |   :group 'csound-mode-font-lock)
 88 | 
 89 | (defface csound-font-lock-global-a-rate
 90 |   '((((class color)) (:inherit font-lock-constant-face :bold t)))
 91 |   "Face for global a-rates"
 92 |   :group 'csound-mode-font-lock)
 93 | 
 94 | (defface csound-font-lock-s-variables
 95 |   '((((class color) (background light)) (:foreground "#999601"))
 96 |     (((class color) (background dark)) (:foreground "#F7F300")))
 97 |   "Face for strings (S)"
 98 |   :group 'csound-mode-font-lock)
 99 | 
100 | (defface csound-font-lock-global-s-variables
101 |   '((((class color) (background light)) (:foreground "#999601" :bold t))
102 |     (((class color) (background dark)) (:foreground "#F7F300" :bold t)))
103 |   "Face for global strings (gS)"
104 |   :group 'csound-mode-font-lock)
105 | 
106 | (defface csound-font-lock-goto
107 |   '((((class color)) (:inherit font-lock-constant-face)))
108 |   "Symbols that have been defined with goto ending with colon (end:)"
109 |   :group 'csound-mode-font-lock)
110 | 
111 | (defface csound-font-lock-goto-label
112 |   '((((class color)) (:inherit font-lock-constant-face)))
113 |   "Symbols that represent a goto label"
114 |   :group 'csound-mode-font-lock)
115 | 
116 | (defface csound-font-lock-p
117 |   '((((class color) (background light)) (:foreground "#A48E32" :bold t))
118 |     (((class color) (background dark)) (:foreground "#F9E79F" :bold t)))
119 |   "Face for csound parameter fields (p3, p4 etc.)"
120 |   :group 'csound-mode-font-lock)
121 | 
122 | (defface csound-font-lock-i
123 |   '((((class color)) (:inherit font-lock-builtin-face)))
124 |   "Instrument statement in score."
125 |   :group 'csound-mode-font-lock)
126 | 
127 | (defface csound-font-lock-e
128 |   '((((class color)) (:inherit font-lock-warning-face)))
129 |   "Face for end of score statement (e)"
130 |   :group 'csound-mode-font-lock)
131 | 
132 | ;; TODO add faces for all score statements
133 | 
134 | (defface csound-font-lock-macros
135 |   '((((class color)) (:inherit font-lock-preprocessor-face)))
136 |   "Face for macro definition and instanciation (#macro# $macro)"
137 |   :group 'csound-mode-font-lock)
138 | 
139 | (defface csound-font-lock-strings
140 |   '((((class color)) (:inherit font-lock-string-face :bold nil)))
141 |   "Face for strings themselves seperated by double quotation marks."
142 |   :group 'csound-mode-font-lock)
143 | 
144 | (defface csound-font-lock-xml-tags
145 |   '((((class color)) (:inherit font-lock-keyword-face)))
146 |   "Face for the core .csd xml tags, (<CsoundSynthesizer> etc)"
147 |   :group 'csound-mode-font-lock)
148 | 
149 | 
150 | ;; Add faces macros to variables
151 | ;; TODO: why doesn't defface make a symbol?
152 | (mapc (lambda (sym) (eval `(defvar ,sym ',sym)))
153 |       '(csound-font-lock-i-rate
154 | 	csound-font-lock-global-i-rate
155 | 	csound-font-lock-k-rate
156 | 	csound-font-lock-global-k-rate
157 | 	csound-font-lock-f-rate
158 | 	csound-font-lock-global-f-rate
159 | 	csound-font-lock-a-rate
160 | 	csound-font-lock-global-a-rate
161 | 	csound-font-lock-s-variables
162 | 	csound-font-lock-global-s-variables
163 | 	csound-font-lock-goto
164 | 	csound-font-lock-goto-label
165 | 	csound-font-lock-p
166 | 	csound-font-lock-i
167 | 	csound-font-lock-e
168 | 	csound-font-lock-macros
169 | 	csound-font-lock-strings
170 | 	csound-font-lock-xml-tags))
171 | 
172 | (defvar csound-font-lock-list
173 |   (eval-when-compile
174 |     (let ((csound-font-lock-keywords '()))
175 |       ;; Regex for i-rates
176 |       (push '("\\<i+\\w*" . csound-font-lock-i-rate) csound-font-lock-keywords)
177 | 
178 |       ;; Regex for global i-rates
179 |       (push '("\\<\\(gi\\)+\\w*" . csound-font-lock-global-i-rate) csound-font-lock-keywords)
180 | 
181 |       ;; Regex for k-rates
182 |       (push `("\\<k+\\w*" . csound-font-lock-k-rate) csound-font-lock-keywords)
183 | 
184 |       ;; Regex for global k-rates
185 |       (push '("\\<\\(gk\\)+\\w*" . csound-font-lock-global-k-rate) csound-font-lock-keywords)
186 | 
187 |       ;; Regex for f-rate variables
188 |       (push '("\\<f+\\w*" . csound-font-lock-f-rate) csound-font-lock-keywords)
189 | 
190 |       ;; Regex for global f-rate variables
191 |       (push '("\\<\\(gf\\)+\\w*" . csound-font-lock-global-f-rate) csound-font-lock-keywords)
192 | 
193 |       ;; Regex for a-rates
194 |       (push '("\\<a+\\w*" . csound-font-lock-a-rate) csound-font-lock-keywords)
195 | 
196 |       ;; Regex for global a-rates
197 |       (push '("\\<\\(ga\\)+\\w*" . csound-font-lock-global-a-rate) csound-font-lock-keywords)
198 | 
199 |       ;; Regex for S variables
200 |       (push '("\\<S+\\w*" . csound-font-lock-s-variables) csound-font-lock-keywords)
201 | 
202 |       ;; Regex for global S variables
203 |       (push '("\\<\\(gS\\)+\\w*" . csound-font-lock-global-s-variables) csound-font-lock-keywords)
204 | 
205 |       ;; Regex for goto symbols ending with colon
206 |       (push '("\\<\\w*:\\B" . csound-font-lock-goto) csound-font-lock-keywords)
207 | 
208 |       ;; Regex for goto labels
209 |       (push '("\\<\\(goto\\|igoto\\|kgoto\\)\\s-*\\(\\w+\\)" 2 csound-font-lock-goto-label) csound-font-lock-keywords)
210 | 
211 |       ;; Regex for p-fields
212 |       (push '("\\bp[[:digit:]]+" . csound-font-lock-p) csound-font-lock-keywords)
213 | 
214 |       ;; Regex for `e` statement
215 |       (push '("\\<[e]\\>" . csound-font-lock-e) csound-font-lock-keywords)
216 | 
217 |       ;; Regex for csound macros types
218 |       (push '("\\#\\w*\\|\\$\\w*" . csound-font-lock-macros) csound-font-lock-keywords)
219 | 
220 |       ;; Regex for csound string types  (use syntactic fontification?)
221 |       ;; (push '("\\s\"\\(.*?\\)[^\\]\\s\"" . csound-font-lock-strings) csound-font-lock-keywords)
222 | 
223 |       ;; Regex for core csound xml tags
224 |       ;; "</?CsoundSynthesizer>\\|</?CsOptions>\\|</?CsInstruments>\\|</?CsScore[=\\\"0-9a-zA-z]?>\\|</?CsLicense>"
225 |       (push `(,(concat (regexp-opt '("<CsoundSynthesizer>" "</CsoundSynthesizer>"
226 | 				     "<CsOptions>" "</CsOptions>"
227 | 				     "<CsInstruments>" "</CsInstruments>"
228 | 				     "<CsLicense>" "</CsLicense>"))
229 | 		       ;; account for preprocessors
230 | 		       "\\|<CsScore[.\\\"]*>\\|</?CsScore>?")
231 | 	      . csound-font-lock-xml-tags)
232 | 	    csound-font-lock-keywords)
233 |       ;; Some opcodes got missing but dont need docstrings
234 |       (setq csound-font-lock--missing-faces
235 |             '("then" "do" "od" "else" "elseif" "endif" "switch" "endsw" "case" "default"))
236 |       ;; Add opcodes to font-lock table csdoc-opdocde-database hash-table
237 |       (let ((mutz '()))
238 | 	(maphash (lambda (k v)
239 | 		   (when (stringp k)
240 | 		     (setq mutz (cons k mutz))))
241 | 		 csdoc-opcode-database)
242 | 	(setq mutz (append mutz csound-font-lock--missing-faces))
243 | 	(setq mutz (regexp-opt mutz 'words))
244 | 	(push `(,mutz . font-lock-builtin-face) csound-font-lock-keywords))
245 |       ;; Regex for `i` events in score
246 |       (push '("\\<i\\'" . csound-font-lock-i) csound-font-lock-keywords)
247 |       ;; Single line comments (use syntactic fontification?)
248 |       (push '("//.*" . font-lock-comment-face)  csound-font-lock-keywords)
249 |       )))
250 | 
251 | 
252 | ;; Borrowed from rainbow-delimiters.el
253 | (eval-when-compile
254 |   (defmacro csound-font-lock-param-delimiters--define-depth-faces ()
255 |     (let ((faces '())
256 |           (light-colors ["#709870" "#7388d6" "#909183" "#FF0099" "#4acabb"
257 | 			 "#93eaa3" "#858580" "#80a880" "#887070"])
258 | 	  (dark-colors ["#909183" "#7388d6" "#99ff00" "#0099ff" "#FF0099"
259 | 			"#4acabb" "#93eaa3"  "#D31D21" "#f6bd1f"]))
260 |       (dotimes (i 9)
261 |         (push `(defface ,(intern (format "csound-score-param-delimiters-depth-%d-face" (1+ i)))
262 |                  '((((class color) (background light)) :foreground ,(aref light-colors i))
263 |                    (((class color) (background dark)) :foreground ,(aref dark-colors i)))
264 |                  ,(format "Nested delimiter face, depth %d." (1+ i))
265 |                  :group 'csound-mode)
266 |               faces))
267 |       `(progn ,@faces))))
268 | (csound-font-lock-param-delimiters--define-depth-faces)
269 | 
270 | (defun csound-font-lock-param-delimiters-default-pick-face (depth)
271 |   (intern-soft
272 |    (concat "csound-score-param-delimiters-depth-"
273 | 	   (number-to-string
274 | 	    (if (<= depth 9)
275 | 		depth
276 | 	      (1+ (mod depth 9))))
277 | 	   "-face")))
278 | 
279 | (defun csound-font-lock--fontify-score (beg end)
280 |   (let ((beg-line-num (line-number-at-pos beg))
281 | 	(end-line-num (min (line-number-at-pos (max-char))
282 |                            (+ 2 (line-number-at-pos end)))))
283 |     (save-excursion
284 |       (beginning-of-line)
285 |       (while (< (line-number-at-pos) end-line-num)
286 | 	(let* ((beg-word nil)
287 | 	       (end-word nil)
288 | 	       (end-line (line-end-position))
289 | 	       (passed-i-p nil)
290 | 	       (depth 2)
291 | 	       (rainbow-line-p (save-excursion
292 | 				 (back-to-indentation)
293 | 				 (let ((first-word (thing-at-point 'word t)))
294 | 				   (when first-word
295 | 				     (string-match-p "^[-]?i\\|^[-]?f" first-word))))))
296 | 	  (if (not rainbow-line-p)
297 | 	      (save-excursion (font-lock-default-fontify-region (line-beginning-position) (line-end-position) nil))
298 | 	    (while (< (point) end-line)
299 | 	      (if (and rainbow-line-p (not passed-i-p))
300 | 		  (progn
301 | 		    (back-to-indentation)
302 | 		    (setq passed-i-p t)
303 | 		    (setq beg-word (point)
304 | 			  end-word (search-forward-regexp "\\s-\\|$" (line-end-position)))
305 | 		    ;; Recolor i to overwrite i-rate behaviour
306 | 		    (font-lock-prepend-text-property (1- beg-word) beg-word 'face "csound-font-lock-i")
307 | 		    ;; Color P1 values
308 | 		    (font-lock-prepend-text-property beg-word end-word 'face
309 | 						     (funcall #'csound-font-lock-param-delimiters-default-pick-face depth))
310 | 		    (setq depth (1+ depth)))
311 | 		;; If passed i marker
312 | 		(progn
313 | 		  (setq beg-word (min (1- (or (save-excursion (search-forward-regexp "[-?0-9a-zA-Z\\[\\.\\+\\<\\>\"]" (line-end-position) t 1))
314 | 					      (line-end-position))))
315 | 			end-word (save-excursion
316 | 				   (goto-char beg-word)
317 | 				   (let ((e (search-forward-regexp "\\s-\\|$" (line-end-position))))
318 | 				     (if (< e end-line)
319 | 					 e end-line))))
320 | 		  (goto-char end-word)
321 | 		  (font-lock-prepend-text-property beg-word end-word 'face (funcall #'csound-font-lock-param-delimiters-default-pick-face depth))
322 | 		  (setq depth (1+ depth)))))))
323 |         (forward-line)))))
324 | 
325 | (defun csound-font-lock-fontify-region (beg end &optional loud)
326 |   (save-excursion
327 |     (let ((within-score-p (or (save-excursion (search-backward "<CsScore" nil t 1))
328 |                               (string-match-p ".sco$" (buffer-name (current-buffer)))))
329 |           (score-boundry (if (string-match-p ".sco$" (buffer-name (current-buffer)))
330 |                              (max-char)
331 |                            (or (save-excursion (goto-char (point-min))
332 |                                                (search-forward-regexp "<CsScore" nil t 1))
333 |                                nil)))
334 |           (orchestra-boundry (if (or (string-match-p ".orc$" (buffer-name (current-buffer)))
335 |                                      (string-match-p ".udo$" (buffer-name (current-buffer))))
336 |                                  (buffer-size)
337 |                                (or (save-excursion (goto-char (point-min))
338 |                                                    (search-forward-regexp "</CsInstruments>" end t 1))
339 |                                    (buffer-size)))))
340 |       (if (and within-score-p score-boundry csound-font-lock-rainbow-score-parameters-p)
341 |           (csound-font-lock--fontify-score (max score-boundry beg) (min end (max-char)))
342 |         ;; All normal font-lock calls, but let's keep rainbow delimited fonts untouched
343 |         (let* ((end-line (1- (line-number-at-pos (min end (point-max)))))
344 |                (end-line (if (and score-boundry csound-font-lock-rainbow-score-parameters-p)
345 |                              (line-number-at-pos score-boundry)
346 |                            end-line)))
347 |           (goto-char beg)
348 |           (beginning-of-line)
349 |           (while (< (line-number-at-pos) (1+ end-line))
350 |             (save-excursion
351 |               (font-lock-default-fontify-region (line-beginning-position) (line-end-position) nil))
352 |             (forward-line)))))))
353 | 
354 | (defun csound-font-lock--flush-buffer (&optional start)
355 |   (save-excursion
356 |     (goto-char (or start (point-max)))
357 |     (let ((line-count (line-number-at-pos)))
358 |       (goto-char (point-min))
359 |       (while (< (line-number-at-pos) line-count)
360 | 	(save-excursion (font-lock-default-fontify-region (line-beginning-position) (line-end-position) nil))
361 |         (forward-line)))))
362 | 
363 | (defun csound-font-lock--flush-score (&optional start)
364 |   (when csound-font-lock-rainbow-score-parameters-p
365 |     (save-excursion
366 |       (goto-char (or start (point-min)))
367 |       (let ((score-beg (if (string-match-p ".sco$" (buffer-name (current-buffer)))
368 | 			   0
369 | 			 (save-excursion (search-forward "<CsScore" nil t 1))))
370 | 	    (score-end (or (save-excursion (search-forward "</CsoundSynthesizer>" nil t 1)) (line-number-at-pos (buffer-size)))))
371 | 	(when (and score-beg score-end)
372 | 	  (csound-font-lock--fontify-score score-beg score-end))))))
373 | 
374 | (defun csound-font-lock-flush-buffer (&optional start)
375 |   (progn (csound-font-lock--flush-buffer start)
376 | 	 (csound-font-lock--flush-score start)))
377 | 
378 | (provide 'csound-font-lock)
379 | 
380 | ;;; csound-font-lock.el ends here
381 | 


--------------------------------------------------------------------------------
/csound-indentation.el:
--------------------------------------------------------------------------------
  1 | ;;; csound-indentation.el --- A major mode for interacting and coding Csound
  2 | 
  3 | ;; Copyright (C) 2017 - 2023  Hlöðver Sigurðsson
  4 | 
  5 | ;; Author: Hlöðver Sigurðsson <hlolli@gmail.com>
  6 | ;; Version: 0.2.9
  7 | ;; Package-Requires: ((emacs "25") (shut-up "0.3.2") (multi "2.0.1") (dash "2.16.0") (highlight "0"))
  8 | ;; URL: https://github.com/hlolli/csound-mode
  9 | 
 10 | ;; This program is free software; you can redistribute it and/or modify
 11 | ;; it under the terms of the GNU General Public License as published by
 12 | ;; the Free Software Foundation, either version 3 of the License, or
 13 | ;; (at your option) any later version.
 14 | 
 15 | ;; This program is distributed in the hope that it will be useful,
 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18 | ;; GNU General Public License for more details.
 19 | 
 20 | ;; You should have received a copy of the GNU General Public License
 21 | ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 22 | 
 23 | ;;; Commentary:
 24 | 
 25 | ;;  Indentation rules for csound-mode
 26 | 
 27 | ;;; Code:
 28 | 
 29 | 
 30 | (require 'csound-util)
 31 | (require 'csound-score)
 32 | 
 33 | ;;; define some customizable variables
 34 | (defcustom csound-indentation-spaces 2
 35 |   "Set how many spaces are in indentation."
 36 |   :type 'integer
 37 |   :group 'csound-mode)
 38 | 
 39 | (defcustom csound-indentation-aggressive-score nil
 40 |   "If true, then align blocks will be called for every indent
 41 |    calls in a score file or within CsScore tags. Works well
 42 |    when used in combination with aggressive-indent mode.
 43 |    (defaults to nil(false))"
 44 |   :type 'boolean
 45 |   :group 'csound-mode)
 46 | 
 47 | (defcustom csound-indentation-indent-goto nil
 48 |   "If true, then anything that comes after goto symbol
 49 |    will be indented."
 50 |   :type 'boolean
 51 |   :group 'csound-mode)
 52 | 
 53 | ;;; define some predicate functions for checking regexp
 54 | (defun csound-indentation--current-line-breaks-p ()
 55 |   "returns t if a \ is found not in the middle of a word in the current line, otherwise nil"
 56 |   (if (save-excursion 
 57 |         (beginning-of-line 0) 
 58 |         (search-forward-regexp
 59 | 	 "\\B\\\\\\B" (csound-util-line-boundry) t 1))
 60 |       t nil))
 61 | 
 62 | (defun csound-indentation--previous-line-breaks-p ()
 63 |   "returns t if a \ not in the middle of word is found in the previous
 64 | line, otherwise nil"
 65 |   (if (save-excursion
 66 |         (beginning-of-line 0)
 67 |         (search-forward-regexp "\\B\\\\\\B" (csound-util-line-boundry) t 1))
 68 |       t nil))
 69 | 
 70 | (defun csound-indentation--current-line-empty-p ()
 71 |   "returns t if the current line is empty, otherwise nil"
 72 |   (and
 73 |    (save-excursion
 74 |      (beginning-of-line)
 75 |      ;; (looking-at-p "[[:blank:]]*$") ; is this a mistake? 
 76 |      (search-forward-regexp "[[:blank:]]*$" (csound-util-line-boundry)
 77 | 			    t 1))   ; did you mean this instead?
 78 |    ;; don't account for line continuation token being empty
 79 |    (not (and (csound-indentation--previous-line-breaks-p)
 80 |              (csound-indentation--current-line-breaks-p)))))
 81 | 
 82 | (defun csound-indentation--pointer-inside-paren-p ()
 83 |   "returns t when pointer is inside a parenthesis, otherwise nil"
 84 |   (let* ((case-fold-search nil)
 85 | 	 (last-open (save-excursion (search-backward-regexp "(" nil t)))
 86 | 	 (last-closed (save-excursion (search-backward-regexp ")" nil t))))
 87 |     (cond ((eq 'nil last-open) nil)
 88 | 	  ((and (numberp last-open) (eq 'nil last-closed)) t)
 89 | 	  ((< last-closed last-open) t)
 90 | 	  (t nil))))
 91 | 
 92 | (defun csound-indentation--cursor-behind-indentation-point-p ()
 93 |   "returns t if the cursor is behind an indentation point, which is
 94 | whitespace in the beginning of a line, otherwise nil"
 95 |   (> (or
 96 |       (save-excursion
 97 |         (beginning-of-line)
 98 |         ;; (search-forward-regexp "^\\s-*" (csound-util-line-boundry) t
 99 | 	;; 		       1) ; is this a mistake?
100 | 	(search-forward-regexp "^\\s-+" (csound-util-line-boundry) t
101 |   1)) ; did you mean this instead? 
102 |       (point)) 
103 |      (point)))
104 | 
105 | (defun csound-indentation-begin-of-expr-p ()
106 |   "returns t when in the next line a instr or opcode block starts, otherwise nil"
107 |   (save-excursion
108 |     (beginning-of-line 1) 
109 |     (search-forward-regexp "\\b\\(instr\\|opcode\\)\\b" (line-end-position 1) t)))
110 | 
111 | (defun csound-indentation-end-of-expr-p ()
112 |   "returns t when in the next line a instr or opcode block is closed, otherwise nil"
113 |   (save-excursion
114 |     (beginning-of-line 1)
115 |     (search-forward-regexp "\\b\\(endin\\|endop\\)\\b" (line-end-position 1) t)))
116 | 
117 | (defun csound-indentation-inside-instr-p ()
118 |   "returns t when point is inside a instr block, otherwise nil"
119 |   (let* ((case-fold-search nil)
120 | 	 (last-instr (save-excursion (search-backward-regexp "^\\s-*\\(instr\\)\\b" nil t)))
121 | 	 (last-endin (save-excursion (search-backward-regexp "^\\s-*\\(endin\\)\\b" nil t))))
122 |     (cond ((eq 'nil last-instr) nil)
123 | 	  ((and (numberp last-instr) (eq 'nil last-endin)) t)
124 | 	  ((< last-endin last-instr) t)
125 | 	  (t nil))))
126 | 
127 | (defun csound-indentation-inside-opcode-p ()
128 |   "returns t when point is inside a opcode block, otherwise nil"
129 |   (let* ((case-fold-search nil)
130 | 	 (last-opcode (save-excursion (search-backward-regexp "^\\s-*\\(opcode\\)\\b" nil t)))
131 | 	 (last-endop (save-excursion (search-backward-regexp "^\\s-*\\(endop\\)\\b" nil t))))
132 |     (cond ((eq 'nil last-opcode) nil)
133 | 	  ((and (numberp last-opcode) (eq 'nil last-endop)) t)
134 | 	  ((< last-endop last-opcode) t)
135 | 	  (t nil))))
136 | 
137 | (defun csound-indentation-beginning-of-bool-p ()
138 |   "returns 1 when the next line a boolean expressions starts but without a goto,
139 | otherwise 0"
140 |   (save-excursion
141 |     (beginning-of-line 1)
142 |     (if (and (search-forward-regexp
143 | 	      "\\<\\(if\\|while\\|else\\|elseif\\|until\\)\\>"
144 | 	      (csound-util-line-boundry) t 1)
145 |  	     ;; if in mix with gotos
146 | 	     ;; dont have endif therefore
147 | 	     ;; dont create logical blocks
148 | 	      (prog2
149 | 	      	  (beginning-of-line)
150 | 		  (not (search-forward-regexp "\\<\\(kgoto\\|igoto\\|goto\\)\\>" (csound-util-line-boundry) t 1))))
151 | 	1 0)))
152 | 
153 | (defun csound-indentation-end-of-bool-p ()
154 |   "returns 1 when in the next line a boolean expresion is closed,
155 | otherwise 0"
156 |   (save-excursion
157 |     (beginning-of-line 1)
158 |     (if (search-forward-regexp
159 | 	 "\\<\\(endif\\|od\\|else\\|elseif\\)\\>"
160 | 	 (csound-util-line-boundry) t 1)
161 | 	1 0)))
162 | 
163 | ;;; not needed
164 | ;; (defun csound-indentation-count-goto-if-mix
165 | ;;     (end-of-expr cnt current-depth)
166 | ;;   "if"
167 |   
168 | ;;   (if (or (> current-depth 50) (<= end-of-expr (point)))
169 | ;;       ;; if curren-depth is > 50 or pointer is behind the end of the
170 | ;;       ;; current instr or opcode block return cnt
171 | ;;       cnt
172 | ;;       ;; else do this
173 | ;;     (prog2
174 | ;; 	(beginning-of-line 1) ;; go down one line
175 | ;; 	(if ;; if a if statement and a goto statement is found count
176 | ;; 	     ;; upwards, if not return current cnt
177 | ;; 	     (and (search-forward-regexp "\\<\\(if\\)\\>" (csound-util-line-boundry) t 1)
178 | ;; 		  ;; (search-forward-regexp "\\<\\(goto\\)\\>"
179 | ;; 		  ;; 			 (csound-util-line-boundry) t
180 | ;; 		  ;; 			 1)
181 | ;; 		  ;; (search-forward-regexp "\\<\\(igoto\\|kgoto\\|goto\\)\\>"
182 | ;; 		  ;; 			 (csound-util-line-boundry) t
183 | ;; 		  ;; 			 1)
184 | ;; 		  (search-forward-regexp "\\<\\(kgoto\\|igoto\\|goto\\)\\>"
185 | ;; 					 (csound-util-line-boundry) t
186 | ;; 					 1))
187 | ;; 	    (csound-indentation-count-goto-if-mix end-of-expr (1+ cnt)
188 | ;; 						  (1+ current-depth))
189 | ;; 	  (csound-indentation-count-goto-if-mix end-of-expr cnt (1+ current-depth))))))
190 | 
191 | ;;; this function is never used
192 | ;; (defun csound-indentation-expression-first-arg (expr-string non-comma-cnt initial-recur-p)
193 | ;;   (let ((trimmed-str (csound-util-chomp expr-string)))
194 | ;;     (let* ((beginning-of-delimination (string-match "[\s\t,]" trimmed-str 0))
195 | ;;            (end-of-delimination (when beginning-of-delimination
196 | ;;                                   (string-match "[^\s^\t^,]" trimmed-str beginning-of-delimination)))
197 | ;;            (comma-inbetween  (when end-of-delimination
198 | ;;                                (string-match-p ","
199 | ;;                                                (substring-no-properties trimmed-str beginning-of-delimination
200 | ;;                                                                         end-of-delimination))))
201 | ;;            (next-form (when end-of-delimination
202 | ;;                         (substring-no-properties trimmed-str end-of-delimination (length trimmed-str))))
203 | ;;            (next-beginning (string-match "[\s\t,]" next-form 0))
204 | ;;            (next-end (when next-beginning
205 | ;;                        (string-match "[^\s^\t^,]" next-form next-beginning)))
206 | ;;            (next-comma (when next-end
207 | ;;                          (string-match-p ","
208 | ;;                                          (substring-no-properties next-form next-beginning next-end)))))
209 | ;;       (if (or (not (= 0 non-comma-cnt))
210 | ;;               (and initial-recur-p (not comma-inbetween) next-comma))
211 | ;;           (substring-no-properties trimmed-str end-of-delimination
212 | ;;                                    (or (string-match "[\s\|\t]" trimmed-str end-of-delimination)
213 | ;;                                        (length trimmed-str)))
214 | ;;         (when next-form
215 | ;;           (csound-indentation-expression-first-arg
216 | ;;            next-form
217 | ;;            (if comma-inbetween non-comma-cnt (1+ non-comma-cnt)) nil))))))
218 | 
219 | 
220 | ;;; this functions is never used
221 | ;; (defun csound-indentation-line-break-indent ()
222 | ;;   ;; If it's the second occourance in a row
223 | ;;   (if (save-excursion
224 | ;;         (beginning-of-line 0)
225 | ;;         (csound-indentation-line-break-escape-p) ; this function
226 | ;; 					; doesn't exists
227 | ;; 	)
228 | ;;       (indent-line-to (save-excursion
229 | ;;                         (beginning-of-line 0)
230 | ;;                         (search-forward-regexp "[^\s^\t]" (line-end-position 1) t 1)
231 | ;;                         (1- (current-column))))
232 | ;;     (let* ((assignment-operator (save-excursion
233 | ;;                                   (beginning-of-line 0)
234 | ;;                                   (search-forward-regexp "=" (csound-util-line-boundry) t 1)))
235 | ;;            (paren-open (when assignment-operator
236 | ;;                          (save-excursion
237 | ;;                            (goto-char assignment-operator)
238 | ;;                            (search-forward-regexp "(" (csound-util-line-boundry) t 1)))))
239 | ;;       (cond
240 | ;;        ;; ivar = poscil( |ival, ival2)
241 | ;;        ((and assignment-operator paren-open)
242 | ;;         (indent-line-to (save-excursion
243 | ;;                           (goto-char paren-open)
244 | ;;                           (search-forward-regexp "[^\s^\t^(]" (csound-util-line-boundry) t 1)
245 | ;;                           (1- (current-column)))))
246 | ;;        ;; ivar = |"coulbeanything"
247 | ;;        ((and assignment-operator (not paren-open))
248 | ;;         (indent-line-to (save-excursion
249 | ;;                           (goto-char assignment-operator)
250 | ;;                           (search-forward-regexp "[^\s^\t]" (csound-util-line-boundry) t 1)
251 | ;;                           (current-column))))
252 | ;;        ;; First element that has comma after an element without comma
253 | ;;        (t (let* ((first-arg
254 | ;;                   (csound-indentation-expression-first-arg
255 | ;;                    (csound-util-remove-comment-in-string
256 | ;;                     (buffer-substring-no-properties
257 | ;;                      (line-beginning-position 0)
258 | ;;                      (line-end-position 0)))
259 | ;;                    0 t))
260 | ;;                  (first-arg-pos
261 | ;;                   (save-excursion
262 | ;;                     (beginning-of-line 0)
263 | ;;                     (search-forward first-arg (line-end-position 1) t 1)
264 | ;;                     (current-column))))
265 | ;;             (if (and first-arg first-arg-pos)
266 | ;;                 (indent-line-to (- first-arg-pos (length first-arg)))
267 | ;;               ;; Fallback, ident +2 from first non-whitespace char above
268 | ;;               (indent-line-to
269 | ;;                (save-excursion
270 | ;;                  (beginning-of-line 0)
271 | ;;                  (search-forward-regexp "[^\s^\t]" (csound-util-line-boundry) t 1)
272 | ;;                  (current-column))))))))))
273 | 
274 | (defun csound-indentation-inside-expression-calc (expr-type)
275 |   "calculates the indentation level for current line an indent it"
276 |   (let* ((beginning-of-expr (if (eq 'instr expr-type)
277 |                                 (save-excursion
278 | 				  (search-backward-regexp "\\s-*\\<\\(instr\\)\\b" nil t))
279 | 			      (save-excursion
280 | 				(search-backward-regexp "\\s-*\\<\\(opcode\\)\\b" nil t))))
281 | 	 (end-of-expr (or (if (eq 'instr expr-type)
282 | 			      (save-excursion
283 | 				(search-forward-regexp "\\s-*\\<\\(endin\\)\\b" nil t))
284 | 			    (save-excursion
285 | 			      (search-forward-regexp "\\s-*\\<\\(endop\\)\\b" nil t)))
286 | 			  (point-max)))
287 | 	 (ending-of-current-line (line-end-position))
288 | 	 (expression-to-point (replace-regexp-in-string
289 |                                "\".*\"\\|;;.*\\|//.*" ""
290 |                                (buffer-substring beginning-of-expr (line-end-position 1)) ))
291 | 	 (expression-to-line-above (buffer-substring beginning-of-expr (line-end-position 0)))
292 | 	 (count-if-statements (save-excursion
293 | 				(csound-util-recursive-count
294 | 				 "\\<\\(if\\)\\((\\|\\>\\)"
295 | 				 expression-to-point 0)))
296 | 	 (goto-if-mix (save-excursion
297 | 				(csound-util-recursive-count
298 | 				 "\\<if\\>.*\\<\\(goto\\|igoto\\|kgoto\\)\\>" 
299 | 				 expression-to-point 0)))			    
300 | 	 ;; (count-elseif-statements (recursive-count
301 | 	 ;; "\\b\\(elseif\\)\\b" (buffer-substring beginning-of-expr
302 | 	 ;; (line-end-position 1)) 0))
303 | 	 (count-endif-statements (csound-util-recursive-count "\\s-?\\(endif\\)\\s-?" expression-to-point 0))
304 | 	 (count-while-statements (csound-util-recursive-count "\\s-?\\(while\\)\\s-?" expression-to-point 0))
305 | 	 (count-od-statements (csound-util-recursive-count "\\<\\(od\\)\\>" expression-to-point 0))
306 |          ;;(count-switch-statements (csound-util-recursive-count "\\s-?\\(switch\\)\\s-?" expression-to-point 0))
307 |          ;;(count-endw-statements (csound-util-recursive-count "\\s-?\\(endsw\\)\\s-?" expression-to-point 0))
308 |          (count-multiline-string-open (csound-util-recursive-count "{{" expression-to-line-above 0))
309 | 	 (count-multiline-string-close (csound-util-recursive-count "}}" expression-to-point 0))
310 | 	 (after-goto-statement
311 | 	  (if csound-indentation-indent-goto
312 | 	      (if (and (string-match-p "\\<\\w*:\\b" expression-to-point)
313 | 		       (= 0 (- count-multiline-string-open count-multiline-string-close)))
314 | 		  1 0)
315 | 	    0))
316 | 	 (line-at-goto-statement
317 | 	  (if (and csound-indentation-indent-goto
318 |                    (save-excursion
319 | 		     (beginning-of-line)
320 | 		     (search-forward-regexp "\\<\\w*\\:\\s-*$" (line-end-position 1) t 1)))
321 | 	      1 0))
322 | 	 (begin-of-bool-p (csound-indentation-beginning-of-bool-p))
323 |          (previous-line-break-adjust
324 | 	  (if (csound-indentation--previous-line-breaks-p)
325 | 	      1 0))
326 | 	 (unbalanced-parens
327 | 	  (if (csound-indentation--pointer-inside-paren-p)
328 | 	      1 0))
329 | 	 (unbalanced-parens-or-line-break
330 | 	  (if (or (eq 1 unbalanced-parens) (eq 1 previous-line-break-adjust))
331 | 					      1 0))
332 | 	 (tab-count (max 1 (1+ (- (+ count-if-statements
333 |                                      after-goto-statement
334 |                                      count-multiline-string-open
335 | 				     ;; count-elseif-statements
336 | 				     count-while-statements
337 |                                      ;;count-switch-statements
338 |                                      ;;previous-line-break-adjust
339 | 				     unbalanced-parens-or-line-break)
340 | 				  count-endif-statements
341 | 				  count-od-statements
342 |                                   ;;count-endw-statements
343 | 				  begin-of-bool-p
344 | 				  (if (> after-goto-statement 0)  line-at-goto-statement 0)
345 | 				  goto-if-mix
346 |                                   count-multiline-string-close
347 | 				  ;;end-of-bool-p
348 | 				  )))))
349 | ;;     (message "topoint: %s" expression-to-point)
350 | ;;     (message "bool-begin: %d, ods: %d, line-at-goto: %d, aft-goto: %d,
351 | ;; count-if: %d, count-endif: %d mix: %d mls: %d.%d unbalanced-parens: %d
352 | ;; tab-count: %d"
353 | ;;              begin-of-bool-p
354 | ;;              count-od-statements
355 | ;;              line-at-goto-statement
356 | ;;              after-goto-statement
357 | ;;              count-if-statements
358 | ;;              count-endif-statements
359 | ;;              goto-if-mix
360 | ;;              count-multiline-string-open
361 | ;;              count-multiline-string-close
362 | ;; 	     unbalanced-parens
363 | ;;              tab-count)
364 | ;;     (message "RES %d"  (* csound-indentation-spaces tab-count))
365 | ;;     ;;(message "str-open: %d str-close: %d " count-string-open count-string-close)
366 | ;;     (message "multistr-open: %d multistr-close: %d " count-multiline-string-open count-multiline-string-close)
367 |     ;; (when (and (eq 't end-of-bool-p) (not (eq 't begin-of-bool-p))) (indent-line-to (* csound-indentation-spaces (1- tab-count))))
368 |     (indent-line-to (* csound-indentation-spaces tab-count))))
369 | 
370 | (defun csound-indentation--for-each-line (start end fn)
371 |   (while (< (point) end)
372 |     (funcall fn)
373 |     (forward-line)))
374 | 
375 | (defun csound-indentation--do-indent ()
376 |   (let ((score-p (or (save-excursion (search-backward "<CsScore" nil t 1))
377 | 		     (string-match-p ".sco$" (buffer-name (current-buffer))))))
378 |     (cond
379 |      (score-p (if csound-indentation-aggressive-score
380 | 		  (csound-score-align-block)
381 | 		(indent-line-to 0)))
382 |      ((csound-indentation-begin-of-expr-p) (indent-line-to 0))
383 |      ((csound-indentation-end-of-expr-p) (indent-line-to 0))
384 |      ;; ((csound-indentation-line-break-escape-p) (csound-indentation-line-break-indent))
385 |      ((csound-indentation-inside-instr-p) (csound-indentation-inside-expression-calc 'instr))
386 |      ((csound-indentation-inside-opcode-p) (csound-indentation-inside-expression-calc 'opcode))
387 |      (t (indent-line-to 0)))))
388 | 
389 | (defun csound-indentation-line ()
390 |   "Indent current line."
391 |   (if (or (csound-indentation--current-line-empty-p)
392 |           (csound-indentation--cursor-behind-indentation-point-p))
393 |       (csound-indentation--do-indent)
394 |     (save-excursion (csound-indentation--do-indent))))
395 | 
396 | (provide 'csound-indentation)
397 | 
398 | ;;; csound-indentation.el ends here
399 | 


--------------------------------------------------------------------------------
/csound-repl.el:
--------------------------------------------------------------------------------
  1 | ;;; csound-repl.el --- A major mode for interacting and coding Csound
  2 | 
  3 | ;; Copyright (C) 2017 - 2023  Hlöðver Sigurðsson
  4 | 
  5 | ;; Author: Hlöðver Sigurðsson <hlolli@gmail.com>
  6 | ;; Version: 0.2.9
  7 | ;; Package-Requires: ((emacs "25") (shut-up "0.3.2") (multi "2.0.1") (dash "2.16.0") (highlight "0"))
  8 | ;; URL: https://github.com/hlolli/csound-mode
  9 | 
 10 | ;; This program is free software; you can redistribute it and/or modify
 11 | ;; it under the terms of the GNU General Public License as published by
 12 | ;; the Free Software Foundation, either version 3 of the License, or
 13 | ;; (at your option) any later version.
 14 | 
 15 | ;; This program is distributed in the hope that it will be useful,
 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18 | ;; GNU General Public License for more details.
 19 | 
 20 | ;; You should have received a copy of the GNU General Public License
 21 | ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 22 | 
 23 | ;;; Commentary:
 24 | ;; Repl functionality for csound-mode
 25 | 
 26 | ;;; Code:
 27 | 
 28 | (require 'comint)
 29 | (require 'csound-font-lock)
 30 | (require 'csound-opcodes)
 31 | (require 'csound-repl-interaction)
 32 | (require 'csound-util)
 33 | (require 'dash)
 34 | (require 'font-lock)
 35 | (require 'highlight)
 36 | (require 'shut-up)
 37 | 
 38 | (defvar csound-repl--csound-server)
 39 | (defvar csound-repl--udp-client-proc)
 40 | (defvar csound-repl--console-client-proc)
 41 | 
 42 | ;; For flash effects, expression variables,
 43 | ;; need to live longer than the funcall
 44 | (defvar csound-repl--expression-start 0)
 45 | (defvar csound-repl--expression-end 0)
 46 | (defvar csound-repl--expression-tmp-buffer-size 0)
 47 | 
 48 | (defvar csound-repl--process-tty-name
 49 |   ""
 50 |   "tty-name of the comnit process that
 51 |   communicates with Csound instance.")
 52 | 
 53 | (defcustom csound-repl-buffer-name "*Csound REPL*"
 54 |   "Buffer name given to the csound-mode repl."
 55 |   :group 'csound-mode-repl
 56 |   :type 'string)
 57 | 
 58 | (defcustom csound-repl-sr 44100
 59 |   "Sample rate of the csound repl"
 60 |   :group 'csound-mode-repl
 61 |   :type 'integer)
 62 | 
 63 | (defcustom csound-repl-ksmps 32
 64 |   "ksmps value of the csound repl"
 65 |   :group 'csound-mode-repl
 66 |   :type 'integer)
 67 | 
 68 | (defcustom csound-repl-kr
 69 |   (/ csound-repl-sr csound-repl-ksmps)
 70 |   "kr value of the csound repl"
 71 |   :group 'csound-mode-repl
 72 |   :type 'integer)
 73 | 
 74 | (defcustom csound-repl-nchnls 2
 75 |   "Number of out channels for the csound repl"
 76 |   :group 'csound-mode-repl
 77 |   :type 'integer)
 78 | 
 79 | (defcustom csound-repl-0dbfs 1
 80 |   "0dbfs value of the csound repl"
 81 |   :group 'csound-mode-repl
 82 |   :type 'integer)
 83 | 
 84 | (defcustom csound-repl-start-server-p t
 85 |   "When non nil, start csound server."
 86 |   :group 'csound-mode-repl
 87 |   :type 'boolean)
 88 | 
 89 | (defun csound-repl--get-sr (buf)
 90 |   (cond
 91 |    ((and buf csound-repl-start-server-p)
 92 |     (save-excursion
 93 |       (switch-to-buffer buf)
 94 |       (goto-char (point-min))
 95 |       (search-forward-regexp
 96 |        "^\\s-*sr\\s-*=\\s-*\\([0-9]+\\)" nil t 1)
 97 |       (let ((sr (match-string-no-properties 1)))
 98 |         (switch-to-prev-buffer)
 99 |         sr))
100 |     (number-to-string csound-repl-sr))
101 |    (buf (number-to-string csound-repl-sr))))
102 | 
103 | (defun csound-repl--get-kr (buf)
104 |   (cond ((and buf csound-repl-start-server-p)
105 |          (save-excursion
106 |            (switch-to-buffer buf)
107 |            (goto-char (point-min))
108 |            (search-forward-regexp
109 |             "^\\s-*kr\\s-*=\\s-*\\([0-9]+\\)" nil t 1)
110 |            (let ((sr (match-string-no-properties 1)))
111 |              (switch-to-prev-buffer)
112 |              sr))
113 |          (number-to-string csound-repl-kr))
114 |         (buf (number-to-string csound-repl-kr))))
115 | 
116 | (defun csound-repl--get-ksmps (buf)
117 |   (cond ((and buf csound-repl-start-server-p)
118 |          (save-excursion
119 |            (switch-to-buffer buf)
120 |            (goto-char (point-min))
121 |            (search-forward-regexp
122 |             "^\\s-*ksmps\\s-*=\\s-*\\([0-9]+\\)" nil t 1)
123 |            (let ((sr (match-string-no-properties 1)))
124 |              (switch-to-prev-buffer)
125 |              sr))
126 |          (number-to-string csound-repl-ksmps))
127 |         (buf (number-to-string csound-repl-ksmps))))
128 | 
129 | (defun csound-repl--get-0dbfs (buf)
130 |   (cond ((and buf csound-repl-start-server-p)
131 |          (save-excursion
132 |            (switch-to-buffer buf)
133 |            (goto-char (point-min))
134 |            (search-forward-regexp
135 |             "^\\s-*0dbfs\\s-*=\\s-*\\([0-9]+\\)" nil t 1)
136 |            (let ((sr (match-string-no-properties 1)))
137 |              (switch-to-prev-buffer)
138 |              sr))
139 |          (number-to-string csound-repl-0dbfs))
140 |         (buf (number-to-string csound-repl-0dbfs))))
141 | 
142 | (defun csound-repl--get-nchnls (buf)
143 |   (cond ((and buf csound-repl-start-server-p)
144 |          (save-excursion
145 |            (switch-to-buffer buf)
146 |            (goto-char (point-min))
147 |            (search-forward-regexp
148 |             "^\\s-*nchnls\\s-*=\\s-*\\([0-9]+\\)" nil t 1)
149 |            (let ((sr (match-string-no-properties 1)))
150 |              (switch-to-prev-buffer)
151 |              sr))
152 |          (number-to-string csound-repl-nchnls))
153 |         (buf (number-to-string csound-repl-nchnls))))
154 | 
155 | (defun csound-repl-buffer-running-p ()
156 |   (let ((indx 0)
157 |         (exists? nil))
158 |     (while (and (< indx (length (buffer-list)))
159 |                 (not exists?))
160 |       (if (string-match
161 |            csound-repl-buffer-name
162 |            (buffer-name (nth indx (buffer-list))))
163 |           (setq exists? t)
164 |         (setq indx (1+ indx))))
165 |     exists?))
166 | 
167 | (defun csound-repl--buffer-create ()
168 |   (interactive)
169 |   (when (not (csound-repl-buffer-running-p))
170 |     (let ((prev-buffer (buffer-name)))
171 |       (save-excursion
172 |         (generate-new-buffer
173 |          csound-repl-buffer-name)
174 |         (split-window-sensibly)
175 |         (switch-to-buffer-other-window csound-repl-buffer-name)
176 |         (with-current-buffer (buffer-name) (funcall 'csound-repl-mode))
177 |         (switch-to-buffer-other-window prev-buffer)))))
178 | 
179 | (defun csound-repl-last-visited-csd ()
180 |   "This decides which filename is given to repl buffer.
181 |    Returns a list of (path buffer-name buffer)"
182 |   (shut-up
183 |     (let ((indx--last-visited 0)
184 |           (match-p nil)
185 |           (last-file "not-found")
186 |           (len (length (buffer-list))))
187 |       (while (and (< indx--last-visited len)
188 |                   (not match-p))
189 |         (if (string-match-p ".csd$" (buffer-name (nth indx--last-visited (buffer-list))))
190 |             (prog2
191 |                 (setq-local last-file (list
192 |                                        (file-name-directory
193 |                                         (buffer-file-name
194 |                                          (nth indx--last-visited (buffer-list))))
195 |                                        (buffer-name
196 |                                         (nth indx--last-visited (buffer-list)))
197 |                                        (nth indx--last-visited (buffer-list))))
198 |                 (setq-local match-p t))
199 |           (setq-local indx--last-visited (1+ indx--last-visited))))
200 |       last-file)))
201 | 
202 | 
203 | (defconst csound-repl-prompt
204 |   (let ((prompt "csnd> "))
205 |     (put-text-property 0 (length prompt) 'read-only t prompt)
206 |     prompt))
207 | 
208 | 
209 | (defvar csound-repl--input nil)
210 | 
211 | (defvar csound-repl--input-history (make-hash-table :test 'equal))
212 | 
213 | (defun csound-repl--input-sender (proc input)
214 |   (unless (eq 0 (length (csound-util-chomp input)))
215 |     (let* ((id (csound-util--generate-random-uuid))
216 |            (buffer-read-only nil)
217 |            (lb (- (line-beginning-position) 5))
218 |            (input-string (-> input csound-util-chomp))
219 |            (first-chunk (car (split-string input-string))))
220 |       (when (and first-chunk (< 0 (length first-chunk)))
221 |         (read-csound-repl (intern (substring-no-properties first-chunk 0 1))
222 |                           csound-repl--udp-client-proc input-string))
223 |       ;; (comint-output-filter proc (format "%s\n" return-val))
224 |       (push (cons id input) csound-repl--input)
225 |       ;; (message "%s" input)
226 |       (puthash id (process-buffer proc) csound-repl--input-history)
227 |       ;; (save-excursion (set-buffer csound-repl-buffer-name) (point-max))
228 |       ))
229 |   (comint-output-filter proc csound-repl-prompt))
230 | 
231 | (defun csound-repl--generate-welcome-message (cur-file sr ksmps nchnls 0dbfs)
232 |   (let* ((csound-repl---welcome-title
233 |           (concat "  __   __   __             __             __   __   __ \n"
234 |                   " /    /    /  | /  | /| ||/  |      /|/| /  ||/  | /   \n"
235 |                   "(    (___ (   |(   |( | ||   | ___ ( / |(   ||   |(___ \n"
236 |                   "|   )    )|   )|   )| | )|   )     |   )|   )|   )|    \n"
237 |                   "|__/  __/ |__/ |__/ | |/ |__/      |  / |__/ |__/ |__  \n"))
238 |          (s (format (concat "\n"
239 |                             "file: " cur-file "\n"
240 |                             "sr: %s\n"
241 |                             "ksmps: %s\n"
242 |                             "nchnls: %s\n"
243 |                             "0dbfs: %s\n\n\n")
244 |                     sr
245 |                     ksmps
246 |                     nchnls
247 |                     0dbfs)))
248 |     (concat csound-repl---welcome-title s)))
249 | 
250 | ;; (defun csound-repl--set-default-dir-options ()
251 | ;;   (let ((filedir (nth 1 (csound-repl-last-visited-csd))))
252 | ;;     (mapc (lambda (opt)
253 | ;;             (csoundSetOption csound-repl--csound-instance
254 | ;;                              (format "--env:%s+=;%s"
255 | ;;                                      opt filedir)))
256 | ;;           '("INCDIR" "SFDIR"
257 | ;;             "SSDIR" "SADIR"
258 | ;;             "MFDIR"))))
259 | 
260 | (defun csound-repl--expression-at-point ()
261 |   (save-excursion
262 |     (end-of-line)
263 |     (let ((fallback (list (line-beginning-position) (line-end-position)))
264 |           (beg (search-backward-regexp "^\\s-*\\<instr\\>\\|^\\s-*\\<opcode\\>" nil t))
265 |           (end (search-forward-regexp "^\\s-*\\<endin\\>\\|^\\s-*\\<endop\\>" nil t)))
266 |       (if (and beg end (<= beg (car fallback) end))
267 |           (list beg end)
268 |         fallback
269 |         ;; (throw 'no-expression "No instrument or opcode expression was found.")
270 |         ))))
271 | 
272 | (defun csound-repl--newline-seperated-score-block ()
273 |   (let ((beg-block (save-excursion
274 |                      (end-of-line 0)
275 |                      (while (search-backward-regexp
276 |                              "\\(^\\s-*\\|^\\t-*\\)i+[0-9\\\".*]*\\b"
277 |                              (line-beginning-position 1) t 1)
278 |                        (end-of-line 0))
279 |                      (line-beginning-position 2)))
280 |         (end-block (save-excursion
281 |                      (end-of-line 1)
282 |                      (while (search-backward-regexp
283 |                              "\\(^\\s-*\\|^\\t-*\\)i+[0-9\\\".*]*\\b"
284 |                              (line-beginning-position 1) t 1)
285 |                        (end-of-line 2))
286 |                      (line-end-position 0))))
287 |     (list beg-block end-block)))
288 | 
289 | (setq csound-repl--filter-multline-hackfix nil)
290 | 
291 | (setq csound-repl--filter-multline-hackfix-rtevent nil)
292 | 
293 | (defun csound-repl--filter (_ msg)
294 |   (save-current-buffer
295 |     (set-buffer csound-repl-buffer-name)
296 |     (goto-char (buffer-size))
297 |     (let ((msg (->> msg
298 |                     (replace-regexp-in-string "\0\\|\n" "")
299 |                     (replace-regexp-in-string ">>>" " >>> ")
300 |                     (replace-regexp-in-string "\\s-+rtevent:\\s-+" "rtevent: ")))
301 |           (hackfix-p csound-repl--filter-multline-hackfix))
302 |       (when (string-match-p "rtevent:" msg)
303 |         (setq csound-repl--filter-multline-hackfix-rtevent 0
304 |               csound-repl--filter-multline-hackfix t))
305 |       (when (numberp csound-repl--filter-multline-hackfix-rtevent)
306 |         (if (eq 2 csound-repl--filter-multline-hackfix-rtevent)
307 |             (setq csound-repl--filter-multline-hackfix-rtevent nil
308 |                   csound-repl--filter-multline-hackfix nil)
309 |           (setq csound-repl--filter-multline-hackfix-rtevent
310 |                 (1+ csound-repl--filter-multline-hackfix-rtevent))))
311 |       (when (string-match-p ">>>" msg)
312 |         (setq csound-repl--filter-multline-hackfix t))
313 |       (when (string-match-p "<<<" msg)
314 |         (setq csound-repl--filter-multline-hackfix nil))
315 |       (if (prog2 (beginning-of-line)
316 |               (search-forward csound-repl-prompt nil t 1))
317 |           (progn
318 |             (beginning-of-line)
319 |             (end-of-line 0)
320 |             (if hackfix-p
321 |                 (insert msg)
322 |               (insert (concat "\n" msg))))
323 |         (progn
324 |           (goto-char (buffer-size))
325 |           (end-of-line 1)
326 |           (if hackfix-p
327 |               (insert msg)
328 |             (insert (concat msg "\n")))))
329 |       (when (or (string-match-p  "rtjack\\: error" msg)
330 |                 (string-match-p "rtjack\\: could not connect" msg))
331 |         (insert "REPL ERROR: Something went wrong, please restart the repl to continue.\n")))
332 |     (goto-char (1+ (buffer-size)))))
333 | 
334 | (defun csound-repl--errorp (pre-eval-size)
335 |   (save-current-buffer
336 |     (set-buffer csound-repl-buffer-name)
337 |     (goto-char pre-eval-size)
338 |     (beginning-of-line 0)
339 |     (if (or (search-forward-regexp "error: " nil t 1)
340 |             (search-forward-regexp "Can't open" nil t 1)
341 |             (search-forward-regexp "Can't find" nil t 1))
342 |         t nil)))
343 | 
344 | (defun csound-repl--flash-region (errorp)
345 |   (if errorp
346 |       (hlt-highlight-region
347 |        csound-repl--expression-start
348 |        csound-repl--expression-end 'csound-font-lock-eval-flash-error)
349 |     (hlt-highlight-region
350 |      csound-repl--expression-start
351 |      csound-repl--expression-end
352 |      'csound-font-lock-eval-flash))
353 |   (run-with-idle-timer 0.15 nil
354 |                        (lambda ()
355 |                          (hlt-unhighlight-region
356 |                           csound-repl--expression-start
357 |                           csound-repl--expression-end))))
358 | 
359 | (defun csound-repl-evaluate-orchestra-region (start end)
360 |   (let ((expression-string (buffer-substring start end)))
361 |     (setq-local csound-repl--expression-start start)
362 |     (setq-local csound-repl--expression-end end)
363 |     (setq-local csound-repl--expression-tmp-buffer-size
364 |                 (buffer-size (get-buffer csound-repl-buffer-name)))
365 |     (process-send-string csound-repl--udp-client-proc expression-string)
366 |     (run-with-idle-timer
367 |      0.02 nil
368 |      (lambda ()
369 |        (if (csound-repl--errorp csound-repl--expression-tmp-buffer-size)
370 |            (csound-repl--flash-region t)
371 |          (progn
372 |            (csound-repl--flash-region nil)
373 |            (csound-repl--filter
374 |             nil
375 |             (concat ";; Evaluated: "
376 |                     (buffer-substring csound-repl--expression-start
377 |                                       (save-excursion
378 |                                         (goto-char csound-repl--expression-start)
379 |                                         (line-end-position)))))))))))
380 | 
381 | 
382 | (defun csound-repl-evaluate-score-region (start end)
383 |   (let ((expression-string (buffer-substring start end))
384 |         (message-buffer-size (buffer-size
385 |                               (get-buffer csound-repl-buffer-name))))
386 |     ;; (message expression-string)
387 |     (setq-local csound-repl--expression-start start)
388 |     (setq-local csound-repl--expression-end end)
389 |     (setq-local csound-repl--expression-tmp-buffer-size
390 |                 (buffer-size (get-buffer csound-repl-buffer-name)))
391 |     (process-send-string csound-repl--udp-client-proc
392 |                          (concat "$" (csound-score-trim-time expression-string)))
393 |     (run-with-idle-timer
394 |      0.02 nil
395 |      (lambda ()
396 |        (if (csound-repl--errorp csound-repl--expression-tmp-buffer-size)
397 |            (prog2 (csound-repl--flash-region t)
398 |                (csound-repl--filter nil ";; Score: error in code"))
399 |          (csound-repl--flash-region nil))))))
400 | 
401 | (defun csound-repl-evaluate-region ()
402 |   "Evaluate any csound code in region."
403 |   (interactive)
404 |   (if (not (csound-repl-buffer-running-p))
405 |       (message "csound-repl is not started")
406 |     (if (save-excursion
407 |           (search-backward "<CsScore" nil t 1))
408 |         (if (region-active-p)
409 |             (prog2
410 |                 (csound-repl-evaluate-score-region
411 |                  (region-beginning)
412 |                  (region-end))
413 |                 (deactivate-mark))
414 |           (if (save-excursion
415 |                 (beginning-of-line 1)
416 |                 (search-forward-regexp "i[0-9\"]?" (line-end-position) t 1))
417 |               (apply 'csound-repl-evaluate-score-region
418 |                      (csound-repl--newline-seperated-score-block))
419 |             (csound-repl-evaluate-score-region
420 |              (line-beginning-position)
421 |              (line-end-position))))
422 |       (if (region-active-p)
423 |           (prog2
424 |               (csound-repl-evaluate-orchestra-region
425 |                (region-beginning)
426 |                (region-end))
427 |               (deactivate-mark))
428 |         (apply 'csound-repl-evaluate-orchestra-region (csound-repl--expression-at-point))))))
429 | 
430 | (defun csound-repl-evaluate-line ()
431 |   "Evaluate csound expression on current line."
432 |   (interactive)
433 |   (if (not (csound-repl-buffer-running-p))
434 |       (message "csound-repl is not started")
435 |     (if (save-excursion
436 |           (search-backward-regexp "<CsScore" nil t 1))
437 |         (csound-repl-evaluate-score-region
438 |          (line-beginning-position)
439 |          (line-end-position))
440 |       (csound-repl-evaluate-orchestra-region
441 |        (line-beginning-position)
442 |        (line-end-position)))))
443 | 
444 | 
445 | ;; (defun csound-repl-plot-ftgen ()
446 | ;;   "Plots the f statement on the cursor's current line.
447 | ;;    This operation evaluates the f statement and reads
448 | ;;    table from Csound, sends it to gnuplot which sends
449 | ;;    the png into the REPL."
450 | ;;   ;; (interactive)
451 | ;;   (let* ((line-str (buffer-substring-no-properties (line-beginning-position)
452 | ;;               (line-end-position)))
453 | ;;   (line-str (csound-util-chomp line-str))
454 | ;;   (f-statement-p (if (eq 0 (length line-str))
455 | ;;          nil
456 | ;;        (string-equal "f" (substring line-str 0 1))))
457 | ;;   (ftgen-orc-p (string-match-p "\\<ftgen\\>" line-str)))
458 | ;;     (when (or f-statement-p
459 | ;;        ftgen-orc-p)
460 | ;;       (if f-statement-p
461 | ;;    (csound-repl-evaluate-score-region (line-beginning-position)
462 | ;;               (line-end-position))
463 | ;;  (csound-repl-evaluate-orchestra-region (line-beginning-position)
464 | ;;                 (line-end-position)))
465 | ;;       (sleep-for 0 50)
466 | ;;       (let ((table-num (if f-statement-p
467 | ;;         (-> (substring line-str 1)
468 | ;;             (csound-util-chomp)
469 | ;;             (split-string " ")
470 | ;;             first)
471 | ;;       (save-current-buffer
472 | ;;         (set-buffer csound-repl-buffer-name)
473 | ;;         (goto-char (buffer-size))
474 | ;;         (search-backward-regexp "ftable \\([0-9]+\\)\\:")
475 | ;;         (match-string-no-properties 1)))))
476 | ;;  (csound-repl-interaction--plot (string-to-number table-num))))))
477 | 
478 | (defvar csound-repl--font-lock-list
479 |   '((";.*" . font-lock-comment-face)
480 |     ("SECTION [0-9]+:" . font-lock-string-face)
481 |     ("new alloc.*" . font-lock-comment-face)
482 |     ("error:\\|instrerror:" . font-lock-warning-face)
483 |     ;; ("\\<T[^_]\\|\\<TT\\|M:" . csound-font-lock-i-rate)
484 |     (">>>.*<<<" . csound-font-lock-s-variables)
485 |     ("\\<\\w*[^0-9]:\\B" . csound-font-lock-a-rate)))
486 | 
487 | (defun csound-repl--sentinel (proc msg)
488 |   (message msg))
489 | 
490 | (defun csound-repl--start-client (port)
491 |   (let ((port (if (stringp port) port (number-to-string port)))
492 |         (host "127.0.0.1"))
493 |     (make-network-process :name "csound-udp-client"
494 |                           :type 'datagram
495 |                           :buffer csound-repl-buffer-name
496 |                           :family 'ipv4
497 |                           :host host
498 |                           :service port
499 |                           :sentinel 'csound-repl--filter
500 |                           :filter 'csound-repl--filter)))
501 | 
502 | (defun csound-repl--console-client (port)
503 |   (let ((port (if (stringp port) port (number-to-string port)))
504 |         (host "127.0.0.1"))
505 |     (make-network-process :name "csound-console-client"
506 |                           :server t
507 |                           :type 'datagram
508 |                           :buffer csound-repl-buffer-name
509 |                           :family 'ipv4
510 |                           :host host
511 |                           :service port
512 |                           :sentinel 'csound-repl--filter
513 |                           :filter 'csound-repl--filter)))
514 | 
515 | (defun csound-repl--start-server (port console-port sr ksmps nchnls zero-db-fs)
516 |   (start-process "Csound Server" csound-repl-buffer-name
517 |                  "csound" "-odac"
518 |                  (format "--port=%s" port)
519 |                  (format "--udp-console=127.0.0.1:%s" console-port)
520 |                  (format "--sample-rate=%s" sr)
521 |                  (format "--ksmps=%s" ksmps)
522 |                  (format "--nchnls=%s" nchnls)
523 |                  (format "--0dbfs=%s" zero-db-fs)))
524 | 
525 | (setq csound-repl-map
526 |       (let ((map comint-mode-map))
527 |         (define-key map (kbd "<S-return>")
528 |           (lambda ()
529 |             (interactive)
530 |             (insert "\n      ")))
531 |         map))
532 | 
533 | (define-derived-mode
534 |   csound-repl-mode comint-mode "CsoundRepl"
535 |   "Csound Interactive Message Buffer and REPL."
536 |   :syntax-table csound-mode-syntax-table
537 |   (setq-local comint-input-sender 'csound-repl--input-sender)
538 |   (iimage-mode t)
539 |   (unless (comint-check-proc (current-buffer))
540 |     (let* ((last-csound-buffer (csound-repl-last-visited-csd))
541 |            (buffer-name (and last-csound-buffer (listp last-csound-buffer)
542 |                              (nth 1 last-csound-buffer)))
543 |            (buffer (and last-csound-buffer (listp last-csound-buffer)
544 |                         (nth 2 last-csound-buffer)))
545 |            (port (if csound-repl-start-server-p 6000 8099))
546 |            (console-port (if csound-repl-start-server-p 6001 8100))
547 |            (sr (csound-repl--get-sr buffer))
548 |            (ksmps (csound-repl--get-ksmps buffer))
549 |            (nchnls (csound-repl--get-nchnls buffer))
550 |            (0dbfs (csound-repl--get-0dbfs buffer)))
551 |       (insert (csound-repl--generate-welcome-message buffer-name sr ksmps nchnls 0dbfs))
552 |       (if csound-repl-start-server-p
553 |           (setq csound-repl--csound-server (csound-repl--start-server
554 |                                             port
555 |                                             console-port
556 |                                             sr
557 |                                             ksmps
558 |                                             nchnls
559 |                                             0dbfs))
560 |         (let ((fake-proc
561 |                (condition-case nil
562 |                    (start-process "ijsm" (current-buffer) "hexl")
563 |                  (file-error (start-process "ijsm" (current-buffer) "cat")))))
564 |           (set-process-query-on-exit-flag fake-proc nil)
565 |           ;; Add a silly header
566 |           ;;  (insert "Interactive Javascript Mode\n")
567 |           (set-marker
568 |            (process-mark fake-proc) (point))
569 |           (comint-output-filter fake-proc csound-repl-prompt)))
570 |       (when csound-repl-start-server-p
571 |         (set-process-filter csound-repl--csound-server (lambda (_ stdin) nil)))
572 |       (setq csound-repl--udp-client-proc (csound-repl--start-client port))
573 |       (setq csound-repl--console-client-proc (csound-repl--console-client console-port))
574 |       (when csound-repl-start-server-p
575 |         (set-process-query-on-exit-flag csound-repl--csound-server nil))
576 |       (set-process-query-on-exit-flag csound-repl--udp-client-proc nil)
577 |       (set-process-query-on-exit-flag csound-repl--console-client-proc nil)
578 |       (setq-local font-lock-defaults '(csound-font-lock-list
579 |                                        csound-repl--font-lock-list))
580 |       (setq-local comment-start ";; ")
581 |       (setq-local eldoc-documentation-function 'csound-eldoc-function)
582 |       (add-hook 'completion-at-point-functions #'csound-util-opcode-completion-at-point nil t)
583 |       ;; (setq-local comint-prompt-read-only t)
584 |       (setq-local comint-scroll-to-bottom-on-input t)
585 |       (setq-local comint-scroll-to-bottom-on-output t)
586 |       (setq-local comint-move-point-for-output t)
587 |       ;; (set-marker (process-mark csound-repl--console-client-proc) (point))
588 |       ;; (comint-output-filter csound-repl--console-client-proc csound-repl-prompt)
589 |       )))
590 | 
591 | (provide 'csound-repl)
592 | 
593 | ;;; csound-repl.el ends here
594 | 


--------------------------------------------------------------------------------