(FILECREATED "20-Feb-85 14:15:03" {DANTE}<WOGULIS>DIRECTORYTOOLS.;9 13118
changes to: (FNS DIRECTORY.TREE QUICK.LIST CHARCODE.TO.STRING MIDDLE.DIR.COMMAND
DIR.FROM.GRAPH)
(VARS DIRECTORYTOOLSCOMS)
previous date: "15-Feb-85 16:17:06" {DANTE}<WOGULIS>DIRECTORYTOOLS.;7)
(* Copyright (c) 1985 by Jim Wogulis & Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DIRECTORYTOOLSCOMS)
(RPAQQ DIRECTORYTOOLSCOMS ((FILES GRAPHER FILEBROWSER)
(* GRAPH.DIRECTORY is the only function intended for users to call.)
(FNS CHARCODE.TO.STRING GRAPH.DIRECTORY GRAPH.DIRECTORY1 DIRECTORY.TREE
LEFT.DIR.COMMAND MIDDLE.DIR.COMMAND LEFT.DIR.GRAPH.FNS DIR.FROM.GRAPH
QUICK.LIST GET.DIR.FROM.STRING MERGE.DIR FIXDIR)))
(FILESLOAD GRAPHER FILEBROWSER)
(* GRAPH.DIRECTORY is the only function intended for users to call.)
(DEFINEQ
(CHARCODE.TO.STRING
[LAMBDA (LIST) (* edited: "20-Feb-85 14:11")
(PROG [(STR (ALLOCSTRING (LENGTH LIST]
(for X in LIST as N from 1 do (RPLCHARCODE STR N X))
(RETURN STR])
(GRAPH.DIRECTORY
[LAMBDA (FILEGROUP WINDOW CASE.SENSITIVE?) (* JWogulis "15-Feb-85 16:16")
(PROG (TREE)
(* * This is the only function intended for the user. It graphs the subdirectories of FILEGROUP and has two button
commands that work on the nodes, LEFT.DIR.COMMAND and MIDDLE.DIR.COMMAND It returns the window.)
(if [NOT (HOSTNAMEP (FILENAMEFIELD FILEGROUP (QUOTE HOST]
then (printout T "I can not find host: " (FILENAMEFIELD FILEGROUP (QUOTE HOST))
T)
(RETURN NIL))
[if (NOT (WINDOWP WINDOW))
then (SETQ WINDOW (CREATEW (GETREGION 100 100]
(WINDOWPROP WINDOW (QUOTE TITLE)
"SEARCHING FOR SUBDIRS...")
(ADD.PROCESS (LIST (QUOTE GRAPH.DIRECTORY1)
(KWOTE FILEGROUP)
(KWOTE WINDOW)
(KWOTE CASE.SENSITIVE?))
(QUOTE NAME)
"DIRECTORY GRAPHER")
(RETURN WINDOW])
(GRAPH.DIRECTORY1
[LAMBDA (FILEGROUP WINDOW CASE.SENSITIVE?) (* JWogulis "15-Feb-85 15:21")
(PROG (TREE)
(* * This is the only function intended for the user. It graphs the subdirectories of FILEGROUP and has two button
commands that work on the nodes, LEFT.DIR.COMMAND and MIDDLE.DIR.COMMAND It returns the window.)
(if [NOT (CAR (SETQ TREE (if (NOT (LISTP FILEGROUP))
then (DIRECTORY.TREE FILEGROUP CASE.SENSITIVE?)
else FILEGROUP]
then (printout WINDOW "There are no files in the group:" FILEGROUP T)
(RETURN NIL))
(SHOWGRAPH (LAYOUTSEXPR TREE)
WINDOW
(QUOTE LEFT.DIR.COMMAND)
(QUOTE MIDDLE.DIR.COMMAND))
(WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT "SubDirectories of: " FILEGROUP])
(DIRECTORY.TREE
[LAMBDA (FILESPEC CASE.SENSITIVE?) (* edited: "20-Feb-85 14:13")
(PROG [NEXTDIR DIRS TEMP HOST (FILEGROUP (\GENERATEFILES (DIRECTORY.FILL.PATTERN FILESPEC]
(* * In the while loop: this generates the "next" file in FILEGROUP each time through. Then it gets just the
subdirectory name and collects it in DIRS if it is not already there.)
[while (SETQ NEXTDIR (\GENERATENEXTFILE FILEGROUP))
do (if (NOT HOST)
then
(* I need this to get the full host name since the user could use abbreviations (It would be nice to put this
somewhere else.))
(SETQ HOST (CONCAT "{" (FILENAMEFIELD (if (LISTP NEXTDIR)
then (CHARCODE.TO.STRING NEXTDIR)
else NEXTDIR)
(QUOTE HOST))
"}")))
(BLOCK) (* I have the LISTP check because the Dlion filesystem
returns charcode lists rather than names when using
\GENERATENEXTFILE %.)
(SETQ NEXTDIR (GET.DIR.FROM.STRING (if (LISTP NEXTDIR)
then (CHARCODE.TO.STRING NEXTDIR)
else NEXTDIR)))
(if (NOT CASE.SENSITIVE?)
then (SETQ NEXTDIR (U-CASE NEXTDIR))) (* I this checks to see if the STRING NEXTDIR is
already in DIRS Kind of kludgy.)
(if (NOT (for STR in DIRS thereis (STREQUAL STR NEXTDIR)))
then (SETQ DIRS (CONS NEXTDIR DIRS] (* FIXDIR takes the subdirectory string and returns a
list of sudirs i.e. "<TEST>TEST2>" =>
(TEST TEST2))
(SETQ DIRS (for X in DIRS collect (FIXDIR X))) (* MERGE.DIR takes a list of lists like those returned
from FIXDIR and makes it a grapher useable list of the
subdirectory tree.)
(RETURN (APPEND (LIST HOST)
(MERGE.DIR DIRS])
(LEFT.DIR.COMMAND
[LAMBDA (NODE WINDOW) (* JWogulis "15-Feb-85 11:36")
(* * This is the left button command. It would be easy to add more items here, and take care of the cases in the
function: LEFT.DIR.GRAPH.FNS)
(if NODE
then (if [NOT (OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT]
then (MENU (create MENU
ITEMS ←(LIST (LIST (QUOTE FileBrowser)
(LIST NODE WINDOW)
"Will bring up FILEBROWSER on the selected subdirectory.")
(LIST (QUOTE List% Files)
(LIST NODE WINDOW)
"Will do a quick listing of the files under subdirectory."))
WHENSELECTEDFN ←(QUOTE LEFT.DIR.GRAPH.FNS)))
else (MIDDLE.DIR.COMMAND NODE WINDOW])
(MIDDLE.DIR.COMMAND
[LAMBDA (NODE WINDOW) (* edited: "20-Feb-85 13:50")
(* * This is the middle button case and now just BKSYSBUFs the full subdirectory name into the current TTY.
The weird loop in there is so that names like NS names that might have embedded blanks, are printed out in the TTY
with % before the blanks.)
(if NODE
then (for X in (CHCON (DIR.FROM.GRAPH NODE WINDOW)) join (if (EQUAL 32 X)
then (BKSYSBUF
(CONCAT (CHARACTER 37)
(CHARACTER 32)))
else (BKSYSBUF (CHARACTER X])
(LEFT.DIR.GRAPH.FNS
[LAMBDA (ITEM MENU BUTTON) (* JWogulis "13-Feb-85 10:58")
(* * This is what the left button menu uses on the selected item. I have constructed the ITEM to hold the NODE and
WINDOW information needed. (see LEFT.DIR.COMMAND))
(PROG (DIR.PATT)
(if ITEM
then (SETQ DIR.PATT (DIR.FROM.GRAPH (CAADR ITEM)
(CADADR ITEM)))
(SELECTQ (CAR ITEM)
(FileBrowser (* Do a FILEBROWSER on the file pattern.)
(FILEBROWSER DIR.PATT))
[List% Files (* Add as a process, a quick listing of the files under
file pattern.)
(ADD.PROCESS (LIST (QUOTE QUICK.LIST)
(KWOTE (CAADR ITEM))
(KWOTE (CADADR ITEM]
NIL])
(DIR.FROM.GRAPH
[LAMBDA (NODE WINDOW) (* edited: "20-Feb-85 13:36")
(PROG ([RESULT (LIST (OR (fetch NODELABEL of NODE)
(fetch NODEID of NODE]
[ALLNODES (fetch GRAPHNODES of (WINDOWPROP WINDOW (QUOTE GRAPH]
(CURRENT.NODE NODE))
(* * This function takes a NODE record and a WINDOW as its argument, and returns the full subdir name of the node as
a string. The algoritm is kludgy because GRAPHER does not keep around the info I really need
(i.e. each NODE has a field for the TONODES and FROMNODES which are lists of NODEIDs instead of the actual NODE
record. Oh well.))
(until [NOT (SETQ CURRENT.NODE (CAR (fetch FROMNODES of CURRENT.NODE]
do
(* Find the node that leads to CURRENT.NODE by finding the node in the graph with the same ID as the first
(and in this case only) FROMNODES of CURRENT.NODE %.)
[SETQ CURRENT.NODE (for X in ALLNODES thereis (EQUAL CURRENT.NODE
(fetch NODEID of X]
(* The result here is a list of the dir and subdirs. The OR case is used because a NODE may have a NODELABEL which
is what is printed on the graph which is correct because NODEID may be just an identifier and not the right name.)
(SETQ RESULT (CONS (OR (fetch NODELABEL of CURRENT.NODE)
(fetch NODEID of CURRENT.NODE))
RESULT)))
(* This assumes that the first member of the list is the host name , the second is the directory , and the rest are
the subdirs. I think this is a safe assumption.)
(RETURN (CONCATLIST (APPEND (LIST (CAR RESULT)
"<")
(for X in (CDR RESULT) join (LIST X ">"])
(QUICK.LIST
[LAMBDA (NODE WINDOW) (* edited: "20-Feb-85 14:13")
(PROG ((DIR.PATT (DIR.FROM.GRAPH NODE WINDOW))
START FILEGROUP)
(* * This is a quick list of the files under the subdir associated with NODE and WINDOW. Since I add this as a
process, the printout T and (WINDOWPROP NIL (QUOTE TITLE) DIR.PATT) will default to the output window of the
process. I needed to do this because I saw now easy way of creating a window that was scrollable AND would black out
when full.)
(SETQ FILEGROUP (\GENERATEFILES (DIRECTORY.FILL.PATTERN DIR.PATT)))
(SETQ START (ADD1 (NCHARS DIR.PATT)))
(WINDOWPROP NIL (QUOTE TITLE)
DIR.PATT)
(while (SETQ NEXTDIR (\GENERATENEXTFILE FILEGROUP))
do (BLOCK)
(printout T (SUBSTRING (if (LISTP NEXTDIR)
then (CHARCODE.TO.STRING NEXTDIR)
else NEXTDIR)
START -1)
T))
(printout T "=== done ===" T])
(GET.DIR.FROM.STRING
[LAMBDA (STRING) (* JWogulis "13-Feb-85 11:10")
(PROG (FIRST LAST)
(* * This function takes a filename string and returns the directory/subdirectory string with < to start and > on
the end.)
(SETQ FIRST (STRPOS "<" STRING))
[SETQ LAST (for X from (NCHARS STRING) to 1 by -1 thereis (STREQUAL ">"
(SUBSTRING STRING X X]
(RETURN (SUBSTRING STRING FIRST LAST])
(MERGE.DIR
[LAMBDA (LIST) (* JWogulis "15-Feb-85 14:47")
(PROG (TEMP)
(* * This recursive function takes a list of dir/subdir lists and returns a list suitable for LAYOUTSEXPR from
GRAPHER to use.)
(if (EQUAL 1 (LENGTH LIST))
then (* In this case there are no subdirs of the CAR of
LIST)
(RETURN LIST)) (* Now collect all the dir/subdir names that are the
CARs of each element of LIST and remove repeats with
INTERSECTION)
(SETQ TEMP (for X in LIST collect (CAR X)))
(SETQ TEMP (INTERSECTION TEMP TEMP))
(RETURN (for X in TEMP collect (APPEND (LIST X)
(MERGE.DIR (for Y in LIST
when (AND (STREQUAL X (CAR Y))
(ILESSP 1 (LENGTH Y)))
collect (CDR Y])
(FIXDIR
[LAMBDA (STRING) (* JWogulis "15-Feb-85 14:26")
(PROG (SPACES (NUM 0))
(* * FIXDIR takes a directory string and returns a list of the subdirectories, each delimited by >)
(SETQ SPACES (for X from 2 to (NCHARS STRING) when (STREQUAL ">" (SUBSTRING STRING X X))
collect (SUB1 X)))
(RETURN (for X in SPACES bind (LAST ← 2)
STR
collect (SETQ STR (SUBSTRING STRING LAST X))
(SETQ LAST (IPLUS 2 X))
STR])
)
(PUTPROPS DIRECTORYTOOLS COPYRIGHT ("Jim Wogulis & Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (872 13019 (CHARCODE.TO.STRING 882 . 1174) (GRAPH.DIRECTORY 1176 . 2228) (
GRAPH.DIRECTORY1 2230 . 3142) (DIRECTORY.TREE 3144 . 5248) (LEFT.DIR.COMMAND 5250 . 6146) (
MIDDLE.DIR.COMMAND 6148 . 6840) (LEFT.DIR.GRAPH.FNS 6842 . 7733) (DIR.FROM.GRAPH 7735 . 9641) (
QUICK.LIST 9643 . 10747) (GET.DIR.FROM.STRING 10749 . 11313) (MERGE.DIR 11315 . 12395) (FIXDIR 12397
. 13017)))))
STOP