-
Notifications
You must be signed in to change notification settings - Fork 11
/
cl-patterns-skeletons.el
119 lines (102 loc) · 4.62 KB
/
cl-patterns-skeletons.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
;;;; cl-patterns-skeletons.el --- collection of cl-patterns-related skeletons. -*- lexical-binding: t; -*-
;; Copyright (C) 2021 modula t.
;; Author: modula t. <defaultxr AT gmail DOT com>
;; Homepage: https://github.com/defaultxr/cl-patterns
;; Version: 0.5
;; Package-Requires: ((emacs "24.4"))
;; Keywords: convenience, lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; These are just a few skeletons for various cl-patterns-related constructs.
;; They're designed to be as "smart" as possible, i.e. by prompting for paths
;; when appropriate, inserting correct pattern parameters based on synthdefs,
;; etc. If you don't care what something is named, you can enter just a period
;; (.) to automatically generate a name based on the
;; function that the `cl-patterns-name-generator' custom variable is
;; set to; by default it generates a name that is just random letters.
;;; Code:
(require 'cl-patterns-helpers)
(defcustom cl-patterns-bdef-default-directory nil
"The directory that `bdef-skeleton''s filename completion should start from.
If nil (the default), start from the current buffer's directory instead."
:type '(choice directory (const nil))
:group 'cl-patterns)
(defcustom cl-patterns-name-generator 'cl-patterns-generate-random-name
"The function that is used to generate a default name for a pb or other named
construct when the user supplies only a period."
:type '(function)
:group 'cl-patterns)
(defun cl-patterns-read-name (prompt initial-input &optional default-value history)
"Prompt the user for a name for the construct being generated by a skeleton. If
the user enters just a period, a random name is generated with
`cl-patterns-name-generator'."
(let* ((history (or history 'cl-patterns-name-history))
(res (read-string prompt initial-input history default-value)))
(if (string= res ".")
(funcall cl-patterns-name-generator)
(cl-patterns-ensure-symbol-syntax res))))
(define-skeleton tempo-skeleton
"Insert (tempo ...) with the current *clock* tempo."
""
"(tempo " (number-to-string (or (cl-patterns-lisp-eval `(cl:* 60 (cl-patterns:tempo cl-patterns:*clock*)))
110))
_ "/60)")
(define-skeleton bdef-skeleton
"Prompt for a file, then insert (bdef ...) that loads said file."
""
"(bdef "
(let* ((filename (read-file-name "bdef file? " cl-patterns-bdef-default-directory))
(suggestion (concat ":" (cl-patterns-friendly-string (file-name-base filename))))
(sym (cl-patterns-read-name "bdef name? (. to autogenerate) " suggestion (mapcar 'cl-patterns-increase-number-suffix (remove nil (list (cl-patterns-guess-bdef)))))))
(concat sym " \"" (replace-regexp-in-string "\"" "\\\"" (abbreviate-file-name filename) t t) "\""))
")")
(define-skeleton pb-skeleton
"Insert (pb ...), prompting for a name and an instrument."
""
"(pb " (let* ((instrument (cl-patterns-select-instrument "pb instrument? "))
(name (cl-patterns-read-name "pb name? (. to autogenerate) "
nil
(mapcar 'cl-patterns-increase-number-suffix
(remove nil (list (cl-patterns-guess-pdef) instrument)))))
(args (cl-patterns-instrument-arguments instrument))
(buf-arg (or (member "BUFFER" args)
(member "BUFNUM" args))))
(concat name "\n :instrument " instrument
(when buf-arg
(concat "\n :" (downcase (car buf-arg)) " " (cl-patterns-guess-bdef))))) "
:dur 1" _ "
:pfindur 4)")
(define-skeleton pt-skeleton
"Insert a basic ptrack pattern."
""
"(pdef :" _ "
(ptrack
(list :note 0 :dur 1/4 :instrument :" (cl-patterns-guess-instrument) ")
#T(- ;; 0
-
-
-
- ;; 4
-
-
-
- ;; 8
-
-
-
- ;; 12
-
-
-
)))")
(provide 'cl-patterns-skeletons)
;;; cl-patterns-skeletons.el ends here