(FILECREATED " 3-Aug-84 23:21:14" {PHYLUM}<3-LISP>EMACS>WINDOW.FPKG;1 15854
changes to: (RECORDS EMACSSTREAM)
(FNS \TEDIT.WINDOW.TITLE TYI EMACS fsEDITORNAME EMACS.INIT EMACS.INIT.MENU
EMACS.CREATEW \EMACS.GENSYM.BUFFER.NAME.FOR \EMACS.ICONFUN EMACS.GET.REGIONS
EMACS.GET.REGIONS.FROM.WINDOW EMACS.INTERACTION.WINDOW.PIXEL.HEIGHT
EMACS.UPDATE.MODELINE EMACS.SET.BUFFER.NAME EMACS.REPAINTFN EMACS.QUITFN
ALREADY.BEING.EDITED TEDIT.NOTIFY MAKE.EMACS.BUG.FORM))
(* Copyright (c) 1984 by Xerox Corporation)
(PRETTYCOMPRINT WINDOWCOMS)
(RPAQQ WINDOWCOMS ((INITVARS (BytesPerPage 512)
(\\OLD.EDITOR.NAME 'EMACS)
(\\CURRENT.EDITOR.NAME 'EMACS)
(EMACS.INTERACTION.WINDOW.HEIGHT 4)
(EMACS.ALL.BUFFERS NIL)
(EMACS.GENSYM.COUNTER 0))
(RECORDS EMACSSTREAM)
(FNS \TEDIT.WINDOW.TITLE TYI EMACS fsEDITORNAME EMACS.INIT EMACS.INIT.MENU EMACS.CREATEW
\EMACS.GENSYM.BUFFER.NAME.FOR \EMACS.ICONFUN EMACS.GET.REGIONS
EMACS.GET.REGIONS.FROM.WINDOW EMACS.INTERACTION.WINDOW.PIXEL.HEIGHT
EMACS.UPDATE.MODELINE EMACS.SET.BUFFER.NAME EMACS.REPAINTFN EMACS.QUITFN
ALREADY.BEING.EDITED TEDIT.NOTIFY MAKE.EMACS.BUG.FORM)
(P (COND ((NULL (RECLOOK 'STREAM))
(EVAL (FOR R IN SYSTEMRECLST THEREIS (EQ (CADR R)
'STREAM)))))
(COND ((NULL (RECLOOK 'SELECTION))
(LOADFNS NIL '{ERIS}<LISPUSERS>TEDIT.DCOM 'SYSLOAD '(RECORD DATATYPE))))
(COND ((NULL (RECLOOK 'TEXTOBJ))
(LOADFNS NIL '{ERIS}<LISPUSERS>TEXTOFD.DCOM 'SYSLOAD '(RECORD DATATYPE))))
(SETQ TEDIT.INTERRUPTS '((7 ERROR)))
(SETQ TEDIT.DEFAULT.PROPS (APPEND TEDIT.DEFAULT.PROPS '(CACHE T)))
(ADDTOVAR LAFITESPECIALFORMS ("Emacs Report" 'MAKE.EMACS.BUG.FORM
"Report an Emacs bug or suggestion"))
(SETQ LAFITEFORMSMENU NIL))))
(RPAQ? BytesPerPage 512)
(RPAQ? \\OLD.EDITOR.NAME 'EMACS)
(RPAQ? \\CURRENT.EDITOR.NAME 'EMACS)
(RPAQ? EMACS.INTERACTION.WINDOW.HEIGHT 4)
(RPAQ? EMACS.ALL.BUFFERS NIL)
(RPAQ? EMACS.GENSYM.COUNTER 0)
[DECLARE: EVAL@COMPILE
(ACCESSFNS EMACSSTREAM ((TEXTOBJ (STREAM.F3 DATUM))
(WINDOW (\TEDIT.MAINW (EMACSSTREAM.TEXTOBJ DATUM)))
(SELECTION (TEXTOBJ.SEL (EMACSSTREAM.TEXTOBJ DATUM)))
(CARETPTR (SUB1 (SELECTION.CH# (EMACSSTREAM.SELECTION DATUM))))
(FILEPTR (GETFILEPTR DATUM))
(DIRTY (TEXTOBJ.\DIRTY (EMACSSTREAM.TEXTOBJ DATUM)))
(PROMPTWINDOW (TEXTOBJ.PROMPTWINDOW (EMACSSTREAM.TEXTOBJ DATUM)))))
]
(DEFINEQ
(\TEDIT.WINDOW.TITLE
(LAMBDA NIL (* "Gumby" " 3-Aug-84 23:21")
'NIL))
(TYI
(LAMBDA NIL (* "Gumby" " 3-Aug-84 23:21")
(* Fix mysterious bug in \GETKEY;
don%'t leave turds on the screen *)
(\WAITFORSYSBUFP)
(\GETKEY)))
(EMACS
(LAMBDA (TEXT WINDOW DONTSPAWN PROPS NOMODELINE) (* "Gumby" " 3-Aug-84 23:21")
(* As TEDIT%'s TEDIT fn except for detail.
*)
(* User entry to the text editor.
Takes an optional window to be used for editing)
(* DONTSPAWN => Don%'t try to create a new process for
this edit.)
(* NOMODELINE means don%'t attach a modeline to this
window *)
(PROG (TPROPS PROC OLDWINDOW)
(IF (AND TEXT (ATOM TEXT)
(SETQ OLDWINDOW (ALREADY.BEING.EDITED TEXT)))
THEN (* Don%'t let the confusion arise.
The user%'s nor Interlisp%'s.)
(TTY.PROCESS (WINDOWPROP OLDWINDOW 'PROCESS))
ELSE (SETQ WINDOW (OR (AND DONTSPAWN TEDIT.DEFAULT.WINDOW)
(AND NOMODELINE WINDOW)
(AND WINDOW (WINDOWPROP WINDOW 'NOMODELINE)
WINDOW)
(EMACS.CREATEW "Indicate region for Edit Window." NIL WINDOW
NOMODELINE)))
(SETQ TPROPS (APPEND PROPS (LIST 'TEDIT.QUITFN '(EMACS.QUITFN)
'PROMPTWINDOW
(WINDOWPROP WINDOW 'PROMPTWINDOW))
TEDIT.DEFAULT.PROPS))
(WINDOWPROP WINDOW 'TEDIT.PROPS TPROPS)
(WINDOWPROP WINDOW 'TEDIT.QUITFN 'EMACS.QUITFN)
(* Temporary hack? *)
(RETURN (IF DONTSPAWN
THEN (* Either no processes running%, or specifically not to
spawn one.)
(\TEDIT1 TEXT WINDOW T TPROPS)
ELSE (* Spawn a process to do the edit.)
(SETQ PROC (ADD.PROCESS (LIST '\TEDIT1 (KWOTE TEXT)
WINDOW NIL (KWOTE TPROPS))
'EMACS
'NO))
(PROCESS.WINDOW PROC WINDOW)
(TTY.PROCESS PROC)))))))
(fsEDITORNAME
(LAMBDA (NEWNAME) (* "Gumby" " 3-Aug-84 23:21")
(* Tee Hee *)
(IF NEWNAME
THEN (SETQ \\OLD.EDITOR.NAME \\CURRENT.EDITOR.NAME)
(SETQ \\CURRENT.EDITOR.NAME NEWNAME)
(EMACS.INIT.MENU))
\\CURRENT.EDITOR.NAME))
(EMACS.INIT
(LAMBDA NIL (* "Gumby" " 3-Aug-84 23:21")
(* Initializes EMACS. *)
(EMACS.INIT.ARRAY)
(EMACS.INIT.MENU) (* Mooooby kluge%, but will do for now...
*)
(EMACS.MAKE.COMMAND (CHARCODE ↑A)
'\\COM.BACKWARDS.PARAGRAPH)
(EMACS.MAKE.COMMAND (CHARCODE ↑X)
'\\COM.EMACS.DISPATCH.↑X)
(EMACS.MAKE.COMMAND (CHARCODE ESC)
'\\COM.EMACS.DISPATCH.META)
(EMACS.MAKE.COMMAND (CHARCODE DEL)
'\\COM.RUBOUT)
(DEFDEDITCOM 'Emacs 'DEDITEmacs)
T))
(EMACS.INIT.MENU
(LAMBDA NIL (* "Gumby" " 3-Aug-84 23:21")
(* (TEDIT.REMOVE.MENUITEM TEDIT.DEFAULT.MENU (QUOTE Hardcopy)) (TEDIT.REMOVE.MENUITEM TEDIT.DEFAULT.MENU
(QUOTE Quit)) (TEDIT.REMOVE.MENUITEM TEDIT.DEFAULT.MENU (QUOTE Get)) (TEDIT.REMOVE.MENUITEM TEDIT.DEFAULT.MENU
(QUOTE Put)) (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE ("Put" (QUOTE EMACS.PUT)))) (TEDIT.ADD.MENUITEM
TEDIT.DEFAULT.MENU (QUOTE ("Get" (QUOTE EMACS.GET)))) *)
(SETQ BackgroundMenuCommands (CONS (CONS \\CURRENT.EDITOR.NAME '('(EMACS)
"Opens an Edit Window."))
(FOR BUCKET IN BackgroundMenuCommands
WHEN (NOT (MEMB (CAR BUCKET)
(LIST 'TEdit 'EMACS \\OLD.EDITOR.NAME
\\CURRENT.EDITOR.NAME)))
COLLECT BUCKET)))
(SETQ BackgroundMenu NIL)))
(EMACS.CREATEW
(LAMBDA (PROMPT FILE EXISTING.WINDOW NOMODE) (* "Gumby" " 3-Aug-84 23:21")
(* if EXISTING-WINDOW use it for main window.
NOMODE says return only one window *)
(CLRPROMPT)
(IF (NULL EXISTING.WINDOW)
THEN (PRIN1 PROMPT PROMPTWINDOW)) (* REGIONS is (EDIT-WINDOW . MODE-WINDOW) *)
(PROG (REGIONS MODE.WINDOW MODE.REGION)
(IF (AND EXISTING.WINDOW NOMODE)
THEN (SETQ TEDIT.DEFAULT.WINDOW EXISTING.WINDOW)
ELSE (IF EXISTING.WINDOW
THEN (SETQ MODE.REGION (EMACS.GET.REGIONS.FROM.WINDOW EXISTING.WINDOW))
(SETQ TEDIT.DEFAULT.WINDOW EXISTING.WINDOW)
ELSE (SETQ REGIONS (EMACS.GET.REGIONS))
(SETQ MODE.REGION (CDR REGIONS))
(SETQ TEDIT.DEFAULT.WINDOW (CREATEW (CAR REGIONS)))
(WINDOWPROP TEDIT.DEFAULT.WINDOW 'ICONFN '\EMACS.ICONFUN))
(SETQ MODE.WINDOW (CREATEW (CDR MODE.REGION)
(CONCAT (fsEDITORNAME)
" [NEW]")))
(ATTACHWINDOW MODE.WINDOW TEDIT.DEFAULT.WINDOW (CAR MODE.REGION)
'JUSTIFY)
(CLRPROMPT)
(DSPFONT TEDIT.DEFAULT.FONT TEDIT.DEFAULT.WINDOW)
(DSPFONT TEDIT.DEFAULT.FONT MODE.WINDOW)
(WINDOWPROP TEDIT.DEFAULT.WINDOW 'TEDITCREATED T)
(WINDOWPROP TEDIT.DEFAULT.WINDOW 'PROMPTWINDOW MODE.WINDOW)
(WINDOWPROP TEDIT.DEFAULT.WINDOW 'NUMERIC.ARG 1)
(* (WINDOWPROP MODE.WINDOW (QUOTE BUTTONEVENTFN)
(QUOTE \EMACS.MODELINE.HACK.BUTTON)) *)
(WINDOWPROP MODE.WINDOW 'REPAINTFN 'EMACS.REPAINTFN)
(WINDOWPROP MODE.WINDOW 'BUFFER.NAME (\EMACS.GENSYM.BUFFER.NAME.FOR FILE))
(WINDOWPROP MODE.WINDOW 'EMACS.MODE.WINDOW.P T)
(WINDOWPROP MODE.WINDOW 'PAGEFULLFN 'NILL)
(WINDOWPROP MODE.WINDOW 'TEDIT.PROMPTWINDOW T)
(* Tell TEdit that this is the promptwindow to use *)
(WINDOWPROP MODE.WINDOW 'MINSIZE (CONS (FETCH HEIGHT OF MODE.REGION)
0))
(WINDOWPROP MODE.WINDOW 'MAXSIZE (CONS (FETCH HEIGHT OF MODE.REGION)
MAX.FIXP))
(EMACS.UPDATE.MODELINE TEDIT.DEFAULT.WINDOW T)))
(OR (MEMB TEDIT.DEFAULT.WINDOW EMACS.ALL.BUFFERS)
(SETQ EMACS.ALL.BUFFERS (CONS TEDIT.DEFAULT.WINDOW EMACS.ALL.BUFFERS)))
TEDIT.DEFAULT.WINDOW))
(\EMACS.GENSYM.BUFFER.NAME.FOR
(LAMBDA (FILE) (* "Gumby" " 3-Aug-84 23:21")
(IF (OR (NULL FILE)
(ZEROP (NCHARS (MKSTRING FILE))))
THEN (SETQ EMACS.GENSYM.COUNTER (PLUS 1 EMACS.GENSYM.COUNTER))
(CONCAT "Buffer-" EMACS.GENSYM.COUNTER)
ELSE (SELECTQ (TYPENAME FILE)
(STRINGP FILE)
(ATOMP FILE)
FILE))))
(\EMACS.ICONFUN
(LAMBDA (WINDOW) (* "Gumby" " 3-Aug-84 23:21")
(CONCAT (fsEDITORNAME)
": "
(WINDOWPROP (WINDOWPROP WINDOW 'PROMPTWINDOW)
'BUFFER.NAME)
(IF (fetch \DIRTY of (TEXTOBJ WINDOW))
THEN " (*) "
ELSE ""))))
(EMACS.GET.REGIONS
(LAMBDA NIL (* "Gumby" " 3-Aug-84 23:21")
(* I miss LET*! *)
(* Creates the regions for the two EMACS windows. Returns a cons of the main window and a cons of
(QUOTE BOTTOM) and the modeline window. *)
(PROG ((BIG (GETREGION))
HEIGHT MHEIGHT)
(SETQ HEIGHT (fetch HEIGHT of BIG))
(SETQ MHEIGHT (EMACS.INTERACTION.WINDOW.PIXEL.HEIGHT))
(IF (LESSP HEIGHT MHEIGHT)
THEN (PROMPTPRINT "That's too small. Try again.")
(EMACS.GET.REGIONS)
ELSE (RETURN (CONS (CREATE REGION USING BIG HEIGHT ←(IDIFFERENCE HEIGHT MHEIGHT)
BOTTOM ←(IPLUS (FETCH BOTTOM OF BIG)
MHEIGHT))
(CONS 'BOTTOM (CREATE REGION USING BIG HEIGHT ← MHEIGHT))))))))
(EMACS.GET.REGIONS.FROM.WINDOW
(LAMBDA (FOR.WINDOW) (* "Gumby" " 3-Aug-84 23:21")
(* Makes a region for a modeline attached to the bottom of FOR.WINDOW%, unless FOR.WINDOW is too close to the
screen bottom%, when it will go on the top. Returns a cons of the place and the region in question.
*)
(PROG ((BIG (WINDOWPROP FOR.WINDOW 'REGION))
(SIZE (EMACS.INTERACTION.WINDOW.PIXEL.HEIGHT))
BIG.BOTTOM PLACE REGION)
(SETQ REGION (CREATE REGION USING BIG HEIGHT ← SIZE BOTTOM ←(IF (IGREATERP (SETQ BIG.BOTTOM
(FETCH BOTTOM
OF BIG))
SIZE)
THEN (SETQ PLACE
'BOTTOM)
(IDIFFERENCE
BIG.BOTTOM
SIZE)
ELSE (SETQ PLACE
'TOP)
(IPLUS BIG.BOTTOM
(FETCH HEIGHT
OF BIG)))))
(RETURN (CONS PLACE REGION)))))
(EMACS.INTERACTION.WINDOW.PIXEL.HEIGHT
(LAMBDA NIL (* "Gumby" " 3-Aug-84 23:21")
(TIMES EMACS.INTERACTION.WINDOW.HEIGHT (FONTPROP TEDIT.PROMPT.FONT 'HEIGHT))))
(EMACS.UPDATE.MODELINE
(LAMBDA (THING STARTUP) (* "Gumby" " 3-Aug-84 23:21")
(PROG ((WINDOW (IF (EQ (TYPENAME THING)
'WINDOW)
THEN (COND
((WINDOWPROP THING 'EMACS.MODE.WINDOW.P)
THING)
((WINDOWPROP THING 'TEDITCREATED)
(WINDOWPROP THING 'PROMPTWINDOW)))
ELSE (EMACSSTREAM.PROMPTWINDOW THING))))
(IF (AND WINDOW (WINDOWPROP WINDOW 'EMACS.MODE.WINDOW.P))
THEN (* Don%'t choke if e.g. LaFite *)
(WINDOWPROP WINDOW 'TITLE
(CONCAT (fsEDITORNAME)
" -- "
(WINDOWPROP WINDOW 'BUFFER.NAME)
(IF (OR STARTUP (NOT (FETCH \DIRTY
OF (TEXTOBJ (WINDOWPROP WINDOW
'MAINWINDOW))))
)
THEN ""
ELSE " *")))))))
(EMACS.SET.BUFFER.NAME
(LAMBDA (STREAM NEWNAME) (* "Gumby" " 3-Aug-84 23:21")
(AND (NEQ NEWNAME T)
(PROG ((I.WINDOW (EMACSSTREAM.PROMPTWINDOW STREAM)))
(IF (WINDOWPROP I.WINDOW 'EMACS.MODE.WINDOW.P)
THEN (WINDOWPROP I.WINDOW 'BUFFER.NAME (OR NEWNAME (EMACS.FILENAME STREAM)))
(EMACS.UPDATE.MODELINE (EMACSSTREAM.WINDOW STREAM)))))))
(EMACS.REPAINTFN
(LAMBDA (IOWINDOW) (* "Gumby" " 3-Aug-84 23:21")
(\TEDIT.REPAINTFN (WINDOWPROP IOWINDOW 'MAINWINDOW))))
(EMACS.QUITFN
(LAMBDA (WINDOW STREAM) (* "Gumby" " 3-Aug-84 23:21")
(SETQ EMACS.ALL.BUFFERS (DREMOVE (\TEDIT.MAINW (EMACSSTREAM.TEXTOBJ STREAM))
EMACS.ALL.BUFFERS))
(WINDOWPROP WINDOW 'PROMPTWINDOW NIL)))
(ALREADY.BEING.EDITED
(LAMBDA (FNAME) (* "Gumby" " 3-Aug-84 23:21")
(PROG (FILENAME)
(IF (AND FNAME (SETQ FILENAME (FULLNAME FNAME 'OLD)))
THEN (RETURN (FOR W IN EMACS.ALL.BUFFERS THEREIS (EQUAL (PACKFILENAME
'VERSION NIL 'BODY
(TEXTSTREAM.TITLE
(TEXTSTREAM W)))
(PACKFILENAME 'VERSION NIL
'BODY FILENAME))))
))))
(TEDIT.NOTIFY
(LAMBDA (STREAM STRING FLAGS) (* "Gumby" " 3-Aug-84 23:21")
(PROG ((WINDOW (IF (EQ (TYPENAME STREAM)
'STREAM)
THEN (EMACSSTREAM.PROMPTWINDOW STREAM)
ELSE STREAM)))
(COND
((MEMBER 'CLEARW FLAGS)
(CLEARW WINDOW))
((MEMBER 'FRESHLINE FLAGS)
(FRESHLINE WINDOW)))
(PRIN1 STRING WINDOW)
(IF (MEMBER 'TERPRI FLAGS)
THEN (TERPRI WINDOW)))))
(MAKE.EMACS.BUG.FORM
(LAMBDA NIL (* "Gumby" " 3-Aug-84 23:21")
(MAKEXXXSUPPORTFORM "Emacs" "EmacsSupport↑" "1-APR-84")))
)
(COND ((NULL (RECLOOK 'STREAM))
(EVAL (FOR R IN SYSTEMRECLST THEREIS (EQ (CADR R)
'STREAM)))))
(COND ((NULL (RECLOOK 'SELECTION))
(LOADFNS NIL '{ERIS}<LISPUSERS>TEDIT.DCOM 'SYSLOAD '(RECORD DATATYPE))))
(COND ((NULL (RECLOOK 'TEXTOBJ))
(LOADFNS NIL '{ERIS}<LISPUSERS>TEXTOFD.DCOM 'SYSLOAD '(RECORD DATATYPE))))
(SETQ TEDIT.INTERRUPTS '((7 ERROR)))
(SETQ TEDIT.DEFAULT.PROPS (APPEND TEDIT.DEFAULT.PROPS '(CACHE T)))
(ADDTOVAR LAFITESPECIALFORMS ("Emacs Report" 'MAKE.EMACS.BUG.FORM "Report an Emacs bug or suggestion")
)
(SETQ LAFITEFORMSMENU NIL)
(PUTPROPS WINDOW.FPKG COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2482 15195 (\TEDIT.WINDOW.TITLE 2492 . 2622) (TYI 2624 . 2916) (EMACS 2918 . 5009) (
fsEDITORNAME 5011 . 5379) (EMACS.INIT 5381 . 6042) (EMACS.INIT.MENU 6044 . 6938) (EMACS.CREATEW 6940
. 9357) (\EMACS.GENSYM.BUFFER.NAME.FOR 9359 . 9764) (\EMACS.ICONFUN 9766 . 10087) (EMACS.GET.REGIONS
10089 . 11016) (EMACS.GET.REGIONS.FROM.WINDOW 11018 . 12044) (EMACS.INTERACTION.WINDOW.PIXEL.HEIGHT
12046 . 12266) (EMACS.UPDATE.MODELINE 12268 . 13171) (EMACS.SET.BUFFER.NAME 13173 . 13591) (
EMACS.REPAINTFN 13593 . 13767) (EMACS.QUITFN 13769 . 14039) (ALREADY.BEING.EDITED 14041 . 14512) (
TEDIT.NOTIFY 14514 . 15010) (MAKE.EMACS.BUG.FORM 15012 . 15193)))))
STOP