mirror of
https://github.com/cookiengineer/audacity
synced 2025-07-30 23:49:28 +02:00
Nyquist: Cache supported Scripting command profiles.
Fixes slow load on first run of Nyquist effect. Revert aud-import-effects to optional, and add aud-do-command as fast alternative. Slow load now only on first debug use of new commands and cached until Nyquist temp folder is cleared. To avoid unnecessary overhead, 'Lispy' scripting commands only provide additional validation when debugging enabled. AUD-PRINT-COMMAND added as handy reference for new commands. Cache may be refreshed manually with (aud-refresh-debug-data-cache).
This commit is contained in:
SteveDaulton
parent
3d1abf3ddb
commit
171a43821e
@ -15,120 +15,209 @@
|
||||
(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-get-command (id)
|
||||
;;; Return command signature from id string or NIL.
|
||||
(let* ((helpstr (format nil "Help: Command=~s Format=LISP" id))
|
||||
(cmd-sig (aud-do helpstr)))
|
||||
(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
|
||||
((not (listp cmd-sig)) (error "Unknown error in aud-do" cmd-sig))
|
||||
((string-equal (first cmd-sig) "Command not found") nil)
|
||||
(t (setf cmd-sig (first cmd-sig))
|
||||
(eval-string (quote-string cmd-sig))))))
|
||||
((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-import-command (cmd &optional func-name)
|
||||
;;; Generate a LISP function from Audacity command ID or signature.
|
||||
;;; If supplied, the generated function name will be 'func-name', otherwise
|
||||
;;; it will be the command id, preceeded by 'aud-'.
|
||||
(when (stringp cmd)
|
||||
;; cmd is the id, so get the command signature
|
||||
(let ((id cmd))
|
||||
(setf cmd (aud-get-command id))
|
||||
(if cmd
|
||||
(aud-import-command cmd func-name)
|
||||
(error "in aud-import-command, invalid argument" id))))
|
||||
(let ((id (second (assoc 'id cmd)))
|
||||
(params (second (assoc 'params cmd)))
|
||||
(func-def "(defun aud-")
|
||||
(func-kwargs "(&key ")
|
||||
(func-body ""))
|
||||
(if func-name
|
||||
(setf func-def (format nil "(defun ~a " func-name))
|
||||
(string-append func-def id " "))
|
||||
(defun aud-do-command (id &rest params)
|
||||
;; Translate aud-do-command, to (aud-do "command").
|
||||
;; To avoid unnecessary overhead, only validate when debugging enabled
|
||||
(when (and (= (length params) 1)
|
||||
(listp (first params)))
|
||||
;Unpack params from "aud-<command>" stubs
|
||||
(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)
|
||||
(format t "Debug data unavailable: ~s.~%" id)
|
||||
(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
|
||||
(t (format t "Invalid key in ~s :~a~%" id keystr)))))
|
||||
(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)))
|
||||
((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)
|
||||
(let* ((key (second (assoc 'key p)))
|
||||
(type (second (assoc 'type p)))
|
||||
(enums (second (assoc 'enum p)))
|
||||
; The kwarg value must be a valid Lisp variable name (no spaces).
|
||||
(val (char-remove #\Space key)))
|
||||
(string-append func-kwargs val " ")
|
||||
;; Convert list of 'enums' to a string with quoted enums so we can string compare.
|
||||
(if enums
|
||||
(let ((str-enum "(list "))
|
||||
(dolist (e enums)
|
||||
(string-append str-enum "\"" (string e) "\" "))
|
||||
(setf enums (string-append str-enum ")")))
|
||||
(setf enums ""))
|
||||
;; Add validators for each parameter to function body.
|
||||
(string-append func-body
|
||||
" (when " val "
|
||||
(unless (validate " val " \"" type "\" " enums ")(error \"bad argument type\" " val "))
|
||||
(push (format nil \"\\\"" key "\\\"=~s \" " val ") params))\n")))
|
||||
;; concatenate strings to build the complete function.
|
||||
(string-append func-def func-kwargs "&aux (params ()))\n"
|
||||
" ;; Push validated 'val's onto 'params' list
|
||||
(defun validate (val type &optional enums)
|
||||
(cond
|
||||
((string-equal type \"bool\")
|
||||
(or (= val 0)(= val 1)))
|
||||
((string-equal type \"string\")
|
||||
(stringp val))
|
||||
((string-equal type \"enum\")
|
||||
(member val enums :test 'string=))
|
||||
((string-equal type \"int\")
|
||||
(integerp val))
|
||||
((string-equal type \"float\")
|
||||
(numberp val))
|
||||
((string-equal type \"double\")
|
||||
(numberp val))))\n"
|
||||
func-body
|
||||
"
|
||||
(setf command \"" id ": \")
|
||||
(dolist (p params)
|
||||
(setf command (strcat command p)))
|
||||
(aud-do command))")
|
||||
(eval-string func-def)))
|
||||
(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-generate-command-stubs (cmd-list)
|
||||
;; Generate one stub for each function.
|
||||
;; Stubs check that command is actually available before
|
||||
;; generating the Lisp function.
|
||||
;; This function is for internal use only.
|
||||
(dolist (cmd-id cmd-list)
|
||||
(let ((func-def (format nil
|
||||
"(defun aud-~a (&rest args)
|
||||
(if (string-equal (first (aud-do \"Help: Command=~a\")) \"Command not found\")
|
||||
(error \"Command unavailable\" ~s))
|
||||
(aud-import-command ~s)
|
||||
(let ((arg-string \"\") (cmd-string \"(aud-~a \"))
|
||||
(dolist (arg args)
|
||||
(setf arg-string (format nil \"~a ~a\" arg-string arg)))
|
||||
(setf cmd-string (format nil \"~a~a)\" cmd-string arg-string))
|
||||
(eval-string cmd-string)))"
|
||||
cmd-id cmd-id cmd-id cmd-id cmd-id "~a" "~s" "~a" "~a")))
|
||||
(eval-string func-def))))
|
||||
(defun aud-import-effects (&aux cmd)
|
||||
;; Generate function stubs in the form (aud-<command> [&key arg ...])
|
||||
;; Call once to make "aud-<command>"s available.
|
||||
;; Unfortunatly we can't call this on load, as the cache may
|
||||
;; not exist yet, and we don't want to delay loading for regular users.
|
||||
(unless (fboundp 'aud-do-version)
|
||||
(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))))))
|
||||
|
||||
|
||||
;; Hard coded list because "GetInfo:" is slow and we can't yet exclude
|
||||
;; Nyquist plug-ins (Nyquist plug-ins can't run from Nyquist Macros).
|
||||
;; TODO: Create a fast scripting command to return this list instead of relying on hard coded.
|
||||
(aud-generate-command-stubs
|
||||
(list "Amplify" "AutoDuck" "BassAndTreble" "ChangePitch" "ChangeSpeed"
|
||||
"ChangeTempo" "Chirp" "ClickRemoval" "Compressor" "DtmfTones"
|
||||
"Distortion" "Echo" "FadeIn" "FadeOut" "FilterCurve" "FindClipping"
|
||||
"GraphicEq" "Invert" "LoudnessNormalization" "Noise" "Normalize"
|
||||
"Paulstretch" "Phaser" "Repeat" "Repair" "Reverb" "Reverse"
|
||||
"Silence" "SlidingStretch" "Tone" "TruncateSilence" "Wahwah"
|
||||
;; Scriptable Commands
|
||||
"CompareAudio" "Demo" "Export2" "GetInfo" "GetPreference" "Help"
|
||||
"Import2" "Message" "OpenProject2" "SaveProject2" "Screenshot"
|
||||
"SelectFrequencies" "SelectTime" "SelectTracks" "Select" "SetClip"
|
||||
"SetEnvelope" "SetLabel" "SetPreference" "SetProject" "SetTrackAudio"
|
||||
"SetTrackStatus" "SetTrackVisuals" "SetTrack"))
|
||||
(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
|
||||
;is cache the current version? Reload aud-do-version if loaded version old.
|
||||
(when (and (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))))
|
||||
;wrong version, so refresh cache.
|
||||
(aud-refresh-debug-data-cache)))
|
||||
(t ;cache not loaded, so try loading and refresh if we can't.
|
||||
(unless (load fqname :verbose t)
|
||||
(aud-refresh-debug-data-cache))))))
|
||||
|
||||
|
||||
(defun aud-refresh-debug-data-cache ()
|
||||
;; Cache the list of command profiles as function "aud-get-command", and load it.
|
||||
(labels ((disable-plugins (typestring &aux oldval)
|
||||
(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)
|
||||
(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 ()
|
||||
(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 ((path (get-temp-path)) fp)
|
||||
(unless path
|
||||
(return-from aud-refresh-debug-data-cache
|
||||
(format t "Error: Audacity data directory not found.")))
|
||||
; file-separator at end of 'get-temp-path' is platform dependent.
|
||||
(let* ((fqname (format nil "~a~a~a"
|
||||
(string-right-trim (string *file-separator*) (get-temp-path))
|
||||
*file-separator*
|
||||
"aud-do-debug-data-cache.lsp"))
|
||||
(fp (open fqname :direction :output)))
|
||||
(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 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)))
|
||||
|
||||
@ -86,4 +86,4 @@
|
||||
;;; Load wrapper functions for aud-do commands.
|
||||
;;; If commented out, "aud-do-support.lsp" may be loaded by a plug-in.
|
||||
;;; Example: (lisp-loader (strcat *runtime-path* "aud-do-support.lsp"))
|
||||
(load "aud-do-support.lsp")
|
||||
(load "aud-do-support.lsp" :verbose nil)
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user