(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)


(FILECREATED " 3-May-2026 10:44:14" {MEDLEY}<lispusers>DATEFORMAT-EDITOR.;2
 14047  

      :EDIT-BY "lmm"

      :CHANGES-TO (VARS DATEFORMAT-EDITORCOMS)

      :PREVIOUS-DATE "19-May-89 17:52:44" {MEDLEY}<lispusers>DATEFORMAT-EDITOR.;1)


(PRETTYCOMPRINT DATEFORMAT-EDITORCOMS)

(RPAQQ DATEFORMAT-EDITORCOMS

       (

(* ;;; "This system provides a facility for editing date formats as described in section 12.5 of the Interlisp-D manual, Koto version.  User entry point is the function EDIT-DATEFORMAT.  Editing is accomplished using a FREEMENU.  Items displayed in this menu are stored on DATEFORMAT-EDITOR-ITEMS.  Call (GET-DATEFORMAT-EDITOR T) after changing this variable.  Input to EDIT-DATEFORMAT is either NIL or a value returned by the DATEFORMAT function.  Output is either NIL -- in case editing was aborted -- or another value as returned from the DATEFORMAT function.")


        

(* ;;; "Interface")


        (FNS EDIT-DATEFORMAT GET-DATEFORMAT-EDITOR)
        (INITVARS (EDIT-DATEFORMAT-DEFAULT (DATEFORMAT)))
        

(* ;;; "Support")


        (FILES FREEMENU)
        (FNS DATEFORMAT-EDITOR-STATUS DATEFORMAT-EDITOR-GET-STATE DATEFORMAT-EDITOR-PUT-STATE 
             DATEFORMAT-EDITOR-SHOW-STATE DATEFORMAT-EDITOR-ABORTFN DATEFORMAT-EDITOR-CLOSEFN 
             DATEFORMAT-EDITOR-GETDFLTFN DATEFORMAT-EDITOR-PUTDFLTFN DATEFORMAT-EDITOR-QUITFN 
             DATEFORMAT-EDITOR-SHOWFN)
        (VARS $$DATEFORMAT-EDITOR-ITEMS)
        (INITVARS (DATEFORMAT-EDITOR-ITEMS (COPY $$DATEFORMAT-EDITOR-ITEMS)))
        [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS ($$DATEFORMAT-EDITOR (GET-DATEFORMAT-EDITOR))
                                              ($$DATEFORMAT-EDITOR-IDATE (IDATE 
                                                                               " 1-Jan-1988 23:56:41"
                                                                                ]
        (PROP MAKEFILE-ENVIRONMENT DATEFORMAT-EDITOR)))



(* ;;; 
"This system provides a facility for editing date formats as described in section 12.5 of the Interlisp-D manual, Koto version.  User entry point is the function EDIT-DATEFORMAT.  Editing is accomplished using a FREEMENU.  Items displayed in this menu are stored on DATEFORMAT-EDITOR-ITEMS.  Call (GET-DATEFORMAT-EDITOR T) after changing this variable.  Input to EDIT-DATEFORMAT is either NIL or a value returned by the DATEFORMAT function.  Output is either NIL -- in case editing was aborted -- or another value as returned from the DATEFORMAT function."
)





(* ;;; "Interface")


(DEFINEQ

(EDIT-DATEFORMAT

(LAMBDA (DATEFORMAT) (* ; "Edited 29-Mar-88 17:24 by Koomen") (* ;;; "This system provides a facility for editing date formats as described in section 12.14 of the Interlisp-D manual, Koto version.  Editing is accomplished using a FREEMENU.  Items displayed in this menu are stored on DATEFORMAT-EDITOR-ITEMS.  Call (GET-DATEFORMAT-EDITOR T) after changing this variable.  Input is either NIL or a value returned by the DATEFORMAT function.  Output is either NIL -- in case editing was aborted -- or another value as returned from the DATEFORMAT function.") (PROG ((DFE (GET-DATEFORMAT-EDITOR))) (DATEFORMAT-EDITOR-PUT-STATE DFE (OR DATEFORMAT EDIT-DATEFORMAT-DEFAULT)) (OPENW DFE) (DATEFORMAT-EDITOR-SHOW-STATE DFE) (DATEFORMAT-EDITOR-STATUS DFE (QUOTE EDIT)) (NLSETQ (while (EQ (DATEFORMAT-EDITOR-STATUS DFE) (QUOTE EDIT)) do (BLOCK))) (CLOSEW DFE) (if (EQ (DATEFORMAT-EDITOR-STATUS DFE) (QUOTE QUIT)) then (RETURN (DATEFORMAT-EDITOR-GET-STATE DFE)) else (DATEFORMAT-EDITOR-STATUS DFE (QUOTE ABORT)))))
)

(GET-DATEFORMAT-EDITOR

(LAMBDA (RECOMPUTE?) (* ; "Edited 24-Sep-87 13:36 by Koomen") (DECLARE (GLOBALVARS $$DATEFORMAT-EDITOR DATEFORMAT-EDITOR-ITEMS LASTMOUSEX LASTMOUSEY SCREENWIDTH SCREENHEIGHT)) (PROG ((DFE $$DATEFORMAT-EDITOR)) (if (OR RECOMPUTE? (NOT (WINDOWP DFE)) (NOT (FMEMB (DATEFORMAT-EDITOR-STATUS DFE) (QUOTE (QUIT ABORT))))) then (SETQ DFE (FREEMENU DATEFORMAT-EDITOR-ITEMS "Date Format Editor")) (SETQ $$DATEFORMAT-EDITOR DFE) (WINDOWPROP DFE (QUOTE CLOSEFN) (FUNCTION DATEFORMAT-EDITOR-CLOSEFN)) (WINDOWPROP DFE (QUOTE SHRINKFN) (QUOTE DON'T)) (WINDOWPROP DFE (QUOTE RESHAPEFN) (QUOTE DON'T)) (DATEFORMAT-EDITOR-STATUS DFE (QUOTE QUIT))) (MOVEW DFE (IMAX 0 (IMIN LASTMOUSEX (IDIFFERENCE SCREENWIDTH (fetch (REGION WIDTH) of (WINDOWREGION DFE))))) (IMAX 0 (IMIN LASTMOUSEY (IDIFFERENCE SCREENHEIGHT (fetch (REGION HEIGHT) of (WINDOWREGION DFE)))))) (RETURN DFE)))
)
)

(RPAQ? EDIT-DATEFORMAT-DEFAULT
 (DATEFORMAT))



(* ;;; "Support")



(FILESLOAD FREEMENU)
(DEFINEQ

(DATEFORMAT-EDITOR-STATUS

(LAMBDA (DFE NEWSTATUS) (* Koomen "30-Jan-87 23:41") (if NEWSTATUS then (WINDOWPROP DFE (QUOTE DATEFORMAT-EDITOR-STATUS) NEWSTATUS) else (WINDOWPROP DFE (QUOTE DATEFORMAT-EDITOR-STATUS))))
)

(DATEFORMAT-EDITOR-GET-STATE

(LAMBDA (DFE) (* ; "Edited 29-Mar-88 15:05 by Koomen") (PROG ((FMT NIL) (ITEM NIL) (STATE (FM.GETSTATE DFE))) (if (SETQ ITEM (LISTGET STATE (QUOTE TIME))) then (SELECTQ (FM.ITEMPROP ITEM (QUOTE ID)) (TIME-SECS NIL) (TIME-NONE (push FMT (QUOTE NO.TIME))) (TIME-MINS (push FMT (QUOTE NO.SECONDS))) (SHOULDNT "Bad TIME"))) (if (NOT (LISTGET FMT (QUOTE NO.TIME))) then (if (SETQ ITEM (LISTGET STATE (QUOTE TIMEZONE))) then (SELECTQ (FM.ITEMPROP ITEM (QUOTE ID)) (TIMEZONE-NO NIL) (TIMEZONE-YES (push FMT (QUOTE TIME.ZONE))) (SHOULDNT "Bad TIMEZONE")))) (if (SETQ ITEM (LISTGET STATE (QUOTE DATE))) then (SELECTQ (FM.ITEMPROP ITEM (QUOTE ID)) (DATE-NONE (push FMT (QUOTE NO.DATE))) (DATE-NORMAL NIL) (DATE-SPACES (push FMT (QUOTE SPACES))) (DATE-SLASHES (push FMT (QUOTE SLASHES))) (DATE-LEADING (push FMT (QUOTE MONTH.LEADING))) (SHOULDNT "Bad DATE"))) (if (NOT (LISTGET FMT (QUOTE NO.DATE))) then (if (SETQ ITEM (LISTGET STATE (QUOTE DAY))) then (SELECTQ (FM.ITEMPROP ITEM (QUOTE ID)) (DAY-NONE NIL) (DAY-LONG (push FMT (QUOTE DAY.OF.WEEK))) (DAY-SHORT (push FMT (QUOTE DAY.OF.WEEK)) (push FMT (QUOTE DAY.SHORT))) (SHOULDNT "Bad DAY"))) (if (SETQ ITEM (LISTGET STATE (QUOTE MONTH))) then (SELECTQ (FM.ITEMPROP ITEM (QUOTE ID)) (MONTH-LONG (push FMT (QUOTE MONTH.LONG))) (MONTH-SHORT NIL) (MONTH-NUMERIC (push FMT (QUOTE NUMBER.OF.MONTH))) (SHOULDNT "Bad MONTH"))) (if (SETQ ITEM (LISTGET STATE (QUOTE YEAR))) then (SELECTQ (FM.ITEMPROP ITEM (QUOTE ID)) (YEAR-LONG (push FMT (QUOTE YEAR.LONG))) (YEAR-SHORT NIL) (SHOULDNT "Bad YEAR"))) (if (SETQ ITEM (LISTGET STATE (QUOTE LEADER))) then (SELECTQ (FM.ITEMPROP ITEM (QUOTE ID)) (LEADER-NO (push FMT (QUOTE NO.LEADING.SPACES))) (LEADER-YES NIL) (SHOULDNT "Bad LEADER")))) (RETURN (APPLY (FUNCTION DATEFORMAT) (DREVERSE FMT)))))
)

(DATEFORMAT-EDITOR-PUT-STATE

(LAMBDA (DFE DATEFORMAT) (* ; "Edited 29-Mar-88 14:17 by Koomen") (FM.RESETMENU DFE) (for FMT in (if (AND DATEFORMAT (EQ (CAR (LISTP DATEFORMAT)) (QUOTE DATEFORMAT))) then (CDR DATEFORMAT)) bind (DATE _ (QUOTE DATE-NORMAL)) (YEAR _ (QUOTE YEAR-SHORT)) (MONTH _ (QUOTE MONTH-SHORT)) (DAY _ (QUOTE DAY-NONE)) (LEADER _ (QUOTE LEADER-YES)) (TIME _ (QUOTE TIME-SECS)) (TIMEZONE _ (QUOTE TIMEZONE-NO)) do (SELECTQ FMT (NO.DATE (SETQ DATE (QUOTE DATE-NONE))) (NUMBER.OF.MONTH (SETQ MONTH (QUOTE MONTH-NUMERIC))) (MONTH.LEADING (SETQ DATE (QUOTE DATE-LEADING))) (MONTH.LONG (SETQ MONTH (QUOTE MONTH-LONG))) (YEAR.LONG (SETQ YEAR (QUOTE YEAR-LONG))) (SLASHES (SETQ DATE (QUOTE DATE-SLASHES))) (SPACES (SETQ DATE (QUOTE DATE-SPACES))) (NO.LEADING.SPACES (SETQ LEADER (QUOTE LEADER-NO))) (NO.TIME (SETQ TIME (QUOTE TIME-NONE))) (TIME.ZONE (SETQ TIMEZONE (QUOTE TIMEZONE-YES))) (NO.SECONDS (SETQ TIME (QUOTE TIME-MINS))) (DAY.OF.WEEK (OR (EQ DAY (QUOTE DAY-SHORT)) (SETQ DAY (QUOTE DAY-LONG)))) (DAY.SHORT (SETQ DAY (QUOTE DAY-SHORT))) (PROGN (* ; "???") NIL)) finally (if (AND DATE (SETQ DATE (FM.GETITEM DATE NIL DFE))) then (FM.CHANGESTATE (QUOTE DATE) DATE DFE)) (if (AND YEAR (SETQ YEAR (FM.GETITEM YEAR NIL DFE))) then (FM.CHANGESTATE (QUOTE YEAR) YEAR DFE)) (if (AND MONTH (SETQ MONTH (FM.GETITEM MONTH NIL DFE))) then (FM.CHANGESTATE (QUOTE MONTH) MONTH DFE)) (if (AND DAY (SETQ DAY (FM.GETITEM DAY NIL DFE))) then (FM.CHANGESTATE (QUOTE DAY) DAY DFE)) (if (AND LEADER (SETQ LEADER (FM.GETITEM LEADER NIL DFE))) then (FM.CHANGESTATE (QUOTE LEADER) LEADER DFE)) (if (AND TIME (SETQ TIME (FM.GETITEM TIME NIL DFE))) then (FM.CHANGESTATE (QUOTE TIME) TIME DFE)) (if (AND TIMEZONE (SETQ TIMEZONE (FM.GETITEM TIMEZONE NIL DFE))) then (FM.CHANGESTATE (QUOTE TIMEZONE) TIMEZONE DFE))))
)

(DATEFORMAT-EDITOR-SHOW-STATE

(LAMBDA (DFE) (* ; "Edited 29-Mar-88 13:01 by Koomen") (LET ((PROMPTW (GETPROMPTWINDOW DFE)) (FORMAT (DATEFORMAT-EDITOR-GET-STATE DFE))) (CLEARW PROMPTW) (printout PROMPTW (GDATE $$DATEFORMAT-EDITOR-IDATE FORMAT))))
)

(DATEFORMAT-EDITOR-ABORTFN

(LAMBDA (ITEM WINDOW BUTTONS) (* Koomen "30-Jan-87 23:43") (DATEFORMAT-EDITOR-STATUS WINDOW (QUOTE ABORT)))
)

(DATEFORMAT-EDITOR-CLOSEFN

(LAMBDA (WINDOW) (* Koomen "30-Jan-87 23:42") (if (EQ (DATEFORMAT-EDITOR-STATUS WINDOW) (QUOTE EDIT)) then (DATEFORMAT-EDITOR-STATUS WINDOW (QUOTE ABORT))))
)

(DATEFORMAT-EDITOR-GETDFLTFN

(LAMBDA (ITEM WINDOW BUTTONS) (* ; "Edited 29-Mar-88 13:08 by Koomen") (if (EQ (DATEFORMAT-EDITOR-STATUS WINDOW) (QUOTE EDIT)) then (DATEFORMAT-EDITOR-PUT-STATE WINDOW EDIT-DATEFORMAT-DEFAULT) (DATEFORMAT-EDITOR-SHOW-STATE WINDOW)))
)

(DATEFORMAT-EDITOR-PUTDFLTFN

(LAMBDA (ITEM WINDOW BUTTONS) (* ; "Edited 29-Mar-88 13:16 by Koomen") (if (EQ (DATEFORMAT-EDITOR-STATUS WINDOW) (QUOTE EDIT)) then (SETQ EDIT-DATEFORMAT-DEFAULT (DATEFORMAT-EDITOR-GET-STATE WINDOW))))
)

(DATEFORMAT-EDITOR-QUITFN

(LAMBDA (ITEM WINDOW BUTTONS) (* Koomen "30-Jan-87 23:44") (DATEFORMAT-EDITOR-STATUS WINDOW (QUOTE QUIT)))
)

(DATEFORMAT-EDITOR-SHOWFN

(LAMBDA (ITEM WINDOW BUTTONS) (* ; "Edited 29-Mar-88 13:03 by Koomen") (if (EQ (DATEFORMAT-EDITOR-STATUS WINDOW) (QUOTE EDIT)) then (DATEFORMAT-EDITOR-SHOW-STATE WINDOW)))
)
)

(RPAQQ $$DATEFORMAT-EDITOR-ITEMS

       (((TYPE MOMENTARY LABEL "Quit" FONT (GACHA 10 BOLD)
               SELECTEDFN DATEFORMAT-EDITOR-QUITFN MESSAGE "Stop editing, return current settings")
         (TYPE DISPLAY LABEL "")
         (TYPE MOMENTARY LABEL "Abort" FONT (GACHA 10 BOLD)
               SELECTEDFN DATEFORMAT-EDITOR-ABORTFN MESSAGE 
               "Stop editing, ignore changes, return NIL")
         (TYPE DISPLAY LABEL "      Default:")
         (TYPE MOMENTARY LABEL "Get" FONT (GACHA 10 BOLD)
               SELECTEDFN DATEFORMAT-EDITOR-GETDFLTFN MESSAGE "Use default settings")
         (TYPE MOMENTARY LABEL "Put" FONT (GACHA 10 BOLD)
               SELECTEDFN DATEFORMAT-EDITOR-PUTDFLTFN MESSAGE "Save settings as default")
         (TYPE DISPLAY LABEL ""))
        ((TYPE DISPLAY LABEL ""))
        ((TYPE DISPLAY LABEL "DATE:     " FONT (GACHA 10 BOLD)))
        ((TYPE DISPLAY LABEL "  Format: " FONT (GACHA 10 BOLD))
         (TYPE NWAY COLLECTION DATE ID DATE-NORMAL LABEL "dd-mon-yyyy" SELECTEDFN 
               DATEFORMAT-EDITOR-SHOWFN)
         (TYPE NWAY COLLECTION DATE ID DATE-SLASHES LABEL "dd/mon/yyyy" SELECTEDFN 
               DATEFORMAT-EDITOR-SHOWFN)
         (TYPE NWAY COLLECTION DATE ID DATE-NONE LABEL "none" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN))
        ((TYPE DISPLAY LABEL "          ")
         (TYPE NWAY COLLECTION DATE ID DATE-SPACES LABEL "dd mon yyyy" SELECTEDFN 
               DATEFORMAT-EDITOR-SHOWFN)
         (TYPE NWAY COLLECTION DATE ID DATE-LEADING LABEL "mon dd, yyyy??" SELECTEDFN 
               DATEFORMAT-EDITOR-SHOWFN))
        ((TYPE DISPLAY LABEL "  Year:   " FONT (GACHA 10 BOLD))
         (TYPE NWAY COLLECTION YEAR ID YEAR-LONG LABEL "long" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)
         (TYPE NWAY COLLECTION YEAR ID YEAR-SHORT LABEL "short" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN))
        ((TYPE DISPLAY LABEL "  Month:  " FONT (GACHA 10 BOLD))
         (TYPE NWAY COLLECTION MONTH ID MONTH-LONG LABEL "long" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)
         (TYPE NWAY COLLECTION MONTH ID MONTH-SHORT LABEL "short" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN
               )
         (TYPE NWAY COLLECTION MONTH ID MONTH-NUMERIC LABEL "numeric" SELECTEDFN 
               DATEFORMAT-EDITOR-SHOWFN))
        ((TYPE DISPLAY LABEL "  Weekday:" FONT (GACHA 10 BOLD))
         (TYPE NWAY COLLECTION DAY ID DAY-LONG LABEL "long" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)
         (TYPE NWAY COLLECTION DAY ID DAY-SHORT LABEL "short" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)
         (TYPE NWAY COLLECTION DAY ID DAY-NONE LABEL "none" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN))
        ((TYPE DISPLAY LABEL "  Spaces: " FONT (GACHA 10 BOLD))
         (TYPE NWAY COLLECTION LEADER ID LEADER-YES LABEL "yes" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)
         (TYPE NWAY COLLECTION LEADER ID LEADER-NO LABEL "no" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN))
        ((TYPE DISPLAY LABEL ""))
        ((TYPE DISPLAY LABEL "TIME:" FONT (GACHA 10 BOLD)))
        ((TYPE DISPLAY LABEL "  Format:   " FONT (GACHA 10 BOLD))
         (TYPE NWAY COLLECTION TIME ID TIME-SECS LABEL "hh:mm:ss" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN
               )
         (TYPE NWAY COLLECTION TIME ID TIME-MINS LABEL "hh:mm" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN)
         (TYPE NWAY COLLECTION TIME ID TIME-NONE LABEL "none" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN))
        ((TYPE DISPLAY LABEL "  Time Zone:" FONT (GACHA 10 BOLD))
         (TYPE NWAY COLLECTION TIMEZONE ID TIMEZONE-YES LABEL "yes" SELECTEDFN 
               DATEFORMAT-EDITOR-SHOWFN)
         (TYPE NWAY COLLECTION TIMEZONE ID TIMEZONE-NO LABEL "no" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN
               ))))

(RPAQ? DATEFORMAT-EDITOR-ITEMS
 (COPY $$DATEFORMAT-EDITOR-ITEMS))
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(RPAQ $$DATEFORMAT-EDITOR
 (GET-DATEFORMAT-EDITOR))

(RPAQ $$DATEFORMAT-EDITOR-IDATE
 (IDATE " 1-Jan-1988 23:56:41"))
)

(PUTPROPS DATEFORMAT-EDITOR
 MAKEFILE-ENVIRONMENT
 (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 
                                                        10))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2634 4559 (EDIT-DATEFORMAT 2644 . 3671) (GET-DATEFORMAT-EDITOR 3673 . 4557)) (4658 9948
 (DATEFORMAT-EDITOR-STATUS 4668 . 4888) (DATEFORMAT-EDITOR-GET-STATE 4890 . 6696) (
DATEFORMAT-EDITOR-PUT-STATE 6698 . 8508) (DATEFORMAT-EDITOR-SHOW-STATE 8510 . 8761) (
DATEFORMAT-EDITOR-ABORTFN 8763 . 8903) (DATEFORMAT-EDITOR-CLOSEFN 8905 . 9094) (
DATEFORMAT-EDITOR-GETDFLTFN 9096 . 9363) (DATEFORMAT-EDITOR-PUTDFLTFN 9365 . 9601) (
DATEFORMAT-EDITOR-QUITFN 9603 . 9741) (DATEFORMAT-EDITOR-SHOWFN 9743 . 9946)))))
STOP