(FILECREATED "30-Oct-85 15:54:10" {ERIS}<LISPUSERS>DIRGRAPHER.;2 61211
changes to: (VARS DIRGRAPHERCOMS DG.ERISTREE DG.ICON DG.MASK DG.FILL-WINDOW-TEXTURE DG.WHITEBM)
previous date: "15-Jul-85 13:19:37" {ERIS}<LISPUSERS>DIRGRAPHER.;1)
(* Copyright (c) 1985 by Shaul Markovitch. All rights reserved.)
(PRETTYCOMPRINT DIRGRAPHERCOMS)
(RPAQQ DIRGRAPHERCOMS [(INITVARS (* * VARIABLES TO BE SET BY THE USER)
[DG.ICONFONT (FONTCREATE (QUOTE (GACHA 8]
[DG.PROMPTWINDOWFONT (FONTCREATE (QUOTE (GACHA 8]
[DG.GRAPH-LABEL-FONT (FONTCREATE (QUOTE (GACHA 8]
(DG.VERTICAL-HORIZONTAL-OPTION (QUOTE VERTICAL))
(DG.COPY-OVER NIL)
(DG.BOX-ALL T)
(DG.DEFAULT-DIR (QUOTE {DSK}<LISPFILES>))
(DG.CONCURRENT NIL)
(DG.CONCURRENT-ALL T)
(DG.MAX-WIDTH 900)
(DG.MAX-HEIGHT 700)
(DG.MIN-WIDTH 200)
(DG.MIN-HEIGHT 100)
(DG.MENU-EDGE (QUOTE RIGHT))
(DG.DEFAULT-BACKUP-DIRECTORY (QUOTE {FLOPPY}))
(* * PROGRAM VARIABLES)
(DG.DIRECTORY-WAS-SELECTED-EVENT (CREATE.EVENT))
(DG.MONITOR-LOCK (CREATE.MONITORLOCK "DG.MONITOR"))
(DG.LAST-DIRECTORY-SELECTED NIL)
(DG.WINDOW-OF-LAST-DIRECTORY NIL))
(FNS DG.ADD-ITEM-TO-BACKGROUND-MENU DG.ADVISE-GENERATE-FILE DG.APPLY-DIRGRAPHER-COMMAND
DG.APPLY-FB-ON-DIR-AND-SUBDIRS-COMMAND DG.APPLY-FILEBROWSER-COMMAND
DG.ASK-FOR-BACKUP-TYPE DG.ATTACH-DIRECTORY-FILES-MENU DG.BACKUP-COMMAND
DG.BACKUP-ON-DEFAULT-COMMAND DG.BACKUP-ON-SELECTED-COMMAND DG.CONNECT-DIR-COMMAND
DG.COPY-DIRECTORY-COMMAND DG.COPY-FILE-COMMAND DG.COPYBUTTONEVENTFN
DG.CREATE-BACKUP-NAME DG.CREATE-DIRECTORY-CHAIN DG.CREATE-DIRECTORY-SPEC
DG.CREATE-DIRECTORY-TREE DG.CREATE-GRAPH-FROM-TREE DG.CREATE-ICON-TITLE DG.CREATE-MENU
DG.CREATE-PATH-FROM-FILE-NAME DG.CREATE-PREFIX-FROM-PATH DG.CREATE-QUIT-MENU
DG.CREATE-SUBDIR-COMMAND DG.CREATE-TREE-FROM-LISTS DG.CREATE-TREE-NODES DG.CREATEICONW
DG.CURRENT-CONNECTED-DIRECTORY DG.DELETE-DIRECTORY-COMMAND DG.DELETE-FROM-TREE
DG.DIRECTORY-MINUS-PREFIX DG.DIRECTORY-SELECTION-FUNCTION DG.DISPLAY-DIRECTORY-TREE
DG.DOCOMMAND DG.DOCOMMAND-WITH-MONITOR DG.DOCOMMAND-WITHOUT-MONITOR
DG.EXCLUSIVE-DIRECTORY DG.FBICONFN DG.FILE-SELECTION-FN DG.FILECOPY
DG.FIND-DIRECTORY-SUBTREE DG.FIND-PARENT-DIERCTORY DG.FLASHALLWINDOWS
DG.GET-INITIAL-REGION DG.KILL-PROCESS DG.MOVE-DIR-COMMAND DG.MOVE-FILE-COMMAND
DG.MOVECOPY-COMMAND DG.MOVECOPY-DIR-COMMAND DG.PACK-NAME-VER-EXT DG.PROMPTWINDOW
DG.REDISPLAYFN DG.RESIDUAL-PATH DG.RESTORE-COMMAND DG.RESTORE-FROM-DEFAULT-COMMAND
DG.RESTORE-FROM-SELECTED-COMMAND DG.SETIFY DG.SHADE-CURRENT-DIRECTORY DG.TRIM
DG.UNADVISE DG.UNADVISE-GENERATE-FILE DG.UNPACK-DIRECTORY-NAME DG.UPDATE-COMMAND
DG.UPDATE-DIRECTORY-TREE DG.UPDATE-DIRECTROY-TREE DG.WAIT-FOR-DIR-SELECTION DIRGRAPHER)
(BITMAPS DG.ICON DG.MASK DG.FILL-WINDOW-TEXTURE DG.WHITEBM)
(DECLARE: DONTEVAL@LOAD DOCOPY (FILES GRAPHER ICONW FILEBROWSER)
(P (DG.ADVISE-GENERATE-FILE)
(DG.ADD-ITEM-TO-BACKGROUND-MENU (QUOTE DirGrapher)
(QUOTE (DIRGRAPHER))
"Will initiate dirgrapher process on the current directory"
(QUOTE (SUBITEMS ({FLOPPY} (DIRGRAPHER
(QUOTE {FLOPPY})))
({DSK}<LISPFILES>
(DIRGRAPHER (QUOTE
{DSK}<LISPFILES>])
(RPAQ? DG.ICONFONT (FONTCREATE (QUOTE (GACHA 8))))
(RPAQ? DG.PROMPTWINDOWFONT (FONTCREATE (QUOTE (GACHA 8))))
(RPAQ? DG.GRAPH-LABEL-FONT (FONTCREATE (QUOTE (GACHA 8))))
(RPAQ? DG.VERTICAL-HORIZONTAL-OPTION (QUOTE VERTICAL))
(RPAQ? DG.COPY-OVER NIL)
(RPAQ? DG.BOX-ALL T)
(RPAQ? DG.DEFAULT-DIR (QUOTE {DSK}<LISPFILES>))
(RPAQ? DG.CONCURRENT NIL)
(RPAQ? DG.CONCURRENT-ALL T)
(RPAQ? DG.MAX-WIDTH 900)
(RPAQ? DG.MAX-HEIGHT 700)
(RPAQ? DG.MIN-WIDTH 200)
(RPAQ? DG.MIN-HEIGHT 100)
(RPAQ? DG.MENU-EDGE (QUOTE RIGHT))
(RPAQ? DG.DEFAULT-BACKUP-DIRECTORY (QUOTE {FLOPPY}))
(RPAQ? DG.DIRECTORY-WAS-SELECTED-EVENT (CREATE.EVENT))
(RPAQ? DG.MONITOR-LOCK (CREATE.MONITORLOCK "DG.MONITOR"))
(RPAQ? DG.LAST-DIRECTORY-SELECTED NIL)
(RPAQ? DG.WINDOW-OF-LAST-DIRECTORY NIL)
(DEFINEQ
(DG.ADD-ITEM-TO-BACKGROUND-MENU
[LAMBDA (LABEL COMMAND MESSAGE SUBITEMLIST) (* edited: "26-Mar-85 11:50")
(SETQ BackgroundMenuCommands (REMOVE (FASSOC LABEL BackgroundMenuCommands)
BackgroundMenuCommands))
(NCONC1 BackgroundMenuCommands (LIST LABEL COMMAND MESSAGE SUBITEMLIST))
(SETQ BackgroundMenu NIL])
(DG.ADVISE-GENERATE-FILE
[LAMBDA NIL (* sm "11-Jul-85 19:32")
(MOVD (QUOTE \GENERATENEXTFILE)
(QUOTE DG.GENERATE-NEXT-FILE)
T)
(UNADVISE (\GENERATENEXTFILE IN FB.UPDATEBROWSERITEMS))
(ADVISE (QUOTE (\GENERATENEXTFILE IN FB.UPDATEBROWSERITEMS))
(QUOTE AROUND)
(QUOTE (PROG (NEXT-FILE TEMP-HOST TEMP-SCRATCHLIST)
(if (BOUNDP (QUOTE SCRATCHLIST))
then (SETQ TEMP-SCRATCHLIST SCRATCHLIST)
else (SETQ TEMP-SCRATCHLIST NIL))
NEXT
(SETQ NEXT-FILE (DG.GENERATE-NEXT-FILE GENOBJ NAMEONLY TEMP-SCRATCHLIST))
(if (NULL NEXT-FILE)
then (RETURN NIL))
(if (LISTP NEXT-FILE)
then (SETQ NEXT-FILE (PACKC NEXT-FILE)))
(if [OR (NOT (WINDOWPROP (MAINWINDOW WINDOW)
(QUOTE DG.DIRECTORY-ONLY)))
(AND [EQ (U-CASE (FILENAMEFIELD NEXT-FILE (QUOTE DIRECTORY)))
(U-CASE (FILENAMEFIELD (WINDOWPROP (MAINWINDOW WINDOW)
(QUOTE ITEMSPEC))
(QUOTE DIRECTORY]
(EQ (FILENAMEFIELD NEXT-FILE (QUOTE HOST))
(OR [CANONICAL.HOSTNAME (SETQ TEMP-HOST
(FILENAMEFIELD
(WINDOWPROP (MAINWINDOW WINDOW)
(QUOTE ITEMSPEC))
(QUOTE HOST]
TEMP-HOST]
then (RETURN NEXT-FILE)
else (GO NEXT])
(DG.APPLY-DIRGRAPHER-COMMAND
[LAMBDA (WINDOW) (* edited: " 3-Apr-85 11:27")
(PROG (CURRENT-PATH DIR-FILE-LIST FB-WINDOW TEMP-STRING)
(SETQ CURRENT-PATH (CAR (DG.WAIT-FOR-DIR-SELECTION WINDOW
"Select directory on which to apply DirGrapher.")))
(COND
(CURRENT-PATH (INVERTW WINDOW)
(DIRGRAPHER (DG.CREATE-PREFIX-FROM-PATH CURRENT-PATH))
(INVERTW WINDOW])
(DG.APPLY-FB-ON-DIR-AND-SUBDIRS-COMMAND
[LAMBDA (WINDOW) (* sm "10-Jun-85 14:42")
(DG.APPLY-FILEBROWSER-COMMAND WINDOW T])
(DG.APPLY-FILEBROWSER-COMMAND
[LAMBDA (WINDOW SUBDIRS) (* sm " 9-Jul-85 11:00")
(PROG (CURRENT-PATH DIR-FILE-LIST FB-WINDOW TEMP-STRING)
(SETQ CURRENT-PATH (CAR (DG.WAIT-FOR-DIR-SELECTION WINDOW
"Select directory on which to apply FileBrowser.")))
(COND
(CURRENT-PATH (INVERTW WINDOW)
(SETQ FB-WINDOW (FILEBROWSER (DG.CREATE-PREFIX-FROM-PATH CURRENT-PATH)))
(if (NOT SUBDIRS)
then (WINDOWPROP FB-WINDOW (QUOTE DG.DIRECTORY-ONLY)
T))
(WINDOWPROP FB-WINDOW (QUOTE ICONTITLE)
(DG.CREATE-ICON-TITLE CURRENT-PATH))
(WINDOWPROP FB-WINDOW (QUOTE ICONFN)
(QUOTE DG.FBICONFN))
(INVERTW WINDOW])
(DG.ASK-FOR-BACKUP-TYPE
[LAMBDA (CURRENT-DIRECTORY) (* sm " 9-Jun-85 11:53")
(PROG (BACKUP-TYPE)
[COND
((NULL (CDR CURRENT-DIRECTORY))
(SETQ BACKUP-TYPE (QUOTE FILES-ONLY)))
(T (SETQ BACKUP-TYPE (MENU (create MENU
ITEMS ←[LIST (LIST
"Back up files in this directory (but not in subdirectories)"
(QUOTE (QUOTE FILES-ONLY)))
(LIST
"Backup files of this directory and subdirectories"
(QUOTE (QUOTE FILES-AND-SUBS]
MENUFONT ← BIGFONT)
NIL T]
(RETURN BACKUP-TYPE])
(DG.ATTACH-DIRECTORY-FILES-MENU
[LAMBDA (PATH WINDOW MAIN-WINDOW) (* edited: "22-May-85 12:30")
(PROG (MENU FILE-LIST)
(SETQ FILE-LIST (for F in (DG.EXCLUSIVE-DIRECTORY (DG.CREATE-PREFIX-FROM-PATH PATH))
collect (DG.PACK-NAME-VER-EXT F)))
(SETQ MENU-WINDOW (ATTACHMENU (create MENU
ITEMS ←(CONS (QUOTE STOP)
FILE-LIST)
WHENSELECTEDFN ←(QUOTE DG.FILE-SELECTION-FN)
MENUCOLUMNS ←(MAX 1 (IQUOTIENT (CAR (WINDOWSIZE
MAIN-WINDOW))
120))
MENUFONT ←(FONTCREATE (QUOTE GACHA)
8))
MAIN-WINDOW
(if (GREATERP (IPLUS (fetch BOTTOM of (WINDOWREGION
MAIN-WINDOW))
(IQUOTIENT (CDR (WINDOWSIZE MAIN-WINDOW))
2))
540)
then (QUOTE BOTTOM)
else (QUOTE TOP))
(QUOTE JUSTIFY)))
(RETURN MENU-WINDOW])
(DG.BACKUP-COMMAND
[LAMBDA (WINDOW BACKUP-DIR) (* sm "10-Jun-85 13:27")
(PROG (BACKUP-TYPE SOURCE-PATH SOURCE-DIRECTORY FILES-TO-BACKUP ROUND-OF-FILES FILES-BACKUP-NAMES
BACKUP-HOST OLDCOPYRIGHTFLG SOURCE-PATH-AND-WINDOW SOURCE-WINDOW)
(SETQ SOURCE-PATH-AND-WINDOW (DG.WAIT-FOR-DIR-SELECTION WINDOW
"Select the directory that you want to back up."
T))
(SETQ SOURCE-PATH (CAR SOURCE-PATH-AND-WINDOW))
(SETQ SOURCE-WINDOW (CADR SOURCE-PATH-AND-WINDOW))
(SETQ SOURCE-DIRECTORY (DG.FIND-DIRECTORY-SUBTREE SOURCE-PATH SOURCE-WINDOW))
(SETQ BACKUP-TYPE (DG.ASK-FOR-BACKUP-TYPE SOURCE-DIRECTORY))
[if (NULL (FILENAMEFIELD BACKUP-DIR (QUOTE DIRECTORY)))
then (SETQ BACKUP-DIR (PACK* BACKUP-DIR (QUOTE <]
(SETQ BACKUP-HOST (FILENAMEFIELD BACKUP-DIR (QUOTE HOST)))
(INVERTW WINDOW)
[SETQ FILES-TO-BACKUP (if (EQ BACKUP-TYPE (QUOTE FILES-AND-SUBS))
then (DIRECTORY (DG.CREATE-PREFIX-FROM-PATH SOURCE-PATH))
else (DG.EXCLUSIVE-DIRECTORY (DG.CREATE-PREFIX-FROM-PATH
SOURCE-PATH]
(SETQ FILES-BACKUP-NAMES (for F in FILES-TO-BACKUP collect (DG.CREATE-BACKUP-NAME F
SOURCE-PATH
SOURCE-DIRECTORY)))
(SETQ DG.FILES-BACKUP-NAMES FILES-BACKUP-NAMES)
(SETQ DG.DIRECTORY-SUBTREE SOURCE-DIRECTORY)
[SET (FILECOMS (QUOTE BACKUPINFO))
(QUOTE ((VARS DG.FILES-BACKUP-NAMES DG.DIRECTORY-SUBTREE]
(PUTPROP (QUOTE BACKUPINFO)
(QUOTE FILETYPE)
(QUOTE DON'TLIST))
(COND
((EQ BACKUP-TYPE (QUOTE FILES-AND-SUBS))
(SETQ DG.DIRECTORY-SUBTREE SOURCE-DIRECTORY))
(T (SETQ DG.DIRECTORY-SUBTREE NIL)))
(if (EQ BACKUP-HOST (QUOTE FLOPPY))
then (INVERTW WINDOW)
(printout (DG.PROMPTWINDOW WINDOW)
T "Insert floppy .")
(FLOPPY.WAIT.FOR.FLOPPY)
(INVERTW WINDOW))
(SETQ OLDCOPYRIGHTFLG COPYRIGHTFLG)
(SETQ COPYRIGHTFLG NIL)
(MAKEFILE (PACK* BACKUP-DIR (CAR SOURCE-DIRECTORY)
(QUOTE >)
(QUOTE BACKUPINFO))
(QUOTE NEW))
(SETQ COPYRIGHTFLG OLDCOPYRIGHTFLG)
(while FILES-TO-BACKUP
do [for F1 in FILES-TO-BACKUP as F2 in FILES-BACKUP-NAMES
do (if (AND (NOT DG.COPY-OVER)
(DIRECTORY (PACK* BACKUP-DIR F2)))
then (printout (DG.PROMPTWINDOW WINDOW)
T "File " F1 " exists on " BACKUP-DIR " and was not copied.")
(SETQ FILES-TO-BACKUP (REMOVE F1 FILES-TO-BACKUP))
(SETQ FILES-BACKUP-NAMES (REMOVE F2 FILES-BACKUP-NAMES))
else (if (AND DG.COPY-OVER (DIRECTORY (PACK* BACKUP-DIR F2)))
then (DELFILE (PACK* BACKUP-DIR F2)))
(if (OR (NEQ BACKUP-HOST (QUOTE FLOPPY))
(GREATERP (FLOPPY.FREE.PAGES)
(IPLUS (GETFILEINFO F1 (QUOTE SIZE))
400)))
then (if (DG.FILECOPY F1 (PACK* BACKUP-DIR F2)
DG.COPY-OVER)
then (printout (DG.PROMPTWINDOW WINDOW)
T "File " F1 " is backed up.")
else (printout (DG.PROMPTWINDOW WINDOW)
T "File " F1 " exists on " BACKUP-DIR
" and was not copied."))
(SETQ FILES-TO-BACKUP (REMOVE F1 FILES-TO-BACKUP))
(SETQ FILES-BACKUP-NAMES (REMOVE F2 FILES-BACKUP-NAMES]
(if FILES-TO-BACKUP
then (INVERTW WINDOW)
(CLEARW (DG.PROMPTWINDOW WINDOW))
(printout (DG.PROMPTWINDOW WINDOW)
T "No more space on this floppy. Insert a new one. ")
(FLASHWINDOW (DG.PROMPTWINDOW WINDOW)
3)
[for I from 100 to 1000 by 200 do (PLAYTUNE (LIST (CONS I 5000]
(FLOPPY.WAIT.FOR.FLOPPY T)
(INVERTW WINDOW)))
(SETQ FILELST (REMOVE (QUOTE BACKUPINFO)
FILELST))
(INVERTW WINDOW])
(DG.BACKUP-ON-DEFAULT-COMMAND
[LAMBDA (WINDOW) (* sm " 8-Jun-85 12:22")
(if (NULL DG.DEFAULT-BACKUP-DIRECTORY)
then (DG.FLASHALLWINDOWS WINDOW)
(PRINTOUT (DG.PROMPTWINDOW WINDOW)
T "NULL default directory.Backup aborted")
else (DG.BACKUP-COMMAND WINDOW DG.DEFAULT-BACKUP-DIRECTORY])
(DG.BACKUP-ON-SELECTED-COMMAND
[LAMBDA (WINDOW) (* sm " 8-Jun-85 12:49")
(PROG (BACKUP-DIRECTORY)
[SETQ BACKUP-DIRECTORY (DG.CREATE-PREFIX-FROM-PATH (CAR (DG.WAIT-FOR-DIR-SELECTION WINDOW
"Select the directory that will contain the backup."
T]
(DG.BACKUP-COMMAND WINDOW BACKUP-DIRECTORY])
(DG.CONNECT-DIR-COMMAND
[LAMBDA (WINDOW) (* edited: " 3-Apr-85 22:08")
(PROG (CURRENT-PATH CURRENT-PREFIX)
(SETQ CURRENT-PATH (CAR (DG.WAIT-FOR-DIR-SELECTION WINDOW
"Select the directory to which you want to be connected")))
(COND
(CURRENT-PATH (CNDIR (SETQ CURRENT-PREFIX (DG.CREATE-PREFIX-FROM-PATH CURRENT-PATH)))
(if DG.BOX-ALL
then (for W in (OPENWINDOWS) when (WINDOWPROP W (QUOTE DG.TREE))
do (DG.SHADE-CURRENT-DIRECTORY W))
else (DG.SHADE-CURRENT-DIRECTORY WINDOW])
(DG.COPY-DIRECTORY-COMMAND
[LAMBDA (WINDOW) (* edited: " 2-Apr-85 18:02")
(DG.MOVECOPY-DIR-COMMAND WINDOW])
(DG.COPY-FILE-COMMAND
[LAMBDA (WINDOW) (* edited: " 2-Apr-85 18:05")
(DG.MOVECOPY-COMMAND WINDOW])
(DG.COPYBUTTONEVENTFN
[LAMBDA (WINDOW) (* sm " 9-Jul-85 12:28")
(PROG (CURSOR-POS SELECTED-NODE NODE-REGION RELEASED)
(SETQ CURSOR-POS (CURSORPOSITION NIL WINDOW))
[SETQ RELEASED (MOUSESTATE (AND (NOT LEFT)
(NOT MIDDLE)
(NOT RIGHT]
(if (SETQ SELECTED-NODE (for NODE in (fetch GRAPHNODES of (WINDOWPROP WINDOW (QUOTE GRAPH)))
thereis (INSIDEP (SETQ NODE-REGION (NODEREGION NODE))
CURSOR-POS)))
then (FLIPNODE SELECTED-NODE WINDOW)
else (GRAPHERCOPYBUTTONEVENTFN WINDOW))
(if (AND RELEASED SELECTED-NODE)
then (BKSYSBUF (DG.CREATE-PREFIX-FROM-PATH (APPEND (WINDOWPROP WINDOW (QUOTE
DG.PATH-TO-ROOT))
(CDR (fetch NODEID of SELECTED-NODE])
(DG.CREATE-BACKUP-NAME
[LAMBDA (F CURRENT-PATH CURRENT-DIRECTORY) (* edited: " 5-Apr-85 10:34")
(PROG (SECOND-HALF FILE-BACKUP-NAME)
[SETQ SECOND-HALF (SUBSTRING (FILENAMEFIELD F (QUOTE DIRECTORY))
[IPLUS 2 (NCHARS (DG.CREATE-DIRECTORY-CHAIN (CDR CURRENT-PATH]
(NCHARS (FILENAMEFIELD F (QUOTE DIRECTORY]
[SETQ FILE-BACKUP-NAME (PACKFILENAME (QUOTE DIRECTORY)
(COND
(SECOND-HALF (DG.CREATE-DIRECTORY-CHAIN
(LIST (CAR CURRENT-DIRECTORY)
SECOND-HALF)))
(T (CAR CURRENT-DIRECTORY)))
(QUOTE NAME)
(FILENAMEFIELD F (QUOTE NAME))
(QUOTE EXTENSION)
(FILENAMEFIELD F (QUOTE EXTENSION))
(QUOTE VERSION)
(FILENAMEFIELD F (QUOTE VERSION]
(RETURN (PACK (CDR (UNPACK FILE-BACKUP-NAME])
(DG.CREATE-DIRECTORY-CHAIN
[LAMBDA (PATH) (* sm " 9-Jun-85 11:49")
(COND
((NULL PATH)
(QUOTE ""))
((NULL (CDR PATH))
(CAR PATH))
(T (PACK* (CAR PATH)
(QUOTE >)
(DG.CREATE-DIRECTORY-CHAIN (CDR PATH])
(DG.CREATE-DIRECTORY-SPEC
[LAMBDA (PATH WINDOW) (* edited: "31-Dec-00 22:14")
(PROG (CURRENT-DIRECTORY SPEC)
(SETQ CURRENT-DIRECTORY (DG.FIND-DIRECTORY-SUBTREE PATH WINDOW))
(SETQ SPEC (DG.CREATE-PREFIX-FROM-PATH PATH))
[for SUB in (CDR CURRENT-DIRECTORY) do (SETQ SPEC (LIST SPEC (QUOTE -)
(DG.CREATE-PREFIX-FROM-PATH
(APPEND PATH (LIST (CAR SUB]
(RETURN SPEC])
(DG.CREATE-DIRECTORY-TREE
[LAMBDA (PATH) (* edited: " 7-Apr-85 20:51")
(PROG (TREE-PATHS ROOT TREE)
[SETQ TREE-PATHS (for F in (DIRECTORY (DG.CREATE-PREFIX-FROM-PATH PATH))
collect (NTH (DG.CREATE-PATH-FROM-FILE-NAME F)
(LENGTH PATH]
(SETQ TREE-PATHS (DG.SETIFY TREE-PATHS))
(SETQ TREE (CAR (DG.CREATE-TREE-FROM-LISTS TREE-PATHS)))
(if TREE
then (RETURN TREE)
else (RETURN (LAST PATH])
(DG.CREATE-GRAPH-FROM-TREE
[LAMBDA (TREE) (* edited: "29-Mar-85 14:05")
(PROG (NODE-LIST)
(SETQ NODE-LIST (DG.CREATE-TREE-NODES TREE NIL))
(RETURN (LAYOUTGRAPH (CDR NODE-LIST)
(LIST (CAR NODE-LIST))
(LIST DG.VERTICAL-HORIZONTAL-OPTION)
DG.GRAPH-LABEL-FONT])
(DG.CREATE-ICON-TITLE
[LAMBDA (L) (* edited: " 5-Apr-85 11:16")
(COND
[L [COND
((GREATERP (LENGTH L)
3)
(SETQ L (CDR (LASTN L 3]
(APPLY (QUOTE CONCAT)
(CONS (DG.TRIM (CAR L)
11)
(for W in (CDR L) collect (CONCAT (CHARACTER 13)
(DG.TRIM W 11]
(T " "])
(DG.CREATE-MENU
[LAMBDA (WINDOW) (* sm "10-Jun-85 14:44")
(PROG (MENUITEMS TEMP)
[SETQ MENUITEMS (QUOTE (("Create Dir" DG.CREATE-SUBDIR-COMMAND
"Creates subdirectory. Will wait for parent directory selection, and prompt for subdirectory name")
("Delete Dir" DG.DELETE-DIRECTORY-COMMAND
"Will delete entire directory including all files in subdirectories. Will wait for directory selection and if the directory is nonempty it will ask for confirmation"
)
("Backup Dir" DG.BACKUP-ON-SELECTED-COMMAND
"Will ask you to select the directory on which the backup should be stored"
(SUBITEMS ("On default" DG.BACKUP-ON-DEFAULT-COMMAND
"Will backup the selected directory on the default backup directory (the value of DG.DEFAULT-BACKUP-DIRECTORY ) "
)
("On selected"
DG.BACKUP-ON-SELECTED-COMMAND
"Will ask you to select the directory on which the backup should be stored")))
("Restore Dir" DG.RESTORE-FROM-SELECTED-COMMAND
"Will ask you to select the directory from where the backup should be restored"
(SUBITEMS ("From default"
DG.RESTORE-FROM-DEFAULT-COMMAND
"Will restore the selected directory from the default backup directory (the value of DG.DEFAULT-BACKUP-DIRECTORY ) "
)
("From selected"
DG.RESTORE-FROM-SELECTED-COMMAND
"Will ask you to select the directory from where the backup should be restored")))
("Move Dir" DG.MOVE-DIR-COMMAND
"Will move the selected directory (including subdirectories) to a new parent directory.")
("Copy Dir" DG.COPY-DIRECTORY-COMMAND
"Will copy the selected directory (including subdirectories) to a new parent directory.")
("Connect Dir" DG.CONNECT-DIR-COMMAND
"Changes the current directory")
("Apply DG" DG.APPLY-DIRGRAPHER-COMMAND
"Calls DirGrapher on the selected directory")
("Apply FB" DG.APPLY-FILEBROWSER-COMMAND
"Calls FileBrowser on files in the selected directory (but not files in the subdirectories)."
(SUBITEMS ("on directory only"
DG.APPLY-FILEBROWSER-COMMAND
"Calls FileBrowser on files in the selected directory (but not files in the subdirectories).")
("On directory and subdirectories"
DG.APPLY-FB-ON-DIR-AND-SUBDIRS-COMMAND
"Calls FileBrowser on files in the selected directory and subdirectories.")))
("Move File(s)" DG.MOVE-FILE-COMMAND
"Will ask you to select: (1) source directory, (2) files to be moved, and (3) target directory.")
("Copy File(s)" DG.COPY-FILE-COMMAND
"Will ask you to select: (1) source directory, (2) files to be copied, and (3) target directory.")
("Update" DG.UPDATE-COMMAND
"Will update the tree structure according to the current file system state"]
(if (FMEMB DG.MENU-EDGE (QUOTE (TOP BOTTOM)))
then (SETQ MENUITEMS (COPY MENUITEMS))
(SETQ TEMP (CADDR MENUITEMS))
(RPLACA (CDDR MENUITEMS)
(CAR (NTH MENUITEMS 8)))
(RPLACA (NTH MENUITEMS 8)
TEMP))
(RETURN (create MENU
ITEMS ← MENUITEMS
MENUCOLUMNS ←(if (FMEMB DG.MENU-EDGE (QUOTE (TOP BOTTOM)))
then 4
else 1)
WHENSELECTEDFN ←(QUOTE DG.DOCOMMAND])
(DG.CREATE-PATH-FROM-FILE-NAME
[LAMBDA (FNAME) (* edited: " 3-Apr-85 15:41")
(PROG (DIR HOST)
(SETQ DIR (FILENAMEFIELD FNAME (QUOTE DIRECTORY)))
(SETQ HOST (FILENAMEFIELD FNAME (QUOTE HOST)))
(RETURN (if HOST
then [CONS (PACKFILENAME (QUOTE HOST)
(FILENAMEFIELD FNAME (QUOTE HOST)))
(if (NULL DIR)
then NIL
else (DG.UNPACK-DIRECTORY-NAME (UNPACK DIR]
else (if (NULL DIR)
then NIL
else (DG.UNPACK-DIRECTORY-NAME (UNPACK DIR])
(DG.CREATE-PREFIX-FROM-PATH
[LAMBDA (PATH) (* edited: "17-Jul-84 14:58")
(COND
[(CDR PATH)
(PACK* (CAR PATH)
(QUOTE <)
(PACK (for D in (CDR PATH) join (LIST D (QUOTE >]
(T (CAR PATH])
(DG.CREATE-QUIT-MENU
[LAMBDA (WINDOW) (* sm " 8-Jun-85 15:40")
(create MENU
ITEMS ←[SUBST WINDOW (QUOTE WINDOW)
(QUOTE ((" I n t e r r u p t" (DG.KILL-PROCESS WINDOW)
"Will kill the current DirGrapher process. "]
CENTERFLG ← T])
(DG.CREATE-SUBDIR-COMMAND
[LAMBDA (WINDOW) (* edited: " 3-Apr-85 22:14")
(PROG (CURRENT-PATH NEW-DIR-NAME DIRECTORY-SUBTREE)
(SETQ CURRENT-PATH (CAR (DG.WAIT-FOR-DIR-SELECTION WINDOW "Select parent directory.")))
(COND
(CURRENT-PATH (SETQ DIRECTORY-SUBTREE (DG.FIND-DIRECTORY-SUBTREE CURRENT-PATH WINDOW))
[SETQ NEW-DIR-NAME (MKATOM (PROMPTFORWORD (CONCAT
"Enter name for new subdirectory (of "
(CAR DIRECTORY-SUBTREE)
") :")
NIL NIL (DG.PROMPTWINDOW WINDOW]
(COND
((MEMBER NEW-DIR-NAME (CDR DIRECTORY-SUBTREE)))
(T (RPLACD DIRECTORY-SUBTREE (CONS (LIST NEW-DIR-NAME)
(CDR DIRECTORY-SUBTREE)))
(DG.DISPLAY-DIRECTORY-TREE (DG.CREATE-GRAPH-FROM-TREE
(WINDOWPROP WINDOW (QUOTE DG.TREE)))
WINDOW])
(DG.CREATE-TREE-FROM-LISTS
[LAMBDA (LISTS) (* edited: " 3-Apr-85 17:02")
(PROG (TEMP L2)
[for X in LISTS when X do (COND
((NOT (SETQ TEMP (FASSOC (CAR X)
L2)))
(SETQ L2 (CONS (LIST (CAR X)
(CDR X))
L2)))
(T (RPLACD TEMP (CONS (CDR X)
(CDR TEMP]
(RETURN (for X in L2 collect (CONS (CAR X)
(DG.CREATE-TREE-FROM-LISTS (CDR X])
(DG.CREATE-TREE-NODES
[LAMBDA (TREE FORMER-PATH) (* edited: " 3-Apr-85 22:05")
(PROG (CURRENT-ID TO-NODES CURRENT-NODE)
(COND
(TREE (RETURN (CONS [SETQ CURRENT-ID (APPEND FORMER-PATH (LIST (CAR TREE]
(CONS (SETQ CURRENT-NODE (create GRAPHNODE
NODEID ← CURRENT-ID
NODELABEL ←(CAR TREE)
FROMNODES ←(LIST FORMER-PATH)
NODEBORDER ← -2))
(PROG (SON-LIST)
[SETQ SON-LIST (for SON in (CDR TREE)
join (PROG (N-LIST)
(SETQ N-LIST
(DG.CREATE-TREE-NODES
SON CURRENT-ID))
(SETQ TO-NODES
(CONS (CAR N-LIST)
TO-NODES))
(RETURN (CDR N-LIST]
(replace TONODES of CURRENT-NODE with TO-NODES)
(RETURN SON-LIST])
(DG.CREATEICONW
[LAMBDA (WINDOW ICON) (* edited: " 5-Apr-85 11:13")
[COND
((NULL ICON)
(SETQ ICON (TITLEDICONW (create TITLEDICON
ICON ← DG.ICON
MASK ← DG.MASK
TITLEREG ←(CREATEREGION 5 5 65 60))
(WINDOWPROP WINDOW (QUOTE DG.ICONTITLE))
DG.ICONFONT]
ICON])
(DG.CURRENT-CONNECTED-DIRECTORY
[LAMBDA NIL (* edited: "22-May-85 13:55")
(PROG (CURRENT-DIR)
(SETQ CURRENT-DIR (DIRECTORYNAME T T))
(if [NOT (FMEMB (CAR (LAST (UNPACK CURRENT-DIR)))
(QUOTE (} >]
then (RETURN (PACK* CURRENT-DIR (QUOTE >)))
else (RETURN CURRENT-DIR])
(DG.DELETE-DIRECTORY-COMMAND
[LAMBDA (WINDOW) (* edited: "19-Apr-85 14:23")
(PROG (CURRENT-PATH CURRENT-DIRECTORY FATHER-DIRECTORY FILES-TO-BE-DELETED NUMBER-OF-FILES)
(SETQ CURRENT-PATH (CAR (DG.WAIT-FOR-DIR-SELECTION WINDOW "Select directory to be deleted"))
)
(COND
(CURRENT-PATH (INVERTW WINDOW)
(SETQ FILES-TO-BE-DELETED (DIRECTORY (DG.CREATE-PREFIX-FROM-PATH
CURRENT-PATH)))
(INVERTW WINDOW)
(SETQ NUMBER-OF-FILES (LENGTH FILES-TO-BE-DELETED))
[COND
((GREATERP NUMBER-OF-FILES 0)
(printout (DG.PROMPTWINDOW WINDOW)
T "CAUTION !!! " NUMBER-OF-FILES
" files are going to be deleted !!"
"Confirm with left button .")
(FLASHWINDOW (DG.PROMPTWINDOW WINDOW)
2)
(COND
((MOUSECONFIRM)
(INVERTW WINDOW)
(for F in FILES-TO-BE-DELETED
do (DELFILE F)
(printout (DG.PROMPTWINDOW WINDOW)
T "File " F " was deleted."))
(INVERTW WINDOW))
(T (printout (DG.PROMPTWINDOW WINDOW)
T "Delete directory aborted.")
(RETURN NIL]
(COND
((EQUAL CURRENT-PATH (WINDOWPROP WINDOW (QUOTE DG.PATH-TO-ROOT)))
(CLOSEW WINDOW)
(RETURN NIL)))
(DG.DELETE-FROM-TREE CURRENT-PATH WINDOW])
(DG.DELETE-FROM-TREE
[LAMBDA (PATH WINDOW) (* edited: " 3-Apr-85 22:15")
(PROG (PARENT-AND-SON ATHER-DIRECTORY)
(SETQ PARENT-AND-SON (DG.FIND-PARENT-DIERCTORY PATH WINDOW))
(SETQ FATHER-DIRECTORY (CAR PARENT-AND-SON))
(RPLACD FATHER-DIRECTORY (REMOVE (CADR PARENT-AND-SON)
(CDR FATHER-DIRECTORY)))
(DG.DISPLAY-DIRECTORY-TREE (DG.CREATE-GRAPH-FROM-TREE (WINDOWPROP WINDOW (QUOTE DG.TREE)))
WINDOW])
(DG.DIRECTORY-MINUS-PREFIX
[LAMBDA (DIRECTORY PREFIX) (* edited: "27-Mar-85 23:50")
(COND
(PREFIX (SUBATOM DIRECTORY (IPLUS 2 (NCHARS PREFIX))
(NCHARS DIRECTORY)))
(T DIRECTORY])
(DG.DIRECTORY-SELECTION-FUNCTION
[LAMBDA (SELECTED-OBJ G-WINDOW) (* edited: "29-Mar-85 14:49")
(PROG (CURRENT-NODE)
(COND
(SELECTED-OBJ [SETQ DG.LAST-DIRECTORY-SELECTED (APPEND (WINDOWPROP G-WINDOW (QUOTE
DG.PATH-TO-ROOT))
(CDR (fetch NODEID of SELECTED-OBJ]
(SETQ DG.WINDOW-OF-LAST-DIRECTORY G-WINDOW)))
(NOTIFY.EVENT DG.DIRECTORY-WAS-SELECTED-EVENT T])
(DG.DISPLAY-DIRECTORY-TREE
[LAMBDA (GRAPH WINDOW) (* sm " 8-Jul-85 17:27")
(SHOWGRAPH GRAPH WINDOW (QUOTE DG.DIRECTORY-SELECTION-FUNCTION)
(QUOTE DG.DIRECTORY-SELECTION-FUNCTION))
[WINDOWPROP WINDOW (QUOTE REPAINTFN)
(CONS (QUOTE DG.REDISPLAYFN)
(MKLIST (WINDOWPROP WINDOW (QUOTE REPAINTFN]
(WINDOWPROP WINDOW (QUOTE COPYBUTTONEVENTFN)
(QUOTE DG.COPYBUTTONEVENTFN))
(DG.SHADE-CURRENT-DIRECTORY WINDOW])
(DG.DOCOMMAND
[LAMBDA (ITEM MENU KEY) (* edited: " 7-Apr-85 20:11")
(PROG (WINDOW)
(SETQ WINDOW (MAINWINDOW (WFROMMENU MENU)))
(COND
((NOT DG.CONCURRENT-ALL)
(DG.DOCOMMAND-WITH-MONITOR DG.MONITOR-LOCK WINDOW ITEM MENU))
((NOT DG.CONCURRENT)
(DG.DOCOMMAND-WITH-MONITOR (WINDOWPROP WINDOW (QUOTE DG.LOCK))
WINDOW ITEM MENU))
(T (DG.DOCOMMAND-WITHOUT-MONITOR WINDOW ITEM MENU])
(DG.DOCOMMAND-WITH-MONITOR
[LAMBDA (MONITOR-LOCK WINDOW ITEM MENU) (* sm " 9-Jul-85 13:13")
(WINDOWPROP WINDOW (QUOTE DG.PROCESS)
(ADD.PROCESS [SUBPAIR (QUOTE (MONITOR-LOCK WINDOW MENU ITEM))
(LIST MONITOR-LOCK WINDOW MENU ITEM)
(QUOTE (PROGN (WITH.MONITOR MONITOR-LOCK (TTYDISPLAYSTREAM
(DG.PROMPTWINDOW WINDOW))
(SHADEITEM (QUOTE ITEM)
MENU GRAYSHADE)
(WINDOWPROP WINDOW (QUOTE
DG.SHADED-ITEM)
(QUOTE ITEM))
(CLEARW (DG.PROMPTWINDOW WINDOW))
(APPLY* (CADR (QUOTE ITEM))
WINDOW)
(PRINTOUT (DG.PROMPTWINDOW WINDOW)
T
(CAR (QUOTE ITEM))
" Completed. ")
(SHADEITEM (QUOTE ITEM)
MENU WHITESHADE)
(WINDOWPROP WINDOW (QUOTE
DG.SHADED-ITEM)
NIL)
(WINDOWPROP WINDOW (QUOTE
DG.PROCESS)
NIL]
(QUOTE WINDOW)
(DG.PROMPTWINDOW WINDOW)
(QUOTE NAME)
(CAR ITEM])
(DG.DOCOMMAND-WITHOUT-MONITOR
[LAMBDA (WINDOW ITEM MENU) (* sm " 9-Jul-85 13:13")
(WINDOWPROP WINDOW (QUOTE DG.PROCESS)
(ADD.PROCESS [SUBPAIR (QUOTE (WINDOW MENU ITEM))
(LIST WINDOW MENU ITEM)
(QUOTE (PROGN (TTYDISPLAYSTREAM (DG.PROMPTWINDOW WINDOW))
(SHADEITEM (QUOTE ITEM)
MENU GRAYSHADE)
(WINDOWPROP WINDOW (QUOTE DG.SHADED-ITEM)
(QUOTE ITEM))
(CLEARW (DG.PROMPTWINDOW WINDOW))
(APPLY* (CADR (QUOTE ITEM))
WINDOW)
(PRINTOUT (DG.PROMPTWINDOW WINDOW)
T
(CAR (QUOTE ITEM))
" Completed. ")
(SHADEITEM (QUOTE ITEM)
MENU WHITESHADE)
(WINDOWPROP WINDOW (QUOTE DG.SHADED-ITEM)
NIL)
(WINDOWPROP WINDOW (QUOTE DG.PROCESS)
NIL]
(QUOTE WINDOW)
(DG.PROMPTWINDOW WINDOW)
(QUOTE NAME)
(CAR ITEM])
(DG.EXCLUSIVE-DIRECTORY
[LAMBDA (DIRECTORY-PATTERN) (* edited: "22-May-85 12:23")
(PROG (CURRENT-DIRECTORY)
(SETQ CURRENT-DIRECTORY (FILENAMEFIELD DIRECTORY-PATTERN (QUOTE DIRECTORY)))
(RETURN (for F in (DIRECTORY DIRECTORY-PATTERN) when (EQ (FILENAMEFIELD F (QUOTE DIRECTORY))
CURRENT-DIRECTORY)
collect F])
(DG.FBICONFN
[LAMBDA (WINDOW ICON) (* edited: "30-Mar-85 16:04")
[COND
((NULL ICON)
(SETQ ICON (TITLEDICONW (create TITLEDICON
ICON ← FILEDRAWER
MASK ← FILEDRAWERMASK
TITLEREG ←(CREATEREGION 5 5 55 55))
(WINDOWPROP WINDOW (QUOTE ICONTITLE))
DG.ICONFONT]
ICON])
(DG.FILE-SELECTION-FN
[LAMBDA (ITEM MENU KEY) (* sm "15-Jul-85 13:17")
(PROG (WINDOW)
(SETQ WINDOW (WFROMMENU MENU))
(COND
[(EQ ITEM (QUOTE STOP))
(NOTIFY.EVENT (WINDOWPROP (MAINWINDOW WINDOW)
(QUOTE DG.FILE-SELECTION-ENDED-EVENT]
(ITEM (COND
((FMEMB ITEM (WINDOWPROP WINDOW (QUOTE DG.SELECTED-FILES)))
(WINDOWDELPROP WINDOW (QUOTE DG.SELECTED-FILES)
ITEM)
(SHADEITEM ITEM MENU WHITESHADE WINDOW))
(T (WINDOWADDPROP WINDOW (QUOTE DG.SELECTED-FILES)
ITEM)
(SHADEITEM ITEM MENU BLACKSHADE WINDOW])
(DG.FILECOPY
[LAMBDA (F1 F2 OVER-FLAG) (* edited: "31-Mar-85 22:39")
(COND
((DIRECTORY F2)
(COND
(OVER-FLAG (DELFILE F2)
(COPYFILE F1 F2))
(T NIL)))
(T (COPYFILE F1 F2)
T])
(DG.FIND-DIRECTORY-SUBTREE
[LAMBDA (PATH WINDOW) (* edited: "31-Dec-00 22:10")
(PROG (DIRECTORY-SUBTREE)
[SETQ PATH (NTH PATH (LENGTH (WINDOWPROP WINDOW (QUOTE DG.PATH-TO-ROOT]
[SETQ DIRECTORY-SUBTREE (LIST (WINDOWPROP WINDOW (QUOTE DG.TREE]
(for X in PATH do (SETQ DIRECTORY-SUBTREE (FASSOC X DIRECTORY-SUBTREE)))
(RETURN DIRECTORY-SUBTREE])
(DG.FIND-PARENT-DIERCTORY
[LAMBDA (PATH WINDOW) (* edited: "30-Mar-85 16:29")
(PROG (FATHER-DIRECTORY CURRENT-DIRECTORY)
(SETQ FATHER-DIRECTORY (WINDOWPROP WINDOW (QUOTE DG.TREE)))
(SETQ PATH (CDR (DG.RESIDUAL-PATH WINDOW PATH)))
(while (AND (SETQ CURRENT-DIRECTORY (FASSOC (CAR PATH)
FATHER-DIRECTORY))
(CDR PATH))
do (SETQ FATHER-DIRECTORY CURRENT-DIRECTORY)
(SETQ PATH (CDR PATH)))
(if (NOT (LISTP CURRENT-DIRECTORY))
then (RETURN (LIST NIL FATHER-DIRECTORY))
else (RETURN (LIST FATHER-DIRECTORY CURRENT-DIRECTORY])
(DG.FLASHALLWINDOWS
[LAMBDA (WINDOW) (* edited: " 3-Apr-85 16:21")
(for W in (CONS WINDOW (ATTACHEDWINDOWS WINDOW)) do (FLASHWINDOW W])
(DG.GET-INITIAL-REGION
[LAMBDA (GRAPH) (* sm " 8-Jun-85 15:29")
(PROG (G-REGION)
(SETQ G-REGION (GRAPHREGION GRAPH))
(GETMOUSESTATE)
(RETURN (GETREGION (MIN DG.MAX-WIDTH (MAX (fetch WIDTH of G-REGION)
DG.MIN-WIDTH))
(MIN DG.MAX-HEIGHT (MAX (fetch HEIGHT of G-REGION)
DG.MIN-HEIGHT])
(DG.KILL-PROCESS
[LAMBDA (WINDOW) (* sm " 8-Jun-85 15:40")
(COND
((WINDOWPROP WINDOW (QUOTE DG.PROCESS))
(DEL.PROCESS (WINDOWPROP WINDOW (QUOTE DG.PROCESS)))
(DG.FLASHALLWINDOWS WINDOW)
(CLEARW (DG.PROMPTWINDOW WINDOW))
(printout (DG.PROMPTWINDOW WINDOW)
"User interupt. Directory Grapher process aborted.")
(for W in (ATTACHEDWINDOWS WINDOW) when (WINDOWPROP W (QUOTE DG.DETACH))
do (DETACHWINDOW W)
(CLOSEW W))
(REDISPLAYW WINDOW)
(WINDOWPROP WINDOW (QUOTE DG.PROCESS)
NIL])
(DG.MOVE-DIR-COMMAND
[LAMBDA (WINDOW) (* edited: " 2-Apr-85 18:02")
(DG.MOVECOPY-DIR-COMMAND WINDOW T])
(DG.MOVE-FILE-COMMAND
[LAMBDA (WINDOW) (* edited: " 2-Apr-85 18:05")
(DG.MOVECOPY-COMMAND WINDOW T])
(DG.MOVECOPY-COMMAND
[LAMBDA (WINDOW MOVE) (* edited: "19-Apr-85 14:24")
(PROG (TARGET-PATH SOURCE-PATH SELECTED-FILES TARGET-PREFIX SOURCE-PREFIX MENU-WINDOW
SOURCE-WINDOW SOURCE-PATH-WINDOW)
(SETQ SOURCE-PATH-WINDOW (DG.WAIT-FOR-DIR-SELECTION WINDOW "Select source directory " T))
(SETQ SOURCE-WINDOW (CADR SOURCE-PATH-WINDOW))
(SETQ SOURCE-PATH (CAR SOURCE-PATH-WINDOW))
(COND
(SOURCE-PATH (INVERTW WINDOW)
(SETQ SOURCE-PREFIX (DG.CREATE-PREFIX-FROM-PATH SOURCE-PATH))
(SETQ MENU-WINDOW (DG.ATTACH-DIRECTORY-FILES-MENU SOURCE-PATH SOURCE-WINDOW
WINDOW))
(WINDOWPROP MENU-WINDOW (QUOTE DG.DETACH)
T)
(INVERTW WINDOW)
(CLEARW (DG.PROMPTWINDOW WINDOW))
(printout (DG.PROMPTWINDOW WINDOW)
"Select files from menu. When done select STOP.")
(AWAIT.EVENT (WINDOWPROP WINDOW (QUOTE DG.FILE-SELECTION-ENDED-EVENT))
1000000)
(SETQ SELECTED-FILES (WINDOWPROP MENU-WINDOW (QUOTE DG.SELECTED-FILES)))
(SETQ TARGET-PATH (CAR (DG.WAIT-FOR-DIR-SELECTION WINDOW
"Select target directory "
T)))
(COND
(TARGET-PATH (INVERTW WINDOW)
(SETQ TARGET-PREFIX (DG.CREATE-PREFIX-FROM-PATH TARGET-PATH))
(for FILE in SELECTED-FILES
do (if (DG.FILECOPY (PACK* SOURCE-PREFIX FILE)
(PACK* TARGET-PREFIX FILE)
DG.COPY-OVER)
then (printout (DG.PROMPTWINDOW WINDOW)
T FILE " : " SOURCE-PREFIX " --> "
TARGET-PREFIX)
else (printout (DG.PROMPTWINDOW WINDOW)
T FILE
" already exists and was not copied. "))
(if MOVE
then (DELFILE (PACK* SOURCE-PREFIX FILE)))
(SHADEITEM FILE (CAR (WINDOWPROP MENU-WINDOW
(QUOTE MENU)))
HIGHLIGHTSHADE MENU-WINDOW))
(INVERTW WINDOW)
(DETACHWINDOW MENU-WINDOW)
(CLOSEW MENU-WINDOW])
(DG.MOVECOPY-DIR-COMMAND
[LAMBDA (WINDOW MOVE) (* sm " 9-Jun-85 12:10")
(PROG (TARGET-PATH SOURCE-PATH SELECTED-FILES TARGET-PREFIX SOURCE-PREFIX MENU-WINDOW
SOURCE-FATHER-SON TARGET-FATHER-SON TARGET-PATH-WINDOW SOURCE-WINDOW
TARGET-WINDOW FILE-NAME NEW-NAME NEW-PREFIX)
(SETQ SOURCE-WINDOW-PATH (DG.WAIT-FOR-DIR-SELECTION WINDOW
"Select the directory that you want to transfer."
T))
(SETQ SOURCE-PATH (CAR SOURCE-WINDOW-PATH))
(SETQ SOURCE-WINDOW (CADR SOURCE-WINDOW-PATH))
(COND
(SOURCE-PATH (INVERTW WINDOW)
(SETQ SOURCE-PREFIX (DG.CREATE-PREFIX-FROM-PATH SOURCE-PATH))
(SETQ SELECTED-FILES (DIRECTORY SOURCE-PREFIX))
(INVERTW WINDOW)
(SETQ TARGET-PATH-WINDOW (DG.WAIT-FOR-DIR-SELECTION
WINDOW
(CONCAT "Select new parent for directory " (CAR (LAST SOURCE-PATH)))
T))
(SETQ TARGET-PATH (CAR TARGET-PATH-WINDOW))
(if (AND MOVE (GREATERP (LENGTH TARGET-PATH)
(LENGTH SOURCE-PATH))
(for A1 in SOURCE-PATH as A2 in TARGET-PATH
always (EQUAL A1 A2)))
then (DG.FLASHALLWINDOWS WINDOW)
(printout (DG.PROMPTWINDOW WINDOW)
T "Can not move a directory to its descendants")
(RETURN NIL))
(SETQ TARGET-WINDOW (CADR TARGET-PATH-WINDOW))
(COND
(TARGET-PATH
(INVERTW WINDOW)
(SETQ TARGET-PREFIX (DG.CREATE-PREFIX-FROM-PATH TARGET-PATH))
(for FILE in SELECTED-FILES
do (if (DG.FILECOPY FILE
[SETQ NEW-NAME
(PACK* [SETQ NEW-PREFIX
(DG.CREATE-PREFIX-FROM-PATH
(APPEND TARGET-PATH
(NTH (
DG.CREATE-PATH-FROM-FILE-NAME FILE)
(LENGTH SOURCE-PATH]
(SETQ FILE-NAME (DG.PACK-NAME-VER-EXT
FILE]
DG.COPY-OVER)
then (printout (DG.PROMPTWINDOW WINDOW)
T FILE-NAME " : " (PACKFILENAME
(QUOTE HOST)
(FILENAMEFIELD FILE (QUOTE HOST))
(QUOTE DIRECTORY)
(FILENAMEFIELD FILE (QUOTE HOST)))
" --> " NEW-PREFIX)
else (printout (DG.PROMPTWINDOW WINDOW)
T NEW-NAME " already exists and was not copied. ")
)
(if MOVE
then (DELFILE FILE)))
(SETQ SOURCE-FATHER-SON (DG.FIND-PARENT-DIERCTORY SOURCE-PATH
SOURCE-WINDOW))
(SETQ TARGET-FATHER-SON (DG.FIND-PARENT-DIERCTORY TARGET-PATH
TARGET-WINDOW))
[RPLACD (CADR TARGET-FATHER-SON)
(CONS (COPY (CADR SOURCE-FATHER-SON))
(CDR (CADR TARGET-FATHER-SON]
[if MOVE
then (RPLACD (CAR SOURCE-FATHER-SON)
(REMOVE (CADR SOURCE-FATHER-SON)
(CDAR SOURCE-FATHER-SON]
(DG.DISPLAY-DIRECTORY-TREE (DG.CREATE-GRAPH-FROM-TREE
(WINDOWPROP SOURCE-WINDOW (QUOTE DG.TREE)))
SOURCE-WINDOW)
(if (NEQ TARGET-WINDOW SOURCE-WINDOW)
then (DG.DISPLAY-DIRECTORY-TREE (DG.CREATE-GRAPH-FROM-TREE
(WINDOWPROP TARGET-WINDOW
(QUOTE DG.TREE)))
TARGET-WINDOW])
(DG.PACK-NAME-VER-EXT
[LAMBDA (F) (* edited: " 3-Apr-85 11:31")
(PACKFILENAME (QUOTE NAME)
(FILENAMEFIELD F (QUOTE NAME))
(QUOTE VERSION)
(FILENAMEFIELD F (QUOTE VERSION))
(QUOTE EXTENSION)
(FILENAMEFIELD F (QUOTE EXTENSION])
(DG.PROMPTWINDOW
[LAMBDA (WINDOW) (* edited: "29-Mar-85 16:07")
(CAR (WINDOWPROP WINDOW (QUOTE PROMPTWINDOW])
(DG.REDISPLAYFN
[LAMBDA (WINDOW) (* sm " 9-Jul-85 13:29")
(DG.SHADE-CURRENT-DIRECTORY WINDOW)
(for W in (ATTACHEDWINDOWS WINDOW) bind MENU bind ITEM when (SETQ MENU (WINDOWPROP W
(QUOTE MENU)))
do (if (SETQ ITEM (WINDOWPROP WINDOW (QUOTE DG.SHADED-ITEM)))
then (SHADEITEM ITEM (CAR MENU)
WHITESHADE W)
(WINDOWPROP WINDOW (QUOTE DG.SHADED-ITEM)
NIL])
(DG.RESIDUAL-PATH
[LAMBDA (WINDOW PATH) (* edited: "29-Mar-85 12:37")
(NTH PATH (LENGTH (WINDOWPROP WINDOW (QUOTE DG.PATH-TO-ROOT])
(DG.RESTORE-COMMAND
[LAMBDA (WINDOW BACKUP-DIR) (* sm "10-Jun-85 13:52")
(PROG (TARGET-PATH TARGET-DIRECTORY FILES-TO-BACKUP N OVER-WRITE-FLAG FLOPPY-FILES DSK-FILES
DIRECTORY-INFO-FILE-NAME F-NAME NEW-NAME OVER-FLAG-ASKED UNFOUND-FILES
INFO-NAME BACKUP-HOST FILES-BACKUP-NAMES TARGET-PATH-AND-WINDOW TARGET-WINDOW)
(SETQ TARGET-PATH-AND-WINDOW (DG.WAIT-FOR-DIR-SELECTION WINDOW
"Select directory that you want to restore"
T))
(SETQ TARGET-PATH (CAR TARGET-PATH-AND-WINDOW))
(SETQ TARGET-WINDOW (CADR TARGET-PATH-AND-WINDOW))
(SETQ TARGET-DIRECTORY (DG.FIND-DIRECTORY-SUBTREE TARGET-PATH TARGET-WINDOW))
(SETQ BACKUP-HOST (FILENAMEFIELD BACKUP-DIR (QUOTE HOST)))
(if (EQ BACKUP-HOST (QUOTE FLOPPY))
then (printout (DG.PROMPTWINDOW WINDOW)
T "Insert Floppy")
(FLOPPY.WAIT.FOR.FLOPPY))
[if (NULL (FILENAMEFIELD BACKUP-DIR (QUOTE DIRECTORY)))
then (SETQ BACKUP-DIR (PACK* BACKUP-DIR (QUOTE <]
(INVERTW WINDOW)
(SETQ INFO-NAME (PACK* BACKUP-DIR (CAR TARGET-DIRECTORY)
(QUOTE >BACKUPINFO)))
(if (NULL (DIRECTORY INFO-NAME))
then (CLEARW (DG.PROMPTWINDOW WINDOW))
(INVERTW WINDOW)
(DG.FLASHALLWINDOWS WINDOW)
(printout (DG.PROMPTWINDOW WINDOW)
T "Couldn't find the file " INFO-NAME " . Resore aborted. ")
else (PROG NIL
(LOAD INFO-NAME (QUOTE SYSLOAD))
(RPLACD TARGET-DIRECTORY (APPEND (CDR TARGET-DIRECTORY)
(for SUB in (CDR DG.DIRECTORY-SUBTREE)
when (NOT (FASSOC (CAR SUB)
(CDR TARGET-DIRECTORY)))
collect SUB)))
(DG.DISPLAY-DIRECTORY-TREE (DG.CREATE-GRAPH-FROM-TREE (WINDOWPROP
TARGET-WINDOW
(QUOTE DG.TREE)))
TARGET-WINDOW)
(if (NEQ TARGET-WINDOW WINDOW)
then (INVERTW WINDOW))
(SETQ FILES-BACKUP-NAMES DG.FILES-BACKUP-NAMES)
NEW-ROUND-OF-COPY
(INVERTW WINDOW)
[for F in FILES-BACKUP-NAMES bind F-WITH-<
do (COND
[(DIRECTORY (SETQ F-NAME (PACK* BACKUP-DIR F)))
(SETQ NEW-NAME
(PACK* [DG.CREATE-PREFIX-FROM-PATH
(APPEND TARGET-PATH (CDR (DG.CREATE-PATH-FROM-FILE-NAME
(SETQ F-WITH-<(PACK*
(QUOTE <)
F]
(DG.PACK-NAME-VER-EXT F-WITH-<)))
(COND
((DG.FILECOPY F-NAME NEW-NAME DG.COPY-OVER)
(printout (DG.PROMPTWINDOW WINDOW)
T NEW-NAME " Restored."))
(T (printout (DG.PROMPTWINDOW WINDOW)
T NEW-NAME " exists and wasn't restored. "]
(T (COND
((NOT (FMEMB F UNFOUND-FILES))
(SETQ UNFOUND-FILES (CONS F UNFOUND-FILES]
(INVERTW WINDOW)
(COND
(UNFOUND-FILES (RINGBELLS)
(DG.FLASHALLWINDOWS WINDOW)
(CLEARW (DG.PROMPTWINDOW WINDOW))
(if (EQ BACKUP-HOST (QUOTE FLOPPY))
then (printout (DG.PROMPTWINDOW WINDOW)
(LENGTH UNFOUND-FILES)
" Files were not found on this floppy !! please insert another one. ")
(SETQ FILES-BACKUP-NAMES UNFOUND-FILES)
(SETQ UNFOUND-FILES NIL)
(FLOPPY.WAIT.FOR.FLOPPY T)
(GO NEW-ROUND-OF-COPY)
else (PRINTOUT (DG.PROMPTWINDOW WINDOW)
(LENGTH UNFOUND-FILES)
" Files wre not found on the backup directory and were not restored"])
(DG.RESTORE-FROM-DEFAULT-COMMAND
[LAMBDA (WINDOW) (* sm " 8-Jun-85 13:06")
(if (NULL DG.DEFAULT-BACKUP-DIRECTORY)
then (DG.FLASHALLWINDOWS WINDOW)
(PRINTOUT (DG.PROMPTWINDOW WINDOW)
T "NULL default directory.Backup aborted")
else (DG.RESTORE-COMMAND WINDOW DG.DEFAULT-BACKUP-DIRECTORY])
(DG.RESTORE-FROM-SELECTED-COMMAND
[LAMBDA (WINDOW) (* sm " 8-Jun-85 13:05")
(PROG (BACKUP-DIRECTORY)
[SETQ BACKUP-DIRECTORY (DG.CREATE-PREFIX-FROM-PATH (CAR (DG.WAIT-FOR-DIR-SELECTION WINDOW
"Select the directory that contains the backup."
T]
(DG.RESTORE-COMMAND WINDOW BACKUP-DIRECTORY])
(DG.SETIFY
[LAMBDA (L)
(PROG (NEW-SET)
(for ONE-ELEMENT in L when (NOT (MEMBER ONE-ELEMENT NEW-SET)) do (SETQ NEW-SET
(CONS ONE-ELEMENT
NEW-SET)))
(RETURN NEW-SET])
(DG.SHADE-CURRENT-DIRECTORY
[LAMBDA (WINDOW) (* edited: "22-May-85 13:56")
(PROG (CURRENT-PATH)
[SETQ CURRENT-PATH (NTH (DG.CREATE-PATH-FROM-FILE-NAME (DG.CURRENT-CONNECTED-DIRECTORY))
(LENGTH (WINDOWPROP WINDOW (QUOTE DG.PATH-TO-ROOT]
(for NODE in (fetch GRAPHNODES of (WINDOWPROP WINDOW (QUOTE GRAPH)))
do (COND
((EQUAL CURRENT-PATH (fetch NODEID of NODE))
(RESET/NODE/BORDER NODE 2 WINDOW))
(T (COND
((GREATERP (fetch NODEBORDER of NODE)
0)
(RESET/NODE/BORDER NODE -2 WINDOW])
(DG.TRIM
[LAMBDA (W N) (* edited: " 5-Apr-85 11:08")
(COND
((GREATERP (NCHARS W)
N)
(SUBATOM W 1 N))
(T W])
(DG.UNADVISE
[LAMBDA NIL (* edited: "31-Mar-85 23:26")
(UNADVISE (\GENERATENEXTFILE IN FB.UPDATEBROWSERITEMS])
(DG.UNADVISE-GENERATE-FILE
[LAMBDA NIL (* edited: "31-Mar-85 23:26")
(UNADVISE (\GENERATENEXTFILE IN FB.UPDATEBROWSERITEMS])
(DG.UNPACK-DIRECTORY-NAME
[LAMBDA (NAME) (* edited: " 3-Apr-85 17:01")
(COND
((NULL NAME)
NIL)
(T (CONS [PACK (PROG (PACKED-NAME)
LOOP(COND
((OR (NULL NAME)
(EQ (CAR NAME)
(QUOTE >)))
(RETURN PACKED-NAME))
(T (SETQ PACKED-NAME (NCONC1 PACKED-NAME (CAR NAME)))
(SETQ NAME (CDR NAME))
(GO LOOP]
(DG.UNPACK-DIRECTORY-NAME (CDR NAME])
(DG.UPDATE-COMMAND
[LAMBDA (WINDOW) (* edited: " 3-Apr-85 13:38")
(INVERTW WINDOW)
(DG.UPDATE-DIRECTORY-TREE WINDOW])
(DG.UPDATE-DIRECTORY-TREE
[LAMBDA (WINDOW) (* edited: " 3-Apr-85 22:20")
(PROG (TREE)
[SETQ TREE (DG.CREATE-DIRECTORY-TREE (WINDOWPROP WINDOW (QUOTE DG.PATH-TO-ROOT]
(WINDOWPROP WINDOW (QUOTE DG.TREE)
TREE)
(DG.DISPLAY-DIRECTORY-TREE (DG.CREATE-GRAPH-FROM-TREE TREE)
WINDOW])
(DG.UPDATE-DIRECTROY-TREE
[LAMBDA (WINDOW) (* edited: "30-Mar-85 15:21")
(PROG (TREE)
(SETQ TREE (DG.CREATE-DIRECTORY-TREE (WINDOWPROP WINDOW 'DG.PATH-TO-ROOT)))
(DG.DISPLAY-DIRECTORY-TREE TREE WINDOW])
(DG.WAIT-FOR-DIR-SELECTION
[LAMBDA (WINDOW MESSAGE ALLOW-OTHER-WINDOWS) (* edited: " 3-Apr-85 23:17")
(PROG (WAITS)
(SETQ DG.LAST-DIRECTORY-SELECTED NIL)
(SETQ WAITS 0)
(printout (DG.PROMPTWINDOW WINDOW)
T MESSAGE)
WAIT-AGAIN
(SETQ WAITS (ADD1 WAITS))
(AWAIT.EVENT DG.DIRECTORY-WAS-SELECTED-EVENT 1000)
(COND
((OR (NULL DG.LAST-DIRECTORY-SELECTED)
(AND (NOT ALLOW-OTHER-WINDOWS)
(NEQ DG.WINDOW-OF-LAST-DIRECTORY WINDOW)))
[COND
((GREATERP WAITS 50)
(RETURN NIL))
((ZEROP (IMOD WAITS 10))
(FLASHWINDOW (DG.PROMPTWINDOW WINDOW))
(PLAYTUNE (LIST (CONS (ITIMES 100 (IQUOTIENT WAITS 10))
10000)
(CONS (ITIMES 100 (ADD1 (IQUOTIENT WAITS 10)))
10000)
(CONS (ITIMES 100 (IQUOTIENT WAITS 10))
10000]
(GO WAIT-AGAIN)))
(RETURN (LIST DG.LAST-DIRECTORY-SELECTED DG.WINDOW-OF-LAST-DIRECTORY])
(DIRGRAPHER
[LAMBDA ({DEV}<DIR> WINDOW-REGION PATH?) (* sm " 9-Jul-85 11:27")
(PROG (TREE DG.WINDOW PATH)
(COND
((NULL {DEV}<DIR>)
(SETQ {DEV}<DIR> DG.DEFAULT-DIR)))
(if (LISTP {DEV}<DIR>)
then (SETQ TREE {DEV}<DIR>)
[SETQ PATH (OR PATH? (LIST (CAR TREE]
else (SETQ PATH (DG.CREATE-PATH-FROM-FILE-NAME {DEV}<DIR>))
(SETQ TREE (DG.CREATE-DIRECTORY-TREE PATH)))
(SETQ GRAPH (DG.CREATE-GRAPH-FROM-TREE TREE))
(if WINDOW-REGION
then (SETQ DG.WINDOW (CREATEW WINDOW-REGION {DEV}<DIR>))
else (SETQ DG.WINDOW (CREATEW (DG.GET-INITIAL-REGION GRAPH)
{DEV}<DIR>))
(WINDOWPROP DG.WINDOW (QUOTE MINSIZE)
(CONS DG.MIN-WIDTH DG.MIN-HEIGHT)))
(WINDOWPROP DG.WINDOW (QUOTE DG.PATH-TO-ROOT)
PATH)
(DG.DISPLAY-DIRECTORY-TREE GRAPH DG.WINDOW)
(WINDOWPROP DG.WINDOW (QUOTE DG.TREE)
TREE)
(WINDOWADDPROP DG.WINDOW (QUOTE REPAINTFN)
(QUOTE DG.REDISPLAYFN))
(WINDOWPROP DG.WINDOW (QUOTE ICONFN)
(QUOTE DG.CREATEICONW))
(WINDOWPROP DG.WINDOW (QUOTE EXPANDFN)
(QUOTE (DG.SHADE-CURRENT-DIRECTORY REDISPLAYGRAPH)))
(WINDOWPROP DG.WINDOW (QUOTE DG.ICONTITLE)
(DG.CREATE-ICON-TITLE PATH))
(WINDOWPROP DG.WINDOW (QUOTE DG.PROCESS)
NIL)
(WINDOWPROP DG.WINDOW (QUOTE DG.FILE-SELECTION-ENDED-EVENT)
(CREATE.EVENT "DGEVENT"))
(WINDOWPROP DG.WINDOW (QUOTE DG.LOCK)
(CREATE.MONITORLOCK "DG.LOCK"))
(GETPROMPTWINDOW DG.WINDOW 3 DG.PROMPTWINDOWFONT)
(ATTACHMENU (DG.CREATE-MENU DG.WINDOW)
DG.WINDOW DG.MENU-EDGE (QUOTE JUSTIFY))
(ATTACHMENU (DG.CREATE-QUIT-MENU DG.WINDOW)
DG.WINDOW
(QUOTE BOTTOM)
(QUOTE JUSTIFY))
(RETURN DG.WINDOW])
)
(RPAQ DG.ICON (READBITMAP))
(75 75
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"N@@@@@@@@@@@@@@@@@N@"
"N@@@@@@@@@@@@@@@@@N@"
"NGOOOOOOOOOOOOOOOLN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@D@@@@@@@DN@"
"ND@@@@@@@D@@@@@@@DN@"
"ND@@@@@@@D@@@@@@@DN@"
"ND@@@COOOOOOOH@@@DN@"
"ND@@@B@@@@@@@H@@@DN@"
"ND@@@B@@@@@@@H@@@DN@"
"ND@@@B@@@@@@@H@@@DN@"
"ND@GOOOO@@AOOOOH@DN@"
"ND@D@@@A@@A@@@@H@DN@"
"ND@D@@@A@@A@@@@H@DN@"
"NDGOL@AOOAOO@@OOHDN@"
"NDD@D@A@AA@A@@H@HDN@"
"NDD@D@A@AA@A@@H@HDN@"
"NDD@D@A@AA@A@@H@HDN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"ND@@@@@@@@@@@@@@@DN@"
"NGOOOOOOOOOOOOOOOLN@"
"N@@@@@@@@@@@@@@@@@N@"
"N@@@@@@@@@@@@@@@@@N@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@")
(RPAQ DG.MASK (READBITMAP))
(75 75
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@")
(RPAQ DG.FILL-WINDOW-TEXTURE (READBITMAP))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@")
(RPAQ DG.WHITEBM (READBITMAP))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@")
(DECLARE: DONTEVAL@LOAD DOCOPY
(FILESLOAD GRAPHER ICONW FILEBROWSER)
(DG.ADVISE-GENERATE-FILE)
[DG.ADD-ITEM-TO-BACKGROUND-MENU (QUOTE DirGrapher)
(QUOTE (DIRGRAPHER))
"Will initiate dirgrapher process on the current directory"
(QUOTE (SUBITEMS ({FLOPPY} (DIRGRAPHER (QUOTE {FLOPPY})))
({DSK}<LISPFILES> (DIRGRAPHER (QUOTE
{DSK}<LISPFILES>]
)
(PUTPROPS DIRGRAPHER COPYRIGHT ("Shaul Markovitch" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4278 56916 (DG.ADD-ITEM-TO-BACKGROUND-MENU 4288 . 4660) (DG.ADVISE-GENERATE-FILE 4662
. 6220) (DG.APPLY-DIRGRAPHER-COMMAND 6222 . 6709) (DG.APPLY-FB-ON-DIR-AND-SUBDIRS-COMMAND 6711 . 6893
) (DG.APPLY-FILEBROWSER-COMMAND 6895 . 7710) (DG.ASK-FOR-BACKUP-TYPE 7712 . 8408) (
DG.ATTACH-DIRECTORY-FILES-MENU 8410 . 9472) (DG.BACKUP-COMMAND 9474 . 13833) (
DG.BACKUP-ON-DEFAULT-COMMAND 13835 . 14223) (DG.BACKUP-ON-SELECTED-COMMAND 14225 . 14640) (
DG.CONNECT-DIR-COMMAND 14642 . 15314) (DG.COPY-DIRECTORY-COMMAND 15316 . 15483) (DG.COPY-FILE-COMMAND
15485 . 15643) (DG.COPYBUTTONEVENTFN 15645 . 16592) (DG.CREATE-BACKUP-NAME 16594 . 17599) (
DG.CREATE-DIRECTORY-CHAIN 17601 . 17925) (DG.CREATE-DIRECTORY-SPEC 17927 . 18470) (
DG.CREATE-DIRECTORY-TREE 18472 . 19068) (DG.CREATE-GRAPH-FROM-TREE 19070 . 19471) (
DG.CREATE-ICON-TITLE 19473 . 19919) (DG.CREATE-MENU 19921 . 23362) (DG.CREATE-PATH-FROM-FILE-NAME
23364 . 24052) (DG.CREATE-PREFIX-FROM-PATH 24054 . 24376) (DG.CREATE-QUIT-MENU 24378 . 24725) (
DG.CREATE-SUBDIR-COMMAND 24727 . 25714) (DG.CREATE-TREE-FROM-LISTS 25716 . 26309) (
DG.CREATE-TREE-NODES 26311 . 27278) (DG.CREATEICONW 27280 . 27653) (DG.CURRENT-CONNECTED-DIRECTORY
27655 . 28083) (DG.DELETE-DIRECTORY-COMMAND 28085 . 29560) (DG.DELETE-FROM-TREE 29562 . 30119) (
DG.DIRECTORY-MINUS-PREFIX 30121 . 30390) (DG.DIRECTORY-SELECTION-FUNCTION 30392 . 30885) (
DG.DISPLAY-DIRECTORY-TREE 30887 . 31427) (DG.DOCOMMAND 31429 . 31955) (DG.DOCOMMAND-WITH-MONITOR 31957
. 33184) (DG.DOCOMMAND-WITHOUT-MONITOR 33186 . 34284) (DG.EXCLUSIVE-DIRECTORY 34286 . 34729) (
DG.FBICONFN 34731 . 35108) (DG.FILE-SELECTION-FN 35110 . 35832) (DG.FILECOPY 35834 . 36105) (
DG.FIND-DIRECTORY-SUBTREE 36107 . 36604) (DG.FIND-PARENT-DIERCTORY 36606 . 37359) (DG.FLASHALLWINDOWS
37361 . 37576) (DG.GET-INITIAL-REGION 37578 . 38032) (DG.KILL-PROCESS 38034 . 38688) (
DG.MOVE-DIR-COMMAND 38690 . 38853) (DG.MOVE-FILE-COMMAND 38855 . 39015) (DG.MOVECOPY-COMMAND 39017 .
41203) (DG.MOVECOPY-DIR-COMMAND 41205 . 44711) (DG.PACK-NAME-VER-EXT 44713 . 45059) (DG.PROMPTWINDOW
45061 . 45238) (DG.REDISPLAYFN 45240 . 45784) (DG.RESIDUAL-PATH 45786 . 45984) (DG.RESTORE-COMMAND
45986 . 49875) (DG.RESTORE-FROM-DEFAULT-COMMAND 49877 . 50269) (DG.RESTORE-FROM-SELECTED-COMMAND 50271
. 50683) (DG.SETIFY 50685 . 50947) (DG.SHADE-CURRENT-DIRECTORY 50949 . 51649) (DG.TRIM 51651 . 51849)
(DG.UNADVISE 51851 . 52030) (DG.UNADVISE-GENERATE-FILE 52032 . 52225) (DG.UNPACK-DIRECTORY-NAME 52227
. 52775) (DG.UPDATE-COMMAND 52777 . 52962) (DG.UPDATE-DIRECTORY-TREE 52964 . 53378) (
DG.UPDATE-DIRECTROY-TREE 53380 . 53678) (DG.WAIT-FOR-DIR-SELECTION 53680 . 54782) (DIRGRAPHER 54784 .
56914)))))
STOP