Path: utzoo!utgpu!news-server.csri.toronto.edu!rutgers!sun-barr!lll-winken!ncis.tis.llnl.gov!blackbird!lonex.radc.af.mil!wlbr!roger.imsd.contel.com!mh
From: mh@roger.imsd.contel.com (Mike H.)
Newsgroups: comp.windows.news
Subject: NeWS version of elvis (the vi clone) part 1 of 9
Message-ID: <1991Jan11.014859.26930@wlbr.imsd.contel.com>
Date: 11 Jan 91 01:48:59 GMT
Sender: news@wlbr.imsd.contel.com (news)
Distribution: comp
Organization: Contel FSD, Westlake Village, CA
Lines: 537
Nntp-Posting-Host: roger.imsd.contel.com


#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	elvis.ps
#	elvis_cps.cps
# This archive created: Thu Jan 10 17:21:05 1991
export PATH; PATH=/bin:$PATH
if test -f 'elvis.ps'
then
	echo shar: will not over-write existing file "'elvis.ps'"
else
cat << \SHAR_EOF > 'elvis.ps'
%
% NeWS postscript machinery for the elvis editor
% Author: Mike Hoegeman, mh@wlbr.imsd.contel.com
%

systemdict dup /ElvisCanvas known %%
pop false 
{
    pop
} {

ClassCanvas
dictbegin
    /StandOut? false def
    /OldCursor? false def
    /CursorEnabled? true def
    /CursorX 0 def
    /CursorY 0 def
    /BoldTextColor ColorDict /Black get def
    /TextDescent 0 def
dictend
classbegin
    
% Class Variables:

% Defaults:

    % TO BE DONE: chances are there is a way to install a key mapping directly
    % into the interest
    /ElvisKeyDict dictbegin
	0 1 256 { dup def } for
	127 8 def		% remap delete to backspace
    dictend def

    /LeftMargin 0 def
    /OrigMatrix null def
    % Bug extrordinaire , only non scalable fonts work!!
    % I really have to fix this
    /TextFamily /7x14 def
    /TextSize 13 def
    /TextSpacing 0 def
    /SavedTextColor null def

% Methods:

    /oldcursor { /OldCursor? exch def } def

    /settextstuff {
	/TextDescent TextFont fontdescent def
    } def

    /newinit {
	/newinit super send
	/SavedTextColor TextColor def
	/FillColor FillColor promote
	/TextColor TextColor promote
    } def

    /validate {
	/resetscale self send
	/validate super send
    } def

    %   (lifted from psterm, this stuff should be redone)
    %   We have some nasty code here that tries to save the
    %   canvas' original matrix.  The default canvas matrix will
    %   be altered by resetscale and we need to restore it before
    %   we can recalculate the new scale factors.
    %
    /reshape { % x y w h => -
        OrigMatrix null ne {
            gsave
                Canvas setcanvas OrigMatrix setmatrix
                clippath Canvas reshapecanvas
            grestore
        } if

	% adjust height to be even number of rows of text...
	TextFont fontheight TextSpacing add div truncate
	TextFont fontheight TextSpacing add mul 
	
	% do likewise for the columns
	exch 
	WidthScale div truncate WidthScale mul 
	exch
        
        /reshape super send

	% tell the C side a reshape has occured
	% damage repainting will ensue on it's own
	gsave MyScale
	    ElvisResizeTag tagprint 
	    size typedprint typedprint
	grestore
        
	/OrigMatrix matrix currentmatrix promote
        /invalidate self send
    } def
    
    /WidthScale {
	TextFont setfont (W) stringwidth pop 
    } def

    /MyScale {
	WidthScale
	TextFont fontheight TextSpacing add neg scale
    } def

    /resetscale {
	gsave 
	    Canvas setcanvas
	    OrigMatrix null ne {
		OrigMatrix setmatrix
	    } if

	    % flip
	    clippath pathbbox
	    0 exch TextFont fontheight sub TextSpacing sub translate 
	    pop pop pop

	    MyScale
	    settextstuff
	    LeftMargin 0 translate
	    
	    newpath clippath Canvas reshapecanvas
	grestore
    } def

    % display (string)
    %
    /ST { % (string) => -
	    HideCursor
	    Canvas setcanvas
	    % blank out old string
	    CursorX CursorY moveto dup length -1 rect
	    FillColor setcolor fill 
		
	    % paint string
	    CursorX CursorY TextDescent sub moveto
	    TextColor setcolor TextFont setfont show
	    currentpoint TextDescent add cm
    } def
    
    
    /HideCursor {
	% unpaint any previous cursor
	OldCursor? { 
	    gsave 5 setrasteropcode
		CursorX CursorY 2 copy moveto 
		CursorPath fill
		moveto
	    grestore
	} if
	false oldcursor
    } def

    %% cursorshape change commands 
    /cpathset { 
	HideCursor 
	/CursorPath exch load promote
	CursorX CursorY cm
    } def
    
    %
    /CursorPath {
	1 -1 rect
    } def
    
    % normal cursor shape
    /cQ { /cQpath  cpathset } def
    /cQpath { 
	1 -1 rect 
    } def
    % when in command mode shape
    /cV { cQ } def
    
    % ex command line cursor shape
    /cX { /cXpath cpathset } def
    /cXpath { 
	1 -.2 rect 
    } def
    
    % input mode cursor shape
    /cI { /cIpath cpathset } def
    /cIpath { 
	-.2 .2 rmoveto
	-.5 0 rlineto .5 -.5 rlineto .5 .5 rlineto   closepath
    } def
    
    % replace mode cursor shape
    /cR { cI } def
    
    /cm { % x y => -
	CursorEnabled? {
	    currentrasteropcode 3 1 roll
		5 setrasteropcode

		% unpaint any previous cursor
		OldCursor? { 
		    CursorX CursorY moveto 
		    CursorPath fill
		} if

		% move caret
		2 copy /CursorY exch def /CursorX exch def moveto

		% turn caret on
		currentpoint moveto  
		CursorPath fill
		true oldcursor
	    setrasteropcode
	} {
	    % move caret
	    2 copy /CursorY exch def /CursorX exch def moveto
	} ifelse
    } def

%
% termcap primitives 
%

    % begin standout mode
    %
    /so {
	TextColor FillColor
	/TextColor exch promote
	/FillColor exch promote
    } def

    % end standout mode
    %
    /se { so } def

    % start/end underline mode
    %
    /us { so } def
    /ue { se } def

    % start/end bold text mode
    %
    /VB { so } def
    /Vb { se } def

    /bc {
	CursorX 1 sub 0 max CursorY cm
    } def


    /Cr { 0 CursorY cm } def
    /Nl { 
	CursorY Height 1 sub ge {
	    % we have gone below the scroll area
	    % scroll everything up a line..
	    
	    0 0 moveto Width Height 1 sub rect 
	    0 -1 copyarea

	    % .. and clear out the garbage at the bottom.
	    
	    % we don't have to worry about the cursor cause it's
	    % in the garbage area (unless it's a mighty bizarre cursor!)
	    false oldcursor
	    
	    0 Height moveto Width LeftMargin sub -2 rect 
	    FillColor setcolor fill
	    CursorX CursorY cm
	} {
	    CursorX CursorY 1 add cm
	} ifelse
    } def

    /RSR {
	    % scroll window up 
	    dup % => lines lines
	    0 CursorY moveto Width Height neg rect  % => lines lines
	    0 exch neg copyarea % => lines

	    % blank out invalid stuff at bottom
	    % => lines
	    0 CursorY moveto Width LeftMargin sub exch neg rect % => -
	    FillColor setcolor fill
    } def

    /CrNl { 
	/CursorX 0 def
	Nl
    } def

    % upline (cursor up)
    %
    /up {
	CursorX CursorY 
	1 sub cm
    } def

    % visual bell (must not move the cursor)
    %
    /vb {
	gsave  
	    5 setrasteropcode 
	    fill pause pause fill 
	grestore
    } def

    % scroll down
    %
    /sr {
	1 SR
    } def

    % block version of sr
    %
    /SR { % number_of_lines_to_scroll_down => -
	false oldcursor
	dup
	gsave
	    % do the scroll, more than needed Height wise but so what
	    0 CursorY 1 sub moveto Width Height rect
	    0 exch copyarea

	    % blank out the area we vacated with the scroll
	    0 CursorY 1 sub moveto
	    Width LeftMargin sub exch rect 

	    FillColor setcolor fill 
	grestore
    } def

    % clear to end of line
    %
    /ce {
	false oldcursor
	CursorX CursorY 
	    2 copy moveto 
	    Width CursorX LeftMargin add sub -1 rect 
	    FillColor  setcolor  fill 
	cm
    } def

    % make cursor appear normal (undo vs/vi)
    %
    /ve { true EC } def

    % make cursor invisible
    %
    /vi { false EC } def

    % (Dis)/(En)able cursor
    %
    /EC {
	dup CursorEnabled? eq {
	    pop
	} {
	    dup {
		% enable , turn cursor on
		% we can just do this with an in place move cursor
		/CursorEnabled? exch def
		CursorX CursorY cm
	    } {
		% disable , turn cursor off
		HideCursor
		/CursorEnabled? exch def
	    } ifelse
	} ifelse
    } def

    /KeyBoard {
	/ElvisKeyTag where {
	    pop
	    /Name get ElvisKeyDict exch get
	    %% dup (% key\n) exch mark exch ] dbgprintf
	    dup type /nametype eq {
		self send
	    } {
		ElvisKeyTag tagprint 
		typedprint
	    } ifelse
	} {
	} ifelse
    } def

    /MakeInterests {
	/MakeInterests super send
	/KeyBoard self soften buildsend
	Canvas /defaultkeys ClassKeysInterest send
    } def

    /PaintCanvas { % - => -
	ElvisDamageTag tagprint flush
    } def

    /minsize { % - => w h
	/minsize super send
	128 max exch
	128 max exch
    } def

    /preferredsize { % - => width height
	gsave
	    /canvas self send setcanvas
	    WidthScale 80 mul
	    TextFont fontheight TextSpacing add 44 mul
	grestore
    } def 

classend /ElvisCanvas exch put

} ifelse

