(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")

(FILECREATED "29-Nov-88 15:06:14" {PHYLUM}<BURWELL>LISP>ARMODES.\;10
 6915   

      |changes| |to:|  (RECORDS AR.ENVIRONMENT)
                       (VARS ARMODESCOMS)
                       (FNS AR.MODE AR.ADD.TO.BACKGROUND.MENU AR.MODE.SUBITEMS)

      |previous| |date:| "29-Nov-88 14:40:17" {PHYLUM}<BURWELL>LISP>ARMODES.\;9)


; Copyright (c) 1988 by Xerox Corporation.  All rights reserved.

(PRETTYCOMPRINT ARMODESCOMS)

(RPAQQ ARMODESCOMS

       (
        (* |;;| "provide a mechanism for change the database which the AR system uses")


        
        (* |;;| "the interface to switch modes")


        (FNS AR.MODE)
        (GLOBALVARS AR.MODE)
        
        (* |;;| "things for the background menu interface to mode changes")


        (FNS AR.ADD.TO.BACKGROUND.MENU AR.MODE.SUBITEMS)
        (FILES DEFAULTSUBITEMFN)
        (VARS (AR.MODE.SUBITEMS)
              (\\AR.ENVIRONMENTS))
        (GLOBALVARS AR.MODE.SUBITEMS \\AR.ENVIRONMENTS)
        
        (* |;;| "the ar environment -- everything you need to switch modes")


        (RECORDS AR.ENVIRONMENT)
        (GLOBALVARS AR.ENVIRONMENTS)
        
        (* |;;| "installation")


        (P (AR.ADD.TO.BACKGROUND.MENU)
           
           (* |;;| 

        "if there's nothing set up already assume it's the Lisp mode and construct the environment")


           (|if| (NOT (BOUNDP 'AR.ENVIRONMENTS))
                 |then|
                 (LET ((ORIGINALENVIRONMENT (|create| AR.ENVIRONMENT)))
                      (|for| FIELD |in| (RECORDFIELDNAMES 'AR.ENVIRONMENT)
                             |do|
                             (RECORDACCESS FIELD ORIGINALENVIRONMENT (RECLOOK 'AR.ENVIRONMENT)
                                    'REPLACE
                                    (EVAL FIELD)))
                      (SETQ AR.ENVIRONMENTS (LIST 'LISP ORIGINALENVIRONMENT)))
                 (AR.MODE 'LISP)))))



(* |;;| "provide a mechanism for change the database which the AR system uses")





(* |;;| "the interface to switch modes")


(DEFINEQ

(AR.MODE

  (LAMBDA (MODE)
                                      (* \; "Edited  5-Aug-88 18:22 by Burwell")

    (|if|
 (NULL MODE)
        |then|
 (PROMPTPRINT "AR mode is " AR.MODE)
              AR.MODE
      |else|
 (LET ((ENVIRONMENT.FOR.MODE (LISTGET AR.ENVIRONMENTS MODE)))
                      (|if|
 ENVIRONMENT.FOR.MODE
                          |then|
 (|if|
 (OR (FIND.PROCESS 'AR.QUERY.FORM.TEMP)
                                                   (FIND.PROCESS 'AR.FORM.TEMP)
                                                   (FIND.PROCESS 'AR.FORM.MENU)
                                                   (FIND.PROCESS 'AR.FORM)
                                                   (FIND.PROCESS 'AR.QUERY.FORM))
                                         |then|
 (PROMPTPRINT 
                                                "Please close open AR windows before changing modes."
                                                           )
                                       |else|
 (SETQ AR.MODE MODE)
                                             (|for|
 VAR |in|
 (RECORDFIELDNAMES 
                                                                            'AR.ENVIRONMENT)
                                                |do|
 (SET VAR (RECORDACCESS VAR 
                                                                         ENVIRONMENT.FOR.MODE
                                                                         (RECLOOK 'AR.ENVIRONMENT))))
                                             (PROMPTPRINT "AR mode set to " MODE))
                        |else|
 (PROMPTPRINT "AR mode " MODE " not recognized."))))))
)
(DECLARE\: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS AR.MODE)
)



(* |;;| "things for the background menu interface to mode changes")


(DEFINEQ

(AR.ADD.TO.BACKGROUND.MENU

  (LAMBDA NIL
                                         (* \; "Edited  2-Aug-88 15:58 by Burwell")

    (|if|
 (NOT (|for|
 E |in|
 |BackgroundMenuCommands|
                      |thereis|
 (EQUAL "AR Mode" (AND (LISTP E)
                                                          (CAR E)))))
        |then|
 (|push|
 |BackgroundMenuCommands| `("AR Mode" '(AR.MODE
)
                                                                "Displays current AR mode."
                                                                (EVAL (AR.MODE.SUBITEMS
))))
              (SETQ |BackgroundMenu| NIL))))

(AR.MODE.SUBITEMS

  (LAMBDA NIL
                                         (* \; "Edited  2-Aug-88 15:56 by Burwell")

    (|if|
 (EQUAL AR.ENVIRONMENTS \\AR.ENVIRONMENTS)
        |then|
 AR.MODE.SUBITEMS
      |else|
 (LET ((MODES (|for|
 MODE |in|
 AR.ENVIRONMENTS |by|
 (CDDR MODE)
                                 |collect|
 MODE)))
                      (SETQ AR.MODE.SUBITEMS (|for|
 MODE |in|
 MODES
                                                |collect|

                                                `(,MODE '(AR.MODE
 ',MODE)
                                                        ,(CONCAT "Set AR mode to " MODE))))
                      (SETQ \\AR.ENVIRONMENTS (COPY AR.ENVIRONMENTS))
                      AR.MODE.SUBITEMS))))
)

(FILESLOAD DEFAULTSUBITEMFN)

(RPAQQ AR.MODE.SUBITEMS
 NIL)

(RPAQQ \\AR.ENVIRONMENTS
 NIL)
(DECLARE\: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS AR.MODE.SUBITEMS \\AR.ENVIRONMENTS)
)



(* |;;| "the ar environment -- everything you need to switch modes")


(DECLARE\: EVAL@COMPILE

(RECORD AR.ENVIRONMENT
 
        (AR.NO.MESSAGE.FLG AR.INDEX.DEFAULT.FILE.NAME AR.INFO.FILE.NAME AR.DIRECTORY AR.FORM.FORMAT 
               AR.FORM.SPECS AR.SUBMIT.NUM.FILE.NAME AR.DISPLAY.FIELDS AR.SUMMARY.FIELDS 
               AR.CLEANUP.SORT.ORDER AR.SORT.SPEC.ITEMS AR.QUERY.SPEC.ITEMS AR.INDEX.CACHE.FILE.NAME
               AR.IDENTIFICATION.STRING AR.INTERESTING.SUBMIT.FIELDS))
)
(DECLARE\: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS AR.ENVIRONMENTS)
)



(* |;;| "installation")



(AR.ADD.TO.BACKGROUND.MENU
)


(* |;;| "if there's nothing set up already assume it's the Lisp mode and construct the environment")



(|if|
 (NOT (BOUNDP 'AR.ENVIRONMENTS))
    |then|
 (LET ((ORIGINALENVIRONMENT (|create|
 AR.ENVIRONMENT)))
                    (|for|
 FIELD |in|
 (RECORDFIELDNAMES 'AR.ENVIRONMENT)
                       |do|
 (RECORDACCESS FIELD ORIGINALENVIRONMENT (RECLOOK 'AR.ENVIRONMENT)
                                       'REPLACE
                                       (EVAL FIELD)))
                    (SETQ AR.ENVIRONMENTS (LIST 'LISP ORIGINALENVIRONMENT)))
          (AR.MODE
 'LISP))
(PUTPROPS ARMODES COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (2120 3819 (AR.MODE 2130 . 3817)) (3955 5410 (AR.ADD.TO.BACKGROUND.MENU 3965 . 4620) (
AR.MODE.SUBITEMS 4622 . 5408)))))
STOP