[comp.sources.misc] v07i036: CRISP release 1.9 part 15/32

allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) (06/12/89)

Posting-number: Volume 7, Issue 36
Submitted-by: fox@marlow.UUCP (Paul Fox)
Archive-name: crisp1.9/part16



#!/bin/sh
# this is part 2 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file src/crisp/core.m continued
#
CurArch=2
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
     exit 1; fi
( read Scheck
  if test "$Scheck" != $CurArch
  then echo "Please unpack part $Scheck next!"
       exit 1;
  else exit 0; fi
) < s2_seq_.tmp || exit 1
echo "x - Continuing file src/crisp/core.m"
sed 's/^X//' << 'SHAR_EOF' >> src/crisp/core.m
X *           Bucks.                                                 *
X *              England SL7 1TX                                     *
X *                                                                  *
X *                                                                  *
X *    Please See COPYRIGHT notice.                                  *
X *                                                                  *
X ********************************************************************/
X
X# include	"crisp.h"
X
X# define	FILENAME	"BUFFER"
X
X(macro _fatal_error
X	(
X		(int	win
X				buf
X				file_no
X				this_buf)
X		(string	prompt tmp file_name buf_name)
X
X		(= buf (create_buffer "*** CRISP Internal Error ***" NULL 1))
X		(set_buffer buf)
X		(insert "A fatal error has been detected with the software.\n")
X		(insert "CRISP  will attempt to save your modified buffers.\n")
X		(insert "\n")
X		(insert "It will  write  the  buffers  away to files called\n")
X		(insert "BUFFER.1, BUFFER.2, etc.\n")
X		(insert "\n")
X		(insert "It will not  overwrite the  original files in case\n")
X		(insert "the buffers have  been corrupted or it dies during\n")
X		(insert "the attempted salvage.\n")
X		(insert "\n")
X		(insert "You will be prompted to save each file.")
X		(top_of_buffer)
X		(= win (sized_window (inq_lines) (inq_line_length) ""))
X		(set_window win)
X		(attach_buffer buf)
X		(refresh)
X		(message "")		
X		/*----------------------------------------
X		/*   Now attempt to save the files.
X		/*----------------------------------------*/
X		(= this_buf (next_buffer 1))
X		(= file_no 1)
X		
X		(while (!= this_buf buf) (
X			(set_buffer this_buf)
X			
X			(if (&& (! (inq_system)) (inq_modified)) (
X				(inq_names file_name NULL buf_name)
X				
X				(if (> (strlen file_name) 20)
X					(= file_name buf_name))
X					
X				(sprintf tmp "Save %s as %s.%d ? (y/n) " file_name FILENAME file_no)
X				(= prompt "x")
X				
X				(while (== (index "NnYy" prompt) 0) (
X					(get_parm NULL prompt tmp 1)
X					))
X				(if (index "yY" prompt) (
X					(sprintf file_name "%s.%d" FILENAME file_no)
X					(write_buffer file_name)
X					(++ file_no)))
X				))
X			(= this_buf (next_buffer 1))
X			))
X	)
X)
SHAR_EOF
echo "File src/crisp/core.m is complete"
chmod 0644 src/crisp/core.m || echo "restore of src/crisp/core.m fails"
mkdir src src/crisp >/dev/null 2>&1
echo "x - extracting src/crisp/crisp.m (Text)"
sed 's/^X//' << 'SHAR_EOF' > src/crisp/crisp.m &&
X/********************************************************************
X *                                                                  *
X *      CRISP - Custom Reduced Instruction Set Programmers Editor   *
X *                                                                  *
X *      (C) Paul Fox, 1989                                          *
X *      43, Jerome Close                Tel: +44 6284 4222          *
X *          Marlow                                                  *
X *           Bucks.                                                 *
X *              England SL7 1TX                                     *
X *                                                                  *
X *                                                                  *
X *    Please See COPYRIGHT notice.                                  *
X *                                                                  *
X ********************************************************************/
X# include	"crisp.h"
X
X
X/*----------------------------------------
X/*   The following macro is used to convert
X/*   a PC keyboard key description into
X/*   a keyboard dependent string, so that
X/*   messages appearing at the bottom of
X/*   windows dont necessarily say things like
X/*   <Alt-H> on a keyboard which doesnt have
X/*   an Alt-H key.
X/*----------------------------------------*/
X(macro key_label
X	(
X		(string key)
X		(int len keyval)
X		
X		(get_parm 0 key)
X		(= keyval (- (key_to_int key) 128))
X		
X		(= len (length_of_list kbd_labels))
X		(if (< len keyval)
X			(return key))
X		(return (nth keyval kbd_labels))
X		
X	)
X)
X/*----------------------------------------
X/*   Macro to perform a redo after an undo.
X/*----------------------------------------*/
X(macro redo
X	(undo 0 0 0)
X)
X(macro edit_next_buffer
X	(
X		(int	curbuf
X				nextbuf)
X		(string filename)
X
X		(= curbuf (inq_buffer))
X		(= nextbuf (next_buffer))
X
X		(if (== curbuf nextbuf) (
X			(error "No more buffers.")
X			(return)))
X
X		(set_buffer nextbuf)
X		(inq_names filename)
X		(edit_file filename)
X		(display_file_name)
X	)
X)
X(macro edit_prev_buffer
X	(
X		(int	curbuf
X				nextbuf)
X		(string	filename)
X
X		(= curbuf (inq_buffer))
X		(= nextbuf (next_buffer))
X
X		(if (== curbuf nextbuf) (
X			(error "No more buffers.")
X			(return)))
X
X		(while 1 (
X			(set_buffer nextbuf)
X			(if (== (next_buffer) curbuf)
X				(break))
X			(= nextbuf (next_buffer))
X			))
X		(set_buffer nextbuf)
X		(inq_names filename)
X		(edit_file filename)
X		(display_file_name)
X	)
X)
X(macro redit
X	(
X		(string file_name)
X		(int	tmpbuf curbuf line)
X
X		(inq_names NULL NULL file_name)
X		(inq_position line)
X
X		(= curbuf (inq_buffer))
X		(delete_buffer curbuf)
X
X		(edit_file "Non-existant")
X		(= tmpbuf (inq_buffer))
X
X		(shell_pop (+ "exec sccs edit " file_name))
X		(edit_file file_name)
X		(delete_buffer tmpbuf)
X		(goto_line line)
X	)
X)
X(macro shell_pop
X	(
X		(string command
X					space)
X		(int	curwin
X				curbuf
X				win
X				buf
X				line col)
X
X		(get_parm 0 command)
X		(= curwin (inq_window))
X		(= curbuf (inq_buffer))
X		(= buf (create_buffer "Shell Pop-Up" NULL 1))
X		(= win (create_window 55 8 77 2))
X		(attach_buffer buf)
X		(connect)
X		(insert (+ command "\n"))
X		(inq_position line col)
X		(set_process_position line col)
X		(insert_process (+ command "\n"))
X		(refresh)
X		;*
X		;*   Wait for process to exit.
X		;*
X		(wait)
X		(delete_buffer buf)
X		(delete_window)
X		(set_buffer curbuf)
X		(set_window curwin)
X	)
X)
X(macro	clear_buffer
X	(
X		(top_of_buffer)
X		(drop_anchor)
X		(end_of_buffer)
X		(delete_block)
X	)
X)
X;**************************************************
X;** ALT-!:  Pipe output from shell into buffer.  **
X;**************************************************
X(macro _pipe 	
X	(	(string	command)
X
X		(get_parm NULL command "!")
X		(sprintf command "%s >&bpipe.tmp" command)
X		(dos command)
X		(read_file "bpipe.tmp")
X		(del "bpipe.tmp")
X	)
X)
X
X;**************************************************
X;** .log:   Extension handler for .log files.    **
X;**************************************************
X(macro	.log
X	(
X		(set_backup)
X	)
X)
X(macro	.m
X	(tabs 4 7)
X)
X(macro	.c
X	(tabs 9 17)
X)
X(macro	default
X	(tabs 9 17)
X)
X//
X//	The following macro is called on startup and is responsible
X// for setting up the initial environment. In addition, it sets
X// up the following global variables which are used by the other
X// macros to try and ensure some form of portability between
X// operating systems.
X//
X//	string 	CRISP_OPSYS
X//		This contains the string:
X//			VMS	- if running under VMS
X//			UNIX	- if running under any Unix variant.
X//
X//	string	CRISP_DELIM
X//		This contains a string which can be used to concatenate a
X//		directory name and a filename. This string can be used
X//		for constructing filenames.
X//		Under VMS this is null; under Unix it is "/".
X//
X// string	CRISP_SLASH
X//		This contains the character used to delimit a directory
X//		name and a file name. This string can be used for breaking
X//		apart file-names.
X//		Under VMS this is "]"; under Unix it is "/".
X//
X(macro crisp
X	(
X		(int	win suflen kbd_normal)
X		(list	kbd_labels)
X		(global	kbd_normal
X					kbd_labels)
X		(string	kbd term suffix 
X					suffices 
X					CRISP_OPSYS
X					CRISP_DELIM
X					CRISP_SLASH
X					)
X		(global 	win 
X					CRISP_OPSYS
X					CRISP_DELIM
X					CRISP_SLASH
X					)
X
X		(= kbd_normal (inq_keyboard))
X		(assign_to_key "<Shift-Tab>"	"previous_tab")
X		(assign_to_key "<Shift-F5>"	"search_next")
X		(assign_to_key "<Shift-F6>"	"search_prev")
X		(assign_to_key "<Shift-F10>"	"cm")
X		(assign_to_key "<Home>"	"home")
X		(assign_to_key	"<End>"	"end")
X		(assign_to_key "<Ctrl-Left-Arrow>" "objects word_left")
X		(assign_to_key "<Ctrl-Right-Arrow>" "objects word_right")
X		(assign_to_key	"<Alt-1>"	"drop_bookmark 1")
X		(assign_to_key	"<Alt-2>"	"drop_bookmark 2")
X		(assign_to_key	"<Alt-3>"	"drop_bookmark 3")
X		(assign_to_key	"<Alt-4>"	"drop_bookmark 4")
X		(assign_to_key	"<Alt-5>"	"drop_bookmark 5")
X		(assign_to_key	"<Alt-6>"	"drop_bookmark 6")
X		(assign_to_key	"<Alt-7>"	"drop_bookmark 7")
X		(assign_to_key	"<Alt-8>"	"drop_bookmark 8")
X		(assign_to_key	"<Alt-9>"	"drop_bookmark 9")
X		(assign_to_key	"<Alt-0>"	"drop_bookmark 0")
X		(assign_to_key	"<Alt-B>"	"buffer_list 1")
X		(assign_to_key	"<Alt-F>"	"features")
X		(assign_to_key	"<Alt-H>"	"help")
X		(assign_to_key	"<Alt-P>"	"edit_prev_buffer")
X		(assign_to_key	"<Alt-N>"	"edit_next_buffer")
X		(assign_to_key	"<Alt-Q>"	"quote")
X		(assign_to_key	"<Alt-S>"	"search-fwd")
X		(assign_to_key	"<Alt-T>"	"translate-fwd")
X		(assign_to_key	"<Alt-Y>"	"search-back")
X		(assign_to_key	"#127"	"delete_character")
X		(assign_to_key	"^B"	"set_bottom_of_window")
X		(assign_to_key	"^C"	"set_center_of_window")
X		(assign_to_key	"^F"	"objects format_block")
X		(assign_to_key	"^G"	"objects routines")
X		(assign_to_key	"^H"	"backspace")
X		(assign_to_key	"^K"	"objects delete_word_left")
X		(assign_to_key	"^L"	"objects delete_word_right")
X		(assign_to_key	"^O"	"options")
X		(assign_to_key	"^R"	"repeat")
X		(assign_to_key	"^T"	"set_top_of_window")
X		(assign_to_key	"^U"	"redo")
X		(assign_to_key	"^^"	"brace")
X		(assign_to_key	"^]"	"tag_function")
X		/*-------------------------------------------------------
X		/*
X		/*	Find  out  what  operating system we are on. We do
X		/*	this  by  testing  for the existence of files that
X		/*	are  peculiar  to  the  operating  systems.  These
X		/*	tests  may  get  the wrong files in which case you
X		/*	may  need  to  tinker  with  them for best effect.
X		/*	The  purpose  here  is  to  have a global variable
X		/*	that  can  be  tested  in  the  macros  for system
X		/*	dependent    actions.   For   example,   VMS   has
X		/*	different  file  naming  conventions to unix which
X		/*	can cause the macros to fail.
X		/*-------------------------------------------------------*/
X		
X		(if (exist "sys$input") (
X				(= CRISP_OPSYS "VMS")
X				(= CRISP_DELIM "")
X				(= CRISP_SLASH "]")
X				)
X		;else
X			(if (exist "/") (
X				(= CRISP_OPSYS "UNIX")
X				(= CRISP_DELIM "/")
X				(= CRISP_SLASH "/")
X				)))
X		
X		/*---------------------------------------------------------*/
X		/*    Find   out   what   terminal   type  we  are,  and	  *
X		/*    initialise   the   terminal   characteristics  for	  *
X		/*    CRISP.  We  do  this  by  first seeing if BTERM is	  *
X		/*    set.  If  it  is, then we load tty/$BTERM; if not,	  *
X		/*    we   use   TERM,  and  see  if  tty/$TERM  exists.	  *
X		/*    Otherwise,  we  default  to  tty.m  If  the  BTERM	  *
X		/*    environment    variable    is    of    the   form:	  *
X		/*    type-type1-type2,  then  we  load  tty/type.m  and	  *
X		/*    execute  macros  'type1',  'type2', ... This is to	  *
X		/*    avoid  exceeding  the  14 character filename limit	  *
X		/*    on  Sys  V,  and also to keep terminal definitions	  *
X		/*    which are similar in the same tty file.				  *
X		/*---------------------------------------------------------*/
X		
X		(= term (inq_environment "BTERM"))
X		(if (== term "")
X			(= term (lower (inq_environment "TERM"))))
X		(= suflen (index term "-"))
X		(if suflen (
X				(= suffices (substr term (+ suflen 1)))
X				(= term (substr term 1 (- suflen 1)))
X				))
X		(if (|| (== term "") (! (load_macro (+ "tty/" term)))) 
X			(load_macro "tty/tty")
X			)
X		/*----------------------------------------
X		/*  Now scan suffix list.
X		/*----------------------------------------*/
X		(while (!= suffices "") (
X			(= suflen (index suffices "-"))
X			(if suflen (
X				(= suffix (substr suffices 1 (- suflen 1)))
X				(= suffices (substr suffices (+ suflen 1)))
X				)
X			;else
X				(
X					(= suffix suffices)
X					(= suffices "")
X				)
X			)
X			(execute_macro suffix)
X			))
X		/*----------------------------------------
X		/*  See if this guy has a keyboard description
X		/*  environment variable.
X		/*----------------------------------------*/
X		(= kbd (lower (inq_environment "BKBD")))
X		(load_macro (+ "kbd/" kbd))
X		;*
X		;*  We enable CRISP to update the screen, and tell it to
X		;*  refresh it.
X		;*
X		(enable_display 1)
X		(redraw)
X		;*
X		;*  Autoload definitions.
X		;*
X		(autoload "compile" 	
X									"cm"
X									"make" 
X									"lint"
X									"default-next_error" "default-previous_error")
X		(autoload "core" 		"_fatal_error")
X		(autoload "g_macros" 
X									"objects" 
X									"<<"
X									">>"
X									"c-routines" 
X									"h-routines" 
X									"m-routines"
X									"mm-routines"
X									"select_routine")
X		(autoload "help"
X									"help"
X									"help_display"
X									"explain")
X		(autoload "history" 
X									"_prompt_begin"
X									"_prompt_end")
X		(autoload "misc"
X									"autoindent"
X									"display_file_name"
X									"end"
X									"home"
X									"previous_tab"
X									"quote"
X									"repeat"
X									"delete_character"
X									"write_buffer"
X									)
X		(autoload "options" 
X									"options"
X									"echo_line-options")
X		(autoload "region"
X									"copy"
X									"cut"
X;									"paste"
X									)
X		(autoload "search"
X									"translate-fwd"
X									"search-fwd"
X									"search-back"
X									"search_next"
X									"search_prev"
X									"search-options")
X		(autoload "select" 
X									"field_list"
X									"sized_window" 
X									"select_list" 
X									"select_file" 
X									"select_buffer" 
X									"buffer_list")
X		(autoload "shell" 	
X									"sh" 
X									"csh" 
X									"ksh" 
X									"create_shell")
X		(autoload 	"tags"
X									"mtags"
X									"tag"
X									"tags"
X									"tag_function")
X		(autoload 	"telnet"
X									"rlogin")
X		(autoload 	"text"		
X									"grep"
X									"spell"
X									"wc")
X		(autoload 	"unix"		
X									"perform_unix_command")
X		(autoload	"window"
X									"set_top_of_window"
X									"set_bottom_of_window"
X									"set_center_of_window")
X		(autoload	"wp"
X									"wp-options"
X									"h-format_block"
X									"c-format_block"
X									"default-format_block"
X									"margin")
X		;*
X		;*   Tell user about any latest news.
X		;*
X		;* (welcome)
X	)
X)
X
SHAR_EOF
chmod 0444 src/crisp/crisp.m || echo "restore of src/crisp/crisp.m fails"
mkdir src src/crisp >/dev/null 2>&1
echo "x - extracting src/crisp/dial.m (Text)"
sed 's/^X//' << 'SHAR_EOF' > src/crisp/dial.m &&
X/********************************************************************
X *                                                                  *
X *      CRISP - Custom Reduced Instruction Set Programmers Editor   *
X *                                                                  *
X *      (C) Paul Fox, 1989                                          *
X *      43, Jerome Close                Tel: +44 6284 4222          *
X *          Marlow                                                  *
X *           Bucks.                                                 *
X *              England SL7 1TX                                     *
X *                                                                  *
X *                                                                  *
X *    Please See COPYRIGHT notice.                                  *
X *                                                                  *
X ********************************************************************/
X# include	"crisp.h"
X
X
X# define	TIMEOUT	60
X# define	TRUE		1
X# define	PREFIX	"\rATDT9"
X
X;***
X;*** Initialise modem description table.
X;***
X(macro	_init
X	(
X		(list	modem_strings)
X		(global modem_strings)
X		(int modem_active)
X		(global modem_active)
X
X		(unregister_macro 5 "dial_hangup")
X		(register_macro 5 "dial_hangup")
X
X		(= modem_strings (quote_list 
X			(300				"1\r")
X			(1200				"5\r")
X			(2400				"10\r")
X;			(4800				"3\r")
X;			(9600				"??")	; Not defined at present.
X;			(19200			"??") ;  "       "
X			("NO CARRIER" 	"3\r")
X			("BUSY"			"7\r")
X			("NO ANSWER"	"8\r")
X			("RING"			"2\r")
X			("BLACKLISTED" "26\r")
X			))
X	)
X)
X;***
X;*** Example dial macro for calling BIX. Note that this macro
X;*** is censored before being distributed world-wide. So you'll
X;*** have to fill in your own telephone number / passwords etc.
X;***
X;*** This macro dials an X.25 PAD in England and calls BIX.
X;*** Please tailor to your own needs, but please keep copy
X;*** safe otherwise future installations of CRISP may destroy
X;*** your private copy.
X;***
X(macro bix
X	(
X		(echo_line 9)  // Just Line number and time. Reduces load
X							// on display if we dont have to keep updating
X							// column and percentage.
X		(dial "BIX" "01-200-1353" 1200 									;*** PRIVATE
X				(						 		(insert_process "\r\rd1\r\r")		;*** PRIVATE
X				 (wait_for 20 "NUI?")	(insert_process "npssdem033WHU\r") ;*** PRIVATE
X				 (wait_for 20 "ADD?")	(insert_process	"a931060015787\r");*** PRIVATE
X				 (wait_for 20 "ame? ")	(insert_process	"foxy\r")			;*** PRIVATE
X				))
X	)
X)
X;***
X;*** (dial system-name number speed (waitfor transmit waitfor transmit ..))
X;***
X(macro dial
X	(
X		(int	dial_buf)
X		(global dial_buf)
X		(string	system-name number)
X		(int	speed line col)
X		(int	cmds retval)
X		(declare	d)
X
X		(dial_hangup)
X
X		(if (! (get_parm 0 system-name "System to dial : "))
X			(return))
X		(if (! (get_parm 1 number "Number to dial : "))
X			(return))
X		(if (! (get_parm 2 speed "Speed : " NULL 1200))
X			(return))
X
X		(= dial_buf (create_shell	"/bin/sh" 
X											(+ system-name "-Window") 
X											(| PF_ECHO PF_WAIT)
X						))
X		(assign_to_key "<Ctrl-S>" "dial_send")
X		(assign_to_key "<Ctrl-R>" "dial_recv")
X		(strip_cr 0)
X		(wait_for 10 "\$")
X		(insert "cu -l /dev/cua0 -t -s 1200\n")
X		(inq_position line col)
X		(set_process_position line col)
X		(insert_process "cu -l /dev/cua0 -t -s 1200\n")
X		(wait_for 10 "onnected\r")
X		(= modem_active TRUE)
X
X		(= retval (dial_dial modem_strings (+ (+ PREFIX number) "\r")))
X		(if (< retval 0) (
X			(error "Dialup failed.")
X			(return)))
X
X		(= d (nth 0 (nth retval modem_strings)))
X		(if (is_string d) (
X			(error d)
X			(return)))
X		(if (!= d speed) (
X			(error "Connected at wrong speed - %d." d)
X			(return)
X			))
X		(message "Connected at %d baud" speed)
X
X		(end_of_buffer)
X		(inq_position line col)
X		(set_process_position line col)
X
X		(get_parm 3 cmds)
X		(connect 0)
X		(sh_line_mode)
X	)
X)
X(macro	dial_hangup
X	(
X		(if (! modem_active)
X			(return))
X
X		(sh_char_mode)
X		(message "Saying goodbye to modem.")
X		(attach_buffer dial_buf)
X		(set_buffer dial_buf)
X		(insert_process "\r~.\r")
X		(refresh)
X		(wait_for 5 "\\[EOT]")
X		(= modem_active FALSE)
X	)
X)
X(macro dial_dial
X	(
X		(list	l)
X		(list	wlist)
X		(int	n)
X		(int	retval)
X		(declare	atom)
X		(string	number)
X		(int	line col)
X
X		(if (! (get_parm 0 l))
X			(return -1))
X		(if (! (get_parm 1 number))
X			(return -1))
X
X		(while TRUE (
X			(= atom (nth n l))
X			(if (is_null atom)
X				(break))
X			(put_nth n wlist (nth 1 atom))
X			(++ n)			
X			))
X		(insert number)
X		(refresh)
X		(inq_position line col)
X		(set_process_position line col)
X		(insert_process number)
X		(connect PF_WAIT)
X		(= retval (wait_for TIMEOUT wlist))
X		(return retval)
X	)
X)
X(macro dial_send
X	(
X		(string	filename)
X
X		(get_parm 0 filename)
X		(if (== filename "")
X			(= filename (select_file "*" "Send File")))
X		(if (== filename "")
X			(return))
X;		(get_parm 0 filename "File to send: ")
X		(insert_process (+ (+ "\r~Csx -bkvv " filename) "\n\n"))
X		(refresh)
X	)
X)
X(macro dial_recv
X	(
X		(string	filename)
X;		(get_parm 0 filename "File to receive: ")
X		(insert_process "\r~Crz -bvv\n")
X		(refresh)
X	)
X)
X
SHAR_EOF
chmod 0444 src/crisp/dial.m || echo "restore of src/crisp/dial.m fails"
mkdir src src/crisp >/dev/null 2>&1
echo "x - extracting src/crisp/edt.m (Text)"
sed 's/^X//' << 'SHAR_EOF' > src/crisp/edt.m &&
X/********************************************************************
X *                                                                  *
X *      CRISP - Custom Reduced Instruction Set Programmers Editor   *
X *                                                                  *
X *      (C) Paul Fox, 1989                                          *
X *      43, Jerome Close                Tel: +44 6284 4222          *
X *          Marlow                                                  *
X *           Bucks.                                                 *
X *              England SL7 1TX                                     *
X *                                                                  *
X *                                                                  *
X *    Please See COPYRIGHT notice.                                  *
X *                                                                  *
X *  Set of macros to emulate an EDT interface.							  *
X ********************************************************************/
X 
X# include	"crisp.h"
X# define	GOLD "OP"
X
X/*----------------------------------------
X/*   Definitions for current direction.
X/*----------------------------------------*/
X# define	ADVANCE	1
X# define	BACKUP	-1
X
X(macro _init
X	(
X		(string	edt_undo_line
X					edt_undo_word
X					edt_undo_char)
X		(int		edt_direction edt_col)
X		(global	edt_undo_line
X					edt_undo_word
X					edt_undo_char
X					edt_direction edt_col)
X		(= edt_direction ADVANCE)
X		/*----------------------------------------
X		/*   Make control characters display as
X		/*   they do in EDT.
X		/*----------------------------------------*/
X		(display_mode 0)
X		(set_display_chars 
X			"<NUL>" "<SOH>" "<STX>" "<ETX>" "<EOT>" "<ENQ>" "<ACK>" "<BEL>" 
X			"<BS>"  "<HT>"  "<NL>"  "<VT>"  "<FF>"  "<CR>"  "<SO>"  "<SI>" 
X			"<DLE>" "<DC1>" "<DC2>" "<DC3>" "<DC4>" "<NAK>" "<SYN>" "<ETB>" 
X			"<CAN>" "<EM>"  "<SUB>" "<ESC>" "<FS>"  "<GS>"  "<RS>"  "<US>")
X	)
X)
X(macro edt
X	(
X		(ansi)
X		(assign_to_key (+ GOLD "OD") "<<")
X		(assign_to_key (+ GOLD "OC") ">>")
X		
X		(assign_to_key "OQ" "help") 			/* PF2 */
X		(assign_to_key (+ GOLD "OQ") "help") 			/* PF2 */
X
X		(assign_to_key "OR" "search_next")	/* PF3 */
X		(assign_to_key (+ GOLD "OR") "search-fwd")	/* PF3 */
X
X		(assign_to_key "OS" (quote_list 
X										(
X											(= edt_undo_line (read))
X											(delete_to_eol)
X											(delete_char)
X										))) /* PF 4 */
X
X		(assign_to_key (+ GOLD "OS") (quote_list
X									(
X										(insert edt_undo_line)
X									)))	/* PF4 */
X
X		(assign_to_key "Ow" "search_fwd \"\x0c\"")	/* 7 */
X		(assign_to_key (+ GOLD "Ow") "execute_macro")	/* 7 */
X
X		(assign_to_key "Ox" (quote_list				/* 8 */
X										(
X											(if (== edt_direction ADVANCE)
X												(page_down)
X											;else
X												(page_up)
X												)
X										)))
X
X		(assign_to_key (+ GOLD "Ox") "page_direction")			/* 8 */
X		(assign_to_key "Oy" "message \"Sorry, not supported\"") /* 9 */
X		(assign_to_key "Om" "objects delete_word_right")		/* - */
X		(assign_to_key (+ GOLD "Om") (quote_list	/* - */
X									(
X										(insert edt_undo_word)
X									)))	/* PF4 */
X
X		(assign_to_key "Ot" (quote_list				/* 4 */
X										(
X											(message "Advance.")
X											(= edt_direction ADVANCE)
X										)))
X		(assign_to_key (+ GOLD "Ot") "end_of_buffer")			/* 4 */
X		(assign_to_key "Ou" (quote_list				/* 5 */
X										(
X											(message "Backup.")
X											(= edt_direction BACKUP)
X		(assign_to_key (+ GOLD "Ou") "top_of_buffer")			/* 5 */
X										)))
X		(assign_to_key "Ov" "cut")					/* 6 */
X		(assign_to_key (+ GOLD "Ov") "paste")					/* 6 */
X		(assign_to_key "Ol" (quote_list			/* , */
X										(
X										(= edt_undo_char (read 1))
X										(delete_char)
X										)))
X		(assign_to_key (+ GOLD "Ol") (quote_list	/* , */ 
X													(insert edt_undo_char)
X												))
X
X
X		(assign_to_key "Oq" (quote_list		/* 1 */
X										(
X											(if (== edt_direction ADVANCE)
X												(objects "word_right")
X											;else
X												(objects "word_left"))
X										)))
X
X		(assign_to_key "Or" "end_of_line")			/*  2 */
X		(assign_to_key "Os" (quote_list		/* 3 */
X										(
X											(if (== edt_direction ADVANCE)
X												(right)
X											;else
X												(left))
X										)))
X		(assign_to_key "OM" "copy")					/* Enter */
X
X		(assign_to_key "Op" (quote_list		/* 0 */
X										(
X											(if (== edt_direction ADVANCE)
X												(down)
X											;else
X												(up))
X										)))
X		(assign_to_key (+ GOLD "Op") (quote_list		/* 0 */
X										(
X											(save_position)
X											(beginning_of_line)
X											(insert "\n")
X											(restore_position)
X										)))
X		(assign_to_key "On" (quote_list
X										(
X											(message "Anchor dropped.")
X											(mark)
X										)
X									))					/* . */
X
X
X		(assign_to_key "^E" "edit_file")
X		(assign_to_key "#127" "backspace")
X		(assign_to_key "^H" (quote_list
X									(
X									(inq_position NULL edt_col)
X									(if (== edt_col 1)
X										(up)
X									;else
X										(beginning_of_line))
X									)))
X		(assign_to_key "^L" "self_insert")
X		(assign_to_key "^W" "write_buffer")
X		(assign_to_key "^U" "undo")
X		(autoindent "y")
X
X	)
X)
SHAR_EOF
chmod 0644 src/crisp/edt.m || echo "restore of src/crisp/edt.m fails"
mkdir src src/crisp >/dev/null 2>&1
echo "x - extracting src/crisp/features.m (Text)"
sed 's/^X//' << 'SHAR_EOF' > src/crisp/features.m &&
X/********************************************************************
X *                                                                  *
X *      CRISP - Custom Reduced Instruction Set Programmers Editor   *
X *                                                                  *
X *      (C) Paul Fox, 1989                                          *
X *      43, Jerome Close                Tel: +44 6284 4222          *
X *          Marlow                                                  *
X *           Bucks.                                                 *
X *              England SL7 1TX                                     *
X *                                                                  *
X *                                                                  *
X *    Please See COPYRIGHT notice.                                  *
X *                                                                  *
X ********************************************************************/
X(macro features
X	(
X		(int	result result1)
X
X		(= result  -1)
X		(= result1 -1)
X
X		(select_list "CRISP Features" "" 3 (quote_list
X			"ASCII Chart"				"feature_select"
X											"help_display \"features/Ascii.hlp\" \"ASCII\""
X			"Calculator"				"feature_select" 
X											"help_display \"features/Calc.hlp\" \"Calculator\""
X			"Compilation"				"feature_compile" 
X											"help_display \"features/Compile.hlp\" \"Compiling\""
X			"Current Filename"		"feature_select" 	
X											"help_display \"features/Filename.hlp\" \"Current Filename\""
X			"GREP"						"feature_select"	
X											"help_display \"features/Grep.hlp\" \"GREP\""
X			"List Buffers"				"feature_select"	
X											"help_display \"features/Buflist.hlp\" \"List Buffers\""
X			"Mail"						"feature_select"
X											"help_display \"features/Mail.hlp\" \"Mail\""
X			"Options"					"feature_select"	
X											"help_display \"features/Options.hlp\" \"Options\""
X			"Programming Features" 	"feature_programming"	
X											"help_display \"features/Program.hlp\" \"Compiling\""
X			"Region Manipulation"  	"feature_region"	
X											"help_display \"features/Region.hlp\" \"Regions\""
X			"Spell"						"feature_select"	
X											"help_display \"features/Spell.hlp\" \"Spelling\""
X			"Start a Sub-shell"		"feature_select"	
X											"help_display \"features/Shell.hlp\" \"Shells\""
X			"Word Count"			  	"feature_select"	
X											"help_display \"features/Wc.hlp\" \"Word Count\""
X			) 2)
X		(refresh)
X		(switch result 
X			1	(ascii)
X			2	(calc)
X			3	(switch result1
X					1	(lint)
X					2	(make)
X					)
X			4	(display_file_name)
X			5	(grep)
X			6	(buffer_list)
X			7	(mail)
X			8	(options)
X			9	(switch result1
X					1	(brace)
X					2	(tag)
X					3	(objects "routines")
X					)
X			10 (switch result1
X					1	(objects "format_block")
X					2	(block-lower_case)
X					3	(>>)
X					4	(<<)
X					5	(block-upper_case)
X					)
X			11 (spell)
X			12	(csh)
X			13	(wc)
X			)
X	)
X)
X(macro feature_select
X	(
X		(inq_position result)
X		(push_back (key_to_int "<Esc>"))
X	)
X)
X(macro feature_compile
X	(
X		(inq_position result)
X		(= result1 (select_list "Compile" "" 3 (quote_list
X			"Lint"			""
X								"help_display \"features/Compile.hlp\" \"Lint\" \"> The (lint) Macro\""
X			"Execute Make" ""
X								"help_display \"features/Compile.hlp\" \"Make\" \"> The (make) Macro\""
X			) 2))
X		(push_back (key_to_int "<Esc>"))
X	)
X)
X(macro feature_programming
X	(
X
X		(inq_position result)
X		(= result1 (select_list "Programming" "" 3 (quote_list
X			"Match brackets"	""
X									"help_display \"features/Program.hlp\" \"Bracket Matching\" \"> The Match Brackets Macro\""
X			"Find function"	""
X									"help_display \"features/Program.hlp\" \"Finding Functions\" \"> The Find Function Macro\""
X			"List functions"	""
X									"help_display \"features/Program.hlp\" \"Function List\" \"> The List Functions Macro\""
X			) 2))
X		(push_back (key_to_int "<Esc>"))
X	)
X)
X(macro feature_region
X	(
X		(inq_position result)
X		(= result1 (select_list "Regions" "" 1 (quote_list
X			"Justify Text"
X			"Lower case text"
X			"Indent Block"
X			"Unindent Block"
X			"Upper case text"
X			) 2))
X		(push_back (key_to_int "<Esc>"))
X	)
X)
SHAR_EOF
chmod 0444 src/crisp/features.m || echo "restore of src/crisp/features.m fails"
mkdir src src/crisp >/dev/null 2>&1
echo "x - extracting src/crisp/g_macros.m (Text)"
sed 's/^X//' << 'SHAR_EOF' > src/crisp/g_macros.m &&
X/********************************************************************
X *                                                                  *
X *      CRISP - Custom Reduced Instruction Set Programmers Editor   *
X *                                                                  *
X *      (C) Paul Fox, 1989                                          *
X *      43, Jerome Close                Tel: +44 6284 4222          *
X *          Marlow                                                  *
X *           Bucks.                                                 *
X *              England SL7 1TX                                     *
X *                                                                  *
X *                                                                  *
X *    Please See COPYRIGHT notice.                                  *
X *                                                                  *
X ********************************************************************/
X# include	"crisp.h"
X
X(macro objects
X	(
X		(string	ext 		   ;* Extension of current buffer.
X					function		;* Function to call.
X					macro_name	;* Name of macro to call.
X					)
X		(int		arg1)
X
X		(get_parm 0 function)
X		(get_parm 1 arg1)
X		(inq_names NULL ext NULL)
X		(assign_to_key	"^N"	"objects next_error")
X		(assign_to_key	"^P"	"objects previous_error")
X		(= macro_name (+ ext (+ "-" function)))
X		(if (! (inq_macro macro_name))
X			(= macro_name (+ "default-" function)))
X		(execute_macro macro_name arg1)
X	)
X)
X;*
X;*   Macros to shift left & shift right the currently marked
X;*   block.
X;*
X(macro >>
X	(
X		(objects ">>")
X	)
X)
X(macro <<
X	(
X		(objects "<<")
X	)
X)
X(macro default->>
X	(
X		(int marked)
X
X		(= marked (inq_marked))
X		(if (== marked 0)
X			(drop_anchor MK_LINE))
X		(beginning_of_line)
X		(translate "<" "\t" ST_GLOBAL ST_REGEXP NULL ST_BLOCK)
X		(if (== marked 0)
X			(raise_anchor))
X	)
X)
X(macro default-<<
X	(
X		(int marked)
X
X		(= marked (inq_marked))
X		(if (== marked 0)
X			(drop_anchor MK_LINE))
X		(beginning_of_line)
X		(translate "<\t" "" ST_GLOBAL ST_REGEXP NULL ST_BLOCK)
X		(if (== marked 0)
X			(raise_anchor))
X	)
X)
X;*
X;*   Delete word left/right macros.
X;*   Uses the word_left/word_right macros.
X;*
X(macro default-delete_word_right
X	(
X		(delete_word (default-word_right))
X	)
X)
X(macro default-delete_word_left
X	(
X		(delete_word (default-word_left))
X	)
X)
X(macro delete_word
X	(
X		(int	i)
X
X		(drop_anchor 4)
X		(get_parm 0 i)
X		(delete_block)
X		
X	)
X)
X;*
X;*	word_left macros.
X;*
X(macro default-word_left
X	(
X		(return (word_left "<|[ .()/\t]\\c[~ .()/\t]"))
X	)
X)
X(macro word_left
X	(	(int line col line1 col1)
X		(string	pat)
X
X		(get_parm 0 pat)
X		(inq_position line col)
X		(search_back pat -3)
X		(inq_position line1 col1)
X		(if (&& (== line line1) (== col col1)) (
X			(prev_char)
X			(return (search_back pat -3))))
X		(return 0)
X	)
X)
X;*
X;*	word_right macros.
X;* 
X(macro default-word_right
X		(return (word_right "<|[ .()/\t]\\c[~ .()/\t]"))
X)
X(macro word_right
X	(
X		(string	pat)
X
X		(get_parm 0 pat)
X		(next_char)
X		(return (search_fwd pat))
X	)
X)
X(macro default-routines
X	(
X		(error "No routines macro defined for this file.")
X	)
X)
X/* Routines for Intel assembler files */
X(macro asm-routines
X		(select_routine "<*{PROC}|{proc}"
X				"Assembler Subroutines" "asm-routines_trim")
X)
X(macro asm-routines_trim
X	(
X		(string	routine_name)
X
X		(get_parm 0 routine_name)
X		(return routine_name)
X	)
X)
X/* Routines for PostScript files. */
X(macro ps-routines
X		(select_routine "</"
X				"PostScript Definitions" "ps-routines_trim")
X)
X(macro ps-routines_trim
X	(
X		(string	routine_name)
X
X		(get_parm 0 routine_name)
X		(return routine_name)
X	)
X)
X/* Routines for Yacc source files. */
X(macro y-routines
X		(select_routine "<[_a-zA-Z0-9]+[ \t]@:"
X				"Yacc Rules" "y-routines_trim")
X)
X(macro y-routines_trim
X	(
X		(int		spos)
X		(string	routine_name)
X
X		(get_parm 0 routine_name)
X
X		(= spos (search_string ":" routine_name))
X		(if (> spos 0)
X				(= routine_name (substr routine_name 1 (- spos 1))))
X		(return (trim routine_name))
X
X	)
X)
X(macro c-routines
X		(select_routine "<[_a-zA-Z0-9]+[ \t]@*([^)\"]@)[^,;]@>"
X				"Functions" "c-routines_trim")
X)
X(macro c-routines_trim
X	(
X		(int		spos)
X		(string	routine_name)
X
X		(get_parm 0 routine_name)
X
X		(= spos (search_string "[;/{]" routine_name))
X		(if (> spos 0)
X				(= routine_name (substr routine_name 1 (- spos 1))))
X		(return (trim routine_name))
X
X	)
X)
X(macro h-routines
X		(select_routine "<{typedef}|{struct}\\c" "Structures" "h-routines_trim")
X)
X(macro h-routines_trim
X	(
X		(int		spos)
X		(string	routine_name)
X
X		(get_parm 0 routine_name)
X
X		(= spos (search_string "[;/{]" routine_name))
X		(if (> spos 0)
X				(= routine_name (substr routine_name 1 (- spos 1))))
X		(return (trim routine_name))
X
X	)
X)
X(macro hlp-routines
X		(select_routine "<\\> " "Sections" "hlp-routines_trim")
X)
X(macro hlp-routines_trim
X	(
X		(string	routine_name)
X
X		(get_parm 0 routine_name)
X		(return (substr routine_name 3))
X	)
X)
X(macro m-routines
X		(select_routine "<({macro}|{replacement}\\c" "Macros" "m-routines_trim")
X)
X(macro m-routines_trim
X	(
X		(int		spos)
X		(string	routine_name)
X
X		(get_parm 0 routine_name)
X
X		(= spos (search_string "[ \t;]" routine_name))
X		(if (> spos 0)
X				(return (substr routine_name 1 (- spos 1))))
X		(return routine_name)
X
X	)
X)
X(macro mm-routines
X		(select_routine "<\.{TH}|{H}|{SH}" "Sections" "mm-routines_trim")
X)
X(macro mm-routines_trim
X	(
X		(int		spos)
X		(string	routine_name)
X
X		(get_parm 0 routine_name)
X
X		(return routine_name)
X
X	)
X)
X;*
X;*   Routine to select language sepecific entities from a buffer.
X;*
X;*	(macro select_routine
X;*			sstr		search-string to find matching line.
X;*			name		name of things we are looking for.
X;*			)
X		
X(macro select_routine
X	(
X		(list		line_no_list)	;* List of line-numbers so we know
X										;* where to go to when the user makes
X										;* a selection.
X		(int		curbuf			;* Current buffer.
X					macbuf			;* Buffer to put macro names in.
X					mac_cnt			;* Count of macros encountered so far.
X					line				;* Temporary to contain line number of
X										;* of matched macro-name.
X					display_win		;* Window to display macros in.
X					spos				;* Search position.
X					selection		;* Users selection.
X					width				;* Maximum width so far.
X					)
X		(string	routine_name	;* Name of currently matched macro.
X					sstr				;* Search-string for matching lines.
X					name				;* Name of things we are looking for.
X					trim_func		;* Function to trim matched line.
X					msg
X					)
X
X		(get_parm 0 sstr)
X		(get_parm 1 name)
X		(get_parm 2 trim_func)
X		(= curbuf (inq_buffer))
X		(save_position)
X		(= macbuf (create_buffer name NULL 1))
X		(top_of_buffer)
X		(message "Scanning for %s..." (lower name))
X		(= mac_cnt 0)
X		(= width 10)
X
X		(while (search_fwd sstr) (
X				(= routine_name (ltrim (trim (compress (read)))))
X				(= routine_name (execute_macro trim_func routine_name))
X				(inq_position line)
X				(put_nth mac_cnt line_no_list line)
X				(set_buffer macbuf)
X				(if mac_cnt
X					(insert "\n"))
X				(insert routine_name)
X				(++ mac_cnt)
X;				(message "Scanning for %s [#%d]..." (lower name) mac_cnt)
X				(if (> (strlen routine_name) width)
X					(= width (strlen routine_name)))
X				(set_buffer curbuf)
X				(next_char)
X				)
X		)
X		(message "%d %s found." mac_cnt (lower name))
X		(restore_position)
X
X		;*
X		;*   If no macros found just tell the user and exit.
X		;*
X		(if (== mac_cnt 0) (
X				(message "No %s found." (lower name))
X				(delete_buffer macbuf)
X				(return)
X				))
X		;*
X		;*   We found some macros -- display them.
X		;*
X		(++ width)
X		(if (< width 26)
X			(= width 26))
X		(= msg (+ (key_label "<Alt-C>") " - copy to scrap. "))
X		(= display_win (sized_window (+ mac_cnt 1) width msg))
X		(message "Use arrow keys to make a selection.")
X		(= selection (select_buffer macbuf display_win SEL_NORMAL
X								(
X									(assign_to_key "<Ctrl-C>" "routines_copy")
X									(assign_to_key "<Alt-C>" "routines_copy")
X								)
X								NULL
X								"help_display \"features/Program.hlp\" \"Function List\" \"> The List Functions Macro\""
X							))
X		(delete_buffer macbuf)
X		(message "")
X		(if (< selection 0)
X			(return)
X			)
X		(goto_line (nth (- selection 1) line_no_list))
X 	)
X)
X(macro routines_copy
X	(
X		(save_position)
X		(top_of_buffer)
X		(drop_anchor MK_LINE)
X		(end_of_buffer)
X		(copy)
X		(restore_position)
X		(message "Routines copied to scrap.")
X	)
X)
SHAR_EOF
chmod 0444 src/crisp/g_macros.m || echo "restore of src/crisp/g_macros.m fails"
mkdir src src/crisp >/dev/null 2>&1
echo "x - extracting src/crisp/g_vi.m (Text)"
sed 's/^X//' << 'SHAR_EOF' > src/crisp/g_vi.m &&
X/********************************************************************
X *                                                                  *
X *      CRISP - Custom Reduced Instruction Set Programmers Editor   *
X *                                                                  *
X *      (C) Paul Fox, 1989                                          *
X *      43, Jerome Close                Tel: +44 6284 4222          *
X *          Marlow                                                  *
X *           Bucks.                                                 *
X *              England SL7 1TX                                     *
X *                                                                  *
X *                                                                  *
X *    Please See COPYRIGHT notice.                                  *
X *                                                                  *
X ********************************************************************/
X(macro _init
X	(
X		(int	_command_keymap _insert_keymap)
X		(string last_command)
X		(global	_command_keymap _insert_keymap last_command)
X
X		(keyboard_push)
X		(assign_to_key "<Left Arrow>" "left")
X		(assign_to_key "<Right Arrow>" "right")
X		(assign_to_key "<Up Arrow>" "up")
X		(assign_to_key "<Down Arrow>" "down")
X		(assign_to_key	"<PgUp>"	"page_up")
X		(assign_to_key	"<PgDn>"	"page_down")
X		(assign_to_key " " "right")
X		(assign_to_key	"."	"dot")
X		(assign_to_key "$" "end_of_line")
X		(assign_to_key "/" "search_fwd")
X		(assign_to_key "?" "search_back")
X		(assign_to_key "\^" "beginning_of_line")
X		(assign_to_key "^B" "page_up")
X		(assign_to_key "^F" "page_down")
X		(assign_to_key "^G" "display_file_name")
X		(assign_to_key	"^L"	"redraw")
X		(assign_to_key	"^M"	"down")
X		(assign_to_key "0"	"beginning_of_line")
X		(assign_to_key "A" "vi_Add")
X		(assign_to_key "B" "search_back \"[ \\t\\n]\"")
X		(assign_to_key "C"	"change")
X		(assign_to_key "D"	"delete_to_eol")
X		(assign_to_key "G" "end_of_buffer")
X		(assign_to_key "H" "top_of_window")
X		(assign_to_key "I"     "i_command")
X		(assign_to_key "J" "join_line")
X		(assign_to_key "L" "end_of_window")
X		(assign_to_key	"O"	"vi_Open")
X		(assign_to_key "W" "search_fwd \"[ \t\n]\\\\c[~ \t\n]\"")
X		(assign_to_key "X" "backspace")
X		(assign_to_key	"ZZ"	"x")
X		(assign_to_key "a" "vi_add")
X		(assign_to_key "b" "search_back \"[ \t\n]\"")
X		(assign_to_key	"db"	"db_cmd")
X		(assign_to_key	"dw"	"dw_cmd")
X		(assign_to_key "h" "left")
X		(assign_to_key "i" "vi_insert_mode 0")
X		(assign_to_key "j" "down")
X		(assign_to_key "k" "up")
X		(assign_to_key "l" "right")
X		(assign_to_key	"n"	"search_again")
X		(assign_to_key	"o"	"vi_open")
X		(assign_to_key	"p"	"paste")
X		(assign_to_key "u" "undo")
X		(assign_to_key "w" "search_fwd \"[.:;[\\\\]/ \t\n]\\\\c[~ \t\n]\"")
X		(assign_to_key "x"	"delete_char")
X		(assign_to_key ":" "execute_macro")
X		(= _command_keymap (inq_keyboard))
X		(keyboard_pop 1)
X
X		(keyboard_push)
X		(keyboard_typeables)
X		(assign_to_key	"<Esc>"	"vi_command_mode")
X		(assign_to_key "^H" "backspace")
X		(assign_to_key "#127" "backspace")
X		(= _insert_keymap (inq_keyboard))
X		(keyboard_pop 1)
X
X	)
X)
X(macro vi
X	(
X		(keyboard_push _command_keymap)
X		(process)
X		(keyboard_pop 1)
X	)
X)
X(macro vi_insert_mode
X	(
X		(int	arg)
X		(get_parm 0 arg)
X		(keyboard_pop 1)
X		(keyboard_push _insert_keymap)
X	)
X)
X(macro vi_command_mode
X	(
X		(keyboard_pop 1)
X		(keyboard_push _command_keymap)
X	)
X)
X(macro vi_open
X	(
X		(end_of_line)
X		(insert "\n")
X		(vi_insert_mode)
X	)
X)
X(macro vi_Open
X	(
X		(beginning_of_line)
X		(insert "\n")
X		(up)
X		(vi_insert_mode)
X	)
X)
X(macro vi_add
X	(
X		(right)
X		(vi_insert_mode)
X	)
X)
X(macro vi_Add
X	(
X		(end_of_line)
X		(vi_insert_mode)
X	)
X)
X(macro	db_cmd
X	(
X		(= last_command "db_cmd")
X		(delete_previous_word)
X	)
X)
X(macro	dw_cmd
X	(
X		(= last_command "dw_cmd")
X		(delete_next_word)
X	)
X)
X(macro e
X	(
X		(string	file)
X		(get_parm 0 file)
X		(edit_file file)
X	)
X)
X(macro r
X	(
X		(string	file)
X		(get_parm 0 file)
X		(read_file file)
X	)
X)
X(macro w		(write_buffer))
X(macro n		(next_buffer))
X(macro	x
X	(
X		(exit)
X		(exit)
X		(exit)
X	)
X)
X(macro join_line
X	(
X		(= last_command "join_line")
X		(end_of_line)
X		(delete_char)
X		(insert " ")
X	)
X)
X
X(macro change
X	(
X		(= last_command "change")
X		(delete_to_eol)
X		(vi_insert_mode)
X	)
X)
X(macro	i_command
X	(
X		(beginning_of_line)
X		(vi_insert_mode)
X	)
X)
X(macro	dot
X	(
X		(last_command)
X	)
X)
SHAR_EOF
chmod 0444 src/crisp/g_vi.m || echo "restore of src/crisp/g_vi.m fails"
mkdir src src/crisp >/dev/null 2>&1
echo "x - extracting src/crisp/hanoi.m (Text)"
sed 's/^X//' << 'SHAR_EOF' > src/crisp/hanoi.m &&
X/********************************************************************
X *                                                                  *
X *      CRISP - Custom Reduced Instruction Set Programmers Editor   *
X *                                                                  *
X *      (C) Paul Fox, 1989                                          *
X *      43, Jerome Close                Tel: +44 6284 4222          *
X *          Marlow                                                  *
X *           Bucks.                                                 *
X *              England SL7 1TX                                     *
X *                                                                  *
X *                                                                  *
X *    Please See COPYRIGHT notice.                                  *
X *                                                                  *
X ********************************************************************/
X# define	WIDTH	24
X
X(macro hanoi
X	(
X		(int discs i)
X		(int buf new_buf)
X		
X		(= discs 3)
X		(if (|| (<= (get_parm 0 discs "Number of discs: ") 0) (< discs 0))
X			(= discs 3)
X			)
X		(if (> discs 9)
X				(= discs 9)
X			)
X		(= buf (inq_buffer))
X		(= new_buf (create_buffer "Tower of Hanoi" NULL 1))
X		(set_buffer new_buf)
X		(attach_buffer new_buf)
X		(clear_buffer)
X		(insert "                                                                      \n")
X		(insert "                                                                      \n")
X		(insert "                                                                      \n")
X		(insert "            !                       !                       !             \n")
X		(insert "           xxx                      !                       !                 \n")
X		(if (> discs 1)
X		(insert "          xxxxx                     !                       !                 \n"))
X		(if (> discs 2)
X		(insert "         xxxxxxx                    !                       !                 \n"))
X		(if (> discs 3)
X		(insert "        xxxxxxxxx                   !                       !                   \n"))
X		(if (> discs 4)
X		(insert "       xxxxxxxxxxx                  !                       !                 \n"))
X		(if (> discs 5)
X		(insert "      xxxxxxxxxxxxx                 !                       !                \n"))
X		(if (> discs 6)
X		(insert "     xxxxxxxxxxxxxxx                !                       !                \n"))
X		(if (> discs 7)
X		(insert "    xxxxxxxxxxxxxxxxx               !                       !                \n"))
X		(if (> discs 8)
X		(insert "   xxxxxxxxxxxxxxxxxxx              !                       !                \n"))
X		(if (> discs 9)
X		(insert "  xxxxxxxxxxxxxxxxxxxxx             !                       !                \n"))
X		(insert "====================================================================    \n")
X		(hanoi0 discs 1 3 2)
X		(if (inq_kbd_char) (
X				(read_char)
X				(message "I've had enough of this!")
X				)
X		)
X		(set_buffer buf)
X	)
X)
X(macro hanoi0
X	(
X		(int	n sn dn hn)
X		(if (inq_kbd_char)
X			(return)
X			)
X		(get_parm 0 n)
X		(get_parm 1 sn)
X		(get_parm 2 dn)
X		(get_parm 3 hn)
X		(if (> n 0)
X				(
X					(hanoi0 (- n 1) sn hn dn)
X					(if (inq_kbd_char)
X							(return)
X							)
X					(move_piece sn dn)
X					(hanoi0 (- n 1) hn dn sn)
X				)
X			)
X	)
X)                                                                           
X(macro move_piece
X	(
X		(int	width i j from to col col1 col2 lines)
X		(string blanks disc)
X
X		(get_parm 0 from)
X		(get_parm 1 to)
X		(top_of_buffer)
X		(= i from)
X		(while (> i 0) (
X				(search_fwd "!")
X				(right)
X				(-- i)
X				)
X			)
X		(left)
X		(inq_position NULL col)
X		(while (== (read 1) "!")
X			(
X				(++ lines)
X				(down)
X			)
X		)
X		(search_back " \\c")
X		(inq_position NULL col1)
X		(search_fwd "x@\\c" -2)
X		(inq_position NULL col2)
X		(refresh)
X		(move_abs 0 col1)
X		(= width (- col2 col1))
X		(= disc (read width))
X		(up)
X		(move_abs 0 col1)
X		(= blanks (read width))
X		(down)
X		(= j lines)
X		(while (>= j 0) (
X				(replace_string blanks)
X				(up)
X				(replace_string disc)
X				(display_disc)
X				(-- j)
X				)
X			)
X		(if (> to from)
X				(= j (* (- to from) WIDTH))
X			;else
X				(= j (* (- from to) WIDTH))
X			)
X		(/= j 2)
X		(while (> j 0) (
X			(if (> to from) (
X					(insert "  ")
X					(inq_position NULL col)
X					(end_of_line)
X					(left 2)
X					(delete_char 2)
X					(move_abs 0 col)
X					)
X			;else
X				(
X					(left 2)
X					(inq_position NULL col)
X					(delete_char 2)
X					(end_of_line)
X					(insert "  ")
X					(move_abs 0 col)
X				)
X			)
X			(-- j)
X			(display_disc)
X			)
X		)				
X		(save_position)
X		(replace_string blanks)
X		(search_fwd "!")
X		(delete_char)
X		(insert " ")
X		(restore_position)
X		(down)
X		(replace_string disc)
X		(display_disc)
X		(while 1 (
X				(replace_string blanks)
X				(down)
X				(replace_string disc)
X				(display_disc)
X				(down)
X				(if (!= (read 1) " ")
X					(break)
X					)
X				(up)
X				)
X			)
X				
X						
X	)
X)
X(macro display_disc
X	(
X;			(drop_anchor 4)
X			(move_rel 0 width)
X			(refresh)
X			(move_rel 0 (- 0 width))
X;			(raise_anchor)
X	)
X)
X(macro replace_string
X	(
X		(string	str)
X		(int	col)
X
X		(get_parm 0 str)
X		(inq_position NULL col)
X		(delete_char (strlen str))
SHAR_EOF
echo "End of part 2"
echo "File src/crisp/hanoi.m is continued in part 3"
echo "3" > s2_seq_.tmp
exit 0
-- 
=====================			Reuters Ltd PLC, 
Tel: +44 628 891313 x. 212		 Westthorpe House,
UUCP:     fox%marlow.uucp@idec.stc.co.uk  Little Marlow,
					   Bucks, England SL7 3RQ