Eliminate duplicate declarations for TABLEBROWSER record, remove TABLEBROWSERDECLS file (#877)
* Eliminate duplicate declarations for TABLEBROWSER record, remove TABLEBROWSERDECLS file * change packages that used to load TABEBROWSERDECLS SOURCE to just LOADCOMP TABLEBROWSER * make sure full RECORD is saved * ARCHIVETOOL update of ARCHIVEBROWSER but no docs and looks like PARC-only
This commit is contained in:
Larry Masinter
GitHub
@@ -1,506 +0,0 @@
|
||||
(FILECREATED " 4-Mar-87 17:04:08" {PHYLUM}<LISPUSERS>KOTO>ARCHIVEBROWSER.;3 28150
|
||||
|
||||
changes to: (VARS ARCHIVEBROWSERCOMS) (FNS AB.Delete.Command AB.Retrieve.Command
|
||||
AB.Retrieve.Directory.Command AB.Retrieve.Renamed.Aux AB.Undelete.Command AB ARCHIVEBROWSER
|
||||
AB.Make.Cedar.Filename AB.Retrieve.Renamed.Command)
|
||||
|
||||
previous date: "22-Sep-86 13:12:01" {QV}<BRIGGS>LISP>ARCHIVEBROWSER.;4)
|
||||
|
||||
|
||||
(* Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.)
|
||||
|
||||
(PRETTYCOMPRINT ARCHIVEBROWSERCOMS)
|
||||
|
||||
(RPAQQ ARCHIVEBROWSERCOMS ((* * the user's interface to the archive browser) (FNS ARCHIVEBROWSER AB)
|
||||
(* * command processing functions) (FNS AB.When.Selected.Fn AB.Command.Fn AB.Delete.Command
|
||||
AB.Expunge.Command AB.Filter.Command AB.Recompute.Command AB.Retrieve.Command
|
||||
AB.Retrieve.Directory.Command AB.Retrieve.Renamed.Command AB.Retrieve.Renamed.Aux AB.Sort.Command
|
||||
AB.Undelete.Command) (* * miscellaneous functions) (FNS AB.Set.Browser.Title AB.Iconfn AB.Closefn
|
||||
AB.Printfn AB.Prompt.For.Input AB.Read.Directory AB.Subitemp AB.Make.Cedar.Filename) (* * the user
|
||||
that gets retrieval requests) (INITVARS (AB.archivist "Archivist")) (* * the structure for an archive
|
||||
entry) (RECORDS AB.item) (* * the icon) (BITMAPS AB.icon AB.icon.mask) (INITVARS (AB.titled.icon (
|
||||
create TITLEDICON ICON _ AB.icon MASK _ AB.icon.mask TITLEREG _ (CREATEREGION 7 8 60 24)))) (* * the
|
||||
font for the browser, which must be a fixed pitch font for now) (VARS (AB.browser.font (FONTCREATE (
|
||||
QUOTE TERMINAL) 10))) (* * based on the TableBrowser package) (FILES TABLEBROWSER) (DECLARE:
|
||||
EVAL@COMPILE DONTCOPY (FILES TABLEBROWSERDECLS)) (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
|
||||
COMPILERVARS (ADDVARS (NLAMA AB) (NLAML) (LAMA)))))
|
||||
(* * the user's interface to the archive browser)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(ARCHIVEBROWSER
|
||||
(LAMBDA (archivefilespec filter) (* N.H.Briggs " 2-Mar-87 16:56") (LET* ((menu (create MENU ITEMS _ (
|
||||
QUOTE ((Retrieve AB.Retrieve.Command "Retrieve selected files" (SUBITEMS ("Retrieve selected files"
|
||||
AB.Retrieve.Command "Retrieve selected files") ("Retrieve to directory" AB.Retrieve.Directory.Command
|
||||
"Retrieve selected files to a different directory") ("Retrieve renamed" AB.Retrieve.Renamed.Command
|
||||
"Retrieve selected files specifying new name for each file"))) (Filter AB.Filter.Command
|
||||
"Set filter for displayed file names") (Sort AB.Sort.Command "Sort entries by file name" (SUBITEMS (
|
||||
"Sort by file name" AB.Sort.Command "Sort entries by file name") ("Sort by creation date" (
|
||||
AB.Sort.Command CreationDate) "Sort entries by creation date of the file") ("Sort by archive date" (
|
||||
AB.Sort.Command Archive) "Sort entries by date that the file was archived") (Reverse (AB.Sort.Command
|
||||
Reverse) "Reverse the order of the entries"))) (Recompute AB.Recompute.Command
|
||||
"Redisplay browser items after re-reading archive directory" (SUBITEMS ("Same directory"
|
||||
AB.Recompute.Command "Redisplay browser items after re-reading archive directory") ("New directory" (
|
||||
AB.Recompute.Command T) "Browse a different archive directory"))) ("" NIL "do nothing - a separator")
|
||||
(Delete AB.Delete.Command "Delete selected items") (Undelete AB.Undelete.Command
|
||||
"Undelete selected items" (SUBITEMS ("Undelete selected items" AB.Undelete.Command
|
||||
"Undelete selected items") ("Undelete ALL items" (AB.Undelete.Command T) "Undelete all deleted items")
|
||||
)) ("" NIL "do nothing - a separator so you don't accidentally Expunge") (Expunge AB.Expunge.Command
|
||||
"Expunge deleted items and rewrite the archive directory"))) CENTERFLG _ T TITLE _ " Commands "
|
||||
WHENSELECTEDFN _ (QUOTE AB.When.Selected.Fn))) (promptfont (FONTCREATE (QUOTE HELVETICA) 10)) (
|
||||
promptheight (HEIGHTIFWINDOW (TIMES 2 (FONTPROP promptfont (QUOTE HEIGHT))) T)) (promptwindow) (
|
||||
windowregion (GETREGION (PLUS (fetch IMAGEWIDTH of menu) 144) (PLUS (fetch IMAGEHEIGHT of menu)
|
||||
promptheight))) (window (CREATEW (CREATEREGION (fetch LEFT of windowregion) (fetch BOTTOM of
|
||||
windowregion) (DIFFERENCE (fetch WIDTH of windowregion) (fetch IMAGEWIDTH of menu)) (DIFFERENCE (fetch
|
||||
HEIGHT of windowregion) promptheight)) "")) (browser (TB.MAKE.BROWSER NIL window (BQUOTE (PRINTFN
|
||||
AB.Printfn FONT (\, AB.browser.font)))))) (ATTACHMENU menu window (QUOTE RIGHT) (QUOTE TOP)) (
|
||||
TB.USERDATA browser (LIST (QUOTE ARCHIVE) (PACKFILENAME.STRING (QUOTE HOST) (OR (FILENAMEFIELD
|
||||
archivefilespec (QUOTE HOST)) (FILENAMEFIELD (DIRECTORYNAME) (QUOTE HOST))) (QUOTE DIRECTORY) (OR (
|
||||
FILENAMEFIELD archivefilespec (QUOTE DIRECTORY)) (CAR (FULLUSERNAME T))) (QUOTE NAME) (OR (
|
||||
FILENAMEFIELD archivefilespec (QUOTE NAME)) (QUOTE Archive)) (QUOTE EXTENSION) (OR (FILENAMEFIELD
|
||||
archivefilespec (QUOTE EXTENSION)) (QUOTE directory)) (QUOTE BODY) archivefilespec) (QUOTE FILTER) (OR
|
||||
filter "*.*"))) (* (use something like this if the "attic" is used) L-CASE (OR filter (CONCAT (CAR (
|
||||
FULLUSERNAME T)) ">*.*"))) (SETQ promptwindow (GETPROMPTWINDOW window 2 (FONTCREATE (QUOTE HELVETICA)
|
||||
10))) (AB.Set.Browser.Title browser) (WINDOWPROP promptwindow (QUOTE MINSIZE) (CONS 0 (fetch (REGION
|
||||
HEIGHT) of (WINDOWPROP promptwindow (QUOTE REGION))))) (WINDOWPROP promptwindow (QUOTE MAXSIZE) (CONS
|
||||
64000 (fetch (REGION HEIGHT) of (WINDOWPROP promptwindow (QUOTE REGION))))) (LINELENGTH MAX.SMALLP
|
||||
promptwindow) (WINDOWPROP window (QUOTE ICONFN) (FUNCTION AB.Iconfn)) (WINDOWADDPROP window (QUOTE
|
||||
CLOSEFN) (FUNCTION AB.Closefn) T) (AB.Command.Fn (SASSOC (QUOTE Recompute) (fetch (MENU ITEMS) of menu
|
||||
)) menu (QUOTE LEFT)))))
|
||||
|
||||
(AB
|
||||
(NLAMBDA filespec% filter (* N.H.Briggs " 4-Mar-87 12:11") (LET ((patternandfilter (NLAMBDA.ARGS
|
||||
filespec% filter))) (ARCHIVEBROWSER (CAR patternandfilter) (CADR patternandfilter)) NIL)))
|
||||
)
|
||||
(* * command processing functions)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(AB.When.Selected.Fn
|
||||
(LAMBDA (Item Menu Key) (* N.H.Briggs "25-Jun-86 11:48") (if (AND (LISTP Item) (CADR Item)) then (
|
||||
TB.PROCESS (LIST (FUNCTION AB.Command.Fn) (KWOTE Item) (KWOTE Menu) (KWOTE Key)) (PACK* (QUOTE AB-) (
|
||||
CAR Item))))))
|
||||
|
||||
(AB.Command.Fn
|
||||
(LAMBDA (item menu key) (* N.H.Briggs "18-Jun-86 13:09") (RESETLST (LET* ((realitem item) (window (
|
||||
WINDOWPROP (WFROMMENU menu) (QUOTE MAINWINDOW))) (browser (WINDOWPROP window (QUOTE TABLEBROWSER)))) (
|
||||
if (NOT (MEMBER item (fetch (MENU ITEMS) of menu))) then (* A subitem -- fetch main item) (SETQ item (
|
||||
for I in (fetch (MENU ITEMS) of menu) thereis (AB.Subitemp item I)))) (if (OBTAIN.MONITORLOCK (fetch (
|
||||
TABLEBROWSER TBLOCK) of browser) T T) then (RESETSAVE (SHADEITEM item menu MENUSELECTSHADE) (LIST (
|
||||
FUNCTION SHADEITEM) item menu WHITESHADE)) (LET ((function (CADR realitem)) (promptwindow (
|
||||
GETPROMPTWINDOW window)) extra) (if (OPENWP promptwindow) then (CLEARW promptwindow)) (if (LISTP
|
||||
function) then (SETQ extra (CADR function)) (SETQ function (CAR function))) (APPLY* function browser
|
||||
extra)) else (TB.BROWSER.BUSY browser))))))
|
||||
|
||||
(AB.Delete.Command
|
||||
(LAMBDA (browser) (* N.H.Briggs " 4-Mar-87 17:01") (LET ((count 0) (browserpromptwindow (
|
||||
GETPROMPTWINDOW (TB.WINDOW browser)))) (DECLARE (SPECVARS count)) (TB.MAP.SELECTED.ITEMS browser (
|
||||
FUNCTION (LAMBDA (browser item) (DECLARE (SPECVARS count)) (TB.DELETE.ITEM browser item) (add count 1)
|
||||
))) (if (EQ count 0) then (printout browserpromptwindow "No items marked for deletion.") else (
|
||||
printout browserpromptwindow count " item" (if (IGREATERP count 1) then "s" else "")
|
||||
" marked for deletion.")))))
|
||||
|
||||
(AB.Expunge.Command
|
||||
(LAMBDA (browser) (* N.H.Briggs "18-Jun-86 12:23") (if (EQ (fetch (TABLEBROWSER TB#DELETED) of browser
|
||||
) 0) then (printout (GETPROMPTWINDOW (TB.WINDOW browser)) "Nothing to expunge!") else (LET ((
|
||||
directorystream (OPENSTREAM (PACKFILENAME (QUOTE VERSION) NIL (QUOTE BODY) (LISTGET (TB.USERDATA
|
||||
browser) (QUOTE ARCHIVE))) (QUOTE OUTPUT)))) (if (NOT directorystream) then (printout (GETPROMPTWINDOW
|
||||
(TB.WINDOW browser)) "Error opening (new version of) archive directory " (LISTGET (TB.USERDATA
|
||||
browser) (QUOTE ARCHIVE)) " ...aborted.") else (LINELENGTH MAX.SMALLP directorystream) (* ensure
|
||||
nothing wraps around) (LISTPUT (TB.USERDATA browser) (QUOTE ALLITEMS) (for item in (LISTGET (
|
||||
TB.USERDATA browser) (QUOTE ALLITEMS)) when (NOT (TB.ITEM.DELETED? browser item)) collect (printout
|
||||
directorystream (fetch (AB.item AB.Filename) of (fetch (TABLEITEM TIDATA) of item)) , (fetch (AB.item
|
||||
AB.Creation.Date) of (fetch (TABLEITEM TIDATA) of item))) (for media on (fetch (AB.item AB.Media) of (
|
||||
fetch (TABLEITEM TIDATA) of item)) by (CDDR media) do (printout directorystream ,, (CAR media)) (
|
||||
printout directorystream , (CADR media)) finally (printout directorystream T)) item)) (LISTPUT (
|
||||
TB.USERDATA browser) (QUOTE ARCHIVE) (L-CASE (FULLNAME directorystream))) (CLOSEF directorystream) (
|
||||
AB.Set.Browser.Title browser) (TB.MAP.DELETED.ITEMS browser (FUNCTION TB.REMOVE.ITEM)))))))
|
||||
|
||||
(AB.Filter.Command
|
||||
(LAMBDA (browser) (* N.H.Briggs "18-Jun-86 12:28") (LET ((pattern (AB.Prompt.For.Input
|
||||
"Files matching what? " (LISTGET (TB.USERDATA browser) (QUOTE FILTER)) browser T))) (if pattern then (
|
||||
LISTPUT (TB.USERDATA browser) (QUOTE FILTER) (L-CASE pattern)) (AB.Set.Browser.Title browser) (
|
||||
AB.Recompute.Command browser)))))
|
||||
|
||||
(AB.Recompute.Command
|
||||
(LAMBDA (browser newdirectory?) (* N.H.Briggs "19-Sep-86 12:34") (LET* ((window (TB.WINDOW browser)) (
|
||||
windowregion (WINDOWPROP window (QUOTE REGION))) (region (CREATEREGION 0 0 (fetch (REGION WIDTH) of
|
||||
windowregion) (fetch (REGION HEIGHT) of windowregion))) (namewidth 0) (userdata (TB.USERDATA browser))
|
||||
(filter (DIRECTORY.MATCH.SETUP (PACKFILENAME (QUOTE BODY) (LISTGET userdata (QUOTE FILTER))))) result
|
||||
) (if (NOT (ZEROP (fetch (TABLEBROWSER TB#DELETED) of browser))) then (if (MENU (create MENU ITEMS _ (
|
||||
QUOTE (("Expunge" (QUOTE Expunge) "Expunge items marked for deletion") ("Don't Expunge" NIL
|
||||
"Don't expunge items marked for deletion"))) TITLE _ "Expunge deleted items?" CENTERFLG _ T)) then (
|
||||
AB.Expunge.Command browser))) (if (AND newdirectory? (SETQ result (AB.Prompt.For.Input
|
||||
"New archive directory? " NIL browser T))) then (LISTPUT userdata (QUOTE ARCHIVE) (PACKFILENAME.STRING
|
||||
(QUOTE NAME) (OR (FILENAMEFIELD result (QUOTE NAME)) (QUOTE Archive)) (QUOTE EXTENSION) (OR (
|
||||
FILENAMEFIELD result (QUOTE EXTENSION)) (QUOTE directory)) (QUOTE BODY) result))) (if (OR (NOT
|
||||
newdirectory?) (AND newdirectory? result)) then (TB.REPLACE.ITEMS browser) (LISTPUT userdata (QUOTE
|
||||
ALLITEMS) (for item in (AB.Read.Directory browser) bind tableitem eachtime (SETQ tableitem (create
|
||||
TABLEITEM TIDATA _ item)) collect (if (DIRECTORY.MATCH filter (PACKFILENAME (QUOTE BODY) (fetch (
|
||||
AB.item AB.Filename) of item))) then (SETQ namewidth (MAX namewidth (STRINGWIDTH (fetch (AB.item
|
||||
AB.Filename) of item) AB.browser.font))) (TB.INSERT.ITEM browser tableitem)) tableitem)) (LISTPUT
|
||||
userdata (QUOTE NAMEWIDTH) namewidth) (TB.DISPLAY.LINES browser (TB.FIRST.VISIBLE.ITEM# browser region
|
||||
) (TB.LAST.VISIBLE.ITEM# browser region))))))
|
||||
|
||||
(AB.Retrieve.Command
|
||||
(LAMBDA (browser) (* N.H.Briggs " 4-Mar-87 16:54") (DECLARE (GLOBALVARS AB.archivist)) (PROG ((count 0
|
||||
) registry corestream) (DECLARE (SPECVARS corestream count)) (SETQ registry (SELECTQ (OR (LAFITEMODE)
|
||||
(\LAFITE.INFER.MODE)) (GV ".pa") (NS ":PA") (RETURN (printout (GETPROMPTWINDOW (TB.WINDOW browser))
|
||||
"Can't retrieve -- Lafite mode must be set to GV or NS")))) (SETQ corestream (OPENSTREAM (QUOTE
|
||||
{NODIRCORE}) (QUOTE BOTH))) (LINELENGTH MAX.SMALLP corestream) (printout corestream
|
||||
"Subject: Retrieve request" T "To: " AB.archivist registry T "cc: " (FULLUSERNAME) T T) (
|
||||
TB.MAP.SELECTED.ITEMS browser (FUNCTION (LAMBDA (browser item) (DECLARE (SPECVARS corestream count)) (
|
||||
printout corestream "Retrieve: " (fetch (AB.item AB.Filename) of (fetch (TABLEITEM TIDATA) of item))
|
||||
" of " (fetch (AB.item AB.Creation.Date) of (fetch (TABLEITEM TIDATA) of item)) " from " (CAR (fetch (
|
||||
AB.item AB.Media) of (fetch (TABLEITEM TIDATA) of item))) " or " (CADR (fetch (AB.item AB.Media) of (
|
||||
fetch (TABLEITEM TIDATA) of item))) T) (add count 1)))) (if (EQ count 0) then (printout (
|
||||
GETPROMPTWINDOW (TB.WINDOW browser)) "Nothing to retrieve.") (CLOSEF corestream) (RETURN)) (SETQ
|
||||
corestream (OPENTEXTSTREAM corestream)) (printout (GETPROMPTWINDOW (TB.WINDOW browser))
|
||||
"Sending mail to " AB.archivist registry " requesting " count " file" (if (NEQ count 1) then "s: "
|
||||
else ": ")) (if (CAR (ERSETQ (LAFITE.SENDMESSAGE corestream))) then (printout (GETPROMPTWINDOW (
|
||||
TB.WINDOW browser)) " done.") else (printout (GETPROMPTWINDOW (TB.WINDOW browser)) " failed.")))))
|
||||
|
||||
(AB.Retrieve.Directory.Command
|
||||
(LAMBDA (browser) (* N.H.Briggs " 4-Mar-87 16:53") (DECLARE (GLOBALVARS AB.archivist)) (PROG ((count 0
|
||||
) registry corestream newdirectory) (DECLARE (SPECVARS corestream count newdirectory)) (SETQ registry
|
||||
(SELECTQ (OR (LAFITEMODE) (\LAFITE.INFER.MODE)) (GV ".pa") (NS ":PA") (RETURN (printout (
|
||||
GETPROMPTWINDOW (TB.WINDOW browser)) "Can't retrieve -- Lafite mode must be set to GV or NS")))) (if (
|
||||
NOT (SETQ newdirectory (AB.Prompt.For.Input "Directory to retrieve into? " NIL browser T))) then (
|
||||
RETURN)) (SETQ corestream (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))) (LINELENGTH MAX.SMALLP
|
||||
corestream) (printout corestream "Subject: Retrieve request" T "To: " AB.archivist registry T "cc: " (
|
||||
FULLUSERNAME) T T) (TB.MAP.SELECTED.ITEMS browser (FUNCTION (LAMBDA (browser item) (DECLARE (SPECVARS
|
||||
corestream count newdirectory)) (printout corestream "Retrieve: " (fetch (AB.item AB.Filename) of (
|
||||
fetch (TABLEITEM TIDATA) of item)) " of " (fetch (AB.item AB.Creation.Date) of (fetch (TABLEITEM
|
||||
TIDATA) of item)) " from " (CAR (fetch (AB.item AB.Media) of (fetch (TABLEITEM TIDATA) of item)))
|
||||
" or " (CADR (fetch (AB.item AB.Media) of (fetch (TABLEITEM TIDATA) of item))) " as " (
|
||||
AB.Make.Cedar.Filename (PACKFILENAME.STRING (QUOTE DIRECTORY) newdirectory (QUOTE VERSION) NIL (QUOTE
|
||||
BODY) (fetch (AB.item AB.Filename) of (fetch (TABLEITEM TIDATA) of item)))) T) (add count 1)))) (if (
|
||||
EQ count 0) then (printout (GETPROMPTWINDOW (TB.WINDOW browser)) "Nothing to retrieve.") (CLOSEF
|
||||
corestream) (RETURN)) (SETQ corestream (OPENTEXTSTREAM corestream)) (printout (GETPROMPTWINDOW (
|
||||
TB.WINDOW browser)) "Sending mail to " AB.archivist registry " requesting " count " file" (if (NEQ
|
||||
count 1) then "s: " else ": ")) (if (CAR (ERSETQ (LAFITE.SENDMESSAGE corestream))) then (printout (
|
||||
GETPROMPTWINDOW (TB.WINDOW browser)) " done.") else (printout (GETPROMPTWINDOW (TB.WINDOW browser))
|
||||
" failed.")))))
|
||||
|
||||
(AB.Retrieve.Renamed.Command
|
||||
(LAMBDA (browser) (* N.H.Briggs " 3-Mar-87 12:34") (DECLARE (GLOBALVARS AB.archivist)) (PROG ((count 0
|
||||
) registry corestream) (DECLARE (SPECVARS corestream count)) (SETQ registry (SELECTQ (OR (LAFITEMODE)
|
||||
(\LAFITE.INFER.MODE)) (GV ".pa") (NS ":PA") (RETURN (printout (GETPROMPTWINDOW (TB.WINDOW browser))
|
||||
"Can't retrieve -- Lafite mode must be set to GV or NS")))) (SETQ corestream (OPENSTREAM (QUOTE
|
||||
{NODIRCORE}) (QUOTE BOTH))) (LINELENGTH MAX.SMALLP corestream) (printout corestream
|
||||
"Subject: Retrieve request" T "To: " AB.archivist registry T "cc: " (FULLUSERNAME) T T) (
|
||||
TB.MAP.SELECTED.ITEMS browser (FUNCTION AB.Retrieve.Renamed.Aux)) (if (EQ count 0) then (printout (
|
||||
GETPROMPTWINDOW (TB.WINDOW browser)) "Nothing to retrieve.") (CLOSEF corestream) (RETURN)) (SETQ
|
||||
corestream (OPENTEXTSTREAM corestream)) (printout (GETPROMPTWINDOW (TB.WINDOW browser))
|
||||
"Sending mail to " AB.archivist registry " requesting " count " file" (if (NEQ count 1) then "s: "
|
||||
else ": ")) (if (CAR (ERSETQ (LAFITE.SENDMESSAGE corestream))) then (printout (GETPROMPTWINDOW (
|
||||
TB.WINDOW browser)) " done.") else (printout (GETPROMPTWINDOW (TB.WINDOW browser)) " failed.")))))
|
||||
|
||||
(AB.Retrieve.Renamed.Aux
|
||||
(LAMBDA (browser item) (* N.H.Briggs " 4-Mar-87 16:52") (DECLARE (SPECVARS corestream count)) (LET ((
|
||||
newname (AB.Prompt.For.Input (CONCAT "Retrieve " (fetch (AB.item AB.Filename) of (fetch (TABLEITEM
|
||||
TIDATA) of item)) " as ?") (fetch (AB.item AB.Filename) of (fetch (TABLEITEM TIDATA) of item)) browser
|
||||
"... skipped"))) (if newname then (printout corestream "Retrieve: " (fetch (AB.item AB.Filename) of (
|
||||
fetch (TABLEITEM TIDATA) of item)) " of " (fetch (AB.item AB.Creation.Date) of (fetch (TABLEITEM
|
||||
TIDATA) of item)) " from " (CAR (fetch (AB.item AB.Media) of (fetch (TABLEITEM TIDATA) of item)))
|
||||
" or " (CADR (fetch (AB.item AB.Media) of (fetch (TABLEITEM TIDATA) of item))) " as " (
|
||||
AB.Make.Cedar.Filename (PACKFILENAME.STRING (QUOTE VERSION) NIL (QUOTE BODY) newname)) T) (add count 1
|
||||
)))))
|
||||
|
||||
(AB.Sort.Command
|
||||
(LAMBDA (browser sorttype) (* N.H.Briggs "17-Jun-86 12:47") (LET ((items (fetch (TABLEBROWSER TBITEMS)
|
||||
of browser))) (if (EQ sorttype (QUOTE Reverse)) then (SETQ items (DREVERSE items)) else (SORT items (
|
||||
SELECTQ sorttype (CreationDate (FUNCTION (LAMBDA (x y) (IGREATERP (IDATE (fetch (AB.item
|
||||
AB.Creation.Date) of (fetch (TABLEITEM TIDATA) of x))) (IDATE (fetch (AB.item AB.Creation.Date) of (
|
||||
fetch (TABLEITEM TIDATA) of y))))))) (Archive (FUNCTION (LAMBDA (x y) (ILESSP (fetch (AB.item
|
||||
AB.Sequence.Number) of (fetch (TABLEITEM TIDATA) of x)) (fetch (AB.item AB.Sequence.Number) of (fetch
|
||||
(TABLEITEM TIDATA) of y)))))) (FUNCTION (LAMBDA (x y) (ALPHORDER (fetch (AB.item AB.Filename) of (
|
||||
fetch (TABLEITEM TIDATA) of x)) (fetch (AB.item AB.Filename) of (fetch (TABLEITEM TIDATA) of y)) (
|
||||
UPPERCASEARRAY))))))) (for item in items as i from 1 do (replace TI# of item with i)) (
|
||||
TB.REPLACE.ITEMS browser items) (TB.REDISPLAY.ITEMS browser))))
|
||||
|
||||
(AB.Undelete.Command
|
||||
(LAMBDA (browser all?) (* N.H.Briggs " 4-Mar-87 17:00") (LET ((count 0) (browserpromptwindow (
|
||||
GETPROMPTWINDOW (TB.WINDOW browser)))) (DECLARE (SPECVARS count)) (if all? then (TB.MAP.DELETED.ITEMS
|
||||
browser (FUNCTION (LAMBDA (browser item) (DECLARE (SPECVARS count)) (TB.UNDELETE.ITEM browser item) (
|
||||
add count 1)))) else (TB.MAP.SELECTED.ITEMS browser (FUNCTION (LAMBDA (browser item) (DECLARE (
|
||||
SPECVARS count)) (TB.UNDELETE.ITEM browser item) (add count 1))))) (if (EQ count 0) then (printout
|
||||
browserpromptwindow "No items were undeleted.") else (printout browserpromptwindow count " item" (if (
|
||||
NEQ count 1) then "s" else "") " undeleted.")))))
|
||||
)
|
||||
(* * miscellaneous functions)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(AB.Set.Browser.Title
|
||||
(LAMBDA (browser) (* N.H.Briggs "17-Jun-86 15:45") (LET ((archive (LISTGET (TB.USERDATA browser) (
|
||||
QUOTE ARCHIVE))) (filter (LISTGET (TB.USERDATA browser) (QUOTE FILTER)))) (WINDOWPROP (GETPROMPTWINDOW
|
||||
(TB.WINDOW browser)) (QUOTE TITLE) (CONCAT "Archive Browser" (OR (AND archive (CONCAT " " archive))
|
||||
"") (OR (AND filter (CONCAT " - files " filter)) ""))))))
|
||||
|
||||
(AB.Iconfn
|
||||
(LAMBDA (window icon) (* N.H.Briggs "19-Sep-86 18:58") (DECLARE (GLOBALVARS AB.titled.icon)) (LET* ((
|
||||
browser (WINDOWPROP window (QUOTE TABLEBROWSER))) (archive (LISTGET (TB.USERDATA browser) (QUOTE
|
||||
ARCHIVE))) (directory (UNPACKFILENAME.STRING archive (QUOTE DIRECTORY))) (host (UNPACKFILENAME.STRING
|
||||
archive (QUOTE HOST))) (title (PACKFILENAME.STRING (QUOTE HOST) host (QUOTE DIRECTORY) (SUBSTRING
|
||||
directory 1 (STRPOS directory ">"))))) (if icon then (ICONW.TITLE icon title) icon else (TITLEDICONW
|
||||
AB.titled.icon title (FONTCREATE (QUOTE MODERN) 8) NIL NIL NIL (CHARCODE (})))))))
|
||||
|
||||
(AB.Closefn
|
||||
(LAMBDA (window) (* edited: "20-Jun-86 12:42") (LET ((browser (WINDOWPROP window (QUOTE TABLEBROWSER))
|
||||
)) (if (NOT (ZEROP (fetch (TABLEBROWSER TB#DELETED) of browser))) then (if (MENU (create MENU ITEMS _
|
||||
(QUOTE (("Expunge" (QUOTE Expunge) "Expunge items marked for deletion") ("Don't Expunge" NIL
|
||||
"Don't expunge items marked for deletion"))) TITLE _ "Expunge deleted items?" CENTERFLG _ T)) then (
|
||||
AB.Expunge.Command browser))) NIL)))
|
||||
|
||||
(AB.Printfn
|
||||
(LAMBDA (browser item window) (* N.H.Briggs "22-Sep-86 13:09") (LET* ((entry (fetch TIDATA of item)) (
|
||||
namewidth (OR (LISTGET (TB.USERDATA browser) (QUOTE NAMEWIDTH)) 0)) (offset (DSPXPOSITION NIL window))
|
||||
(datestart (IPLUS offset namewidth 10))) (* if this is to work for variable spaced fonts it has to be
|
||||
smart about the widths of date and media fields too) (PRIN1 (fetch (AB.item AB.Filename) of entry)
|
||||
window) (if (ZEROP namewidth) then (PRIN1 " " window) else (BLTSHADE WHITESHADE window (DSPXPOSITION
|
||||
NIL window) (IDIFFERENCE (DSPYPOSITION NIL window) (FONTPROP AB.browser.font (QUOTE DESCENT))) (
|
||||
IDIFFERENCE datestart (DSPXPOSITION NIL window)) (FONTPROP AB.browser.font (QUOTE HEIGHT))) (
|
||||
DSPXPOSITION datestart window)) (PRIN1 (fetch (AB.item AB.Creation.Date) of entry) window) (PRIN1
|
||||
" " window) (for media in (fetch (AB.item AB.Media) of entry) do (PRIN1 media window) (PRIN1 " "
|
||||
window)))))
|
||||
|
||||
(AB.Prompt.For.Input
|
||||
(LAMBDA (prompt default browser abortflag) (* N.H.Briggs "22-Apr-86 17:32") (* * Prompt for input for
|
||||
browser browser with question prompt offering default answer DEFAULT. If abortflag is true and
|
||||
response is NIL, prints "... aborted" or abortflag (should be a text string)) (LET* ((promptwindow (
|
||||
GETPROMPTWINDOW (TB.WINDOW browser))) (promptwidth (STRINGWIDTH prompt promptwindow)) (windowwidth (
|
||||
WINDOWPROP promptwindow (QUOTE WIDTH))) result) (CLEARW promptwindow) (if (IGREATERP (IPLUS
|
||||
promptwidth (STRINGWIDTH (OR default "XXX") promptwindow)) windowwidth) then (* Prompt plus default
|
||||
response will overflow the width of the window, so be a nice guy and break it up) (for i from (
|
||||
IDIFFERENCE (NCHARS prompt) 4) to 10 by -1 bind (excesswidth _ (IDIFFERENCE promptwidth windowwidth))
|
||||
when (AND (EQ (NTHCHARCODE prompt i) (CHARCODE SPACE)) (IGREATERP (STRINGWIDTH (SUBSTRING prompt i)
|
||||
promptwindow) excesswidth)) do (RETURN (SETQ prompt (CONCAT (SUBSTRING prompt 1 (IPLUS i -1)) "
|
||||
" (SUBSTRING prompt (IPLUS i 1))))))) (SETQ result (CAR (NLSETQ (PROMPTFORWORD prompt default NIL
|
||||
promptwindow NIL (QUOTE TTY) (CHARCODE (CR ESC)))))) (if (AND (EQ result NIL) abortflag) then (
|
||||
PRINTOUT promptwindow (if (EQ abortflag T) then "... aborted" else abortflag))) (TERPRI promptwindow)
|
||||
result)))
|
||||
|
||||
(AB.Read.Directory
|
||||
(LAMBDA (browser) (* N.H.Briggs "22-Sep-86 12:53") (LET ((directorystream (AND (LISTGET (TB.USERDATA
|
||||
browser) (QUOTE ARCHIVE)) (CAR (NLSETQ (OPENSTREAM (LISTGET (TB.USERDATA browser) (QUOTE ARCHIVE)) (
|
||||
QUOTE INPUT)))))) (linerdtable (COPYREADTABLE (QUOTE ORIG))) (promptwindow (GETPROMPTWINDOW (TB.WINDOW
|
||||
browser))) items) (if (NOT directorystream) then (printout promptwindow
|
||||
"Can't find archive directory " (LISTGET (TB.USERDATA browser) (QUOTE ARCHIVE))) (LISTPUT (TB.USERDATA
|
||||
browser) (QUOTE ARCHIVE) NIL) (AB.Set.Browser.Title browser) NIL else (LISTPUT (TB.USERDATA browser)
|
||||
(QUOTE ARCHIVE) (L-CASE (FULLNAME directorystream))) (AB.Set.Browser.Title browser) (SETSEPR (LIST (
|
||||
CONSTANT (CHARCODE EOL))) NIL linerdtable) (SETBRK NIL NIL linerdtable) (bind start end inputline
|
||||
repeatuntil (EOFP directorystream) eachtime (SETQ inputline (RSTRING directorystream linerdtable)) (
|
||||
READC directorystream) as i from 1 collect (create AB.item AB.Filename _ (L-CASE (SUBSTRING inputline
|
||||
1 (SUB1 (SETQ end (STRPOS " " inputline))))) AB.Creation.Date _ (SUBSTRING inputline (ADD1 end) (SUB1
|
||||
(SETQ end (STRPOS " " inputline (ADD1 end))))) AB.Media _ (first (SETQ end (ADD1 end)) repeatwhile
|
||||
end eachtime (SETQ start (ADD1 end)) (while (EQUAL (SUBSTRING inputline start start) " ") do (SETQ
|
||||
start (ADD1 start))) (SETQ end (STRPOS " " inputline start)) collect (SUBSTRING inputline start (AND
|
||||
end (SUB1 end)))) AB.Sequence.Number _ i) finally (CLOSEF directorystream))))))
|
||||
|
||||
(AB.Subitemp
|
||||
(LAMBDA (subitem item) (* N.H.Briggs "16-Apr-86 18:32") (* * True if subitem appears among the
|
||||
subitems of item or descendents) (LET ((sub (CADDDR item))) (AND sub (EQ (CAR (LISTP sub)) (QUOTE
|
||||
SUBITEMS)) (OR (MEMBER subitem sub) (for i in (CDR sub) thereis (AB.Subitemp subitem i)))))))
|
||||
|
||||
(AB.Make.Cedar.Filename
|
||||
(LAMBDA (filename) (* N.H.Briggs " 3-Mar-87 12:08") (LET ((unpackedfilename (UNPACK filename))) (PACK
|
||||
(SUBLIS (QUOTE (({ . %[) (} . %]) (; . !))) unpackedfilename)))))
|
||||
)
|
||||
(* * the user that gets retrieval requests)
|
||||
|
||||
|
||||
(RPAQ? AB.archivist "Archivist")
|
||||
(* * the structure for an archive entry)
|
||||
|
||||
[DECLARE: EVAL@COMPILE
|
||||
|
||||
(RECORD AB.item (AB.Filename AB.Creation.Date AB.Media AB.Sequence.Number))
|
||||
]
|
||||
(* * the icon)
|
||||
|
||||
|
||||
(RPAQ AB.icon (READBITMAP))
|
||||
(73 73
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"O@@@@@@AN@@@@@@@@AH@"
|
||||
"ML@@@@@CK@@@@@@@@AH@"
|
||||
"LOOOOOOOOOOOOOOOOIH@"
|
||||
"LJ@@@@@DHG@@@@@@AIH@"
|
||||
"LK@@@@AHHAL@@@@@FIH@"
|
||||
"LIH@@@A@H@GH@@@@LIH@"
|
||||
"LHF@@@G@H@@OL@@GHIH@"
|
||||
"LHC@@COOOOOOGOOO@IH@"
|
||||
"LHAH@C@CN@@A@@@F@IH@"
|
||||
"LH@LON@FK@@A@@AL@IH@"
|
||||
"LH@FNBAOOOOA@@CL@IH@"
|
||||
"LH@CLBCHHL@A@@FH@IH@"
|
||||
"LH@AKOOOOOOI@@MH@IH@"
|
||||
"LH@ADB@@L@LA@AI@@IH@"
|
||||
"LH@ANB@@L@CA@FA@@IH@"
|
||||
"LH@@KCOOOOOOMOC@@IH@"
|
||||
"LH@@IH@CL@@@CJB@@IH@"
|
||||
"LH@@HH@FF@@@GBB@@IH@"
|
||||
"LH@@HDALG@@@LFC@@IH@"
|
||||
"LH@@HCOOOOOOHDA@@IH@"
|
||||
"LH@@HCL@F@@G@DA@@IH@"
|
||||
"LH@@HAOOOOOO@DAH@IH@"
|
||||
"OH@AHAOOOOOO@D@H@IH@"
|
||||
"LO@C@AOOOOOO@D@L@IH@"
|
||||
"LION@CAHC@FA@D@GHIH@"
|
||||
"LH@N@F@HA@LA@D@AOIH@"
|
||||
"LH@GNL@DAAHAHBAO@IH@"
|
||||
"LH@BGO@CAB@@LCOB@IH@"
|
||||
"LH@B@MNAIFAOOO@F@IH@"
|
||||
"LH@B@DCLOMNCHB@D@IH@"
|
||||
"LH@B@D@COO@F@B@D@IH@"
|
||||
"LH@B@D@@FGLB@B@D@IH@"
|
||||
"LH@B@L@GL@CO@C@F@IH@"
|
||||
"LH@B@HCL@@@GNAHC@IH@"
|
||||
"LH@FAKL@@@@@AOLAHIH@"
|
||||
"LH@DAL@@@@@@@AN@LIH@"
|
||||
"LH@OO@@@@@@@@@CNFIH@"
|
||||
"LHCL@@@@@@@@@@@CNIH@"
|
||||
"OOO@@@@@@@@@@@@@AIH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LH@@@@@@@@@@@@@@@IH@"
|
||||
"LOOOOOOOOOOOOOOOOIH@"
|
||||
"L@@@@@@@@@@@@@@@@AH@"
|
||||
"L@@@@@@@@@@@@@@@@AH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@")
|
||||
|
||||
(RPAQ AB.icon.mask (READBITMAP))
|
||||
(73 73
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@"
|
||||
"OOOOOOOOOOOOOOOOOOH@")
|
||||
|
||||
(RPAQ? AB.titled.icon (create TITLEDICON ICON _ AB.icon MASK _ AB.icon.mask TITLEREG _ (CREATEREGION
|
||||
7 8 60 24)))
|
||||
(* * the font for the browser, which must be a fixed pitch font for now)
|
||||
|
||||
|
||||
(RPAQ AB.browser.font (FONTCREATE (QUOTE TERMINAL) 10))
|
||||
(* * based on the TableBrowser package)
|
||||
|
||||
(FILESLOAD TABLEBROWSER)
|
||||
(DECLARE: EVAL@COMPILE DONTCOPY
|
||||
(FILESLOAD TABLEBROWSERDECLS)
|
||||
)
|
||||
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA AB)
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS ARCHIVEBROWSER COPYRIGHT ("Xerox Corporation" 1986 1987))
|
||||
(DECLARE: DONTCOPY
|
||||
(FILEMAP (NIL (1797 5673 (ARCHIVEBROWSER 1807 . 5473) (AB 5475 . 5671)) (5715 18075 (
|
||||
AB.When.Selected.Fn 5725 . 5965) (AB.Command.Fn 5967 . 6830) (AB.Delete.Command 6832 . 7357) (
|
||||
AB.Expunge.Command 7359 . 8764) (AB.Filter.Command 8766 . 9109) (AB.Recompute.Command 9111 . 10870) (
|
||||
AB.Retrieve.Command 10872 . 12460) (AB.Retrieve.Directory.Command 12462 . 14401) (
|
||||
AB.Retrieve.Renamed.Command 14403 . 15599) (AB.Retrieve.Renamed.Aux 15601 . 16431) (AB.Sort.Command
|
||||
16433 . 17398) (AB.Undelete.Command 17400 . 18073)) (18112 23830 (AB.Set.Browser.Title 18122 . 18509)
|
||||
(AB.Iconfn 18511 . 19112) (AB.Closefn 19114 . 19567) (AB.Printfn 19569 . 20498) (AB.Prompt.For.Input
|
||||
20500 . 21823) (AB.Read.Directory 21825 . 23323) (AB.Subitemp 23325 . 23630) (AB.Make.Cedar.Filename
|
||||
23632 . 23828)))))
|
||||
STOP
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 3-Feb-2022 11:57:39" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>DINFO.;5 65271
|
||||
(FILECREATED " 4-Aug-2022 09:56:25" {DSK}<home>larry>medley>lispusers>DINFO.;2 65548
|
||||
|
||||
:CHANGES-TO (FNS DINFO.UPDATE.TEXT.DISPLAY)
|
||||
:CHANGES-TO (FNS DINFO.UPDATE.FMENU DINFO.UPDATE.MENU.DISPLAY DINFO.UPDATE.HISTORY
|
||||
DINFO.UPDATE.GRAPH.DISPLAY DINFO.LAYOUTGRAPH)
|
||||
|
||||
:PREVIOUS-DATE "21-Jan-2022 23:16:01"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>DINFO.;3)
|
||||
:PREVIOUS-DATE " 3-Feb-2022 11:57:39" {DSK}<home>larry>medley>lispusers>DINFO.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -628,10 +628,10 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
(SHOULDNT])
|
||||
|
||||
(DINFO.UPDATE.FMENU
|
||||
[LAMBDA (GRAPH NEW.NODE) (* jow "20-May-86 15:13")
|
||||
|
||||
(* * Update the display of GRAPH's FreeMenu.
|
||||
If NEW.NODE is not specified, use Top node of GRAPH, and change Top node title.)
|
||||
[LAMBDA (GRAPH NEW.NODE) (* jow "20-May-86 15:13")
|
||||
|
||||
(* * Update the display of GRAPH's FreeMenu.
|
||||
If NEW.NODE is not specified, use Top node of GRAPH, and change Top node title.)
|
||||
|
||||
(LET* [(W (fetch (DINFOGRAPH FMENU.WINDOW) of GRAPH))
|
||||
(NODELST (fetch (DINFOGRAPH NODELST) of GRAPH))
|
||||
@@ -712,7 +712,7 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(DINFO.UPDATE.MENU.DISPLAY
|
||||
[LAMBDA (GRAPH NODE) (* drc%: "25-Jan-86 18:20")
|
||||
[LAMBDA (GRAPH NODE) (* drc%: "25-Jan-86 18:20")
|
||||
(LET* [(DINFOW (fetch (DINFOGRAPH WINDOW) of GRAPH))
|
||||
(WINDOW (fetch (DINFOGRAPH SUBNODE.MENU.WINDOW) of GRAPH))
|
||||
[CHILDREN (DREVERSE (for ID in (fetch (DINFONODE CHILDREN) of NODE)
|
||||
@@ -764,9 +764,8 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
(REDISPLAYW WINDOW)
|
||||
(replace (DINFOGRAPH SUBNODE.MENU.WINDOW) of GRAPH with WINDOW)
|
||||
(LET [(BITS (fetch (REGION BOTTOM) of (WINDOWPROP WINDOW 'REGION]
|
||||
|
||||
(* Slide DINFOW up if our new menu is off the screen)
|
||||
|
||||
(* Slide DINFOW up if our new menu is
|
||||
off the screen)
|
||||
(AND (ILESSP BITS 0)
|
||||
(RELMOVEW DINFOW (create POSITION
|
||||
XCOORD _ 0
|
||||
@@ -780,7 +779,7 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
(CADR ITEM])
|
||||
|
||||
(DINFO.UPDATE.HISTORY
|
||||
[LAMBDA (GRAPH NODE SEL DISPLAY?) (* drc%: "25-Jan-86 18:21")
|
||||
[LAMBDA (GRAPH NODE SEL DISPLAY?) (* drc%: "25-Jan-86 18:21")
|
||||
(LET* ((DINFOW (fetch (DINFOGRAPH WINDOW) of GRAPH))
|
||||
(OLDWINDOW (fetch (DINFOGRAPH HISTORY.MENU.WINDOW) of GRAPH))
|
||||
(OLDITEMS (fetch (DINFOGRAPH HISTORY.ITEMS) of GRAPH))
|
||||
@@ -839,17 +838,15 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(DINFO.UPDATE.GRAPH.DISPLAY
|
||||
[LAMBDA (DINFO.GRAPH NODE FORCE?) (* drc%: "27-Jan-86 16:19")
|
||||
[LAMBDA (DINFO.GRAPH NODE FORCE?) (* drc%: "27-Jan-86 16:19")
|
||||
(LET [(DINFOW (fetch (DINFOGRAPH WINDOW) of DINFO.GRAPH))
|
||||
(LOCATION (CONS (fetch (DINFONODE PARENT) of NODE)
|
||||
(fetch (DINFONODE CHILDREN) of NODE]
|
||||
(if (AND (NOT FORCE?)
|
||||
(EQUAL LOCATION (fetch (DINFOGRAPH LAST.GRAPH.LOCATION) of DINFO.GRAPH)))
|
||||
then
|
||||
|
||||
(* don't need to relayout grapher display --
|
||||
just change which node is inverted.)
|
||||
|
||||
then (* don't need to relayout grapher
|
||||
display -- just change which node is
|
||||
inverted.)
|
||||
(DINFO.INVERT.NODE (fetch (DINFOGRAPH GRAPH.WINDOW) of DINFO.GRAPH)
|
||||
NODE DINFO.GRAPH)
|
||||
else (DINFO.SHOWGRAPH (DINFO.LAYOUTGRAPH DINFO.GRAPH NODE)
|
||||
@@ -944,7 +941,7 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
else (OPENW WINDOW])
|
||||
|
||||
(DINFO.LAYOUTGRAPH
|
||||
[LAMBDA (DINFO.GRAPH NODE) (* drc%: "25-Jan-86 18:20")
|
||||
[LAMBDA (DINFO.GRAPH NODE) (* drc%: "25-Jan-86 18:20")
|
||||
(LET* [(WINDOW (fetch (DINFOGRAPH WINDOW) of DINFO.GRAPH))
|
||||
(FONT (OR (FONTP (fetch (DINFOGRAPH MENUFONT) of DINFO.GRAPH))
|
||||
MENUFONT))
|
||||
@@ -1115,21 +1112,21 @@ Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS DINFO COPYRIGHT ("Xerox Corporation" 1985 1986 1987 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4678 6137 (DINFOGRAPHPROP 4678 . 6137)) (7391 24529 (DINFO 7401 . 9015) (DINFO.UPDATE
|
||||
9017 . 11881) (DINFOGRAPH 11883 . 12301) (DINFO.SPECIAL.UPDATE 12303 . 14001) (DINFO.READ.GRAPH 14003
|
||||
. 15858) (DINFO.WRITE.GRAPH 15860 . 16950) (DINFO.SELECT.GRAPH 16952 . 17859) (DINFO.DEFAULT.MENU
|
||||
17861 . 20385) (DINFO.FIND 20387 . 22973) (DINFO.LOOKUP 22975 . 24527)) (24530 27224 (
|
||||
DINFO.READ.KOTO.GRAPH 24540 . 27222)) (27225 29539 (DINFO.SETUP.WINDOW 27235 . 27916) (DINFO.CLOSEFN
|
||||
27918 . 28351) (DINFO.SHRINKFN 28353 . 28549) (DINFO.EXPANDFN 28551 . 29108) (DINFO.ICONFN 29110 .
|
||||
29537)) (29540 40800 (DINFO.ADD.FMENU 29550 . 30645) (DINFO.CREATE.FMENU 30647 . 34596) (
|
||||
DINFO.FMW.CLOSEFN 34598 . 35443) (DINFO.FMENU.HANDLER 35445 . 36084) (DINFO.UPDATE.FMENU 36086 . 38291
|
||||
) (DINFO.TOGGLE.MENU 38293 . 38883) (DINFO.TOGGLE.GRAPH 38885 . 39384) (DINFO.TOGGLE.HISTORY 39386 .
|
||||
39930) (DINFO.TOGGLE.TEXT 39932 . 40798)) (40801 48499 (DINFO.UPDATE.MENU.DISPLAY 40811 . 44831) (
|
||||
DINFO.UPDATE.FROM.MENU 44833 . 45132) (DINFO.UPDATE.HISTORY 45134 . 47668) (DINFO.HISTORIC.UPDATE
|
||||
47670 . 48497)) (48500 58666 (DINFO.UPDATE.GRAPH.DISPLAY 48510 . 49828) (DINFO.UPDATE.FROM.GRAPH 49830
|
||||
. 50273) (DINFO.GET.GRAPH.WINDOW 50275 . 50860) (DINFO.CREATE.GRAPH.WINDOW 50862 . 51979) (
|
||||
DINFO.SHOWGRAPH 51981 . 53706) (DINFO.INVERT.NODE 53708 . 55096) (DINFO.LAYOUTGRAPH 55098 . 58664)) (
|
||||
58667 64610 (DINFO.UPDATE.TEXT.DISPLAY 58677 . 60625) (DINFO.TITLEMENUFN 60627 . 61752) (
|
||||
DINFO.OPENTEXTSTREAM 61754 . 62970) (DINFO.SHOWSEL 62972 . 63705) (DINFO.GET.FILENAME 63707 . 64608)))
|
||||
(FILEMAP (NIL (4744 6203 (DINFOGRAPHPROP 4744 . 6203)) (7457 24595 (DINFO 7467 . 9081) (DINFO.UPDATE
|
||||
9083 . 11947) (DINFOGRAPH 11949 . 12367) (DINFO.SPECIAL.UPDATE 12369 . 14067) (DINFO.READ.GRAPH 14069
|
||||
. 15924) (DINFO.WRITE.GRAPH 15926 . 17016) (DINFO.SELECT.GRAPH 17018 . 17925) (DINFO.DEFAULT.MENU
|
||||
17927 . 20451) (DINFO.FIND 20453 . 23039) (DINFO.LOOKUP 23041 . 24593)) (24596 27290 (
|
||||
DINFO.READ.KOTO.GRAPH 24606 . 27288)) (27291 29605 (DINFO.SETUP.WINDOW 27301 . 27982) (DINFO.CLOSEFN
|
||||
27984 . 28417) (DINFO.SHRINKFN 28419 . 28615) (DINFO.EXPANDFN 28617 . 29174) (DINFO.ICONFN 29176 .
|
||||
29603)) (29606 40850 (DINFO.ADD.FMENU 29616 . 30711) (DINFO.CREATE.FMENU 30713 . 34662) (
|
||||
DINFO.FMW.CLOSEFN 34664 . 35509) (DINFO.FMENU.HANDLER 35511 . 36150) (DINFO.UPDATE.FMENU 36152 . 38341
|
||||
) (DINFO.TOGGLE.MENU 38343 . 38933) (DINFO.TOGGLE.GRAPH 38935 . 39434) (DINFO.TOGGLE.HISTORY 39436 .
|
||||
39980) (DINFO.TOGGLE.TEXT 39982 . 40848)) (40851 48646 (DINFO.UPDATE.MENU.DISPLAY 40861 . 44982) (
|
||||
DINFO.UPDATE.FROM.MENU 44984 . 45283) (DINFO.UPDATE.HISTORY 45285 . 47815) (DINFO.HISTORIC.UPDATE
|
||||
47817 . 48644)) (48647 58943 (DINFO.UPDATE.GRAPH.DISPLAY 48657 . 50109) (DINFO.UPDATE.FROM.GRAPH 50111
|
||||
. 50554) (DINFO.GET.GRAPH.WINDOW 50556 . 51141) (DINFO.CREATE.GRAPH.WINDOW 51143 . 52260) (
|
||||
DINFO.SHOWGRAPH 52262 . 53987) (DINFO.INVERT.NODE 53989 . 55377) (DINFO.LAYOUTGRAPH 55379 . 58941)) (
|
||||
58944 64887 (DINFO.UPDATE.TEXT.DISPLAY 58954 . 60902) (DINFO.TITLEMENUFN 60904 . 62029) (
|
||||
DINFO.OPENTEXTSTREAM 62031 . 63247) (DINFO.SHOWSEL 63249 . 63982) (DINFO.GET.FILENAME 63984 . 64885)))
|
||||
))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user