v07i036: CRISP release 1.9 part 15/32
Brandon S. Allbery - comp.sources.misc
allbery at uunet.UU.NET
Mon Jun 12 07:49:48 AEST 1989
Posting-number: Volume 7, Issue 36
Submitted-by: fox at 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 at idec.stc.co.uk Little Marlow,
Bucks, England SL7 3RQ
More information about the Comp.sources.misc
mailing list