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

Remove the LEAVETTY from the PF-TEDIT Tedit window (#2260)

Browse Source
This commit is contained in:
rmkaplan
2025-08-15 13:42:57 -07:00
committed by GitHub
parent 92a3cea0eb
commit 4fef217c45
2 changed files with 38 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

72
lispusers/TEDIT-PF-SEE
View File

@@ -1,12 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Apr-2025 22:00:54" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;141 11757 (FILECREATED "29-Jul-2025 22:01:56" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>TEDIT-PF-SEE.;150 11962
:EDIT-BY rmk :EDIT-BY rmk
:CHANGES-TO (FNS PF-TEDIT PF-TEDIT-FROM-TEXT) :CHANGES-TO (FNS PF-TEDIT)
:PREVIOUS-DATE " 7-Apr-2025 23:03:54" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;140) :PREVIOUS-DATE "29-Jul-2025 18:07:48"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>TEDIT-PF-SEE.;149)
(PRETTYCOMPRINT TEDIT-PF-SEECOMS) (PRETTYCOMPRINT TEDIT-PF-SEECOMS)
@@ -27,7 +29,9 @@
(DEFINEQ (DEFINEQ
(PF-TEDIT (PF-TEDIT
[LAMBDA (FN IFILES VERSION REPRINT) (* ; "Edited 14-Apr-2025 22:00 by rmk") [LAMBDA (FN IFILES VERSION REPRINT) (* ; "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") (* ; "Edited 26-Mar-2025 10:08 by rmk")
(* ; "Edited 18-Feb-2025 23:39 by rmk") (* ; "Edited 18-Feb-2025 23:39 by rmk")
(* ; "Edited 6-Dec-2024 19:15 by rmk") (* ; "Edited 6-Dec-2024 19:15 by rmk")
@@ -71,31 +75,31 @@
(CL:UNLESS IFILES (CL:UNLESS IFILES
(SETQ IFILES (WHEREIS FN '(FNS FUNCTIONS) (SETQ IFILES (WHEREIS FN '(FNS FUNCTIONS)
T))) T)))
(IF IFILES (if IFILES
THEN (* ; "skip compiled files") then (* ; "skip compiled files")
(* ;; "Since we are creating readonly Tedits, try to keep the TTY where it is.") (* ;; "Since we are creating readonly Tedits, try to keep the TTY where it is.")
(FOR IFILE LOC TSTREAM ENV EXPR TFPROP WINDOW INSIDE IFILES (for IFILE LOC TSTREAM ENV EXPR TFPROP WINDOW inside IFILES
EACHTIME (CL:IF (VERSIONP IFILE) eachtime (CL:IF (VERSIONP IFILE)
(SETQ IFILE (FINDFILEVERSION (CAR (WHEREIS FN NIL T)) (SETQ IFILE (FINDFILEVERSION (CAR (WHEREIS FN NIL T))
IFILE))) UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION) IFILE))) unless (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
*COMPILED-EXTENSIONS*) *COMPILED-EXTENSIONS*)
DO do
(SETQ LOC (FINDFNDEF FN IFILE)) (SETQ LOC (FINDFNDEF FN IFILE))
(IF (LISTP LOC) (if (LISTP LOC)
THEN (SETQ TFPROP (LIST FN (CAR LOC))) then (SETQ TFPROP (LIST FN (CAR LOC)))
[SETQ WINDOW (FIND W IN (OPENWINDOWS) [SETQ WINDOW (find W in (OPENWINDOWS)
SUCHTHAT (AND (EQUAL TFPROP (WINDOWPROP W 'TF)) suchthat (AND (EQUAL TFPROP (WINDOWPROP W 'TF))
(fetch (TEXTWINDOW WTEXTSTREAM) of W] (TEXTSTREAM W T]
(IF (AND WINDOW (NOT REPRINT)) [if (AND WINDOW (NOT REPRINT))
THEN then
(* ;; (* ;;
 "If already an open PF window on this function in this file, just raise it to the top")  "If already an open PF window on this function in this file, just raise it to the top")
(TOTOPW WINDOW) (TOTOPW WINDOW)
(RETURN) (RETURN)
ELSE (CL:WITH-OPEN-FILE else (CL:WITH-OPEN-FILE
(ISTREAM (POP LOC) (ISTREAM (POP LOC)
:DIRECTION :INPUT) :DIRECTION :INPUT)
(SETQ ENV (LISPSOURCEFILEP ISTREAM)) (SETQ ENV (LISPSOURCEFILEP ISTREAM))
@@ -109,18 +113,18 @@
(PRINTOUT TSTREAM 5 "[From " (FULLNAME ISTREAM) (PRINTOUT TSTREAM 5 "[From " (FULLNAME ISTREAM)
"]" T) "]" T)
(PRINT-READER-ENVIRONMENT ENV TSTREAM) (PRINT-READER-ENVIRONMENT ENV TSTREAM)
(IF REPRINT (if REPRINT
THEN (SETFILEPTR ISTREAM (POP LOC)) then (SETFILEPTR ISTREAM (POP LOC))
(SETQ EXPR (WITH-READER-ENVIRONMENT ENV (READ ISTREAM))) (SETQ EXPR (WITH-READER-ENVIRONMENT ENV (READ ISTREAM)))
(WITH-READER-ENVIRONMENT ENV (WITH-READER-ENVIRONMENT ENV
(IF (EQ FN (CAR EXPR)) (if (EQ FN (CAR EXPR))
THEN (DSPFONT BOLDFONT TSTREAM) then (DSPFONT BOLDFONT TSTREAM)
(PRINT FN TSTREAM) (PRINT FN TSTREAM)
(DSPFONT DEFAULTFONT TSTREAM) (DSPFONT DEFAULTFONT TSTREAM)
(SETQ EXPR (CADR EXPR)) (SETQ EXPR (CADR EXPR))
(PRINTDEF EXPR 3 T NIL NIL TSTREAM) (PRINTDEF EXPR 3 T NIL NIL TSTREAM)
ELSEIF (EQ FN (CADR EXPR)) elseif (EQ FN (CADR EXPR))
THEN then
(* ;; (* ;;
 "Presumably a DEFUN. Print the CAR, boldface the cadr")  "Presumably a DEFUN. Print the CAR, boldface the cadr")
@@ -131,26 +135,26 @@
(PRINTDEF (CDDDR EXPR) (PRINTDEF (CDDDR EXPR)
3 T T NIL TSTREAM) 3 T T NIL TSTREAM)
(PRIN3 ")" TSTREAM) (PRIN3 ")" TSTREAM)
ELSE (PRINTDEF EXPR 3 NIL NIL NIL TSTREAM))) else (PRINTDEF EXPR 3 NIL NIL NIL TSTREAM)))
ELSE (PFI.MAYBE.PP.DEFINITION ISTREAM TSTREAM (POP LOC) else (PFI.MAYBE.PP.DEFINITION ISTREAM TSTREAM (POP LOC)
(POP LOC))) (POP LOC)))
(TERPRI TSTREAM) (TERPRI TSTREAM)
[TEDIT TSTREAM (OR WINDOW 'TF) [TEDIT TSTREAM (OR WINDOW 'TF)
NIL NIL
`(READONLY T LEAVETTY T TITLE ,(CONCAT FN " from " (FULLNAME `(READONLY T TITLE ,(CONCAT FN " from " (FULLNAME ISTREAM))
ISTREAM))
ITEM-NAME ITEM-NAME
,FN BOUNDTABLE ,(TEDIT.ATOMBOUND.READTABLE *READTABLE*] ,FN 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.") (* ;; "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) (WINDOWPROP (WFROMDS TSTREAM)
'TF TFPROP))) 'TF TFPROP)
ELSEIF (EQ LOC 'FILE.NOT.FOUND) (TOTOPW (WFROMDS TSTREAM]
THEN (printout T "file " IFILE " not found." T) elseif (EQ LOC 'FILE.NOT.FOUND)
ELSE (printout T FN " not found on " LOC "." T))) then (printout T "file " IFILE " not found." T)
else (printout T FN " not found on " LOC "." T)))
(SETQ *LAST-DF* FN) (SETQ *LAST-DF* FN)
ELSE (PRINTOUT T FN " has no function definition" T]) else (PRINTOUT T FN " has no function definition" T])
(PF-TEDIT-FROM-TEXT (PF-TEDIT-FROM-TEXT
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 14-Apr-2025 21:59 by rmk") [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 14-Apr-2025 21:59 by rmk")
@@ -214,5 +218,5 @@
(ADDTOVAR LAMA ) (ADDTOVAR LAMA )
) )
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (1017 10695 (PF-TEDIT 1027 . 8961) (PF-TEDIT-FROM-TEXT 8963 . 10693))))) (FILEMAP (NIL (1080 10900 (PF-TEDIT 1090 . 9166) (PF-TEDIT-FROM-TEXT 9168 . 10898)))))
STOP STOP

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

Binary file not shown.