github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-13 07:29:52 +00:00
Code Issues Projects Releases Wiki Activity

Add MAKESYSDATE to logo window title, just delete Venue logo code

Browse Source
This commit is contained in:
Larry Masinter 2022-03-04 19:49:07 -08:00
parent c68f84219a
commit 156b14851b
7 changed files with 32 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
sources/LOADUP-FULL
View File

@ -1,10 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 2-Mar-2022 13:58:38" {DSK}<home>larry>medley>sources>LOADUP-FULL.;3 4768
(FILECREATED " 4-Mar-2022 19:17:17" {DSK}<home>larry>medley>sources>LOADUP-FULL.;2 4746
:CHANGES-TO (FNS LOADUP-FULL LOADFULLFONTS FIXMETA)
:CHANGES-TO (FNS LOADUP-FULL)
:PREVIOUS-DATE "15-Jan-2022 15:49:06" {DSK}<home>larry>medley>sources>LOADUP-FULL.;1)
:PREVIOUS-DATE " 2-Mar-2022 13:58:38" {DSK}<home>larry>medley>sources>LOADUP-FULL.;1)
(PRETTYCOMPRINT LOADUP-FULLCOMS)
@ -102,5 +102,5 @@
(FIXMETA)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (661 4730 (LOADFULLFONTS 671 . 2112) (LOADUP-FULL 2114 . 4480) (FIXMETA 4482 . 4728)))))
(FILEMAP (NIL (639 4708 (LOADFULLFONTS 649 . 2090) (LOADUP-FULL 2092 . 4458) (FIXMETA 4460 . 4706)))))
STOP

BIN
sources/LOADUP-FULL.LCOM
View File

Binary file not shown.

19
sources/LOADUP-LISP
View File

