(FILECREATED " 2-Jul-86 22:55:29" {QV}<NOTECARDS>1.3K>RHTPATCH051.;11 45566
changes to: (FNS NC.GetFileBrowserPattern NC.GETPROMPTWINDOW NC.FileBrowserOpen
NC.AbortSession NC.DatabaseFileName NC.FileBrowserAbort
NC.FileBrowserCheckpoint NC.FileBrowserClose NC.DoNoteFileOp
NC.FileBrowserCompact NC.FileBrowserExpunge NC.CompactNoteFile
NC.DeleteDatabaseFile NC.FindFileBrowserWinForPattern NC.FileBrowserMenu
NC.FlashFileBrowserWin NC.FileBrowserRecomputeWithNewPattern)
(VARS RHTPATCH051COMS)
previous date: " 1-Jul-86 00:02:23" {QV}<NOTECARDS>1.3K>RHTPATCH051.;1)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH051COMS)
(RPAQQ RHTPATCH051COMS ((* * Changes for notefile browser related stuff. Also random other changes.)
(* * Add this near the file browser stuff in NCINTERFACE)
(DECLARE: EVAL@COMPILE (P (FILESLOAD (FROM VALUEOF NOTECARDSDIRECTORIES)
(LOADCOMP)
FILEBROWSER)))
(* * New globalvars for NCINTERFACE)
(GLOBALVARS NC.FileBrowserExpungeMenuItem NC.FileBrowserRecomputeMenuItem
NC.FileBrowserMenuItemsToKeep)
(* * This should replace the VARS at the bottom of NCINTERFACE)
(VARS (NC.FileBrowserMenuItemsToRemove (QUOTE (Hardcopy See Edit Load
Compile Copy Rename
Expunge)))
(NC.FileBrowserMenuItemsToKeep (QUOTE (Delete Undelete Recompute Sort)
))
(NC.FileBrowserMenuItemsToAdd
(QUOTE ((Open NC.FileBrowserOpen "Open selected Notefiles.")
(Checkpoint NC.FileBrowserCheckpoint
"Checkpoint the selected Notefiles, saving dirty cards.")
(Close NC.FileBrowserClose "Close selected Notefiles.")
(Abort NC.FileBrowserAbort
"Aborts the selected Notefiles losing work since last checkpoint.")
(Compact NC.FileBrowserCompact
"Compacts selected Notefiles to target files."
(SUBITEMS (Compact% To% Target% File
NC.FileBrowserCompact
"Compacts selected Notefiles to target files.")
(Compact% In% Place (
NC.FileBrowserCompact (QUOTE InPlace))
"Compacts selected Notefiles in place.")))
(Inspect&Repair NC.FileBrowserInspect&Repair
"Inspects and optionally repairs selected Notefiles."
(SUBITEMS (Read% Substances
(NC.FileBrowserInspect&Repair
(QUOTE ReadSubstances))
"Inspects and optionally repairs selected Notefiles, but reads every substance. This slows things WAY down."
)))
(Copy FB.COPYCOMMAND
"Copies given notefile(s) to target file (or directory).")
(Rename FB.RENAMECOMMAND
"Moves given notefile(s) to target file (or directory)."))))
(NC.FileBrowserExpungeMenuItem (QUOTE (Expunge NC.FileBrowserExpunge
"Permanently removes from the file system all files marked for deletion")))
(NC.FileBrowserRecomputeMenuItem (QUOTE (Recompute
FB.UPDATECOMMAND
"Recomputes set of notefiles satisfying selection pattern"
(SUBITEMS ("Same Pattern"
FB.UPDATECOMMAND
"Recomputes set of files satisfying current pattern")
("New Pattern"
NC.FileBrowserRecomputeWithNewPattern
"Prompts for a new selection pattern and updates browser")
("New Info"
FB.NEWINFOCOMMAND
"Change the set of file attributes that are displayed")))))
)
(* * This replaces the two INITVARS near the bottom of NCINTERFACE)
(INITVARS (NC.FileBrowserMenuItems
(APPEND NC.FileBrowserMenuItemsToAdd
(for MenuItem in FB.MENU.ITEMS when
(FMEMB (CAR MenuItem)
NC.FileBrowserMenuItemsToKeep)
collect
(if (EQ (CAR MenuItem)
(QUOTE Recompute))
then NC.FileBrowserRecomputeMenuItem else
MenuItem))
(LIST NC.FileBrowserExpungeMenuItem)
(for MenuItem in FB.MENU.ITEMS unless
(OR (FMEMB (CAR MenuItem)
NC.FileBrowserMenuItemsToRemove)
(FMEMB (CAR MenuItem)
NC.FileBrowserMenuItemsToKeep))
collect MenuItem))))
(INITVARS (NC.FileBrowserPatterns NIL)
(NC.FileBrowserDefaultPatterns (QUOTE ({DSK}*.NOTEFILE;*))))
(* * New functions for NCINTERFACE)
(FNS NC.FileBrowserExpunge NC.GetFileBrowserPattern
NC.FileBrowserRecomputeWithNewPattern NC.FindFileBrowserWinForPattern)
(* * Changed functions for NCINTERFACE)
(FNS NC.FileBrowserCompact NC.FileBrowserClose NC.FileBrowserAbort
NC.FileBrowserCheckpoint NC.FileBrowserOpen NC.FileBrowserMenu
NC.FlashFileBrowserWin NC.GETPROMPTWINDOW)
(* * Changed functions for NCDATABASE)
(FNS NC.CompactNoteFile NC.DeleteDatabaseFile NC.AbortSession
NC.DoNoteFileOp NC.DatabaseFileName)))
(* * Changes for notefile browser related stuff. Also random other changes.)
(* * Add this near the file browser stuff in NCINTERFACE)
(DECLARE: EVAL@COMPILE
(FILESLOAD (FROM VALUEOF NOTECARDSDIRECTORIES)
(LOADCOMP)
FILEBROWSER)
)
(* * New globalvars for NCINTERFACE)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.FileBrowserExpungeMenuItem NC.FileBrowserRecomputeMenuItem
NC.FileBrowserMenuItemsToKeep)
)
(* * This should replace the VARS at the bottom of NCINTERFACE)
(RPAQQ NC.FileBrowserMenuItemsToRemove (Hardcopy See Edit Load Compile Copy Rename Expunge))
(RPAQQ NC.FileBrowserMenuItemsToKeep (Delete Undelete Recompute Sort))
(RPAQQ NC.FileBrowserMenuItemsToAdd ((Open NC.FileBrowserOpen "Open selected Notefiles.")
(Checkpoint NC.FileBrowserCheckpoint
"Checkpoint the selected Notefiles, saving dirty cards.")
(Close NC.FileBrowserClose "Close selected Notefiles.")
(Abort NC.FileBrowserAbort
"Aborts the selected Notefiles losing work since last checkpoint.")
(Compact NC.FileBrowserCompact
"Compacts selected Notefiles to target files."
(SUBITEMS (Compact% To% Target% File
NC.FileBrowserCompact
"Compacts selected Notefiles to target files.")
(Compact% In% Place (NC.FileBrowserCompact
(QUOTE InPlace))
"Compacts selected Notefiles in place.")))
(Inspect&Repair NC.FileBrowserInspect&Repair
"Inspects and optionally repairs selected Notefiles."
(SUBITEMS (Read% Substances
(NC.FileBrowserInspect&Repair
(QUOTE ReadSubstances))
"Inspects and optionally repairs selected Notefiles, but reads every substance. This slows things WAY down."
)))
(Copy FB.COPYCOMMAND
"Copies given notefile(s) to target file (or directory).")
(Rename FB.RENAMECOMMAND
"Moves given notefile(s) to target file (or directory).")))
(RPAQQ NC.FileBrowserExpungeMenuItem (Expunge NC.FileBrowserExpunge
"Permanently removes from the file system all files marked for deletion"))
(RPAQQ NC.FileBrowserRecomputeMenuItem (Recompute FB.UPDATECOMMAND
"Recomputes set of notefiles satisfying selection pattern"
(SUBITEMS ("Same Pattern" FB.UPDATECOMMAND
"Recomputes set of files satisfying current pattern")
("New Pattern"
NC.FileBrowserRecomputeWithNewPattern
"Prompts for a new selection pattern and updates browser")
("New Info" FB.NEWINFOCOMMAND
"Change the set of file attributes that are displayed"))))
(* * This replaces the two INITVARS near the bottom of NCINTERFACE)
(RPAQ? NC.FileBrowserMenuItems (APPEND NC.FileBrowserMenuItemsToAdd
(for MenuItem in FB.MENU.ITEMS when (FMEMB (CAR MenuItem)
NC.FileBrowserMenuItemsToKeep)
collect
(if (EQ (CAR MenuItem)
(QUOTE Recompute))
then NC.FileBrowserRecomputeMenuItem else MenuItem))
(LIST NC.FileBrowserExpungeMenuItem)
(for MenuItem in FB.MENU.ITEMS unless
(OR (FMEMB (CAR MenuItem)
NC.FileBrowserMenuItemsToRemove)
(FMEMB (CAR MenuItem)
NC.FileBrowserMenuItemsToKeep))
collect MenuItem)))
(RPAQ? NC.FileBrowserPatterns NIL)
(RPAQ? NC.FileBrowserDefaultPatterns (QUOTE ({DSK}*.NOTEFILE;*)))
(* * New functions for NCINTERFACE)
(DEFINEQ
(NC.FileBrowserExpunge
(LAMBDA (FBROWSER KEY ITEM MENU CMD) (* rht: " 2-Jul-86 18:20")
(* * Code stolen from FB.EXPUNGECOMMAND. Replaced call to DELFILE with call to NC.DeleteDatabaseFile.)
(PROG ((TBROWSER (fetch (FILEBROWSER TABLEBROWSER) of FBROWSER))
(NDELETED 0)
FILES FILENAME FAILED FILE)
(COND
((SETQ FILES (TB.COLLECT.ITEMS TBROWSER (QUOTE DELETED)))
(FB.PROMPTWPRINT FBROWSER T "Expunging deleted files...")
(for ITEM in FILES do (COND
((NC.DeleteDatabaseFile (SETQ FILENAME
(FB.FETCHFILENAME ITEM))
(fetch (FILEBROWSER
PROMPTWINDOW)
of FBROWSER)
T)
(add NDELETED 1)
(FB.REMOVE.FILE TBROWSER FBROWSER ITEM)
(FB.UPDATE.COUNTERS FBROWSER (QUOTE BOTH)))
(T (FB.PROMPTWPRINT FBROWSER T "Couldn't expunge "
FILENAME)
(SETQ FAILED T))))
(FB.PROMPTWPRINT FBROWSER (COND
((EQ NDELETED 0)
"
No")
(T (CONCAT (COND
(FAILED "
Done, but only ")
(T "done, "))
NDELETED)))
" files expunged.")
(COND
(FAILED (COND
(CMD (FB.PROMPTWPRINT FBROWSER " " CMD " aborted.")))
(RETURN))))
(T (FB.PROMPTWPRINT FBROWSER T "No files were marked for deletion")))
(RETURN T))))
(NC.GetFileBrowserPattern
(LAMBDA (MainWindow OldPattern) (* rht: " 2-Jul-86 22:34")
(* * Ask user to provide a new file browser pattern. Cancel if user provides an extension. Else, add .notefile
extension.)
(LET* ((Pattern (NC.AskUser "New pattern? " NIL OldPattern T MainWindow T T))
(PatternPlusExtension (AND Pattern (PACKFILENAME (QUOTE BODY)
Pattern
(QUOTE EXTENSION)
(QUOTE NOTEFILE)
(QUOTE VERSION)
(QUOTE *)
(QUOTE NAME)
(QUOTE *)))))
(PROG1 (if (EQ (U-CASE (FILENAMEFIELD PatternPlusExtension (QUOTE EXTENSION)))
(QUOTE NOTEFILE))
then (SETQ NC.FileBrowserPatterns (UNION NC.FileBrowserPatterns
(LIST PatternPlusExtension)))
PatternPlusExtension
else (NC.PrintMsg MainWindow T "Pattern must have either" (CHARACTER
13)
".NOTEFILE extension or no extension.")
(DISMISS 1000)
NIL)
(NC.ClearMsg MainWindow T)))))
(NC.FileBrowserRecomputeWithNewPattern
(LAMBDA (BROWSER) (* rht: " 2-Jul-86 15:04")
(* * Code basically stolen from FB.NEWPATTERNCOMMAND and FB.GET.NEWPATTERN. Just changed to call
NC.GetFileBrowserPattern.)
(LET (PATTERN)
(COND
((AND (FB.MAYBE.EXPUNGE BROWSER "New Pattern")
(SETQ PATTERN (LET* ((OLDPATTERN (fetch (FILEBROWSER PATTERN) of BROWSER))
(NEWPATTERN (NC.GetFileBrowserPattern
(fetch (FILEBROWSER PROMPTWINDOW)
of BROWSER)
OLDPATTERN)))
(COND
(NEWPATTERN (DIRECTORY.FILL.PATTERN NEWPATTERN))))))
(FB.SETNEWPATTERN BROWSER PATTERN)
(FB.UPDATEBROWSERITEMS BROWSER))))))
(NC.FindFileBrowserWinForPattern
(LAMBDA (Pattern NoteCardsIconWindow) (* rht: " 2-Jul-86 16:34")
(* * Look for a notefile file browser having given pattern.)
(for Win in (WINDOWPROP NoteCardsIconWindow (QUOTE FileBrowserWins))
when (AND (WINDOWP Win)
(OR (OPENWP Win)
(OPENWP (WINDOWPROP Win (QUOTE ICONWINDOW))))
(SETQ FileBrowser (WINDOWPROP (OR (WINDOWPROP Win (QUOTE ICONFOR))
Win)
(QUOTE FILEBROWSER)))
(EQ (U-CASE Pattern)
(U-CASE (MKATOM (fetch (FILEBROWSER PATTERN) of FileBrowser)))))
do (RETURN Win))))
)
(* * Changed functions for NCINTERFACE)
(DEFINEQ
(NC.FileBrowserCompact
(LAMBDA (Browser Key Item Menu InPlaceFlg) (* rht: " 2-Jul-86 18:09")
(* * Function called from file browser menu for notefile compact.)
(* * rht 7/2/86: Overhauled. Some code stolen from FB.COPY/RENAME.COMMAND. Much code stolen from
FB.COPY/RENAME.MANY)
(LET ((FILELIST (FB.SELECTEDFILES Browser)))
(COND
((NULL FILELIST))
((NULL (CDR FILELIST)) (* Just one file)
(NC.CompactNoteFile (MKATOM (FB.FETCHFILENAME (CAR FILELIST)))
NIL InPlaceFlg (fetch (FILEBROWSER PROMPTWINDOW) of Browser))
)
(T (* Many files to compact. Use code from
FB.COPY/RENAME.MANY with call to FB.COPY/RENAME.ONE
replaced by NC.CompactnoteFile.)
(PROG (PREFIX FIELDS SUBDIR RETAIN)
(COND
((NULL (SETQ PREFIX (FB.PROMPTFORINPUT (CONCAT "Compact "
(LENGTH FILELIST)
" files to which directory? ")
(OR (fetch (FILEBROWSER
DEFAULTDIR)
of Browser)
(DIRECTORYNAME T))
Browser T)))
(* Aborted)
)
((STRPOS "*" PREFIX)
(FB.PROMPTWPRINT Browser "Sorry, patterns not supported"))
((AND (OR (LISTGET (SETQ FIELDS (UNPACKFILENAME.STRING PREFIX))
(QUOTE HOST))
(LISTGET FIELDS (QUOTE DIRECTORY))
(LISTGET FIELDS (QUOTE DEVICE)))
(OR (LISTGET FIELDS (QUOTE NAME))
(LISTGET FIELDS (QUOTE EXTENSION))
(LISTGET FIELDS (QUOTE VERSION))))
(* Not a pure directory specification, and not just a
simple directory name)
(FB.PROMPTWPRINT Browser "Not a well-formed directory specification."))
(T
(replace (FILEBROWSER DEFAULTDIR) of Browser
with (PACKFILENAME.STRING (QUOTE BODY)
FIELDS
(QUOTE DIRECTORY)
(DIRECTORYNAME T)))
(* Now make sure the files are sorted by increasing
version, so that multiple versions get copied in the
right order)
(SETQ SUBDIR (fetch (FBFILEDATA SUBDIRECTORY)
of (fetch TIDATA of (CAR FILELIST))))
(COND
((for ITEM in (CDR FILELIST)
thereis (NOT (STRING-EQUAL SUBDIR (fetch (FBFILEDATA
SUBDIRECTORY)
of (fetch TIDATA
of ITEM)))))
(FB.PROMPTWPRINT Browser
"Selected files are in multiple subdirectories")
(SETQ RETAIN
(FB.PROMPTFORINPUT
(CONCAT "Retain subdirectory names below level of "
(for ITEM in (CDR FILELIST)
do (SETQ SUBDIR
(FB.GREATEST.PREFIX SUBDIR
(fetch (FBFILEDATA
SUBDIRECTORY)
of (fetch TIDATA
of ITEM))))
finally (RETURN
(OR SUBDIR (SETQ SUBDIR
(SUBSTRING (fetch (FILEBROWSER
PATTERN)
of Browser)
1
(fetch (FILEBROWSER
NAMESTART)
of Browser))))))
"?")
"Yes" Browser T T))
(SETQ RETAIN (COND
((NULL RETAIN) (* Aborted)
(RETURN))
((OR (STRING-EQUAL RETAIN "YES")
(STRING-EQUAL RETAIN "Y"))
(SETQ SUBDIR (ADD1 (NCHARS SUBDIR)))
(* First character that changes)
T)
((OR (STRING-EQUAL RETAIN "NO")
(STRING-EQUAL RETAIN "N"))
NIL)
(T (FB.PROMPTWPRINT Browser "?? ...Aborted.")
(RETURN))))))
(SELECTQ (fetch (FILEBROWSER SORTBY) of Browser)
(FB.NAMES.INCREASING.VERSION
(* Okay))
(FB.NAMES.DECREASING.VERSION (SETQ FILELIST
(FB.SORT.VERSIONS
FILELIST
(FUNCTION
FB.INCREASING.VERSION))))
(SORT FILELIST (FUNCTION FB.NAMES.INCREASING.VERSION)))
(SETQ PREFIX (\ADD.CONNECTED.DIR PREFIX))
(for ITEM in FILELIST
do
(LET ((OLDNAME (FB.FETCHFILENAME ITEM)))
(NC.CompactNoteFile
(MKATOM OLDNAME)
(MKATOM (PACKFILENAME.STRING
(QUOTE DIRECTORY)
PREFIX
(QUOTE DIRECTORY)
(COND
(RETAIN (* Subdirectory of name between common prefix and
root)
(SUBSTRING OLDNAME SUBDIR
(SUB1 (fetch (FBFILEDATA
STARTOFNAME)
of (fetch
TIDATA
of ITEM)))
)))
(QUOTE VERSION)
NIL
(QUOTE BODY)
OLDNAME))
InPlaceFlg
(fetch (FILEBROWSER PROMPTWINDOW) of Browser))))))))))))
(NC.FileBrowserClose
(LAMBDA (Browser Key Item Menu) (* rht: " 2-Jul-86 18:47")
(* * Function called from file browser menu for notefile close.)
(* * rht 7/2/86: Now passes proper InterestedWindow to NC.CloseDatabaseFile. Also calls FB.PROMPTWPRINT instead of
NC.PrintMsg.)
(for FileObject in (FB.SELECTEDFILES Browser)
do (LET* ((FileName (MKATOM (FB.FETCHFILENAME FileObject)))
(NoteFile (NC.NoteFileFromFileName FileName)))
(if (type? NoteFile NoteFile)
then (NC.CloseDatabaseFile NoteFile (fetch (FILEBROWSER PROMPTWINDOW)
of Browser))
else (FB.PROMPTWPRINT Browser T FileName " is not an open NoteFile!!!"))))))
(NC.FileBrowserAbort
(LAMBDA (Browser Key Item Menu) (* rht: " 2-Jul-86 19:05")
(* * Function called from file browser menu for notefile abort.)
(* * rht 7/2/86: Now passes InterestedWindow arg to NC.AbortSession)
(for FileObject in (FB.SELECTEDFILES Browser)
do (LET* ((FileName (MKATOM (FB.FETCHFILENAME FileObject)))
(NoteFile (NC.NoteFileFromFileName FileName)))
(if (type? NoteFile NoteFile)
then (NC.AbortSession NoteFile (fetch (FILEBROWSER PROMPTWINDOW)
of Browser))
else (FB.PROMPTWPRINT Browser T FileName " is not an open NoteFile!!!"))))))
(NC.FileBrowserCheckpoint
(LAMBDA (Browser Key Item Menu) (* rht: " 2-Jul-86 19:05")
(* * Function called from file browser menu for notefile checkpoint.)
(* * rht 7/2/86: Now passes InterestedWindow arg to NC.CheckpointDatabase.)
(for FileObject in (FB.SELECTEDFILES Browser)
do (LET* ((FileName (MKATOM (FB.FETCHFILENAME FileObject)))
(NoteFile (NC.NoteFileFromFileName FileName)))
(if (type? NoteFile NoteFile)
then (NC.CheckpointDatabase NoteFile NIL NIL NIL NIL (fetch (FILEBROWSER
PROMPTWINDOW)
of Browser))
else (NC.PrintMsg NIL NIL FileName " is not an open NoteFile!!!"
(CHARACTER 13)))))))
(NC.FileBrowserOpen
(LAMBDA (Browser Key Item Menu) (* rht: " 2-Jul-86 19:37")
(* * Function called from file browser menu for notefile open.)
(for FileObject in (FB.SELECTEDFILES Browser) do (NC.OpenDatabaseFile
(MKATOM (FB.FETCHFILENAME
FileObject))
NIL NIL NIL NIL NIL NIL NIL NIL NIL
(fetch (FILEBROWSER PROMPTWINDOW)
of Browser)))))
(NC.FileBrowserMenu
(LAMBDA (Window) (* rht: " 2-Jul-86 16:07")
(* * Bring up a notecards file browser after user selects pattern.)
(* * rht 7/2/86: Now calls NC.GetFileBrowserPattern. Also only stores file browser wins on the session icon
windowprop rather than both wins and patterns.)
(LET (Menu Selection)
(SETQ Menu (create MENU
ITEMS ←(APPEND (UNION NC.FileBrowserPatterns
NC.FileBrowserDefaultPatterns)
(QUOTE ((---% New% Pattern% ---(QUOTE
New% Pattern)
"Make a new Notefile browser pattern."))
))
TITLE ← "Notefile Browser Pattern"))
(if (EQ (SETQ Selection (MENU Menu))
(QUOTE New% Pattern))
then (* User wants to give us a new pattern.)
(SETQ Selection (NC.GetFileBrowserPattern Window NIL)))
(if Selection
then (* See if browser for that pattern already exists,
else create one and stash on the NC icon's window's
proplist.)
(OR (NC.FlashFileBrowserWin Selection Window)
(LET ((FileBrowserWins (WINDOWPROP Window (QUOTE FileBrowserWins)))
(FileBrowserWin (FILEBROWSER Selection NIL (BQUOTE (MENU.ITEMS
,
NC.FileBrowserMenuItems)))))
(WINDOWPROP Window (QUOTE FileBrowserWins)
(CONS FileBrowserWin FileBrowserWins))))))))
(NC.FlashFileBrowserWin
(LAMBDA (Pattern NoteCardsIconWindow) (* rht: " 2-Jul-86 16:07")
(* * Return the file browser window if any, corresponding to given pattern. Expand if shrunken and flash.)
(* * rht 5/2/86: Now will reexpand shrunken notefile browser but won't recover window if it's been closed.
Closing window screws up filebrowser.)
(* * rht 7/2/86: Changed to call NC.FindFileBrowserWinForPattern.)
(LET ((FileBrowserWin (NC.FindFileBrowserWinForPattern Pattern NoteCardsIconWindow))
IconWin)
(if (AND FileBrowserWin (OPENWP (SETQ IconWin (WINDOWPROP FileBrowserWin
(QUOTE ICONWINDOW)))))
then (EXPANDW IconWin))
(if (AND FileBrowserWin (OPENWP FileBrowserWin))
then (FLASHW FileBrowserWin)
FileBrowserWin
else NIL))))
(NC.GETPROMPTWINDOW
(LAMBDA (MAINWINDOW %#LINES FONT DONTCREATE MINWIDTH) (* rht: " 2-Jul-86 22:47")
(* makes sure that MAINWINDOW has an attached promptwindow and returns it. If one already exists, it is shaped to
be at least %#LINES high. If FONT is NIL, the font of the main window is used for the promptwindow.)
(* * fgh 6/6/86 Adapted from system GETPROMPTWINDOW. Added MINWIDTH arg.)
(* * rht 7/2/86: Now attaches prompt window on right if near right edge of screen.)
(PROG ((PWINDOWPROP (WINDOWPROP MAINWINDOW (QUOTE PROMPTWINDOW)))
(PWINDOWMINWIDTH (WINDOWPROP MAINWINDOW (QUOTE PROMPTWINDOWMINWIDTH)))
(MAINWINDOWREGION (WINDOWPROP MAINWINDOW (QUOTE REGION)))
PWINDOW PWINDOWREGION WIDTH HEIGHT OBSCUREDHEIGHT PWINDOW.PWINDOW PositionOnEdge)
(SETQ PositionOnEdge (if (GREATERP (PLUS (fetch (REGION LEFT) of
MAINWINDOWREGION)
(OR MINWIDTH PWINDOWMINWIDTH))
SCREENWIDTH)
then (QUOTE RIGHT)
else (QUOTE LEFT)))
(COND
(DONTCREATE (RETURN (CAR PWINDOWPROP)))
(PWINDOWPROP (SETQ PWINDOW (CAR PWINDOWPROP))
(COND
((NOT (OPENWP PWINDOW))
(ATTACHWINDOW PWINDOW MAINWINDOW (QUOTE TOP)
PositionOnEdge
(QUOTE LOCALCLOSE))))
(if (SETQ PWINDOW.PWINDOW (WINDOWPROP PWINDOW (QUOTE PROMPTWINDOW))
)
then (* This prompt window has a prompt window of its own.
Close and detach it.)
(FREEATTACHEDWINDOW (CAR PWINDOW.PWINDOW))
(CLOSEW (CAR PWINDOW.PWINDOW)))
(WINDOWPROP PWINDOW (QUOTE MAXSIZE)
(CONS 64000 64000))
(WINDOWPROP PWINDOW (QUOTE MINSIZE)
(CONS 1 1))
(SETQ HEIGHT (HEIGHTIFWINDOW (TIMES (OR %#LINES (CDR PWINDOWPROP)
1)
(FONTPROP (DSPFONT NIL
PWINDOW)
(QUOTE HEIGHT)))))
(SETQ WIDTH (MAX (WIDTHIFWINDOW (OR MINWIDTH PWINDOWMINWIDTH 1))
(fetch (REGION WIDTH) of MAINWINDOWREGION)))
(SETQ PWINDOWREGION (WINDOWPROP PWINDOW (QUOTE REGION)))
(COND
((OR (NOT (EQP HEIGHT (fetch (REGION HEIGHT) of PWINDOWREGION))
)
(NOT (EQP WIDTH (fetch (REGION WIDTH) of PWINDOWREGION))))
(* Window exists, but not right size.)
(SHAPEW PWINDOW
(if (EQ PositionOnEdge (QUOTE LEFT))
then (create REGION
using PWINDOWREGION HEIGHT ← HEIGHT WIDTH ←
WIDTH)
else (create REGION
BOTTOM ←(fetch (REGION BOTTOM)
of PWINDOWREGION)
LEFT ←(DIFFERENCE
(PLUS (fetch (REGION LEFT)
of MAINWINDOWREGION)
(fetch (REGION WIDTH)
of MAINWINDOWREGION))
WIDTH)
HEIGHT ← HEIGHT
WIDTH ← WIDTH)))
(RPLACD PWINDOWPROP %#LINES)
(* Fall through to check visibility)
)))
(T (SETQ PWINDOW (CREATEW (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(MAX (OR MINWIDTH 1)
(fetch (REGION WIDTH)
of MAINWINDOWREGION))
HEIGHT ←(SETQ HEIGHT
(HEIGHTIFWINDOW
(TIMES (OR %#LINES (SETQ %#LINES 1))
(FONTPROP (OR FONT
(SETQ FONT
(DSPFONT
NIL
MAINWINDOW)))
(QUOTE HEIGHT))))))
NIL NIL T))
(DSPSCROLL T PWINDOW)
(DSPFONT FONT PWINDOW)
(WINDOWPROP PWINDOW (QUOTE PAGEFULLFN)
(QUOTE NILL))
(ATTACHWINDOW PWINDOW MAINWINDOW (QUOTE TOP)
PositionOnEdge
(QUOTE LOCALCLOSE))
(WINDOWPROP MAINWINDOW (QUOTE PROMPTWINDOW)
(CONS PWINDOW %#LINES))
(WINDOWPROP PWINDOW (QUOTE OPENFN)
(FUNCTION \PROMPTWINDOW.OPENFN))))
(COND
((ILESSP (SETQ OBSCUREDHEIGHT (IDIFFERENCE SCREENHEIGHT
(fetch (REGION TOP)
of (WINDOWPROP PWINDOW
(QUOTE REGION))
)))
0) (* Promptwindow off screen at top, so slip window
group down to make it visible)
(RELMOVEW MAINWINDOW (create POSITION
XCOORD ← 0
YCOORD ← OBSCUREDHEIGHT))))
(WINDOWPROP PWINDOW (QUOTE MINSIZE)
(CONS 1 HEIGHT))
(WINDOWPROP PWINDOW (QUOTE MAXSIZE)
(CONS 64000 HEIGHT))
(WINDOWPROP MAINWINDOW (QUOTE PROMPTWINDOWMINWIDTH)
(OR MINWIDTH 1))
(OPENW PWINDOW)
(RETURN PWINDOW))))
)
(* * Changed functions for NCDATABASE)
(DEFINEQ
(NC.CompactNoteFile
(LAMBDA (FromNoteFile ToFileName InPlaceFlg PromptWindow)
(* rht: " 2-Jul-86 18:08")
(* * Compact a NoteFile. If InPlaceFlg is T calls NC.CompactNoteFileInPlace. Otherwise if ToFileName is NIL, asks
for a new file name.)
(* * fkr 11/8/85 Updated to handle new CardID scheme and NoteFile object.)
(* * kirk 19Nov85: Created from NC.CompactDatabaseInPlace to handle new NoteFile format)
(* * fgh 5/186 Totally rewritten to get rid of numerous bugs. Added new PromptWindow parameter.)
(* * rht 7/2/86: Fixed bug in call to NC.CompactToTarget and NC.CompactInPlace. They were being called with
FromNoteFile instead of (OR FromNoteFile FromFileName).)
(LET (WasOpen FromFileName ToNoteFile success)
(* * Get the name of the file to be compacted)
(SETQ FromFileName (COND
((NULL FromNoteFile)
(PROG1 (NC.DatabaseFileName "Name of NoteFile to be compacted:" " -- " T NIL NIL
PromptWindow)
(NC.ClearMsg PromptWindow)))
((type? NoteFile FromNoteFile)
(fetch (NoteFile FullFileName) of FromNoteFile))
(T FromNoteFile)))
(* * If compact to target, get the name of the target file)
(if (NULL InPlaceFlg)
then (SETQ ToFileName (OR ToFileName (PROG1 (NC.DatabaseFileName
"Name of target of compaction:"
" -- " T NIL
NIL
PromptWindow)
(NC.ClearMsg PromptWindow)))))
(* * As long as you have file names, go ahead!)
(if (AND FromFileName (OR InPlaceFlg ToFileName))
then
(* * Make full names)
(SETQ FromFileName (FULLNAME FromFileName (QUOTE OLD)))
(SETQ ToFileName (FULLNAME ToFileName (QUOTE NEW)))
(* * Close the file if its open)
(if (AND (SETQ FromNoteFile (NC.NoteFileFromFileName FromFileName))
(SETQ WasOpen (OPENP FromFileName)))
then (NC.CloseDatabaseFile FromNoteFile))
(* * Compact the file and reopen if successfull and was previously open)
(NC.PrintMsg NIL T "Compacting " FromFileName " ...")
(if (SETQ ToNoteFile (if InPlaceFlg
then (NC.CompactNoteFileInPlace (OR
FromNoteFile
FromFileName))
else (* compact to target)
(NC.CompactNoteFileToTarget (OR
FromNoteFile
FromFileName)
ToFileName)))
then (if WasOpen
then (NC.OpenDatabaseFile ToNoteFile)
else (NC.PrintMsg NIL T "Done compacting " FromFileName))
else (NC.PrintMsg NIL T "Compact of " FromFileName " cancelled."))))))
(NC.DeleteDatabaseFile
(LAMBDA (FileNameOrNoteFile InterestedWindow Don'tConfirmFlg)
(* rht: " 2-Jul-86 18:22")
(* Delete file FileName)
(* * rht 8/7/84: If delete happens, clear NC.DatabaseFileNameSuggestion.)
(* * rht 3/17/85: Fixed for case when user specifies version number of file to delete.)
(* * fkr 11/8/85: Ripped out PSA.Database check. Added check for file open.)
(* * kirk 23Jan86 Changed to use NC.AskYesOrNo)
(* * fgh 6/24/86 Added ability to pass down NoteFile object as well as file name. Added code to remove NF from NFs
hash array and remove the menu on the screen.)
(* * rht 7/2/86: No longer prints completed message with DISMISS. Now returns non-nil if successful.
Accepts Don'tConfirmFlg arg.)
(PROG ((FileName (if (type? NoteFile FileNameOrNoteFile)
then (fetch (NoteFile FullFileName) of FileNameOrNoteFile)
else FileNameOrNoteFile))
FullFileName) (* Make sure no open databases)
(* Get file name)
(AND (NULL FileName)
(NULL (SETQ FileName (NC.DatabaseFileName "Name of Notefile to be deleted:"
" -- "
T NIL NIL InterestedWindow)))
(RETURN NIL)) (* make sure to be deleted file exists)
(SETQ FullFileName (if (FILENAMEFIELD FileName (QUOTE VERSION))
then (FULLNAME FileName)
else (CAR (FILDIR-EARLIEST FileName))))
(COND
((NULL FullFileName)
(NC.PrintMsg (NC.AttachPromptWindow InterestedWindow)
T FileName " does not exist." (CHARACTER 13)
"Delete cancelled."
(CHARACTER 13))
(RETURN)))
(* * Can't delete an open file.)
(if (OPENP FullFileName)
then (NC.PrintMsg (NC.AttachPromptWindow InterestedWindow)
T FileName " is an open file." (CHARACTER 13)
"Delete cancelled."
(CHARACTER 13))
(RETURN)) (* Ask user to confirm twice.)
(OR Don'tConfirmFlg (COND
((NOT (NC.AskYesOrNo (CONCAT "Are you sure you want to delete "
(CHARACTER 13)
FullFileName "?" (CHARACTER 13))
" -- " "No" T (NC.AttachPromptWindow InterestedWindow)
(NOT InterestedWindow)))
(NC.PrintMsg (NC.AttachPromptWindow InterestedWindow)
T FullFileName " not deleted." (CHARACTER 13))
(RETURN))))
(NC.PrintMsg (NC.AttachPromptWindow InterestedWindow)
T "Deleteing " FullFileName (CHARACTER 13))
(DISMISS 1000)
(OR Don'tConfirmFlg (COND
((NOT (NC.AskYesOrNo (CONCAT "Are you still sure you want to delete "
(CHARACTER 13)
FullFileName "?" (CHARACTER 13))
" -- " "No" T (NC.AttachPromptWindow InterestedWindow)
(NOT InterestedWindow)))
(NC.PrintMsg (NC.AttachPromptWindow InterestedWindow)
T FullFileName " not deleted." (CHARACTER 13))
(RETURN))))
(* * Remove this NF from NoteFiles hash array. array and close down any menu)
(LET ((NoteFileObject (NC.NoteFileFromFileName FullFileName))
Menu)
(if NoteFileObject
then (PUTHASH (fetch (NoteFile UID) of NoteFileObject)
NIL NC.NoteFilesHashArray)
(SETQ Menu (fetch (NoteFile Menu) of NoteFileObject))
(if Menu
then (CLOSEW (WFROMMENU Menu)))))
(* * Delete the file)
(SETQ FullFileName (DELFILE FullFileName))
(SETQ NC.DatabaseFileNameSuggestion NIL)
(NC.ClearMsg (NC.AttachPromptWindow InterestedWindow)
T)
(RETURN FullFileName))))
(NC.AbortSession
(LAMBDA (NoteFile InterestedWindow) (* rht: " 2-Jul-86 19:44")
(* * Kill the current notecards session. Work lost since last checkpoint.)
(* * rht 7/14/85: Replaced the call to reset the main menu with call to NC.ResetMainMenu. Also took out redundant
reset of PSA.Database, since NC.ForceDatabaseClose is doing that.)
(* * fgh & rht 10/16/85 Update with new cacheing mechanism.)
(* * fkr 11/8/85 Updated to handle noteFile object and new CardID scheme.)
(* * kirk 20Jan86 Added Don'tCloseFlg to leave NoteFile open after done deleting changes.)
(* * kirk 23Jan86 Changed to use NC.AskYesOrNo)
(* * rht 7/2/86: No longer bugs you if no changes were made since last checkpoint. Removed Don'tCloseFlg arg and
added InterestedWindow arg.)
(LET ((Stream (fetch (NoteFile Stream) of NoteFile))
(FullFileName (fetch (NoteFile FullFileName) of NoteFile))
(LastChkptPtr (fetch (NoteFile CheckptPtr) of NoteFile))
EndPtr CardTotal NewBytes)
(if (AND (STREAMP Stream)
(OPENP Stream))
then (OR InterestedWindow (SETQ InterestedWindow (WFROMMENU (fetch
(NoteFile Menu)
of NoteFile))))
(SETQ EndPtr (GETEOFPTR Stream))
(SETQ NewBytes (IDIFFERENCE EndPtr LastChkptPtr))
(COND
((OR (ZEROP NewBytes)
(NC.AskYesOrNo (CONCAT
"Do you wish to lose all changes since the last checkpoint ("
NewBytes " bytes) of " FullFileName)
"--" "Yes" NIL InterestedWindow NIL T))
(LET ((CardNumber 0)
(CardTotal (fetch (NoteFile HashArraySize) of NoteFile)))
(NC.MapCards
NoteFile
(FUNCTION (LAMBDA (Card)
(LET (Win)
(SETQ CardNumber (ADD1 CardNumber))
(COND
((ZEROP (IREMAINDER CardNumber 100))
(NC.PrintMsg InterestedWindow T
"Quitting from active cards ... "
(CHARACTER 13)
"Processing item number " CardNumber
" out of "
CardTotal "." (CHARACTER 13))))
(COND
((NC.ActiveCardP Card)
(SETQ Win (NC.FetchWindow Card))
(NC.AbortCard Card)
(COND
(Win (bind (Process ←(WINDOWPROP Win (QUOTE
PROCESS)))
until (OR (NULL Process)
(PROCESS.FINISHEDP Process))
do (BLOCK))
(CLOSEW Win))))))))))
(COND
((LESSP LastChkptPtr EndPtr)
(NC.PrintMsg InterestedWindow T "Truncating file " FullFileName " ...")
(COND
((NOT (SETFILEINFO FullFileName (QUOTE LENGTH)
LastChkptPtr))
(NC.PrintMsg InterestedWindow NIL "Couldn't truncate " FullFileName
"."
(CHARACTER 13))))))
(NC.ResetNoteFileInterface NoteFile)
(NC.ForceDatabaseClose NoteFile))
(T (NC.ClearMsg InterestedWindow)))
else (NC.PrintMsg InterestedWindow T FullFileName " is not an open NoteFile!!!"
(CHARACTER 13))))))
(NC.DoNoteFileOp
(LAMBDA (Op) (* rht: " 2-Jul-86 18:46")
(* * Do a NoteFile op chosen from NC icon menu)
(* * rht 7/2/86: Now calls NC.AbortSession with NC.NoteCardsIconWindow arg.)
(SELECTQ Op
(Open% NoteFile (LET ((NoteFile (NC.ListOfNoteFilesMenu T NIL NC.NoteCardsIconWindow
(QUOTE Open% NoteFile))))
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.OpenDatabaseFile NoteFile NIL NIL NIL NIL NIL NIL
NIL NIL NIL
NC.NoteCardsIconWindow))))
(Checkpoint% NoteFile (LET ((NoteFile (NC.ListOfNoteFilesMenu NIL T
NC.NoteCardsIconWindow
(QUOTE
Checkpoint% NoteFile))))
(if NoteFile
then (NC.CheckpointDatabase NoteFile NIL NIL NIL
NIL
NC.NoteCardsIconWindow))))
(Close% NoteFile (LET ((NoteFile (NC.ListOfNoteFilesMenu NIL T
NC.NoteCardsIconWindow
(QUOTE Close% NoteFile))))
(if NoteFile
then (NC.CloseDatabaseFile NoteFile
NC.NoteCardsIconWindow))))
(Abort% NoteFile (LET ((NoteFile (NC.ListOfNoteFilesMenu NIL T
NC.NoteCardsIconWindow
(QUOTE Abort% NoteFile))))
(if NoteFile
then (NC.AbortSession NoteFile NC.NoteCardsIconWindow))))
(Compact% NoteFile (LET ((NoteFile (NC.ListOfNoteFilesMenu T NIL
NC.NoteCardsIconWindow
(QUOTE
Compact% NoteFile))))
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.CompactNoteFile NoteFile NIL NIL
NC.NoteCardsIconWindow))))
(Compact% In% Place (LET ((NoteFile (NC.ListOfNoteFilesMenu T NIL
NC.NoteCardsIconWindow
(QUOTE
Compact% NoteFile))))
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.CompactNoteFile NoteFile NIL T
NC.NoteCardsIconWindow))))
(Inspect&Repair% NoteFile (LET ((NoteFile (NC.ListOfNoteFilesMenu T NIL
NC.NoteCardsIconWindow
(QUOTE
Inspect&Repair% NoteFile))))
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.ScavengerPhase1 NoteFile))))
(Read% Substances (LET ((NoteFile (NC.ListOfNoteFilesMenu T NIL
NC.NoteCardsIconWindow
(QUOTE
Inspect&Repair% NoteFile))))
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.ScavengerPhase1 NoteFile T))))
(Copy% NoteFile (LET ((NoteFile (NC.ListOfNoteFilesMenu T (QUOTE CLOSED)
NC.NoteCardsIconWindow
(QUOTE Copy% NoteFile))))
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.CopyNoteFile NoteFile NIL NC.NoteCardsIconWindow)))
)
(Rename% NoteFile (LET ((NoteFile (NC.ListOfNoteFilesMenu T (QUOTE CLOSED)
(QUOTE Rename% NoteFile))
))
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.RenameNoteFile NoteFile NIL NC.NoteCardsIconWindow)
)))
(Delete% NoteFile (LET ((NoteFile (NC.ListOfNoteFilesMenu T (QUOTE CLOSED)
(QUOTE Delete% NoteFile))
))
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.DeleteDatabaseFile NoteFile
NC.NoteCardsIconWindow))))
(Create% NoteFile (NC.CreateDatabaseFile NIL NIL NIL NIL NIL NIL
NC.NoteCardsIconWindow))
NIL)))
(NC.DatabaseFileName
(LAMBDA (Msg Prompt ClearFirstFlg NoSuggestFlg Name InterestedWindow)
(* rht: " 2-Jul-86 19:48")
(* Make a NoteCards database file name on the base
specified by the user. Basically, add the NOTEFILE
extension)
(* * rht 8/7/84: Now provides file name suggestion for user (unless NoSuggestFlg is non-nil.) The suggestion is in
the global var NC.DatabaseFileNameSuggestion which is reset to the new file name before returning.)
(* * kirk 23Jan86 Added optional InterestedWindow)
(* * rht 7/2/86: Fixed to just pass InterestedWindow to NC.AskUser rather than computing the prompt window of
that.)
(OR Name (SETQ Name (MKATOM (NC.AskUser Msg Prompt (AND (NOT NoSuggestFlg)
NC.DatabaseFileNameSuggestion)
ClearFirstFlg InterestedWindow))))
(if Name
then (SETQ Name (PACKFILENAME (QUOTE BODY)
Name
(QUOTE EXTENSION)
(QUOTE NOTEFILE)))
(SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
(FULLNAME Name)))
Name
else NIL)))
)
(PUTPROPS RHTPATCH051 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (8517 12721 (NC.FileBrowserExpunge 8527 . 10020) (NC.GetFileBrowserPattern 10022 . 11167
) (NC.FileBrowserRecomputeWithNewPattern 11169 . 11972) (NC.FindFileBrowserWinForPattern 11974 . 12719
)) (12768 28946 (NC.FileBrowserCompact 12778 . 18290) (NC.FileBrowserClose 18292 . 19101) (
NC.FileBrowserAbort 19103 . 19841) (NC.FileBrowserCheckpoint 19843 . 20670) (NC.FileBrowserOpen 20672
. 21177) (NC.FileBrowserMenu 21179 . 22807) (NC.FlashFileBrowserWin 22809 . 23747) (
NC.GETPROMPTWINDOW 23749 . 28944)) (28992 45484 (NC.CompactNoteFile 29002 . 32017) (
NC.DeleteDatabaseFile 32019 . 36227) (NC.AbortSession 36229 . 39587) (NC.DoNoteFileOp 39589 . 44080) (
NC.DatabaseFileName 44082 . 45482)))))
STOP