(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")

(FILECREATED "11-Dec-87 16:24:53" {DSK}<LISPFILES>FBHINTS.\;6
 6713   

      |changes| |to:|  (FNS FBHINTS.NEWPATTERNCOMMAND FBHINTSMENUWHENSELECTEDFN STRING-MEMBER 
                            FILINGMENUWHENSELECTEDFN)
                       (VARS FBHINTSCOMS)

      |previous| |date:| " 2-Dec-87 11:20:24" {DSK}<LISPFILES>FBHINTS.\;5)


; Copyright (c) 1987 by Rank Xerox.  All rights reserved.

(PRETTYCOMPRINT FBHINTSCOMS)

(RPAQQ FBHINTSCOMS
 ((FNS FBHINTS.NEWPATTERNCOMMAND FBHINTSMENUWHENSELECTEDFN STRING-MEMBER)
                    (INITVARS (FBHINTSLIST '("{DSK}<LISPFILES>"))
                           (*USEFBHINTS* T))
                    (FILES FILEBROWSER)
                    (P (MOVD 'FBHINTS.NEWPATTERNCOMMAND 'FB.NEWPATTERNCOMMAND)
                       (SETQ FBHINTSLIST (MAPCAR FBHINTSLIST (FUNCTION DIRECTORY.FILL.PATTERN)))
                       (SETQ FBHINTSMENU (|create| MENU ITEMS ← FBHINTSLIST WHENSELECTEDFN ←
                                                (FUNCTION FBHINTSMENUWHENSELECTEDFN)
                                                TITLE ← "FB Hints")))))
(DEFINEQ

(FBHINTS.NEWPATTERNCOMMAND

  (LAMBDA (BROWSER)
                                         (* \; "Edited 11-Dec-87 16:24 by HIPPO")


(* |;;;| "This function replaces FB.NEWPATTERNCOMMAND.  It implements a menu of strings which can be stuffed into a FB, just to save typing.  Yup, I'm that lazy.")


    (LET (PATTERN)
         (COND
            ((AND (FB.MAYBE.EXPUNGE BROWSER "New Pattern")
                  (SETQ PATTERN
                   (COND
                      (*USEFBHINTS*                          (* \; 

                                                "Check global switch, if T then do all this crap ...")


                             (LET (DEFPATT BUTTON PATT)
          
          (* |;;| "User may right button to delete items from the menu.  The deletion is done by FILINGMENUWHENSELECTEDFN, so all we need to do here is keep popping the menu up until we get a left or middle.  ie. allow multiple deletes.  Just for neatness save the cursor position when the menu is first popped up for use in positioning the menu if user does successive deletes (otherwise menu goes walkies across the screen).")


                                  (LET ((CURPOS (CREATEPOSITION LASTMOUSEX LASTMOUSEY)))
                                       (|while|
 (EQ (CAR (SETQ DEFPATT (MENU FBHINTSMENU CURPOS)))
                                                    'RIGHT)))
                                  (SETQ PATT (CADR DEFPATT))
                                  (SETQ BUTTON (CAR DEFPATT))
          
          (* |;;| "Now check if a pattern was selected from the menu with the left or right button (left = just replace default string, right = enumerate straight away).  If no pattern was selected do a normal FB.GET.NEWPATTERN, then see if user wants this pattern added to the menu (if it isn't already there).  If s/he  does, ATTACH the new pattern then destructively SORT the list before recomputing the menu.")


                                  (COND
                                     (PATT (SELECTQ BUTTON
                                               (LEFT (|replace|
 PATTERN |of|
 BROWSER |with|
 PATT)
                                                     (FB.GET.NEWPATTERN BROWSER))
                                               (|replace|
 PATTERN |of|
 BROWSER |with|
 PATT)))
                                     (T (LET ((NEWPATT (FB.GET.NEWPATTERN BROWSER)))
                                             (COND
                                                ((AND NEWPATT (NOT (STRING-MEMBER
 NEWPATT FBHINTSLIST
                                                                          )))
                                                 (COND
                                                    ((MOUSECONFIRM "Add to menu before enumerating? " 
                                                            NIL (|fetch|
 (FILEBROWSER PROMPTWINDOW)
                                                                   |of|
 BROWSER)
                                                            NIL)
                                                     (ATTACH NEWPATT FBHINTSLIST)
                                                     (SORT FBHINTSLIST)
                                                     (SETQ FBHINTSMENU
                                                      (|create|
 MENU
                                                             ITEMS ← FBHINTSLIST
                                                             WHENSELECTEDFN ← (FUNCTION 
                                                                            FBHINTSMENUWHENSELECTEDFN
                                                                               )
                                                             TITLE ← "FB Hints"))))))
                                             NEWPATT)))))
                      (T (FB.GET.NEWPATTERN BROWSER)))))
             (FB.SETNEWPATTERN BROWSER PATTERN)
             (FB.UPDATEBROWSERITEMS BROWSER))))))

(FBHINTSMENUWHENSELECTEDFN

  (LAMBDA (ITEM MENU BUTTON)
                                (* \; "Edited 30-Nov-87 13:11 by HIPPO")

          
          (* |;;| "All we have to worry about here is if user has right buttoned an item, in which case we delete it from the list then recompute the menu.  In any case we return (LIST BUTTON ITEM).")


    (COND
       ((EQ BUTTON 'RIGHT)
        (SETQ FBHINTSLIST (REMOVE ITEM FBHINTSLIST))
        (SETQ FBHINTSMENU (|create|
 MENU
                                 ITEMS ← FBHINTSLIST
                                 WHENSELECTEDFN ← 'FBHINTSMENUWHENSELECTEDFN
                                 TITLE ← "FB Hints"))))
    (LIST BUTTON ITEM)))

(STRING-MEMBER

  (LAMBDA (X LST)
                                           (* \; "Edited 30-Nov-87 13:02 by HIPPO")


    (|for|
 I |in|
 LST |thereis|
 (STRING-EQUAL X I))))
)

(RPAQ? FBHINTSLIST
 '("{DSK}<LISPFILES>"))

(RPAQ? *USEFBHINTS*
 T)
(FILESLOAD FILEBROWSER)
(MOVD 'FBHINTS.NEWPATTERNCOMMAND 'FB.NEWPATTERNCOMMAND)
(SETQ FBHINTSLIST (MAPCAR FBHINTSLIST (FUNCTION DIRECTORY.FILL.PATTERN)))
(SETQ FBHINTSMENU (|create| MENU ITEMS ← FBHINTSLIST WHENSELECTEDFN ← (FUNCTION 
                                                                            FBHINTSMENUWHENSELECTEDFN
                                                                             )
                         TITLE ← "FB Hints"))
(PUTPROPS FBHINTS COPYRIGHT ("Rank Xerox" 1987))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (1165 6104 (FBHINTS.NEWPATTERNCOMMAND 1175 . 5202) (FBHINTSMENUWHENSELECTEDFN 5204 . 
5906) (STRING-MEMBER 5908 . 6102)))))
STOP