@ -1,10 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED " 2-Mar-2022 16:31:39" |{DSK}<home>larry>medley>sources>LOADUP-LISP.;6| 5027
(FILECREATED " 4-Mar-2022 19:17:17" |{DSK}<home>larry>medley>sources>LOADUP-LISP.;2| 5132
:CHANGES-TO (FNS LOADUP-LISP)
:PREVIOUS-DATE "28-Feb-2022 20:34:55" |{DSK}<home>larry>medley>sources>LOADUP-LISP.;1|)
:PREVIOUS-DATE " 2-Mar-2022 16:31:39" |{DSK}<home>larry>medley>sources>LOADUP-LISP.;1|)
(PRETTYCOMPRINT LOADUP-LISPCOMS)
@ -17,7 +17,8 @@
(DEFINEQ
(LOADUP-LISP
(LAMBDA NIL (* \; "Edited 2-Mar-2022 16:31 by larry")
(LAMBDA NIL (* \; "Edited 4-Mar-2022 19:13 by larry")
(* \; "Edited 2-Mar-2022 16:31 by larry")
(* \; "Edited 28-Feb-2022 15:02 by larry")
(* \; "Edited 29-Apr-2021 22:30 by rmk:")
(SETQQ COMPILE.EXT LCOM) (* \; "should be set earlier")
@ -85,9 +86,10 @@
(LOADUP '(TIME))
(LOADUP '(BRKDWN))
(LOADUP '(LOGOW IDLER HARDCOPY ICONW FREEMENU SEDIT))
(LOGOW)
(LOADUP '(XCL-EXTRAS)) (*
 "CMLPACKAGE pushes onto INSPECTMACROS")
(LOADUP '(XCL-EXTRAS))
(* |;;| "CMLPACKAGE pushes onto INSPECTMACROS")
(LOADUP '(CMLPACKAGE))
(* |;;| "Puts ARGNAME properties on CL and XCL functions that IL:SMARTARGLIST can't hack. Keep this last so everything will be defined when it runs")
@ -98,6 +100,9 @@
(* |;;| "Already enabled, but this time fixes tables that weren't defined in the init")
(PACKAGE-ENABLE)
(* |;;| " networking code -- should make it optional but too many cross dependencies")
(LOADUP '(PUP 10MBDRIVER LEAF LLETHER DPUPFTP LOCALFILE DSKDISPLAY COURIER LLNS TRSERVER SPP
NSPRINT AUTHENTICATION BSP CLEARINGHOUSE NSFILING MAIKOETHER))
(DRIBBLE)
@ -112,5 +117,5 @@
(GLOBALVARS LISPMAKESYSDATE MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (642 4805 (LOADUP-LISP 652 . 4803)))))
(FILEMAP (NIL (642 4910 (LOADUP-LISP 652 . 4908)))))
STOP

BIN
sources/LOADUP-LISP.LCOM
View File

Binary file not shown.

114
sources/LOGOW
View File

@ -1,23 +1,21 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED " 2-Mar-2022 16:44:21" |{DSK}<home>larry>medley>sources>LOGOW.;4| 18595
(FILECREATED " 4-Mar-2022 19:31:19" |{DSK}<home>larry>medley>sources>LOGOW.;2| 13188
:CHANGES-TO (VARS LOGOWCOMS)
:CHANGES-TO (FNS LOGOW)
:PREVIOUS-DATE "28-Feb-2022 21:48:48" |{DSK}<home>larry>medley>sources>LOGOW.;1|)
:PREVIOUS-DATE " 4-Mar-2022 19:17:17" |{DSK}<home>larry>medley>sources>LOGOW.;1|)
; Copyright (c) 1986-1991, 2022 by Venue.
(PRETTYCOMPRINT LOGOWCOMS)
(RPAQQ LOGOWCOMS
((FNS KOTOLOGOW LOGOW \\DRAWLOGOWINDOWIMAGE)
(VARS LOGOBITMAP)
(INITVARS (LOGOW NIL)
(LOGOTITLEFONT (FONTCREATE '(HELVETICA 6)))
(LOGONAMEFONT (FONTCREATE 'HELVETICA 36 'BOLD)))
(PROP (LOGOW FILETYPE))))
(RPAQQ LOGOWCOMS ((FNS KOTOLOGOW LOGOW \\DRAWLOGOWINDOWIMAGE)
(VARS LOGOBITMAP)
(INITVARS (LOGOW NIL))
(ADDVARS (AFTERMAKESYSFORMS (LOGOW)))
(PROP (LOGOW FILETYPE))))
(DEFINEQ
(KOTOLOGOW
@ -67,95 +65,17 @@
(RETURN W))))
(LOGOW
(LAMBDA (STRING WHERE TITLE TITLE-LOCATION) (* \; "Edited 28-Feb-2022 20:14 by larry")
(LAMBDA (STRING WHERE TITLE TITLE-LOCATION) (* \; "Edited 4-Mar-2022 19:05 by larry")
(* \; "Edited 12-Jul-91 03:12 by jds")
(PROG (WINDOW)
(CL:WHEN (WINDOWP LOGOW)
(CLOSEW LOGOW))
(OR STRING (SETQ STRING (OR "Medley" (CL:STRING-CAPITALIZE MAKESYSNAME))))
(OR TITLE (SETQ TITLE "https://Interlisp.org")) (* \; "(LOGOW NIL) gives default")
(OR TITLE (SETQ TITLE (CONCAT "https://Interlisp.org" " " MAKESYSDATE)))
(* |;;| "(LOGOW NIL) gives default")
(SETQ WINDOW (KOTOLOGOW STRING T TITLE))
(|if| NIL
|then| (OR TITLE-LOCATION (SETQ TITLE-LOCATION :LINE))
(OR TITLE (SETQ TITLE (CL:FORMAT NIL
"Copyright (c) ~D Venue, Oakland, CA. All Rights Reserved."
(LOADTIMECONSTANT (CL:MULTIPLE-VALUE-BIND
(A B C D E YEAR)
(CL:GET-DECODED-TIME)
YEAR)))))
(LET* ((SHADOWDX 2)
(SHADOWDY 2)
(TITLE-BOTTOM-HEIGHT (COND
((EQ TITLE-LOCATION :BOTTOM)
(* \;
 "Magic 4 again, just a little space above the copyright notice.")
(+ (FONTHEIGHT LOGOTITLEFONT)
4))
(T 0)))
(LINE (COND
((EQ TITLE-LOCATION :LINE)
(FONTHEIGHT LOGOTITLEFONT))
(T 4)))
(SLEN (STRINGWIDTH STRING LOGONAMEFONT))
(WLEN (+ (MAX SLEN (+ (BITMAPWIDTH LOGOBITMAP)
2 2)
(STRINGWIDTH TITLE LOGOTITLEFONT))
(PROG1 (+ 4 4) (* \; "left and right margin")
)))
(WHT (+ (FONTHEIGHT LOGONAMEFONT)
(PROG1 (+ 4 LINE 4 4) (* \;
 "below line, line, above line, above bitmap")
)
(BITMAPHEIGHT LOGOBITMAP)
TITLE-BOTTOM-HEIGHT))
(TEMP (BITMAPCREATE WLEN WHT))
(IMAGE (BITMAPCREATE WLEN WHT))
(MASK (BITMAPCREATE WLEN WHT))
(STREAM (DSPCREATE TEMP))
WINDOW LINEY LINEX TITLEWIDTH)
(BITBLT LOGOBITMAP NIL NIL STREAM (DIFFERENCE WLEN (+ (BITMAPWIDTH
LOGOBITMAP)
(PROG1 6
(* \; "right margin"))))
(+ TITLE-BOTTOM-HEIGHT (FONTHEIGHT LOGONAMEFONT)
4 LINE 4))
(DSPFONT LOGONAMEFONT STREAM)
(MOVETO (- WLEN 4 (STRINGWIDTH STRING STREAM))
(+ (FONTDESCENT LOGONAMEFONT)
TITLE-BOTTOM-HEIGHT)
STREAM)
(PRIN3 STRING STREAM)
(BITBLT STREAM 0 0 IMAGE NIL NIL NIL NIL NIL 'ERASE)
(BITBLT STREAM 0 0 IMAGE SHADOWDX (- SHADOWDY)
NIL NIL NIL 'PAINT)
(BITBLT STREAM 0 0 MASK SHADOWDX (- SHADOWDY)
NIL NIL NIL 'PAINT)
(BITBLT STREAM 0 0 MASK NIL NIL NIL NIL NIL 'PAINT)
(SETQ TITLEWIDTH (STRINGWIDTH TITLE LOGOTITLEFONT))
(BITBLT NIL NIL NIL IMAGE (SETQ LINEX 6)
(SETQ LINEY (+ TITLE-BOTTOM-HEIGHT (FONTHEIGHT LOGONAMEFONT)
4))
(IMAX TITLEWIDTH (BITMAPWIDTH LOGOBITMAP))
LINE
'TEXTURE
'PAINT BLACKSHADE)
(BITBLT NIL NIL NIL MASK LINEX LINEY TITLEWIDTH LINE 'TEXTURE 'PAINT
BLACKSHADE)
(SETQ STREAM (DSPCREATE IMAGE))
(DSPFONT LOGOTITLEFONT STREAM)
(DSPOPERATION 'ERASE STREAM)
(DSPTEXTURE BLACKSHADE STREAM)
(MOVETO (ADD1 LINEX)
(+ (FONTDESCENT LOGOTITLEFONT)
(COND
((EQ TITLE-LOCATION :BOTTOM)
0)
(T LINEY)))
STREAM)
(PRIN3 TITLE STREAM)
(SETQ WINDOW (ICONW IMAGE MASK (OR WHERE (CREATEPOSITION (- SCREENWIDTH
WLEN)
(- SCREENHEIGHT WHT)))))))
(WINDOWPROP WINDOW 'BUTTONEVENTFN 'MOVEW)
(WINDOWPROP WINDOW 'TYPE 'LOGOW)
(WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA NIL
@ -184,11 +104,9 @@
(RPAQ? LOGOW NIL)
(RPAQ? LOGOTITLEFONT (FONTCREATE '(HELVETICA 6)))
(RPAQ? LOGONAMEFONT (FONTCREATE 'HELVETICA 36 'BOLD))
(ADDTOVAR AFTERMAKESYSFORMS (LOGOW))
(PUTPROPS LOGOW COPYRIGHT ("Venue" 1986 1987 1988 1989 1990 1991 2022))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (644 10406 (KOTOLOGOW 654 . 3448) (LOGOW 3450 . 9697) (\\DRAWLOGOWINDOWIMAGE 9699 .
10404)))))
(FILEMAP (NIL (596 5071 (KOTOLOGOW 606 . 3400) (LOGOW 3402 . 4362) (\\DRAWLOGOWINDOWIMAGE 4364 . 5069)
))))
STOP

BIN
sources/LOGOW.DFASL
View File

Binary file not shown.

BIN
sources/LOGOW.LCOM
View File

Binary file not shown.