;;; -*- Mode:Common-Lisp; Package:W; Fonts:(CPTFONT HL12B HL12BI HL12BI MEDFNB); Base:10 -*-

;1;;                           RESTRICTED RIGHTS LEGEND*

;1;;Use, duplication, or disclosure by the Government is subject to*
;1;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in*
;1;;Technical Data and Computer Software clause at 52.227-7013.*
;1;;*
;1;;                     TEXAS INSTRUMENTS INCORPORATED.*
;1;;                              P.O. BOX 2909*
;1;;                           AUSTIN, TEXAS 78769*
;1;;                                 MS 2151*
;1;;*
;1;; Copyright (C) 1988, Texas Instruments Incorporated. All rights reserved.*

;1;; Revision history*
;1;; 30 Mar 88  BMK          General Improvement*
;1;; Summer 87  BMK          Original*


;1;;;;                      PUBLIC SOFTWARE MENU*

;1;;    Software that provides an additional item in the USER AIDS column of the *
;1;; system menu called "Site Software".  Selecting this item brings up a second*
;1;; menu that lists all site software that has not yet been loaded into the*
;1;; environment.*
;1;;    To make a software system available via this menu, it must be defined in*
;1;; the file SYS:FOO.SYSTEM such that MAKE-SYSTEM can load the complete system.*
;1;; The function ADD-TO-SITE-SOFTWARE-LIST can then be executed to add the system*
;1;; to the menu.*


(defconstant 4*public-contents-pathname**
	     (pathname "3SYS:PUBLIC.MENU;CONTENTS.PUBLIC#>*")
  "2This file will contain a single list that holds the information concerning
   software available in the PUBLIC directory.  This list is suitable for input
   to the W:MENU-CHOOSE function.  No one should directly alter this file!
   Use ADD-TO-PUBLIC-CONTENTS or REMOVE-FROM-PUBLIC-CONTENTS functions to alter
   this file.  The MAKE-PUBLIC-CONTENTS function will make this file if it does
   not exist and the LOAD-PUBLIC-CONTENTS function will return the list contained
   in this file.*")

(defconstant 4*public-default-pathname**
	     (pathname "3SYS:PUBLIC;*.*#>*")
  "2This pathname is merged with pathnames passed in as arguments to the
   functions below.*")

(defvar 4*public-menu-items**
	'(("3Public Menu Manager*"
	   :buttons (nil
		     (nil :eval (w::public-menu-manager))
		     nil)
	   :documentation (:mouse-m-1 "3Edit what is available from this menu*"))
	  ("3Re-read Public Contents*"
	   :buttons (nil
		     (nil :eval (progn (setq *public-menu-list* nil)
				       (public-menu)))
		     nil)
	   :documentation (:mouse-m-1 "3Re-read the contents of the Public Directory*"))
	  ("" :no-select) ))

(defvar 4*public-menu-list* *nil
  "2Holds the most recent value of the contents of the public directory*")


;1;; MENU INTERFACE -- called from System Menu or system key*

(defun 4public-menu* ()
  "2Called from the system menu, this function brings up a menu of software 
   available in the SYS:PUBLIC; directory.  The user can load the given 
   software, load and launch it (if launchable), or bring up documentation
   for the software.*"
  (unless *public-menu-list*
    (setq *public-menu-list* (make-public-menu-list (load-public-contents))))
  (process-run-function "3Public Software Loader*"
			'menu-choose
			*public-menu-list*
			:label "3Public Software Menu*"
			:pop-up t))

