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

Compatibility--keyword action names

Browse Source
This commit is contained in:
rmkaplan
2025-11-12 23:16:52 -08:00
parent 0bfc2958df
commit 49dd3a2583
2 changed files with 125 additions and 102 deletions
Download Patch File Download Diff File Expand all files Collapse all files

227
lispusers/TEDIT-PF-SEE
View File

@@ -1,25 +1,23 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Jul-2025 22:01:56" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>TEDIT-PF-SEE.;150 11962
(FILECREATED "12-Nov-2025 15:49:07" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;156 13422
:EDIT-BY rmk
:CHANGES-TO (FNS PF-TEDIT)
:CHANGES-TO (VARS TEDIT-PF-SEECOMS)
:PREVIOUS-DATE "29-Jul-2025 18:07:48"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>TEDIT-PF-SEE.;149)
:PREVIOUS-DATE "26-Sep-2025 22:53:59" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;155)
(PRETTYCOMPRINT TEDIT-PF-SEECOMS)
(RPAQQ TEDIT-PF-SEECOMS
[(FNS PF-TEDIT PF-TEDIT-FROM-TEXT)
(COMMANDS ts tf)
(COMMANDS ts tf tc tv tr)
(FILES (SYSLOAD)
REGIONMANAGER VERSIONDEFS)
(ALISTS (TEDIT.CHARACTIONS TEDIT-PF)
(TEDIT.CHARBINDINGS TEDIT-PF))
(ALISTS (TEDIT.CHARACTIONS :TEDIT-PF)
(TEDIT.CHARBINDINGS :TEDIT-PF))
(P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
(MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION))
(TEDIT.INSTALL.CHARBINDINGS))
@@ -29,7 +27,9 @@
(DEFINEQ
(PF-TEDIT
[LAMBDA (FN IFILES VERSION REPRINT) (* ; "Edited 29-Jul-2025 22:01 by rmk")
[LAMBDA (ITEM IFILES VERSION REPRINT TYPE) (* ; "Edited 23-Sep-2025 11:24 by rmk")
(* ; "Edited 20-Sep-2025 08:56 by rmk")
(* ; "Edited 29-Jul-2025 22:01 by rmk")
(* ; "Edited 29-Jun-2025 16:18 by rmk")
(* ; "Edited 14-Apr-2025 22:00 by rmk")
(* ; "Edited 26-Mar-2025 10:08 by rmk")
@@ -46,24 +46,24 @@
(* ; "Edited 12-Jan-2022 13:15 by rmk")
(* ; "Edited 30-Dec-2021 23:17 by rmk")
(* ;; "PF* to a read-only TEDIT window. First argument is the function name, second if given is the input file.")
(* ;; "Shows ITEM of type TYPE in a scrollable read-only TEDIT window. First argument is the item name, second if given is the input file.")
(* ;; "This uses PFCOPYBYTES so we see what it looks like on the file. But some functions were not prettyprinted, so they appear as useless garbage.")
(* ;; "In that case, calling again with REPRINT=T will read and reprint. And, invoking tf again with no arguments at all will also reprint the last function in the same window")
(* ;; "Calling again with REPRINT=T (or ITEM=T) will read and reprint the same item. And, calling again with no arguments at all will also reprint the last item in the same window")
(SETQ IFILES (MKLIST IFILES))
(CL:WHEN (LISTP FN)
(SETQ FN (CAR FN)))
(SELECTQ FN
(CL:WHEN (INTERSECTION TYPE '(FNS FUNCTIONS))
(SETQ TYPE NIL))
(CL:WHEN (INTERSECTION TYPE '(FNS FUNCTIONS))
(SETQ TYPE NIL))
(SELECTQ ITEM
((t T NIL)
(SETQ REPRINT T)
(SETQ FN LASTWORD))
(if (VERSIONP FN)
then (SETQ IFILES (CONS FN))
(SETQ FN LASTWORD)
else (SETQ LASTWORD FN)))
(CL:UNLESS FN (ERROR "No function to print"))
(SETQ ITEM LASTWORD))
(if (VERSIONP ITEM)
then (SETQ IFILES (CONS ITEM))
(SETQ ITEM LASTWORD)
else (SETQ LASTWORD ITEM)))
(CL:UNLESS ITEM (ERROR "No function to print"))
(CL:WHEN (AND (VERSIONP IFILES)
(NULL VERSION))
(SETQ VERSION IFILES)
@@ -73,91 +73,107 @@
(SETQ REPRINT T)
[SETQ IFILES (LDIFFERENCE IFILES '(t T])
(CL:UNLESS IFILES
(SETQ IFILES (WHEREIS FN '(FNS FUNCTIONS)
T)))
[SETQ IFILES (OR (WHEREIS ITEM TYPE T)
(AND (NULL TYPE)
(WHEREIS ITEM 'MACROS T])
(if IFILES
then (* ; "skip compiled files")
then (for IFILE TSTREAM DEF TFPROP WINDOW inside IFILES
eachtime (SETQ IFILE (if (CL:IF (VERSIONP IFILE)
(FINDFILEVERSION (CAR (WHEREIS ITEM TYPE T))
IFILE)
(FINDFILE IFILE T))
else (printout T "file " IFILE " not found." T)
(GO $$ITERATE))) unless (MEMB (FILENAMEFIELD IFILE
'EXTENSION)
*COMPILED-EXTENSIONS*)
do (CL:UNLESS [SETQ DEF (CL:IF TYPE
(GETDEF ITEM TYPE IFILE 'NOERROR)
(OR (GETDEF ITEM 'FNS IFILE 'NOERROR)
(GETDEF ITEM 'FUNCTIONS IFILE 'NOERROR)
(GETDEF ITEM 'MACROS IFILE 'NOERROR)))]
(printout T ITEM " not found on " IFILE "." T)
(GO $$ITERATE))
(* ;; "Since we are creating readonly Tedits, try to keep the TTY where it is.")
(* ;; "We found ITEM of TYPE on IFILE")
(for IFILE LOC TSTREAM ENV EXPR TFPROP WINDOW inside IFILES
eachtime (CL:IF (VERSIONP IFILE)
(SETQ IFILE (FINDFILEVERSION (CAR (WHEREIS FN NIL T))
IFILE))) unless (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
*COMPILED-EXTENSIONS*)
do
(SETQ LOC (FINDFNDEF FN IFILE))
(if (LISTP LOC)
then (SETQ TFPROP (LIST FN (CAR LOC)))
[SETQ WINDOW (find W in (OPENWINDOWS)
suchthat (AND (EQUAL TFPROP (WINDOWPROP W 'TF))
(TEXTSTREAM W T]
[if (AND WINDOW (NOT REPRINT))
then
(* ;;
 "If already an open PF window on this function in this file, just raise it to the top")
(SETQ TFPROP (LIST ITEM TYPE IFILE))
[SETQ WINDOW (find W in (OPENWINDOWS)
suchthat (AND (EQUAL TFPROP (WINDOWPROP W 'TF))
(TEXTSTREAM W T]
(CL:WHEN (AND WINDOW (NOT REPRINT))
(TOTOPW WINDOW)
(RETURN)
else (CL:WITH-OPEN-FILE
(ISTREAM (POP LOC)
:DIRECTION :INPUT)
(SETQ ENV (LISPSOURCEFILEP ISTREAM))
(SETFILEINFO ISTREAM 'FORMAT ENV)
[SETQ TSTREAM (OPENTEXTSTREAM
NIL NIL `(PARABREAKCHARS NIL OPENWIDTH
,(TIMES TEDIT.SOURCE.LINELENGTH
(CHARWIDTH (CHARCODE SPACE)
DEFAULTFONT]
(DSPFONT DEFAULTFONT TSTREAM)
(PRINTOUT TSTREAM 5 "[From " (FULLNAME ISTREAM)
"]" T)
(PRINT-READER-ENVIRONMENT ENV TSTREAM)
(if REPRINT
then (SETFILEPTR ISTREAM (POP LOC))
(SETQ EXPR (WITH-READER-ENVIRONMENT ENV (READ ISTREAM)))
(WITH-READER-ENVIRONMENT ENV
(if (EQ FN (CAR EXPR))
then (DSPFONT BOLDFONT TSTREAM)
(PRINT FN TSTREAM)
(DSPFONT DEFAULTFONT TSTREAM)
(SETQ EXPR (CADR EXPR))
(PRINTDEF EXPR 3 T NIL NIL TSTREAM)
elseif (EQ FN (CADR EXPR))
then
(* ;;
 "Presumably a DEFUN. Print the CAR, boldface the cadr")
(* ;;
 "If already an open window on this item in this file, just raise it to the top")
(PRINTOUT TSTREAM "(" .P2 (CAR EXPR)
" " .FONT BOLDFONT .P2 (CADR EXPR)
.FONT DEFAULTFONT " " .P2 (CADDR EXPR)
T 3)
(PRINTDEF (CDDDR EXPR)
3 T T NIL TSTREAM)
(PRIN3 ")" TSTREAM)
else (PRINTDEF EXPR 3 NIL NIL NIL TSTREAM)))
else (PFI.MAYBE.PP.DEFINITION ISTREAM TSTREAM (POP LOC)
(POP LOC)))
(TERPRI TSTREAM)
[TEDIT TSTREAM (OR WINDOW 'TF)
NIL
`(READONLY T TITLE ,(CONCAT FN " from " (FULLNAME ISTREAM))
ITEM-NAME
,FN BOUNDTABLE ,(TEDIT.ATOMBOUND.READTABLE *READTABLE*]
(TOTOPW WINDOW)
(RETURN))
[SETQ TSTREAM (OPENTEXTSTREAM NIL NIL
`(PARABREAKCHARS NIL OPENWIDTH
,(TIMES TEDIT.SOURCE.LINELENGTH (CHARWIDTH
(CHARCODE SPACE)
DEFAULTFONT]
(CL:WITH-OPEN-FILE (ISTREAM IFILE :DIRECTION :INPUT)
(* ; "Print the reader environment")
(PRINTOUT TSTREAM .FONT DEFAULTFONT 5)
(PRINT-READER-ENVIRONMENT (LISPSOURCEFILEP ISTREAM)
TSTREAM))
(DSPFONT DEFAULTFONT TSTREAM)
[if (FNTYP DEF)
then (PRINTOUT TSTREAM "(" .FONT BOLDFONT .P2 ITEM " " .FONT DEFAULTFONT)
(PRINTDEF DEF 3 T NIL NIL TSTREAM)
(PRIN3 ")" TSTREAM)
elseif (SELECTQ (CAR DEF)
((CL:DEFUN DEFMACRO) (* ; "Could look at :DEFINITION-NAME for definers in general, but we still have to pick out the arguments here (CADDR).")
(PRINTOUT TSTREAM "(" .P2 (CAR DEF)
" " .FONT BOLDFONT .P2 (CADR DEF)
.FONT DEFAULTFONT " " .P2 (CADDR DEF))
(PRINTDEF (CDDDR DEF)
3 T T NIL TSTREAM)
(PRIN3 ")" TSTREAM))
(if (EQ ITEM (CAR DEF))
then (PRINTOUT TSTREAM "(" .FONT BOLDFONT .P2 ITEM .FONT
DEFAULTFONT)
(PRINTDEF (CADR DEF)
3
(NOT TYPE)
NIL NIL TSTREAM)
(PRIN3 ")" TSTREAM)
elseif (EQ ITEM (CADR DEF))
then (PRINTOUT TSTREAM "(" .P2 (CAR DEF)
" " .FONT BOLDFONT .P2 ITEM .FONT DEFAULTFONT)
(PRINTDEF (CDDR DEF)
3
(NEQ TYPE 'VARS)
T NIL TSTREAM)
(PRIN3 ")" TSTREAM)
else (PRINTOUT TSTREAM .FONT BOLDFONT .P2 ITEM ":" .FONT
DEFAULTFONT)
(PRINTDEF DEF 3 (NOT TYPE)
NIL NIL TSTREAM]
(TERPRI TSTREAM)
(* ;; "The windowprop allows for reprinting as a window action, or reprinting from a command that can find and reuse the previous (presumably unprettied) window.")
(* ;; "Since we are creating readonly Tedits, try to keep the TTY where it is.")
(WINDOWPROP (WFROMDS TSTREAM)
'TF TFPROP)
(TOTOPW (WFROMDS TSTREAM]
elseif (EQ LOC 'FILE.NOT.FOUND)
then (printout T "file " IFILE " not found." T)
else (printout T FN " not found on " LOC "." T)))
(SETQ *LAST-DF* FN)
else (PRINTOUT T FN " has no function definition" T])
[TEDIT TSTREAM (OR WINDOW 'TF)
NIL
`(READONLY T TITLE ,(CONCAT ITEM " from " IFILE)
ITEM-NAME
,ITEM BOUNDTABLE ,(TEDIT.ATOMBOUND.READTABLE *READTABLE*]
(* ;; "The windowprop allows for reprinting as a window action, or reprinting from a command that can find and reuse the previous (presumably unprettied) window.")
(WINDOWPROP (WFROMDS TSTREAM)
'TF TFPROP)
(TOTOPW (WFROMDS TSTREAM)))
(SETQ *LAST-DF* ITEM)
else (PRINTOUT T ITEM " has no " (CL:IF TYPE
(L-CASE TYPE)
"function")
" definition" T])
(PF-TEDIT-FROM-TEXT
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 14-Apr-2025 21:59 by rmk")
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 23-Sep-2025 23:28 by rmk")
(* ; "Edited 14-Apr-2025 21:59 by rmk")
(* ; "Edited 7-Apr-2025 23:03 by rmk")
(* ; "Edited 5-Dec-2024 22:20 by rmk")
(* ; "Edited 26-Aug-2024 23:13 by rmk")
@@ -175,7 +191,7 @@
ALLFILES)
(if (EQ 0 (NCHARS FN))
then (TEDIT.PROMPTPRINT TSTREAM "Please select a function to display" T)
elseif (SETQ ALLFILES (WHEREIS FN '(FNS FUNCTIONS)
elseif (SETQ ALLFILES (WHEREIS FN '(FNS FUNCTIONS MACROS)
T))
then (PF-TEDIT FN (CAR (OR (MEMB (FILENAMEFIELD THISFILE)
ALLFILES)
@@ -197,12 +213,19 @@
(DEFCOMMAND tf (FN FILE VERSION) (PF-TEDIT FN FILE VERSION))
(DEFCOMMAND tc (ITEM FILE VERSION) (PF-TEDIT (FILECOMS ITEM)
FILE VERSION T 'VARS))
(DEFCOMMAND tv (ITEM FILE VERSION) (PF-TEDIT ITEM FILE VERSION T 'VARS))
(DEFCOMMAND tr (ITEM FILE VERSION) (PF-TEDIT ITEM FILE VERSION T 'RECORDS))
(FILESLOAD (SYSLOAD)
REGIONMANAGER VERSIONDEFS)
(ADDTOVAR TEDIT.CHARACTIONS (TEDIT-PF PF-TEDIT-FROM-TEXT))
(ADDTOVAR TEDIT.CHARACTIONS (:TEDIT-PF PF-TEDIT-FROM-TEXT))
(ADDTOVAR TEDIT.CHARBINDINGS (TEDIT-PF "Meta,t" "Meta,T"))
(ADDTOVAR TEDIT.CHARBINDINGS (:TEDIT-PF "Meta,t" "Meta,T"))
(MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
@@ -218,5 +241,5 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1080 10900 (PF-TEDIT 1090 . 9166) (PF-TEDIT-FROM-TEXT 9168 . 10898)))))
(FILEMAP (NIL (1018 12068 (PF-TEDIT 1028 . 10218) (PF-TEDIT-FROM-TEXT 10220 . 12066)))))
STOP

BIN
lispusers/TEDIT-PF-SEE.LCOM
View File

Binary file not shown.