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