(FILECREATED "22-Jul-85 13:26:35" {DSK}<LISPFILES>UTILITIES>VARBROWSER.;2
 12094  

      changes to:  (FNS VARBROWSER VB.CREATE-LIST-OF-EQ-WIDTH-MENUS VB.CREATE-ICON-WINDOW)
		   (VARS VARBROWSERCOMS VB.MASK VB.ICON)

      previous date: "16-Jul-85 13:22:23" {DSK}<LISPFILES>UTILITIES>VARBROWSER.;1)


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT VARBROWSERCOMS)

(RPAQQ VARBROWSERCOMS
 ((FNS VARBROWSER VB.CREATE-ICON-WINDOW VB.CREATE-LIST-OF-EQ-WIDTH-MENUS 
			    VB.UPDATE-ALL-MENUS VB.UPDATE-MENU)
		       (VARS VB.ICON VB.MASK)))
(DEFINEQ

(VARBROWSER

  [LAMBDA (LIST-OF-VAR-RANGE-DEFAULT W-POSITION W-TITLE MENU-FONT VAR-NAMES-FONT MIN-MENU-WIDTH 
				     MAX-NAME-WIDTH)         (* sm "22-Jul-85 13:22")

    (
PROG
 (W W-REGION W-WIDTH W-HIGHT MENU-LIST POSITION-DECREMENT FIRST-POSITION MAX-MENU-WIDTH 
	     MENU-ITEM-HEIGHT INIT-VALUE)
          (if
 (
NOT
 (
AND
 MENU-FONT (
FONTP
 MENU-FONT)))
	      then
 (
SETQ
 MENU-FONT (
FONTCREATE
 (
QUOTE
 GACHA)
					       8)))
          [if
 (
NOT
 (
AND
 VAR-NAMES-FONT (
FONTP
 MENU-FONT)))
	      then
 (
SETQ
 VAR-NAMES-FONT (
FONTCREATE
 (
QUOTE
 HELVETICA)
						    8
						    (
QUOTE
 BOLD]
          (if
 (
NULL
 MIN-MENU-WIDTH)
	      then
 (
SETQ
 MIN-MENU-WIDTH 5))
          [
SETQ
 MAX-NAME-WIDTH (
OR
 MAX-NAME-WIDTH (
APPLY
 (
QUOTE
 MAX)
							 (for
 V in
 LIST-OF-VAR-RANGE-DEFAULT
							    collect
 (
NCHARS
 (
CAR
 V]
          (
SETQ
 MIN-MENU-WIDTH (
ITIMES
 MIN-MENU-WIDTH (
CHARWIDTH
 (
CHARCODE
 M)
								 MENU-FONT)))
          (
SETQ
 X-OFFSET (
ITIMES
 MAX-NAME-WIDTH (
CHARWIDTH
 (
CHARCODE
 M)
							   VAR-NAMES-FONT)))
          (
SETQ
 MENU-LIST (VB.CREATE-LIST-OF-EQ-WIDTH-MENUS
 LIST-OF-VAR-RANGE-DEFAULT MENU-FONT 
							    MIN-MENU-WIDTH))
          (
SETQ
 MAX-MENU-WIDTH (fetch
 IMAGEWIDTH of
 (
CAR
 MENU-LIST)))
          (
SETQ
 W-WIDTH (
IPLUS
 MAX-MENU-WIDTH 10 X-OFFSET))
          [
SETQ
 MENU-ITEM-HEIGHT (
ADD1
 (fetch
 ITEMHEIGHT of
 (
CAR
 MENU-LIST]
          (
SETQ
 W-HEIGHT (
IPLUS
 (
ITIMES
 (
LENGTH
 MENU-LIST)
					MENU-ITEM-HEIGHT)
				20))
          (
SETQ
 FIRST-POSITION (
IDIFFERENCE
 W-HEIGHT (
IPLUS
 20 MENU-ITEM-HEIGHT)))
          (
SETQ
 POSITION-DECREMENT (
MINUS
 MENU-ITEM-HEIGHT))
          (
SETQ
 W-REGION (if
 W-POSITION
			     then
 (
SETQ
 W-REGION (
CREATEREGION
 (fetch
 XCOORD of
 W-POSITION)
							       (fetch
 YCOORD of
 W-POSITION)
							       W-WIDTH W-HEIGHT))
			   else
 (
GETBOXREGION
 W-WIDTH W-HEIGHT NIL NIL NIL 
					      "Specify position for varbrowser window")))
          (
SETQ
 W (
CREATEW
 W-REGION (
OR
 W-TITLE "Varbrowser window")))
          (
WINDOWPROP
 W (
QUOTE
 ICONFN)
		      (
QUOTE
 VB.CREATE-ICON-WINDOW))
          (for
 M in
 MENU-LIST as
 VAR-VALUES-DEFAULTE in
 LIST-OF-VAR-RANGE-DEFAULT as
 Y from
 
										   FIRST-POSITION
	     by
 POSITION-DECREMENT
	     do
 (
MOVETO
 3 Y W)
		(
DSPFONT
 VAR-NAMES-FONT W)
		(printout W (
CAR
 VAR-VALUES-DEFAULTE))
		(
DRAWCURVE
 (
LIST
 (create
 POSITION
					 XCOORD _(
DSPXPOSITION
 NIL W)
					 YCOORD _(
DSPYPOSITION
 NIL W))
				 (create
 POSITION
					 XCOORD _ X-OFFSET
					 YCOORD _ Y))
			   NIL
			   (
QUOTE
 (ROUND 1))
			   (
QUOTE
 (1 3))
			   W)
		(
ADDMENU
 M W (create
 POSITION
				     XCOORD _ X-OFFSET
				     YCOORD _ Y))
		(
COND

		  ((
CDDR
 VAR-VALUES-DEFAULTE)
		    (
SETQ
 INIT-VALUE (
CADDR
 VAR-VALUES-DEFAULTE))
		    (
SET
 (
CAR
 VAR-VALUES-DEFAULTE)
			 INIT-VALUE))
		  [(
BOUNDP
 (
CAR
 VAR-VALUES-DEFAULTE))
		    (
SETQ
 INIT-VALUE (
EVAL
 (
CAR
 VAR-VALUES-DEFAULTE]
		  (T (
SETQ
 INIT-VALUE NIL)))
		(VB.UPDATE-MENU
 M INIT-VALUE))
          (
WINDOWPROP
 W (
QUOTE
 OPENFN)
		      (
QUOTE
 VB.UPDATE-ALL-MENUS))
          (
WINDOWPROP
 W (
QUOTE
 EXPANDFN)
		      (
QUOTE
 VB.UPDATE-ALL-MENUS))
          (
RETURN
 W])

(VB.CREATE-ICON-WINDOW

  [LAMBDA (WINDOW ICON)                                      (* sm "22-Jul-85 13:23")

    [
COND

      ((
NULL
 ICON)
	(
SETQ
 ICON (
TITLEDICONW
 (create
 TITLEDICON
					ICON _ VB.ICON
					MASK _ VB.MASK
					TITLEREG _(
CREATEREGION
 3 3 65 40))
				(
WINDOWPROP
 WINDOW (
QUOTE
 TITLE))
				(
FONTCREATE
 (
QUOTE
 GACHA)
					    8]
    ICON])

(VB.CREATE-LIST-OF-EQ-WIDTH-MENUS

  [LAMBDA (LIST-OF-VAR-RANGE-DEFAULT MENU-FONT MIN-MENU-WIDTH)
                                                             (* sm "22-Jul-85 12:41")

    (
PROG
 (TEMP-MENU-LIST MAX-WIDTH)
          [
SETQ
 MAX-WIDTH (
APPLY
 (
QUOTE
 MAX)
				 (for
 VAR-RANGE-DEFAULT in
 LIST-OF-VAR-RANGE-DEFAULT
				    collect
 (if
 (
CADR
 VAR-RANGE-DEFAULT)
						then
 [
ITIMES

						       (
LENGTH
 (
CADR
 VAR-RANGE-DEFAULT))
						       (
APPLY
 (
QUOTE
 MAX)
							      (for
 VALUE in
 (
CADR
 VAR-RANGE-DEFAULT)
								 collect
 (
IPLUS
 (
STRINGWIDTH

										  (
MKSTRING
 VALUE)
										  MENU-FONT)
										8]
					      else
 MIN-MENU-WIDTH]
          (
RETURN
 (for
 VAR-RANGE-DEFAULT in
 LIST-OF-VAR-RANGE-DEFAULT
		     collect
 (create
 MENU
				     ITEMS _[if
 (
CADR
 VAR-RANGE-DEFAULT)
						then
 (for
 V in
 (
CADR
 VAR-RANGE-DEFAULT)
							collect
 (
LIST
 V (
CAR
 VAR-RANGE-DEFAULT)))
					      else
 (
LIST
 (
LIST
 " " (
LIST
 (
CAR
 VAR-RANGE-DEFAULT]
				     MENUROWS _ 1
				     MENUFONT _ MENU-FONT
				     CENTERFLG _ T
				     ITEMWIDTH _[
IQUOTIENT
 MAX-WIDTH (
MAX
 1 (
LENGTH
 (
CADR
 
										VAR-RANGE-DEFAULT]
				     WHENSELECTEDFN _(
QUOTE

				       (LAMBDA (ITEM MEN KEY)
					       (
PROG
 (NEW-VAL REG WIND)
						     (
SETQ
 WIND (
WFROMMENU
 MEN))
						     (if
 (
LISTP
 (
CADR
 ITEM))
							 then
 (
DSPFILL
 (
SETQ
 REG (
MENUITEMREGION

									   ITEM MEN))
								       WHITESHADE
								       (
QUOTE
 REPLACE)
								       WIND)
							      (
DSPFONT
 (fetch
 MENUFONT of
 MEN)
								       WIND)
							      (
MOVETO
 (
IPLUS
 2 (fetch
 LEFT
										  of
 REG))
								      (
IPLUS
 2 (fetch
 BOTTOM
										  of
 REG))
								      WIND)
							      [
SETQ
 NEW-VAL
								(
MKATOM
 (
PROMPTFORWORD
 NIL NIL NIL 
										       WIND NIL
										       (
QUOTE
 TTY]
							      (
SET
 (
CAADR
 ITEM)
								   NEW-VAL)
							      (
RPLACA
 ITEM NEW-VAL)
						       else
 (for
 I in
 (fetch
 ITEMS of
 MEN)
							       do
 (
SHADEITEM
 I MEN WHITESHADE))
							    (
SET
 (
CADR
 ITEM)
								 (
CAR
 ITEM))
							    (
SHADEITEM
 ITEM MEN BLACKSHADE])

(VB.UPDATE-ALL-MENUS

  [LAMBDA (W)                                                (* sm "16-Jul-85 13:16")

    (
PROG
 (VAR-NAME)
          (for
 ONE-MENU in
 (
WINDOWPROP
 W (
QUOTE
 MENU))
	     do
 (VB.UPDATE-MENU
 ONE-MENU (if
 (
BOUNDP
 (if
 [
LISTP
 (
SETQ
 VAR-NAME
								  (
CADAR
 (fetch
 ITEMS of
 ONE-MENU]
							 then
 (
SETQ
 VAR-NAME (
CAR
 VAR-NAME))
						       else
 VAR-NAME))
					     then
 (
EVAL
 VAR-NAME)
					   else
 NIL)))
          (
RETURN
 W])

(VB.UPDATE-MENU

  [LAMBDA (
MENU
 VALUE)                                       (* sm "16-Jul-85 13:08")

    (
PROG
 (WINDOW ITEMS REG)
          (
SETQ
 ITEMS (fetch
 ITEMS of
 MENU))
          (
SETQ
 WINDOW (
WFROMMENU
 MENU))
          (if
 (
AND
 (
EQP
 (
LENGTH
 ITEMS)
			1)
		   (
LISTP
 (
CADAR
 ITEMS)))
	      then
 (
DSPFILL
 (
SETQ
 REG (
MENUITEMREGION
 (
CAR
 ITEMS)
						      MENU))
			    WHITESHADE
			    (
QUOTE
 REPLACE)
			    WINDOW)
		   (
DSPFONT
 (fetch
 MENUFONT of
 MENU)
			    WINDOW)
		   (
MOVETO
 (
IPLUS
 2 (fetch
 LEFT of
 REG))
			   (
IPLUS
 2 (fetch
 BOTTOM of
 REG))
			   WINDOW)
		   (
PRIN1
 VALUE WINDOW)
	    else
 (for
 ITEM in
 ITEMS
		    do
 (
SHADEITEM
 ITEM MENU WHITESHADE)
		       (
COND

			 ((
AND
 (
BOUNDP
 (
CADR
 ITEM))
			       (
EQUAL
 (
EVAL
 (
CADR
 ITEM))
				      (
CAR
 ITEM)))
			   (
SHADEITEM
 ITEM MENU BLACKSHADE])
)

(RPAQ VB.ICON (READBITMAP))
(75 75
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"LOOOOOOOOOOOOOOOONF@"
"LOFJLKOOOOOOOOOOONF@"
"LOBMCKOOOOOOOOOOONF@"
"LOOOOOOOOOOOOOOOONF@"
"LH@@@@@@@@@@@@@@@BF@"
"LH@@@@@@COOOOOOOOJF@"
"LH@@@@@@B@B@DA@D@JF@"
"LH@@@@@@B@B@DA@D@JF@"
"LH@@@@@@COOOOOOOOJF@"
"LH@@@@@@COOL@@D@@JF@"
"LJKKCD@@COOL@@D@@JF@"
"LKBJHDAEGOOOOOOOOJF@"
"LH@@@@@@B@@@AOOOOJF@"
"LJKK@@@@B@@@AOOOOJF@"
"LKJJAEEEGOOOOOOOOJF@"
"LH@@@@@@BAOAAAAA@JF@"
"LJKKDN@@BAOAAAAA@JF@"
"LKJJFHEEGOOOOOOOOJF@"
"LH@@@@@@B@@@@@@@@JF@"
"LJ@JAH@@B@@@@@@@@JF@"
"LKKKMAEEGOOOOOOOOJF@"
"LH@@@@@@B@@@@@@@@JF@"
"LJCKL@@@B@@@@@@@@JF@"
"LKJJEEEEGOOOOOOOOJF@"
"LH@@@@@@B@DAOHDB@JF@"
"LHJFI@@@B@DAOHDB@JF@"
"LKKDMEEEGOOOOOOOOJF@"
"LH@@@@@@B@@COOL@@JF@"
"LJKJ@@@@B@@COOL@@JF@"
"LIJJEEEEGOOOOOOOOJF@"
"LH@@@@@@COHA@B@D@JF@"
"LKIIL@@@COHA@B@D@JF@"
"LJBEBEEEGOOOOOOOOJF@"
"LH@@@@@@B@@@@@@@@JF@"
"LKJF@@@@B@@@@@@@@JF@"
"LJCBEEEEGOOOOOOOOJF@"
"LH@@@@@@B@@@@OOOOJF@"
"LJCJH@@@B@@@@OOOOJF@"
"LKJBNEEEGOOOOOOOOJF@"
"LH@@@@@@@@@@@@@@@BF@"
"LOOOOOOOOOOOOOOOONF@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"L@@@@@@@@@@@@@@@@@F@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@")

(RPAQ VB.MASK (READBITMAP))
(75 75
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@")
(PUTPROPS VARBROWSER COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (585 8489 (VARBROWSER 595 . 4133) (VB.CREATE-ICON-WINDOW 4135 . 4536) (
VB.CREATE-LIST-OF-EQ-WIDTH-MENUS 4538 . 6942) (VB.UPDATE-ALL-MENUS 6944 . 7487) (VB.UPDATE-MENU 7489
 . 8487)))))
STOP