Update HELPSYS to find CLHS (Common Lisp HyperSpec) and lispusers/library docs (#917)
* Update HELPSYS to find CLHS (Common Lisp HyperSpec) and lispusers/library docs * restore lost edits; fix package inclusion for XCL and LISP * mere with previous commit * try again
This commit is contained in:
Larry Masinter
GitHub
@@ -1,15 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 3-Feb-2022 12:04:29" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>HELPSYS.;2 28963
|
||||
(FILECREATED "27-Aug-2022 12:15:35" {DSK}<home>larry>medley>lispusers>HELPSYS.;3 34815
|
||||
|
||||
:CHANGES-TO (VARS HELPSYSCOMS)
|
||||
:CHANGES-TO (FNS GENERIC.MAN.LOOKUP)
|
||||
(COMMANDS "man")
|
||||
|
||||
:PREVIOUS-DATE "27-Nov-2020 09:47:44"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>HELPSYS.;1)
|
||||
:PREVIOUS-DATE "27-Aug-2022 12:05:47" {DSK}<home>larry>medley>lispusers>HELPSYS.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985-1987, 2020 by Xerox Corporation.
|
||||
Copyright (c) 1985-1987, 2020, 2022 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT HELPSYSCOMS)
|
||||
@@ -20,11 +20,21 @@ Copyright (c) 1985-1987, 2020 by Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
DINFO HASH))
|
||||
[COMS (COMMANDS "man")
|
||||
(FNS HELPSYS IRM.LOOKUP IRM.SMART.LOOKUP IRM.RESET)
|
||||
(FNS HELPSYS IRM.LOOKUP GENERIC.MAN.LOOKUP IRM.RESET)
|
||||
(INITVARS (IRM.HOST&DIR)
|
||||
(IRM.HASHFILE.NAME))
|
||||
(GLOBALVARS IRM.HOST&DIR IRM.HASHFILE.NAME)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD 'HELPSYS 'XHELPSYS NIL T]
|
||||
|
||||
|
||||
(* ;;; "Common Lisp HyperSpec lookup")
|
||||
|
||||
(COMS (FNS CLHS.INDEX CLHS.LOOKUP CLHS.OPENER REPO.LOOKUP)
|
||||
[INITVARS (CLHS.ROOT.URL "http://clhs.lisp.se/")
|
||||
(CLHS.INDEX)
|
||||
(CLHS.OPENER)
|
||||
(REPO.TYPES '(FNS FUNCTIONS VARS VARIABLES]
|
||||
(GLOBALVARS CLHS.INDEX CLHS.OPENER REPO.TYPES CLHS.ROOT.URL))
|
||||
(COMS
|
||||
|
||||
(* ;;; "Interface to DInfo")
|
||||
@@ -87,79 +97,111 @@ Copyright (c) 1985-1987, 2020 by Xerox Corporation.
|
||||
)
|
||||
|
||||
(DEFCOMMAND "man" (ENTRY) "Lookup ENTRY in the IRM."
|
||||
(IRM.SMART.LOOKUP ENTRY))
|
||||
(GENERIC.MAN.LOOKUP ENTRY))
|
||||
(DEFINEQ
|
||||
|
||||
(HELPSYS
|
||||
[LAMBDA (FN PROPS) (* drc%: "20-Jan-86 18:05")
|
||||
[LAMBDA (FN PROPS) (* ; "Edited 24-Aug-2022 16:17 by larry")
|
||||
(* ; "Edited 13-Aug-2022 22:35 by lmm")
|
||||
(* drc%: "20-Jan-86 18:05")
|
||||
(if (NOT IRM.HOST&DIR)
|
||||
then (PROMPTPRINT "HELPSYS is unavailable. Set IRM.HOST&DIR.")
|
||||
NIL
|
||||
NIL
|
||||
else (SELECTQ PROPS
|
||||
(ARGS
|
||||
(ARGS
|
||||
|
||||
(* HELPSYS is called by SMARTARGLIST to get args, but this implementation does
|
||||
not support that.)
|
||||
not support that.)
|
||||
|
||||
NIL)
|
||||
(FromDEdit (* from ? under EditCom)
|
||||
(IRM.LOOKUP (if (LISTP FN)
|
||||
then (CAR FN)
|
||||
else FN))
|
||||
NIL)
|
||||
(NIL (* called by TTYIN <actually
|
||||
XHELPSYS is...> when FN...? <CR> is
|
||||
typed.)
|
||||
(if (FGETD FN)
|
||||
then (IRM.LOOKUP FN 'Function)
|
||||
elseif (for MACRO.TYPE in MACROPROPS
|
||||
thereis (GETPROP FN MACRO.TYPE))
|
||||
then (IRM.LOOKUP FN 'Macro IRMWINDOW)
|
||||
elseif (SELECTQ (CAR (GETPROP FN 'CLISPWORD))
|
||||
(NIL)
|
||||
(FORWORD (IRM.LOOKUP FN 'I.S.Operator))
|
||||
(RECORDTRAN (IRM.LOOKUP FN 'RecordOperator))
|
||||
(PROGN (IRM.LOOKUP FN NIL)))
|
||||
else (BEEP)))
|
||||
NIL])
|
||||
NIL)
|
||||
(FromDEdit (* from ? under EditCom)
|
||||
(IRM.LOOKUP (if (LISTP FN)
|
||||
then (CAR FN)
|
||||
else FN))
|
||||
NIL)
|
||||
(NIL (* called by TTYIN <actually XHELPSYS
|
||||
is...> when FN...? <CR> is typed.)
|
||||
(if (FGETD FN)
|
||||
then (GENERIC.MAN.LOOKUP FN NIL 'Function)
|
||||
elseif (for MACRO.TYPE in MACROPROPS thereis (GETPROP FN MACRO.TYPE))
|
||||
then (IRM.LOOKUP FN 'Macro IRMWINDOW)
|
||||
elseif (SELECTQ (CAR (GETPROP FN 'CLISPWORD))
|
||||
(NIL)
|
||||
(FORWORD (IRM.LOOKUP FN 'I.S.Operator))
|
||||
(RECORDTRAN (IRM.LOOKUP FN 'RecordOperator))
|
||||
(PROGN (IRM.LOOKUP FN NIL)))
|
||||
else (BEEP)))
|
||||
NIL])
|
||||
|
||||
(IRM.LOOKUP
|
||||
[LAMBDA (KEYWORD TYPE GRAPH SMARTFLG) (* ; "Edited 27-Nov-2020 08:45 by larry")
|
||||
[LAMBDA (KEYWORD TYPE GRAPH SMARTFLG) (* ; "Edited 24-Aug-2022 16:32 by larry")
|
||||
(* ; "Edited 19-Aug-2022 19:43 by lmm")
|
||||
(* drc%: "17-Jan-86 14:09")
|
||||
|
||||
(* * Does a lookup in the IRM index for KEYWORD
|
||||
(optionally of TYPE) and visits the DInfo node in GRAPH containing the
|
||||
reference. If SMARTFLG is non-NIL, wildcards will be enabled.
|
||||
GRAPH defaults to IRM.DINFOGRAPH.)
|
||||
(* ;;; "Does a lookup in the IRM index for KEYWORD (optionally of TYPE) and visits the DInfo node in GRAPH containing the reference. If SMARTFLG is non-NIL, wildcards will be enabled. GRAPH defaults to IRM.DINFOGRAPH.")
|
||||
|
||||
(LET* [(GRAPH (if (type? DINFOGRAPH GRAPH)
|
||||
then GRAPH
|
||||
else (IRM.GET.DINFOGRAPH)))
|
||||
(KEYWORD (MKATOM (U-CASE KEYWORD)))
|
||||
(TYPE (MKATOM TYPE))
|
||||
(WINDOW (fetch (DINFOGRAPH WINDOW) of GRAPH))
|
||||
(MONITORLOCK (DINFOGRAPHPROP GRAPH 'MONITORLOCK]
|
||||
(OPENW WINDOW)
|
||||
(if (OBTAIN.MONITORLOCK MONITORLOCK T)
|
||||
then (RESETLST
|
||||
(RESETSAVE (TTYDISPLAYSTREAM (GETPROMPTWINDOW WINDOW)))
|
||||
(RESETSAVE NIL (LIST 'RELEASE.MONITORLOCK MONITORLOCK))
|
||||
(LET [(REF (if SMARTFLG
|
||||
then (\IRM.SMART.REF KEYWORD WINDOW)
|
||||
else (\IRM.GET.REF KEYWORD TYPE WINDOW]
|
||||
(AND REF (IRM.DISPLAY.REF REF GRAPH))))
|
||||
else (FLASHWINDOW WINDOW])
|
||||
(PROG [(REF (if SMARTFLG
|
||||
then (\IRM.SMART.REF KEYWORD)
|
||||
else (\IRM.GET.REF KEYWORD TYPE]
|
||||
(if (NULL REF)
|
||||
then (RETURN))
|
||||
(LET* [(GRAPH (if (type? DINFOGRAPH GRAPH)
|
||||
then GRAPH
|
||||
else (IRM.GET.DINFOGRAPH)))
|
||||
(KEYWORD (MKATOM (U-CASE KEYWORD)))
|
||||
(TYPE (MKATOM TYPE))
|
||||
(WINDOW (fetch (DINFOGRAPH WINDOW) of GRAPH))
|
||||
(MONITORLOCK (DINFOGRAPHPROP GRAPH 'MONITORLOCK]
|
||||
(OPENW WINDOW)
|
||||
(if (OBTAIN.MONITORLOCK MONITORLOCK T)
|
||||
then (RESETLST
|
||||
(RESETSAVE (TTYDISPLAYSTREAM (GETPROMPTWINDOW WINDOW)))
|
||||
(RESETSAVE NIL (LIST 'RELEASE.MONITORLOCK MONITORLOCK))
|
||||
(IRM.DISPLAY.REF REF GRAPH)
|
||||
(LIST REF))
|
||||
else (FLASHWINDOW WINDOW)
|
||||
NIL])
|
||||
|
||||
(IRM.SMART.LOOKUP
|
||||
[LAMBDA (KEYWORD GRAPH) (* drc%: " 6-Jan-86 14:50")
|
||||
(IRM.LOOKUP KEYWORD NIL GRAPH T])
|
||||
(GENERIC.MAN.LOOKUP
|
||||
[LAMBDA (KEYWORD GRAPH TYPE) (* ; "Edited 27-Aug-2022 12:15 by larry")
|
||||
(* ; "Edited 24-Aug-2022 22:35 by larry")
|
||||
(* ; "Edited 19-Aug-2022 19:35 by lmm")
|
||||
(* drc%: " 6-Jan-86 14:50")
|
||||
(if (STRINGP KEYWORD)
|
||||
then
|
||||
(* ;; "a string -- look up in all three sources")
|
||||
|
||||
(APPEND (IRM.LOOKUP KEYWORD NIL GRAPH T)
|
||||
(CLHS.LOOKUP KEYWORD)
|
||||
(REPO.LOOKUP KEYWORD))
|
||||
elseif (NOT (LITATOM KEYWORD))
|
||||
then
|
||||
(* ;; " not a string -- list or number. turn it into a string, removing parens")
|
||||
|
||||
(LET ((STR (MKSTRING KEYWORD)))
|
||||
(if (LISTP KEYWORD)
|
||||
then (SETQ STR (SUBSTRING KEYWORD 2 -2)))
|
||||
(GENERIC.MAN.LOOKUP STR GRAPH TYPE))
|
||||
elseif [CL:MULTIPLE-VALUE-BIND (FND TYPE)
|
||||
(CL:FIND-SYMBOL KEYWORD "XCL")
|
||||
(AND (EQ KEYWORD FND)
|
||||
(OR (EQ TYPE :INHERITED)
|
||||
(EQ TYPE :EXTERNAL]
|
||||
then
|
||||
(* ;; " Common Lisp symbol")
|
||||
|
||||
(APPEND (CLHS.LOOKUP KEYWORD '(1))
|
||||
(AND (CL:FIND-SYMBOL KEYWORD "IL")
|
||||
(IRM.LOOKUP KEYWORD TYPE GRAPH T)))
|
||||
else (APPEND (IRM.LOOKUP KEYWORD TYPE GRAPH T)
|
||||
(REPO.LOOKUP KEYWORD])
|
||||
|
||||
(IRM.RESET
|
||||
[LAMBDA NIL (* drc%: "27-Jan-86 11:19")
|
||||
(if (type? DINFOGRAPH IRM.DINFOGRAPH)
|
||||
then (LET ((W (fetch (DINFOGRAPH WINDOW) of IRM.DINFOGRAPH)))
|
||||
(OPENW W)
|
||||
(CLOSEW W)))
|
||||
(OPENW W)
|
||||
(CLOSEW W)))
|
||||
(SETQ IRM.DINFOGRAPH)
|
||||
(CLOSEHASHFILE \IRM.HASHFILE)
|
||||
(SETQ \IRM.HASHFILE)
|
||||
@@ -180,12 +222,142 @@ Copyright (c) 1985-1987, 2020 by Xerox Corporation.
|
||||
|
||||
|
||||
|
||||
(* ;;; "Common Lisp HyperSpec lookup")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(CLHS.INDEX
|
||||
[LAMBDA (ENTRY) (* ; "Edited 16-Aug-2022 12:28 by larry")
|
||||
(* ; "Edited 16-Aug-2022 09:34 by lmm")
|
||||
(* ; "Edited 14-Aug-2022 15:54 by lmm")
|
||||
(OR CLHS.INDEX
|
||||
(SETQ CLHS.INDEX
|
||||
(CL:WITH-OPEN-FILE
|
||||
(STREAM (OR (MEDLEYDIR "tmp/clhs" "clindex.html" NIL T)
|
||||
(PROGN (PRINTOUT PROMPTWINDOW "Fetching Hyperspec Index from web" T)
|
||||
(ShellCommand (CONCAT "cd $MEDLEYDIR && " " mkdir -p tmp/clhs && "
|
||||
"curl --output tmp/clhs/clindex.html -s "
|
||||
CLHS.ROOT.URL "Front/X_AllSym.htm")))
|
||||
(MEDLEYDIR "tmp/clhs" "clindex.html")))
|
||||
(LET (LINE POSLINK POSFRAG POSENDLINK POSENDTERM POSTERM LINK)
|
||||
(while (SETQ LINE (CL:READ-LINE STREAM NIL))
|
||||
when [AND (SETQ POSLINK (STRPOS "<LI><A REL=DEFINITION HREF=%"../Body/" LINE 1 NIL
|
||||
NIL T))
|
||||
(SETQ POSENDLINK (STRPOS "%"><B>" LINE (+ 4 POSLINK)))
|
||||
[SETQ POSENDTERM (STRPOS "</B></A>" LINE
|
||||
(PLUS 1 (SETQ POSTERM (+ POSENDLINK
|
||||
(CONSTANT (NCHARS
|
||||
"%"><B>"
|
||||
]
|
||||
(SETQ TERM (SUBSTRING LINE POSTERM (CL:1- POSENDTERM]
|
||||
collect (CONS (for SUBST in '(("&" "&"))
|
||||
when (EQ 1 (STRPOS (CAR SUBST)
|
||||
TERM))
|
||||
do [SETQ TERM (CONCAT (CADR SUBST)
|
||||
(SUBSTRING TERM (PLUS 1 (NCHARS (CAR SUBST]
|
||||
finally (RETURN TERM))
|
||||
(if (SETQ POSFRAG (STRPOS "#" LINE POSLINK POSENDLINK))
|
||||
then (LIST (SUBSTRING LINE POSLINK (CL:1- POSFRAG))
|
||||
(SUBSTRING LINE (CL:1+ POSFRAG)
|
||||
(CL:1- POSENDLINK)))
|
||||
else (LIST (SUBSTRING LINE POSLINK (CL:1- POSENDLINK])
|
||||
|
||||
(CLHS.LOOKUP
|
||||
[LAMBDA (ENTRY PHASES) (* ; "Edited 24-Aug-2022 17:08 by larry")
|
||||
(LET [(OPENER (CLHS.OPENER))
|
||||
(URL NIL)
|
||||
POS
|
||||
(ENTRY (L-CASE (MKSTRING ENTRY]
|
||||
(for PHASE in (OR PHASES '(1 2 3))
|
||||
do
|
||||
(* ;; " three phases: exact match, initial match, partial match")
|
||||
|
||||
(for X in (CLHS.INDEX) when (SELECTQ PHASE
|
||||
(1 (STREQUAL ENTRY (CAR X)))
|
||||
(2 [AND (EQ (STRPOS ENTRY (CAR X))
|
||||
1)
|
||||
(NOT (STREQUAL ENTRY (CAR X])
|
||||
(3 (AND (SETQ POS (STRPOS ENTRY (CAR X)))
|
||||
(NEQ POS 1)))
|
||||
NIL)
|
||||
join (SETQ URL (CONCAT CLHS.ROOT.URL "Body/" (CADR X)
|
||||
(if (CADDR X)
|
||||
then (CONCAT "#" (CADDR X))
|
||||
else "")))
|
||||
(if (EQUAL OPENER "lynx")
|
||||
then
|
||||
(* ;; " Need to quote URL because shell eats #")
|
||||
|
||||
(CHAT 'SHELL NIL (CONCAT OPENER " '" URL "'
|
||||
"))
|
||||
else (ShellCommand (CONCAT OPENER " '" URL "'"
|
||||
" > $MEDLEYDIR/tmp/clhs/warnings.txt 2>&1")
|
||||
T))
|
||||
(RETURN))
|
||||
(AND URL (RETURN (LIST URL])
|
||||
|
||||
(CLHS.OPENER
|
||||
[LAMBDA NIL (* ; "Edited 20-Aug-2022 09:38 by larry")
|
||||
(* ; "Edited 20-Aug-2022 09:20 by lmm")
|
||||
(* ; "Edited 16-Aug-2022 16:50 by lmm")
|
||||
(* ; "Edited 16-Aug-2022 12:22 by larry")
|
||||
(* ; "Edited 15-Aug-2022 09:14 by lmm")
|
||||
(OR CLHS.OPENER (if (INFILEP "{UNIX}/usr/bin/wslview")
|
||||
then
|
||||
(* ;; "windows with WSL")
|
||||
|
||||
"wslview"
|
||||
elseif (STRPOS "darwin" (OR (UNIX-GETENV "OSTYPE")
|
||||
(UNIX-GETENV "PATH")))
|
||||
then
|
||||
(* ;; " MacOS")
|
||||
|
||||
"open"
|
||||
elseif (INFILEP "{UNIX}/usr/bin/lynx")
|
||||
then (if (INFILEP "{UNIX}/usr/bin/xterm")
|
||||
then "xterm -e lynx"
|
||||
else "lynx")
|
||||
else "git web--browse"])
|
||||
|
||||
(REPO.LOOKUP
|
||||
[LAMBDA (ENTRY TYPES) (* ; "Edited 24-Aug-2022 16:54 by larry")
|
||||
(* ; "Edited 21-Aug-2022 15:54 by lmm")
|
||||
(* ; "Edited 19-Aug-2022 20:18 by lmm")
|
||||
(* ; "Edited 16-Aug-2022 16:26 by lmm")
|
||||
(for FL in (WHEREIS ENTRY (OR TYPES REPO.TYPES)
|
||||
T) bind POS FND
|
||||
when [SETQ FND (OR (FINDFILE-WITH-EXTENSIONS FL NIL '(TEDIT TXT TED))
|
||||
(AND (SETQ POS (STRPOS "-" FL))
|
||||
(FINDFILE-WITH-EXTENSIONS (SUBSTRING FL 1 (CL:1- POS))
|
||||
NIL
|
||||
'(TEDIT TXT TTY TED]
|
||||
join (CL:WITH-OPEN-FILE (STR (PATHNAME FND)
|
||||
:DIRECTION :INPUT)
|
||||
(CL:WHEN (SETQ POS (FFILEPOS ENTRY STR))
|
||||
(TEDIT-SEE STR NIL NIL (CL:FORMAT NIL "~a [~a]" FL ENTRY))
|
||||
(LIST FL))])
|
||||
)
|
||||
|
||||
(RPAQ? CLHS.ROOT.URL "http://clhs.lisp.se/")
|
||||
|
||||
(RPAQ? CLHS.INDEX )
|
||||
|
||||
(RPAQ? CLHS.OPENER )
|
||||
|
||||
(RPAQ? REPO.TYPES '(FNS FUNCTIONS VARS VARIABLES))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS CLHS.INDEX CLHS.OPENER REPO.TYPES CLHS.ROOT.URL)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;;; "Interface to DInfo")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(IRM.GET.DINFOGRAPH
|
||||
[LAMBDA (FROM.BACKGROUND?) (* ; "Edited 14-Aug-87 17:31 by drc:")
|
||||
[LAMBDA (FROM.BACKGROUND?) (* ; "Edited 14-Aug-87 17:31 by drc:")
|
||||
|
||||
(* ;; "returns the DInfo graph for the IRM, ensuring that it has been setup.")
|
||||
|
||||
@@ -207,17 +379,16 @@ Copyright (c) 1985-1987, 2020 by Xerox Corporation.
|
||||
IRM.DINFOGRAPH])
|
||||
|
||||
(IRM.DISPLAY.REF
|
||||
[LAMBDA (REF GRAPH) (* drc%: "18-Jan-86 17:17")
|
||||
[LAMBDA (REF GRAPH) (* ; "Edited 19-Aug-2022 20:21 by lmm")
|
||||
(* drc%: "18-Jan-86 17:17")
|
||||
|
||||
(* * visit the DInfo node of GRAPH containing REF)
|
||||
(* ;;; "visit the DInfo node of GRAPH containing REF")
|
||||
|
||||
(LET [(NODE (FASSOC (fetch (IRMREFERENCE NODE) of REF)
|
||||
(fetch (DINFOGRAPH NODELST) of GRAPH]
|
||||
(if NODE
|
||||
then (DINFO.UPDATE GRAPH NODE (LIST (fetch (IRMREFERENCE ITEM) of REF)
|
||||
(fetch (IRMREFERENCE CH#) of REF)))
|
||||
else (PRINTOUT (GETPROMPTWINDOW WINDOW)
|
||||
T "Node not found!"])
|
||||
(fetch (IRMREFERENCE CH#) of REF])
|
||||
)
|
||||
|
||||
(CL:DEFUN IRM.LOAD-GRAPH ()
|
||||
@@ -250,33 +421,33 @@ Copyright (c) 1985-1987, 2020 by Xerox Corporation.
|
||||
(IRM.DISPLAY.CREF
|
||||
[LAMBDA (IMAGEOBJ STREAM) (* drc%: " 7-Jan-86 13:41")
|
||||
(if (EQ (IMAGESTREAMTYPE STREAM)
|
||||
'DISPLAY)
|
||||
'DISPLAY)
|
||||
then (DSPFONT IRM.CREF.FONT STREAM)
|
||||
(LET* ((STRING (IMAGEOBJPROP IMAGEOBJ 'ITEM))
|
||||
(STRINGREGION (STRINGREGION STRING STREAM))
|
||||
(LEFT (ADD1 (fetch (REGION LEFT) of STRINGREGION)))
|
||||
(BOTTOM (fetch (REGION BOTTOM) of STRINGREGION))
|
||||
(REGION (create REGION
|
||||
LEFT _ LEFT
|
||||
BOTTOM _ BOTTOM
|
||||
HEIGHT _ (IPLUS (fetch (REGION HEIGHT) of STRINGREGION)
|
||||
2)
|
||||
WIDTH _ (IPLUS (fetch (REGION WIDTH) of STRINGREGION)
|
||||
6)))
|
||||
(TOP (fetch (REGION TOP) of REGION))
|
||||
(RIGHT (fetch (REGION RIGHT) of REGION)))
|
||||
(IMAGEOBJPROP IMAGEOBJ 'REGION REGION)
|
||||
(CENTERPRINTINREGION STRING REGION STREAM)
|
||||
(DRAWLINE LEFT BOTTOM LEFT (SUB1 TOP)
|
||||
1
|
||||
'INVERT STREAM)
|
||||
(DRAWLINE LEFT TOP (SUB1 RIGHT)
|
||||
TOP 1 'INVERT STREAM)
|
||||
(DRAWLINE RIGHT TOP RIGHT (ADD1 BOTTOM)
|
||||
1
|
||||
'INVERT STREAM)
|
||||
(DRAWLINE RIGHT BOTTOM (ADD1 LEFT)
|
||||
BOTTOM 1 'INVERT STREAM))
|
||||
(LET* ((STRING (IMAGEOBJPROP IMAGEOBJ 'ITEM))
|
||||
(STRINGREGION (STRINGREGION STRING STREAM))
|
||||
(LEFT (ADD1 (fetch (REGION LEFT) of STRINGREGION)))
|
||||
(BOTTOM (fetch (REGION BOTTOM) of STRINGREGION))
|
||||
(REGION (create REGION
|
||||
LEFT _ LEFT
|
||||
BOTTOM _ BOTTOM
|
||||
HEIGHT _ (IPLUS (fetch (REGION HEIGHT) of STRINGREGION)
|
||||
2)
|
||||
WIDTH _ (IPLUS (fetch (REGION WIDTH) of STRINGREGION)
|
||||
6)))
|
||||
(TOP (fetch (REGION TOP) of REGION))
|
||||
(RIGHT (fetch (REGION RIGHT) of REGION)))
|
||||
(IMAGEOBJPROP IMAGEOBJ 'REGION REGION)
|
||||
(CENTERPRINTINREGION STRING REGION STREAM)
|
||||
(DRAWLINE LEFT BOTTOM LEFT (SUB1 TOP)
|
||||
1
|
||||
'INVERT STREAM)
|
||||
(DRAWLINE LEFT TOP (SUB1 RIGHT)
|
||||
TOP 1 'INVERT STREAM)
|
||||
(DRAWLINE RIGHT TOP RIGHT (ADD1 BOTTOM)
|
||||
1
|
||||
'INVERT STREAM)
|
||||
(DRAWLINE RIGHT BOTTOM (ADD1 LEFT)
|
||||
BOTTOM 1 'INVERT STREAM))
|
||||
else (PRIN1 "page X.XX" STREAM])
|
||||
|
||||
(IRM.CREF.BOX
|
||||
@@ -327,30 +498,27 @@ Copyright (c) 1985-1987, 2020 by Xerox Corporation.
|
||||
(RESETFORM (TTYDISPLAYSTREAM (GETPROMPTWINDOW WINDOW))
|
||||
(BLTSHADE BLACKSHADE WSTREAM 0 0 WIDTH HEIGHT 'INVERT)
|
||||
(bind (N _ 0)
|
||||
(ITEM _ (IMAGEOBJPROP IMAGEOBJ 'ITEM))
|
||||
(TYPE _ (IMAGEOBJPROP IMAGEOBJ 'TYPE))
|
||||
(ITEM _ (IMAGEOBJPROP IMAGEOBJ 'ITEM))
|
||||
(TYPE _ (IMAGEOBJPROP IMAGEOBJ 'TYPE))
|
||||
until [OR (NOT (MOUSESTATE (OR LEFT MIDDLE)))
|
||||
(NOT (INSIDEP REGION (CURSORPOSITION NIL WSTREAM]
|
||||
(NOT (INSIDEP REGION (CURSORPOSITION NIL WSTREAM]
|
||||
do (BLOCK 100)
|
||||
(if (EQ (SETQ N (ADD1 N))
|
||||
10)
|
||||
then (printout T T "Will lookup " (IMAGEOBJPROP IMAGEOBJ
|
||||
'ITEM)
|
||||
(if TYPE
|
||||
then (CONCAT " as a " TYPE ".")
|
||||
else ".")))
|
||||
(GETMOUSESTATE) finally (CLEARW T)
|
||||
(if (INSIDEP REGION (CURSORPOSITION NIL WSTREAM))
|
||||
then (ADD.PROCESS (LIST 'IRM.LOOKUP
|
||||
(KWOTE ITEM)
|
||||
(KWOTE TYPE)
|
||||
(WINDOWPROP
|
||||
WINDOW
|
||||
'DINFOGRAPH))
|
||||
'NAME "IRM Cross Reference"))
|
||||
(BLTSHADE BLACKSHADE WSTREAM 0 0 WIDTH HEIGHT
|
||||
'INVERT)
|
||||
NIL])
|
||||
(if (EQ (SETQ N (ADD1 N))
|
||||
10)
|
||||
then (printout T T "Will lookup " (IMAGEOBJPROP IMAGEOBJ 'ITEM)
|
||||
(if TYPE
|
||||
then (CONCAT " as a " TYPE ".")
|
||||
else ".")))
|
||||
(GETMOUSESTATE) finally (CLEARW T)
|
||||
(if (INSIDEP REGION (CURSORPOSITION NIL WSTREAM))
|
||||
then (ADD.PROCESS (LIST 'IRM.LOOKUP (KWOTE ITEM)
|
||||
(KWOTE TYPE)
|
||||
(WINDOWPROP WINDOW
|
||||
'DINFOGRAPH))
|
||||
'NAME "IRM Cross Reference"))
|
||||
(BLTSHADE BLACKSHADE WSTREAM 0 0 WIDTH HEIGHT
|
||||
'INVERT)
|
||||
NIL])
|
||||
)
|
||||
|
||||
(RPAQ? IRM.CREF.FONT (FONTCREATE 'MODERN 8 'MRR))
|
||||
@@ -373,144 +541,102 @@ Copyright (c) 1985-1987, 2020 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(\IRM.GET.REF
|
||||
[LAMBDA (KEYWORD TYPE WINDOW) (* drc%: "18-Jan-86 17:13")
|
||||
[LAMBDA (KEYWORD TYPE) (* ; "Edited 19-Aug-2022 20:00 by lmm")
|
||||
(* drc%: "18-Jan-86 17:13")
|
||||
|
||||
(* * Returns an IRMREFERENCE for KEYWORD of optionally specified TYPE.)
|
||||
(* ;;; "Returns an IRMREFERENCE for KEYWORD of optionally specified TYPE.")
|
||||
|
||||
(\IRM.GET.HASHFILE)
|
||||
|
||||
(* ;; "keywords in hashfile are all uppercased -- makes lookup case insensitive;")
|
||||
|
||||
(\IRM.GET.HASHFILE) (* keywords in hashfile are all
|
||||
uppercased -- make's lookup case
|
||||
insensitive)
|
||||
(SETQ KEYWORD (MKATOM (U-CASE KEYWORD)))
|
||||
(LET (SAMEFLG REFS)
|
||||
(SETQ REFS (if (EQ KEYWORD (WINDOWPROP WINDOW 'PREVIOUS.KEYWORD))
|
||||
then (* same keyword as last time, so
|
||||
fetch cached refs)
|
||||
(SETQ SAMEFLG T)
|
||||
(WINDOWPROP WINDOW 'IRM.REFS)
|
||||
else (CLEARW T)
|
||||
(PRINTOUT T "Fetching reference(s) for " KEYWORD "...")
|
||||
(* hashfile contains a list of
|
||||
IRMREFERENCES for each keyword)
|
||||
(GETHASHFILE KEYWORD \IRM.HASHFILE)))
|
||||
(WINDOWPROP WINDOW 'PREVIOUS.KEYWORD KEYWORD)
|
||||
(WINDOWPROP WINDOW 'IRM.REFS REFS)
|
||||
(LET ((REFS (GETHASHFILE KEYWORD \IRM.HASHFILE)))
|
||||
(COND
|
||||
((NULL REFS)
|
||||
(PRINTOUT T "None found.")
|
||||
NIL)
|
||||
((NULL TYPE)
|
||||
(PRINTOUT T "OK.")
|
||||
(\IRM.CHOOSE.REF REFS KEYWORD))
|
||||
((for REF in REFS thereis (if (AND (EQ (fetch (IRMREFERENCE TYPE)
|
||||
of REF)
|
||||
TYPE)
|
||||
(fetch (IRMREFERENCE PRIMARYFLG)
|
||||
of REF))
|
||||
then (PRINTOUT T "OK.")
|
||||
REF)))
|
||||
((SETQ REFS (for REF in REFS join (if (EQ (fetch (IRMREFERENCE TYPE)
|
||||
of REF)
|
||||
TYPE)
|
||||
then (LIST REF)
|
||||
else NIL)))
|
||||
(PRINTOUT T "OK.")
|
||||
(\IRM.CHOOSE.REF REFS KEYWORD))
|
||||
(T (PRINTOUT T "none found of type " TYPE ".")
|
||||
NIL])
|
||||
((for REF in REFS thereis (if (AND (EQ (fetch (IRMREFERENCE TYPE) of REF)
|
||||
TYPE)
|
||||
(fetch (IRMREFERENCE PRIMARYFLG) of REF))
|
||||
then REF)))
|
||||
((SETQ REFS (for REF in REFS join (if (EQ (fetch (IRMREFERENCE TYPE) of REF)
|
||||
TYPE)
|
||||
then (LIST REF)
|
||||
else NIL)))
|
||||
(\IRM.CHOOSE.REF REFS KEYWORD])
|
||||
|
||||
(\IRM.SMART.REF
|
||||
[LAMBDA (KEYWORD WINDOW) (* drc%: "18-Jan-86 17:40")
|
||||
[LAMBDA (KEYWORD) (* ; "Edited 19-Aug-2022 20:46 by lmm")
|
||||
(* drc%: "18-Jan-86 17:40")
|
||||
|
||||
(* * Returns IRMREFERENCE for KEYWORD. Allows wildcards in KEYWORD, and will
|
||||
try spelling correction.)
|
||||
(* ;;;
|
||||
"Returns IRMREFERENCE for KEYWORD. Allows wildcards in KEYWORD, and will try spelling correction.")
|
||||
|
||||
(if (while [SETQ POS (STRPOS "*" KEYWORD (AND POS (ADD1 POS] bind POS
|
||||
when (NEQ (NTHCHAR KEYWORD (SUB1 POS))
|
||||
'%') do (RETURN T)
|
||||
finally (* if not doing wildcarding then
|
||||
remove quotes when preceding
|
||||
asterisks)
|
||||
[SETQ KEYWORD (PACK (for TAIL on (UNPACK KEYWORD)
|
||||
when [NOT (AND (EQ (CAR TAIL)
|
||||
'%')
|
||||
(EQ (CADR TAIL)
|
||||
'*] collect (CAR TAIL]
|
||||
(RETURN NIL))
|
||||
then (* there's an unquoted asterisk --
|
||||
it's wildcardin' time!)
|
||||
(\IRM.WILD.REF KEYWORD WINDOW)
|
||||
when (NEQ (NTHCHAR KEYWORD (SUB1 POS))
|
||||
'%') do (RETURN T)
|
||||
finally (* ;
|
||||
"if not doing wildcarding then remove quotes when preceding asterisks")
|
||||
[SETQ KEYWORD (PACK (for TAIL on (UNPACK KEYWORD)
|
||||
when [NOT (AND (EQ (CAR TAIL)
|
||||
'%')
|
||||
(EQ (CADR TAIL)
|
||||
'*] collect (CAR TAIL]
|
||||
(RETURN NIL))
|
||||
then (* ;
|
||||
"there's an unquoted asterisk -- it's wildcardin' time!")
|
||||
(\IRM.WILD.REF KEYWORD)
|
||||
elseif \IRM.KEYWORDS
|
||||
then (* we've got possible matches
|
||||
loaded, so try spelling correction)
|
||||
(RESETFORM (TTY.PROCESS (THIS.PROCESS))
|
||||
(LET ((CORRECTED (MISSPELLED? KEYWORD 50 \IRM.KEYWORDS T)))
|
||||
(if CORRECTED
|
||||
then (\IRM.GET.REF CORRECTED NIL WINDOW)
|
||||
else (PRINTOUT T T KEYWORD " Not in IRM")
|
||||
NIL)))
|
||||
else (* default to normal lookup)
|
||||
(\IRM.GET.REF KEYWORD NIL WINDOW])
|
||||
then (* ;
|
||||
"we've got possible matches loaded, so try spelling correction")
|
||||
[RESETFORM (TTY.PROCESS (THIS.PROCESS))
|
||||
(LET ((CORRECTED (MISSPELLED? KEYWORD 50 \IRM.KEYWORDS T)))
|
||||
(if CORRECTED
|
||||
then (\IRM.GET.REF CORRECTED]
|
||||
else (* ; "default to normal lookup")
|
||||
(\IRM.GET.REF KEYWORD])
|
||||
|
||||
(\IRM.CHOOSE.REF
|
||||
[LAMBDA (REFS KEYWORD) (* drc%: " 8-Jan-86 15:23")
|
||||
(if (NULL (CDR REFS))
|
||||
then (CAR REFS)
|
||||
else (MENU (create MENU
|
||||
CENTERFLG _ T
|
||||
TITLE _ (MKSTRING KEYWORD)
|
||||
ITEMS _ (for REF in REFS
|
||||
collect (LIST (LET ((TYPE (fetch (IRMREFERENCE TYPE)
|
||||
of REF)))
|
||||
(if (fetch (IRMREFERENCE
|
||||
PRIMARYFLG)
|
||||
of REF)
|
||||
then (PACK* "* " TYPE " *")
|
||||
else TYPE))
|
||||
(KWOTE REF)
|
||||
(CONCAT "Lookup " KEYWORD " as "
|
||||
(fetch (IRMREFERENCE TYPE)
|
||||
of REF])
|
||||
CENTERFLG _ T
|
||||
TITLE _ (MKSTRING KEYWORD)
|
||||
ITEMS _ (for REF in REFS
|
||||
collect (LIST (LET ((TYPE (fetch (IRMREFERENCE TYPE) of REF)))
|
||||
(if (fetch (IRMREFERENCE PRIMARYFLG)
|
||||
of REF)
|
||||
then (PACK* "* " TYPE " *")
|
||||
else TYPE))
|
||||
(KWOTE REF)
|
||||
(CONCAT "Lookup " KEYWORD " as " (fetch (
|
||||
IRMREFERENCE
|
||||
TYPE)
|
||||
of REF])
|
||||
|
||||
(\IRM.WILD.REF
|
||||
[LAMBDA (KEYWORD WINDOW) (* drc%: "18-Jan-86 17:04")
|
||||
[LAMBDA (KEYWORD) (* ; "Edited 19-Aug-2022 20:31 by lmm")
|
||||
(* drc%: "18-Jan-86 17:04")
|
||||
|
||||
(* * Return IRMREFERENCE matching wildcarded KEYWORD.)
|
||||
(* ;; "Return IRMREFERENCE matching wildcarded KEYWORD.")
|
||||
|
||||
(OPENW WINDOW)
|
||||
(LET* [SAMEFLG (MATCHES (if (EQ KEYWORD (WINDOWPROP WINDOW 'IRM.WILD.KEYWORD))
|
||||
then (* same as last time we wildcarded
|
||||
-- used cached matches.)
|
||||
(SETQ SAMEFLG T)
|
||||
(WINDOWPROP WINDOW 'IRM.MATCHES)
|
||||
else (PROG2 (PRINTOUT (GETPROMPTWINDOW WINDOW)
|
||||
"...Matching wildcard(s)...")
|
||||
(\IRM.WILDCARD KEYWORD (\IRM.GET.KEYWORDS
|
||||
WINDOW))
|
||||
(PRINTOUT (GETPROMPTWINDOW WINDOW)
|
||||
"OK"]
|
||||
(WINDOWPROP WINDOW 'IRM.WILD.KEYWORD KEYWORD)
|
||||
(WINDOWPROP WINDOW 'IRM.MATCHES MATCHES)
|
||||
(LET* ((MATCHES (\IRM.WILDCARD KEYWORD)))
|
||||
(if MATCHES
|
||||
then [if (NULL (CDR MATCHES))
|
||||
then (\IRM.GET.REF (CAR MATCHES)
|
||||
NIL WINDOW)
|
||||
else (OR SAMEFLG (WINDOWPROP WINDOW 'WILD.MENU
|
||||
(create MENU
|
||||
ITEMS _
|
||||
(for MATCH in MATCHES
|
||||
collect (LIST MATCH (KWOTE MATCH)
|
||||
(CONCAT
|
||||
"Will lookup "
|
||||
MATCH
|
||||
" in IRM if selected."
|
||||
)))
|
||||
CENTERFLG _ T
|
||||
TITLE _ KEYWORD)))
|
||||
(LET [(CHOICE (MENU (WINDOWPROP WINDOW 'WILD.MENU]
|
||||
(AND CHOICE (\IRM.GET.REF CHOICE NIL WINDOW]
|
||||
else (PRINTOUT (GETPROMPTWINDOW WINDOW)
|
||||
T "No matches found for " KEYWORD)
|
||||
NIL])
|
||||
then (if (NULL (CDR MATCHES))
|
||||
then (\IRM.GET.REF (CAR MATCHES))
|
||||
else (LET [(CHOICE (MENU (create MENU
|
||||
ITEMS _
|
||||
(for MATCH in MATCHES
|
||||
collect (LIST MATCH (KWOTE MATCH)
|
||||
(CONCAT "Will lookup " MATCH
|
||||
" in IRM if selected."))
|
||||
)
|
||||
CENTERFLG _ T
|
||||
TITLE _ KEYWORD]
|
||||
(AND CHOICE (\IRM.GET.REF CHOICE])
|
||||
|
||||
(\IRM.WILDCARD
|
||||
[LAMBDA (WILDATOM LIST) (* drc%: "18-Jan-86 17:00")
|
||||
@@ -519,8 +645,7 @@ Copyright (c) 1985-1987, 2020 by Xerox Corporation.
|
||||
|
||||
(LET ((SCRATCH (CONS))
|
||||
(WILDLIST (UNPACK WILDATOM)))
|
||||
(for ATOM in LIST when (\IRM.WILD.MATCH WILDLIST (DUNPACK ATOM SCRATCH))
|
||||
collect ATOM])
|
||||
(for ATOM in LIST when (\IRM.WILD.MATCH WILDLIST (DUNPACK ATOM SCRATCH)) collect ATOM])
|
||||
|
||||
(\IRM.WILD.MATCH
|
||||
[LAMBDA (WILDLIST LIST) (* drc%: "18-Jan-86 16:59")
|
||||
@@ -535,17 +660,17 @@ Copyright (c) 1985-1987, 2020 by Xerox Corporation.
|
||||
(EQ (CADR WILDLIST)
|
||||
'*)) (* found a quoted asterisk)
|
||||
(if (EQ '* (CAR LIST))
|
||||
then (* and it matches)
|
||||
(\IRM.WILD.MATCH (CDDR WILDLIST)
|
||||
(CDR LIST]
|
||||
then (* and it matches)
|
||||
(\IRM.WILD.MATCH (CDDR WILDLIST)
|
||||
(CDR LIST]
|
||||
[(EQ (CAR WILDLIST)
|
||||
'*) (* found a real wildcard)
|
||||
(OR (NULL (CDR WILDLIST))
|
||||
(for TAIL on LIST thereis (\IRM.WILD.MATCH (CDR WILDLIST)
|
||||
TAIL]
|
||||
TAIL]
|
||||
((EQ (CAR WILDLIST)
|
||||
(CAR LIST)) (* first chars match --
|
||||
keep checking)
|
||||
keep checking)
|
||||
(\IRM.WILD.MATCH (CDR WILDLIST)
|
||||
(CDR LIST)))
|
||||
(T NIL])
|
||||
@@ -559,13 +684,12 @@ Copyright (c) 1985-1987, 2020 by Xerox Corporation.
|
||||
'INPUT])
|
||||
|
||||
(\IRM.GET.KEYWORDS
|
||||
[LAMBDA (WINDOW QUIETFLG) (* drc%: "18-Jan-86 17:14")
|
||||
[LAMBDA NIL (* ; "Edited 19-Aug-2022 20:33 by lmm")
|
||||
(* drc%: "18-Jan-86 17:14")
|
||||
|
||||
(* * keyword list is hidden in hashfile as its key is in lower case)
|
||||
(* ;;; "keyword list is hidden in hashfile as its key is in lower case")
|
||||
|
||||
(OR \IRM.KEYWORDS (PROGN (PRINTOUT (GETPROMPTWINDOW WINDOW)
|
||||
"Loading keyword list...")
|
||||
(\IRM.GET.HASHFILE)
|
||||
(OR \IRM.KEYWORDS (PROGN (\IRM.GET.HASHFILE)
|
||||
(SETQ \IRM.KEYWORDS (GETHASHFILE 'irm.keywords (\IRM.GET.HASHFILE])
|
||||
)
|
||||
|
||||
@@ -584,14 +708,15 @@ Copyright (c) 1985-1987, 2020 by Xerox Corporation.
|
||||
(ADDTOVAR AROUNDEXITFNS \IRM.AROUND-EXIT)
|
||||
|
||||
(PUTPROPS HELPSYS FILETYPE :FAKE-COMPILE-FILE)
|
||||
(PUTPROPS HELPSYS COPYRIGHT ("Xerox Corporation" 1985 1986 1987 2020))
|
||||
(PUTPROPS HELPSYS COPYRIGHT ("Xerox Corporation" 1985 1986 1987 2020 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4215 8066 (HELPSYS 4225 . 6029) (IRM.LOOKUP 6031 . 7487) (IRM.SMART.LOOKUP 7489 . 7645)
|
||||
(IRM.RESET 7647 . 8064)) (8313 9832 (IRM.GET.DINFOGRAPH 8323 . 9194) (IRM.DISPLAY.REF 9196 . 9830)) (
|
||||
9834 10196 (IRM.LOAD-GRAPH 9834 . 10196)) (10521 16370 (IRM.DISPLAY.CREF 10531 . 12274) (IRM.CREF.BOX
|
||||
12276 . 13103) (IRM.PUT.CREF 13105 . 13330) (IRM.GET.CREF 13332 . 13703) (IRM.CREF.BUTTONEVENTFN 13705
|
||||
. 16368)) (16925 28473 (\IRM.GET.REF 16935 . 19689) (\IRM.SMART.REF 19691 . 21812) (\IRM.CHOOSE.REF
|
||||
21814 . 23160) (\IRM.WILD.REF 23162 . 25904) (\IRM.WILDCARD 25906 . 26284) (\IRM.WILD.MATCH 26286 .
|
||||
27524) (\IRM.GET.HASHFILE 27526 . 27989) (\IRM.GET.KEYWORDS 27991 . 28471)) (28610 28766 (
|
||||
\IRM.AROUND-EXIT 28610 . 28766)))))
|
||||
(FILEMAP (NIL (4617 10192 (HELPSYS 4627 . 6468) (IRM.LOOKUP 6470 . 8108) (GENERIC.MAN.LOOKUP 8110 .
|
||||
9779) (IRM.RESET 9781 . 10190)) (10449 17454 (CLHS.INDEX 10459 . 13157) (CLHS.LOOKUP 13159 . 14957) (
|
||||
CLHS.OPENER 14959 . 16282) (REPO.LOOKUP 16284 . 17452)) (17748 19266 (IRM.GET.DINFOGRAPH 17758 . 18633
|
||||
) (IRM.DISPLAY.REF 18635 . 19264)) (19268 19630 (IRM.LOAD-GRAPH 19268 . 19630)) (19955 25459 (
|
||||
IRM.DISPLAY.CREF 19965 . 21679) (IRM.CREF.BOX 21681 . 22508) (IRM.PUT.CREF 22510 . 22735) (
|
||||
IRM.GET.CREF 22737 . 23108) (IRM.CREF.BUTTONEVENTFN 23110 . 25457)) (26014 34320 (\IRM.GET.REF 26024
|
||||
. 27355) (\IRM.SMART.REF 27357 . 29284) (\IRM.CHOOSE.REF 29286 . 30537) (\IRM.WILD.REF 30539 . 31794)
|
||||
(\IRM.WILDCARD 31796 . 32162) (\IRM.WILD.MATCH 32164 . 33394) (\IRM.GET.HASHFILE 33396 . 33859) (
|
||||
\IRM.GET.KEYWORDS 33861 . 34318)) (34457 34613 (\IRM.AROUND-EXIT 34457 . 34613)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Reference in New Issue
Block a user