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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
|
;;; A collection of helper functions and macros to make scripting Audacity commands
;;; easier and more Lisp-like.
;;;
;;; Copyright 2018 - 2020 Audacity Team
;;; Steve Daulton
;;; Released under terms of the GNU General Public License version 2:
;;; http://www.gnu.org/licenses/old-licenses/gpl-2.0.html
(defun char-remove (ch str)
;;; Remove all occurrences of character from string.
(do ((out "")
(i 0 (1+ i)))
((= i (length str)) out)
(if (char/= (char str i) ch)
(setf out (format nil "~a~a" out (char str i))))))
(defun number-string-p (str)
;;; like digit-char-p for strings
(unless (stringp str)
(return-from number-string-p nil))
(let ((num (string-to-number str)))
(if (numberp num)
num
nil)))
(defmacro string-append (str &rest strs)
;;; Append one or more strings to 'str'
`(setf ,str (strcat ,str ,@strs)))
(defun aud-print-command (cmd)
;;; Print a quick reference for command arguments.
(let ((help-data (first (aud-do-command "Help" :command cmd :format "LISP")))
(out (format nil "(aud-do-command ~s [:key val ...])~%" (string-downcase cmd))))
(cond
((string-equal help-data "Command not found")
;Debug out can be copied on all platforms.
(format t "~a~a." out help-data)
(format nil "~a~a." out help-data))
(t (setf help-data (eval-string (quote-string help-data)))
(let ((params (second (assoc 'params help-data))))
(dolist (p params)
(setf out (format nil "~a :~a (~a) default: ~s~%"
out
(string-downcase (second (assoc 'key p)))
(second (assoc 'type p))
(second (assoc 'default p))))
(let ((enums (assoc 'enum p)))
(when enums
(setf out (format nil "~a [" out))
(dolist (e (second enums))
(setf out (format nil "~a~s " out e)))
(setf out (format nil "~a]~%" (string-right-trim " " out)))))))
(format t "~a" out)
out))))
(defun aud-do-command (id &rest params)
;; Translate aud-do-command, to (aud-do "command").
;; To avoid unnecessary overhead, only validate when debugging enabled
;; 'aud-import-commands' passes params as a list, so we need to unpack it.
(when (and (= (length params) 1)
(listp (first params)))
(setf params (first params)))
(when *tracenable*
(aud-check-debug-cache)
(let (val-allowed type enums pstr
(id-valid (aud-verify-command-id id))
(valid-params (aud-get-command-params id))
(keystr ""))
(if (not id-valid)
; The command may still be valid as
; "GetInfo: Type=Commands" does not return all valid AUD-DO commands.
(format t "Debug data unavailable: ~s.~%" id)
;; Command ID recognised, so check params.
(dolist (p params)
(setf pstr (format nil "~a" p))
(cond
((char= (char pstr 0) #\:) ;keyword
(setf keystr (subseq pstr 1))
(let ((kf (dolist (vp valid-params nil)
(when (string-equal (second (assoc 'key vp)) keystr)
(return vp)))))
(cond
(kf ;keyword found
(setf type (second (assoc 'type kf)))
(setf enums (second (assoc 'enum kf)))
(cond
((member type '("int" "float" "double") :test 'string-equal)
(setf val-allowed "number"))
((string-equal type "enum")
(setf val-allowed enums)) ;a list
(t (setf val-allowed type)))) ;"string" "bool" or NIL
;; Invalid keyword, so give some helpful hints:
(t (format t "Invalid key in ~s :~a~%" id keystr)
;; pretty print valid keywords
(format t "Valid keys for ~a are:~%" id)
(dolist (vp valid-params)
(dolist (item vp)
(let ((itype (first item)))
(case itype
('KEY (format t " ~a " (second item)))
('TYPE (when (string-not-equal (second item) "enum")
(format t "(~a) " (second item))))
('ENUM (format t "[~a]"
(string-trim "()"
(format nil "~a" (second item))))))))
(format t "~%"))))))
(t ;key value
(cond
((not val-allowed)
(format t "Too many arguments: ~s :~a~%" id keystr))
((listp val-allowed)
(unless (member pstr enums :test 'string=) ;case sensitive
(format t "Invalid enum in ~s :~a - ~s~%" id keystr p)
(format t "Options are:~% ~a~%" enums)))
((string= val-allowed "bool")
(unless (or (string= pstr "0") (string= pstr "1"))
(format t "~s :~a value must be 0 or 1~%" id keystr)))
((string= val-allowed "number")
(unless (or (numberp p) (number-string-p p))
(format t "~s :~a value must be a number: ~s~%" id keystr p)))
((string= val-allowed "string")
(unless (stringp p)
(format t "~s :~a value must be a string: ~a~%" id keystr p))))
(psetq val-allowed nil
type nil
enums nil)))))))
;; Send the command
(let ((cmd (format nil "~a:" id)))
(dolist (p params)
(setf p (format nil "~a" p))
(string-append cmd
(cond
((char= (char p 0) #\:) ;keyword
(format nil " ~a=" (subseq p 1)))
(t ;key value
(format nil "~s" p)))))
(aud-do cmd)))
(defun aud-import-commands (&aux cmd)
;; Generate function stubs in the form (aud-<command> [&key arg ...])
;; Call once to make "aud-<command>"s available.
;; We don't call this on load, as we don't want to delay loading Nyquist unnecessarily.
(aud-check-debug-cache)
(dolist (cmd (aud-get-command))
(setf cmd (second (assoc 'id cmd)))
(let ((symb (intern (string-upcase (format nil "aud-~a" cmd)))))
(eval `(defun ,symb (&rest args)
(aud-do-command ,cmd args))))))
(defun aud-check-debug-cache ()
;;; Load aud-do-debug-data-cache, updating if necessary.
(let ((fqname (format nil "~a~a~a"
(string-right-trim (string *file-separator*) (get-temp-path))
*file-separator*
"aud-do-debug-data-cache.lsp")))
(cond ;Update if necessary
((fboundp 'aud-do-version) ;cache is loaded
;; Refresh cache if versions don't match.
;; 'aud-do-version' tests the interned version.
;; 'autoload-helper' tests the disk version and prevents repeating cache refresh in the initial session.
(unless (or (string= (format nil "~a" (aud-do-version))
(format nil "~a" (get '*audacity* 'version)))
(string= (format nil "~a" (autoload-helper fqname 'aud-do-version nil))
(format nil "~a" (get '*audacity* 'version))))
(aud-refresh-debug-data-cache fqname)))
;cache not loaded, so try loading and refresh if we can't.
((not (load fqname :verbose t))
(aud-refresh-debug-data-cache fqname)))))
(defun aud-refresh-debug-data-cache (fqname)
;; Cache the list of command profiles as function "aud-get-command", and load it.
(labels ((disable-plugins (typestring &aux oldval)
;; Disable plug-ins of type 'typestring' and return it's previous value.
(let ((getcmd (format nil "GetPreference: Name=\"~a/Enable\"" typestring)))
(setf oldval (first (aud-do getcmd)))
(do-set-val typestring oldval 0) ;Disable all plug-ins
oldval)) ;may be 0, 1 or ""
(do-set-val (typestring oldval newval)
;; If plug-in type was previously enabled ('oldval = true, "1" or empty), set it to 'newval'.
(let ((setcmd (format nil "SetPreference: Name=\"/~a/Enable\" Value=" typestring)))
(when (and oldval (or (string= oldval "")(string= oldval "1")))
(aud-do (format nil "~a~s" setcmd (if (= newval 0) 0 oldval))))))
(get-usable-commands ()
;; Disable plug-ins, get list of remaining commands, then re-enable plug-ins if previously enabled.
;; Return list of commands.
(let ((cmds '(("Nyquist" ny)("LADSPA" la)("LV2" lv)("VST" vs)("AudioUnit" au)("Vamp" va)))
info)
(dolist (cmd cmds)
(setf (nth 1 cmd) (disable-plugins (nth 0 cmd))))
(setf info (first (aud-do "getinfo: type=Commands format=LISP"))) ;Get scriptables and built-in effects
(dolist (cmd cmds)
(do-set-val (nth 0 cmd) (nth 1 cmd) 1)) ;Re-enable plug-ins
info)))
(let ((fp (open fqname :direction :output)))
;; Write cache file, or return error.
(cond
(fp (format fp
";; Intended for internal use by aud-do-command.~%
(defun aud-do-version ()
'~a)~%
(defun aud-verify-command-id (id)
(second (assoc 'id (aud-get-command id))))~%
(defun aud-get-command-params (id)
(second (assoc 'params (aud-get-command id))))~%
(defun aud-get-command (&optional id &aux cmds)
;; If id supplied, return command profile or nil.
;; Else, return full list.
(setf cmds
'~a)
;; Return all commands, or one command or nil.
(if id
(dolist (cmd cmds nil)
(when (string-equal (string id) (second (assoc 'id cmd)))
(return cmd)))
cmds))"
(get '*audacity* 'version)
(get-usable-commands))
(format t "Debug data cache refreshed.~%")
(close fp)
(unless (load fqname :verbose t) ;load the file
(error "Unable to load" fqname))) ;assert
(t (format t "Error: ~a cannot be written." fqname))))))
;; Try to load AUD- command cache.
(when (get-temp-path)
(let ((fqname (format nil "~a~a~a"
(string-right-trim (string *file-separator*) (get-temp-path))
*file-separator*
"aud-do-debug-data-cache.lsp")))
(load fqname :verbose t)))
|
