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:
SteveDaulton 2020-01-11 16:04:47 +00:00
parent 1176b61953
commit 98a21259e0
1 changed files with 131 additions and 41 deletions

View File

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