1;;; A collection of helper functions and macros to make scripting Audacity commands
2;;; easier and more Lisp-like.
3;;;
4;;; Copyright 2018 - 2020 Audacity Team
5;;; Steve Daulton
6;;; Released under terms of the GNU General Public License version 2:
7;;; http://www.gnu.org/licenses/old-licenses/gpl-2.0.html
8
9
10(defun char-remove (ch str)
11  ;;; Remove all occurrences of character from string.
12  (do ((out "")
13       (i 0 (1+ i)))
14      ((= i (length str)) out)
15    (if (char/= (char str i) ch)
16        (setf out (format nil "~a~a" out (char str i))))))
17
18(defun number-string-p (str)
19  ;;; like digit-char-p for strings
20  (unless (stringp str)
21    (return-from number-string-p nil))
22  (let ((num (string-to-number str)))
23    (if (numberp num)
24        num
25        nil)))
26
27(defmacro string-append (str &rest strs)
28  ;;; Append one or more strings to 'str'
29  `(setf ,str (strcat ,str ,@strs)))
30
31(defun aud-print-command (cmd)
32  ;;; Print a quick reference for command arguments.
33  (let ((help-data (first (aud-do-command "Help" :command cmd :format "LISP")))
34        (out (format nil "(aud-do-command ~s [:key val ...])~%" (string-downcase cmd))))
35    (cond
36      ((string-equal help-data "Command not found")
37          ;Debug out can be copied on all platforms.
38          (format t "~a~a." out help-data)
39          (format nil "~a~a." out help-data))
40      (t  (setf help-data (eval-string (quote-string help-data)))
41          (let ((params (second (assoc 'params help-data))))
42            (dolist (p params)
43              (setf out (format nil "~a  :~a (~a) default: ~s~%"
44                                out
45                                (string-downcase (second (assoc 'key p)))
46                                (second (assoc 'type p))
47                                (second (assoc 'default p))))
48              (let ((enums (assoc 'enum p)))
49                (when enums
50                  (setf out (format nil "~a    [" out))
51                  (dolist (e (second enums))
52                    (setf out (format nil "~a~s " out e)))
53                  (setf out (format nil "~a]~%" (string-right-trim " " out)))))))
54          (format t "~a" out)
55          out))))
56
57
58(defun aud-do-command (id &rest params)
59  ;; Translate aud-do-command, to (aud-do "command").
60  ;; To avoid unnecessary overhead, only validate when debugging enabled
61  ;; 'aud-import-commands' passes params as a list, so we need to unpack it.
62  (when (and (= (length params) 1)
63             (listp (first params)))
64    (setf params (first params)))
65  (when *tracenable*
66    (aud-check-debug-cache)
67    (let (val-allowed type enums pstr
68          (id-valid (aud-verify-command-id id))
69          (valid-params (aud-get-command-params id))
70          (keystr ""))
71      (if (not id-valid)
72          ; The command may still be valid as
73          ; "GetInfo: Type=Commands" does not return all valid AUD-DO commands.
74          (format t "Debug data unavailable: ~s.~%" id)
75          ;; Command ID recognised, so check params.
76          (dolist (p params)
77            (setf pstr (format nil "~a" p))
78            (cond
79              ((char= (char pstr 0) #\:) ;keyword
80                (setf keystr (subseq pstr 1))
81                (let ((kf (dolist (vp valid-params nil)
82                            (when (string-equal (second (assoc 'key vp)) keystr)
83                              (return vp)))))
84                  (cond
85                    (kf ;keyword found
86                      (setf type (second (assoc 'type kf)))
87                      (setf enums (second (assoc 'enum kf)))
88                      (cond
89                        ((member type '("int" "float" "double") :test 'string-equal)
90                          (setf val-allowed "number"))
91                        ((string-equal type "enum")
92                          (setf val-allowed enums)) ;a list
93                        (t (setf val-allowed type)))) ;"string" "bool" or NIL
94                    ;; Invalid keyword, so give some helpful hints:
95                    (t (format t "Invalid key in ~s :~a~%" id keystr)
96                       ;; pretty print valid keywords
97                       (format t "Valid keys for ~a are:~%" id)
98                       (dolist (vp valid-params)
99                         (dolist (item vp)
100                           (let ((itype (first item)))
101                             (case itype
102                              ('KEY (format t "   ~a " (second item)))
103                              ('TYPE (when (string-not-equal (second item) "enum")
104                                       (format t "(~a) " (second item))))
105                              ('ENUM (format t "[~a]"
106                                        (string-trim "()"
107                                            (format nil "~a" (second item))))))))
108                         (format t "~%"))))))
109              (t  ;key value
110                (cond
111                  ((not val-allowed)
112                      (format t "Too many arguments: ~s :~a~%" id keystr))
113                  ((listp val-allowed)
114                      (unless (member pstr enums :test 'string=) ;case sensitive
115                        (format t "Invalid enum in ~s :~a - ~s~%" id keystr p)
116                        (format t "Options are:~%  ~a~%" enums)))
117                  ((string= val-allowed "bool")
118                      (unless (or (string= pstr "0") (string= pstr "1"))
119                        (format t "~s :~a value must be 0 or 1~%" id keystr)))
120                  ((string= val-allowed "number")
121                      (unless (or (numberp p) (number-string-p p))
122                        (format t "~s :~a value must be a number: ~s~%" id keystr p)))
123                  ((string= val-allowed "string")
124                      (unless (stringp p)
125                        (format t "~s :~a value must be a string: ~a~%" id keystr p))))
126                (psetq  val-allowed nil
127                        type  nil
128                        enums nil)))))))
129  ;; Send the command
130  (let ((cmd (format nil "~a:" id)))
131    (dolist (p params)
132      (setf p (format nil "~a" p))
133      (string-append cmd
134          (cond
135            ((char= (char p 0) #\:) ;keyword
136              (format nil " ~a=" (subseq p 1)))
137            (t  ;key value
138              (format nil "~s" p)))))
139    (aud-do cmd)))
140
141
142(defun aud-import-commands (&aux cmd)
143  ;; Generate function stubs in the form (aud-<command> [&key arg ...])
144  ;; Call once to make "aud-<command>"s available.
145  ;; We don't call this on load, as we don't want to delay loading Nyquist unnecessarily.
146  (aud-check-debug-cache)
147  (dolist (cmd (aud-get-command))
148    (setf cmd (second (assoc 'id cmd)))
149    (let ((symb (intern (string-upcase (format nil "aud-~a" cmd)))))
150      (eval `(defun ,symb (&rest args)
151              (aud-do-command ,cmd args))))))
152
153
154(defun aud-check-debug-cache ()
155  ;;; Load aud-do-debug-data-cache, updating if necessary.
156  (let ((fqname (format nil "~a~a~a"
157                       (string-right-trim (string *file-separator*) (get-temp-path))
158                       *file-separator*
159                       "aud-do-debug-data-cache.lsp")))
160    (cond ;Update if necessary
161      ((fboundp 'aud-do-version)  ;cache is loaded
162        ;; Refresh cache if versions don't match.
163        ;; 'aud-do-version' tests the interned version.
164        ;; 'autoload-helper' tests the disk version and prevents repeating cache refresh in the initial session.
165        (unless (or (string= (format nil "~a" (aud-do-version))
166                             (format nil "~a" (get '*audacity* 'version)))
167                    (string= (format nil "~a" (autoload-helper fqname 'aud-do-version nil))
168                             (format nil "~a" (get '*audacity* 'version))))
169          (aud-refresh-debug-data-cache fqname)))
170      ;cache not loaded, so try loading and refresh if we can't.
171      ((not (load fqname :verbose t))
172        (aud-refresh-debug-data-cache fqname)))))
173
174
175(defun aud-refresh-debug-data-cache (fqname)
176  ;; Cache the list of command profiles as function "aud-get-command", and load it.
177  (labels ((disable-plugins (typestring &aux oldval)
178            ;; Disable plug-ins of type 'typestring' and return it's previous value.
179            (let ((getcmd (format nil "GetPreference: Name=\"~a/Enable\"" typestring)))
180              (setf oldval (first (aud-do getcmd)))
181              (do-set-val typestring oldval 0) ;Disable all plug-ins
182              oldval))  ;may be 0, 1 or ""
183          (do-set-val (typestring oldval newval)
184            ;; If plug-in type was previously enabled ('oldval = true, "1" or empty), set it to 'newval'.
185            (let ((setcmd (format nil "SetPreference: Name=\"/~a/Enable\" Value=" typestring)))
186              (when (and oldval (or (string= oldval "")(string= oldval "1")))
187                (aud-do (format nil "~a~s" setcmd (if (= newval 0) 0 oldval))))))
188          (get-usable-commands ()
189            ;; Disable plug-ins, get list of remaining commands, then re-enable plug-ins if previously enabled.
190            ;; Return list of commands.
191            (let ((cmds '(("Nyquist" ny)("LADSPA" la)("LV2" lv)("VST" vs)("AudioUnit" au)("Vamp" va)))
192                  info)
193              (dolist (cmd cmds)
194                (setf (nth 1 cmd) (disable-plugins (nth 0 cmd))))
195              (setf info (first (aud-do "getinfo: type=Commands format=LISP"))) ;Get scriptables and built-in effects
196              (dolist (cmd cmds)
197                (do-set-val (nth 0 cmd) (nth 1 cmd) 1))  ;Re-enable plug-ins
198              info)))
199      (let ((fp (open fqname :direction :output)))
200        ;; Write cache file, or return error.
201        (cond
202          (fp (format fp
203";; Intended for internal use by aud-do-command.~%
204(defun aud-do-version ()
205  '~a)~%
206(defun aud-verify-command-id (id)
207  (second (assoc 'id (aud-get-command id))))~%
208(defun aud-get-command-params (id)
209  (second (assoc 'params (aud-get-command id))))~%
210(defun aud-get-command (&optional id &aux cmds)
211  ;; If id supplied, return command profile or nil.
212  ;; Else, return full list.
213  (setf cmds
214  '~a)
215  ;; Return all commands, or one command or nil.
216  (if id
217      (dolist (cmd cmds nil)
218        (when (string-equal (string id) (second (assoc 'id cmd)))
219          (return cmd)))
220      cmds))"
221                      (get '*audacity* 'version)
222                      (get-usable-commands))
223              (format t "Debug data cache refreshed.~%")
224              (close fp)
225              (unless (load fqname :verbose t) ;load the file
226                (error "Unable to load" fqname))) ;assert
227          (t  (format t "Error: ~a cannot be written." fqname))))))
228
229
230;; Try to load AUD- command cache.
231(when (get-temp-path)
232  (let ((fqname (format nil "~a~a~a"
233                        (string-right-trim (string *file-separator*) (get-temp-path))
234                        *file-separator*
235                        "aud-do-debug-data-cache.lsp")))
236    (load fqname :verbose t)))
237