(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) (FILECREATED "15-Mar-89 16:24:43" {ERIS}DOC>HACKS>DIGI-CLOCK.\;5 50813 |changes| |to:| (VARS DIGI-CLOCKCOMS) (FNS DC-DELETE-ALARM-SETTING DIGI-CLOCK DC-KILL-PROCESS DC-PROMPT-FOR-ALARM-MESSAGE DC-START-PROCESS DC-ADD-AUXW DC-SHAPE-TO-FIT DC-SET-ALARM) |previous| |date:| "22-Feb-89 16:50:15" {ERIS}DOC>HACKS>DIGI-CLOCK.\;4) ; Copyright (c) 1988, 1989 by XEROX Corporation. All rights reserved. (PRETTYCOMPRINT DIGI-CLOCKCOMS) (RPAQQ DIGI-CLOCKCOMS ( (* |;;| "Top level functions") (FNS DIGI-CLOCK DC-START-PROCESS DC-KILL-PROCESS DC-BUTTONEVENTFN DC-AUXW-BUTTONEVENTFN DC-SET-TIME-BUTTONEVENTFN ST) (* |;;| "Dc-buttoneventfns") (FNS DC-PROCESS DC-UPDATE DC-GET-OPERATION) (* |;;| "Auxw functions") (FNS DC-AUXW-GET-OPERATION DC-ADD-AUXW DC-DELETE-AUXW DC-AUXW-UPDATE) (* |;;| "Set time functions") (FNS DC-WARNING-TIME-NOT-SET) (FNS DC-SET-TIME DC-UPDATE-TIME-ITEM DC-VALID-DATE-P DC-SET-LAST-DAY-FOR-MONTH) (FNS DC-INITIALIZE-SET-TIME-MENU DC-MAKE-NEW-SET-TIME-MENU DC-OPEN-SET-TIME-MENUW) (FNS DC-EXTRACT-STARTING-SET-TIME-DATE DC-SET-TIME-MAKE-DATE-STRING) (FNS DC-SET-TIME-ZONE-HEADING DC-SET-TIME-ZONE DC-GET-TIME-ZONE) (* |;;| "Alarm functions") (FNS DC-SET-ALARM DC-ADD-ALARM-SETTING DC-DELETE-ALARM-SETTING) (FNS DC-ALARM-DUE-TO-RING? DC-RING-ALARM DC-TURN-ALARM-OFF) (FNS DC-PROMPT-FOR-ALARM-MESSAGE DC-GET-MESSAGE-WINDOW DC-CLOSE-MESSAGE-WINDOW) (* |;;| "Display & Misc functions") (FNS DC-DISPLAY-TIME DC-MAKE-DISPLAY-TIME-STRING DC-PRINT-JUSTIFIED-STRING DC-CONVERT-DATE-FORMAT DC-SHAPE-TO-FIT DC-GET-DATE DC-MENU-POSITION) (* |;;| "Font functions") (FNS DC-SET-FONT DC-FONT-FAMILY-MENU DC-FONT-SIZE-MENU DC-FONT-FACE-MENU) (* |;;| "List of the world's time zones") (VARS *DC-TIME-ZONE-LIST*) (* |;;| "Call digi-clock ") )) (* |;;| "Top level functions") (DEFINEQ (DIGI-CLOCK (LAMBDA (RESTART-FROM-SCRATCH) (* \; "Edited 22-Feb-89 16:21 by Mountford") (|if| (FIND.PROCESS "DIGITAL CLOCK") |then| (DEL.PROCESS "DIGITAL CLOCK")) (|if| (NOT (MEMBER "DIGITAL CLOCK" IDLE.SUSPEND.PROCESS.NAMES)) |then| (|push| IDLE.SUSPEND.PROCESS.NAMES "DIGITAL CLOCK")) (BLOCK) (ADD.PROCESS (LIST 'DC-START-PROCESS RESTART-FROM-SCRATCH) 'NAME "DIGITAL CLOCK" 'RESTARTABLE T))) (DC-START-PROCESS (LAMBDA (RESTART-FROM-SCRATCH) (* \; "Edited 17-Feb-89 16:04 by Mountford") (|if| (GREATERP (IDATE) 0) |then| (SETQ *DC-OLD-DATE* (DATE)) |else| (SETQ *DC-OLD-DATE* " 1-Jan-88 08:00:00")) (|if| (BOUNDP '*DC-WINDOW*) |then| (WINDOWPROP *DC-WINDOW* 'CLOSEFN (REMOVE 'DC-KILL-PROCESS (WINDOWPROP *DC-WINDOW* 'CLOSEFN))) (CLOSEW *DC-WINDOW*) (WINDOWPROP *DC-WINDOW* 'CLOSEFN 'DC-KILL-PROCESS)) (|if| (OR RESTART-FROM-SCRATCH (NOT (BOUNDP '*DC-WINDOW*)) (NULL *DC-WINDOW*)) |then| (SETQ *DC-WINDOW* (CREATEW (CREATEREGION 1 (IDIFFERENCE SCREENHEIGHT 46) 430 46))) (WINDOWPROP *DC-WINDOW* 'RESHAPEFN 'DON\'T) (SETQ *DC-DATEFORMAT* (DATEFORMAT SPACES NO.SECONDS DAY.OF.WEEK DAY.SHORT)) (WINDOWPROP *DC-WINDOW* 'BUTTONEVENTFN 'DC-BUTTONEVENTFN) (WINDOWPROP *DC-WINDOW* 'CLOSEFN 'DC-KILL-PROCESS) (SETQ *DC-AUXW-FONT* (FONTCREATE 'HELVETICA 18)) (SETQ *DC-FONT* (FONTCREATE 'HELVETICA 36)) (WINDOWPROP *DC-WINDOW* 'ALARM-MODE 'LOUD) (WINDOWPROP *DC-WINDOW* 'CAN-UPDATE T) (DSPFONT *DC-FONT* *DC-WINDOW*) (DC-ADD-AUXW)) (DC-PROCESS))) (DC-KILL-PROCESS (LAMBDA NIL (* \; "Edited 22-Feb-89 16:16 by Mountford") (|if| (FIND.PROCESS "DIGITAL CLOCK") |then| (DEL.PROCESS "DIGITAL CLOCK")))) (DC-BUTTONEVENTFN (LAMBDA (WINDOW) (* \; "Edited 15-Aug-88 07:01 by Mountford") (|if| (WINDOWPROP *DC-WINDOW* 'CAN-UPDATE) |then| (WINDOWPROP *DC-WINDOW* 'CAN-UPDATE NIL) (TOTOPW WINDOW) (|if| (MOUSESTATE MIDDLE) |then| (SELECTQ (DC-GET-OPERATION) (* \; "") (|Set Font| (|if| (DC-SET-FONT) |then| (DC-UPDATE (IDATE)))) (|Set Time| (DC-SET-TIME)) (|Set Alarm| (DC-SET-ALARM)) (|Turn Alarm Off| (DC-TURN-ALARM-OFF) (DC-UPDATE (IDATE))) (|Delete Alarm Setting| (DC-DELETE-ALARM-SETTING)) (|Quiet Alarm| (WINDOWPROP *DC-WINDOW* 'ALARM-MODE 'QUIET)) (|Loud Alarm| (WINDOWPROP *DC-WINDOW* 'ALARM-MODE 'LOUD)) (|12-Hour Clock| (WINDOWPROP *DC-WINDOW* '12-HOUR-MODE T) (DC-UPDATE (IDATE))) (|24-Hour Clock| (WINDOWPROP *DC-WINDOW* '12-HOUR-MODE NIL) (DC-UPDATE (IDATE))) (|Set Local Time Zone| (DC-PRINT-JUSTIFIED-STRING *DC-WINDOW* "Select Local Time Zone" 'CENTER 'CLEARW) (DC-SET-TIME-ZONE WINDOW) (DC-UPDATE (IDATE))) (|Add New Regional Time Zone| (DC-ADD-AUXW)) (|Shape to Fit| (DC-SHAPE-TO-FIT *DC-WINDOW* (DC-MAKE-DISPLAY-TIME-STRING (DATE *DC-DATEFORMAT*) (WINDOWPROP *DC-WINDOW* '12-HOUR-MODE ))) (DC-UPDATE (IDATE))) NIL)) (|if| (MOUSESTATE LEFT) |then| (DC-UPDATE (IDATE))) (WINDOWPROP *DC-WINDOW* 'CAN-UPDATE T)))) (DC-AUXW-BUTTONEVENTFN (LAMBDA (WINDOW) (* \; "Edited 2-Sep-88 15:45 by Mountford") (|if| (WINDOWPROP *DC-WINDOW* 'CAN-UPDATE) |then| (WINDOWPROP *DC-WINDOW* 'CAN-UPDATE NIL) (TOTOPW WINDOW) (|if| (MOUSESTATE MIDDLE) |then| (SELECTQ (DC-AUXW-GET-OPERATION) (* \; "") (|Set Font for Aux Clocks| (|if| (DC-SET-FONT WINDOW 'ALL-AUXW) |then| (DC-UPDATE (IDATE)))) (|Set Aux Clock Font In Just This Window| (|if| (DC-SET-FONT WINDOW) |then| (DC-UPDATE (IDATE)))) (|Delete This Window| (DC-DELETE-AUXW WINDOW)) (|Set Time-Zone Heading| (DC-SET-TIME-ZONE-HEADING WINDOW) (DC-UPDATE (IDATE))) (|Set Regional Time Zone| (DC-SET-TIME-ZONE WINDOW) (DC-UPDATE (IDATE))) NIL)) (|if| (MOUSESTATE LEFT) |then| (DC-UPDATE (IDATE))) (WINDOWPROP *DC-WINDOW* 'CAN-UPDATE T)))) (DC-SET-TIME-BUTTONEVENTFN (LAMBDA (ITEM MENU BUTTON) (* \; "Edited 15-Aug-88 07:16 by Mountford") (LET (DISPLAY-TIME) (COND ((EQ ITEM '|Set|) (CLOSEW *DC-SET-TIME-MENUW*) (|if| (WINDOWPROP *DC-SET-TIME-WINDOW* 'SETTING-ALARM) |then| (DC-ADD-ALARM-SETTING (DC-SET-TIME-MAKE-DATE-STRING)) |else| (SETTIME (DC-SET-TIME-MAKE-DATE-STRING)) (SETQ *DC-OLD-DATE* (DATE)) (|until| (WINDOWPROP *DC-WINDOW* 'CAN-UPDATE) |do| (BLOCK 1000)) (DC-UPDATE (IDATE)))) ((EQ ITEM '|Esc|) (CLOSEW *DC-SET-TIME-MENUW*)) (T (DC-UPDATE-TIME-ITEM ITEM) (SETQ DISPLAY-TIME (DC-CONVERT-DATE-FORMAT (DC-SET-TIME-MAKE-DATE-STRING) '(DATEFORMAT NO.SECONDS))) (SETQ DISPLAY-TIME (DC-MAKE-DISPLAY-TIME-STRING DISPLAY-TIME (WINDOWPROP *DC-WINDOW* '12-HOUR-MODE))) (DC-PRINT-JUSTIFIED-STRING *DC-SET-TIME-WINDOW* DISPLAY-TIME 'CENTERED 'CLEARW)))))) (ST (LAMBDA (HOUR MINUTE DATE MONTH YEAR) (* \; "Edited 25-Jul-88 11:45 by Mountford") (|if| (NOT (BOUNDP '*DC-OLD-DATE*)) |then| (SETQ *DC-OLD-DATE* " 1-Jan-88 08:00:00")) (|if| (NOT HOUR) |then| (SETTIME *DC-OLD-DATE*) |else| (|if| (NOT MINUTE) |then| (SETQ MINUTE 0)) (|if| (NOT DATE) |then| (SETQ DATE (SUBSTRING *DC-OLD-DATE* 1 2))) (|if| (NOT MONTH) |then| (SETQ MONTH (SUBSTRING *DC-OLD-DATE* 4 6))) (|if| (NOT YEAR) |then| (SETQ YEAR (SUBSTRING *DC-OLD-DATE* 8 9))) (SETTIME (CONCAT MONTH "-" DATE "-" YEAR " " HOUR ":" MINUTE))) (CLRPROMPT) (SETQ *DC-OLD-DATE* (DATE)))) ) (* |;;| "Dc-buttoneventfns") (DEFINEQ (DC-PROCESS (LAMBDA NIL (* \; "Edited 15-Aug-88 06:52 by Mountford") (PROG NIL TOP (|if| (WINDOWPROP *DC-WINDOW* 'CAN-UPDATE) |then| (WINDOWPROP *DC-WINDOW* 'CAN-UPDATE NIL) (DC-UPDATE (IDATE)) (WINDOWPROP *DC-WINDOW* 'CAN-UPDATE T)) (BLOCK 60000) (* \; "BLOCK FOR A MINUTE") (GO TOP)))) (DC-UPDATE (LAMBDA (ITIME) (* \; "Edited 15-Aug-88 08:13 by Mountford") (LET ((MERIDIAN (WINDOWPROP *DC-WINDOW* '12-HOUR-MODE)) (AUX-CLOCKS (WINDOWPROP *DC-WINDOW* 'ATTACHEDWINDOWS))) (|if| (IGREATERP ITIME 0) |then| (DC-DISPLAY-TIME ITIME MERIDIAN) (|if| (DC-ALARM-DUE-TO-RING? ITIME) |then| (DC-RING-ALARM) (SETQ AUX-CLOCKS (CDR AUX-CLOCKS))) (|for| WINDOW |in| AUX-CLOCKS |do| (DC-AUXW-UPDATE ITIME MERIDIAN WINDOW)) |else| (DC-WARNING-TIME-NOT-SET))))) (DC-GET-OPERATION (LAMBDA NIL (* \; "Edited 13-Aug-88 10:40 by Mountford") (LET ((MENU-LIST (LIST '|Set Font| '|Set Time| '|Set Alarm| (|if| (EQ (WINDOWPROP *DC-WINDOW* 'ALARM-MODE) 'QUIET) |then| '|Loud Alarm| |else| '|Quiet Alarm|) (COND ((WINDOWPROP *DC-WINDOW* 'ALARM-RINGING) '|Turn Alarm Off|) ((WINDOWPROP *DC-WINDOW* 'ALARM-LIST) '|Delete Alarm Setting|) (T '||)) '|Shape to Fit| (|if| (WINDOWPROP *DC-WINDOW* '12-HOUR-MODE) |then| '|24-Hour Clock| |else| '|12-Hour Clock|) '|Set Local Time Zone| '|Add New Regional Time Zone|))) (MENU (|create| MENU ITEMS _ MENU-LIST CENTERFLG _ T))))) ) (* |;;| "Auxw functions") (DEFINEQ (DC-AUXW-GET-OPERATION (LAMBDA NIL (* \; "Edited 2-Sep-88 13:53 by Mountford") (MENU (|create| MENU ITEMS _ '(|Delete This Window| (|Set Font for Aux Clocks| '|Set Font for Aux Clocks| NIL (SUBITEMS |Set Aux Clock Font In Just This Window| )) |Set Time-Zone Heading| |Set Regional Time Zone|) CENTERFLG _ T)))) (DC-ADD-AUXW (LAMBDA NIL (* \; "Edited 17-Feb-89 16:08 by Mountford") (LET ((AUXW) (ITIME (IDATE)) (MERIDIAN (WINDOWPROP *DC-WINDOW* '12-HOUR-MODE)) (WINDOW-HEIGHT (HEIGHTIFWINDOW (FONTPROP *DC-AUXW-FONT* 'HEIGHT)))) (SETQ AUXW (CREATEW (CREATEREGION 1 (IDIFFERENCE SCREENHEIGHT WINDOW-HEIGHT) 430 WINDOW-HEIGHT) NIL NIL T)) (ATTACHWINDOW AUXW *DC-WINDOW* 'BOTTOM 'JUSTIFY) (DSPFONT *DC-AUXW-FONT* AUXW) (DC-PRINT-JUSTIFIED-STRING AUXW "Select Time Zone for this Window" 'CENTER 'CLEARW) (|if| (DC-SET-TIME-ZONE AUXW) |then| (WINDOWPROP AUXW 'BUTTONEVENTFN 'DC-AUXW-BUTTONEVENTFN) (DC-SHAPE-TO-FIT *DC-WINDOW* (DC-MAKE-DISPLAY-TIME-STRING (GDATE ITIME *DC-DATEFORMAT* ) MERIDIAN)) (|if| (IGREATERP ITIME 0) |then| (DC-AUXW-UPDATE ITIME MERIDIAN AUXW) |else| (DC-AUXW-UPDATE (IDATE *DC-OLD-DATE*) MERIDIAN AUXW)) |else| (DETACHWINDOW AUXW) (CLOSEW AUXW))))) (DC-DELETE-AUXW (LAMBDA (WINDOW) (* \; "Edited 25-Jul-88 06:59 by Mountford") (DETACHWINDOW WINDOW) (CLOSEW WINDOW) (LET ((WINDOW-LIST (WINDOWPROP *DC-WINDOW* 'ATTACHEDWINDOWS))) (|for| W |in| WINDOW-LIST |do| (DETACHWINDOW W)) (|for| W |in| WINDOW-LIST |do| (ATTACHWINDOW W *DC-WINDOW* 'BOTTOM 'JUSTIFY))))) (DC-AUXW-UPDATE (LAMBDA (ITIME MERIDIAN WINDOW) (* \; "Edited 13-Aug-88 11:20 by Mountford") (LET ((LOCATION (WINDOWPROP WINDOW 'LOCATION)) (TIME-OFFSET (WINDOWPROP WINDOW 'TIME-ZONE-OFFSET)) REGIONAL-TIME DISPLAY-TIME) (SETQ REGIONAL-TIME (DC-GET-DATE *DC-DATEFORMAT* ITIME TIME-OFFSET)) (SETQ DISPLAY-TIME (DC-MAKE-DISPLAY-TIME-STRING REGIONAL-TIME MERIDIAN)) (DC-PRINT-JUSTIFIED-STRING WINDOW LOCATION 'LEFT 'CLEARW) (DC-PRINT-JUSTIFIED-STRING WINDOW DISPLAY-TIME 'RIGHT) DISPLAY-TIME))) ) (* |;;| "Set time functions") (DEFINEQ (DC-WARNING-TIME-NOT-SET (LAMBDA NIL (* \; "Edited 15-Aug-88 06:42 by Mountford") (LET ((WINDOWS (CONS *DC-WINDOW* (WINDOWPROP *DC-WINDOW* 'ATTACHEDWINDOWS)))) (DC-PRINT-JUSTIFIED-STRING *DC-WINDOW* "Time not set." 'CENTER 'CLEARW) (|for| I |to| 10 |do| (|for| W |in| WINDOWS |do| (BLOCK 100) (INVERTW W) (BLOCK 100) (INVERTW W)))))) ) (DEFINEQ (DC-SET-TIME (LAMBDA NIL (* \; "Edited 25-Jul-88 07:25 by Mountford") (DC-INITIALIZE-SET-TIME-MENU) (WINDOWPROP *DC-SET-TIME-WINDOW* 'SETTING-ALARM NIL))) (DC-UPDATE-TIME-ITEM (LAMBDA (ITEM) (* \; "Edited 1-Aug-88 06:23 by Mountford") (LET ((CHANGE (CAR ITEM)) (ITEM (CADR ITEM))) (|if| (EQ CHANGE '+) |then| (WINDOWPROP *DC-SET-TIME-WINDOW* ITEM (ADD1 (WINDOWPROP *DC-SET-TIME-WINDOW* ITEM ))) (|if| (NOT (DC-VALID-DATE-P (DC-SET-TIME-MAKE-DATE-STRING))) |then| (COND ((EQ ITEM 'DY) (WINDOWPROP *DC-SET-TIME-WINDOW* 'DY 1)) ((EQ ITEM 'MO) (|if| (IGREATERP (WINDOWPROP *DC-SET-TIME-WINDOW* 'MO) 12) |then| (WINDOWPROP *DC-SET-TIME-WINDOW* 'MO 1) |else| (DC-SET-LAST-DAY-FOR-MONTH))) ((EQ ITEM 'YR) (WINDOWPROP *DC-SET-TIME-WINDOW* 'YR 1)) ((OR (EQ ITEM 'HR) (EQ ITEM 'MIN)) (WINDOWPROP *DC-SET-TIME-WINDOW* ITEM 0)) (T (WINDOWPROP *DC-SET-TIME-WINDOW* ITEM (SUB1 (WINDOWPROP *DC-SET-TIME-WINDOW* ITEM)))))) |else| (WINDOWPROP *DC-SET-TIME-WINDOW* ITEM (SUB1 (WINDOWPROP *DC-SET-TIME-WINDOW* ITEM)) ) (|if| (NOT (DC-VALID-DATE-P (DC-SET-TIME-MAKE-DATE-STRING))) |then| (COND ((EQ ITEM 'DY) (DC-SET-LAST-DAY-FOR-MONTH)) ((EQ ITEM 'MO) (|if| (ILESSP (WINDOWPROP *DC-SET-TIME-WINDOW* 'MO) 1) |then| (WINDOWPROP *DC-SET-TIME-WINDOW* 'MO 12) |else| (DC-SET-LAST-DAY-FOR-MONTH))) ((EQ ITEM 'YR) (WINDOWPROP *DC-SET-TIME-WINDOW* 'YR 99)) ((EQ ITEM 'HR) (WINDOWPROP *DC-SET-TIME-WINDOW* ITEM 23)) ((EQ ITEM 'MIN) (WINDOWPROP *DC-SET-TIME-WINDOW* ITEM 59)) (T (WINDOWPROP *DC-SET-TIME-WINDOW* ITEM (ADD1 (WINDOWPROP *DC-SET-TIME-WINDOW* ITEM)))))))))) (DC-VALID-DATE-P (LAMBDA (DATE-STRING) (* \; "Edited 23-Jul-88 10:56 by Mountford") (|if| (IDATE DATE-STRING) |then| DATE-STRING))) (DC-SET-LAST-DAY-FOR-MONTH (LAMBDA NIL (* \; "Edited 31-Jul-88 14:54 by Mountford") (SELECTQ (WINDOWPROP *DC-SET-TIME-WINDOW* 'MO) (2 (|if| (ZEROP (IREMAINDER (WINDOWPROP *DC-SET-TIME-WINDOW* 'YR) 4)) |then| (WINDOWPROP *DC-SET-TIME-WINDOW* 'DY 29) |else| (WINDOWPROP *DC-SET-TIME-WINDOW* 'DY 28))) ((4 6 9 11) (WINDOWPROP *DC-SET-TIME-WINDOW* 'DY 30)) ((1 3 5 7 8 10 12) (WINDOWPROP *DC-SET-TIME-WINDOW* 'DY 31)) NIL))) ) (DEFINEQ (DC-INITIALIZE-SET-TIME-MENU (LAMBDA NIL (* \; "Edited 14-Aug-88 21:35 by Mountford") (|if| (OR (NOT (BOUNDP '*DC-SET-TIME-MENUW*)) (NULL *DC-SET-TIME-MENUW*)) |then| (DC-MAKE-NEW-SET-TIME-MENU)) (LET ((MERIDIAN (WINDOWPROP *DC-WINDOW* '12-HOUR-MODE)) DATE-STRING DISPLAY-TIME) (|if| (IGREATERP (IDATE *DC-OLD-DATE*) (IDATE)) |then| (SETQ DATE-STRING (DC-CONVERT-DATE-FORMAT *DC-OLD-DATE* '(NUMBER.OF.MONTH NO.SECONDS))) (SETQ DISPLAY-TIME (DC-CONVERT-DATE-FORMAT *DC-OLD-DATE* '(NO.SECONDS))) |else| (SETQ DATE-STRING (DATE (DATEFORMAT NUMBER.OF.MONTH NO.SECONDS))) (SETQ DISPLAY-TIME (DATE (DATEFORMAT NO.SECONDS)))) (SETQ DISPLAY-TIME (DC-MAKE-DISPLAY-TIME-STRING DISPLAY-TIME MERIDIAN)) (DC-OPEN-SET-TIME-MENUW) (DC-PRINT-JUSTIFIED-STRING *DC-SET-TIME-WINDOW* DISPLAY-TIME 'CENTERED 'CLEARW) (DC-EXTRACT-STARTING-SET-TIME-DATE DATE-STRING)))) (DC-MAKE-NEW-SET-TIME-MENU (LAMBDA NIL (* \; "Edited 31-Dec-00 16:10 by Mountford") (LET ((TITLE-FONT (FONTCREATE 'HELVETICA 12)) (MENU-FONT (FONTCREATE 'HELVETICA 18))) (SETQ *DC-SET-TIME-MENUW* (ADDMENU (|create| MENU ITEMS _ '((+ DY) (\ - DY) (+ MO) (\ - MO) (+ YR) (\ - YR) (+ HR) (\ - HR) (+ MIN) (\ - MIN) |Set| |Esc|) MENUROWS _ 2 MENUFONT _ MENU-FONT MENUTITLEFONT _ TITLE-FONT TITLE _ "DY MO YR HR MIN SET " WHENSELECTEDFN _ 'DC-SET-TIME-BUTTONEVENTFN))) (SETQ *DC-SET-TIME-WINDOW* (CREATEW (CREATEREGION LASTMOUSEX LASTMOUSEY 120 27) NIL NIL T)) (ATTACHWINDOW *DC-SET-TIME-WINDOW* *DC-SET-TIME-MENUW* 'TOP 'JUSTIFY) (DSPFONT MENU-FONT *DC-SET-TIME-WINDOW*)))) (DC-OPEN-SET-TIME-MENUW (LAMBDA NIL (* \; "Edited 25-Jul-88 07:33 by Mountford") (LET ((CLOCK-REGION (WINDOWPROP *DC-WINDOW* 'REGION))) (|if| (IGREATERP (IPLUS (CAR CLOCK-REGION) (CADDR CLOCK-REGION) 215) SCREENWIDTH) |then| (ATTACHWINDOW *DC-SET-TIME-MENUW* *DC-WINDOW* 'LEFT 'TOP) |else| (ATTACHWINDOW *DC-SET-TIME-MENUW* *DC-WINDOW* 'RIGHT 'TOP)) (DETACHWINDOW *DC-SET-TIME-MENUW*) (OPENW *DC-SET-TIME-MENUW*)))) ) (DEFINEQ (DC-EXTRACT-STARTING-SET-TIME-DATE (LAMBDA (DATE-STRING) (* \; "Edited 4-Aug-88 06:16 by Mountford") (|if| (EQUAL " " (SUBSTRING DATE-STRING 1 1)) |then| (WINDOWPROP *DC-SET-TIME-WINDOW* 'DY (MKATOM (SUBSTRING DATE-STRING 2 2))) |else| (WINDOWPROP *DC-SET-TIME-WINDOW* 'DY (MKATOM (SUBSTRING DATE-STRING 1 2)))) (WINDOWPROP *DC-SET-TIME-WINDOW* 'MO (MKATOM (SUBSTRING DATE-STRING 4 5))) (WINDOWPROP *DC-SET-TIME-WINDOW* 'YR (MKATOM (SUBSTRING DATE-STRING 7 8))) (WINDOWPROP *DC-SET-TIME-WINDOW* 'HR (MKATOM (SUBSTRING DATE-STRING 10 11))) (WINDOWPROP *DC-SET-TIME-WINDOW* 'MIN (MKATOM (SUBSTRING DATE-STRING 13 14))))) (DC-SET-TIME-MAKE-DATE-STRING (LAMBDA NIL (* \; "Edited 25-Jul-88 07:31 by Mountford") (CONCAT (WINDOWPROP *DC-SET-TIME-WINDOW* 'MO) "-" (WINDOWPROP *DC-SET-TIME-WINDOW* 'DY) "-" (WINDOWPROP *DC-SET-TIME-WINDOW* 'YR) " " (WINDOWPROP *DC-SET-TIME-WINDOW* 'HR) ":" (WINDOWPROP *DC-SET-TIME-WINDOW* 'MIN)))) ) (DEFINEQ (DC-SET-TIME-ZONE-HEADING (LAMBDA (WINDOW) (* \; "Edited 20-Jul-88 23:42 by Mountford") (LET ((LOCATION (WINDOWPROP WINDOW 'LOCATION))) (CLEARW WINDOW) (MOVETOUPPERLEFT WINDOW) (WINDOWPROP WINDOW 'LOCATION (PROMPTFORWORD "Location Name: " LOCATION NIL WINDOW NIL 'TTY (CHARCODE (EOL ESCAPE LF TAB))))))) (DC-SET-TIME-ZONE (LAMBDA (WINDOW) (* \; "Edited 25-Jul-88 06:54 by Mountford") (LET ((TIME-ZONE-INFO (DC-GET-TIME-ZONE))) (|if| TIME-ZONE-INFO |then| (|if| (EQ WINDOW *DC-WINDOW*) |then| (SETQ |\\TimeZoneComp| (CDR TIME-ZONE-INFO)) (|for| W |in| (WINDOWPROP *DC-WINDOW* 'ATTACHEDWINDOWS) |do| (WINDOWPROP W 'TIME-ZONE-OFFSET (ITIMES 3600 (IDIFFERENCE (WINDOWPROP W 'TIME-ZONE) |\\TimeZoneComp|)))) |else| (WINDOWPROP WINDOW 'LOCATION (CAR TIME-ZONE-INFO)) (WINDOWPROP WINDOW 'TIME-ZONE (CDR TIME-ZONE-INFO)) (WINDOWPROP WINDOW 'TIME-ZONE-OFFSET (ITIMES 3600 (IDIFFERENCE (CDR TIME-ZONE-INFO) |\\TimeZoneComp|))))) TIME-ZONE-INFO))) (DC-GET-TIME-ZONE (LAMBDA NIL (* \; "Edited 20-Jul-88 23:23 by Mountford") (|if| (AND (BOUNDP 'TIME-ZONE-MENU) TIME-ZONE-MENU) |then| (MENU TIME-ZONE-MENU) |else| (MENU (SETQ TIME-ZONE-MENU (|create| MENU TITLE _ "ENTER TIME ZONE" ITEMS _ *DC-TIME-ZONE-LIST* CENTERFLG _ T)))))) ) (* |;;| "Alarm functions") (DEFINEQ (DC-SET-ALARM (LAMBDA NIL (* \; "Edited 17-Feb-89 15:28 by Mountford") (* |;;| "The time and alarm are actually set by DC-SET-TIME-BUTTONEVENTFN.") (DC-INITIALIZE-SET-TIME-MENU) (WINDOWPROP *DC-SET-TIME-WINDOW* 'SETTING-ALARM T))) (DC-ADD-ALARM-SETTING (LAMBDA (DATE-STRING) (* \; "Edited 15-Aug-88 07:29 by Mountford") (LET ((MESSAGE-WINDOW (DC-GET-MESSAGE-WINDOW)) (ALARM-LIST (WINDOWPROP *DC-WINDOW* 'ALARM-LIST)) (ITIME (IDATE DATE-STRING)) MESSAGE ALARM-DATE) (SETQ MESSAGE (DC-PROMPT-FOR-ALARM-MESSAGE MESSAGE-WINDOW)) (WINDOWPROP *DC-WINDOW* 'ALARM-LIST (|push| ALARM-LIST (CONS ITIME MESSAGE))) (SETQ DATE-STRING (DC-CONVERT-DATE-FORMAT DATE-STRING (DATEFORMAT SPACES NO.SECONDS))) (SETQ DATE-STRING (DC-MAKE-DISPLAY-TIME-STRING DATE-STRING (WINDOWPROP *DC-WINDOW* '12-HOUR-MODE))) (SETQ ALARM-DATE (CONCAT "Alarm set for: " DATE-STRING)) (DC-PRINT-JUSTIFIED-STRING MESSAGE-WINDOW ALARM-DATE 'CENTERED 'CLEARW)))) (DC-DELETE-ALARM-SETTING (LAMBDA NIL (* \; "Edited 22-Feb-89 16:50 by Mountford") (LET ((MENU-LIST '("CLEAR ALL")) NEW-ALARM-LIST DELETE-ITEM) (|for| ITEM |in| (WINDOWPROP *DC-WINDOW* 'ALARM-LIST) |do| (|push| MENU-LIST (CONCAT (DC-GET-DATE *DC-DATEFORMAT* (CAR ITEM)) " - " (CDR ITEM)))) (SETQ DELETE-ITEM (MENU (|create| MENU ITEMS _ MENU-LIST))) (|if| (EQUAL DELETE-ITEM "CLEAR ALL") |then| (WINDOWPROP *DC-WINDOW* 'ALARM-LIST NIL) |else| (SETQ DELETE-ITEM (IDATE (SUBSTRING DELETE-ITEM 1 15))) (|for| ITEM |in| (WINDOWPROP *DC-WINDOW* 'ALARM-LIST) |do| (|if| (NOT (EQP (CAR ITEM) DELETE-ITEM)) |then| (|push| NEW-ALARM-LIST ITEM))) (WINDOWPROP *DC-WINDOW* 'ALARM-LIST NEW-ALARM-LIST))))) ) (DEFINEQ (DC-ALARM-DUE-TO-RING? (LAMBDA (ITIME) (* \; "Edited 25-Jul-88 06:56 by Mountford") (* |;;;| "Routine looks to see if the alarm is ringing. If it is, it rings bells and then prints out at associated message. If the alarm isn't ringing, and there is a list of alarm times, it iterates down the list looking to see if it is time for the alarm to ring. If it is time for the alarm to ring it simply substitutes NIL for the date in the alarm list. The list is rebuilt once when the alarm is turned off. The reason for doing it this way is so that the list isn't being rebuilt every time the clock looks to see if the alarm is set and so that the alarm times can be in any order. Ie. they don't have to be in chronological order. ") (PROG ((ALARM-RINGING (WINDOWPROP *DC-WINDOW* 'ALARM-RINGING)) (ALARM-LIST (WINDOWPROP *DC-WINDOW* 'ALARM-LIST))) (COND (ALARM-RINGING (RETURN T)) (ALARM-LIST (|for| ALARM |in| ALARM-LIST |do| (|if| (IGEQ ITIME (CAR ALARM)) |then| (WINDOWPROP *DC-WINDOW* 'ALARM-RINGING ALARM) (RPLACA ALARM NIL) (RETURN T)))))))) (DC-RING-ALARM (LAMBDA NIL (* \; "Edited 25-Jul-88 06:57 by Mountford") (LET ((ALARM-MESSAGE (CDR (WINDOWPROP *DC-WINDOW* 'ALARM-RINGING))) (MESSAGE-WINDOW (DC-GET-MESSAGE-WINDOW))) (DC-PRINT-JUSTIFIED-STRING MESSAGE-WINDOW ALARM-MESSAGE 'CENTERED 'CLEARW) (|if| (EQ (WINDOWPROP *DC-WINDOW* 'ALARM-MODE) 'LOUD) |then| (RINGBELLS) |else| (|for| I |to| 30 |do| (VIDEOCOLOR (NOT (VIDEOCOLOR))) (BLOCK 110)))))) (DC-TURN-ALARM-OFF (LAMBDA (ITEM MENU BUTTON) (* \; "Edited 25-Jul-88 06:53 by Mountford") (LET ((TEMP-ALARM-LIST)) (|for| ALARM |in| (WINDOWPROP *DC-WINDOW* 'ALARM-LIST) |do| (|if| (CAR ALARM) |then| (SETQ TEMP-ALARM-LIST (APPEND TEMP-ALARM-LIST (LIST ALARM))))) (WINDOWPROP *DC-WINDOW* 'ALARM-LIST TEMP-ALARM-LIST) (WINDOWPROP *DC-WINDOW* 'ALARM-RINGING NIL) (DC-CLOSE-MESSAGE-WINDOW)))) ) (DEFINEQ (DC-PROMPT-FOR-ALARM-MESSAGE (LAMBDA (MESSAGE-WINDOW) (* \; "Edited 22-Feb-89 16:19 by Mountford") (LET (MESSAGE) (WINDOWPROP *DC-WINDOW* 'CAN-UPDATE NIL) (CLEARW MESSAGE-WINDOW) (MOVETOUPPERLEFT WINDOW) (SETQ MESSAGE (PROMPTFORWORD " Message: " "No Message" NIL MESSAGE-WINDOW NIL 'TTY (CHARCODE (EOL ESCAPE LF TAB)))) (WINDOWPROP *DC-WINDOW* 'CAN-UPDATE T) MESSAGE))) (DC-GET-MESSAGE-WINDOW (LAMBDA NIL (* \; "Edited 25-Jul-88 07:07 by Mountford") (OR (CAR (WINDOWPROP *DC-WINDOW* 'ATTACHEDWINDOWS)) (LET ((MESSAGE-WINDOW (CREATEW (CREATEREGION 1 (IDIFFERENCE SCREENHEIGHT 25) 430 30)))) (ATTACHWINDOW MESSAGE-WINDOW *DC-WINDOW* 'BOTTOM 'JUSTIFY) (WINDOWPROP MESSAGE-WINDOW 'MESSAGE-WINDOW T) (DSPFONT *DC-AUXW-FONT* MESSAGE-WINDOW) MESSAGE-WINDOW)))) (DC-CLOSE-MESSAGE-WINDOW (LAMBDA NIL (* \; "Edited 25-Jul-88 06:58 by Mountford") (LET ((MESSAGE-WINDOW (CAR (WINDOWPROP *DC-WINDOW* 'ATTACHEDWINDOWS)))) (|if| (WINDOWPROP MESSAGE-WINDOW 'MESSAGE-WINDOW) |then| (DETACHWINDOW MESSAGE-WINDOW) (CLOSEW MESSAGE-WINDOW))))) ) (* |;;| "Display & Misc functions") (DEFINEQ (DC-DISPLAY-TIME (LAMBDA (ITIME MERIDIAN) (* \; "Edited 1-Aug-88 08:00 by Mountford") (LET* ((LOCAL-TIME (DC-GET-DATE *DC-DATEFORMAT* ITIME)) (DISPLAY-TIME (DC-MAKE-DISPLAY-TIME-STRING LOCAL-TIME MERIDIAN))) (DC-PRINT-JUSTIFIED-STRING *DC-WINDOW* DISPLAY-TIME 'CENTERED 'CLEARW)))) (DC-MAKE-DISPLAY-TIME-STRING (LAMBDA (DATE-STRING MERIDIAN) (* \; "Edited 15-Aug-88 09:18 by Mountford") (LET ((DISPLAY-TIME DATE-STRING) (HOUR (MKATOM (SUBSTRING DATE-STRING 11 12)))) (* |;;|  "If *DC-DATEFORMAT* is changed to number.of.month, it causes the clock to break in 12-hour mode.") (|if| MERIDIAN |then| (LET ((DAY (SUBSTRING DATE-STRING 16))) (COND ((ZEROP HOUR) (SETQ DISPLAY-TIME (CONCAT (SUBSTRING DATE-STRING 1 10) "12" (SUBSTRING DATE-STRING 13 15) "am"))) ((ILESSP HOUR 10) (SETQ DISPLAY-TIME (CONCAT (SUBSTRING DATE-STRING 1 10) " " (SUBSTRING DATE-STRING 12 15) "am"))) ((ILESSP HOUR 12) (SETQ DISPLAY-TIME (CONCAT (SUBSTRING DATE-STRING 1 15) "am"))) ((EQP HOUR 12) (SETQ DISPLAY-TIME (CONCAT (SUBSTRING DATE-STRING 1 15) "pm"))) ((ILESSP HOUR 22) (SETQ DISPLAY-TIME (CONCAT (SUBSTRING DATE-STRING 1 10) " " (IDIFFERENCE HOUR 12) (SUBSTRING DATE-STRING 13 15) "pm"))) (T (SETQ DISPLAY-TIME (CONCAT (SUBSTRING DATE-STRING 1 10) (IDIFFERENCE HOUR 12) (SUBSTRING DATE-STRING 13 15) "pm")))) (|if| DAY |then| (SETQ DISPLAY-TIME (CONCAT DISPLAY-TIME DAY))))) (|if| (EQUAL " " (SUBSTRING DISPLAY-TIME 1 1)) |then| (SETQ DISPLAY-TIME (SUBSTRING DISPLAY-TIME 2))) DISPLAY-TIME))) (DC-PRINT-JUSTIFIED-STRING (LAMBDA (WINDOW STRING JUSTIFICATION CLEARW?) (* \; "Edited 15-Aug-88 06:41 by Mountford") (LET ((STRING-WIDTH (STRINGWIDTH STRING WINDOW)) (WINDOW-WIDTH (WINDOWPROP WINDOW 'WIDTH))) (|if| CLEARW? |then| (CLEARW WINDOW)) (MOVETOUPPERLEFT WINDOW) (COND ((IGREATERP STRING-WIDTH WINDOW-WIDTH) (DC-SHAPE-TO-FIT *DC-WINDOW* STRING) (SETQ WINDOW-WIDTH (WINDOWPROP WINDOW 'WIDTH)))) (COND ((EQ JUSTIFICATION 'LEFT) (SETQ STRING (CONCAT " " STRING))) ((EQ JUSTIFICATION 'RIGHT) (SETQ STRING (CONCAT STRING " ")) (SETQ STRING-WIDTH (IPLUS 3 (STRINGWIDTH STRING WINDOW))) (DSPXPOSITION (IDIFFERENCE WINDOW-WIDTH STRING-WIDTH) WINDOW)) ('CENTER (DSPXPOSITION (IQUOTIENT (IDIFFERENCE WINDOW-WIDTH STRING-WIDTH) 2) WINDOW))) (PRINTOUT WINDOW STRING)))) (DC-CONVERT-DATE-FORMAT (LAMBDA (DATE-STRING NEW-FORMAT-LIST) (* \; "Edited 25-Jul-88 11:50 by Mountford") (|if| (EQ (CAR NEW-FORMAT-LIST) 'DATEFORMAT) |then| (GDATE (IDATE DATE-STRING) NEW-FORMAT-LIST) |else| (GDATE (IDATE DATE-STRING) (CONS 'DATEFORMAT NEW-FORMAT-LIST))))) (DC-SHAPE-TO-FIT (LAMBDA (WINDOW STRING) (* \; "Edited 17-Feb-89 16:12 by Mountford") (LET ((WINDOW-LIST (WINDOWPROP *DC-WINDOW* 'ATTACHEDWINDOWS)) (STRING-WIDTH (STRINGWIDTH (CONCAT " " STRING) WINDOW)) (HEIGHT (HEIGHTIFWINDOW (FONTPROP WINDOW 'HEIGHT))) (REGION (WINDOWPROP WINDOW 'REGION)) STRING-WIDTH AUXW-STRING-WIDTH AUXW-HEIGHT X Y) (WINDOWPROP WINDOW 'RESHAPEFN NIL) (|for| AUXW |in| WINDOW-LIST |do| (DETACHWINDOW AUXW) (SETQ AUXW-STRING-WIDTH (STRINGWIDTH (CONCAT (WINDOWPROP AUXW 'LOCATION) " " STRING) AUXW)) (|if| (IGREATERP AUXW-STRING-WIDTH STRING-WIDTH) |then| (SETQ STRING-WIDTH AUXW-STRING-WIDTH))) (SETQ X (CAR REGION)) (SETQ Y (CADR REGION)) (SETQ WIDTH (WIDTHIFWINDOW STRING-WIDTH)) (SHAPEW WINDOW (LIST X Y WIDTH HEIGHT)) (SETQ AUXW-HEIGHT (HEIGHTIFWINDOW (FONTPROP (CAR WINDOW-LIST) 'HEIGHT))) (|for| AUXW |in| WINDOW-LIST |do| (SHAPEW AUXW (LIST X Y WIDTH AUXW-HEIGHT)) (ATTACHWINDOW AUXW *DC-WINDOW* 'BOTTOM 'JUSTIFY)) (WINDOWPROP *DC-WINDOW* 'RESHAPEFN 'DON\'T)))) (DC-GET-DATE (LAMBDA (DATEFORMAT ITIME OFFSET) (* \; "Edited 1-Aug-88 07:55 by Mountford") (|if| ITIME |then| (|if| OFFSET |then| (GDATE (IDIFFERENCE ITIME OFFSET) DATEFORMAT) |else| (GDATE ITIME DATEFORMAT)) |else| (|if| OFFSET |then| (GDATE (IDIFFERENCE (IDATE) OFFSET) DATEFORMAT) |else| (GDATE (IDATE) DATEFORMAT))))) (DC-MENU-POSITION (LAMBDA (MENU) (* \; "Edited 11-Aug-88 06:14 by Mountford") (LET ((WINDOW-REGION (WINDOWPROP *DC-WINDOW* 'REGION)) (MENU-HEIGHT (CADDDR (MENUREGION MENU)))) (CONS (IPLUS (CAR WINDOW-REGION) (CADDR WINDOW-REGION)) (IDIFFERENCE (IPLUS (CADR WINDOW-REGION) (CADDDR WINDOW-REGION)) MENU-HEIGHT))))) ) (* |;;| "Font functions") (DEFINEQ (DC-SET-FONT (LAMBDA (WINDOW ALL-AUXW-P) (* \; "Edited 2-Sep-88 15:44 by Mountford") (LET ((FAMILY (DC-FONT-FAMILY-MENU)) (SIZE (DC-FONT-SIZE-MENU)) (FACE (DC-FONT-FACE-MENU)) OLD-FONT NEW-FONT) (|if| (NOT (AND FAMILY SIZE FACE)) |then| (|if| WINDOW |then| (SETQ OLD-FONT (DSPFONT NIL WINDOW)) |else| (SETQ OLD-FONT (DSPFONT NIL *DC-WINDOW*))) (|if| (NOT FAMILY) |then| (SETQ FAMILY (FONTPROP OLD-FONT 'FAMILY))) (|if| (NOT SIZE) |then| (SETQ SIZE (FONTPROP OLD-FONT 'SIZE))) (|if| (NOT FACE) |then| (SETQ FACE (FONTPROP OLD-FONT 'FACE)))) (DC-PRINT-JUSTIFIED-STRING *DC-WINDOW* "Fetching Font" 'CENTER 'CLEARW) (SETQ NEW-FONT (FONTCREATE FAMILY SIZE FACE NIL NIL 'NOERRORFLG)) (|if| NEW-FONT |then| (COND (ALL-AUXW-P (SETQ *DC-AUXW-FONT* NEW-FONT) (|for| AUXW |in| (WINDOWPROP *DC-WINDOW* 'ATTACHEDWINDOWS) |do| (DSPFONT *DC-AUXW-FONT* AUXW))) (WINDOW (DSPFONT NEW-FONT WINDOW)) (T (SETQ *DC-FONT* NEW-FONT) (DSPFONT *DC-FONT* *DC-WINDOW*))) (DC-SHAPE-TO-FIT *DC-WINDOW* (DC-MAKE-DISPLAY-TIME-STRING (GDATE (IDATE) *DC-DATEFORMAT*) (WINDOWPROP *DC-WINDOW* '12-HOUR-MODE))) |else| (DC-PRINT-JUSTIFIED-STRING *DC-WINDOW* "Font Not Found" 'CENTER 'CLEARW)) NEW-FONT))) (DC-FONT-FAMILY-MENU (LAMBDA NIL (* \; "Edited 13-Aug-88 11:01 by Mountford") (|if| (OR (NOT (BOUNDP '*DC-FONT-FAMILY-MENU*)) (NULL *DC-FONT-FAMILY-MENU*)) |then| (SETQ *DC-FONT-FAMILY-MENU* (|create| MENU ITEMS _ '((|Titan| 'TITAN) (|Hippo| 'HIPPO) (|Gacha| 'GACHA) (|Classic| 'CLASSIC) (|BoldPS| 'BOLDPS) (|Modern| 'MODERN) (|Terminal| 'TERMINAL) (|Helvetica| 'HELVETICA) (|Helveticad| 'HELVETICAD) ("Old English" 'OLDENGLISH) ("Letter Gothic" 'LETTERGOTHIC) ("Times Roman" 'TIMESROMAN) ("Times Romand" 'TIMESROMAND)) CENTERFLG _ T TITLE _ " Font "))) (MENU *DC-FONT-FAMILY-MENU* (DC-MENU-POSITION *DC-FONT-FAMILY-MENU*)))) (DC-FONT-SIZE-MENU (LAMBDA NIL (* \; "Edited 13-Aug-88 10:52 by Mountford") (|if| (OR (NOT (BOUNDP '*DC-FONT-SIZE-MENU*)) (NULL *DC-FONT-SIZE-MENU*)) |then| (SETQ *DC-FONT-SIZE-MENU* (|create| MENU ITEMS _ '(6 7 8 9 10 11 12 14 16 18 24 26 30 36 72) MENUCOLUMNS _ 3 TITLE _ " Size "))) (MENU *DC-FONT-SIZE-MENU* (DC-MENU-POSITION *DC-FONT-SIZE-MENU*)))) (DC-FONT-FACE-MENU (LAMBDA NIL (* \; "Edited 11-Aug-88 06:46 by Mountford") (|if| (OR (NOT (BOUNDP '*DC-FONT-FACE-MENU*)) (NULL *DC-FONT-FACE-MENU*)) |then| (SETQ *DC-FONT-FACE-MENU* (|create| MENU ITEMS _ '((|Bold| 'BRR) (|Italic| 'MIR) ("Bold Italic" 'BIR) (|Regular| 'MRR)) TITLE _ " Face " CENTERFLG _ T))) (MENU *DC-FONT-FACE-MENU* (DC-MENU-POSITION *DC-FONT-FACE-MENU*)))) ) (* |;;| "List of the world's time zones") (RPAQQ *DC-TIME-ZONE-LIST* (("Nome, Alaska" '("Nome, Alaska: " . 11) '(-180 . -165)) ("Honolulu, Hawaii" '("Honolulu, Hawaii: " . 10) '(-165 . -150)) ("Marquesas Islands" '("Marquesas Islands: " . 9) '(-150 . -135)) ("San Francisco, California" '("San Francisco, California: " . 8) '(-135 . -120)) ("Denver, Colorado" '("Denver, Colorado: " . 7) '(-120 . -105)) ("Houston, Texas" '("Houston, Texas: " . 6) '(-105 . -90)) ("Washington DC" '("Washington DC: " . 5) '(-90 . -75)) ("Buenos Aires, Argentina" '("Buenos Aires, Argentina: " . 4) '(-75 . -60)) ("Brasilia, Brasil" '("Brasilia, Brasil: " . 3) '(-60 . -45)) ("Rio de Janeiro, Brasil" '("Rio de Janeiro, Brasil: " . 2) '(-45 . -30)) ("Reykjavik, Iceland" '("Reykjavik, Iceland: " . 1) '(-30 . -15)) ("Greenwich, England" '("Greenwich, England: " . 0) '(-15 . 0)) ("Paris, France" '("Paris, France: " . -1) '(0 . 15)) ("Athens, Greece" '("Athens, Greece: " . -2) '(15 . 30)) ("Moscow, USSR" '("Moscow, USSR: " . -3) '(30 . 45)) ("Riyadh, Arabia" '("Riyadh, Arabia: " . -4) '(45 . 60)) ("Kabul, Afganistan" '("Kabul, Afganistan: " . -5) '(60 . 75)) ("Kathmandu, Nepal" '("Kathmandu, Nepal: " . -6) '(75 . 90)) ("Bangkok, Thailand" '("Bangkok, Thailand:" . -7) '(90 . 105)) ("Hong Kong" '("Hong Kong: " . -8) '(105 . 120)) ("Seoul, South Korea" '("Seoul, South Korea: " . -9) '(120 . 135)) ("Tokyo, Japan" '("Tokyo, Japan: " . -10) '(135 . 150)) ("Sydney Austrailia" '("Sydney Austrailia:" . -11) '(150 . 165)) ("Aukland, New Zealand" '("Aukland, New Zealand: " . -12) '(165 . 180)))) (* |;;| "Call digi-clock ") (PUTPROPS DIGI-CLOCK COPYRIGHT ("XEROX Corporation" 1988 1989)) (DECLARE\: DONTCOPY (FILEMAP (NIL (3028 11522 (DIGI-CLOCK 3038 . 3527) (DC-START-PROCESS 3529 . 5030) (DC-KILL-PROCESS 5032 . 5254) (DC-BUTTONEVENTFN 5256 . 7915) (DC-AUXW-BUTTONEVENTFN 7917 . 9437) ( DC-SET-TIME-BUTTONEVENTFN 9439 . 10705) (ST 10707 . 11520)) (11560 13964 (DC-PROCESS 11570 . 12052) ( DC-UPDATE 12054 . 12752) (DC-GET-OPERATION 12754 . 13962)) (13999 17168 (DC-AUXW-GET-OPERATION 14009 . 14636) (DC-ADD-AUXW 14638 . 16136) (DC-DELETE-AUXW 16138 . 16552) (DC-AUXW-UPDATE 16554 . 17166)) ( 17207 17833 (DC-WARNING-TIME-NOT-SET 17217 . 17831)) (17834 21892 (DC-SET-TIME 17844 . 18067) ( DC-UPDATE-TIME-ITEM 18069 . 21076) (DC-VALID-DATE-P 21078 . 21276) (DC-SET-LAST-DAY-FOR-MONTH 21278 . 21890)) (21893 25094 (DC-INITIALIZE-SET-TIME-MENU 21903 . 23106) (DC-MAKE-NEW-SET-TIME-MENU 23108 . 24463) (DC-OPEN-SET-TIME-MENUW 24465 . 25092)) (25095 26274 (DC-EXTRACT-STARTING-SET-TIME-DATE 25105 . 25817) (DC-SET-TIME-MAKE-DATE-STRING 25819 . 26272)) (26275 28480 (DC-SET-TIME-ZONE-HEADING 26285 . 26761) (DC-SET-TIME-ZONE 26763 . 27951) (DC-GET-TIME-ZONE 27953 . 28478)) (28516 30916 ( DC-SET-ALARM 28526 . 28830) (DC-ADD-ALARM-SETTING 28832 . 29756) (DC-DELETE-ALARM-SETTING 29758 . 30914)) (30917 33527 (DC-ALARM-DUE-TO-RING? 30927 . 32382) (DC-RING-ALARM 32384 . 32995) ( DC-TURN-ALARM-OFF 32997 . 33525)) (33528 34968 (DC-PROMPT-FOR-ALARM-MESSAGE 33538 . 34034) ( DC-GET-MESSAGE-WINDOW 34036 . 34586) (DC-CLOSE-MESSAGE-WINDOW 34588 . 34966)) (35013 42503 ( DC-DISPLAY-TIME 35023 . 35386) (DC-MAKE-DISPLAY-TIME-STRING 35388 . 37966) (DC-PRINT-JUSTIFIED-STRING 37968 . 39058) (DC-CONVERT-DATE-FORMAT 39060 . 39452) (DC-SHAPE-TO-FIT 39454 . 41404) (DC-GET-DATE 41406 . 42016) (DC-MENU-POSITION 42018 . 42501)) (42538 47425 (DC-SET-FONT 42548 . 44456) ( DC-FONT-FAMILY-MENU 44458 . 46056) (DC-FONT-SIZE-MENU 46058 . 46622) (DC-FONT-FACE-MENU 46624 . 47423) )))) STOP