Skip to content

Commit

Permalink
WINDOWOBJ: Better handling of unknown image objects (#1436)
Browse files Browse the repository at this point in the history 
* WINDOWOBJ: Better handling of unknown image objects

2 changes:   If WHEREIS says that an unknown getfn is on FOO-FIE and FOO>FOO exists, then offer FOO in the mouseconfirm.  This should get all the support code (e.g. TMAX is offered instead of TMAX-NUMBER).  Issue #748.  Separately, if the getfn is not found when the file is opened (so the image object is encapsulated), the encapsulated imagebox fn will upgrade the image if the getfn exists when the object is redisplayed.

* Glitch
  • Loading branch information
@rmkaplan
rmkaplan authored Dec 2, 2023
1 parent 735108e commit c8c4768
Show file tree
Hide file tree
Showing 2 changed files with 72 additions and 36 deletions.
108 changes: 72 additions & 36 deletions sources/WINDOWOBJ
View file
Original file line number Diff line number Diff line change
@@ -1,16 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "18-Mar-2022 21:45:55" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>WINDOWOBJ.;8 28006
(FILECREATED "29-Nov-2023 14:51:52" {WMEDLEY}<sources>WINDOWOBJ.;17 30975

:CHANGES-TO (FNS READIMAGEOBJ)
:EDIT-BY rmk

:PREVIOUS-DATE "17-Mar-2022 22:48:26"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>WINDOWOBJ.;7)
:CHANGES-TO (FNS READIMAGEOBJ)

:PREVIOUS-DATE "29-Nov-2023 14:14:32" {WMEDLEY}<sources>WINDOWOBJ.;15)

