(FILECREATED "15-Oct-85 15:42:32" {DSK}<LISPFILES>FERGUSON>DIRMENU.LSP;4 19702 changes to: (FNS DIRMENU.INIT DIRMENU DIRMENU.WSF DIRMENU.REDISPLAY) previous date: " 1-Oct-85 08:54:50" {DSK}<LISPFILES>FERGUSON>DIRMENU.LSP;3) (* Copyright (c) 1985 by FERGUSON, JAY, C.. All rights reserved.) (PRETTYCOMPRINT DIRMENUCOMS) (RPAQQ DIRMENUCOMS ((* * DIRMENU directory interface package) (INITVARS (DIRMENU.MENU.FONT (QUOTE (HELVETICA 10))) (DIRMENU.DIR.FONT (QUOTE (GACHA 12 BOLD))) (DIRMENU.BORDER 4) (DIRMENU.WIDTH 300)) (GLOBALVARS DIRECTORIES LISPUSERSDIRECTORIES FONTDIRECTORIES USERNAME \CONNECTED.DIRECTORY LOGINHOST/DIR DIRMENU.MENU.FONT DIRMENU.DIR.FONT DIRMENU.WIDTH DIRMENU.BORDER) (* * DIRMENU Functions) (FNS DIRMENU DIRMENU.CONNECT DIRMENU.EDIT DIRMENU.INIT DIRMENU.LOAD DIRMENU.RBF DIRMENU.REDISPLAY DIRMENU.WSF MAKE.DIR.ENTRY REPLACE.ITEM SELECTDIR.WSF SELECTED.WSF) (* * Advised functions) (ADVISE /CNDIR CNDIR) (* * Loaded files) (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) COPYFILES) (* * System declarations - localvars for smaller & faster compile -) (DECLARE: (LOCALVARS . T)) (LISPXMACROS CDIR))) (* * DIRMENU directory interface package) (RPAQ? DIRMENU.MENU.FONT (QUOTE (HELVETICA 10))) (RPAQ? DIRMENU.DIR.FONT (QUOTE (GACHA 12 BOLD))) (RPAQ? DIRMENU.BORDER 4) (RPAQ? DIRMENU.WIDTH 300) (DECLARE: DOEVAL@COMPILE DONTCOPY (GLOBALVARS DIRECTORIES LISPUSERSDIRECTORIES FONTDIRECTORIES USERNAME \CONNECTED.DIRECTORY LOGINHOST/DIR DIRMENU.MENU.FONT DIRMENU.DIR.FONT DIRMENU.WIDTH DIRMENU.BORDER) ) (* * DIRMENU Functions) (DEFINEQ (DIRMENU [LAMBDA (POS NAME DEFAULT/DIR) (* j.ferguson "15-Oct-85 15:41") (PROG (LOADINFO COMMAND.MENU SELECTED.MENU DIR.MENU BASEHEIGHT WIN) (SETQ COMMAND.MENU (create MENU ITEMS ←(QUOTE (CONNECT (DIRECTORY (QUOTE DIRECTORY) NIL (SUBITEMS (NDIR (QUOTE NDIR) NIL) (SIZE (QUOTE SIZE) NIL) (VERBOSE (QUOTE VERBOSE) NIL) (PARTIAL (QUOTE PARTIAL) NIL))) LOAD (COPYFILES (QUOTE COPYFILES) NIL (SUBITEMS (COPYFILES (QUOTE COPYFILES) NIL) (COPYFILE (QUOTE COPYFILE) NIL))) FILEBROWSER MAKEFILE)) WHENSELECTEDFN ←(FUNCTION DIRMENU.WSF) MENUOUTLINESIZE ← 0 CENTERFLG ← T MENUFONT ← DIRMENU.MENU.FONT)) (SETQ SELECTED.MENU (create MENU ITEMS ←(QUOTE (SELECTED-DIRECTORY)) CENTERFLG ← T ITEMWIDTH ←(IDIFFERENCE DIRMENU.WIDTH (PLUS DIRMENU.BORDER 4)) ITEMHEIGHT ← 20 MENUOUTLINESIZE ← 0 WHENSELECTEDFN ←(FUNCTION SELECTED.WSF) MENUFONT ← DIRMENU.DIR.FONT)) (SETQ LOADINFO (DIRMENU.LOAD NAME DEFAULT/DIR)) (SETQ DIR.MENU (create MENU ITEMS ←(for ITEM in (CDR LOADINFO) collect (MAKE.DIR.ENTRY ITEM)) WHENSELECTEDFN ←(FUNCTION SELECTDIR.WSF) MENUOUTLINESIZE ← 0 MENUFONT ← DIRMENU.MENU.FONT)) [SETQ BASEHEIGHT (PLUS DIRMENU.BORDER (MAX (fetch IMAGEHEIGHT of COMMAND.MENU) (fetch IMAGEHEIGHT of DIR.MENU] (if (POSITIONP POS) then (SETQ WIN (CREATEW (CREATEREGION (fetch XCOORD of POS) (fetch YCOORD of POS) DIRMENU.WIDTH (IPLUS BASEHEIGHT (fetch IMAGEHEIGHT of SELECTED.MENU) (TIMES DIRMENU.BORDER 4))) NIL DIRMENU.BORDER)) else (SETQ WIN (CREATEW (GETBOXREGION DIRMENU.WIDTH (IPLUS BASEHEIGHT (fetch IMAGEHEIGHT of SELECTED.MENU) (TIMES DIRMENU.BORDER 4))) NIL DIRMENU.BORDER))) (ADDMENU COMMAND.MENU WIN (CREATEPOSITION (QUOTIENT (DIFFERENCE (QUOTIENT DIRMENU.WIDTH 2) (fetch IMAGEWIDTH of COMMAND.MENU)) 2) 2)) (ADDMENU DIR.MENU WIN (CREATEPOSITION (PLUS (QUOTIENT DIRMENU.WIDTH 2) (QUOTIENT (DIFFERENCE (QUOTIENT DIRMENU.WIDTH 2) (fetch IMAGEWIDTH of DIR.MENU)) (QUOTIENT DIRMENU.BORDER 2))) 2)) (ADDMENU SELECTED.MENU WIN (CREATEPOSITION 0 (IPLUS BASEHEIGHT DIRMENU.BORDER 2))) (WINDOWPROP WIN (QUOTE NAME) NAME) (WINDOWPROP WIN (QUOTE DIR.MENU) DIR.MENU) (WINDOWPROP WIN (QUOTE COMMAND.MENU) COMMAND.MENU) (WINDOWPROP WIN (QUOTE SELECTED.MENU) SELECTED.MENU) (WINDOWPROP WIN (QUOTE REPAINTFN) (FUNCTION DIRMENU.REDISPLAY)) (WINDOWPROP WIN (QUOTE RIGHTBUTTONFN) (FUNCTION DIRMENU.RBF)) (WINDOWPROP WIN (QUOTE DIRMENU.FILENAME) (CAR LOADINFO)) (WINDOWPROP WIN (QUOTE DIRMENU.DATA) (CDR LOADINFO)) (DIRMENU.REDISPLAY WIN]) (DIRMENU.CONNECT [LAMBDA (DIRECTORY WIN) (* j.ferguson "30-Aug-85 18:05") (if [OR (EQ DIRECTORY (WINDOWPROP WIN 'SELECTED-DIRECTORY)) (EQUAL (MKATOM (CONCAT DIRECTORY ">")) (WINDOWPROP WIN 'SELECTED-DIRECTORY] then (REPLACE.ITEM 'CONNECT (WINDOWPROP WIN 'COMMAND.MENU) '*connected* T T) else (REPLACE.ITEM 'CONNECT (WINDOWPROP WIN 'COMMAND.MENU) 'CONNECT NIL T]) (DIRMENU.EDIT [LAMBDA (WIN) (* j.ferguson "30-Aug-85 18:05") (PROG (POS DIRMENU.DATA FILE DIR.MENU BASEHEIGHT SELECTED.MENU) (DECLARE (SPECVARS DIRMENU.DATA)) (SETQ DIRMENU.DATA (WINDOWPROP WIN 'DIRMENU.DATA)) (EDITE DIRMENU.DATA) (UNMARKASCHANGED 'DIRMENU.DATA 'VARS) (if (SETQ FILE (FULLNAME (CONCAT 'DIRMENU '%. (OR (WINDOWPROP WIN 'NAME) USERNAME 'DEFAULT)) 'OLD/NEW)) then (OPENFILE FILE 'BOTH) (PRINT DIRMENU.DATA FILE) (CLOSEF? FILE)) (SETQ DIR.MENU (create MENU ITEMS ←(for ITEM in DIRMENU.DATA collect (MAKE.DIR.ENTRY ITEM)) WHENSELECTEDFN ←(FUNCTION SELECTDIR.WSF) MENUOUTLINESIZE ← 0 MENUFONT ← DIRMENU.MENU.FONT)) [SETQ BASEHEIGHT (PLUS DIRMENU.BORDER (MAX (fetch IMAGEHEIGHT of (WINDOWPROP WIN 'COMMAND.MENU)) (fetch IMAGEHEIGHT of DIR.MENU] (SETQ SELECTED.MENU (WINDOWPROP WIN 'SELECTED.MENU)) (SETQ POS (with REGION (WINDOWPROP WIN 'REGION) (CONS LEFT BOTTOM))) [SHAPEW WIN (CREATEREGION (CAR POS) (CDR POS) DIRMENU.WIDTH (PLUS BASEHEIGHT (fetch IMAGEHEIGHT of SELECTED.MENU) (TIMES DIRMENU.BORDER 4] (DELETEMENU (WINDOWPROP WIN 'DIR.MENU DIR.MENU) T WIN) (DELETEMENU SELECTED.MENU T WIN) (ADDMENU SELECTED.MENU WIN (CREATEPOSITION 0 (IPLUS BASEHEIGHT DIRMENU.BORDER 2))) (ADDMENU DIR.MENU WIN (CREATEPOSITION (PLUS (QUOTIENT DIRMENU.WIDTH 2) (QUOTIENT (DIFFERENCE (QUOTIENT DIRMENU.WIDTH 2) (fetch IMAGEWIDTH of DIR.MENU)) (QUOTIENT DIRMENU.BORDER 2))) 2) T) (WINDOWPROP WIN 'DIRMENU.DATA DIRMENU.DATA) (WINDOWPROP WIN 'DIRMENU.FILENAME FILE) (DIRMENU.REDISPLAY WIN]) (DIRMENU.INIT [LAMBDA (FULLFLG) (* j.ferguson "15-Oct-85 15:23") (PROG ([DIRS (COPY (QUOTE (DSK] LUDIRS FONTDIRS DIRECTORY END) [if FULLFLG then (for FILE in (DIRECTORY (QUOTE {DSK}*.*)) do (SETQ DIRECTORY (FILENAMEFIELD FILE (QUOTE DIRECTORY))) (PUTASSOC (IF (SETQ END (STRPOS (QUOTE >) DIRECTORY)) THEN (MKATOM (SUBSTRING DIRECTORY (ADD1 END))) ELSE DIRECTORY) (CONCAT (QUOTE {DSK}<) DIRECTORY (QUOTE >)) DIRS)) else (SETQ DIRS (CONS (QUOTE DSK) (OR (for FILE in DIRECTORIES when FILE collect (SETQ DIRECTORY (FILENAMEFIELD FILE (QUOTE DIRECTORY) )) (LIST (IF (SETQ END (STRPOS (QUOTE >) DIRECTORY)) THEN (MKATOM (SUBSTRING DIRECTORY (ADD1 END))) ELSE DIRECTORY) FILE)) (COPY (QUOTE ({DSK}] [SETQ LUDIRS (CONS (QUOTE LISPUSERS) (OR (for FILE in LISPUSERSDIRECTORIES collect (SETQ DIRECTORY (FILENAMEFIELD FILE (QUOTE DIRECTORY))) (LIST (IF (SETQ END (STRPOS (QUOTE >) DIRECTORY)) THEN (MKATOM (SUBSTRING DIRECTORY (ADD1 END))) ELSE DIRECTORY) FILE)) (COPY (QUOTE ({DSK}<LISPFILES>LISPUSERS>] [SETQ FONTDIRS (CONS (QUOTE FONTS) (OR (for FILE in DISPLAYFONTDIRECTORIES collect (SETQ DIRECTORY (FILENAMEFIELD FILE (QUOTE DIRECTORY))) (LIST (IF (SETQ END (STRPOS (QUOTE >) DIRECTORY)) THEN (MKATOM (SUBSTRING DIRECTORY (ADD1 END))) ELSE DIRECTORY) FILE)) (COPY (QUOTE ({DSK}<LISPFILES>FONTS>] (RETURN (BQUOTE ((, (OR USERNAME (QUOTE DEFAULT)) , (OR LOGINHOST/DIR \CONNECTED.DIRECTORY)) (FLOPPY {FLOPPY}) (CORE {CORE}) , LUDIRS , FONTDIRS , DIRS]) (DIRMENU.LOAD [LAMBDA (NAME DEFAULT/DIR) (* j.ferguson "27-Sep-85 10:51") (PROG (DIRMENU.DATA FILENAME FILE) [SETQ FILENAME (CONCAT (QUOTE DIRMENU) (QUOTE %.) (OR NAME USERNAME (QUOTE DEFAULT] (if [SETQ FILE (FINDFILE FILENAME T (AND DEFAULT/DIR (LIST DEFAULT/DIR] then (OPENFILE FILE (QUOTE INPUT)) else (FLASHWINDOW PROMPTWINDOW 2) (PROMPTPRINT "Unable to open file: " FILENAME ". Default directories generated")) (if (OR (NULL FILE) (EOFP FILE)) then (SETQ DIRMENU.DATA (DIRMENU.INIT)) else (SETQ DIRMENU.DATA (READ FILE))) (CLOSEF? FILE) (RETURN (CONS FILE DIRMENU.DATA]) (DIRMENU.RBF [LAMBDA (WIN) (* j.ferguson "30-Aug-85 18:05") (PROG (RBFMENU) (if [NULL (SETQ RBFMENU (WINDOWPROP WIN 'RBFMENU] then (SETQ RBFMENU (create MENU ITEMS ← '(CLOSE SHRINK BURY MOVE EDIT) CENTERFLG ← T)) (WINDOWPROP WIN 'RBFMENU RBFMENU)) (SELECTQ (MENU RBFMENU) (CLOSE (CLOSEW WIN)) (BURY (BURYW WIN)) (MOVE (MOVEW WIN)) (SHRINK (SHRINKW WIN "DIRMENU Utility")) (EDIT (DIRMENU.EDIT WIN)) NIL]) (DIRMENU.REDISPLAY [LAMBDA (WIN REG) (* j.ferguson " 3-Sep-85 10:16") (PROG (BASEHEIGHT) (DSPFILL REG WHITESHADE (QUOTE REPLACE) WIN) [SETQ BASEHEIGHT (PLUS DIRMENU.BORDER (for MENU in (WINDOWPROP WIN (QUOTE MENU)) largest (fetch IMAGEHEIGHT of MENU) finally (RETURN $$EXTREME] (DRAWLINE 0 BASEHEIGHT DIRMENU.WIDTH BASEHEIGHT DIRMENU.BORDER (QUOTE REPLACE) WIN) (DRAWLINE (QUOTIENT DIRMENU.WIDTH 2) BASEHEIGHT (QUOTIENT DIRMENU.WIDTH 2) 0 DIRMENU.BORDER (QUOTE REPLACE) WIN) (for MENU in (WINDOWPROP WIN (QUOTE MENU)) do (BLTMENUIMAGE MENU WIN)) (REPLACE.ITEM (QUOTE SELECTED-DIRECTORY) (WINDOWPROP WIN (QUOTE SELECTED.MENU)) (OR (WINDOWPROP WIN (QUOTE SELECTED-DIRECTORY)) LOGINHOST/DIR \CONNECTED.DIRECTORY) T T) (if [OR (EQ \CONNECTED.DIRECTORY (WINDOWPROP WIN (QUOTE SELECTED-DIRECTORY))) (EQUAL (MKATOM (CONCAT \CONNECTED.DIRECTORY ">")) (WINDOWPROP WIN (QUOTE SELECTED-DIRECTORY] then (REPLACE.ITEM (QUOTE CONNECT) (WINDOWPROP WIN (QUOTE COMMAND.MENU)) (QUOTE *connected*) T T]) (DIRMENU.WSF [LAMBDA (ITEM MENU KEY) (* j.ferguson "15-Oct-85 15:42") (PROG (WIN DEVICE CONNECTED.DEVICE) (SETQ WIN (WFROMMENU MENU)) (SETQ DEVICE (WINDOWPROP WIN (QUOTE SELECTED-DIRECTORY))) (if (EQ (WINDOWPROP WIN (QUOTE CONNECT)) (QUOTE *connected*)) then (SETQ CONNECTED.DEVICE "") else (SETQ CONNECTED.DEVICE DEVICE)) (if DEVICE then (SELECTQ (if (LISTP ITEM) then (CAR ITEM) else ITEM) (MAKEFILE (BKSYSBUF "MAKEFILE(") (BKSYSBUF CONNECTED.DEVICE)) (LOAD (BKSYSBUF "LOAD(") (BKSYSBUF CONNECTED.DEVICE)) (COPYFILES (BKSYSBUF "COPYFILES(") (BKSYSBUF CONNECTED.DEVICE)) (COPYFILE (BKSYSBUF "COPYFILE(") (BKSYSBUF CONNECTED.DEVICE)) (FILEBROWSER (if (NOT (GETPROP (QUOTE FILEBROWSER) (QUOTE FILEDATES))) then (FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) FILEBROWSER)) (BKSYSBUF "FILEBROWSER(") (BKSYSBUF CONNECTED.DEVICE) (BKSYSBUF "*.*)")) (DIRECTORY (BKSYSBUF "CDIR ") (BKSYSBUF CONNECTED.DEVICE) (BKSYSBUF (CHARACTER 13))) (CDIR (BKSYSBUF "CDIR ") (BKSYSBUF CONNECTED.DEVICE) (BKSYSBUF (CHARACTER 13))) (SIZE (BKSYSBUF "DIR ") (BKSYSBUF CONNECTED.DEVICE) (BKSYSBUF "* SIZE") (BKSYSBUF (CHARACTER 13))) (VERBOSE (BKSYSBUF "DIR ") (BKSYSBUF CONNECTED.DEVICE) (BKSYSBUF "* VERBOSE") (BKSYSBUF (CHARACTER 13))) (PARTIAL (BKSYSBUF "CDIR ") (BKSYSBUF DEVICE)) [CONNECT (if (NEQ (QUOTE *connected*) (WINDOWPROP WIN (QUOTE CONNECT))) then (BKSYSBUF (BQUOTE (CNDIR (QUOTE , DEVICE] NIL]) (MAKE.DIR.ENTRY [LAMBDA (ITEM) (* jcf "19-Jul-85 09:26") (if (ATOM (CADR ITEM)) then ITEM else (PROG (GROUP) (SETQ GROUP (for I in (CDR ITEM) collect (MAKE.DIR.ENTRY I))) (RETURN (BQUOTE (, (CAR ITEM) , (CADAR GROUP) "" (SUBITEMS ,@ GROUP]) (REPLACE.ITEM [LAMBDA (ITEM MENU VALUE BOLDFLG CENTERFLG) (* edited: " 3-Sep-85 16:53") (PROG (WIN REGION) (SETQ WIN (WFROMMENU MENU)) (SETQ REGION (MENUITEMREGION ITEM MENU)) (DSPFILL REGION WHITESHADE 'REPLACE WIN) (DSPFONT (FONTCOPY (fetch MENUFONT of MENU) 'WEIGHT (if BOLDFLG then 'BOLD else 'MEDIUM)) WIN) [if CENTERFLG then (CENTERPRINTINREGION (OR VALUE ITEM) REGION WIN) else (with REGION REGION (MOVETO LEFT (IPLUS BOTTOM (IQUOTIENT (IDIFFERENCE HEIGHT (FONTPROP (fetch MENUFONT of MENU) 'HEIGHT)) 2) 2) WIN) (printout WIN (OR VALUE ITEM] (WINDOWPROP WIN ITEM VALUE]) (SELECTDIR.WSF [LAMBDA (ITEM MENU KEY) (* j.ferguson "30-Aug-85 18:06") (PROG (WIN) (SELECTQ KEY [LEFT (SETQ WIN (WFROMMENU MENU)) (if (NEQ (WINDOWPROP WIN 'SELECTED-DIRECTORY) (CADR ITEM)) then (REPLACE.ITEM 'SELECTED-DIRECTORY (WINDOWPROP WIN 'SELECTED.MENU) (CADR ITEM) T T)) (if (OR (EQ \CONNECTED.DIRECTORY (CADR ITEM)) (EQUAL (MKATOM (CONCAT \CONNECTED.DIRECTORY ">")) (CADR ITEM))) then (if (NEQ (WINDOWPROP WIN 'CONNECT) '*connected*) then (REPLACE.ITEM 'CONNECT (WINDOWPROP WIN 'COMMAND.MENU) '*connected* T T)) else (if (NEQ (WINDOWPROP WIN 'CONNECT) 'CONNECT) then (REPLACE.ITEM 'CONNECT (WINDOWPROP WIN 'COMMAND.MENU) 'CONNECT NIL T] (MIDDLE (BKSYSBUF (CADR ITEM))) NIL]) (SELECTED.WSF [LAMBDA (ITEM MENU KEY) (* j.ferguson "30-Aug-85 18:06") (SELECTQ KEY [LEFT (if (WINDOWPROP (WFROMMENU MENU) 'SELECTED-DIRECTORY) then (BKSYSBUF (WINDOWPROP (WFROMMENU MENU) 'SELECTED-DIRECTORY] [MIDDLE (if (WINDOWPROP (WFROMMENU MENU) 'SELECTED-DIRECTORY) then (BKSYSBUF (CONCAT (WINDOWPROP (WFROMMENU MENU) 'SELECTED-DIRECTORY) (CHARACTER 13] NIL]) ) (* * Advised functions) (PUTPROPS /CNDIR READVICE [NIL (AFTER NIL (PROGN (for WINDOW in (OPENWINDOWS) when (WINDOWPROP WINDOW (QUOTE CONNECT)) do (DIRMENU.CONNECT \CONNECTED.DIRECTORY WINDOW)) (WINDOWPROP \TopLevelTtyWindow (QUOTE TITLE) (CONCAT "CONNECTED DIRECTORY: " \CONNECTED.DIRECTORY]) (PUTPROPS CNDIR READVICE [NIL (AFTER NIL (PROGN (for WINDOW in (OPENWINDOWS) when (WINDOWPROP WINDOW (QUOTE CONNECT)) do (DIRMENU.CONNECT \CONNECTED.DIRECTORY WINDOW)) (WINDOWPROP \TopLevelTtyWindow (QUOTE TITLE) (CONCAT "CONNECTED DIRECTORY: " \CONNECTED.DIRECTORY]) (READVISE /CNDIR CNDIR) (* * Loaded files) (FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) COPYFILES) (* * System declarations - localvars for smaller & faster compile -) (DECLARE: (DECLARE: DOEVAL@COMPILE DONTCOPY (LOCALVARS . T) ) ) (ADDTOVAR LISPXMACROS (CDIR (DODIR (NLAMBDA.ARGS LISPXLINE) (QUOTE (P COLUMNS 20)) (QUOTE *) ""))) (PUTPROPS DIRMENU.LSP COPYRIGHT ("FERGUSON, JAY, C." 1985)) (DECLARE: DONTCOPY (FILEMAP (NIL (1731 18503 (DIRMENU 1741 . 5493) (DIRMENU.CONNECT 5495 . 6013) (DIRMENU.EDIT 6015 . 8231) (DIRMENU.INIT 8233 . 10544) (DIRMENU.LOAD 10546 . 11383) (DIRMENU.RBF 11385 . 11995) ( DIRMENU.REDISPLAY 11997 . 13401) (DIRMENU.WSF 13403 . 15519) (MAKE.DIR.ENTRY 15521 . 15942) ( REPLACE.ITEM 15944 . 16884) (SELECTDIR.WSF 16886 . 17946) (SELECTED.WSF 17948 . 18501))))) STOP