Update Nyquist Plug-in Installer

Now supports installing multiple plug-ins at the same time.
Also supports .lsp and help files (.html and .txt).

plug-ins/nyquist-plug-in-installer.ny

@@ -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"
+$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
-;; 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))
 
 
 (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 issupported (fname)
-(defun isplugin (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 get-file-list (file-string)
-(defun fix-ext (fname)
+  ;; See https://wiki.audacityteam.org/wiki/Nyquist_File-Button_Tutorial#Open_Multiple_Files
-  (setf ln (length fname))
+  (let ((path-string (format nil "(list ~s )" (string-trim "\"" file-string))))
-  (if (and (> ln 7)
+    (eval-string path-string)))
-           (string-equal (subseq fname (- ln 7) ln) ".ny.txt"))
-    (subseq fname 0 (- ln 4))
-    fname))
 
 (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))
+      (push (list 3 fname) install-fail))
-    ((not (isplugin fname))
+    ((not (issupported fname))
-      (format nil (_ "Error.~%~s is not a supported plug-in.~%") short-name))
+      (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))
+        ;; Check for fails
-            (format nil (_ "Error.~%~s is not a valid Nyquist plug-in.~%") short-name))
         ((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))
+          (push (list 6 short-name) install-fail))
-        (t
+        ;; Now the successes
+        ((check-ext short-name ".ny")
             (copy-file fname out-fname)
-        (format nil (_ "~s installed to:~%\"~a\"~%~%~
+            (if (= overwrite 2)
-            Use the Plug-in Manager to enable the effect.")
+                (push (list 1 short-name) install-success)
-            short-name out-fname))))))
+                (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
+(defun isempty (x)
-  ((or (not (boundp 'plug-in))(not (audacity-version-ok '(2 3 1))))
+  ;;Return t if x is an empty list.
-      (_ "This plug-in requires Audacity 2.3.1 or later."))
+  (unless (listp x)
-  ((not (isfilename plug-in))
+    (error "Not a list" x))
-      (_ (format nil "Error.~%No file selected.")))
+  (if (= (length x) 0) t nil))
-  (t  (install plug-in)))
+
+(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))))