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

(FILECREATED "19-May-89 17:52:44" {ERINYES}<LISPUSERS>MEDLEY>DATEFORMAT-EDITOR.;1
 13443  

      changes to%:  (VARS DATEFORMAT-EDITORCOMS)

      previous date%: "16-Sep-88 12:50:52" {PHYLUM}<LISP>MEDLEY>LISPUSERS>DATEFORMAT-EDITOR.;1)


(* "
Copyright (c) 1987, 1988, 1989 by Johannes A. G. M. Koomen.  All rights reserved.
")

(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 (SYSLOAD) 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-88 23:56:41"))) (P (COND ((NOT (GETD (QUOTE \OUTDATE-STRING))) (* ; "Get DATE extensions") (FILESLOAD (SYSLOAD) DATEPATCH))))) (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 (SYSLOAD) 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-yy" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN) (TYPE NWAY COLLECTION DATE ID DATE-SLASHES LABEL "dd/mon/yy" 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 yy" SELECTEDFN DATEFORMAT-EDITOR-SHOWFN) (TYPE NWAY COLLECTION DATE ID DATE-LEADING LABEL "mon dd, yy" 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-88 23:56:41"))


(COND ((NOT (GETD (QUOTE \OUTDATE-STRING))) (* ; "Get DATE extensions") (FILESLOAD (SYSLOAD) DATEPATCH)))
)

(PUTPROPS DATEFORMAT-EDITOR MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10))
(PUTPROPS DATEFORMAT-EDITOR COPYRIGHT ("Johannes A. G. M. Koomen" 1987 1988 1989))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2483 4408 (EDIT-DATEFORMAT 2493 . 3520) (GET-DATEFORMAT-EDITOR 3522 . 4406)) (4513 9803
 (DATEFORMAT-EDITOR-STATUS 4523 . 4743) (DATEFORMAT-EDITOR-GET-STATE 4745 . 6551) (
DATEFORMAT-EDITOR-PUT-STATE 6553 . 8363) (DATEFORMAT-EDITOR-SHOW-STATE 8365 . 8616) (
DATEFORMAT-EDITOR-ABORTFN 8618 . 8758) (DATEFORMAT-EDITOR-CLOSEFN 8760 . 8949) (
DATEFORMAT-EDITOR-GETDFLTFN 8951 . 9218) (DATEFORMAT-EDITOR-PUTDFLTFN 9220 . 9456) (
DATEFORMAT-EDITOR-QUITFN 9458 . 9596) (DATEFORMAT-EDITOR-SHOWFN 9598 . 9801)))))
STOP