Skip to content

[pull] master from audacity:master #579

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
pull merged 2 commits into from
Mar 4, 2020
Merged

[pull] master from audacity:master #579

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
171a438
Nyquist: Cache supported Scripting command profiles.
SteveDaulton Mar 1, 2020
722a3f5
Fix: 'aud-import-effects' should be 'aud-import-commands'
SteveDaulton Mar 4, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
297 changes: 193 additions & 104 deletions nyquist/aud-do-support.lsp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 " "))
(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 ": \")
(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)
(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-import-commands (&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))))))


(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-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-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)))))))


;; 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"))
;; 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)))
2 changes: 1 addition & 1 deletion nyquist/init.lsp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)