%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % TNT interface for GNU Emacs. % % Author: Chris Maio % Modified: Don Hopkins % Last edit: 14 Sep 1990 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % This file defined the classes ClassEmacsCanvas and ClassEmacsSelection systemdict begin %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % ClassEmacsCanvas class definition /ClassEmacsCanvas ClassCanvas [/EmacsFile /EmacsFileLock] classbegin %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Class Variables % /TextFont /Screen-Bold findfont 15 scalefont def % /TextFont /vtsingle findfont 10 scalefont def /TextFont /vtsingle findfont 9 scalefont def /BG 1 1 1 rgbcolor def /Stuff? true def % true => simulate typein %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Tags /tRepairWindow 1 def /tGetWinInfo 2 def /tWinResize 3 def /tKeyboardInput 4 def /tMetaKeyDown 5 def /tEmacsInput 6 def /tEmacsInsert 7 def /tEmacsCommand 8 def /tEmacsTrack 9 def /tEmacsSelect 10 def /tDebugMessage 11 def /tEmacsEvent 12 def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Initialization % Create a window and start interpreting emacs protocol on currentfile. % Does not return. % /startemacswindow { % - => - currentprocess /ProcessName (GnuEmacs Listener) put framebuffer setcanvas userdict begin /can currentfile framebuffer /new ClassEmacsCanvas send def /window can framebuffer /new ClassBaseWindow send def end /MeasureFont can send % set frame label to `emacs on hostname' if possible. { currentfile getsocketpeername } stopped { pop (emacs) } { (.) search { 3 1 roll pop pop } if (emacs on ) exch append } ifelse /setlabel window send 80 24 /SD can send /new ClassEventMgr send dup /ProcessName (GnuEmacs EventMgr) put /activate window send /place window send /map window send /size can send /WinHeight exch round cvi def /LineWidth exch round cvi def can setcanvas TextFont setfont false setprintermatch FG setcolor can % { {currentfile cvx exec} stopped quit } exch send { currentfile cvx exec } exch send } def /NewInit { % file can => - /NewInit super send % file /EmacsFile exch cvlit def /EmacsLock createmonitor def systemdict /EmacsCanvas known not { systemdict /EmacsCanvas self soften put } if } def /destroy { % - => - systemdict /EmacsCanvas known { systemdict /EmacsCanvas get self eq { systemdict /EmacsCanvas undef } if } if /destroy super send } def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Emacs Client Protocol % DefineTag /DT { % name value def } def % Begin repair % /BR { % - => - self setcanvas damagepath clipcanvas } def % End repair % /ER { % - => - newpath clipcanvas } def % Clear screen % /CL { % - => - clippath /BackFill self send } def % Clear to end of line % /CE { % x y => - moveto LineWidth LineHeight rect /BackFill self send } def % Clear and show % /CS { % s x y n x y => - moveto LineHeight rect /BackFill self send moveto show } def % Clear and show inverted % /CSI { % s x y n x y => - moveto LineHeight rect FG setcolor fill moveto BG setcolor show FG setcolor } def % Insert lines % /IL { % y n => - /dy exch def /top exch LineHeight add def 0 dy moveto LineWidth top dy sub rect 0 dy neg copyarea 0 top moveto LineWidth dy neg rect /BackFill self send } def % Insert lines within scroll region % /IL2 { % top bottom dy => - neg 3 1 roll % -dy top bottom 2 index sub dup % -dy top (bottom+dy) (bottom+dy) 0 exch moveto % -dy top (bottom+dy) 1 index exch sub % -dy top (top-(bottom+dy)) LineWidth exch rect % -dy top 1 index 0 exch copyarea % -dy top 0 exch moveto LineWidth exch rect /BackFill self send } def % Delete lines % /DL { % y n => - /dy exch def /top exch LineHeight add def 0 0 moveto LineWidth top dy sub rect 0 dy copyarea 0 0 moveto LineWidth dy rect /BackFill self send } def % Delete lines within scroll region % /DL2 { % top bottom dy => - 1 index 0 exch moveto % top bottom dy 3 -1 roll % bottom dy top 2 index sub % bottom dy top-bottom 1 index sub % bottom dy top-bottom-dy LineWidth exch rect % bottom dy dup 0 exch copyarea % bottom dy exch 0 exch moveto % dy LineWidth exch rect /BackFill self send } def % Delete characters % /DC { % x y dx => - dup dup dup % x y dx dx dx dx 6 -1 roll add % y dx dx dx x2 4 index % y dx dx dx x2 y moveto LineWidth LineHeight rect neg 0 copyarea % y dx dx 3 1 roll % dx y dx LineWidth exch sub exch moveto LineHeight rect /BackFill self send } def % Insert characters % /IC { % x y dx => - 3 1 roll 3 copy % dx x y dx x y moveto LineWidth LineHeight rect 0 copyarea moveto LineHeight rect /BackFill self send } def % Show text % /S { % s x y => - moveto show } def % Show text in the background color % /SI { % s x y => - moveto BG setcolor show FG setcolor } def % Fill background with the foreground color % /FI { % n x y => - moveto LineWidth LineHeight rect FG setcolor fill } def % Toggle the cursor % /CT { % x y => - moveto CharWidth LineHeight rect % XXX % currentrasteropcode 5 setrasteropcode fill setrasteropcode FG setcolor currentpixel BG setcolor currentpixel xor setpixel 6 setrasteropcode fill FG setcolor } def % Flash the screen % /^G { % - => - % gsave 5 setrasteropcode clippath fill clippath fill grestore beep } def % Reshape the window % /SD { % cols rows => - LineHeight mul 4 add exch CharWidth mul 4 add exch [ 3 -2 roll ] cvx /preferredsize exch def { gsave Parent setcanvas /location self send /preferredsize self send /reshape self send grestore } Parent send } def % Set the frame label % /FL { % framelabel => - /setlabel Parent send } def % Set the font -- should be followed by a SD to reshape the window % /SF { % name size => - mark 3 1 roll { exch findfont exch scalefont /TextFont exch def } stopped cleartomark /MeasureFont self send } def % Interactively move the window % /IM { % - => - Parent /descendantof? ClassWindow send { gsave Parent /Parent get setcanvas /place Parent send grestore } if } def % Input procedure % /IP { % - => - % watch for hints that the canvas may have changed self null 20 dict begin /ResetYourSelf { currentcanvas setcanvas } def currentdict end /new ClassInterest send /addclient /eventmgr self send send } def % Send Selection % /SS { % rank size string => - exch pop exch RankName % string /rank self soften /new ClassEmacsSelection send % string sel { settext setselection } exch send } def % Execute a random string; n != 0 means expect to find something on top % of the stack afterwards which should be sent back to Emacs. % /DO { % string n => - 0 eq { { cvx exec } fork pop pop } { { cvx exec } fork exch pop waitprocess dup type /stringtype ne { (%) sprintf } if EmacsLock { /SendString self send } montior } ifelse } def % Set stuff % /ST { % int => - 0 ne /Stuff? exch def } def % Set origin % /SO { % x y => - gsave Parent /descendantof? ClassWindow send { Parent /Parent get setcanvas /move Parent send } { Parent setcanvas /move self send } ifelse grestore } def % Map window % /MW { % - => - /map self send Parent /descendantof? ClassWindow send { /map Parent send } if } def % Reshape window % /RW { % - => - IM } def % Retain window % /RT { % int => - pop } def % Reset Canvas % /RC { % - => - self setcanvas } def % Get window info % /GW { % - => - EmacsLock { self setcanvas /SendReset self send clippath pathbbox 4 2 roll pop pop /WinHeight exch def /LineWidth exch def tGetWinInfo tagprint LineWidth typedprint WinHeight typedprint CharWidth typedprint BaseLine typedprint LineHeight typedprint flush } monitor } def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Emacs server side interface /sendkey { % int => - { tKeyboardInput tagprint typedprint } OutputToEmacs } def /sendstring { % str => - { /SendString self send } OutputToEmacs } def /sendcommand { % cmd => - { /EmacsCommand self send } OutputToEmacs } def /sendmessage { % msg => - { /EmacsMessage self send } OutputToEmacs } def /sendemacsevent { % name action canvas clientdata x y time => - { /EmacsEvent self send } OutputToEmacs } def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Canvas overrides % Repaint a damaged canvas -- passes damaged region back to client % /Fix { % - => - clipcanvaspath pathbbox BackgroundColor setcolor fill { tRepairWindow tagprint typedprint typedprint typedprint typedprint } OutputToEmacs } def /Paint { % - => - clipcanvaspath pathbbox newpath { tRepairWindow tagprint typedprint typedprint typedprint typedprint } OutputToEmacs } def /reshape { % x y w h => - /reshape super send /?validate self send { gsave self setcanvas /SendReset self send /size self send /WinHeight exch def /LineWidth exch def tWinResize tagprint LineWidth typedprint WinHeight typedprint CharWidth typedprint BaseLine typedprint LineHeight typedprint grestore } OutputToEmacs } def % Return the minimum size to keep emacs from core dumping % /minsize { % - => w h /MeasureFont self send CharWidth 10 mul 4 add LineHeight 5 mul 4 add % XXX: Any smaller and it core dumps! } def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Utilities /BackFill { % - => - BG setcolor fill FG setcolor } def /MeasureFont { % - => - gsave TextFont setfont (m) stringwidth pop /CharWidth exch round cvi def /BaseLine TextFont fontdescent round cvi def % /LineHeight TextFont fontheight BaseLine add round cvi def /LineHeight TextFont fontheight ceiling cvi def grestore } def /OutputToEmacs { % proc => - EmacsLock { currentprocess dup /Stdout get cvlit % proc cp stdout exch /Stdout /EmacsFile load put % proc stdout /OutputToEmacsTemp exch promote % proc exec % /EmacsFile load flushfile /OutputToEmacsTemp load % stdout /OutputToEmacsTemp unpromote currentprocess /Stdout 3 -1 roll put % flush } monitor } def % Send keyboard input to emacs % /EmacsInput { % str => - tEmacsInput tagprint typedprint } def % Ask emacs to insert a string % /EmacsInsert { % str => - tEmacsInsert tagprint typedprint } def /SendString { % str => - Stuff? { /EmacsInput self send } { /EmacsInsert self send } ifelse } def % Ask emacs to call a function, e.g. `(rmail) EmacsCommand' % /EmacsCommand { % cmd => - dup type /stringtype ne { (%) sprintf } if tEmacsCommand tagprint typedprint } def % Send a debug message % /EmacsMessage { % msg => - tDebugMessage tagprint typedprint } def /EmacsEvent { % name action canvas clientdata x y time => - 7 copy pop pop pop % ... name action canvas clientdata % calculate space for strings and trailing nulls length exch length add exch length add exch length add 4 add tHaveEmacsEvent tagprint typedprint tReadEmacsEvent tagprint 7 array astore { typedprint } forall } def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Input services % Key service /Keyable? true def /Receptible? true def /KeyStart { % event => [ labels ] true pop [/StandardKey /NumPadKey] true } def /LeftMeta dup /keyforsymbol ClassKeyboard send def /RightMeta dup /keyforsymbol ClassKeyboard send def /StandardKey { % event => - % REMIND: don't block the global event manager EmacsLock { dup /KeyState get dup LeftMeta arraycontains? exch RightMeta arraycontains? or { tMetaKeyDown tagprint 1 typedprint /Name get tKeyboardInput tagprint typedprint tMetaKeyDown tagprint 0 typedprint } { /Name get tKeyboardInput tagprint typedprint } ifelse flush } monitor } def /FunctionString { % event => - /Name get /SendString self send } def /ArrowString //FunctionString def /AsciiReception { % event str => - exch pop /sendstring self send } def /SendReset { /eventmgr self send null ne { createevent dup begin /Name /ResetYourSelf def /Process /eventmgr self send def end sendevent } if } def % Menu Service /Menuable? true def /Menu /Grid framebuffer /new ClassMenu send def [ [ (Stuff) /EmacsStuff ] [ (Paste) /EmacsPaste ] [ (Copy) /EmacsCopy ] [ (Cut) /EmacsCut ] ] /setitemlist Menu send /EmacsStuff { % index menu => - pop pop createevent dup /Canvas self put dup /selectioncopy ClassUI send /selectionpaste ClassUI send } def /EmacsCopy { % index menu => - pop pop createevent dup /Canvas self put /selectioncopy ClassUI send } def /EmacsCut { % index menu => - pop pop createevent dup /Canvas self put /selectioncut ClassUI send } def /EmacsPaste { % index menu => - pop pop createevent dup /Canvas self put /selectionpaste ClassUI send } def /Trackable? true def /SendEventXY { gsave begin self setcanvas XLocation typedprint YLocation typedprint end grestore } def /TrackStart { % event => name true | false { tEmacsTrack tagprint dup /Name get PointButton eq {0} {1} ifelse /EName 1 index def typedprint 0 typedprint /SendEventXY self send } OutputToEmacs /Default true } def /TrackMotion { % event => - { tEmacsTrack tagprint EName typedprint 1 typedprint /SendEventXY self send } OutputToEmacs } def /TrackStop { % event => - { tEmacsTrack tagprint EName typedprint 2 typedprint /SendEventXY self send } OutputToEmacs } def classend def /ClassEmacsSelection ClassSelection dictbegin /Text nullstring def /Size 0 def dictend classbegin /SingleRequest { % oldval key => newval { /ContentsAscii { pop Text } /SetContentsAscii { /Text exch def null } /SelectionObjsize { pop Text length } /Default { pop /UnknownRequest } } case } def /Deselect { } def /settext { % (str) => - /Text exch def } def /text { % - => str Text } def /textsize { % - => len Text length } def classend def end % systemdict %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%