(in-package "KPML-I")

;;; ----------------------------------------------------------------------
;;; Various functions for offering menus to the user
;;; depending on the contents of some given directory.
;;; ----------------------------------------------------------------------

;;; ----------------------------------------------------------------------
;;; 3.2.8
;;; was not upcasing language variety names... giving weird
;;; symbols that confuse... e.g., :|Russian|. These were fine for
;;; the recognition of particular directories that could then be
;;; loaded, but were not triggering the page code settings 
;;; appropriately.
;;; ----------------------------------------------------------------------

(defun LANGUAGE-VARIETY-MENU-CHOICE ()
  (let* ((message-stream 
	  (clim:get-frame-pane 
	   ;; 2.0.15 was trying to get something from an unset resource
	   ;;        manager frame, so give it more options...
	   (or *resource-manager-frame*
	       *resource-development-frame*)
	   'inspector))
	 (search-directory common-lisp-user::*root-of-resources*)
	 (candidate-paths
	  (kpml::kpml-directory 
	   (concatenate 'string (namestring search-directory) 
			"*" #+acl3.0 "\\")))
	 (candidate-assoc-list 
	  (mapcar #'(lambda (path) 
		      (cons #-(or acl3.0 lispworks)(pathname-name path)
			    #+(or acl3.0 lispworks)(kpml::acl-get-directory-name path)
			    path))
		      candidate-paths))
	 (candidates 
	  (mapcar #'first candidate-assoc-list))
	 (choice nil)
	 (choice-list nil)
	 )
    (unless candidates
	    (format message-stream "~%No varieties reachable.")
	    (return-from LANGUAGE-VARIETY-MENU-CHOICE nil))
    ;; unfortunately clicking outside of the menu causes the
    ;; window system to hang -- at least on Lucid 4.0; Clim 1.0 --
    ;; and so collecting options is not allowed here.
    ;;
    ;; In addition, clicking on the Windows95 dismiss button destroys
    ;; the frame so effectively that any subsequent attempts to use
    ;; this menu bomb. So here we back-off entirely and bring up
    ;; a standard Windows menu...

    (setf choice
	  (menu-choose 
	   ;;	    (append candidates (list '|Done|))
	   (remove nil (remove "." candidates :test #'string=))
	   :associated-window 
	   (clim:frame-top-level-sheet clim:*application-frame*)
	   :label "Language Variety Selection")
	  )
    (cond ((eq choice '|Done|)
	   (return-from LANGUAGE-VARIETY-MENU-CHOICE choice-list))
	  (t
	   (return-from LANGUAGE-VARIETY-MENU-CHOICE 
			(if choice 
			    (intern (string-upcase choice) "KEYWORD")
			  nil))))))

;;; ----------------------------------------------------------------------
;;; Following function takes a directory and an extension and
;;; offers a menu for selecting those files in the directory
;;; with the given extension. The name of the file without
;;; extension and directory position is used for the menu items.
;;; The result is a list of the file(s) selected. 
;;;
;;; Unfortunately, the window system appears to be somewhat
;;; untrustworthy. Use of this function causes the window system
;;; to hang quite often. No idea why as yet.
;;; ----------------------------------------------------------------------

(defun FILES-FROM-DIRECTORY-MENU-CHOICE (search-directory mask)
  (let* ((message-stream 
          (clim:get-frame-pane 
	   ;; 2.1 same as 2.0.15 from another menu... i.e.,
           ;;        was trying to get something from an unset resource
	   ;;        manager frame, so give it more options...
	   (or *resource-manager-frame*
	       *resource-development-frame*)
	   'inspector))
	 (candidate-paths
	  (kpml::kpml-directory
	   (merge-pathnames 
	    (concatenate 'string (namestring search-directory) 
			   (concatenate 'string "*." (string mask)))
	    "*.*.newest")))
	 (candidate-assoc-list 
	  (mapcar #'(lambda (path) (cons (pathname-name path) path)) candidate-paths))
	 (candidates 
	  (mapcar #'first candidate-assoc-list))
	 (choice nil)
	 (choice-list nil)
	 )
    (unless candidates
	    (format message-stream "~%No files found.")
	    (return-from FILES-FROM-DIRECTORY-MENU-CHOICE nil))
;;; unfortunately clicking outside of the menu causes the
;;; window system to hang (at least on Lucid 4.0; Clim 1.0)
;;; and so collecting options is not allowed here.
     (setf choice
	   (menu-choose 
;;	    (append candidates (list '|Done|))
	    candidates
	    :associated-window 
	    (clim:frame-top-level-sheet clim:*application-frame*)
	    :label "Directory File Selection"))
     (cond ((eq choice '|Done|)
	    (return-from FILES-FROM-DIRECTORY-MENU-CHOICE choice-list))
	   (t
;;	    (when choice
;;		  (pushnew (cdr (assoc choice candidate-assoc-list))
;;			   choice-list))
	    (return-from FILES-FROM-DIRECTORY-MENU-CHOICE 
			 (list (cdr (assoc choice candidate-assoc-list))))))))




;;; For picking out directories...

(defun SUBDIRECTORIES-MENU-CHOICE (search-directory)
  (let* ((message-stream 
	  (clim:get-frame-pane *resource-manager-frame* 'inspector))
	 (candidate-paths
	  (kpml::kpml-directory 
	   (concatenate 'string (namestring search-directory) "*")))
	 (candidate-assoc-list 
	  (mapcar #'(lambda (path) (cons (pathname-name path) path)) candidate-paths))
	 (candidates 
	  (mapcar #'first candidate-assoc-list))
	 (choice nil)
	 (choice-list nil)
	 )
    (unless candidates
	    (format message-stream "~%No options.")
	    (return-from SUBDIRECTORIES-MENU-CHOICE nil))
;;; unfortunately clicking outside of the menu causes the
;;; window system to hang -- at least on Lucid 4.0; Clim 1.0 --
;;; and so collecting options is not allowed here.
     (setf choice
	   (menu-choose 
	    ;;	    (append candidates (list '|Done|))
	    (remove nil (remove "." candidates :test #'string=))
	    :associated-window 
	    (clim:frame-top-level-sheet clim:*application-frame*)
	    :label "Subdirectory Selection"))
     (cond ((eq choice '|Done|)
	    (return-from SUBDIRECTORIES-MENU-CHOICE choice-list))
	   (t
	    (return-from SUBDIRECTORIES-MENU-CHOICE 
			 (list (cdr (assoc choice candidate-assoc-list))))))))