systemdict dup /ElvisFrame known %%
pop false 
{ 
    pop
} {
/defaultclass ClassBaseFrame send []
classbegin
    
    /FooterFraction .99 def % fraction of how much footer is used for 
    			    % the left footer
    /destroyfromuser {
	ElvisDestroyTag tagprint flush
	% /destroyfromuser super send
    } def

classend  /ElvisFrame exch put
} ifelse

% create a window
/win 
    [ElvisCanvas] [/Footer true] framebuffer /new ElvisFrame send 
def

/C /client win send soften def
C setcanvas

(Elvis) /setlabel win send

[/place /activate] {
    win send
} forall

/S { send } def
0 0 /cm C S 

(Elvis) /setlabel win send

currentprocess cvx /ProcessName (Elvis) put

/map win send pause

%newprocessgroup currentfile closefile
SHAR_EOF
fi # end of overwriting check
if test -f 'elvis_cps.cps'
then
	echo shar: will not over-write existing file "'elvis_cps.cps'"
else
cat << \SHAR_EOF > 'elvis_cps.cps'
%
% elvis_cps.cps
%
#define GET_DIMEN_TAG 10

% include the tags such that both cps code inthis file and c code
% eleswhere can use them

cdef ps_RunFile(string file_name)
     file_name run

cdef ps_RegisterTag(string tag_name, tag_value)
    tag_name cvn tag_value def

cdef ps_ST(cstring str)
    str /ST C S

cdef ps_scroll_down(int lines)
    lines /SR C S

cdef ps_pswrite(cpostscript source_code)
    source_code 

cdef ps_Cr()
    /Cr C S

cdef ps_Nl()
    /Nl C S

cdef ps_CrNl()
    /CrNl C S

cdef ps_beep()
    beep pause

cdef ps_enable_cursor()
    /ve C S

cdef ps_disable_cursor()
    /vi C S

cdef ps_rendermsg(string msg)
    msg null /setfooter win send

cdef ps_appendmsg(string old, string new)
    old new append null /setfooter win send

cdef ps_set_title(string title)
    title /setlabel win send
    %% so you can recognize the postscript half of elvis via 'psps'
    currentprocess cvx /ProcessName (Elvis-) title append put
    title /setlabel /Icon /sendsubframe win send

cdef ps_get_lines_and_cols(int lines, int cols) => GET_DIMEN_TAG(lines, cols)
    {   
	GET_DIMEN_TAG tagprint
	Height typedprint
	Width  typedprint
	flush 
    } C send
SHAR_EOF
fi # end of overwriting check
#	End of shell archive
exit 0