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

(FILECREATED " 5-Aug-88 18:30:07" {PHYLUM}<BURWELL>LISP>ARMODES.\;7
 6699   

      |changes| |to:|  (RECORDS AR.ENVIRONMENT)
                       (FNS AR.MODE AR.FORM.FILL.INS.DEFAULT AR.SEND.MESSAGE AR.MODE.SUBITEMS)
                       (VARS ARMODESCOMS)

      |previous| |date:| " 2-Aug-88 21:47:13" {PHYLUM}<BURWELL>LISP>ARMODES.\;1)


; 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.ENTRY.LIST.PRINT.FIELDS AR.ENTRY.LIST.PRINT.MULTILINE.FLAG AR.ENTRY.LIST.WINDOW.FIELDS 
               AR.INDEX.DEFAULT.FIELDS AR.NO.MESSAGE.FLG AR.INDEX.DEFAULT.FILE.NAME AR.INFO.FILE.NAME
               AR.SUBMIT.FILE.NAME AR.DIRECTORY AR.FORM.FORMAT AR.FORM.SPECS AR.SUBMIT.NUM.FILE.NAME
               AR.MAP AR.SUMMARY.MAP AR.THIN.SUMMARY.MAP 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 (2136 3515 (AR.MODE 2146 . 3513)) (3652 5014 (AR.ADD.TO.BACKGROUND.MENU 3662 . 4311) (
AR.MODE.SUBITEMS 4313 . 5012)))))
STOP