This is the Histmenu+Manager+Clipboard branch WITHOUT the changes to Clipboard (since there were issues with conflicting key bindings) (#944)
This commit is contained in:
Matt Heffron
GitHub
parent
a387094eab
commit
0474f924a4
@ -1,453 +1,191 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
(FILECREATED "10-Nov-2020 15:57:14" |{DSK}<export>home>denber>lisp>HISTMENU.;40| 28526
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
|changes| |to:| (FNS |HistoryMenu| |UpdateHistoryWindow| |UpdateWistoryWindow|
|
||||
|HistRightButtonFn| |HistMenuOp| |HistMenuMiddle| REMOVENTH)
|
||||
(VARS HISTMENUCOMS HISTCOMS)
|
||||
(FILECREATED "19-Sep-2022 19:20:51" {DSK}<home>matt>medley>LISPUSERS>HISTMENU.;4 16184
|
||||
|
||||
|previous| |date:| "20-Oct-2020 12:02:51" |{DSK}<export>home>denber>lisp>HISTMENU.;1|)
|
||||
:CHANGES-TO (VARS HISTMENUCOMS)
|
||||
(FNS HistMenuOp)
|
||||
|
||||
:PREVIOUS-DATE "15-Sep-2022 21:50:50" {DSK}<home>matt>medley>LISPUSERS>HISTMENU.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984, 1987, 2022 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT HISTMENUCOMS)
|
||||
|
||||
(RPAQQ HISTMENUCOMS ((FNS |HistMenuMiddle| |HistMenuOp| |HistRightButtonFn| |HistoryMenu|
|
||||
REMOVENTH |UpdateHistoryWindow| |UpdateWistoryWindow|)
|
||||
(VARS HISTCOMS)))
|
||||
(RPAQQ HISTMENUCOMS ((VARS * HISTMENUVARS)
|
||||
(INITVARS HistMenuExecOnly)
|
||||
(FNS * HISTMENUFNS)
|
||||
(BITMAPS HistoryBitMap HistoryMask)
|
||||
(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
|
||||
HISTMENU)))
|
||||
|
||||
(RPAQQ HISTMENUVARS (BadHistoryItems HistDefaultSlice HistItemsShown HistMenuItemHeight HistMenuWidth
|
||||
HistOpMenuItems HistWindowWidth HistEventWidth UpdateOnDeleteFlg (
|
||||
HistRightMenu
|
||||
)
|
||||
(HistOpMenu)
|
||||
(HistoryWindow)
|
||||
(HistoryMenu)))
|
||||
|
||||
(RPAQQ BadHistoryItems (EDIT ?= OK T NIL ^))
|
||||
|
||||
(RPAQQ HistDefaultSlice 30)
|
||||
|
||||
(RPAQQ HistItemsShown 51)
|
||||
|
||||
(RPAQQ HistMenuItemHeight 15)
|
||||
|
||||
(RPAQQ HistMenuWidth 164)
|
||||
|
||||
(RPAQQ HistOpMenuItems
|
||||
((REDO 'REDO "REDO event selected")
|
||||
(FIX 'FIX "Edit event selected")
|
||||
(UNDO 'UNDO "UNDO event selected")
|
||||
(?? '?? "Show event selected")
|
||||
(Delete 'Delete "Delete event from history menu")))
|
||||
|
||||
(RPAQQ HistWindowWidth 164)
|
||||
|
||||
(RPAQQ HistEventWidth 60)
|
||||
|
||||
(RPAQQ UpdateOnDeleteFlg T)
|
||||
|
||||
(RPAQQ HistRightMenu NIL)
|
||||
|
||||
(RPAQQ HistOpMenu NIL)
|
||||
|
||||
(RPAQQ HistoryWindow NIL)
|
||||
|
||||
(RPAQQ HistoryMenu NIL)
|
||||
|
||||
(RPAQ? HistMenuExecOnly NIL)
|
||||
|
||||
(RPAQQ HISTMENUFNS (HistEventString HistHeldFn HistMenuOp HistRightButtonFn HistoryIcon HistoryMenu
|
||||
LastNEvents UpdateHistory UpdateHistoryWindow))
|
||||
(DEFINEQ
|
||||
|
||||
(|HistMenuMiddle|
|
||||
(LAMBDA (ITEM MENU KEY)
|
||||
(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)
'(" "))
((LISTGET (CDDDR entry)
'HistoryString))
(T (PROG (newLst key (event (CAR entry))
str)
[COND
[(AND (EQ (SETQ key (CAR event))
'UNDO)
(CDR event))
(* Special form for UNDO. Show form of event that was undone.)
(SETQ event (APPEND event '(" -- ") (CAR (LISPXFIND LISPXHISTORY (CDR event)
'ENTRY]
((FMEMB key BadHistoryItems) (* Not an item to be shown in history)
(NCONC entry (LIST 'HistoryString 'Deleted))
(RETURN '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 '% ]
(TCONC newLst item)
SKIP finally (SETQ str (APPLY '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 'HistoryString str)))
(RETURN str])
|
||||
|
||||
(* |;;| "Actions to take when the middle button is pressed on a History Window menu item.")
|
||||
(* \; "Edited 30-Oct-2020 14:36 by root")
|
||||
(PROG (N) (* PRINT "HistMenuMiddle")
|
||||
(* PRINT ITEM)
|
||||
(RETURN (CADR ITEM)))))
|
||||
(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 (ITEM MENU KEY) (* \; "Edited 4-Nov-2020 19:59 by root")
|
||||
(HistMenuOp
|
||||
[LAMBDA (exp menu key) (* ; "Edited 19-Sep-2022 19:20 by Matt Heffron")
|
||||
(* ; "Edited 15-Sep-2022 21:49 by Matt Heffron")
|
||||
(PROG (op)
|
||||
|
||||
(* |;;| "Process History Window menu items when the user clicks on one.")
|
||||
(* ;; "Stuff the appropriate text into the Exec window.")
|
||||
|
||||
(PROG (NITEMS)
|
||||
(* ;; "Per Michele Denber: Since it actually goes into the window that has the caret, first check to see if the window with focus is an Exec window.")
|
||||
|
||||
(* |;;| "Need to know the number of the item (ie. ITEMNO) the user clicked on in the menu so we can compute the Exec line that corresponds to.")
|
||||
(* ;; "Note the original HISTMENU did not do this.")
|
||||
|
||||
(SETQ ITEMNO (|\\ItemNumber| ITEM (|fetch| (MENU ITEMS) |of| MENU)))
|
||||
(* PRINT ITEMNO)
|
||||
(* SETQ ITEMNO (-
|
||||
ITEMNO 2))
|
||||
(SETQ ITEMEXEC (- LASTEXEC ITEMNO))
|
||||
(COND
|
||||
((NULL (CDR exp))
|
||||
(RETURN))
|
||||
([AND HistMenuExecOnly (NOT (FIXP (STRPOS "EXEC" (PROCESSPROP (TTY.PROCESS)
|
||||
'NAME]
|
||||
|
||||
(* |;;|
|
||||
"This method is needed to stay in sync in case the user deletes an entry form the menu.")
|
||||
(* ;; "It turns out that this check can be too restrictive. ")
|
||||
|
||||
(SETQ ITEMEXEC (CAADAR (NTH |HistoryString| ITEMNO)))
|
||||
(* \;
|
||||
"The exec line of the selected item.")
|
||||
(* ;;
|
||||
"E.g., It wouldn't allow for using the HistMenu in a Break window unless %"under%" an Exec process")
|
||||
|
||||
(* |;;| " Stuff the appropriate text into the Exec window. Since it actually goes into the window that has the caret first check to see if the window with focus is an Exec window. Note the original HISTMENU did not do this.")
|
||||
(* PRINT "HistMenuOp KEY=")
|
||||
(* PRINT KEY)
|
||||
(|if| (NEQ (STRPOS "EXEC" (PROCESSPROP (TTY.PROCESS)
|
||||
'NAME))
|
||||
NIL)
|
||||
|then| (SELECTQ KEY
|
||||
(LEFT (BKSYSBUF (CONCAT "REDO " ITEMEXEC))
|
||||
(BKSYSCHARCODE (CHARCODE CR)))
|
||||
(MIDDLE (SETQ MRET (MENU MMENU))(* \;
|
||||
"Show the middle button menu and return which item was selected.")
|
||||
(* PRINT MRET)
|
||||
(SETQ MRET (CADR MRET))
|
||||
(SELECTQ MRET
|
||||
(REDO (BKSYSBUF (CONCAT "REDO " ITEMEXEC))
|
||||
(BKSYSCHARCODE (CHARCODE CR)))
|
||||
(FIX (BKSYSBUF (CONCAT "FIX " ITEMEXEC))
|
||||
(BKSYSCHARCODE (CHARCODE CR)))
|
||||
(UNDO (BKSYSBUF (CONCAT "UNDO " ITEMEXEC))
|
||||
(BKSYSCHARCODE (CHARCODE CR)))
|
||||
(?? (BKSYSBUF (CONCAT "?? " ITEMEXEC))
|
||||
(BKSYSCHARCODE (CHARCODE CR)))
|
||||
(|Deleted| (* PRINT "DELETE")
|
||||
(* PRINT ITEMNO)
|
||||
(SETQ NITEMS (LENGTH |HistoryString|))
|
||||
(PROMPTPRINT "Please select an Exec window for this action.")
|
||||
(RETURN)))
|
||||
(SELECTQ key
|
||||
(LEFT (SETQ op '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))
|
||||
'ENTRY))
|
||||
'HistoryString
|
||||
'Deleted)
|
||||
(RETURN (AND UpdateOnDeleteFlg (UpdateHistory menu))))
|
||||
(NIL (* ; "nothing selected")
|
||||
(RETURN NIL))
|
||||
(GO DOIT)))
|
||||
(RETURN))
|
||||
DOIT
|
||||
(BKSYSBUF op) (* ;
|
||||
"Insert op space event identifier in system buffer")
|
||||
(BKSYSBUF " ")
|
||||
(BKSYSBUF (CDR exp))
|
||||
(BKSYSCHARCODE (CHARCODE CR))
|
||||
NIL])
|
||||
|
||||
(* |;;|
|
||||
"Remove the selected item from HistoryString:")
|
||||
(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 'HistRightMenu))
(SETQ HistRightMenu (create MENU
ITEMS _ '((Bury 'BURYW "Puts this window on the bottom.")
(Move 'MOVEW "Moves window by a corner.")
(Shrink 'SHRINKW
"Replaces this window with its icon (or title if it doesn't have an icon."
)
(Update 'UpdateHistoryWindow
"Update the window to show all current items"]
(TOTOPW WINDOW)
(PROG (COM)
(RETURN (COND
((SETQ COM (MENU HistRightMenu))
(APPLY* COM WINDOW)
T])
|
||||
|
||||
(SETQ |HistoryString| (REMOVENTH (- ITEMNO 1)
|
||||
|HistoryString|))
|
||||
(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 'UpdateHistoryWindow])
|
||||
|
||||
(* |;;|
|
||||
"Remove the selected item from HMITEMS too so they stay in sync.")
|
||||
(HistoryMenu
|
||||
[LAMBDA (histMenuLength histMenuPosition) (* ; "Edited 15-Sep-2022 21:49 by Matt Heffron")
|
||||
|
||||
(SETQ HMITEMS (REMOVENTH (- ITEMNO 1)
|
||||
HMITEMS))
|
||||
(* ;; "Create a menu showing the last histMenuLength events of history. If histMenuPosition is not given, then allows the user to move window")
|
||||
|
||||
(* |;;| "Now add in the earlier Exec item to the end so that both lists remain histMenuLength long. Ie. if the last item on the last was 734, go find 733 and tack it on the end.")
|
||||
(PROG (W wwidth wregion (wheight (ITIMES HistMenuItemHeight HistItemsShown)))
|
||||
(OR histMenuLength (SETQ histMenuLength HistDefaultSlice))
|
||||
|
||||
(SETQ NBACK (LIST (MINUS (SUB1 NITEMS))))
|
||||
(SETQ |HistoryString| (APPEND |HistoryString|
|
||||
(LISPXFIND
|
||||
LISPXHISTORY NBACK
|
||||
'ENTRIES)))
|
||||
(SETQ HMITEMS
|
||||
(APPEND HMITEMS
|
||||
(LIST (LIST (CAAAR (NTH |HistoryString|
|
||||
NITEMS))))))
|
||||
(* ;; "Default HistorySlice is HistDefaultSlice")
|
||||
|
||||
(* |;;| "And finally update the menu image.")
|
||||
(SETQ HistoryMenu (create MENU
|
||||
ITEMS _ (LastNEvents histMenuLength)
|
||||
ITEMHEIGHT _ HistMenuItemHeight
|
||||
ITEMWIDTH _ HistMenuWidth
|
||||
MENUOUTLINESIZE _ 0
|
||||
WHENSELECTEDFN _ 'HistMenuOp
|
||||
WHENHELDFN _ 'HistHeldFn))
|
||||
(PROGN [PROG ((MD (fetch MENUUSERDATA of HistoryMenu)))
|
||||
(COND
|
||||
((NULL MD)
|
||||
(replace MENUUSERDATA of HistoryMenu with (LIST 'HistorySlice
|
||||
histMenuLength)))
|
||||
(T (LISTPUT MD '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 'RIGHTBUTTONFN 'HistRightButtonFn)
|
||||
(ADDMENU HistoryMenu W (create POSITION
|
||||
XCOORD _ 0
|
||||
YCOORD _ 0)
|
||||
T))
|
||||
HistoryMenu])
|
||||
|
||||
(|replace| ITEMS |of| |HistMenu|
|
||||
|with| HMITEMS)
|
||||
(UPDATE/MENU/IMAGE |HistMenu|)
|
||||
(REDISPLAYW |HistWin|))
|
||||
NIL))
|
||||
(* |;;| "The RIGHTBUTTONFN of the underlying window takes precedence over the WHENSELECTEDFN of the menu filling the window so we do not put a RIGHT button entry here.")
|
||||
(RIGHT (PRINT "HistMenuOp RIGHT")
|
||||
(* SETQ MRET (CAR (MENU
|
||||
|HistRightMenu|)))
|
||||
(SETQ MRET NIL)
|
||||
(PRINT MRET)
|
||||
(SELECTQ MRET
|
||||
(|Bury| (BURYW |HistWin|))
|
||||
(|Move| (MOVEW |HistWin|))
|
||||
(|Shrink| (SHRINKW |HistWin|))
|
||||
(|Update| (|UpdateHistoryWindow|))
|
||||
NIL))
|
||||
NIL)
|
||||
|else| (PROMPTPRINT "Please select the Exec window for this action.")))))
|
||||
(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 'Deleted (SETQ ev (HistEventString hist1]
collect (SETQ i (ADD1 i))
(COND
((OR hist hist1)
(CONS ev (ENTRY# LISPXHISTORY hist1)))
(T '(" "])
|
||||
|
||||
(|HistRightButtonFn|
|
||||
(LAMBDA (WIN) (* \; "Edited 8-Nov-2020 17:01 by root")
|
||||
(PROG (X)
|
||||
(MENU |HistRightMenu|) (* SELECTQ MRET (|Bury|
|
||||
(BURYW |HistWin|))
|
||||
(|Move| (MOVEW |HistWin|))
|
||||
(|Shrink| (SHRINKW |HistWin|))
|
||||
(|Update| (|UpdateHistoryWindow|))
|
||||
NIL)
|
||||
(RETURN WIN))))
|
||||
(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)
'HistorySlice]
(UPDATE/MENU/IMAGE histMenu)
(BLTMENUIMAGE histMenu historyWindow])
|
||||
|
||||
(|HistoryMenu|
|
||||
(LAMBDA (|histMenuLength| |histMenuPosition|) (* \; "Edited 10-Nov-2020 15:56 by root")
|
||||
(PROG (NEGLEN) (* PRINT "Start HistoryMenu")
|
||||
(OR |histMenuLength| (SETQ |histMenuLength| 30))
|
||||
|
||||
(* |;;| "The MIN here is needed in case the user starts HistoryMenu before the history has grown to the requested size.")
|
||||
|
||||
(SETQ ACTUALNITEMS (MIN (CADR LISPXHISTORY)
|
||||
|histMenuLength|))
|
||||
(SETQ NEGLEN (MINUS (MIN |histMenuLength| ACTUALNITEMS)))
|
||||
(SETQ NBACK (LIST -1 `THRU NEGLEN)) (* \; " N.B. backquote!")
|
||||
(* OR |histMenuPosition|
|
||||
(SETQ |histMenuPosition|
|
||||
(QUOTE (LASTMOUSEX LASTMOUSEY 176
|
||||
464))))
|
||||
(SETQ |HistEventWidth| (- (OR (CADDR |histMenuPosition|)
|
||||
178)
|
||||
4))
|
||||
(SETQ |HistoryString| (LISPXFIND LISPXHISTORY NBACK 'ENTRIES))
|
||||
(SETQ HMITEMS (LIST (CAAR |HistoryString|)))
|
||||
(|for| I |from| 2 |to| (MIN |histMenuLength| ACTUALNITEMS)
|
||||
|do| (* PRINT (CAAAR (NTH |HistoryString|
|
||||
I)))
|
||||
(SETQ HMITEMS (APPEND HMITEMS (LIST (LIST (CAAAR (NTH |HistoryString| I)))))))
|
||||
|
||||
(* |;;| "try (CAADAR (NTH HistoryString n)) to get item no.")
|
||||
|
||||
(SETQ MMENU (|create| MENU
|
||||
ITEMS _ '((REDO 'REDO "REDO item selected")
|
||||
(FIX 'FIX "Edit item selected")
|
||||
(UNDO 'UNDO "UNDO event selected")
|
||||
(?? '?? "Show event selected")
|
||||
(|Delete| '|Deleted| "Delete event from history menu"))
|
||||
WHENSELECTEDFN _ '|HistMenuMiddle|))
|
||||
(SETQ |HistRightMenu| (|create| MENU
|
||||
ITEMS _ '((|Bury| (BURYW |HistWin|)
|
||||
"Puts this window on the bottom.")
|
||||
(|Move| (MOVEW |HistWin|)
|
||||
"Moves window by a corner.")
|
||||
(|Shrink| (SHRINKW |HistWin|)
|
||||
|
||||
"Replaces this window with its icon (or title if it doesn't have an icon."
|
||||
)
|
||||
(|Update| (|UpdateHistoryWindow|)
|
||||
|
||||
"Update the window to show all current items."
|
||||
)))) (* SETQ |HistWin| (CREATEW
|
||||
(QUOTE (50 100 172 382))
|
||||
"History Window"))
|
||||
(SETQ |HistMenu| (|create| MENU
|
||||
ITEMS _ HMITEMS
|
||||
MENUROWS _ |histMenuLength|
|
||||
ITEMWIDTH _ |HistEventWidth|
|
||||
WHENSELECTEDFN _ '|HistMenuOp|
|
||||
MENUOUTLINESIZE _ 0))
|
||||
|
||||
(* |;;| " Remember the last Exec line no. so we know which one to FIX, etc.")
|
||||
|
||||
(SETQ LASTEXEC (CAR (HISTORY-NTH LISPXHISTORY 2)))
|
||||
(SETQ LASTEXEC (- LASTEXEC 2)) (* SETQ |HistRightButtonFn| NIL)
|
||||
(SETQ |HistWin| (ADDMENU |HistMenu| NIL |histMenuPosition|))
|
||||
(OR |histMenuPosition| (MOVEW |HistWin|))
|
||||
(WINDOWPROP |HistWin| 'RIGHTBUTTONFN '|HistRightButtonFn|)
|
||||
(WINDOWPROP |HistWin| 'TITLE "History Window")
|
||||
(WINDOWPROP |HistWin| 'BORDER 4) (* CREATEMENUEDWINDOW PUTMENUPROP
|
||||
UPDATE/MENU/IMAG WINDOWPROP HWIN
|
||||
(QUOTE RIGHTBUTTONFN)
|
||||
|HistRightButtonFn|)
|
||||
(RETURN HWIN))))
|
||||
|
||||
(REMOVENTH
|
||||
(LAMBDA (N LIST) (* \; "Edited 27-Oct-2020 16:15 by root")
|
||||
|
||||
(* |;;| "Return LIST with the Nth element removed.")
|
||||
|
||||
(|if| (OR (ZEROP N)
|
||||
(NULL LIST))
|
||||
|then| (CDR LIST)
|
||||
|else| (CONS (CAR LIST)
|
||||
(REMOVENTH (CL:1- N)
|
||||
(CDR LIST))))))
|
||||
|
||||
(|UpdateHistoryWindow|
|
||||
(LAMBDA (NEGLEN) (* \; "Edited 10-Nov-2020 15:53 by root")
|
||||
(PROG (NITEMS)
|
||||
(SETQ NITEMS (LENGTH (|fetch| ITEMS |of| |HistMenu|)))
|
||||
|
||||
(* |;;| "Need this in case HistoryMenu was started before the requested size was reached,")
|
||||
|
||||
(SETQ ACTUALNITEMS (ADD1 (MIN (CADR LISPXHISTORY)
|
||||
NITEMS)))
|
||||
(SETQ NEGLEN (MINUS ACTUALNITEMS))
|
||||
(SETQ NBACK (LIST -2 `THRU NEGLEN))
|
||||
(SETQ |HistoryString| (LISPXFIND LISPXHISTORY NBACK 'ENTRIES))
|
||||
(SETQ HMITEMS (LIST (CAAR |HistoryString|)))
|
||||
|
||||
(* |;;| "Make sure LASTEXEC again points to the most recent event since that has now changed.")
|
||||
|
||||
(SETQ LASTEXEC (CAR (HISTORY-NTH LISPXHISTORY 2)))
|
||||
(SETQ LASTEXEC (- LASTEXEC 2))
|
||||
(|for| I |from| 2 |to| ACTUALNITEMS
|
||||
|do| (SETQ HMITEMS (APPEND HMITEMS (LIST (LIST (CAAAR (NTH |HistoryString| I)))))))
|
||||
(|replace| ITEMS |of| |HistMenu| |with| HMITEMS)
|
||||
(UPDATE/MENU/IMAGE |HistMenu|)
|
||||
(WINDOWPROP |HistWin| 'BORDER 4)
|
||||
(REDISPLAYW |HistWin|))))
|
||||
|
||||
(|UpdateWistoryWindow|
|
||||
(LAMBDA NIL
|
||||
(PROG (N)
|
||||
NIL)))
|
||||
(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 'MENU])
|
||||
)
|
||||
|
||||
(RPAQQ HISTCOMS
|
||||
((FNS PRINTHISTORY ENTRY# PRINTHISTORY1 PRINTHISTORY2)
|
||||
(FNS EVALQT ENTEREVALQT USEREXEC LISPXREAD LISPXREADBUF LISPXREADP LISPXUNREAD LISPX LISPX/
|
||||
LISPX/1 LISPXEVAL LISPXSTOREVALUE HISTORYSAVE LISPXFIND LISPXGETINPUT REMEMBER
|
||||
GETEXPRESSIONFROMEVENTSPEC LISPXFIND0 LISPXFIND1 HISTORYFIND HISTORYFIND1 HISTORYMATCH
|
||||
VALUEOF VALUOF VALUOF-EVENT LISPXUSE LISPXUSE0 LISPXUSE1 LISPXSUBST LISPXUSEC LISPXFIX
|
||||
CHANGESLICE LISPXSTATE LISPXTYPEAHEAD)
|
||||
(ALISTS (SYSTEMINITVARS LISPXHISTORY GREETHIST))
|
||||
(DECLARE\: DONTEVAL@LOAD DOCOPY (VARS (\#REDOCNT 3)
|
||||
(ARCHIVEFLG T)
|
||||
(ARCHIVEFN)
|
||||
(ARCHIVELST '(NIL 0 50 100))
|
||||
(DISPLAYTERMFLG)
|
||||
(EDITHISTORY '(NIL 0 30 100))
|
||||
(HERALDSTRING)
|
||||
(LASTEXEC)
|
||||
(LASTHISTORY)
|
||||
(LISPXBUFS)
|
||||
(LISPXHIST)
|
||||
(LISPXHISTORY '(NIL 0 30 100))
|
||||
(LISPXPRINTFLG T)
|
||||
(LISPXUSERFN)
|
||||
(MAKESYSDATE)
|
||||
(PROMPT#FLG T)
|
||||
(REDOCNT)
|
||||
(SYSOUT.EXT 'SYSOUT)
|
||||
(SYSOUTFILE 'WORK)
|
||||
(SYSOUTGAG)
|
||||
(TOPLISPXBUFS)))
|
||||
(LISPXMACROS SHH RETRIEVE BEFORE AFTER OK REMEMBER\: REMEMBER TYPE-AHEAD ??T)
|
||||
(ADDVARS (LISPXFINDSPLST FROM TO THRU SUCHTHAT ALL AND)
|
||||
(BEFORESYSOUTFORMS (SETQ SYSOUTDATE (DATE))
|
||||
(PROGN (COND ((NULL FILE)
|
||||
(SETQ FILE SYSOUTFILE))
|
||||
(T (SETQ SYSOUTFILE (PACKFILENAME 'VERSION NIL 'BODY FILE))))
|
||||
(COND ((AND (NULL (FILENAMEFIELD FILE 'EXTENSION))
|
||||
(NULL (FILENAMEFIELD FILE 'VERSION)))
|
||||
(SETQ FILE (PACKFILENAME 'BODY FILE 'EXTENSION SYSOUT.EXT))))))
|
||||
(RESETFORMS (SETQ READBUF NIL)
|
||||
(SETQ READBUFSOURCE NIL)
|
||||
(SETQ TOPLISPXBUFS (OR (CLBUFS T)
|
||||
TOPLISPXBUFS))
|
||||
(COND ((EQ CLEARSTKLST T)
|
||||
(COND ((EQ NOCLEARSTKLST NIL)
|
||||
(CLEARSTK))
|
||||
(T (* |clear| |all| |stack| |pointers| EXCEPT |those| |on|
|
||||
NOCLEARSTKLST.)
|
||||
(MAPC (CLEARSTK T)
|
||||
(FUNCTION (LAMBDA (X)
|
||||
(AND (NOT (FMEMB X NOCLEARSTKLST))
|
||||
(RELSTK X))))))))
|
||||
(T (MAPC CLEARSTKLST (FUNCTION RELSTK))
|
||||
(SETQ CLEARSTKLST NIL))))
|
||||
(HISTORYSAVEFORMS)
|
||||
(LISPXCOMS |...| ?? FIX FORGET NAME ORIGINAL REDO REPEAT RETRY UNDO USE |fix|
|
||||
|forget| |name| |redo| |repeat| |retry| |undo| |use|)
|
||||
(SYSTATS (LISPXSTATS LISPX INPUTS)
|
||||
(UNDOSAVES UNDO SAVES)
|
||||
(UNDOSTATS CHANGES UNDONE)
|
||||
NIL
|
||||
(EDITCALLS CALLS TO EDITOR)
|
||||
(EDITSTATS EDIT COMMANDS)
|
||||
(EDITEVALSTATS COMMANDS INVOLVING EVALUATING A LISP EXPRESSION)
|
||||
(EDITESTATS USES OF AN E COMMAND TYPED IN DIRECTLY)
|
||||
(EDITISTATS USES OF AN I COMMAND TYPED IN DIRECTLY)
|
||||
(EDITUNDOSAVES EDIT UNDO SAVES)
|
||||
(EDITUNDOSTATS EDIT CHANGES UNDONE)
|
||||
NIL
|
||||
(P.A.STATS P.A. COMMANDS)
|
||||
NIL
|
||||
(CLISPIFYSTATS CALLS TO CLISPIFY)
|
||||
NIL
|
||||
(FIXCALLS CALLS TO DWIM)
|
||||
(FIXTIME)
|
||||
(ERRORCALLS WERE DUE TO ERRORS)
|
||||
(DWIMIFYFIXES WERE FROM DWIMIFYING)
|
||||
NIL "OF THOSE DUE TO ERRORS:" (TYPEINFIXES WERE DUE TO ERRORS IN TYPE-IN)
|
||||
(PROGFIXES WERE DUE TO ERRORS IN USER PROGRAMS)
|
||||
(SUCCFIXES1 OF THESE CALLS WERE SUCCESSFUL)
|
||||
NIL "OF THE CALLS DUE TO DWIMIFYING:" (SUCCFIXES2 WERE SUCCESSFUL)
|
||||
NIL
|
||||
(SPELLSTATS OF ALL DWIM CORRECTIONS WERE SPELLING CORRECTIONS)
|
||||
(CLISPSTATS WERE CLISP TRANSFORMATIONS)
|
||||
(INFIXSTATS OF THESE WERE INFIX TRANSFORMATIONS)
|
||||
(IFSTATS WERE IF/THEN/ELSE STATEMENTS)
|
||||
(I.S.STATS WERE ITERATIVE STATEMENTS)
|
||||
(MATCHSTATS WERE PATTERN MATCHES)
|
||||
(RECORDSTATS WERE RECORD OPERATIONS)
|
||||
NIL
|
||||
(SPELLSTATS1 OTHER SPELLING CORRECTIONS\, E.G. EDIT COMMANDS)
|
||||
NIL
|
||||
(RUNONSTATS OF ALL SPELLING CORRECTIONS WERE RUN-ON CORRECTIONS)
|
||||
NIL
|
||||
(VETOSTATS CORRECTIONS WERE VETOED)
|
||||
NIL)
|
||||
(NOCLEARSTKLST))
|
||||
(APPENDVARS (AFTERSYSOUTFORMS (COND ((LISTP SYSOUTGAG)
|
||||
(EVAL SYSOUTGAG))
|
||||
(SYSOUTGAG)
|
||||
((OR (NULL USERNAME)
|
||||
(EQ USERNAME (USERNAME NIL T)))
|
||||
(TERPRI T)
|
||||
(PRIN1 HERALDSTRING T)
|
||||
(TERPRI T)
|
||||
(TERPRI T)
|
||||
(GREET0)
|
||||
(TERPRI T))
|
||||
(T (LISPXPRIN1 '"****ATTENTION USER " T)
|
||||
(LISPXPRIN1 (USERNAME)
|
||||
T)
|
||||
(LISPXPRIN1 '":
|
||||
this sysout is initialized for user " T)
|
||||
(LISPXPRIN1 USERNAME T)
|
||||
(LISPXPRIN1 '".
|
||||
" T)
|
||||
(LISPXPRIN1 '"To reinitialize, type GREET()
|
||||
" T)))
|
||||
(SETINITIALS)))
|
||||
(P (MAPC SYSTATS (FUNCTION (LAMBDA (X)
|
||||
(AND (LISTP X)
|
||||
(EQ (GETTOPVAL (CAR X))
|
||||
'NOBIND)
|
||||
(SETTOPVAL (CAR X)
|
||||
NIL)))))
|
||||
(PUTD 'E))
|
||||
(COMS (FNS GREET GREET0)
|
||||
(ADDVARS (PREGREETFORMS (DREMOVE GREETFORM RESETFORMS)
|
||||
(SETQ CONSOLETIME (SETQ CPUTIME (SETQ EDITIME 0)))
|
||||
(SETQ CONSOLETIME0 (CLOCK 0))
|
||||
(SETQ CPUTIME0 (CLOCK 2)))
|
||||
(POSTGREETFORMS (SETINITIALS)
|
||||
(AND EDITCHARACTERS (APPLY 'SETTERMCHARS EDITCHARACTERS))))
|
||||
(DECLARE\: DONTEVAL@LOAD DOCOPY (VARS (GREETHIST)
|
||||
(SYSTEMTYPE)
|
||||
(GREETFORM '(LISPXEVAL '(GREET)
|
||||
'_))
|
||||
(CUTEFLG)
|
||||
(GREETDATES '((" 1-JAN" . "Happy new year")
|
||||
("12-FEB"
|
||||
. "Happy Lincoln's birthday")
|
||||
("14-FEB"
|
||||
. "Happy Valentine's day")
|
||||
("22-FEB"
|
||||
. "Happy Washington's birthday")
|
||||
("15-MAR"
|
||||
. "Beware the Ides of March")
|
||||
("17-MAR"
|
||||
. "Happy St. Patrick's day")
|
||||
("18-MAY" . "It's Victoria Day")
|
||||
(" 1-JUL" . "It's Canada Day")
|
||||
("31-OCT" . "Trick or Treat")
|
||||
(" 5-NOV"
|
||||
. "<boom> it's Guy Fawkes day")
|
||||
("25-DEC" . "Merry Christmas")))
|
||||
(USERNAME)
|
||||
(HOSTNAME)
|
||||
(CONSOLETIME 0)
|
||||
(CONSOLETIME0 0)
|
||||
(CPUTIME 0)
|
||||
(CPUTIME0 0)
|
||||
(EDITIME 0)
|
||||
(FIRSTNAME))
|
||||
(ADDVARS (BEFOREMAKESYSFORMS (SETQ RESETFORMS (CONS GREETFORM RESETFORMS))
|
||||
(SETQ MAKESYSDATE (DATE))))
|
||||
(ADDVARS (AFTERMAKESYSFORMS (LISPXEVAL '(GREET)
|
||||
'_)))))
|
||||
(FNS LISPXPRINT LISPXPRIN1 LISPXPRIN2 LISPXPRINTDEF LISPXPRINTDEF0 LISPXSPACES LISPXTERPRI
|
||||
LISPXTAB USERLISPXPRINT LISPXPUT)
|
||||
(GLOBALVARS \#REDOCNT ARCHIVEFLG ARCHIVEFN ARCHIVELST BOUNDPDUMMY BREAKRESETVALSLST
|
||||
CAR/CDRNIL CHCONLST1 CLEARSTKLST CLISPARRAY CLISPCHARS CLISPFLG CLISPTRANFLG
|
||||
CONSOLETIME CONSOLETIME0 CPUTIME CPUTIME0 CTRLUFLG CUTEFLG DISPLAYTERMFLG DWIMFLG
|
||||
EDITHISTORY EDITIME EDITQUIETFLG EDITSTATS EVALQTFORMS FILERDTBL FIRSTNAME GREETDATES
|
||||
GREETHIST HISTORYCOMS HISTORYSAVEFN HISTORYSAVEFORMS HISTSTR0 HISTSTR2 HISTSTR3 IT
|
||||
LASTHISTORY LISP-RELEASE-VERSION LISPXBUFS LISPXCOMS LISPXFINDSPLST LISPXFNS
|
||||
LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS LISPXPRINTFLG LISPXREADFN LISPXSTATS
|
||||
LISPXUSERFN MACSCRATCHSTRING NEWUSERFLG P.A.STATS POSTGREETFORMS PREGREETFORMS
|
||||
PRETTYHEADER RANDSTATE READBUFSOURCE REDOCNT REREADFLG RESETFORMS SYSFILES
|
||||
TOPLISPXBUFS USERHANDLE USERNAME)
|
||||
(VARS (LISP-RELEASE-VERSION 2.0))
|
||||
(BLOCKS (LISPXFINDBLOCK LISPXFIND LISPXFIND0 LISPXFIND1 HISTORYFIND HISTORYFIND1
|
||||
(ENTRIES LISPXFIND HISTORYFIND)
|
||||
(LOCALFREEVARS _FLG L LST Z =FLG HISTORYFLG PREDFLG LINE HISTORY TYPE BACKUP
|
||||
QUIETFLG)
|
||||
(NOLINKFNS HISTORYMATCH LISPXGETINPUT))
|
||||
(NIL ENTRY# EVALQT GETEXPRESSIONFROMEVENTSPEC GREET GREET0 HISTORYMATCH HISTORYSAVE
|
||||
LISPX LISPX/ LISPX/1 LISPXEVAL LISPXFIND1 LISPXGETINPUT LISPXPRIN1 LISPXPRIN2
|
||||
LISPXPRINT LISPXPRINTDEF LISPXPRINTDEF0 LISPXPUT LISPXREAD LISPXREADBUF
|
||||
LISPXREADP LISPXSPACES LISPXSTOREVALUE LISPXSUBST LISPXTAB LISPXTERPRI
|
||||
LISPXTYPEAHEAD LISPXUNREAD LISPXUSE LISPXUSE0 LISPXUSE1 LISPXUSEC PRINTHISTORY
|
||||
PRINTHISTORY1 PRINTHISTORY2 USEREXEC USERLISPXPRINT VALUEOF VALUOF (LOCALVARS
|
||||
. T)
|
||||
(SPECVARS LISPXLINE LISPXID LISPXVALUE LISPXLISTFLG HISTORY ID EVENT
|
||||
BREAKRESETVALS VARS GENLST INITLST NAME MESSAGE)
|
||||
(LINKFNS . T)
|
||||
(NOLINKFNS LISPXTYPEAHEAD UNDOLISPX ARCHIVEFN LISPXFIX LISPXUSE LISPXUSE0
|
||||
LISPXSUBST LISPXFIND HISTORYMATCH PRINTHISTORY DISPLAYTERMP
|
||||
LISPXSTOREVALUE HISTORYSAVEFN ENTEREVALQT PRINTHISTORY1 PRINTHISTORY2
|
||||
LISPXFIND HISTORYMATCH LISPXGETINPUT LISPXSUBST ARCHIVEFN LISPXFIX
|
||||
LISPXUSE LISPXUSE0 LISPXSUBST HISTORYMATCH PRINTHISTORY DISPLAYTERMP
|
||||
LISPXSTOREVALUE HISTORYSAVEFN ENTEREVALQT LISPXTYEAHEAD UNDOLISPX
|
||||
GREETFILENAME)))
|
||||
(DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA VALUEOF)
|
||||
(NLAML)
|
||||
(LAMA)))))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (731 14594 (|HistMenuMiddle| 741 . 1200) (|HistMenuOp| 1202 . 7581) (|HistRightButtonFn|
|
||||
7583 . 8274) (|HistoryMenu| 8276 . 12906) (REMOVENTH 12908 . 13307) (|UpdateHistoryWindow| 13309 .
|
||||
14523) (|UpdateWistoryWindow| 14525 . 14592)))))
|
||||
(RPAQQ HistoryBitMap #*(64 64)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AOOOOOOOOOOOOON@AH@@@@@@@@@@@FA@C@@@@@@@@@@@@D@HB@@@@@@@@@@@@L@HB@@@@@@@@@@@@H@DB@@@@@@@@@@@@H@DB@@@@@@@@@@@@H@DB@@@@@@@@@@@@D@HC@@@@@@@@@@@@DDHA@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@@
|
||||
)
|
||||
|
||||
(RPAQQ HistoryMask #*(64 64)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AOOOOOOOOOOOOON@AOOOOOOOOOOOOOOHCOOOOOOOOOOOOOOHCOOOOOOOOOOOOOOLCOOOOOOOOOOOOOOLCOOOOOOOOOOOOOOLCOOOOOOOOOOOOOOLCOOOOOOOOOOOOOOLCOOOOOOOOOOOOOOLAOOOOOOOOOOOOOOHAOOOOOOOOOOOOON@@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@@
|
||||
)
|
||||
|
||||
(PUTPROPS HISTMENU FILETYPE :TCOMPL)
|
||||
|
||||
(PUTPROPS HISTMENU MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
|
||||
(PUTPROPS HISTMENU COPYRIGHT ("Xerox Corporation" 1984 1987 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2110 13830 (HistEventString 2120 . 5316) (HistHeldFn 5318 . 5703) (HistMenuOp 5705 .
|
||||
8071) (HistRightButtonFn 8073 . 9172) (HistoryIcon 9174 . 9723) (HistoryMenu 9725 . 12138) (
|
||||
LastNEvents 12140 . 12957) (UpdateHistory 12959 . 13498) (UpdateHistoryWindow 13500 . 13828)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@ -1,23 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "10-Feb-2022 22:17:51" {DSK}<home>larry>medley>lispusers>MANAGER.;4 111722
|
||||
(FILECREATED "15-Sep-2022 23:39:36" {DSK}<home>matt>medley>LISPUSERS>MANAGER.;2 111145
|
||||
|
||||
:CHANGES-TO (ADVICE (MARKASCHANGED :IN DEFAULT.EDITDEFA0001)
|
||||
LOADFNS LOAD \ADDTOFILEBLOCK/ADDNEWCOM DELFROMCOMS ADDTOCOMS UPDATEFILES
|
||||
UNMARKASCHANGED MARKASCHANGED MAKEFILE ADDTOFILES? ADDFILE)
|
||||
(VARS MANAGERCOMS)
|
||||
(FNS Manager.DO.COMMAND Manager.HIGHLIGHT Manager.PROMPT Manager.WINDOW
|
||||
Manager.insurefilehighlights Manager.CHANGED? Manager.CHECKFILE
|
||||
Manager.COLLECTCOMS Manager.COMS.WSF Manager.COMSOPEN Manager.COMSUPDATE
|
||||
Manager.HIGHLIGHTED Manager.INSUREHIGHLIGHTS Manager.FILECHANGES
|
||||
Manager.FILELSTCHANGED? Manager.FILESUBTYPES Manager.GET.ENVIRONMENT
|
||||
Manager.GETFILE Manager.INTITLE? Manager.MAIN.WSF Manager.MAINCLOSE
|
||||
Manager.MAINMENUITEMS Manager.MAINOPEN Manager.MAINUPDATE Manager.MAKEFILE.ADV
|
||||
Manager.MENUCOLUMNS Manager.MENUHASITEM Manager.MENUITEMS
|
||||
Manager.REMOVE.DUPLICATE.ADVICE Manager.RESETSUBITEMS Manager.SORT.COMS
|
||||
Manager.SORTBYCOLUMN)
|
||||
:CHANGES-TO (FNS Manager.DO.COMMAND)
|
||||
|
||||
:PREVIOUS-DATE "18-Nov-87 15:18:24" |{POGO:AISNORTH:XEROX}<FISCHER>WORK>MANAGER.;2|)
|
||||
:PREVIOUS-DATE "10-Feb-2022 22:17:51" {DSK}<home>matt>medley>LISPUSERS>MANAGER.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@ -536,7 +523,10 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
UPDATEFILES])
|
||||
|
||||
(Manager.DO.COMMAND
|
||||
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 18-Nov-87 14:30 by raf")
|
||||
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 15-Sep-2022 23:35 by Matt Heffron")
|
||||
(* ; "Edited 15-Sep-2022 23:32 by Matt Heffron")
|
||||
(* ; "Edited 15-Sep-2022 23:19 by Matt Heffron")
|
||||
(* ; "Edited 18-Nov-87 14:30 by raf")
|
||||
(if (EQ COMSTYPE 'FILEVARS)
|
||||
then (SETQ COMSTYPE 'VARS) (* ; "The Manager currently does unnatural things with the FILEVARS type, this is a hack to compensate for it. E.g., editing a FILEVARS = editing the VARS, etc.")
|
||||
)
|
||||
@ -730,12 +720,14 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
else (* ; "single item")
|
||||
(UNMARKASCHANGED ITEM COMSTYPE)))
|
||||
(SEE (FB.FASTSEE.ONEFILE
|
||||
FILE
|
||||
(LET [(W (CREATEW NIL (CONCAT "Seeing " FILE "..."]
|
||||
(DSPSCROLL 'ON W)
|
||||
(WINDOWPROP W 'PAGEFULLFN 'FB.SEEFULLFN)
|
||||
(TTYDISPLAYSTREAM W)
|
||||
W)))
|
||||
NIL FILE (LET [(W (CREATEW NIL (CONCAT "Seeing " FILE
|
||||
"..."]
|
||||
(DSPSCROLL 'ON W)
|
||||
(WINDOWPROP W 'PAGEFULLFN
|
||||
'FB.SEEFULLFN)
|
||||
(TTYDISPLAYSTREAM W)
|
||||
W)))
|
||||
(TEDIT-SEE (TEDIT-SEE FILE))
|
||||
(LOAD
|
||||
(printout T .FONT LAMBDAFONT "Loading file " FILE "."
|
||||
.FONT DEFAULTFONT T)
|
||||
@ -1756,18 +1748,18 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
)
|
||||
(PUTPROPS MANAGER COPYRIGHT ("Xerox Corporation" 1986 1987 1900 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (25538 101851 (MANAGER 25548 . 26347) (MANAGER.RESET 26349 . 27863) (Manager.ADDADV
|
||||
27865 . 29218) (Manager.ADDTOFILES? 29220 . 29498) (Manager.ALTERMARKING 29500 . 31110) (
|
||||
Manager.DO.COMMAND 31112 . 62332) (Manager.HIGHLIGHT 62334 . 62631) (Manager.PROMPT 62633 . 62946) (
|
||||
Manager.WINDOW 62948 . 63581) (Manager.insurefilehighlights 63583 . 64654) (Manager.CHANGED? 64656 .
|
||||
65205) (Manager.CHECKFILE 65207 . 66306) (Manager.COLLECTCOMS 66308 . 67746) (Manager.COMS.WSF 67748
|
||||
. 70418) (Manager.COMSOPEN 70420 . 75158) (Manager.COMSUPDATE 75160 . 76252) (Manager.HIGHLIGHTED
|
||||
76254 . 76560) (Manager.INSUREHIGHLIGHTS 76562 . 77120) (Manager.FILECHANGES 77122 . 77421) (
|
||||
Manager.FILELSTCHANGED? 77423 . 77751) (Manager.FILESUBTYPES 77753 . 78391) (Manager.GET.ENVIRONMENT
|
||||
78393 . 80931) (Manager.GETFILE 80933 . 83247) (Manager.INTITLE? 83249 . 83927) (Manager.MAIN.WSF
|
||||
83929 . 86573) (Manager.MAINCLOSE 86575 . 87685) (Manager.MAINMENUITEMS 87687 . 88764) (
|
||||
Manager.MAINOPEN 88766 . 94142) (Manager.MAINUPDATE 94144 . 94780) (Manager.MAKEFILE.ADV 94782 . 95818
|
||||
) (Manager.MENUCOLUMNS 95820 . 96624) (Manager.MENUHASITEM 96626 . 96983) (Manager.MENUITEMS 96985 .
|
||||
97230) (Manager.REMOVE.DUPLICATE.ADVICE 97232 . 98838) (Manager.RESETSUBITEMS 98840 . 100077) (
|
||||
Manager.SORT.COMS 100079 . 100611) (Manager.SORTBYCOLUMN 100613 . 101849)))))
|
||||
(FILEMAP (NIL (24415 101274 (MANAGER 24425 . 25224) (MANAGER.RESET 25226 . 26740) (Manager.ADDADV
|
||||
26742 . 28095) (Manager.ADDTOFILES? 28097 . 28375) (Manager.ALTERMARKING 28377 . 29987) (
|
||||
Manager.DO.COMMAND 29989 . 61755) (Manager.HIGHLIGHT 61757 . 62054) (Manager.PROMPT 62056 . 62369) (
|
||||
Manager.WINDOW 62371 . 63004) (Manager.insurefilehighlights 63006 . 64077) (Manager.CHANGED? 64079 .
|
||||
64628) (Manager.CHECKFILE 64630 . 65729) (Manager.COLLECTCOMS 65731 . 67169) (Manager.COMS.WSF 67171
|
||||
. 69841) (Manager.COMSOPEN 69843 . 74581) (Manager.COMSUPDATE 74583 . 75675) (Manager.HIGHLIGHTED
|
||||
75677 . 75983) (Manager.INSUREHIGHLIGHTS 75985 . 76543) (Manager.FILECHANGES 76545 . 76844) (
|
||||
Manager.FILELSTCHANGED? 76846 . 77174) (Manager.FILESUBTYPES 77176 . 77814) (Manager.GET.ENVIRONMENT
|
||||
77816 . 80354) (Manager.GETFILE 80356 . 82670) (Manager.INTITLE? 82672 . 83350) (Manager.MAIN.WSF
|
||||
83352 . 85996) (Manager.MAINCLOSE 85998 . 87108) (Manager.MAINMENUITEMS 87110 . 88187) (
|
||||
Manager.MAINOPEN 88189 . 93565) (Manager.MAINUPDATE 93567 . 94203) (Manager.MAKEFILE.ADV 94205 . 95241
|
||||
) (Manager.MENUCOLUMNS 95243 . 96047) (Manager.MENUHASITEM 96049 . 96406) (Manager.MENUITEMS 96408 .
|
||||
96653) (Manager.REMOVE.DUPLICATE.ADVICE 96655 . 98261) (Manager.RESETSUBITEMS 98263 . 99500) (
|
||||
Manager.SORT.COMS 99502 . 100034) (Manager.SORTBYCOLUMN 100036 . 101272)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user