(FILECREATED "31-Jan-86 11:36:13" {ERIS}<LISPUSERS>KOTO>BACKGROUNDMENU.;4 6563
changes to: (FNS BkgMenu.add.item BkgMenu.move.item)
(VARS BACKGROUNDMENUCOMS)
previous date: "31-Jan-86 11:15:27" {ERIS}<LISPUSERS>KOTO>BACKGROUNDMENU.;3)
(* Copyright (c) 1985, 1986 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 (QUOTE 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 (QUOTE 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 (QUOTE 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 (QUOTE 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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (908 6473 (BkgMenu.add.item 918 . 1738) (BkgMenu.fixup 1740 . 2804) (BkgMenu.move.item
2806 . 3163) (BkgMenu.remove.item 3165 . 3427) (BkgMenu.rename.item 3429 . 3700) (
BkgMenu.reorder.items 3702 . 4017) (BkgMenu.subitems 4019 . 4406) (\BkgMenu.locate 4408 . 4899) (
\BkgMenu.locater 4901 . 5437) (\BkgMenu.remove.item 5439 . 5723) (\BkgMenu.scan.item.list 5725 . 6127)
(\BkgMenu.unremove.item 6129 . 6471)))))
STOP