(defun 4public-menu-manager *(&aux action)
  ""
  (when (setq action (w:menu-choose '(("3Add Public Menu Item*"    :value :add)
				      ("3Edit Public Menu Item*"    :value :edit)
				      ("3Remove Public Menu Item*" :value :remove))
				    :label "3Public Menu Manager*"
				    :pop-up t))
    (let ((list-of-sw (cdddr (mapcar #'car *public-menu-list*)))
	  item new-item)
      (case action
	(:add    (and (setq new-item (public-item-cvv))
		      (apply #'add-to-public-contents new-item)))
	(:edit   (and list-of-sw
		      (setq item (menu-choose list-of-sw :pop-up t
					      :label "3Edit Public Menu Item*"))
		      (setq new-item (public-item-cvv (assoc item *public-menu-list*
							     :test #'string-equal)))
		      (apply #'add-to-public-contents
			     (append new-item (list item))) ))
	(:remove (and list-of-sw
		      (setq item (menu-choose list-of-sw :pop-up t
					      :label "3REMOVE Public Menu Item*"))
		      (remove-from-public-contents item))) ))))

(defun 4public-item-cvv *(&optional menu-item)
  ""
  (let* ((item          (if menu-item (car menu-item) ""))
	 (doc-string    (if menu-item
			    (getf (getf (cdr menu-item) :documentation) :documentation)
			    ""))
	 (buttons       (when menu-item (getf (cdr menu-item) :buttons)))
	 (files         (when buttons (second (second (third (car buttons))))))
	 (systems       (when buttons (second (third  (third (car buttons))))))
	 (launch-string (if buttons (second (third (second buttons))) ""))
	 (documentation (if buttons (second (third (third buttons))) "")))
    (declare (special item doc-string buttons files systems
		      launch-string documentation))
    (unless item (setq item ""))
    (unless doc-string (setq doc-string ""))
    (unless launch-string (setq launch-string ""))
    (unless documentation (setq documentation ""))
    (w:choose-variable-values
      '((item "3The software's name*" :string)
	(doc-string "3The mouse-documentation*" :string)
	(files "3The files to be loaded*" :string-list)
	(systems "3The systems to be made*" :list-of :any)
	(launch-string "3The form to launch the software*" :string)
	(documentation "3The documentation file*" :string))
      :width 500
      :label "3Enter the parameters of the Public Menu Item:*"
      :margin-choices '(("3Abort*" (signal-condition eh:*abort-object*))) )
    `(,item ,doc-string ,files ,systems ,launch-string ,documentation)))


;1;; Menu Choose Item List Generator*

(defun 4make-public-menu-list *(public-contents)
  ""
  (append *public-menu-items*
	  (mapcar #'(lambda (item)
		      (apply #'make-public-menu-item item))
		  public-contents)))

(defun 4make-public-menu-item* (name doc-string files systems
				    launch-string documentation-pathname
				    &aux doc-list)
  "2Builds the Menu Choose item for a Public software package specification.*"
  `(,name
    :buttons (,(when (or files systems)
		 (setq doc-list (append doc-list '(:mouse-l-1 "3Load the software*")))
		 `(nil :eval (public-loader ',files ',systems)))
	      ,(when (string/= "" launch-string)
		 (setq doc-list (append doc-list '(:mouse-m-1 "3Launch the software*")))
		 `(nil :eval (public-launcher ,launch-string)))
	      ,(when (string/= "" documentation-pathname)
		 (setq doc-list (append doc-list '(:mouse-r-1 "3View the documentation*")))
		 `(nil :eval (public-read-doc ,documentation-pathname))) )
    :documentation ,(append doc-list `(:documentation ,doc-string))))


;1;;  Routines that maintain Public Contents file on SYS:PUBLIC;*

(defun 4verify-public-contents* ()
  "2Makes certain that a contents file for the SYS:PUBLIC; directory exists.*"
  (if (probe-file *public-contents-pathname*)
      (mouse-confirm "3The Public Contents file already exists!*"
		     "3Click or move off box to remove*")
      (new-public-contents)))

(defun 4new-public-contents* ()
  "2Starts a new contents file for the SYS:PUBLIC; directory, initializing it to NIL.*"
  (with-open-file (public-contents *public-contents-pathname*
				   :direction :output
				   :if-exists :overwrite
				   :if-does-not-exist :create)
    (print nil
	   public-contents)))

(defun 4add-to-public-contents* (name doc-string &optional files systems
				     (launch-string "") (documentation "")
				     (old-name ""))
  "2Adds a software package to the Public contents file.
    NAME is the name of the software to be used in the Public Menu.
    DOC-STRING will appear in the mouse-line of the Public Menu to explain briefly
           the purpose of the software.
    FILES is a list, where each element is the pathname of a file to be loaded.  The files
           are loaded in the same order as the list.  Note:  this must be a list, even if it
           contains only one pathname.
    SYSTEMS is a list, where each element is a system to be 'made'.  The system names
           will simply be passed to MAKE-SYSTEM in the same order as the list.  The
           system's defsystem should be available on the sys-host or should have been
           loaded previously.  The files listed in FILES are loaded before the systems are
           made, so the defsystem file can be specified in FILES.  Note:  this must be a
           list, even if it contains only one pathname.
    LAUNCH-STRING is a string from which can be read a form to evaluate to launch
           the software.  A string is required since some software may be defined within
           its own package.  This package would not necessarily exist when this function
           is called, and therefore would cause an error if read as a form instead of a
           string.  If the string is not specified, launching is not provided as an option.
    DOCUMENTATION contains the pathname of the file which documents this software.
           If the pathname is not provided, the option to bring up this file from the Public
           Menu is not provided.*"
  (let ((contents (load-public-contents)))
    (with-open-file (public-contents *public-contents-pathname*
				     :direction :output
				     :if-exists :overwrite
				     :if-does-not-exist :create)
      (pkg-bind "3USER*"
	(print
	  (setq w:contents
		(sortcar
		  (cons `(,name ,doc-string ,files ,systems ,launch-string ,documentation)
			(remove-if #'(lambda (item)
				       (or (string-equal w:name (car w:item))
					   (string-equal w:old-name (car w:item))))
				   w:contents))
		  #'string-lessp))
	  w:public-contents)))
    (setq *public-menu-list*
	  (make-public-menu-list contents)) ))

(defun 4remove-from-public-contents* (name)
  "2Removes the software package named NAME from the contents file on 
    SYS:PUBLIC;.  See ADD-TO-PUBLIC-CONTENTS.*"
  (let ((contents (load-public-contents)))
    (with-open-file (public-contents *public-contents-pathname*
				     :direction :output
				     :if-exists :new-version
				     :if-does-not-exist :create)
      (pkg-bind "3USER*"
	(print (setq w:contents
		     (remove-if #'(lambda (item)
				    (string-equal w:name (car w:item)))
				w:contents))
	       w:public-contents)))
    (setq *public-menu-list*
	  (make-public-menu-list contents)) ))

(defun 4load-public-contents* ()
  "2Reads and returns the contents file for SYS:PUBLIC;.  This file is in
    a form suitable for W:MENU-CHOOSE.*"
  (with-open-file (public-contents *public-contents-pathname*
				   :direction :input
				   :if-does-not-exist nil)
    (when public-contents
      (read public-contents))))


;1;; Functions evaluated when an item is selected from PUBLIC-MENU*

(defun 4public-loader* (files systems)
  "2Loads all the files in FILES in the same order they are listed, 
   and then makes all the systems in SYSTEMS in the same order they are listed.*"
  (dolist (pathname files t)
    (load (merge-pathnames pathname
			   *public-default-pathname*)
	  :verbose nil
	  :print nil
	  :if-does-not-exist nil))
  (dolist (system systems t)
    (make-system system :silent :nowarn)))

(defun 4public-launcher* (launch-string)
  ""
  (process-run-function "3Public Menu Launch*"
			#'public-launcher-secondary
			launch-string))

(defun 4public-launcher-secondary* (launch-string &aux window)
  (setq window (idle-lisp-listener default-screen t))
  (send window :mouse-select)
  (send window :force-kbd-input launch-string))

(defun 4public-read-doc* (documentation-pathname)
  "2Will someday bring up the file DOCUMENTATION-PATHNAME for viewing and then return
    to the Public Menu.*"
  (process-run-function "3Public Menu Documentation*"
			#'public-read-doc-secondary
			documentation-pathname))

;1 Zmacs View File.*
(defun 4public-read-doc-secondary* (documentation-pathname)
  "2Will someday bring up the file DOCUMENTATION-PATHNAME for viewing and then return
    to the Public Menu.*"
  (let* ((sheet (zwei::find-or-create-idle-zmacs-window))
	 (window (send (send sheet
			     :editor-closure)
		       #'eval
		       'zwei:*window*))
	 (overlay (zwei:create-overlying-window window)))
    (send sheet
	  :force-kbd-input
	  `(:execute public-view-file ,documentation-pathname ,overlay))
    (unless (member (send sheet :status) '(:selected :exposed))
      (find-system-instance 'zmacs nil nil))))

(defun 4public-view-file* (pathname &optional window)
  "2\"View\" the text of file PATHNAME.
   To scroll forward one screen: CTRL-
, CTRL-V or SPACE
             backward one screen: CTRL- or META-V
             forward one line: CTRL-N or 

             backward one line: CTRL-P or .*"
  (sys:with-suggestions-menus-for zwei:view-file
    (with-open-file (stream pathname :error :retry :preserve-dates t)
      (zwei::prompt-line "3Viewing ~A*" (send stream :truename))
      (zwei::view-stream stream window))))

;1; Lisp Listener View File.*
;(defun 4public-read-doc-secondary* (documentation-pathname &aux window)
;  "2Will someday bring up the file DOCUMENTATION-PATHNAME for viewing and then return*
;2    to the Public Menu.*"
;  (setq window (idle-lisp-listener default-screen t))
;  (send window :mouse-select)
;  (send window :force-kbd-input (string-append "3(VIEW-FILE *"
;					       #\"
;					       documentation-pathname
;					       #\"
;					       "3)*")))