(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "XCL")
(filecreated "26-Jan-88 15:45:41" {erinyes}<lispusers>lyric>dirgrapher.\;2 102873
|changes| |to:| (vars dirgraphercoms)
(fns dg.advise-generate-file)
|previous| |date:| "20-Aug-87 19:28:44" {erinyes}<lispusers>lyric>dirgrapher.\;1)
; Copyright (c) 1985, 1986, 1900, 1987, 1988 by Shaul Markovitch. All rights reserved.
(prettycomprint dirgraphercoms)
(rpaqq dirgraphercoms
((files grapher filebrowser)
(initvars
(* |;;;| "VARIABLES TO BE SET BY THE USER")
(dg.promptwindowfont (fontcreate '(gacha 8)))
(dg.graph-label-font (fontcreate '(gacha 8)))
(dg.vertical-horizontal-option 'vertical)
(dg.copy-over nil)
(dg.box-all t)
(dg.default-dir '{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 'right)
(dg.menu-font littlefont)
(dg.file-info-attributes '(size creationdate writedate author))
(dg.default-backup-directory '{floppy})
(dg.stand-alone-hosts '(dsk floppy core))
(dg.background-directories nil))
(vars dg.cancel-button-bm dg.ok-button-bm dg.reset-button-bm
(* |;;;| "PROGRAM VARIABLES")
(dg.iconfont (fontcreate '(gacha 8)))
(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.file-exists
dg.file-info-command dg.file-info-selection-fn dg.files-hardcopy-command
dg.load-files-command dg.newer-file 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-free-menu
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.delete-old-versions-command dg.delete-selected-files-command
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.exclusive-new-versions dg.exclusive-old-versions dg.fbiconfn
dg.file-selection-fn dg.filecopy dg.find-directory-subtree dg.find-menu-item
dg.find-parent-dierctory dg.flashallwindows dg.get-fb-pattern dg.get-file-list
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)
(p (dg.advise-generate-file)
(setq dg.background-directories (union dg.background-directories
(union directories
(cons '{floppy}
(for d in (volumes)
when
(lispdirectoryp d)
collect
(pack* '{dsk}< d '>))))))
(dg.add-item-to-background-menu
'|DirGrapher|
'(dirgrapher) "Will initiate dirgrapher process on the current directory"
(cons 'subitems
(cons '("DG Windows to top" (|for| w |in| (openwindows)
|when|
(or (windowprop w 'dg.path-to-root)
(and (windowprop w 'iconfor)
(windowprop (windowprop w 'iconfor)
'dg.path-to-root)))
|do|
(totopw w)))
(for d in dg.background-directories collect (list d (list 'dirgrapher
(kwote d))
(concat
"WILL APPLY DIRGRAPHER ON "
d)))))))
(* |;;;| "(declare\\: dontcopy (prop makefile-environment dirgrapher))")
))
(filesload grapher filebrowser)
(rpaq? dg.promptwindowfont (fontcreate '(gacha 8)))
(rpaq? dg.graph-label-font (fontcreate '(gacha 8)))
(rpaq? dg.vertical-horizontal-option 'vertical)
(rpaq? dg.copy-over nil)
(rpaq? dg.box-all t)
(rpaq? dg.default-dir '{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 'right)
(rpaq? dg.menu-font littlefont)
(rpaq? dg.file-info-attributes '(size creationdate writedate author))
(rpaq? dg.default-backup-directory '{floppy})
(rpaq? dg.stand-alone-hosts '(dsk floppy core))
(rpaq? dg.background-directories nil)
(rpaqq dg.cancel-button-bm #*(50 20)AOOOOOOOOOON@@@@COOOOOOOOOOO@@@@G@@@@@@@@@@CH@@@N@@@@@@@@@@AL@@@L@@@@@@@@@@@L@@@L@@@@@@@@@@@L@@@LAO@@@@@@@C@L@@@LCAH@@@@@@C@L@@@LCAILGLGHOC@L@@@LC@@FFFLMIK@L@@@LC@ANFFLAOK@L@@@LCAKFFFLAHC@L@@@LCAKFFFLMIK@L@@@LAOAOFFGHOC@L@@@L@@@@@@@@@@@L@@@L@@@@@@@@@@@L@@@N@@@@@@@@@@AL@@@G@@@@@@@@@@CH@@@COOOOOOOOOOO@@@@AOOOOOOOOOON@@@@
)
(rpaqq dg.ok-button-bm #*(50 20)AOOOOOOOOOON@@@@COOOOOOOOOOO@@@@G@@@@@@@@@@CH@@@N@@@@@@@@@@AL@@@L@@@@@@@@@@@L@@@L@GL@@@@@@@@L@@@L@FF@@@@@F@@L@@@L@FFGHOCLOH@L@@@L@FFLMIFFF@@L@@@L@GLOMLGNF@@L@@@L@FFL@GF@F@@L@@@L@FFLMCFFF@@L@@@L@FFGINCLCH@L@@@L@@@@@@@@@@@L@@@L@@@@@@@@@@@L@@@L@@@@@@@@@@@L@@@N@@@@@@@@@@AL@@@G@@@@@@@@@@CH@@@COOOOOOOOOOO@@@@AOOOOOOOOOON@@@@
)
(rpaqq dg.reset-button-bm #*(50 20)AOOOOOOOOOON@@@@COOOOOOOOOOO@@@@G@@@@@@@@@@CH@@@N@@@@@@@@@@AL@@@L@@@@@@@@@@@L@@@L@GL@@@@@@@@L@@@L@FF@@@@@F@@L@@@L@FFGHOCLOH@L@@@L@FFLMIFFF@@L@@@L@GLOMLGNF@@L@@@L@FFL@GF@F@@L@@@L@FFLMCFFF@@L@@@L@FFGINCLCH@L@@@L@@@@@@@@@@@L@@@L@@@@@@@@@@@L@@@L@@@@@@@@@@@L@@@N@@@@@@@@@@AL@@@G@@@@@@@@@@CH@@@COOOOOOOOOOO@@@@AOOOOOOOOOON@@@@
)
(rpaq dg.iconfont (fontcreate '(gacha 8)))
(rpaq dg.directory-was-selected-event (create.event))
(rpaq dg.monitor-lock (create.monitorlock "DG.MONITOR"))
(rpaqq dg.last-directory-selected nil)
(rpaqq dg.window-of-last-directory nil)
(defineq
(dg.add-item-to-background-menu
(lambda (label command message subitemlist) (* |edited:| "13-May-86 14:03")
(declare (globalvars |BackgroundMenuCommands| |BackgroundMenu|))
(setq |BackgroundMenuCommands| (remove (fassoc label |BackgroundMenuCommands|)
|BackgroundMenuCommands|))
(nconc1 |BackgroundMenuCommands| (list label command message subitemlist))
(setq |BackgroundMenu| nil)))
(dg.advise-generate-file
(lambda nil (* \; "Edited 26-Jan-88 15:42 by smL")
(movd '\\generatenextfile 'dg.generate-next-file t)
(unadvise (\\generatenextfile in fb.updatebrowseritems))
(advise '(\\generatenextfile in fb.updatebrowseritems) 'around
'(prog* ((window (tb.window (fb.tablebrowser browser)))
(pattern (dg.get-fb-pattern window))
(fbdir (u-case (filenamefield pattern 'directory)))
(fbhost (u-case (filenamefield pattern 'host)))
next-file temp-host)
(declare (global dg.stand-alone-hosts))
(setq fbhost (|if| (fmemb fbhost dg.stand-alone-hosts)
|then| fbhost
|else| (or (canonical.hostname fbhost)
fbhost)))
next
(setq next-file (dg.generate-next-file genobj nameonly))
(|if| (null next-file)
|then| (return nil))
(|if| (listp next-file)
|then| (setq next-file (packc next-file)))
(|if| (or (not (windowprop (mainwindow window)
'dg.directory-only))
(and (eq (u-case (filenamefield next-file 'directory))
fbdir)
(eq (filenamefield next-file 'host)
fbhost)))
|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) (* |edited:| " 7-May-86 13:09")
(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 'dg.directory-only t))
(windowprop fb-window 'iconfn '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 'files-only))
(t (setq backup-type (menu (|create| menu
items ← (list (list
"Back up files in this directory (but not in subdirectories)"
''files-only)
(list
"Backup files of this directory and subdirectories"
''files-and-subs))
menufont ← bigfont)
nil t))))
(return backup-type))))
(dg.attach-directory-files-menu
(lambda (path window main-window file-selection-fn includefullnames)
(* |edited:| "16-May-86 15:56")
(declare (globalvars littlefont screenheight))
(prog (menu file-list number-of-columns number-of-rows length-file-list max-width menu-window)
(setq file-selection-fn (or file-selection-fn 'dg.file-selection-fn))
(setq file-list (cons '\ stop (|for| f |in| (dg.exclusive-directory (
dg.create-prefix-from-path
path))
|collect| (|if| includefullnames
|then| (list (dg.pack-name-ver-ext f)
f)
|else| (dg.pack-name-ver-ext f)))))
(|if| (cdr file-list)
|then| (setq length-file-list (length file-list))
(setq max-width 6)
(|for| f |in| file-list |bind| width
|when| (greaterp (setq width (stringwidth (|if| includefullnames
|then| (car f)
|else| f)
littlefont))
max-width) |do| (setq max-width width))
(setq number-of-columns (max 1 (iquotient (car (windowsize main-window))
max-width)))
(setq number-of-rows (iplus (iquotient length-file-list number-of-columns)
(|if| (eqp (iremainder length-file-list
number-of-columns)
0)
|then| 0
|else| 1)))
(setq file-list (append file-list (|for| i |from| (add1 length-file-list)
|to| (itimes number-of-columns
number-of-rows) |collect| " ")))
(setq file-list (|for| row |from| 1 |to| number-of-rows
|join| (|for| i |in| (nth file-list row)
|by| (nth i (add1 number-of-rows)) |collect| i)))
(setq menu-window
(attachmenu (|create| menu
items ← file-list
whenselectedfn ← file-selection-fn
menucolumns ← number-of-columns
menufont ← littlefont)
main-window
(|if| (greaterp (iplus (|fetch| bottom |of| (windowregion main-window))
(iquotient (cdr (windowsize main-window))
2))
(iquotient screenheight 2))
|then| 'bottom
|else| 'top)
'justify))
(return menu-window)
|else| (return nil)))))
(dg.backup-command
(lambda (window backup-dir) (* |edited:| "13-May-86 14:02")
(declare (globalvars dg.directory-subtree dg.files-backup-names copyrightflg dg.copy-over filelst
))
(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 'directory))
|then| (setq backup-dir (pack* backup-dir '<)))
(setq backup-host (filenamefield backup-dir 'host))
(invertw window)
(setq files-to-backup (|if| (eq backup-type '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 'backupinfo)
'((vars dg.files-backup-names dg.directory-subtree)))
(putprop 'backupinfo 'filetype 'don\'tlist)
(cond
((eq backup-type 'files-and-subs)
(setq dg.directory-subtree source-directory))
(t (setq dg.directory-subtree nil)))
(|if| (eq backup-host '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)
'>
'backupinfo)
'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)
(dg.file-exists (pack* backup-dir f2))
(not (dg.newer-file f1 (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 (dg.file-exists (pack* backup-dir f2)))
|then| (delfile (pack* backup-dir f2)))
(|if| (or (neq backup-host 'floppy)
(greaterp (floppy.free.pages)
(iplus (getfileinfo f1 '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 'backupinfo filelst))
(invertw window))))
(dg.file-exists
(lambda (f) (* |edited:| " 6-Mar-86 14:43")
(infilep f)))
(dg.file-info-command
(lambda (window) (* |edited:| "16-May-86 15:59")
(declare (globalvars dg.promptwindowfont littlefont dg.file-info-attributes))
(prog (source-path selected-files source-prefix menu-window source-path-window wregion
title-width title columns datewidth pwindow)
(setq pwindow (dg.promptwindow window))
(setq source-path (car (dg.wait-for-dir-selection window
"Select directory from which you want to files info.")))
(cond
(source-path (invertw window)
(setq source-prefix (dg.create-prefix-from-path source-path))
(setq title " ")
(|while| (greaterp (stringwidth "MMMMMMMMMMMMMMMMMMMM : " dg.promptwindowfont)
(stringwidth title littlefont)) |do| (setq title (concat title
" ")))
(setq datewidth (stringwidth (date)
dg.promptwindowfont))
(|for| i |in| dg.file-info-attributes |bind| i-with-blanks
|do| (setq columns (nconc1 columns (stringwidth title littlefont)))
(setq i-with-blanks i)
(|if| (member i '(writedate readdate creationdate))
|then| (|while| (greaterp datewidth (stringwidth i-with-blanks
littlefont))
|do| (setq i-with-blanks (concat i-with-blanks " "))))
(setq title (concat title i-with-blanks " ")))
(windowprop window 'dg.info-columns columns)
(setq title-width (stringwidth title littlefont))
(|if| (greaterp title-width (|fetch| width |of| (windowprop pwindow 'region)))
|then| (setq wregion (windowregion window))
(|replace| width |of| wregion
|with| (iplus (|fetch| width |of| wregion)
(idifference title-width (|fetch| width
|of| (windowprop
pwindow
'region)))))
(invertw window)
(reshapeallwindows window wregion)
(invertw window))
(windowprop pwindow 'title title)
(setq menu-window (dg.attach-directory-files-menu source-path window window
'dg.file-info-selection-fn t))
(invertw window)
(|if| menu-window
|then| (windowprop menu-window 'dg.detach t)
(clearw (dg.promptwindow window))
(await.event (windowprop window 'dg.file-selection-ended-event)
1000000)
(detachwindow menu-window)
(closew menu-window))
(windowprop pwindow 'title nil))))))
(dg.file-info-selection-fn
(lambda (item menu key) (* |edited:| "13-May-86 14:17")
(declare (globalvars dg.file-info-attributes))
(prog (window)
(setq window (mainwindow (wfrommenu menu)))
(cond
((eq item '\ stop)
(notify.event (windowprop window 'dg.file-selection-ended-event)))
((equal item " "))
(item (printout (dg.promptwindow window)
t
(substring (car item)
1
(min (nchars (car item)
20)))
" : ")
(|for| att |in| dg.file-info-attributes |as| col |in| (windowprop window
'dg.info-columns)
|do| (dspxposition col (dg.promptwindow window))
(printout (dg.promptwindow window)
(getfileinfo (cadr item)
att))))))))
(dg.files-hardcopy-command
(lambda (window) (* |edited:| "13-May-86 14:06")
(prog (source-path selected-files source-prefix menu-window source-path-window)
(setq source-path (car (dg.wait-for-dir-selection window
"Select directory from which you want to hardcopy selected files."
)))
(cond
(source-path (setq source-prefix (dg.create-prefix-from-path source-path))
(setq menu-window (dg.get-file-list " The selected files will be hardcopied. "
window source-path window))
(setq selected-files (windowprop menu-window 'dg.selected-files))
(|if| selected-files
|then| (invertw window)
(|for| file |in| selected-files
|do| (listfiles1 (pack* source-prefix file))
(shadeitem file (car (windowprop menu-window 'menu))
highlightshade menu-window)
(block))
(invertw window))
(detachwindow menu-window)
(closew menu-window))))))
(dg.load-files-command
(lambda (window loadtype ldflg) (* |edited:| "13-May-86 16:31")
(declare (globalvars highlightshade))
(prog (source-path selected-files source-prefix menu-window source-path-window)
(setq loadtype (or loadtype 'load))
(setq source-path (car (dg.wait-for-dir-selection window (concat
"Select directory from which you want to "
loadtype " selected files."
))))
(cond
(source-path (setq source-prefix (dg.create-prefix-from-path source-path))
(setq menu-window (dg.get-file-list " The selected files will be LOADED. " window
source-path window))
(setq selected-files (windowprop menu-window 'dg.selected-files))
(|if| selected-files
|then| (invertw window)
(|for| file |in| selected-files
|do| (apply* loadtype (pack* source-prefix file)
ldflg)
(shadeitem file (car (windowprop menu-window 'menu))
highlightshade menu-window)
(block))
(invertw window))
(detachwindow menu-window)
(closew menu-window))))))
(dg.newer-file
(lambda (f1 f2) (* |edited:| " 7-Mar-86 15:31")
(greaterp (getfileinfo f1 'icreationdate)
(getfileinfo f2 'icreationdate))))
(dg.backup-on-default-command
(lambda (window) (* |edited:| "13-May-86 13:56")
(declare (globalvars dg.default-backup-directory))
(|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:| "13-May-86 13:55")
(declare (globalvars dg.box-all))
(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 '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
'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 '
dg.path-to-root)
(cdr (|fetch| nodeid |of|
selected-node
)))))))))
(dg.create-backup-free-menu
(lambda (left bottom) (* |edited:| "16-May-86 17:50")
(fm.formatmenu (list '((type title label "Files to Backup : " font (modern 12 bold))
(type toggle label "Include SubDirectories" id subdirs)
(type toggle label "No Old Versions" id subdirs))
(list `(type nway label ,dg.ok-button-bm id buttons)
`(type nway label ,\,dg.reset-button-bm id buttons)
`(type nway label ,\,dg.cancel-button-bm id buttons))))))
(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 'directory)
(iplus 2 (nchars (dg.create-directory-chain (cdr current-path))))
(nchars (filenamefield f 'directory))))
(setq file-backup-name (packfilename 'directory (cond
(second-half (dg.create-directory-chain
(list (car
current-directory
)
second-half)))
(t (car current-directory)))
'name
(filenamefield f 'name)
'extension
(filenamefield f 'extension)
'version
(filenamefield f 'version)))
(return (pack (cdr (unpack file-backup-name)))))))
(dg.create-directory-chain
(lambda (path) (* |sm| " 9-Jun-85 11:49")
(cond
((null path)
'"")
((null (cdr path))
(car path))
(t (pack* (car path)
'>
(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 '- (dg.create-prefix-from-path (append path
(list (car sub)))))))
(return spec))))
(dg.create-directory-tree
(lambda (path) (* |edited:| "13-May-86 12:34")
(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:| "13-May-86 14:09")
(declare (globalvars dg.vertical-horizontal-option dg.graph-label-font))
(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 '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) (* |edited:| "16-May-86 16:19")
(declare (globalvars dg.menu-edge dg.menu-font))
(prog (menuitems temp)
(setq menuitems '(("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."
)))
("Files" null
" The subitems of the <Files> item manipulate files within selected directories"
(subitems ("Move Files" dg.move-file-command
"Will ask you to select: (1) source directory, (2) files to be moved, and (3) target directory."
)
("Copy Files" dg.copy-file-command
"Will ask you to select: (1) source directory, (2) files to be copied, and (3) target directory."
)
("Load Files" (dg.load-files-command load nil)
"Will ask you to select a directory and files to be loaded"
(subitems ("LOAD" (dg.load-files-command load nil)
"Will ask you to select a directory and files to be loaded"
(subitems ("LDFLG=NIL" (
dg.load-files-command
load nil))
("LDFLG=SYSLOAD"
(dg.load-files-command
load sysload))))
("LOAD?" (dg.load-files-command load? nil)
"Will ask you to select a directory and files to be loaded USING LOAD? function"
(subitems ("LDFLG=NIL" (
dg.load-files-command
load? nil))
("LDFLG=SYSLOAD" (
dg.load-files-command
load? sysload
))))
("LOADFROM" (dg.load-files-command loadfrom
nil)
"Will ask you to select a directory and files to be loaded USING LOADFROM function"
(subitems ("LDFLG=NIL" (
dg.load-files-command
loadfrom nil))
("LDFLG=SYSLOAD" (
dg.load-files-command
loadfrom
sysload))))))
("Delete Files" dg.delete-selected-files-command
"Will ask you to select a directory and files to be deleted (EXPUNGED)."
(subitems ("Selected Files"
dg.delete-selected-files-command
"Will ask you to select a directory and files to be deleted (EXPUNGED)."
)
("Old Versions"
dg.delete-old-versions-command " Will ask you to select a directory, and will delete all old versions of files in the selected directory. Only DG.NUMBER-OF-VERSIONS (1 by default) last versions will remain"
)))
("Info" dg.file-info-command
"Will ask you to select a directory, and will display info on selected files. "
)
("Hardcopy" dg.files-hardcopy-command
"Will ask you to select a directory and files to be hardcopied."
)))
("Update" dg.update-command
"Will update the tree structure according to the current file system state"
)))
(|if| (fmemb dg.menu-edge '(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 '(top bottom))
|then| 4
|else| 1)
whenselectedfn ← 'dg.docommand
menufont ← dg.menu-font)))))
(dg.create-path-from-file-name
(lambda (fname) (* |edited:| " 3-Apr-85 15:41")
(prog (dir host)
(setq dir (filenamefield fname 'directory))
(setq host (filenamefield fname 'host))
(return (|if| host
|then| (cons (packfilename 'host (filenamefield fname '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)
'<
(pack (|for| d |in| (cdr path) |join| (list d '>)))))
(t (car path)))))
(dg.create-quit-menu
(lambda (window) (* |edited:| "12-May-86 13:06")
(|create| menu
items ← (subst window 'window '((" I n t e r r u p t / R e s e t " (
dg.kill-process
window)
"Will kill the current DirGrapher process if active, and will reset the DirGrapher display."
)))
centerflg ← t)))
(dg.create-subdir-command
(lambda (window) (* |edited:| "30-Sep-85 14:45")
(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))
(terpri (dg.promptwindow window))
(setq new-dir-name (mkatom (promptforword (concat
"Enter name for new subdirectory (of "
(car directory-subtree)
") :")
nil nil (dg.promptwindow window)
nil
'tty)))
(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
'dg.tree))
window))))))))
(dg.create-tree-from-lists
(lambda (lists) (* |edited:| "13-May-86 12:10")
(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)))))
(block))
(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 '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)))
'(} >)))
|then| (return (pack* current-dir '>))
|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 'dg.path-to-root))
(closew window)
(return nil)))
(dg.delete-from-tree current-path window))))))
(dg.delete-from-tree
(lambda (path window) (* |edited:| "13-May-86 13:58")
(prog (parent-and-son father-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 'dg.tree))
window))))
(dg.delete-old-versions-command
(lambda (window) (* |edited:| "13-May-86 12:07")
(prog (source-path selected-files source-prefix menu-window source-path-window)
(setq source-path (car (dg.wait-for-dir-selection window
"Select directory from which you want to delete old versions of files."
)))
(cond
(source-path (setq source-prefix (dg.create-prefix-from-path source-path))
(setq selected-files (dg.exclusive-old-versions source-prefix))
(|if| selected-files
|then| (printout (dg.promptwindow window)
t " " (length selected-files)
" files will be DELETED from " source-prefix
" . Approve with left button. ")
(|if| (mouseconfirm)
|then| (invertw window)
(|for| file |in| selected-files
|do| (delfile file)
(printout (dg.promptwindow window)
t file " was deleted. ")
(block))
(invertw window)
|else| (printout (dg.promptwindow window)
t " Delete files aborted.")))
(detachwindow menu-window)
(closew menu-window))))))
(dg.delete-selected-files-command
(lambda (window) (* |edited:| "13-May-86 16:31")
(declare (globalvars highlightshade))
(prog (source-path selected-files source-prefix menu-window source-path-window)
(setq source-path (car (dg.wait-for-dir-selection window
"Select directory from which you want to delete selected files."
)))
(cond
(source-path (setq source-prefix (dg.create-prefix-from-path source-path))
(setq menu-window (dg.get-file-list (concat " The selected files will be "
" DELETED (EXPUNGED) " " from "
source-prefix " .")
window source-path window))
(setq selected-files (windowprop menu-window 'dg.selected-files))
(|if| selected-files
|then| (printout (dg.promptwindow window)
t " " (length selected-files)
" files will be DELETED from " source-prefix
" . Approve with left button. ")
(|if| (mouseconfirm)
|then| (invertw window)
(|for| file |in| selected-files
|do| (delfile (pack* source-prefix file))
(shadeitem file (car (windowprop menu-window
'menu))
highlightshade menu-window)
(block))
(invertw window)
|else| (printout (dg.promptwindow window)
t " Delete files aborted.")))
(detachwindow menu-window)
(closew menu-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:| "13-May-86 14:26")
(declare (globalvars dg.last-directory-selected dg.window-of-last-directory
dg.directory-was-selected-event))
(prog (current-node)
(cond
(selected-obj (setq dg.last-directory-selected (append (windowprop g-window '
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 'dg.directory-selection-function 'dg.directory-selection-function)
(windowprop window 'repaintfn (cons 'dg.redisplayfn (mklist (windowprop window 'repaintfn))))
(windowprop window 'copybuttoneventfn 'dg.copybuttoneventfn)
(dg.shade-current-directory window)))
(dg.docommand
(lambda (item menu key) (* |edited:| "13-May-86 14:27")
(declare (globalvars dg.concurrent dg.concurrent-all dg.monitor-lock))
(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 'dg.lock)
window item menu))
(t (dg.docommand-without-monitor window item menu))))))
(dg.docommand-with-monitor
(lambda (monitor-lock window item menu) (* |edited:| " 8-May-86 12:10")
(prog (parent-item)
(setq parent-item (dg.find-menu-item item (|fetch| items |of| menu)))
(windowprop
window
'dg.process
(add.process (subpair '(monitor-lock window menu item parent-item)
(list monitor-lock window menu item parent-item)
'(progn (with.monitor monitor-lock (ttydisplaystream (dg.promptwindow
window))
(shadeitem 'parent-item menu grayshade)
(windowprop window 'dg.unshade-if-shaded
'(shadeitem 'parent-item menu whiteshade))
(clearw (dg.promptwindow window))
(if (atom (cadr 'item))
then (apply* (cadr 'item)
window)
else (apply (caadr 'item)
(cons window (cdadr 'item))))
(printout (dg.promptwindow window)
t
(car 'parent-item)
" Completed. ")
(windowprop window 'dg.unshade-if-shaded nil)
(shadeitem 'parent-item menu whiteshade)
(windowprop window 'dg.shaded-item nil)
(windowprop window 'dg.process nil))))
'window
(dg.promptwindow window)
'name
(car parent-item))))))
(dg.docommand-without-monitor
(lambda (window item menu) (* |edited:| " 8-May-86 12:10")
(windowprop window 'dg.process
(add.process (subpair '(window menu item) (list window menu item)
'(progn (ttydisplaystream (dg.promptwindow window))
(shadeitem 'item menu grayshade)
(windowprop window 'dg.shaded-item 'item)
(clearw (dg.promptwindow window))
(if (atom (cadr 'item))
then (apply* (cadr 'item)
window)
else (apply (caadr 'item)
(cons window (cdadr 'item))))
(printout (dg.promptwindow window)
t
(car 'item)
" Completed. ")
(shadeitem 'item menu whiteshade)
(windowprop window 'dg.shaded-item nil)
(windowprop window 'dg.process nil)))
'window
(dg.promptwindow window)
'name
(car item)))))
(dg.exclusive-directory
(lambda (directory-pattern) (* |edited:| "22-May-85 12:23")
(prog (current-directory)
(setq current-directory (filenamefield directory-pattern 'directory))
(return (|for| f |in| (directory directory-pattern) |when| (eq (filenamefield f
'directory)
current-directory)
|collect| f)))))
(dg.exclusive-new-versions
(lambda (directory-pattern) (* |edited:| "16-May-86 16:24")
(prog (current-directory)
(setq current-directory (filenamefield directory-pattern 'directory))
(return (|for| file |in| (|for| f |in| (directory directory-pattern)
|when| (eq (filenamefield f 'directory)
current-directory) |collect| f)
|when| (equal file (infilep (packfilename.string 'version nil 'body file)))
|collect| file)))))
(dg.exclusive-old-versions
(lambda (directory-pattern) (* |edited:| " 7-May-86 17:59")
(prog (current-directory)
(setq current-directory (filenamefield directory-pattern 'directory))
(return (|for| file |in| (|for| f |in| (directory directory-pattern)
|when| (eq (filenamefield f 'directory)
current-directory) |collect| f)
|when| (not (equal file (infilep (packfilename.string 'version nil 'body file)))
) |collect| file)))))
(dg.fbiconfn
(lambda (window icon) (* |edited:| "13-May-86 14:25")
(declare (globalvars filedrawer filedrawerregion dg.iconfont))
(cond
((null icon)
(setq icon (titlediconw (|create| titledicon
icon ← filedrawer
titlereg ← filedrawerregion)
(dg.create-icon-title (dg.create-path-from-file-name (dg.get-fb-pattern
window)))
dg.iconfont)))
((iconw.title icon (dg.create-icon-title (dg.create-path-from-file-name (dg.get-fb-pattern
window))))))
icon))
(dg.file-selection-fn
(lambda (item menu key) (* |edited:| "13-May-86 14:08")
(declare (globalvars whiteshade blackshade))
(prog (window)
(setq window (wfrommenu menu))
(cond
((eq item '\ stop)
(notify.event (windowprop (mainwindow window)
'dg.file-selection-ended-event)))
((equal item " "))
(item (cond
((fmemb item (windowprop window 'dg.selected-files))
(windowdelprop window 'dg.selected-files item)
(shadeitem item menu whiteshade window))
(t (windowaddprop window 'dg.selected-files item)
(shadeitem item menu blackshade window))))))))
(dg.filecopy
(lambda (f1 f2 over-flag) (* |edited:| " 6-Mar-86 15:06")
(cond
((dg.file-exists f2)
(cond
((or over-flag (dg.newer-file f1 f2))
(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 'dg.path-to-root))))
(setq directory-subtree (list (windowprop window 'dg.tree)))
(|for| x |in| path |do| (setq directory-subtree (fassoc x directory-subtree)))
(return directory-subtree))))
(dg.find-menu-item
(lambda (item item-list) (* |edited:| "26-Sep-85 14:19")
(cond
((null item-list)
nil)
((atom item-list)
nil)
((fmemb item item-list)
item)
((and (cdddr (car item-list))
(eq (car (cadddr (car item-list)))
'subitems)
(dg.find-menu-item item (cdr (cadddr (car item-list)))))
(car item-list))
(t (dg.find-menu-item item (cdr item-list))))))
(dg.find-parent-dierctory
(lambda (path window) (* |edited:| "30-Mar-85 16:29")
(prog (father-directory current-directory)
(setq father-directory (windowprop window '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-fb-pattern
(lambda (w) (* |edited:| " 7-May-86 12:50")
(fetchfield '(filebrowser 14 pointer) (windowprop (mainwindow w)
'filebrowser))))
(dg.get-file-list
(lambda (message window source-path source-window) (* |edited:| "16-May-86 16:16")
(prog (menu-window)
(invertw window)
(setq menu-window (dg.attach-directory-files-menu source-path source-window window))
(invertw window)
(|if| menu-window
|then| (windowprop menu-window 'dg.detach t)
(clearw (dg.promptwindow window))
(|printout| (dg.promptwindow window)
"Select files from menu. When done select STOP." t message)
(await.event (windowprop window 'dg.file-selection-ended-event)
1000000))
(return menu-window))))
(dg.get-initial-region
(lambda (graph) (* \; "Edited 19-Aug-87 08:55 by smL")
(declare (globalvars dg.max-width dg.max-height dg.min-width dg.min-height))
(* |;;| "Edited by smL to use WIDTHIFWINDOW and HEIGHTIFWINDOW")
(let ((g-region (graphregion graph)))
(getmousestate)
(getregion (min dg.max-width (widthifwindow (max (|fetch| width |of| g-region)
dg.min-width)))
(min dg.max-height (heightifwindow (max (|fetch| height |of| g-region)
dg.min-height)
t))))))
(dg.kill-process
(lambda (window) (* |edited:| "12-May-86 13:03")
(cond
((windowprop window 'dg.process)
(del.process (windowprop window '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 'dg.detach) |do| (detachwindow w)
(closew w))
(windowprop (dg.promptwindow window)
'title nil)
(redisplayw window)
(eval (windowprop window 'dg.unshade-if-shaded))
(windowprop window '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:| "20-May-86 23:22")
(declare (globalvars dg.copy-over highlightshade))
(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 (setq source-prefix (dg.create-prefix-from-path source-path))
(setq target-path (car (dg.wait-for-dir-selection window
"Select target directory " t)))
(|if| target-path
|then| (setq target-prefix (dg.create-prefix-from-path target-path))
(setq menu-window (dg.get-file-list (concat
" The selected files will be "
(|if| move
|then| " MOVED "
|else| " COPIED ")
" from " source-prefix
" to " target-prefix " .")
window source-path source-window))
(setq selected-files (windowprop menu-window 'dg.selected-files))
(|if| selected-files
|then| (invertw window)
(|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
'menu))
highlightshade menu-window)
(block))
(invertw window))
(detachwindow menu-window)
(closew menu-window)))))))
(dg.movecopy-dir-command
(lambda (window move) (* |edited:| "13-May-86 14:13")
(declare (globalvars dg.copy-over))
(prog (target-path source-path selected-files target-prefix source-prefix source-window-path
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 'host (filenamefield
file
'host)
'directory
(filenamefield file 'directory))
" --> " new-prefix)
|else| (|printout| (dg.promptwindow window)
t new-name " already exists and was not copied. "))
(|if| move
|then| (delfile file))
(block))
(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
'dg.tree))
source-window)
(|if| (neq target-window source-window)
|then| (dg.display-directory-tree (dg.create-graph-from-tree
(windowprop target-window 'dg.tree))
target-window)))))))))
(dg.pack-name-ver-ext
(lambda (f) (* |edited:| " 3-Apr-85 11:31")
(packfilename 'name (filenamefield f 'name)
'version
(filenamefield f 'version)
'extension
(filenamefield f 'extension))))
(dg.promptwindow
(lambda (window) (* |edited:| "29-Mar-85 16:07")
(car (windowprop window 'promptwindow))))
(dg.redisplayfn
(lambda (window) (* |edited:| "26-Sep-85 15:05")
(dg.shade-current-directory window)))
(dg.residual-path
(lambda (window path) (* |edited:| "29-Mar-85 12:37")
(nth path (length (windowprop window 'dg.path-to-root)))))
(dg.restore-command
(lambda (window backup-dir) (* |edited:| "12-May-86 14:57")
(declare (globalvars dg.files-backup-names dg.directory-subtree dg.copy-over))
(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 'host))
(|if| (eq backup-host 'floppy)
|then| (|printout| (dg.promptwindow window)
t "Insert Floppy")
(floppy.wait.for.floppy))
(|if| (null (filenamefield backup-dir 'directory))
|then| (setq backup-dir (pack* backup-dir '<)))
(invertw window)
(setq info-name (pack* backup-dir (car target-directory)
'>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 '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
'dg.tree))
target-window)
(|if| (neq target-window window)
|then| (invertw window))
(setq files-backup-names dg.files-backup-names)
newroundofcopy
(invertw window)
(|for| f |in| files-backup-names |bind| f-with-<
|do| (cond
((dg.file-exists (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* '< 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 '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 newroundofcopy)
|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) (* |edited:| "13-May-86 13:57")
(declare (globalvars dg.default-backup-directory))
(|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) (* |edited:| "13-May-86 12:10")
(prog (new-set)
(|for| one-element |in| l |when| (not (member one-element new-set))
|do| (setq new-set (cons one-element new-set))
(block))
(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 'dg.path-to-root))))
(|for| node |in| (|fetch| graphnodes |of| (windowprop window '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)
'>))
(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 'dg.path-to-root)))
(windowprop window '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:| "13-May-86 14:31")
(declare (globalvars dg.last-directory-selected dg.directory-was-selected-event
dg.window-of-last-directory))
(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?) (* |edited:| "13-May-86 14:24")
(declare (globalvars dg.default-dir waitingcursor promptwindow dg.min-width dg.min-height
dg.promptwindowfont dg.menu-edge))
(prog (tree dg.window path old-cursor graph)
(cond
((null {dev}<dir>)
(setq {dev}<dir> dg.default-dir)))
(setq old-cursor (cursor waitingcursor))
(printout promptwindow t "DirGrapher : Computing directory structure ")
(|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 (copy path))))
(setq graph (dg.create-graph-from-tree tree))
(printout promptwindow t "DirGrapher : Done.")
(cursor old-cursor)
(|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 'minsize (cons dg.min-width dg.min-height)))
(windowprop dg.window 'dg.path-to-root path)
(dg.display-directory-tree graph dg.window)
(windowprop dg.window 'dg.tree tree)
(windowaddprop dg.window 'repaintfn 'dg.redisplayfn)
(windowprop dg.window 'iconfn 'dg.createiconw)
(windowprop dg.window 'expandfn '(dg.shade-current-directory redisplaygraph))
(windowprop dg.window 'dg.icontitle (dg.create-icon-title path))
(windowprop dg.window 'dg.process nil)
(windowprop dg.window 'dg.file-selection-ended-event (create.event "DGEVENT"))
(windowprop dg.window 'dg.lock (create.monitorlock "DG.LOCK"))
(getpromptwindow dg.window 3 dg.promptwindowfont)
(attachmenu (dg.create-menu dg.window)
dg.window dg.menu-edge 'justify)
(attachmenu (dg.create-quit-menu dg.window)
dg.window
'bottom
'justify)
(return dg.window))))
)
(rpaqq dg.icon #*(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@
)
(rpaqq dg.mask #*(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@
)
(rpaqq dg.fill-window-texture
#*(16 16)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@)
(rpaqq dg.whitebm #*(16 16)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@)
(dg.advise-generate-file)
(setq dg.background-directories (union dg.background-directories
(union directories (cons '{floppy}
(for d in (volumes)
when
(lispdirectoryp d)
collect
(pack* '{dsk}< d '>))))))
(dg.add-item-to-background-menu
'|DirGrapher|
'(dirgrapher) "Will initiate dirgrapher process on the current directory"
(cons 'subitems (cons '("DG Windows to top" (|for| w |in| (openwindows)
|when|
(or (windowprop w 'dg.path-to-root)
(and (windowprop w 'iconfor)
(windowprop (windowprop w 'iconfor)
'dg.path-to-root)))
|do|
(totopw w)))
(for d in dg.background-directories collect (list d (list 'dirgrapher
(kwote d))
(concat
"WILL APPLY DIRGRAPHER ON "
d))))))
(* |;;;| "(declare\\: dontcopy (prop makefile-environment dirgrapher))")
(putprops dirgrapher copyright ("Shaul Markovitch" 1985 1986 1900 1987 1988))
(declare\: dontcopy
(filemap (nil (8084 97635 (dg.add-item-to-background-menu 8094 . 8552) (dg.advise-generate-file 8554
. 10241) (dg.apply-dirgrapher-command 10243 . 10764) (dg.apply-fb-on-dir-and-subdirs-command 10766 .
10939) (dg.apply-filebrowser-command 10941 . 11662) (dg.ask-for-backup-type 11664 . 12619) (
dg.attach-directory-files-menu 12621 . 16321) (dg.backup-command 16323 . 21827) (dg.file-exists 21829
. 21955) (dg.file-info-command 21957 . 25478) (dg.file-info-selection-fn 25480 . 26625) (
dg.files-hardcopy-command 26627 . 27988) (dg.load-files-command 27990 . 29633) (dg.newer-file 29635 .
29834) (dg.backup-on-default-command 29836 . 30287) (dg.backup-on-selected-command 30289 . 30776) (
dg.connect-dir-command 30778 . 31526) (dg.copy-directory-command 31528 . 31686) (dg.copy-file-command
31688 . 31837) (dg.copybuttoneventfn 31839 . 33270) (dg.create-backup-free-menu 33272 . 33892) (
dg.create-backup-name 33894 . 35331) (dg.create-directory-chain 35333 . 35645) (
dg.create-directory-spec 35647 . 36192) (dg.create-directory-tree 36194 . 36791) (
dg.create-graph-from-tree 36793 . 37277) (dg.create-icon-title 37279 . 37805) (dg.create-menu 37807 .
47220) (dg.create-path-from-file-name 47222 . 47939) (dg.create-prefix-from-path 47941 . 48228) (
dg.create-quit-menu 48230 . 48882) (dg.create-subdir-command 48884 . 50454) (dg.create-tree-from-lists
50456 . 51392) (dg.create-tree-nodes 51394 . 53153) (dg.createiconw 53155 . 53643) (
dg.current-connected-directory 53645 . 54038) (dg.delete-directory-command 54040 . 56106) (
dg.delete-from-tree 56108 . 56645) (dg.delete-old-versions-command 56647 . 58354) (
dg.delete-selected-files-command 58356 . 60575) (dg.directory-minus-prefix 60577 . 60833) (
dg.directory-selection-function 60835 . 61727) (dg.display-directory-tree 61729 . 62143) (dg.docommand
62145 . 62742) (dg.docommand-with-monitor 62744 . 64873) (dg.docommand-without-monitor 64875 . 66360)
(dg.exclusive-directory 66362 . 66900) (dg.exclusive-new-versions 66902 . 67507) (
dg.exclusive-old-versions 67509 . 68133) (dg.fbiconfn 68135 . 68946) (dg.file-selection-fn 68948 .
69758) (dg.filecopy 69760 . 70085) (dg.find-directory-subtree 70087 . 70515) (dg.find-menu-item 70517
. 71022) (dg.find-parent-dierctory 71024 . 71780) (dg.flashallwindows 71782 . 71975) (
dg.get-fb-pattern 71977 . 72223) (dg.get-file-list 72225 . 72948) (dg.get-initial-region 72950 . 73678
) (dg.kill-process 73680 . 74460) (dg.move-dir-command 74462 . 74616) (dg.move-file-command 74618 .
74769) (dg.movecopy-command 74771 . 78216) (dg.movecopy-dir-command 78218 . 83535) (
dg.pack-name-ver-ext 83537 . 83822) (dg.promptwindow 83824 . 83979) (dg.redisplayfn 83981 . 84131) (
dg.residual-path 84133 . 84306) (dg.restore-command 84308 . 89859) (dg.restore-from-default-command
89861 . 90316) (dg.restore-from-selected-command 90318 . 90809) (dg.setify 90811 . 91129) (
dg.shade-current-directory 91131 . 91896) (dg.trim 91898 . 92097) (dg.unadvise 92099 . 92267) (
dg.unadvise-generate-file 92269 . 92451) (dg.unpack-directory-name 92453 . 93166) (dg.update-command
93168 . 93340) (dg.update-directory-tree 93342 . 93705) (dg.update-directroy-tree 93707 . 93982) (
dg.wait-for-dir-selection 93984 . 95380) (dirgrapher 95382 . 97633)))))
stop