(FILECREATED "16-Oct-84 10:30:08" {ERIS}<LISPCORE>DEMO>ICONFNS.;4 4032   

      changes to:  (VARS ICONFNSCOMS)

      previous date: "27-JAN-83 11:51:23" {PHYLUM}<BURTON>ORB>ICONFNS.;12)


(* Copyright (c) 1983, 1984 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT ICONFNSCOMS)

(RPAQQ ICONFNSCOMS [(DECLARE: FIRST (FILES MAP))
		    (VARS ICONCODES)
		    (FNS CREATE.FIGUREW.ICONMENU ICONFONTMENU ICONMENU.SELECTEDFN MOVE.ICONMENU 
			 CLOSE.ICONMENU OPEN.ICONMENU)
		    (ADDVARS (DISPLAYFONTDIRECTORIES <LISPCORE>DEMO>))
		    (VARS (CHARMICONFONT (FONTCREATE (QUOTE CHARMICONS)
						     1])
(DECLARE: FIRST 
(FILESLOAD MAP)
)

(RPAQQ ICONCODES (67 68 69 121 72 74 75 76 77 78 79 99 101 102 103 104 105 106 107 108 109 110 111 
		     112 113 114 115 116 117 118 119 120))
(DEFINEQ

(CREATE.FIGUREW.ICONMENU
  [LAMBDA (COMMANDW)                                         (* rrb "12-JAN-83 11:29")
                                                             (* adds an iconmenu to a command menu for a figure 
							     window.)
    (PROG ((IMENU (ICONFONTMENU))
	   IMENUW)
          (SETQ IMENUW (ADDMENU IMENU NIL (UPPERLEFTMENUPOSITION IMENU COMMANDW)))
          (WINDOWPROP IMENUW (QUOTE COMMANDW)
		      COMMANDW)
          (RETURN IMENUW])

(ICONFONTMENU
  [LAMBDA (WINDOW)                                           (* rrb "12-JAN-83 11:38")
                                                             (* returns a menu that has the icon characters on it.
							     (MENU (ICONFONTMENU)))
    (create MENU
	    ITEMS ←(for CH in ICONCODES collect (CHARACTER CH))
	    MENUFONT ← CHARMICONFONT
	    MENUCOLUMNS ← 4
	    CENTERFLG ← T
	    ITEMHEIGHT ←(IPLUS 2 (FONTPROP CHARMICONFONT (QUOTE HEIGHT)))
	    WHENSELECTEDFN ←(FUNCTION ICONMENU.SELECTEDFN])

(ICONMENU.SELECTEDFN
  [LAMBDA (ITEM MENU)                                        (* rrb "27-JAN-83 09:06")
                                                             (* selected function for the icon menu.
							     Adds a text string with the selected character in 
							     CHARMICONFONT.)
    (PROG ((FIGW (WINDOWPROP (WINDOWPROP (WFROMMENU MENU)
					 (QUOTE COMMANDW))
			     (QUOTE FIGUREW)))
	   TEXTELT)
          (SETQ TEXTELT (POSITIONTEXTELT ITEM CHARMICONFONT FIGW "indicate the position of the icon"))
                                                             (* NIL if the icon was placed outside the window.)
          (RETURN (AND TEXTELT (FIGW.ADD.ELEMENT TEXTELT FIGW])

(MOVE.ICONMENU
  [LAMBDA (COMMANDW NEWPOS)                                  (* rrb "13-JAN-83 23:07")
                                                             (* moves the icon menu with a command menu)
    (PROG [(IMENU (WINDOWPROP COMMANDW (QUOTE ICONMENU]
          (AND IMENU (MOVEW IMENU (UPPERLEFTMENUPOSITION (CAR (WINDOWPROP IMENU (QUOTE MENU)))
							 COMMANDW NEWPOS])

(CLOSE.ICONMENU
  [LAMBDA (COMMANDW NEWPOS)                                  (* rrb "26-JAN-83 09:02")
                                                             (* closes the icon menu associated with a command menu)
    (PROG [(ICONCW (WINDOWPROP COMMANDW (QUOTE ICONMENU]     (* break link to command menu.)
          (WINDOWPROP ICONCW (QUOTE COMMANDW)
		      NIL)
          (AND ICONCW (CLOSEW ICONCW])

(OPEN.ICONMENU
  [LAMBDA (COMMANDW NEWPOS)                                  (* rrb "26-JAN-83 09:01")
                                                             (* opens the icon menu associated with a command menu)
    (PROG [(ICONCW (WINDOWPROP COMMANDW (QUOTE ICONMENU]     (* add link to command menu.)
          (COND
	    (ICONCW (WINDOWPROP ICONCW (QUOTE COMMANDW)
				COMMANDW)
		    (OPENW ICONCW])
)

(ADDTOVAR DISPLAYFONTDIRECTORIES <LISPCORE>DEMO>)

(RPAQ CHARMICONFONT (FONTCREATE (QUOTE CHARMICONS)
				1))
(PUTPROPS ICONFNS COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (808 3830 (CREATE.FIGUREW.ICONMENU 818 . 1303) (ICONFONTMENU 1305 . 1851) (
ICONMENU.SELECTEDFN 1853 . 2576) (MOVE.ICONMENU 2578 . 2973) (CLOSE.ICONMENU 2975 . 3401) (
OPEN.ICONMENU 3403 . 3828)))))
STOP