(FILECREATED "21-AUG-83 04:17:27" {PHYLUM}<LISPCORE>DEMO>HISTMENU.;1 12565
changes to: (VARS HistoryBitMap HistoryBitMapMask HISTMENUCOMS)
(FNS HistoryIcon)
previous date: "31-MAR-83 18:13:18" {PHYLUM}<LISPUSERS>HISTMENU.;13)
(PRETTYCOMPRINT HISTMENUCOMS)
(RPAQQ HISTMENUCOMS ((VARS BadHistoryItems HistDefaultSlice HistItemsShown HistMenuHeight
HistMenuWidth HistOpMenuItems HistWindowWidth HistEventWidth
UpdateOnDeleteFlg (HistOpMenu)
(HistoryWindow)
(HistoryMenu))
(FNS HistEventString HistHeldFn HistMenuOp HistRightButtonFn HistoryIcon
HistoryMenu LastNEvents UpdateHistory UpdateHistoryWindow)
(BITMAPS HistoryBitMap HistoryBitMapMask)))
(RPAQQ BadHistoryItems (EDIT ?= OK T NIL ↑))
(RPAQQ HistDefaultSlice 30)
(RPAQQ HistItemsShown 51)
(RPAQQ HistMenuHeight 15)
(RPAQQ HistMenuWidth 164)
(RPAQQ HistOpMenuItems ((REDO (QUOTE REDO)
"REDO event selected")
(FIX (QUOTE FIX)
"Edit event selected")
(UNDO (QUOTE UNDO)
"UNDO event selected")
(?? (QUOTE ??)
"Show event selected")
(Delete (QUOTE Delete)
"Delete event from history menu")))
(RPAQQ HistWindowWidth 164)
(RPAQQ HistEventWidth 60)
(RPAQQ UpdateOnDeleteFlg T)
(RPAQQ HistOpMenu NIL)
(RPAQQ HistoryWindow NIL)
(RPAQQ HistoryMenu NIL)
(DEFINEQ
(HistEventString
[LAMBDA (entry) (* dgb: "10-FEB-83 10:32")
(* Put together a string which looks like input for menu. Put spaces between atoms, remove <c.r.>, and make top
level NIL be "()". entry is a history list entry of form (event value . proplist). Computed entries are cached in
the propList under the property HistoryString)
(COND
((NULL entry)
(QUOTE (" ")))
((LISTGET (CDDDR entry)
(QUOTE HistoryString)))
(T (PROG (newLst key (event (CAR entry))
str)
[COND
[(AND (EQ (SETQ key (CAR event))
(QUOTE UNDO))
(CDR event)) (* Special form for UNDO. Show form of event that was
undone.)
(SETQ event (APPEND event (QUOTE (" -- "))
(CAR (LISPXFIND LISPXHISTORY (CDR event)
(QUOTE ENTRY]
((FMEMB key BadHistoryItems) (* Not an item to be shown in history)
(NCONC entry (LIST (QUOTE HistoryString)
(QUOTE Deleted)))
(RETURN (QUOTE Deleted]
(SETQ newLst (TCONC NIL key))
(for tail item on (CDR event)
do (* Add item to the event description to made into a
string)
[COND
((EQ HISTSTR0 (SETQ item (CAR tail)))
(* leave out <c.r.>)
(GO SKIP))
((NULL item)
(SETQ item "()"))
((ATOM item) (* Put in space between atoms)
(TCONC newLst (QUOTE % ]
(TCONC newLst item)
SKIP
finally (SETQ str (APPLY (QUOTE CONCAT)
(CAR newLst))) (* make a string using CONCAT, and put as property
HistoryString)
[COND
((IGREATERP (NCHARS str)
HistEventWidth) (* Avoid going on too long)
(SETQ str (CONCAT (SUBSTRING str 1 HistEventWidth)
" ..."]
(NCONC entry (LIST (QUOTE HistoryString)
str)))
(RETURN str])
(HistHeldFn
[LAMBDA (item menu key) (* dgb: " 9-FEB-83 16:36")
(CLRPROMPT)
(printout PROMPTWINDOW "Will " (SELECTQ key
(MIDDLE "do one of UNDO, FIX, ??, or Delete on ")
"REDO ")
(CDR item)
T %# (PRIN3 (CAR item))
T])
(HistMenuOp
[LAMBDA (exp menu key) (* dgb: " 2-MAR-83 14:03")
(PROG (op)
(COND
((NULL (CDR exp))
(RETURN)))
(SELECTQ key
(LEFT (SETQ op (QUOTE REDO))
(GO DOIT))
(MIDDLE [SETQ op (MENU (OR (AND (type? MENU HistOpMenu)
HistOpMenu)
(SETQ HistOpMenu (create MENU
ITEMS ← HistOpMenuItems]
(SELECTQ op
[Delete (LISTPUT (CDDDR (LISPXFIND LISPXHISTORY
(LIST (CDR exp))
(QUOTE ENTRY)))
(QUOTE HistoryString)
(QUOTE Deleted))
(RETURN (AND UpdateOnDeleteFlg (UpdateHistory menu]
(NIL (* nothing selected)
(RETURN NIL))
(GO DOIT)))
(RETURN))
DOIT(COND
((EQ LISPXID (QUOTE *)) (* Inside the editor, put out an E)
(BKSYSBUF "E ")))
(BKSYSBUF op) (* Insert op space event identifier in system buffer)
(BKSYSBUF " ")
(BKSYSBUF (CDR exp))
(BKSYSBUF "
")
NIL])
(HistRightButtonFn
[LAMBDA (WINDOW) (* dgb: "31-MAR-83 18:12")
(* Sets up Menu, and then does usual right window stuff,
augmented by UpdateHistoryWindow)
[OR (type? MENU (EVALV (QUOTE HistRightMenu)))
(SETQ HistRightMenu (create MENU
ITEMS ←(QUOTE ((Bury (QUOTE BURYW)
"Puts this window on the bottom.")
(Move (QUOTE MOVEW)
"Moves window by a corner.")
(Shrink (QUOTE SHRINKW)
"Replaces this window with its icon (or title if it doesn't have an icon.")
(Update (QUOTE UpdateHistoryWindow)
"Update the window to show all current items"]
(TOTOPW WINDOW)
(PROG (COM)
(RETURN (COND
((SETQ COM (MENU HistRightMenu))
(APPLY* COM WINDOW)
T])
(HistoryIcon
[LAMBDA (N histPosition iconPosition) (* hts: "21-AUG-83 04:11")
(* Used with the shrink and expand functions of windows.
Creates a history menu, and uses a labelled ScrollBitMap
for an icon image)
(PROG [H (W (if (GETD (QUOTE ICONW))
then (ICONW (BITMAPCOPY HistoryBitMap)
HistoryBitMapMask iconPosition T)
else (CREATEWFROMIMAGE (BITMAPCOPY HistoryBitMap]
(SETQ H (HistoryMenu N histPosition))
(SHRINKW (WFROMMENU H)
W iconPosition (QUOTE UpdateHistoryWindow])
(HistoryMenu
[LAMBDA (histMenuLength histMenuPosition) (* dgb: " 2-MAR-83 14:17")
(* Create a menu showing the last histMenuLength events
of history. If histMenuPosition is not given, then
allows the user to move window)
(PROG (W wwidth wregion (wheight (ITIMES HistMenuHeight HistItemsShown)))
(OR histMenuLength (SETQ histMenuLength HistDefaultSlice))
(* Default HistorySlice is HistDefaultSlice)
(SETQ HistoryMenu (create MENU
ITEMS ←(LastNEvents histMenuLength)
ITEMHEIGHT ← HistMenuHeight
ITEMWIDTH ← HistMenuWidth
MENUOUTLINESIZE ← 0
WHENSELECTEDFN ←(QUOTE HistMenuOp)
WHENHELDFN ←(QUOTE HistHeldFn)))
(PROGN [PROG ((MD (fetch MENUUSERDATA of HistoryMenu)))
(COND
((NULL MD)
(replace MENUUSERDATA of HistoryMenu with (LIST (QUOTE HistorySlice)
histMenuLength)))
(T (LISTPUT MD (QUOTE HistorySlice)
histMenuLength]
histMenuLength)
(SETQ wwidth (WIDTHIFWINDOW (fetch (MENU IMAGEWIDTH) of HistoryMenu)))
(SETQ wheight (HEIGHTIFWINDOW (fetch (MENU IMAGEHEIGHT) of HistoryMenu)
T))
[COND
((NOT (type? POSITION histMenuPosition))
(SETQ histMenuPosition (GETBOXPOSITION wwidth wheight NIL NIL NIL
"Position History Window"]
(SETQ wregion (create REGION
LEFT ←(fetch XCOORD of histMenuPosition)
BOTTOM ←(fetch YCOORD of histMenuPosition)
WIDTH ← wwidth
HEIGHT ← wheight))
(SETQ W (CREATEW wregion "History Window"))
(WINDOWPROP W (QUOTE RIGHTBUTTONFN)
(QUOTE HistRightButtonFn))
(ADDMENU HistoryMenu W (create POSITION
XCOORD ← 0
YCOORD ← 0)
T))
HistoryMenu])
(LastNEvents
[LAMBDA (N) (* dgb: " 9-FEB-83 14:52")
(PROG (ev (i 1))
(RETURN (while (ILESSP i N) bind hist1 (lastN ←(ADD1 (CADR LISPXHISTORY)))
(hist ←(CAR LISPXHISTORY))
when [PROGN (SETQ hist1 (CAR hist))
(SETQ hist (CDR hist))
(NEQ (QUOTE Deleted)
(SETQ ev (HistEventString hist1]
collect (SETQ i (ADD1 i))
(COND
((OR hist hist1)
(CONS ev (ENTRY%# LISPXHISTORY hist1)))
(T (QUOTE (" "])
(UpdateHistory
[LAMBDA (histMenu) (* dgb: " 9-FEB-83 16:29")
(* replace the current set of events with the most
recent set)
(PROG ((historyWindow (WFROMMENU histMenu)))
[replace ITEMS of histMenu with (LastNEvents (LISTGET (fetch MENUUSERDATA of histMenu)
(QUOTE HistorySlice]
(UPDATE/MENU/IMAGE histMenu)
(BLTMENUIMAGE histMenu historyWindow])
(UpdateHistoryWindow
[LAMBDA (window) (* dgb: " 4-JUN-82 06:55")
(* For use with both the HISTMENU package and ICON
package. Updates a history menu on opening it from its
icon)
(UpdateHistory (CAR (WINDOWPROP window (QUOTE MENU])
)
(RPAQ HistoryBitMap (READBITMAP))
(64 64
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"AOOOOOOOOOOOOOOH"
"AH@@@@@@@@@@@F@L"
"C@@@@@@@@@@@@L@F"
"B@@@@@@@@@@@@H@B"
"B@@@@@@@@@@@@O@C"
"B@@@@@@@@@@@@I@C"
"B@@@@@@@@@@@@K@C"
"B@@@@@@@@@@@@IHB"
"C@@@@@@@@@@@@@DF"
"A@DDA@@@@@@@@@GL"
"@HDD@@@A@@@@@@GH"
"@HDDG@NCLCHKAAB@"
"@HGLAAAA@DDLIAB@"
"@DDDA@LA@DDHAAF@"
"@DDDA@BA@DDH@JD@"
"@DDDAAAABDDH@JD@"
"@BDDA@N@LCHH@DD@"
"@B@@@@@@@@@@@DD@"
"@B@@@@@@@@@@AHD@"
"@A@@@@@@@@@@@@D@"
"@A@@@@@@@@@@@@D@"
"@A@@@@@@@@@@@@D@"
"@A@@@@@@@@@@@@D@"
"@A@@@@@@@@@@@@D@"
"@@H@@@@@@@@@@@F@"
"@@H@@@@@@@@@@@B@"
"@@H@@@@@@@@@@@B@"
"@@H@@@@@@@@@@@B@"
"@@H@@@@@@@@@@@B@"
"@@H@@@@@@@@@@@B@"
"@@H@@@@@@@@@@@B@"
"@@H@@@@@@@@@@@B@"
"@@H@@@@@@@@@@@B@"
"@@L@@@@@@@@@@@C@"
"@@L@@@@@@@@@@@A@"
"@@D@@@@@@@@@@@A@"
"@@D@@@@@@@@@@@A@"
"@@D@@@@@@@@@@@A@"
"@@D@@@@@@@@@@@A@"
"@@D@@@@@@@@@@@A@"
"@@D@@@@@@@@@@@A@"
"@@D@@@@@@@@@@@A@"
"@@D@@@@@@@@@@@A@"
"@@D@@@@@@@@@@@A@"
"@@L@@@@@@@@@@@A@"
"@@H@@@@@@@@@@@A@"
"@@H@@@@@@@@@@@A@"
"@@H@@@@@@@@@@@A@"
"@OOOOOOOOOOOO@A@"
"CH@@@@@@@@@@GLA@"
"F@@@@@@@@@@@LFA@"
"D@@@@@@@@@@AHBA@"
"L@@@@@@@@@@A@FB@"
"H@@@@@@@@@@A@LB@"
"H@@@@@@@@@@AOHD@"
"H@@@@@@@@@@AH@D@"
"L@@@@@@@@@@@H@H@"
"L@@@@@@@@@@@LA@@"
"N@@@@@@@@@@@GF@@"
"CH@@@@@@@@@@AL@@"
"BOOOOOOOOOOOOH@@")
(RPAQ HistoryBitMapMask (READBITMAP))
(64 64
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"AOOOOOOOOOOOOOOH"
"AOOOOOOOOOOOOOOL"
"COOOOOOOOOOOOOON"
"COOOOOOOOOOOOOON"
"COOOOOOOOOOOOOOO"
"COOOOOOOOOOOOOOO"
"COOOOOOOOOOOOOOO"
"COOOOOOOOOOOOOON"
"COOOOOOOOOOOOOON"
"AOOOOOOOOOOOOOOL"
"@OOOOOOOOOOOOOOH"
"@OOOOOOOOOOOOON@"
"@OOOOOOOOOOOOON@"
"@GOOOOOOOOOOOON@"
"@GOOOOOOOOOOOOL@"
"@GOOOOOOOOOOOOL@"
"@COOOOOOOOOOOOL@"
"@COOOOOOOOOOOOL@"
"@COOOOOOOOOOOOL@"
"@AOOOOOOOOOOOOL@"
"@AOOOOOOOOOOOOL@"
"@AOOOOOOOOOOOOL@"
"@AOOOOOOOOOOOOL@"
"@AOOOOOOOOOOOOL@"
"@@OOOOOOOOOOOON@"
"@@OOOOOOOOOOOON@"
"@@OOOOOOOOOOOON@"
"@@OOOOOOOOOOOON@"
"@@OOOOOOOOOOOON@"
"@@OOOOOOOOOOOON@"
"@@OOOOOOOOOOOON@"
"@@OOOOOOOOOOOON@"
"@@OOOOOOOOOOOON@"
"@@OOOOOOOOOOOOO@"
"@@OOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@OOOOOOOOOOOOO@"
"@@OOOOOOOOOOOOO@"
"@@OOOOOOOOOOOOO@"
"@@OOOOOOOOOOOOO@"
"@OOOOOOOOOOOOOO@"
"COOOOOOOOOOOOOO@"
"GOOOOOOOOOOOOOO@"
"GOOOOOOOOOOOOOO@"
"OOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOL@"
"OOOOOOOOOOOOOOL@"
"OOOOOOOOOOOOOOH@"
"OOOOOOOOOOOOOO@@"
"OOOOOOOOOOOOON@@"
"COOOOOOOOOOOOL@@"
"BOOOOOOOOOOOOH@@")
(DECLARE: DONTCOPY
(FILEMAP (NIL (1384 10021 (HistEventString 1394 . 3488) (HistHeldFn 3490 . 3802) (HistMenuOp 3804 .
4949) (HistRightButtonFn 4951 . 5869) (HistoryIcon 5871 . 6533) (HistoryMenu 6535 . 8528) (LastNEvents
8530 . 9085) (UpdateHistory 9087 . 9629) (UpdateHistoryWindow 9631 . 10019)))))
STOP