(FILECREATED "11-Sep-84 11:17:44" {ERIS}<LISPUSERS>HISTMENU.;17 12793
changes to: (VARS HistRightMenu HistoryBitMap HistoryMask)
(FNS LastNEvents)
previous date: "16-May-84 20:50:00" {PHYLUM}<LISPUSERS>HISTMENU.;16)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT HISTMENUCOMS)
(RPAQQ HISTMENUCOMS ((VARS * HISTMENUVARS)
(FNS * HISTMENUFNS)
(BITMAPS HistoryBitMap HistoryMask)
(FILES ICONW)))
(RPAQQ HISTMENUVARS (BadHistoryItems HistDefaultSlice HistItemsShown HistMenuHeight HistMenuWidth
HistOpMenuItems HistRightMenu HistWindowWidth HistEventWidth
UpdateOnDeleteFlg (HistOpMenu)
(HistoryWindow)
(HistoryMenu)))
(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 HistRightMenu {MENU}%#6,101374)
(RPAQQ HistWindowWidth 164)
(RPAQQ HistEventWidth 60)
(RPAQQ UpdateOnDeleteFlg T)
(RPAQQ HistOpMenu NIL)
(RPAQQ HistoryWindow NIL)
(RPAQQ HistoryMenu NIL)
(RPAQQ HISTMENUFNS (HistEventString HistHeldFn HistMenuOp HistRightButtonFn HistoryIcon HistoryMenu
LastNEvents UpdateHistory UpdateHistoryWindow))
(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) (* dgb: "16-May-84 19:42")
(* 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 (ICONW HistoryBitMap HistoryMask iconPosition T)))
(SETQ H (HistoryMenu N histPosition))
(RETURN (SETQ HistoryWindow (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: "11-Sep-84 09:11")
(PROG (ev (i 1))
(RETURN (while (ILESSP i N) bind hist1 (lastN ←(ADD1 (OR (CADR LISPXHISTORY)
0)))
(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
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"AOOOOOOOOOOOOON@"
"AH@@@@@@@@@@@FA@"
"C@@@@@@@@@@@@D@H"
"B@@@@@@@@@@@@L@H"
"B@@@@@@@@@@@@H@D"
"B@@@@@@@@@@@@H@D"
"B@@@@@@@@@@@@H@D"
"B@@@@@@@@@@@@D@H"
"C@@@@@@@@@@@@DDH"
"A@DDA@@@@@@@@CG@"
"AHDD@@@A@@@@@@H@"
"@HDDG@NCLCHKBAH@"
"@HGLAAAA@DDLJBD@"
"@LDDA@LA@DDHBBD@"
"@LDDA@BA@DDHADD@"
"@DDDAAAABDDHADD@"
"@FDDA@N@LCHH@HD@"
"@B@@@@@@@@@@@HD@"
"@B@@@@@@@@@@CHD@"
"@C@@@@@@@@@@@@D@"
"@C@@@@@@@@@@@@D@"
"@A@@@@@@@@@@@@D@"
"@A@@@@@@@@@@@@D@"
"@A@@@@@@@@@@@@D@"
"@AH@@@@@@@@@@@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@"
"AH@@@@@@@@@@GLA@"
"F@@@@@@@@@@@LFA@"
"D@@@@@@@@@@AHBC@"
"L@@@@@@@@@@A@FB@"
"H@@@@@@@@@@A@LF@"
"H@@@@@@@@@@AOHD@"
"H@@@@@@@@@@AH@D@"
"L@@@@@@@@@@@H@H@"
"L@@@@@@@@@@@LA@@"
"N@@@@@@@@@@@GF@@"
"CH@@@@@@@@@@AL@@"
"@OOOOOOOOOOOOH@@")
(RPAQ HistoryMask (READBITMAP))
(64 64
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"AOOOOOOOOOOOOON@"
"AOOOOOOOOOOOOOOH"
"COOOOOOOOOOOOOOH"
"COOOOOOOOOOOOOOL"
"COOOOOOOOOOOOOOL"
"COOOOOOOOOOOOOOL"
"COOOOOOOOOOOOOOL"
"COOOOOOOOOOOOOOL"
"COOOOOOOOOOOOOOL"
"AOOOOOOOOOOOOOOH"
"AOOOOOOOOOOOOON@"
"@OOOOOOOOOOOOON@"
"@OOOOOOOOOOOOOL@"
"@OOOOOOOOOOOOOL@"
"@OOOOOOOOOOOOOL@"
"@GOOOOOOOOOOOOL@"
"@GOOOOOOOOOOOOL@"
"@COOOOOOOOOOOOL@"
"@COOOOOOOOOOOOL@"
"@COOOOOOOOOOOOL@"
"@COOOOOOOOOOOOL@"
"@AOOOOOOOOOOOOL@"
"@AOOOOOOOOOOOOL@"
"@AOOOOOOOOOOOOL@"
"@AOOOOOOOOOOOON@"
"@@OOOOOOOOOOOON@"
"@@OOOOOOOOOOOON@"
"@@OOOOOOOOOOOON@"
"@@OOOOOOOOOOOON@"
"@@OOOOOOOOOOOON@"
"@@GOOOOOOOOOOON@"
"@@GOOOOOOOOOOON@"
"@@GOOOOOOOOOOON@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@GOOOOOOOOOOOO@"
"@@OOOOOOOOOOOOO@"
"@@OOOOOOOOOOOOO@"
"@@OOOOOOOOOOOOO@"
"@@OOOOOOOOOOOOO@"
"@OOOOOOOOOOOOOO@"
"COOOOOOOOOOOOOO@"
"GOOOOOOOOOOOOOO@"
"GOOOOOOOOOOOOOO@"
"OOOOOOOOOOOOOOO@"
"OOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOL@"
"OOOOOOOOOOOOOOL@"
"OOOOOOOOOOOOOOH@"
"OOOOOOOOOOOOOO@@"
"COOOOOOOOOOOOL@@"
"AOOOOOOOOOOOOH@@")
(FILESLOAD ICONW)
(PUTPROPS HISTMENU COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1613 10180 (HistEventString 1623 . 3717) (HistHeldFn 3719 . 4031) (HistMenuOp 4033 .
5178) (HistRightButtonFn 5180 . 6098) (HistoryIcon 6100 . 6674) (HistoryMenu 6676 . 8669) (LastNEvents
8671 . 9244) (UpdateHistory 9246 . 9788) (UpdateHistoryWindow 9790 . 10178)))))
STOP