(FILECREATED "19-Oct-87 05:10:45" {PHYLUM}<CAMERON>LISP>RESIZE-FILEBROWSER.;15 22719
changes to: (ADVICE FB.UPDATEBROWSERITEMS)
(VARS RESIZE-FILEBROWSERCOMS FB.RESIZE.TO.FIT.MENU.ENTRY)
(FNS FB.RESIZE.TO.FIT.STATUS FB.RESIZE.THIS.FILEBROWSER.P FB.RESIZE.TO.FIT
FB.RESIZE.TO.FIT.GLOBAL.STATUS FB.RESIZE.TO.FIT.OFF.GLOBALLY
FB.RESIZE.TO.FIT.ON.GLOBALLY FB.RESIZE.TO.FIT.OFF FB.RESIZE.TO.FIT.ON)
(PROPS (RESIZE-FILEBROWSER MAKEFILE-ENVIRONMENT))
previous date: "19-Oct-87 04:44:48" {PHYLUM}<CAMERON>LISP>RESIZE-FILEBROWSER.;14)
(* "
Copyright (c) 1987 by Andrew J Cameron, III and Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT RESIZE-FILEBROWSERCOMS)
(RPAQQ RESIZE-FILEBROWSERCOMS (
(* ;; "AUTHOR: Andrew J. Cameron, III")
(* ;; "DESCRIPTION: This LispUsers utility augments FileBrowsers so that they automatically (or manually) resize so as to display maximal information when they are (re)computed.")
(* ;; "NON-FEATURES:")
(* ;; "Aurtomatic resizing does not occur when a FileBorwser is sorted or expunged.")
(* ;; "")
(* ;; "NOTE: One needs to load the source files for FILEBROWSER and TABLEBROWSER if you want to edit/compile the functions in this file. They can be loaded PROP so the performance of the furture use of the filebrowser is not degraded (compiled functions continue to be used). The presence of their source code is required so that the proper record package definitions are available to the functions defined here. This is handled automagically by the following line.")
(* ;; " ")
(DECLARE: DONTEVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
TABLEBROWSERDECLS
FILEBROWSER))
(* ;; "The following vars control what corner is %"tacked%" down when/if a FileBrowser is resized, and whether or not automatic resizing is allowed or not.")
(* ;;
"Of course, the tacked corner will be moved if something would have been displayed off the screen.")
(INITVARS (FB.RESIZE.TO.FIT.TACK.LEFT T)
(FB.RESIZE.TO.FIT.TACK.TOP T)
(FB.RESIZE.TO.FIT.OK T))
(SPECVARS FB.RESIZE.TO.FIT.TACK.LEFT FB.RESIZE.TO.FIT.TACK.TOP
FB.RESIZE.TO.FIT.OK)
(* ;; "The primary functions.")
(FNS FB.RESIZE.TO.FIT FB.RESIZE.THIS.FILEBROWSER.P FB.RESIZE.TO.FIT.ON
FB.RESIZE.TO.FIT.ON.GLOBALLY FB.RESIZE.TO.FIT.OFF
FB.RESIZE.TO.FIT.OFF.GLOBALLY FB.RESIZE.TO.FIT.STATUS
FB.RESIZE.TO.FIT.GLOBAL.STATUS)
(* ;; "This allows manual resizing to fit.")
(VARS FB.RESIZE.TO.FIT.MENU.ENTRY)
(P (NCONC FB.MENU.ITEMS FB.RESIZE.TO.FIT.MENU.ENTRY))
(* ;; "This provides for automatic resizing to fit.")
(ADVISE FB.UPDATEBROWSERITEMS)
(* ;; "Try to keep Lyric package lossage to a minimun.")
(PROP MAKEFILE-ENVIRONMENT RESIZE-FILEBROWSER)))
(* ;; "AUTHOR: Andrew J. Cameron, III")
(* ;;
"DESCRIPTION: This LispUsers utility augments FileBrowsers so that they automatically (or manually) resize so as to display maximal information when they are (re)computed."
)
(* ;; "NON-FEATURES:")
(* ;; "Aurtomatic resizing does not occur when a FileBorwser is sorted or expunged.")
(* ;; "")
(* ;;
"NOTE: One needs to load the source files for FILEBROWSER and TABLEBROWSER if you want to edit/compile the functions in this file. They can be loaded PROP so the performance of the furture use of the filebrowser is not degraded (compiled functions continue to be used). The presence of their source code is required so that the proper record package definitions are available to the functions defined here. This is handled automagically by the following line."
)
(* ;; " ")
(DECLARE: DONTEVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
TABLEBROWSERDECLS FILEBROWSER)
)
(* ;;
"The following vars control what corner is %"tacked%" down when/if a FileBrowser is resized, and whether or not automatic resizing is allowed or not."
)
(* ;;
"Of course, the tacked corner will be moved if something would have been displayed off the screen.")
(RPAQ? FB.RESIZE.TO.FIT.TACK.LEFT T)
(RPAQ? FB.RESIZE.TO.FIT.TACK.TOP T)
(RPAQ? FB.RESIZE.TO.FIT.OK T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(SPECVARS FB.RESIZE.TO.FIT.TACK.LEFT FB.RESIZE.TO.FIT.TACK.TOP FB.RESIZE.TO.FIT.OK)
)
(* ;; "The primary functions.")
(DEFINEQ
(FB.RESIZE.TO.FIT
[LAMBDA (BROWSER) (* ; "Edited 17-Oct-87 22:28 by andyiii")
(* ;;
"Resizes a filebrowser to fit it contents on the screen so that maximal information is displayed.")
(* ;; "width determined from infoitem feilds")
(* ;;
"height big enough to show all files, but not bigger than max-lines lines or the size of the screen")
(* ;; "")
(* ;; "Boy! Is this code ugly, or what?")
(* ;; "")
(LET* ((MAX-LINES 100)
(BROWSERWINDOW (fetch (FILEBROWSER BROWSERWINDOW) of BROWSER))
(TBROWSER (fetch (FILEBROWSER TABLEBROWSER) of BROWSER))
(BROWSERWINDOWBORDER (WINDOWPROP BROWSERWINDOW (QUOTE BORDER)))
(ALLFILES (TB.COLLECT.ITEMS TBROWSER))
(LINES (LENGTH ALLFILES))
(BROWSERFONT (fetch TBFONT of TBROWSER))
(FONTHEIGHT (FONTPROP BROWSERFONT (QUOTE HEIGHT)))
(FONTDESCENT (FONTPROP BROWSERFONT (QUOTE DESCENT)))
(INFOMENUW (fetch (FILEBROWSER INFOMENUW) of BROWSER))
(INFOWINDOWHEIGHT (if (OPENWP INFOMENUW)
then (fetch (REGION HEIGHT) of (WINDOWPROP INFOMENUW (QUOTE REGION))
)
else 0))
(INFOITEMS (fetch (FILEBROWSER INFOMENUCHOICES) of BROWSER))
(FBPROMPTWINDOW (fetch (FILEBROWSER PROMPTWINDOW) of BROWSER))
(COUNTERWINDOW (fetch (FILEBROWSER COUNTERWINDOW) of BROWSER))
(HEADINGWINDOW (fetch (FILEBROWSER HEADINGWINDOW) of BROWSER))
(TITLE (WINDOWPROP COUNTERWINDOW (QUOTE TITLE)))
ENDED-UP-CHANGING-ANYTHING)
(INVERTW BROWSERWINDOW) (* ;
"let the user know something is going on.")
(* ;; "(fb.promptwprint browser %"The font is %" fontheight %" points high.%")")
(* ;; "let.. (initx (|fetch| left |of| initreg)) (inity (idifference (|fetch| bottom |of| initreg) infowindowheight))")
(* ;; "let.. (overallreg (windowsize browserwindow))(overallw (car overallreg)) (overallh (cdr overallreg))")
(* ;; " ")
[LET* [(MINX 10)
(X MINX)
(MINY 15)
(Y MINY)
(INITREG (WINDOWPROP BROWSERWINDOW (QUOTE REGION)))
(INITW (fetch WIDTH of INITREG))
(INITH (fetch HEIGHT of INITREG))
(MINWINDOW (MINIMUMWINDOWSIZE BROWSERWINDOW))
(MINW (CAR MINWINDOW))
(MINH (CDR MINWINDOW))
(OVERALLREG (WINDOWREGION BROWSERWINDOW))
(INITX (fetch LEFT of OVERALLREG))
(INITY (fetch BOTTOM of OVERALLREG))
(OVERALLW (fetch WIDTH of OVERALLREG))
(OVERALLH (fetch HEIGHT of OVERALLREG))
(EXTRAW (IDIFFERENCE OVERALLW INITW))
(EXTRAH (IPLUS (fetch HEIGHT of (WINDOWPROP FBPROMPTWINDOW (QUOTE REGION)))
(fetch HEIGHT of (WINDOWPROP COUNTERWINDOW (QUOTE REGION)))
(fetch HEIGHT of (WINDOWPROP HEADINGWINDOW (QUOTE REGION)))
INFOWINDOWHEIGHT))
(MAX-NUM-OF-LINES (IMIN MAX-LINES (IQUOTIENT (IDIFFERENCE (IDIFFERENCE
(IDIFFERENCE (IDIFFERENCE
SCREENHEIGHT
EXTRAH)
(ITIMES 2 MINY))
FONTDESCENT)
(ITIMES 2 BROWSERWINDOWBORDER))
FONTHEIGHT)))
LINES-SEEN NEWREGION
(NEWHEIGHT (IMAX MINH (IMIN (IPLUS (HEIGHTIFWINDOW (IPLUS (ITIMES (SETQ LINES-SEEN
(IMIN LINES
MAX-NUM-OF-LINES
))
FONTHEIGHT)
FONTDESCENT)
NIL BROWSERWINDOWBORDER)
EXTRAH)
SCREENHEIGHT)))
[MIN-ITEM-WIDTH (LET ((NEXTPOS (fetch (FILEBROWSER INFOSTART) of BROWSER))
(HEADINGS (fetch (FILEBROWSER INFODISPLAYED) of BROWSER)))
(* ;; "(fb.promptwprint browser headings %"The start pos %" nextpos %".%")")
(COND
(NEXTPOS (add NEXTPOS (IPLUS TB.LEFT.MARGIN WBorder))
[for SPEC in FB.INFOFIELDS
when (FMEMB (fetch INFONAME of SPEC)
HEADINGS)
do (
(* ;; "(fb.promptwprint browser %"|at %" nextpos %" : %" (|fetch| infoname |of| spec) %" is %" (|fetch| (infofield infowidth) |of| spec) %" wide.%")")
(add NEXTPOS (fetch (INFOFIELD INFOWIDTH)
of SPEC]
(* ;; "(fb.promptwprint browser %"
Finally %" nextpos %".%")")
NEXTPOS)
(T FB.DEFAULT.NAME.WIDTH]
(NEWWIDTH (IMAX MINW (IMIN (IPLUS [IMAX MIN-ITEM-WIDTH
(IPLUS (STRINGWIDTH TITLE COUNTERWINDOW)
(ITIMES 2 (WINDOWPROP COUNTERWINDOW
(QUOTE BORDER]
EXTRAW)
SCREENWIDTH] (* ; "(closew browserwindow)")
(* ; "(shapew browserwindow newregion)")
(* ;
"let.. ((reg (windowsize browserwindow))(w (car reg)) (h (cdr reg))")
[SETQ X (IMAX MINX (if FB.RESIZE.TO.FIT.TACK.LEFT
then INITX
else (IDIFFERENCE (IPLUS INITX OVERALLW)
NEWWIDTH]
(SETQ Y (if FB.RESIZE.TO.FIT.TACK.TOP
then (IMAX MINY (IDIFFERENCE (IPLUS INITY OVERALLH)
NEWHEIGHT)
0)
else INITX))
(LET (SOMETHING-IS-OFF-THE-SCREEN) (* ; "too wide?")
[if (GEQ (PLUS NEWWIDTH X)
SCREENWIDTH)
then (SETQ SOMETHING-IS-OFF-THE-SCREEN T)
(SETQ X (IMAX MINX (DIFFERENCE (DIFFERENCE SCREENWIDTH NEWWIDTH)
MINX](* ; "too high?")
[if (OR (GEQ (PLUS NEWHEIGHT Y)
SCREENHEIGHT)
(IGREATERP LINES LINES-SEEN))
then (SETQ SOMETHING-IS-OFF-THE-SCREEN T)
(SETQ Y (IMAX MINY (IDIFFERENCE (IDIFFERENCE SCREENHEIGHT NEWHEIGHT)
MINY]
[if SOMETHING-IS-OFF-THE-SCREEN
then [SETQ NEWWIDTH (IMIN NEWWIDTH (IDIFFERENCE SCREENWIDTH (ITIMES 2 MINX]
(SETQ NEWHEIGHT (IMIN NEWHEIGHT (IPLUS (ITIMES LINES-SEEN FONTHEIGHT)
(ITIMES 2 BROWSERWINDOWBORDER)
EXTRAH FONTDESCENT]
(* ;
"(fb.promptwprint browser %"Newregion:%" newregion %"
initregion:%" initreg)")
)
(if (EQUAL OVERALLREG (SETQ NEWREGION (CREATEREGION X Y NEWWIDTH NEWHEIGHT)))
then (INVERTW BROWSERWINDOW) (* ; "no change,")
else (SHAPEW BROWSERWINDOW NEWREGION)
(SETQ ENDED-UP-CHANGING-ANYTHING T))
(if (ILESSP LINES-SEEN MAX-NUM-OF-LINES)
then (FB.SCROLLFN BROWSERWINDOW 0 (IMINUS SCREENHEIGHT)
NIL)) (* ; "(openw browserwindow)")
(if (NEQ LINES-SEEN 0)
then (if (EQUAL LINES-SEEN LINES)
then (FB.PROMPTWPRINT BROWSER "
All " LINES-SEEN " lines are being displayed. ")
else (FB.PROMPTWPRINT BROWSER "
There are " LINES-SEEN " lines out of " LINES " being displayed. "]
ENDED-UP-CHANGING-ANYTHING])
(FB.RESIZE.THIS.FILEBROWSER.P
[LAMBDA (BROWSER) (* ; "Edited 18-Oct-87 23:29 by andyiii")
(* ;; "Determines if this BROWSER is allowed to be automatically resized.")
(LET ((BROWSERWINDOW (fetch (FILEBROWSER BROWSERWINDOW) of BROWSER)))
(NOT (WINDOWPROP BROWSERWINDOW (QUOTE DONT-RESIZE-FILEBROWSER])
(FB.RESIZE.TO.FIT.ON
[LAMBDA (BROWSER) (* ; "Edited 17-Oct-87 20:47 by andyiii")
(* ;; "Turn on automatic resizing for this Browser")
(* ;; " This can be overridden by the global resizing flag being NIL.")
(LET ((BROWSERWINDOW (fetch (FILEBROWSER BROWSERWINDOW) of BROWSER)))
(WINDOWPROP BROWSERWINDOW (QUOTE DONT-RESIZE-FILEBROWSER)
(QUOTE NIL))
(FB.RESIZE.TO.FIT.GLOBAL.STATUS BROWSER])
(FB.RESIZE.TO.FIT.ON.GLOBALLY
[LAMBDA (BROWSER) (* ; "Edited 17-Oct-87 20:51 by andyiii")
(* ;; "Turn on automatic resizing for all Browsers")
(* ;; " This can be overridden by each individual FileBrowser.")
(DECLARE (SPECVARS FB.RESIZE.TO.FIT.OK))
(SETQ FB.RESIZE.TO.FIT.OK T)
(FB.RESIZE.TO.FIT.GLOBAL.STATUS BROWSER])
(FB.RESIZE.TO.FIT.OFF
[LAMBDA (BROWSER) (* ; "Edited 17-Oct-87 20:46 by andyiii")
(* ;; "Turn off automatic resizing for this Browser")
(* ;; " This takes precedence over the T state of the global resizing flag.")
(LET ((BROWSERWINDOW (fetch (FILEBROWSER BROWSERWINDOW) of BROWSER)))
(WINDOWPROP BROWSERWINDOW (QUOTE DONT-RESIZE-FILEBROWSER)
(QUOTE T))
(FB.RESIZE.TO.FIT.STATUS BROWSER])
(FB.RESIZE.TO.FIT.OFF.GLOBALLY
[LAMBDA (BROWSER) (* ; "Edited 17-Oct-87 20:28 by andyiii")
(* ;; "Turn on automatic resizing for all Browsers")
(* ;; " This can be overridden by each individual FileBrowser.")
(DECLARE (SPECVARS FB.RESIZE.TO.FIT.OK))
(SETQ FB.RESIZE.TO.FIT.OK NIL)
(FB.RESIZE.TO.FIT.GLOBAL.STATUS BROWSER])
(FB.RESIZE.TO.FIT.STATUS
[LAMBDA (BROWSER) (* ; "Edited 18-Oct-87 23:33 by andyiii")
(* ;; "Report the status of AutoResizing of this Browser to the user.")
(DECLARE (SPECVARS FB.RESIZE.TO.FIT.OK))
(if (FB.RESIZE.THIS.FILEBROWSER.P BROWSER)
then (FB.PROMPTWPRINT BROWSER "
AutoResizing of this FileBrowsers is on.")
(if (AND (BOUNDP (QUOTE FB.RESIZE.TO.FIT.OK))
FB.RESIZE.TO.FIT.OK)
else (FB.PROMPTWPRINT BROWSER
"
But, AutoResizing of FileBrowsers is globally turned off."))
else (FB.PROMPTWPRINT BROWSER "
AutoResizing of this FileBrowsers has been turned off."])
(FB.RESIZE.TO.FIT.GLOBAL.STATUS
[LAMBDA (BROWSER) (* ; "Edited 17-Oct-87 20:58 by andyiii")
(* ;; "Report the status of the global AutoResizing flag to the user.")
(DECLARE (SPECVARS FB.RESIZE.TO.FIT.OK))
(if (AND (BOUNDP (QUOTE FB.RESIZE.TO.FIT.OK))
FB.RESIZE.TO.FIT.OK)
then (PRINTOUT PROMPTWINDOW "
AutoResizing of FileBrowsers is allowed.")
else (PRINTOUT PROMPTWINDOW "
AutoResizing of FileBrowsers is globally turned off."))
(FB.RESIZE.TO.FIT.STATUS BROWSER])
)
(* ;; "This allows manual resizing to fit.")
(RPAQQ FB.RESIZE.TO.FIT.MENU.ENTRY [("Size to Fit" FB.RESIZE.TO.FIT
"Resize this FileBrowser so maximal information is visible"
(SUBITEMS ("On" FB.RESIZE.TO.FIT.ON
"Activate automatic resizing of this FileBrowser"
(SUBITEMS ("Globally On"
FB.RESIZE.TO.FIT.ON.GLOBALLY
"Allow automatic resizing for any FileBrowser"
)))
("Off" FB.RESIZE.TO.FIT.OFF
"De-Activate automatic resizing of this FileBrowser"
(SUBITEMS ("Globally Off"
FB.RESIZE.TO.FIT.OFF.GLOBALLY
"Disallow automatic resizing for all FileBrowsers"
)))
("Status" FB.RESIZE.TO.FIT.STATUS
"Display the staus of automatic resizing for this FileBrowser"
(SUBITEMS ("Global Status"
FB.RESIZE.TO.FIT.GLOBAL.STATUS
"Display the staus of automatic FileBrowser resizing global flag FileBrowser"
])
(NCONC FB.MENU.ITEMS FB.RESIZE.TO.FIT.MENU.ENTRY)
(* ;; "This provides for automatic resizing to fit.")
[XCL REINSTALL-ADVICE (QUOTE FB.UPDATEBROWSERITEMS)
AFTER
(QUOTE (( LAST (LET ((DUMMY))
(DECLARE (SPECVARS FB.RESIZE.TO.FIT.OK))
(if (AND (AND (BOUNDP (QUOTE FB.RESIZE.TO.FIT.OK))
FB.RESIZE.TO.FIT.OK)
(FB.RESIZE.THIS.FILEBROWSER.P BROWSER))
then
(FB.RESIZE.TO.FIT BROWSER]
(READVISE FB.UPDATEBROWSERITEMS)
(* ;; "Try to keep Lyric package lossage to a minimun.")
(PUTPROPS RESIZE-FILEBROWSER MAKEFILE-ENVIRONMENT ( PACKAGE "INTERLISP" READTABLE
"OLD-INTERLISP-FILE"))
(PUTPROPS RESIZE-FILEBROWSER COPYRIGHT ("Andrew J Cameron, III and Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5643 19861 (FB.RESIZE.TO.FIT 5653 . 16099) (FB.RESIZE.THIS.FILEBROWSER.P 16101 . 16500)
(FB.RESIZE.TO.FIT.ON 16502 . 17044) (FB.RESIZE.TO.FIT.ON.GLOBALLY 17046 . 17489) (
FB.RESIZE.TO.FIT.OFF 17491 . 18032) (FB.RESIZE.TO.FIT.OFF.GLOBALLY 18034 . 18480) (
FB.RESIZE.TO.FIT.STATUS 18482 . 19254) (FB.RESIZE.TO.FIT.GLOBAL.STATUS 19256 . 19859)))))
STOP