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

(FILECREATED "31-Jan-87 18:09:00" {ERIS}<LISPUSERS>LYRIC>BACKGROUNDMENU.;1
 7367   

      previous date%: "31-Jan-86 11:36:13" {ERIS}<LISP>KOTO>LISPUSERS>BACKGROUNDMENU.;1)


(* "
Copyright (c) 1985, 1986, 1987 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT BACKGROUNDMENUCOMS)

(RPAQQ BACKGROUNDMENUCOMS
 ((INITVARS BackgroundMenuFixupMode BackgroundMenuSuperItem 
                                  BackgroundMenuTopLevelItems)
                           (FNS BkgMenu.add.item BkgMenu.fixup BkgMenu.move.item BkgMenu.remove.item 
                                BkgMenu.rename.item BkgMenu.reorder.items BkgMenu.subitems 
                                \BkgMenu.locate \BkgMenu.locater \BkgMenu.remove.item 
                                \BkgMenu.scan.item.list \BkgMenu.unremove.item)))

(RPAQ? BackgroundMenuFixupMode
 NIL)

(RPAQ? BackgroundMenuSuperItem
 NIL)

(RPAQ? BackgroundMenuTopLevelItems
 NIL)
(DEFINEQ

(BkgMenu.add.item

  [LAMBDA (item superitem atend)
                             (* mdd "31-Jan-86 11:32")

    (if
 (NULL superitem)
        then
 (if
 atend
                 then
 (NCONC1 BackgroundMenuCommands item)
               else
 (SETQ BackgroundMenuCommands (CONS item BackgroundMenuCommands)))
             (SETQ BackgroundMenu NIL)
             T
      elseif
 (SETQ superitem (CDDAR (\BkgMenu.locate
 superitem)))
        then
 [if
 (NULL (CDR superitem))
                 then
 (RPLACD superitem (LIST (LIST 'SUBITEMS item)))
               else
 (if
 atend
                        then
 (NCONC1 (CADR superitem)
                                    item)
                      else
 (RPLACD (CADR superitem)
                                  (CONS item (CDADR superitem]
             (SETQ BackgroundMenu NIL)
             T])

(BkgMenu.fixup

  [LAMBDA NIL
                                                (* mdd "23-Sep-85 19:09")

    (bind
 stack (stacking _ (NEQ BackgroundMenuFixupMode 'bottom))
          (result _ T) for
 x in
 (BkgMenu.subitems
)
       do
 [if
 (for
 i in
 BackgroundMenuTopLevelItems thereis
 (EQUAL (MKSTRING i)
                                                                   (MKSTRING x)))
              then
 (if
 (AND stacking (NEQ BackgroundMenuFixupMode 'top))
                       then
 (for
 i in
 stack do
 (OR (BkgMenu.move.item
 i BackgroundMenuSuperItem)
                                                   (SETQ result NIL)))
                            (SETQ stacking NIL))
            else
 (if
 stacking
                     then
 (SETQ stack (CONS x stack))
                   else
 (OR (BkgMenu.move.item
 x BackgroundMenuSuperItem T)
                            (SETQ stacking NIL]
       finally
 [if
 stacking
                   then
 (for
 i in
 stack do
 (OR (BkgMenu.move.item
 i BackgroundMenuSuperItem)
                                               (SETQ result NIL]
             (RETURN result])

(BkgMenu.move.item

  [LAMBDA (item superitem atend)
                             (* mdd "31-Jan-86 11:32")

    (if
 (SETQ item (\BkgMenu.locate
 item))
        then
 (\BkgMenu.remove.item
 item)
             (if
 (BkgMenu.add.item
 (CAR item)
                        superitem atend)
                 then
 T
               else
 (\BkgMenu.unremove.item
 item)
                    NIL])

(BkgMenu.remove.item

  [LAMBDA (item)
                                             (* mdd "23-Sep-85 17:13")

    (if
 (SETQ item (\BkgMenu.locate
 item))
        then
 (\BkgMenu.remove.item
 item)
             (SETQ BackgroundMenu NIL)
             T])

(BkgMenu.rename.item

  [LAMBDA (item new.name)
                                    (* mdd "23-Sep-85 16:58")

    (if
 (SETQ item (\BkgMenu.locate
 item))
        then
 (RPLACA (CAR item)
                    new.name)
             (SETQ BackgroundMenu NIL)
             T])

(BkgMenu.reorder.items

  [LAMBDA (itemlist superitem atend)
                         (* mdd "23-Sep-85 20:26")

    (NOT (for
 i in
 (if
 atend
                       then
 itemlist
                     else
 (REVERSE itemlist)) do
 (OR (BkgMenu.move.item
 i superitem atend)
                                                     (SETQ $$VAL T])

(BkgMenu.subitems

  [LAMBDA (item)
                                             (* mdd "23-Sep-85 18:33")

    (if
 item
        then
 (if
 (SETQ item (\BkgMenu.locate
 item))
                 then
 (MAPCAR (CDR (CADDDR (CAR item)))
                             (FUNCTION CAR))
               else
 'NotAnItem)
      else
 (MAPCAR BackgroundMenuCommands (FUNCTION CAR])

(\BkgMenu.locate

  [LAMBDA (item menu)
                                        (* mdd "23-Sep-85 20:58")

    (if
 [AND (LISTP item)
             (CDR item)
             (NOT (SETQ menu (CADDDR (CAR (\BkgMenu.locate
 (CDR item)
                                                 menu]
        then
 NIL
      else
 (\BkgMenu.locater
 (MKSTRING (if
 (LISTP item)
                                           then
 (CAR item)
                                         else
 item))
                  (OR (CDR menu)
                      BackgroundMenuCommands)
                  menu])

(\BkgMenu.locater

  [LAMBDA (name items preitems)
                              (* mdd "23-Sep-85 20:44")

    (bind
 (queue _ (CONS NIL NIL)) until
 (OR (SETQ $$VAL (\BkgMenu.scan.item.list
 name items preitems 
                                                                queue))
                                             (NULL (CAR queue)))
       do
 (SETQ preitems (CAAR queue))
          (SETQ items (CDR preitems))
          (RPLACA queue (CDAR queue))
          (if
 (NULL (CAR queue))
              then
 (RPLACD queue NIL])

(\BkgMenu.remove.item

  [LAMBDA (item)
                                             (* mdd "23-Sep-85 17:12")

    (if
 (CDR item)
        then
 (RPLACD (CDR item)
                    (CDDDR item))
      else
 (SETQ BackgroundMenuCommands (CDR BackgroundMenuCommands])

(\BkgMenu.scan.item.list

  [LAMBDA (name items preitems queue)
                        (* mdd "23-Sep-85 15:39")

    (for
 i in
 old
 items do
 (if
 (EQUAL (MKSTRING (CAR i))
                                      name)
                               then
 (RETURN (CONS i preitems))
                             else
 (if
 (CDDDR i)
                                      then
 (TCONC queue (CADDDR i)))
                                  (SETQ preitems items])

(\BkgMenu.unremove.item

  [LAMBDA (item)
                                             (* mdd "23-Sep-85 17:17")

    (if
 (CDR item)
        then
 (RPLACD (CDR item)
                    (CONS (CAR item)
                          (CDDR item)))
      else
 (SETQ BackgroundMenuCommands (CONS (CAR item)
                                              BackgroundMenuCommands])
)
(PUTPROPS BACKGROUNDMENU COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1008 7271 (BkgMenu.add.item 1018 . 1910) (BkgMenu.fixup 1912 . 3131) (BkgMenu.move.item
 3133 . 3557) (BkgMenu.remove.item 3559 . 3834) (BkgMenu.rename.item 3836 . 4128) (
BkgMenu.reorder.items 4130 . 4505) (BkgMenu.subitems 4507 . 4907) (\BkgMenu.locate 4909 . 5520) (
\BkgMenu.locater 5522 . 6089) (\BkgMenu.remove.item 6091 . 6378) (\BkgMenu.scan.item.list 6380 . 6877)
 (\BkgMenu.unremove.item 6879 . 7269)))))
STOP