(* ; "
Copyright (c) 1986-1987, 1990-1991, 1993 by Venue & Xerox Corporation.
")

(PRETTYCOMPRINT WINDOWOBJCOMS)

Expand Down Expand Up @@ -315,6 +312,8 @@ Copyright (c) 1986-1987, 1990-1991, 1993 by Venue & Xerox Corporation.
(READIMAGEOBJ
[LAMBDA (STREAM GETFN NOERROR DATANBYTES)

(* ;; "Edited 29-Nov-2023 14:51 by rmk")

(* ;; "Edited 18-Mar-2022 21:45 by rmk: Added WHEREIS as a last resort.")
(* rrb "18-Mar-86 11:35")
(DECLARE (SPECVARS UNDERREADIMAGEOBJ))
Expand All @@ -325,18 +324,33 @@ Copyright (c) 1986-1987, 1990-1991, 1993 by Venue & Xerox Corporation.

(* ;; "rmk: I'm not sure that it makes sense for GETFN to be NIL, as 86 code allowed. Presumably an image object without a GETFN should never have been written.")

(LET (SUPPORTFILE (UNDERREADIMAGEOBJ T))
(LET (SUPPORTFILE HYPHENPOS SFNAME (UNDERREADIMAGEOBJ T))
(DECLARE (SPECVARS UNDERREADIMAGEOBJ))

(* ;; "Typically,the file containing the GETFN has already been loaded. If not, it could be the case that the GETFN and its file were pushed on the list for future reference (now), but the file wasn't loaded then. We need to download it. Or if not there or not there with a file, and we can find the file containing the GETFN in the WHEREIS database, load that file.")

(* ;; "If we find the file with the GETFN but that file doesn't also contain the IMAGEFNS variable, we're screwed. That's why we apply the GETFN under an NLSETQ")
(* ;; "If we find the file with the GETFN but that file doesn't also contain the IMAGEFNS variable, we're screwed. That's why we apply the GETFN under an NLSETQ. As Plan B, if the getfn is on a file ...>abc>abc-xyz, and >abc>abc exists, then we offer to load the putative rootfile instead. (It would be nice to have UNPACKDIR and PACKDIR functions that map back and forth between a>b>c and (a b c).")

(* ;; "Note: the Prompt message only shows the NAME of the file, not the full path")

(CL:WHEN (AND GETFN (NOT (GETD GETFN))
[SETQ SUPPORTFILE (OR (LISTGET (CDR (ASSOC GETFN IMAGEOBJGETFNS))
'FILE)
(CAR (WHEREIS GETFN 'FNS T))
(CAR (WHEREIS GETFN 'FUNCTIONS T]
(SETQ SUPPORTFILE (FINDFILE SUPPORTFILE T))
(PROG1 T
(CL:WHEN [SETQ HYPHENPOS (STRPOS "-" (SETQ SFNAME (FILENAMEFIELD.STRING
SUPPORTFILE
'NAME]
(SETQ SFNAME (SUBSTRING SFNAME 1 (SUB1 HYPHENPOS)))
(CL:WHEN (AND [STRING.EQUAL SFNAME (SUBSTRING (FILENAMEFIELD.STRING
(TRUEFILENAME
SUPPORTFILE)
'DIRECTORY)
(IMINUS (NCHARS SFNAME]
(INFILEP (PACKFILENAME 'NAME SFNAME 'BODY SUPPORTFILE)))
(SETQ SUPPORTFILE SFNAME))))
(MOUSECONFIRM (CONCAT "Trying to read an IMAGEOBJ with GETFN " GETFN
". Shall I load the support file, " SUPPORTFILE "?")
NIL NIL NIL))
Expand Down Expand Up @@ -397,23 +411,35 @@ Copyright (c) 1986-1987, 1990-1991, 1993 by Venue & Xerox Corporation.
(DEFINEQ

(ENCAPSULATEDOBJ.BUTTONEVENTINFN
[LAMBDA (IMAGEOBJ WINDOW) (* ; "Edited 2-Apr-87 15:33 by bvm:")
[LAMBDA (IMAGEOBJ WINDOW) (* ; "Edited 26-Nov-2023 08:15 by rmk")
(* ; "Edited 2-Apr-87 15:33 by bvm:")

(* ;;; "The user hit a button inside this object. Try loading it now.")

(CL:WITH-OPEN-FILE (STREAM (IMAGEOBJPROP IMAGEOBJ 'FILE))
(SETFILEPTR STREAM (IMAGEOBJPROP IMAGEOBJ 'FILEPTR))
(* ;
 "Move to where the IMAGEOBJ's description started in the file we read it from")
(LET [(OBJ (READIMAGEOBJ STREAM (IMAGEOBJPROP IMAGEOBJ 'UNKNOWNGETFN)
 "Move to where the IMAGEOBJ's description started in the file we read it from")
(LET ([OBJ (READIMAGEOBJ STREAM (IMAGEOBJPROP IMAGEOBJ 'UNKNOWNGETFN)
T
(IMAGEOBJPROP IMAGEOBJ 'ENDOFOBJFILEPTR]
PROMPT)
(COND
(OBJ (* ;
 "We succeeded in reading the object this time. Copy its guts over the placeholder.")
 "We succeeded in reading the object this time. Copy its guts over the placeholder.")
(COPYIMAGEOBJ OBJ IMAGEOBJ)
'CHANGED)
(T (PRIN1 "Still no support for this image object." (GETPROMPTWINDOW WINDOW))
((GETD (IMAGEOBJPROP IMAGEOBJ 'UNKNOWNGETFN))
(SETQ PROMPT (GETPROMPTWINDOW WINDOW))
(FRESHLINE PROMPT)
(PRIN1 (CONCAT "Error in executing " (IMAGEOBJPROP IMAGEOBJ 'UNKNOWNGETFN))
PROMPT)
NIL)
(T (SETQ PROMPT (GETPROMPTWINDOW WINDOW))
(FRESHLINE PROMPT)
(PRIN1 (CONCAT (IMAGEOBJPROP IMAGEOBJ 'UNKNOWNGETFN)
" is still unknown")
PROMPT)
NIL])

(ENCAPSULATEDOBJ.PUTFN
Expand Down Expand Up @@ -472,21 +498,32 @@ Either delete this image object or load its support files." IMAGEOBJ)
(DSPFONT OLDFONT STREAM])

(ENCAPSULATEDOBJ.IMAGEBOXFN
[LAMBDA (OBJ STREAM) (* jds "19-Feb-85 10:05")
[LAMBDA (IMAGEOBJ STREAM) (* ; "Edited 29-Nov-2023 12:49 by rmk")
(* jds "19-Feb-85 10:05")

(* ;; "IMAGEOBXFN for an encapsulated IMAGEOBJ. If the GETFN now exists, another attempt is made to retrieve the underlying object and to use its boxfn. ")

(LET ((GETFN (IMAGEOBJPROP IMAGEOBJ 'UNKNOWNGETFN))
NEWOBJ WIDTH HEIGHT FONT)
(if [AND GETFN (CL:WITH-OPEN-FILE (STREAM (IMAGEOBJPROP IMAGEOBJ 'FILE))
(SETFILEPTR STREAM (IMAGEOBJPROP IMAGEOBJ 'FILEPTR))
(* ;
 "IMAGEOBXFN for an encapsulated IMAGEOBJ")
(PROG ((FONT (FONTCREATE 'HELVETICA 8 'BOLD NIL STREAM))
(GETFN (IMAGEOBJPROP OBJ 'UNKNOWNGETFN))
WIDTH HEIGHT)
[SETQ HEIGHT (ITIMES 2 (FONTPROP FONT 'HEIGHT]
(SETQ WIDTH (IMAX (STRINGWIDTH "Unknown IMAGEOBJ type" FONT)
(STRINGWIDTH (CONCAT "GETFN: " GETFN)
FONT)))
(RETURN (create IMAGEBOX
XSIZE _ (IPLUS WIDTH 6)
YSIZE _ (IPLUS HEIGHT 6)
YDESC _ 0
XKERN _ 0])
 "Move to where the IMAGEOBJ's description started in the file we read it from")
(SETQ NEWOBJ (READIMAGEOBJ STREAM GETFN T (IMAGEOBJPROP IMAGEOBJ
'ENDOFOBJFILEPTR]
then (COPYIMAGEOBJ NEWOBJ IMAGEOBJ) (* ; "ENCAPSULATEDOBJ.BUTTONEVENTINFN also returns CHANGED to tell the caller what happened. But we have to return the box. Fingers crossed.")
(APPLY* (IMAGEOBJPROP IMAGEOBJ 'IMAGEBOXFN)
IMAGEOBJ STREAM)
else (SETQ FONT (FONTCREATE 'HELVETICA 8 'BOLD NIL STREAM))
[SETQ HEIGHT (ITIMES 2 (FONTPROP FONT 'HEIGHT]
(SETQ WIDTH (IMAX (STRINGWIDTH "Unknown IMAGEOBJ type" FONT)
(STRINGWIDTH (CONCAT "GETFN: " GETFN)
FONT)))
(create IMAGEBOX
XSIZE _ (IPLUS WIDTH 6)
YSIZE _ (IPLUS HEIGHT 6)
YDESC _ 0
XKERN _ 0])

(ENCAPSULATEDIMAGEFNS
[LAMBDA (GETFN) (* rrb " 3-Feb-86 18:31")
Expand Down Expand Up @@ -526,13 +563,12 @@ Either delete this image object or load its support files." IMAGEOBJ)

(ADDTOVAR LAMA IMAGEOBJPROP)
)
(PUTPROPS WINDOWOBJ COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1991 1993))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4897 21221 (COPYINSERT 4907 . 6434) (IMAGEBOX 6436 . 6616) (IMAGEFNSCREATE 6618 . 7813)
(IMAGEFNSP 7815 . 8056) (IMAGEOBJCREATE 8058 . 8603) (IMAGEOBJP 8605 . 8846) (IMAGEOBJPROP 8848 .
14740) (\IMAGEUSERPROP 14742 . 15336) (HPRINT.IMAGEOBJ 15338 . 15927) (COPYIMAGEOBJ 15929 . 16672) (
READIMAGEOBJ 16674 . 19867) (WRITEIMAGEOBJ 19869 . 21219)) (21435 27642 (
ENCAPSULATEDOBJ.BUTTONEVENTINFN 21445 . 22581) (ENCAPSULATEDOBJ.PUTFN 22583 . 23698) (
ENCAPSULATEDOBJ.DISPLAYFN 23700 . 25313) (ENCAPSULATEDOBJ.IMAGEBOXFN 25315 . 26203) (
ENCAPSULATEDIMAGEFNS 26205 . 27640)))))
(FILEMAP (NIL (4766 22601 (COPYINSERT 4776 . 6303) (IMAGEBOX 6305 . 6485) (IMAGEFNSCREATE 6487 . 7682)
(IMAGEFNSP 7684 . 7925) (IMAGEOBJCREATE 7927 . 8472) (IMAGEOBJP 8474 . 8715) (IMAGEOBJPROP 8717 .
14609) (\IMAGEUSERPROP 14611 . 15205) (HPRINT.IMAGEOBJ 15207 . 15796) (COPYIMAGEOBJ 15798 . 16541) (
READIMAGEOBJ 16543 . 21247) (WRITEIMAGEOBJ 21249 . 22599)) (22815 30697 (
ENCAPSULATEDOBJ.BUTTONEVENTINFN 22825 . 24608) (ENCAPSULATEDOBJ.PUTFN 24610 . 25725) (
ENCAPSULATEDOBJ.DISPLAYFN 25727 . 27340) (ENCAPSULATEDOBJ.IMAGEBOXFN 27342 . 29258) (
ENCAPSULATEDIMAGEFNS 29260 . 30695)))))
STOP
Binary file modified sources/WINDOWOBJ.LCOM
View file
Binary file not shown.

0 comments on commit c8c4768

Please sign in to comment.