mirror of
https://github.com/cookiengineer/audacity
synced 2025-04-29 23:29:41 +02:00
Update Nyquist Plug-in Installer
Now supports installing multiple plug-ins at the same time. Also supports .lsp and help files (.html and .txt).
This commit is contained in:
parent
1176b61953
commit
98a21259e0
@ -6,10 +6,9 @@ $manpage "Nyquist_Plug-in_Installer"
|
||||
$debugbutton false
|
||||
$preview disabled
|
||||
$author "Steve Daulton"
|
||||
$release 2.3.1
|
||||
$release 2.4.0
|
||||
$copyright (_ "Released under terms of the GNU General Public License version 2")
|
||||
|
||||
|
||||
;; Released under terms of the GNU General Public License version 2:
|
||||
;; http://www.gnu.org/licenses/old-licenses/gpl-2.0.html
|
||||
;;
|
||||
@ -18,16 +17,17 @@ $copyright (_ "Released under terms of the GNU General Public License version 2"
|
||||
|
||||
|
||||
;i18n-hint: "Browse..." is text on a button that launches a file browser.
|
||||
$control plug-in (_ "Select plug-in file") file (_ "Browse...") "~/Desktop/" "Plug-in|*.ny;*.NY|Text file|*.txt;*.TXT|All files|*.*;*" "open,exists"
|
||||
|
||||
;; As this plug-in is intended primarily to help novice users, it is unsafe to allow overwriting.
|
||||
;$control overwrite (_ "If plug-in is already installed") choice ((_ "Keep original") (_ "Overwrite")) 0
|
||||
|
||||
(if (not (boundp 'overwrite))
|
||||
(setf overwrite 0))
|
||||
$control files (_ "Select plug-in file") file (_ "Browse...") "~/Desktop/" "Plug-in|*.ny;*.NY|Lisp file|*.lsp;*.LSP|HTML file|*.htm;*.HTM;*.html;*.HTML|Text file|*.txt;*.TXT|All supported|*.ny;*.NY;*.lsp;*.LSP;*.htm;*.HTM;*.html;*.HTML;*.txt;*.TXT|All files|*.*;*" "open,exists,multiple"
|
||||
$control overwrite (_ "Allow overwriting") choice ((_ "Disallow") (_ "Allow")) 0
|
||||
|
||||
|
||||
(defun audacity-version-ok (min-version)
|
||||
;; No longer required as this plug-in is shipped with Audacity.
|
||||
;; Left in for illustration purposes.
|
||||
;; min-version is a list of three numbers (the minimum Audacity version number).
|
||||
;; Example, if the minimum version required is Audacity 2.4.0, then
|
||||
;; call (audacity-version-ok '(2 4 0))
|
||||
;; Treturns t if plug-in is running on 2.4.0 or later, otherwise nil.
|
||||
(cond
|
||||
((get '*audacity* 'version)
|
||||
(mapc (lambda (x y)
|
||||
@ -40,37 +40,41 @@ $control plug-in (_ "Select plug-in file") file (_ "Browse...") "~/Desktop/" "Pl
|
||||
(or (not (boundp 'isok)) isok))
|
||||
(t nil)))
|
||||
|
||||
;; Extract file name and extension from fully qualified file name.
|
||||
(defun get-file-name (fqname &aux (fname ""))
|
||||
;; Return file name . extension from fully qualified file name.
|
||||
(dotimes (i (length fqname) fname)
|
||||
(if (char= (char fqname i) *file-separator*)
|
||||
(setf fname "")
|
||||
(setf fname (format nil "~a~a" fname (char fqname i))))))
|
||||
|
||||
;; Predicate, is file name
|
||||
(defun isfilename (fname)
|
||||
;; Return t if fname looks like valid file name, else nil.
|
||||
(let ((ln (length fname)))
|
||||
(cond
|
||||
((= ln 0) nil)
|
||||
((char= (char fname (- ln 1)) *file-separator*) nil)
|
||||
(t t))))
|
||||
|
||||
;; Predicate, file exists.
|
||||
(defun existsp (fname)
|
||||
;; Return t if file exists, else nil.
|
||||
(let ((fp (open fname)))
|
||||
(cond
|
||||
(fp (close fp) t)
|
||||
(fp (close fp)
|
||||
;overwrite: 0=disallow, 1=allow, 2=is overwriting.
|
||||
(when (= overwrite 1)
|
||||
(setf overwrite 2))
|
||||
t)
|
||||
(t nil))))
|
||||
|
||||
;Predicate, file is writeable.
|
||||
(defun writeablep (fname)
|
||||
;; Return t if file is writeable.
|
||||
(let ((fp (open fname :direction :output)))
|
||||
(cond
|
||||
(fp (close fp) t)
|
||||
(t nil))))
|
||||
|
||||
;; Copy from input file to output file.
|
||||
(defun copy-file (input output)
|
||||
;; Copy from input file to output file.
|
||||
(let ((ifp (open input :direction :input))
|
||||
(ofp (open output :direction :output)))
|
||||
(do ((line (read-line ifp)(read-line ifp)))
|
||||
@ -79,8 +83,44 @@ $control plug-in (_ "Select plug-in file") file (_ "Browse...") "~/Desktop/" "Pl
|
||||
(close ifp)
|
||||
(close ofp)))
|
||||
|
||||
;;Predicate, looks like a Nyquist plug-in.
|
||||
(defun isplugin (fname)
|
||||
(defun issupported (fname)
|
||||
;; Return true if it looks like a supported file.
|
||||
;; For .lsp and .html files, we only check the file extension.
|
||||
;; For .ny files, we have additional sanity checks that it is a
|
||||
;; plug-in and not just a Nyquist Prompt script.
|
||||
(let ((goodfname (fix-ext fname)))
|
||||
(cond
|
||||
((check-ext goodfname ".lsp") t)
|
||||
((check-ext goodfname ".htm") t)
|
||||
((check-ext goodfname ".html") t)
|
||||
((check-ext goodfname ".txt") t)
|
||||
((not (check-ext goodfname ".ny")) nil)
|
||||
((has-plugin-header fname) t)
|
||||
(t nil))))
|
||||
|
||||
(defun check-ext (fname ext)
|
||||
;; Return true if fname has extension ext.
|
||||
(let* ((fnameln (length fname))
|
||||
(extln (length ext))
|
||||
(restln (- fnameln extln)))
|
||||
(cond
|
||||
((< fnameln (1+ extln)) nil) ;too short to be valid
|
||||
((string-equal (subseq fname restln fnameln) ext) t)
|
||||
(t nil))))
|
||||
|
||||
(defun fix-ext (fname)
|
||||
;; If string ends in ".ny.txt" or ".lsp.txt", strip off ".txt"
|
||||
(macrolet ((striptxt (fname) `(setf ,fname (subseq ,fname 0 (- ln 4)))))
|
||||
(let ((ln (length fname)))
|
||||
(cond
|
||||
((and (> ln 8) (string-equal (subseq fname (- ln 8) ln) ".lsp.txt"))
|
||||
(striptxt fname))
|
||||
((and (> ln 7) (string-equal (subseq fname (- ln 7) ln) ".ny.txt"))
|
||||
(striptxt fname)))
|
||||
fname)))
|
||||
|
||||
(defun has-plugin-header (fname)
|
||||
;; Return t if file looks like valid Nyquist plug-in, else nil.
|
||||
(let ((fp (open fname))
|
||||
(teststring "nyquist plug-in"))
|
||||
;First char may be #\; or #\$
|
||||
@ -102,43 +142,93 @@ $control plug-in (_ "Select plug-in file") file (_ "Browse...") "~/Desktop/" "Pl
|
||||
(close fp)
|
||||
nil))))
|
||||
|
||||
;If string ends in ".ny.txt", replace with ".ny"
|
||||
(defun fix-ext (fname)
|
||||
(setf ln (length fname))
|
||||
(if (and (> ln 7)
|
||||
(string-equal (subseq fname (- ln 7) ln) ".ny.txt"))
|
||||
(subseq fname 0 (- ln 4))
|
||||
fname))
|
||||
(defun get-file-list (file-string)
|
||||
;; See https://wiki.audacityteam.org/wiki/Nyquist_File-Button_Tutorial#Open_Multiple_Files
|
||||
(let ((path-string (format nil "(list ~s )" (string-trim "\"" file-string))))
|
||||
(eval-string path-string)))
|
||||
|
||||
(defun install (fname)
|
||||
;; Install file fname (fully qualified file name).
|
||||
;; Push result to list install-success or install-fail.
|
||||
(setf out-path (get '*system-dir* 'user-plug-in))
|
||||
(setf short-name (get-file-name fname))
|
||||
(cond
|
||||
((not (existsp fname))
|
||||
(format nil (_ "Error.~%~s not found or cannot be read.~%") short-name))
|
||||
((not (isplugin fname))
|
||||
(format nil (_ "Error.~%~s is not a supported plug-in.~%") short-name))
|
||||
(push (list 3 fname) install-fail))
|
||||
((not (issupported fname))
|
||||
(push (list 4 fname) install-fail))
|
||||
(t
|
||||
(setf short-name (fix-ext short-name))
|
||||
(setf out-fname
|
||||
(format nil "~a~a~a" out-path *file-separator* short-name))
|
||||
(cond
|
||||
((string-not-equal short-name ".ny" :start1 (- (length short-name) 3))
|
||||
(format nil (_ "Error.~%~s is not a valid Nyquist plug-in.~%") short-name))
|
||||
;; Check for fails
|
||||
((and (existsp out-fname) (= overwrite 0))
|
||||
(format nil (_ "Error.~%~s is already installed.~%") short-name))
|
||||
(push (list 5 short-name) install-fail))
|
||||
((not (writeablep out-fname))
|
||||
(format nil (_ "Error.~%~s cannot be written.~%") out-fname))
|
||||
(t
|
||||
(push (list 6 short-name) install-fail))
|
||||
;; Now the successes
|
||||
((check-ext short-name ".ny")
|
||||
(copy-file fname out-fname)
|
||||
(format nil (_ "~s installed to:~%\"~a\"~%~%~
|
||||
Use the Plug-in Manager to enable the effect.")
|
||||
short-name out-fname))))))
|
||||
(if (= overwrite 2)
|
||||
(push (list 1 short-name) install-success)
|
||||
(push (list 0 short-name) install-success)))
|
||||
(t (copy-file fname out-fname)
|
||||
(push (list 2 short-name) install-success))))))
|
||||
|
||||
(defun print-results (&aux msg results)
|
||||
;; Format results and display in human readable form.
|
||||
(cond
|
||||
((isempty install-success)
|
||||
(setf msg (_ "Error.\n")))
|
||||
((isempty install-fail)
|
||||
(setf msg (format nil (_ "Success.~%Files written to:~%~s~%")
|
||||
(get '*system-dir* 'user-plug-in))))
|
||||
(t (setf msg (_ "Warning.\nFailed to copy some files:\n"))))
|
||||
(setf results (append install-success install-fail))
|
||||
(setf results (sort-results results))
|
||||
(let ((status -1))
|
||||
(dolist (m results msg)
|
||||
(when (/= (first m) status)
|
||||
(setf msg (format nil "~a~%~a~%" msg (status (first m))))
|
||||
(setf status (first m)))
|
||||
(setf msg (format nil "~a~a~%" msg (second m))))))
|
||||
|
||||
(cond
|
||||
((or (not (boundp 'plug-in))(not (audacity-version-ok '(2 3 1))))
|
||||
(_ "This plug-in requires Audacity 2.3.1 or later."))
|
||||
((not (isfilename plug-in))
|
||||
(_ (format nil "Error.~%No file selected.")))
|
||||
(t (install plug-in)))
|
||||
(defun isempty (x)
|
||||
;;Return t if x is an empty list.
|
||||
(unless (listp x)
|
||||
(error "Not a list" x))
|
||||
(if (= (length x) 0) t nil))
|
||||
|
||||
(defun isnotempty (x)
|
||||
(not (isempty x)))
|
||||
|
||||
(defun status (num)
|
||||
;; Return status message corresponding to the installation status number.
|
||||
;; This allows result messages to be grouped according to installation status.
|
||||
(case num
|
||||
;; Success
|
||||
(0 (_ "Plug-ins installed.\n(Use the Plug-in Manager to enable effects):"))
|
||||
(1 (_ "Plug-ins updated:"))
|
||||
(2 (_ "Files copied to plug-ins folder:"))
|
||||
;; Fail
|
||||
(3 (_ "Not found or cannot be read:"))
|
||||
(4 (_ "Unsupported file type:"))
|
||||
(5 (_ "Files already installed ('Allow Overwriting' disabled):"))
|
||||
(6 (_ "Cannot be written to plug-ins folder:"))))
|
||||
|
||||
(defun sort-results (results)
|
||||
;; 'results' are either 'install-success' or 'install-fail'.
|
||||
;; Each item in results is (list status file-name).
|
||||
;; Returns 'results' sorted by status number.
|
||||
(sort results #'(lambda (x y) (< (car x) (car y)))))
|
||||
|
||||
;; Global lists
|
||||
(setf install-success ())
|
||||
(setf install-fail ())
|
||||
|
||||
(let ((files (get-file-list files)))
|
||||
(if (= (length files) 0)
|
||||
(format nil (_ "Error.~%No file selected."))
|
||||
(dolist (file files (print-results))
|
||||
(install file))))
|
||||
|
Loading…
x
Reference in New Issue
Block a user