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