Usenet 1994 October

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume7 / crisp1.9 / part18 < prev next >

Wrap

Text File | 1989-06-18 | 49.6 KB | 1,913 lines

Newsgroups: comp.sources.misc From: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) Subject: v07i038: CRISP release 1.9 part 17/32 Organization: Reuters Ltd PLC, Marlow, England Reply-To: fox@marlow.UUCP (Paul Fox) Posting-number: Volume 7, Issue 38 Submitted-by: fox@marlow.UUCP (Paul Fox) Archive-name: crisp1.9/part18 #!/bin/sh # this is part 4 of a multipart archive # do not concatenate these parts, unpack them in order with /bin/sh # file src/crisp/makeman.m continued # CurArch=4 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/makeman.m" sed 's/^X//' << 'SHAR_EOF' >> src/crisp/makeman.m X (+ " 2 \"Macros to help writing Programs\"\n" END_SECTION)))) X (process_file "features/Program.hlp") X (insert (+ "\n" (+ START_SECTION X (+ " 2 \"Macros for Manipulating Regions\"\n" END_SECTION)))) X (process_file "features/Region.hlp") X (insert (+ "\n" (+ START_SECTION X (+ " 2 \"Macros for accessing sub-shells\"\n" END_SECTION)))) X (process_file "features/Shell.hlp") X (insert (+ "\n" (+ START_SECTION X (+ " 2 \"Macro for Counting Words.\"\n" END_SECTION)))) X (process_file "features/Wc.hlp") X (insert (+ "\n" (+ START_SECTION X (+ " 2 \"Calculator\"\n" END_SECTION)))) X (process_file "features/Calc.hlp") X (insert (+ "\n" (+ START_SECTION X (+ " 2 \"Ascii Wall Chart.\"\n" END_SECTION)))) X (process_file "features/Ascii.hlp") X ) X) X(macro chapter_5 X ( X (read_file (+ BHELP "roff/Lang.mm")) X (insert (+ "\n" (+ START_SECTION X (+ " 2 \"Macros and their Syntax\"\n" END_SECTION)))) X (process_file "lang/Macros.hlp") X (insert (+ "\n" (+ START_SECTION X (+ " 2 \"Language Data Types\"\n" END_SECTION)))) X (process_file "lang/Vars.hlp") X (insert (+ "\n" (+ START_SECTION X (+ " 2 \"The Macro Compiler\"\n" END_SECTION)))) X (process_file "lang/Compiler.hlp") X ) X) X(macro end_processing X ( X (top_of_buffer) X (translate "^.page_size$" PAGE_LENGTH 0) X (top_of_buffer) X (translate "CRISP" "\\\\fBCRISP\\\\fR" ST_GLOBAL) X (top_of_buffer) X (translate "BRIEF" "\\\\fBBRIEF\\\\fR" ST_GLOBAL) X (top_of_buffer) X (while (> (search_fwd "^.H") 0) ( X (down) X (delete_line) X (insert ".sp\n") X )) X (end_of_buffer) X (insert "\n.TC\n") X (switch MACROS X ME (me_end_processing) X MS (ms_end_processing) X ) X ) X) X# define WORDFILE "/tmp/word-file" X X(macro make_index X ( X (int srcbuf) X X (if (! INDEXING) X (return)) X (= srcbuf (inq_buffer)) X X (edit_file WORDFILE) X (clear_buffer) X (message "Inserting index entries...") X X (read_file (+ BHELP "/sections/Arith")) X (read_file (+ BHELP "/sections/Buffer")) X (read_file (+ BHELP "/sections/Debug")) X (read_file (+ BHELP "/sections/Env")) X (read_file (+ BHELP "/sections/File")) X (read_file (+ BHELP "/sections/Kbd")) X (read_file (+ BHELP "/sections/List")) X (read_file (+ BHELP "/sections/Macro")) X (read_file (+ BHELP "/sections/Misc")) X (read_file (+ BHELP "/sections/Movement")) X (read_file (+ BHELP "/sections/Proc")) X (read_file (+ BHELP "/sections/Scrap")) X (read_file (+ BHELP "/sections/Screen")) X (read_file (+ BHELP "/sections/Search")) X (read_file (+ BHELP "/sections/String")) X (read_file (+ BHELP "/sections/Var")) X (read_file (+ BHELP "/sections/Window")) X (sort_buffer) X (uniq) X (gen_index srcbuf WORDFILE) X (set_buffer srcbuf) X ) X) X(macro gen_index X ( X (string X wordfile X word X raw_word /* Word before quote_regexp gets hold of it*/ X regexp1 /* Used for fast find of possible match */ X regexp2 /* Used to locate exact match. */ X index_string X ) X X (int srcbuf X word_line X ) X X (get_parm 0 srcbuf) X (get_parm 1 wordfile) X X (edit_file wordfile) X (= word_line 1) X X /*---------------------------------------- X /* For each word in the index file, X /* scan the source file and insert .tm X /* requests into the source buffer. X /*----------------------------------------*/ X (while (<= word_line (inq_lines)) ( X (goto_line word_line) X (= raw_word (trim (ltrim (read)))) X (= word (quote_regexp raw_word)) X (message "Indexing '%s'..." word) X X (set_buffer srcbuf) X (top_of_buffer) X X (= regexp1 (+ "B" (+ word "\\\\"))) X (= regexp2 (+ "B" (+ word "\\"))) X (= index_string (+ ".tm " (+ "(\\f(HB" (+ raw_word "\\fR) \\n%\n")))) X (while (> (search_fwd regexp1) 0) ( X (beginning_of_line) X (down) X (beginning_of_line) X (insert index_string) X )) X (edit_file wordfile) X (++ word_line) X )) X (set_buffer srcbuf) X (attach_buffer srcbuf) X ) X) X(macro uniq X ( X (string str1 str2) X /*---------------------------------------- X /* Remove all duplicate lines. X /*----------------------------------------*/ X (top_of_buffer) X (= str1 (read)) X (= str2 "xx") X (message "Removing duplicates...") X (while (!= str2 "\n") ( X (= str2 (read)) X (if (== str1 str2) X (delete_line) X ;else X ( X (= str1 str2) X (down) X )) X )) X ) X) X(macro format_index X ( X (string str1 X str2 X token1 X token2 X word X page_list X ) X X /*---------------------------------------- X /* First sort all lines into order. X /* We have to make all single and double X /* digit numbers have leading zero's other X /* wise the sort comes out wrong. X /*----------------------------------------*/ X (top_of_buffer) X (translate " {[0-9]}$" " 0\\0" ST_GLOBAL) X (top_of_buffer) X (translate " {[0-9][0-9]}$" " 0\\0" ST_GLOBAL) X (sort_buffer) X (uniq) X X (top_of_buffer) X (= str1 (read)) X (= str2 "xx") X (message "Merging duplicates...") X (while (!= str2 "\n") ( X (= str2 (read)) X (= token1 (substr str1 1 (index str1 " "))) X (= token2 (substr str2 1 (index str2 " "))) X (if (!= token1 token2) ( X (= str1 str2) X (down) X (continue))) X (= word token1) X (= page_list (trim (substr str1 (+ (index str1 " ") 1)))) X (+= page_list (+ "," (trim (substr str2 (index str2 " "))))) X (= str1 (+ word page_list)) X (up) X (delete_line) X (delete_line) X (insert (+ str1 "\n")) X )) X /*---------------------------------------- X /* Now remove all leading zeros. X /*----------------------------------------*/ X (top_of_buffer) X (translate " 0+" " " ST_GLOBAL) X (top_of_buffer) X (translate " 0+{[1-9]}" " \\0" ST_GLOBAL -2) X (top_of_buffer) X (translate ") " ") . . . " ST_GLOBAL) X (top_of_buffer) X (translate "^" ".br\n" ST_GLOBAL) X (top_of_buffer) X (insert ".2C\n") X (write_buffer) X (message "Index table generated.") X ) X) X X(macro process_file X ( X (string filename) X X (get_parm 0 filename) X (message "Processing %s..." filename) X (= filename (+ BHELP filename)) X (save_position) X (read_file filename) X (restore_position) X X (convert_buffer) X ) X) X(macro convert_buffer X ( X (int line) X (string str str1) X X (inq_position line) X X // X // First make all multiple spaces into single spaces. X // This unformats the justified text. X // X (translate " @" " " ST_GLOBAL -1) X // X // Make section headings into nroff section headings. X // X (goto_line line) X (translate "^\\> {*$}" ".H 3 \"\\0\"" ST_GLOBAL) X // X // Put in paragraph marks. X // X (goto_line line) X (translate "^$" NEW_PARA ST_GLOBAL) X // X // Now make indented blocks into lists. X // X (goto_line line) X (do_DL_list) X (goto_line line) X (do_VL_list) X (goto_line line) X (do_AL_list) X // X // Create fixed displays. X // X (goto_line line) X (while (> (search_fwd "^ ") 0) ( X (insert NEW_PARA) X (insert "\n.in +1i\n") X (insert ".ft CW\n") X (while 1 ( X (down) X (if (!= (read 1) " ") X (break)) X (insert ".br\n") X )) X (insert ".ft R\n") X (insert ".in -1i\n") X )) X // X // Translate all funny characters. X // X (goto_line line) X (translate "\\\\" "\\\\\\\\" ST_GLOBAL) X // X // Translate all funny characters. X // X (goto_line line) X (translate "^'" "\\\\'" ST_GLOBAL) X (goto_line line) X (translate "~" "\\\\~" ST_GLOBAL) X // X // Boldify all CRISP macro names. X // X (translate "({[a-z_]+})" "(\\\\fB\\0\\\\fR)" ST_GLOBAL) X (end_of_buffer) X ) X) X(macro do_DL_list X ( X (int line) X X (while (> (search_fwd "^\t-[ \t]") 0) ( X (insert ".DL\n") X /*---------------------------------------- X /* Mark the region containing the current X /* list. X /*----------------------------------------*/ X (inq_position line) X (if (<= (search_fwd "^[A-Z.]") 0) ( X (end_of_buffer) X (next_char))) X (insert ".LE\n") X (up) X (drop_anchor MK_LINE) X /*---------------------------------------- X /* Now modify the entries. X /*----------------------------------------*/ X (move_abs line 1) X (translate "^\t-?" ".LI\n" ST_GLOBAL NULL NULL ST_BLOCK) X (move_abs line 1) X (translate "^\t\t" "" ST_GLOBAL NULL NULL ST_BLOCK) X (raise_anchor) X )) X ) X) X(macro do_VL_list X ( X (int line) X X (while (> (search_fwd "^\t-[^\t ]") 0) ( X (insert ".VL 10\n") X /*---------------------------------------- X /* Mark the region containing the current X /* list. X /*----------------------------------------*/ X (inq_position line) X (if (<= (search_fwd "^[A-Z]") 0) ( X (end_of_buffer) X (next_char))) X (insert ".LE\n") X (up) X (drop_anchor MK_LINE) X /*---------------------------------------- X /* Now modify the entries. X /*----------------------------------------*/ X (move_abs line 1) X (translate "^\t{-*}\t{*$}" ".LI \\0\n\\1" ST_GLOBAL NULL NULL ST_BLOCK) X (move_abs line 1) X (translate "^\t\t" "" ST_GLOBAL NULL NULL ST_BLOCK) X (raise_anchor) X )) X ) X) X(macro do_AL_list X ( X (int line) X X (while (> (search_fwd "^\t[1-9]") 0) ( X (insert ".AL\n") X /*---------------------------------------- X /* Mark the region containing the current X /* list. X /*----------------------------------------*/ X (inq_position line) X (if (<= (search_fwd "^[A-Z]") 0) ( X (end_of_buffer) X (next_char))) X (insert ".LE\n") X (up) X (drop_anchor MK_LINE) X /*---------------------------------------- X /* Now modify the entries. X /*----------------------------------------*/ X (move_abs line 1) X (translate "^\t[1-9]+. " ".LI\n" ST_GLOBAL NULL NULL ST_BLOCK) X (move_abs line 1) X (translate "^\t @" "" ST_GLOBAL NULL NULL ST_BLOCK) X (raise_anchor) X )) X ) X) X(macro process_sections X ( X (string section) X (int line) X X (save_position) X (read_file (+ BHELP "roff/Prim.mm")) X (restore_position) X (while (> (search_fwd "<##") 0) ( X (= section (substr (trim (read)) 3)) X (delete_line) X (insert ".sp 2\n") X (drop_anchor MK_LINE) X (read_file (+ BHELP (+ "sections/" section))) X (insert "\n") X (up) X (message (+ BHELP (+ "sections/" section))) X (translate "^{?*}$" ".ce\n(\\\\f(HB\\0\\\\fR)" ST_GLOBAL NULL NULL ST_BLOCK) X (raise_anchor) X (down) X )) X (end_of_buffer) X (down) X (beginning_of_line) X ) X) X(macro process_prim X ( X (int line) X (string str str1) X X (restore_position) X (insert ".in +.5i\n") X (insert "\\s-2\n") X (inq_position line) X X // X // Make sections stand out. X // X (message "Removing multiple spaces.") X (goto_line line) X (translate " @" " " ST_GLOBAL -1) X (goto_line line) X (message "Removing tabs at beginning of lines.") X (translate "^\t" "" ST_GLOBAL) X (goto_line line) X (message "Center macro name.") X (while (> (search_fwd "<.HU") 0) ( X (delete_line) X (translate "S*(" "(" 0) X (beginning_of_line) X (insert ".sp 1\n") X (insert ".DS CB\n") X (insert "\\s+3\\f(HB\n.ce\n") X (insert "___________________________________________________\n\n") X (while (!= (= str (read)) "\n") ( X (insert ".ce\n") X (insert (ltrim str)) X (delete_line) X )) X (insert "\\s0\\fR\n") X (insert ".DE") X )) X (message "Processing lists.") X (goto_line line) X (while (> (search_fwd "^\t") 0) ( X (insert ".in +.5i\n") X (insert ".VL 20\n") X (while (== (read 1) "\t") ( X (delete_char) X (insert ".LI \"") X (search_fwd "\t|$") X (if (== (read 1) "\t") ( X (delete_char) X (insert "\"\n") X (down) X ) X ;else X ( X (insert "\"") X (next_char) X )) X (while (== (read 2) "\t\t") ( X (delete_char 2) X (while (== (read 1) "\t") X (delete_char)) X (down))) X )) X (insert ".LE\n") X (insert ".in -.5i\n") X )) X (message "Rearranging descriptions and return.") X (goto_line line) X (while (> (search_fwd "<RETURN") 0) ( X (delete_line) X (delete_line) X X (save_position) X (drop_anchor MK_LINE) X (insert ".sp\n.Fo \"RETURN\\ VALUE\"\n") X (search_fwd "<{.sp 1}|{DESC}") X (up) X (cut) X (search_fwd "<{.sp 1}|{EX}") X (paste) X (restore_position) X (delete_line) X (insert ".Fo \"DESCRIPTION\"") X )) X (message "Making examples into Courier.") X (goto_line line) X (translate "^ {*$}" "\\\\f(CW\\0\\\\fR\n.br" ST_GLOBAL) X (goto_line line) X (message "Renaming Examples heading.") X (translate "EXAMPLES:" ".Fo \"EXAMPLES\"" ST_GLOBAL) X (goto_line line) X (message "Making macros stand out.") X (translate "({[a-z_]+}){?}" "(\\\\fB\\0\\\\fR)\\1" ST_GLOBAL) X (goto_line line) X (end_of_buffer) X (down) X (beginning_of_line) X (insert ".in -.5i\n") X (insert "\\s+2\n") X ) X) SHAR_EOF echo "File src/crisp/makeman.m is complete" chmod 0444 src/crisp/makeman.m || echo "restore of src/crisp/makeman.m fails" mkdir src src/crisp >/dev/null 2>&1 echo "x - extracting src/crisp/misc.m (Text)" sed 's/^X//' << 'SHAR_EOF' > src/crisp/misc.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 autoindent X ( X (string arg) X X (get_parm 0 arg "Turn autoindent on (y/n) ? ") X (if (== (upper (substr arg 1 1)) "Y") X (assign_to_key "<Enter>" "_indent") X ;else X (assign_to_key "<Enter>" "self_insert")) X ) X) X(macro _indent X ( X (int col) X X (if (& (inq_buffer_flags) BF_READONLY) ( X (down) X (beginning_of_line) X (return))) X (insert "\n") X (save_position) X X (if (<= (search_back "[~ \t]") 0) ( X (restore_position) X (return))) X X (beginning_of_line) X (search_fwd "[~ \t]") X (inq_position NULL col) X (restore_position) X (tab_to_col col) X ) X) X/************************************************************* X/* Macro to move the cursor back to the previous tab stop. * X/* This macro will not move the cursor beyond the beginning* X/* of the current line. * X/*************************************************************/ X(macro previous_tab X ( X (int X col X num X prev_num) X X /*---------------------------------------- X /* If we are already in column 1, dont go X /* back any further. X /*----------------------------------------*/ X (inq_position NULL col) X (if (== col 1) X (return)) X (left) X (= prev_num (distance_to_tab)) X (while 1 ( X (= num (distance_to_tab)) X (inq_position NULL col) X (if (< num prev_num) ( X (right) X (break))) X (if (== col 1) X (break)) X (= prev_num num) X (left) X )) X ) X) X X(macro tab_to_col X ( X (int col curcol hard_tabs) X (get_parm 0 col) X (beginning_of_line) X (= hard_tabs (use_tab_char "y")) X (use_tab_char (if hard_tabs "y" "n")) X (if (! hard_tabs) ( X (insert " " (- col 1)) X (return) X )) X (while 1 ( X (inq_position NULL curcol) X (if (>= curcol col) X (break)) X (insert "\t") X )) X (if (> curcol col) ( X (backspace) X (inq_position NULL curcol) X (insert " " (- col curcol)))) X ) X) X X(macro display_file_name X ( X (string filename buf) X (int cols len) X X (inq_names filename) X (inq_screen_size NULL cols) X (-= cols 43) X (= len (strlen filename)) X (if (> len cols) ( X (= filename (substr filename (- len cols))) X (= filename (+ "..." filename)) X )) X (message "File: %s%s" filename (if (inq_modified) "*" "")) X ) X) X(macro repeat X ( X (int count X ch) X (string macro_name) X X (= count 0) X (while 1 ( X (message "Repeat count = %d" count) X (while (== (= ch (read_char)) -1) X (nothing)) X (if (&& (>= ch '0') (<= ch '9')) ( X (= count (+ (* count 10) (- ch '0'))) X (continue))) X (if (== (int_to_key ch) "<Esc>") ( X (message "Repeat aborted.") X (return))) X (if (== (int_to_key ch) "<Ctrl-r>") ( X (if (== count 0) X (= count 1)) X (*= count 4) X (continue))) X (break) X )) X (= macro_name (inq_assignment (int_to_key ch))) X (while (> count 0) ( X (execute_macro macro_name) X (-- count) X )) X ) X) X(macro home X ( X (int line col) X X (inq_position line col) X (if (|| (!= line click_line) (!= col click_col)) X (= click_state 1)) X (switch click_state X 2 (top_of_window) X 3 (top_of_buffer) X NULL ( X (beginning_of_line) X (= click_state 1) X ) X ) X (inq_position click_line click_col) X (++ click_state) X ) X) X(macro end X ( X (int line col) X X (inq_position line col) X (if (|| (!= line click_line) (!= col click_col)) X (= click_state -1)) X (switch click_state X -2 (end_of_window) X -3 (end_of_buffer) X NULL ( X (end_of_line) X (= click_state -1) X ) X ) X (inq_position click_line click_col) X (-- click_state) X ) X) X(macro quote X ( X (int key) X (string buf) X X (= key -1) X (while (< key 0) X (= key (read_char))) X (sprintf buf "%c" key) X (insert buf) X ) X) X(macro delete_character X ( X (if (|| (!= (inq_called) "") (== (inq_marked) 0)) X (return (delete_char))) X (if (== (inq_marked) MK_COLUMN) X (block-delete) X ;else X (delete_block)) X ) X) X(replacement write_buffer X ( X (int ret X old_msg_level) X X (if (!= (inq_called) "") X (return (write_buffer)) X ;else X ( X (= old_msg_level (inq_msg_level)) X (if (inq_marked) X ( X (set_msg_level 1) X (= ret (write_block)) X ) X ;else X ( X (set_msg_level 0) X (= ret (write_buffer)) X )) X (set_msg_level old_msg_level) X (return ret) X )) X ) X) X(macro _init X ( X (int click_line X click_col X click_state X search-regexp X search-case X search-block X ) X (global click_line X click_col X click_state X search-regexp X search-case X search-block X ) X ) X) X SHAR_EOF chmod 0444 src/crisp/misc.m || echo "restore of src/crisp/misc.m fails" mkdir src src/crisp >/dev/null 2>&1 echo "x - extracting src/crisp/options.m (Text)" sed 's/^X//' << 'SHAR_EOF' > src/crisp/options.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 options X ( X (select_list "Options" "" X 3 X (quote_list X "Autoindenting" "autoindent" X "help_display \"features/Options.hlp\" \"Autoindenting\" \"> Autoindenting\"" X "Documents" "wp-options" X "help_display \"features/Options.hlp\" \"Documents\" \"> The Documents Option\"" X "Screen & Status" "echo_line-options" X "help_display \"features/Options.hlp\" \"Status Line\" \"> The Status Line Option\"" X "Searching" "search-options" X "help_display \"features/Options.hlp\" \"Searching\" \"> The Searching Option\"" X "Tabs" "tab-options" X "help_display \"features/Options.hlp\" \"Tabs\" \"> The Tabs Option\"" X ) 1) X ) X) X(macro echo_line-options X ( X (list r_list s_list) X (int options new_options ega_mode ega_mode1) X X (= options (echo_line)) X (= ega_mode (if (== 43 (ega)) 1 0)) X (put_nth 0 r_list ega_mode) X (put_nth 1 r_list (if (& options 0x01) 0 1)) X (put_nth 2 r_list (if (& options 0x02) 0 1)) X (put_nth 3 r_list (if (& options 0x04) 0 1)) X (put_nth 4 r_list (if (& options 0x08) 0 1)) X (= s_list (quote_list X "EGA Mode : " ("25-line" "43-line") X "Line prompt : " ("On" "Off") X "Col prompt : " ("On" "Off") X "Percent thru file : " ("On" "Off") X "Time : " ("On" "Off") X )) X (= r_list (field_list "Echo-Line Options" r_list s_list)) X (= new_options 0) X X (= ega_mode1 (if (nth 0 r_list) 1 0)) X (if (!= ega_mode1 ega_mode) X (ega (if ega_mode1 43 25))) X (if (! (nth 1 r_list)) X (+= new_options 0x01)) X (if (! (nth 2 r_list)) X (+= new_options 0x02)) X (if (! (nth 3 r_list)) X (+= new_options 0x04)) X (if (! (nth 4 r_list)) X (+= new_options 0x08)) X (if (!= new_options options) X (echo_line new_options)) X ) X) X(macro tab-options X ( X (list r_list s_list) X (int fill) X X (= fill (use_tab_char "y")) X (use_tab_char (if fill "n" "y")) X (put_nth 0 r_list (if fill 0 1)) X (= s_list (quote_list X "Fill with : " ("SPACES" "TABS") X )) X (= r_list (field_list "Tab Options" r_list s_list)) X (use_tab_char (if (== (nth 0 r_list) 0) "n" "y")) X ) X) SHAR_EOF chmod 0444 src/crisp/options.m || echo "restore of src/crisp/options.m fails" mkdir src src/crisp >/dev/null 2>&1 echo "x - extracting src/crisp/region.m (Text)" sed 's/^X//' << 'SHAR_EOF' > src/crisp/region.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 _init X ( X (string block_line) X (global block_line) X ) X) X(replacement copy X ( X (int old_msg_level) X X (if (!= (inq_called) "") X (return (copy))) X (if (inq_marked) ( X (= old_msg_level (inq_msg_level)) X (set_msg_level 0) X (copy) X (set_msg_level old_msg_level) X (return))) X X (drop_anchor MK_LINE) X (message "Line copied to scrap.") X (return (copy)) X ) X) X(replacement cut X ( X (int old_msg_level) X X (if (!= (inq_called) "") X (return (cut))) X (if (inq_marked) ( X (= old_msg_level (inq_msg_level)) X (set_msg_level 0) X (cut) X (set_msg_level old_msg_level) X (return))) X X (drop_anchor MK_LINE) X (message "Line cut to scrap.") X (return (cut)) X ) X) X;(replacement paste X; ( X; ) X;) X# define BLOCK_REPLACE 1 X(macro block-upper_case X ( X (block NULL ( X (insert (upper block_line)) X BLOCK_REPLACE X )) X ) X) X(macro block-lower_case X ( X (block NULL ( X (insert (lower block_line)) X BLOCK_REPLACE X )) X ) X) X(macro block-delete X ( X (block NULL ( X BLOCK_REPLACE X )) X ) X) X(macro block X ( X (int type X start_line X start_col X end_line X end_col X col X result X size) X (string macro_name X ) X X (= type (inq_marked start_line start_col end_line end_col)) X (if (== type 0) ( X (error "No marked region.") X (return))) X X (get_parm 0 macro_name) X X (= col (if (== type MK_COLUMN) start_col 1)) X (raise_anchor) X X (move_abs start_line start_col) X (while (<= start_line end_line) ( X (drop_anchor MK_NORMAL) X (save_position) X (if (|| (== type MK_COLUMN) (== start_line end_line)) X (move_abs 0 end_col) X ;else X ( X (end_of_line) X (prev_char) X )) X (= size (inq_mark_size)) X (raise_anchor) X (restore_position) X (= block_line (read size)) X (if (!= macro_name "") X (= result (execute_macro macro_name block_line)) X ;else X (get_parm 1 result)) X (switch result X BLOCK_REPLACE (delete_char size) X ) X (++ start_line) X (move_abs start_line col) X )) X (move_abs end_line end_col) X ) X) SHAR_EOF chmod 0444 src/crisp/region.m || echo "restore of src/crisp/region.m fails" mkdir src src/crisp >/dev/null 2>&1 echo "x - extracting src/crisp/regress.m (Text)" sed 's/^X//' << 'SHAR_EOF' > src/crisp/regress.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;******************************************************************* X; X; regress.m - Regression testing file for CRISP. X; X; Paul Fox, (C) 1988 X; X; Description: X; X; This file is used when debugging and fixing CRISP to aid X; in regression testing - catching bugs introduced inadvertently. X; X; This script does not attempt to exhaustively test CRISP, but tests X; are added whenever a bug is found, to ensure the bug does not get X; missed in the future. X; X; The tests in this file are mainly to do with testing the X; interpreter and simple aspects of the language. No attempt is X; made to test the correctnesss of the display, or reading/writing X; files. X; X; This file can also be run after porting CRISP, to ensure that X; these tests work as expected. If anything doesn't work that should, X; the porter will hae to check for portability problems. X; X; These tests attempt to do things in order of complexity. X; X;******************************************************************* X X# define TRUE 1 X# define FALSE 0 X X(macro regress X ( X (int i j k gi gj gk) X (int num_passed num_failed) X (list l1 l2 l3) X (declare d1 d2 d3) X (string s1 s2 s3 gs1 gs2 gs3) X (global gs1 gs2 gs3 gi gj gk) X (int buf old_buf) X X (= old_buf (inq_buffer)) X (= buf (create_buffer "Regression-Test" NULL 0)) X (set_buffer buf) X (attach_buffer buf) X X (top_of_buffer) X (drop_anchor 3) X (end_of_buffer) X (delete_block) X (top_of_buffer) X X (= num_passed 0) X (= num_failed 0) X X (= i (= j (= k 0))) X (= s1 "String one") X (= s2 "String two") X (= s3 "String three") X X (if (!= i 0) (failed 1) (passed)) X ;;;; X (= s1 s2) X (if (!= s1 "String two") (failed 2) (passed)) X ;;;; X (if (!= s1 (+ "String two" "")) (failed 3) (passed)) X ;;;; X (= s1 (+ s2 s3)) X (if (!= s1 "String twoString three") (failed 4) (passed)) X ;;;; X (= s1 (substr "ABC" -10000 20)) X (if (!= s1 "ABC") (failed 5) (passed)) X ;;;; X (= s1 (substr "ABC" 10000 20)) X (if (!= s1 "") (failed 6) (passed)) X ;;;; X (= s2 "HELLO") X (= s2 s2) X (if (!= s2 "HELLO") (failed 7) (passed)) X ;;;; X (= s2 "S2") X (= s1 (+ s2 (+ "-second-" s2))) X (if (!= s1 "S2-second-S2") (failed 8) (passed)) X ;;;; X (= s1 "variable") X (= k 99) X (if (! (test1_macro "literal-string" 23 s1 k)) (failed 9) (passed)) X ;;;; X (test2_macro i j k s1 s2 s3) X (if (!= k 27) (failed 10) (passed)) X (if (!= s1 "literal") (failed 11) (passed)) X (if (!= s2 "variable") (failed 12) (passed)) X ;;;; X (= k (if TRUE 2 3)) X (if (!= k 2) (failed 13) (passed)) X ;;;; X (= s1 (if TRUE "abc" "def")) X (if (!= s1 "abc") (failed 14) (passed)) X ;;;; X (= s1 (if FALSE "abc" "def")) X (if (!= s1 "def") (failed 15) (passed)) X ;;;; X (= s2 "variable") X (= k 99) X (sprintf s1 "%s,%d,%s,%d" "literal" 1 s2 k) X (if (!= s1 "literal,1,variable,99") (failed 16) (passed)) X ;;;; X (if (!= (test3_macro) "XYZZY") (failed 17) (passed)) X ;;;; X (switch 3 1 (= k 101) 2 (= k 102) 3 (= k 103)) X (if (!= k 103) (failed 18) (passed)) X ;;;; X (sprintf s1 "--%s--" (if 1 "abc" "def")) X (if (!= s1 "--abc--") (failed 19) (passed)) X ;;;; X (if (test4_macro) (failed 20) (passed)) X ;;;; X (switch "hello" X "hello, everybod" (= s1 "first") X "hello" (= s1 "second") X NULL (= s1 "default")) X (if (!= s1 "second") (failed 21) (passed)) X ;;;; X (= s1 "hello, everybod") X (= s2 "hello") X (switch "hello" X s1 (= s1 "first") X s2 (= s1 "second") X NULL (= s1 "default")) X (if (!= s1 "second") (failed 22) (passed)) X ;;;; X (= s1 "") X (= s1 (substr s1 (+ (index s1 ";") 1)) ) X (if (!= s1 "") (failed 23) (passed)) X ;;;; X (= gs1 "") X (get_parm 2 gs1) X (= gs1 (substr gs1 (+ (index gs1 ";") 1)) ) X (if (!= gs1 "") (failed 24) (passed)) X ;;;; X (= s1 "xyz") X (+= s1 "abc") X (if (!= s1 "xyzabc") (failed 25) (passed)) X ;;;; X (= s1 "xyz") X (= s2 "abc") X (+= s1 s2) X (if (!= s1 "xyzabc") (failed 26) (passed)) X ;;;; X (= s1 "xyz") X (= s2 s1) X (+= s1 s2) X (if (!= s1 "xyzxyz") (failed 27) (passed)) X ;;;; X (if (!= (test5_macro) "XYZ") (failed 28) (passed)) X ;;;; X (= s1 "xyz") X (if (!= (+= s1 "abc") "xyzabc") (failed 29) (passed)) X ;;;; X (= s1 "xyz") X (if (!= (+= s1 s1) "xyzxyz") (failed 30) (passed)) X ;;;; X (= s1 "xyz") X (if (!= (= s1 s1) "xyz") (failed 31) (passed)) X ;;;; X (= l1 (quote_list 123 "xyz" (hello))) X (if (!= (length_of_list l1) 3) (failed 32) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= l2 l1) X (if (!= (nth 0 l1) (nth 0 l2)) (failed 33) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= d1 (nth 0 l1)) X (if (! (is_integer d1)) (failed 34) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= d1 (nth 1 l1)) X (if (! (is_string d1)) (failed 35) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= d1 (nth 2 l1)) X (if (! (is_list d1)) (failed 36) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= d1 (nth 3 l1)) X (if (! (is_null d1)) (failed 37) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= l1 (quote_list 1)) X (put_nth 0 l1 2) X (if (!= (nth 0 l1) 2) (failed 38) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= l1 (quote_list 1 "abc")) X (put_nth 0 l1 2) X (if (!= (nth 0 l1) 2) (failed 39) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= l1 (quote_list "abc")) X (put_nth 0 l1 2) X (if (!= (nth 0 l1) 2) (failed 40) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= l1 (quote_list "abc" 1)) X (put_nth 1 l1 2) X (if (!= (nth 1 l1) 2) (failed 41) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= l1 (quote_list 1 "abc" 3)) X (put_nth 1 l1 2) X (if (!= (nth 1 l1) 2) (failed 42) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= l1 (quote_list 1 2 3)) X (put_nth 1 l1 "abc") X (if (!= (nth 1 l1) "abc") (failed 43) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= l1 (quote_list 1 2 3)) X (put_nth 1 l1 (quote_list (1 2 3))) X (if (!= (length_of_list l1) 3) (failed 44) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= l1 (quote_list 1 2 3)) X (put_nth 1 l1 (quote_list (1 2 3))) X (if (!= (nth 2 l1) 3) (failed 45) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= d1 (nth 1 l1)) X (if (!= (nth 2 d1) 3) (failed 46) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (put_nth 3 l1 "end") X (if (!= (nth 3 l1) "end") (failed 47) (passed)) X (if (!= (length_of_list l1) 4) (failed 48) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= l1 (quote_list ((1 2) (3 4) ("hello" "bye")))) X (= d1 (nth 1 l1)) X (if (! (is_list d1)) (failed 49) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (put_nth 0 l3 0) X (put_nth 1 l3 1) X (put_nth 2 l3 2) X (if (!= (nth 0 l3) 0) (failed 50) (passed)) X (if (!= (nth 1 l3) 1) (failed 51) (passed)) X (if (!= (nth 2 l3) 2) (failed 52) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= l1 NULL) X (if (!= (length_of_list l1) 0) (failed 53) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (put_nth 0 l1 "hello") X (if (!= (nth 0 l1) "hello") (failed 54) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= s1 "abc") X (put_nth 0 l1 s1) X (if (!= (nth 0 l1) "abc") (failed 55) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (= s1 "abc") X (put_nth 0 l1 s1) X (= s1 "123456789") X (if (!= (nth 0 l1) "abc") (failed 56) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (declare a57 b57) X (= b57 "hello") X (= a57 b57) X (if (!= a57 "hello") (failed 57) (passed)) X ;;;;;;;;;;;;;;;;;;;;;; X (message "Tests passed: %d, failed: %d" num_passed num_failed) X ) X) X(macro passed X ( X (++ num_passed) X ) X) X(macro failed X ( X (int num) X (string buf) X X (get_parm 0 num) X (sprintf buf "Test %d: Failed.\n" num) X (insert buf) X (++ num_failed) X ) X) X(macro test1_macro X ( X (string s1 s2) X (int i1 i2) X (get_parm 0 s1) X (get_parm 1 i1) X (get_parm 2 s2) X (get_parm 3 i2) X (return (&& (&& (&& (== s1 "literal-string") (== i1 23)) X (== s2 "variable")) (== i2 99)) ) X ) X) X(macro test2_macro X ( (string s1) X X X (= s1 "variable") X (put_parm 0 25) X (put_parm 1 26) X (put_parm 2 27) X (put_parm 3 "literal") X (put_parm 4 s1) X ) X) X(macro test3_macro X ( X (returns "XYZZY") X ) X) X(macro test4_macro X ( X (int dir re) X (string prompt) X X (= dir 0) X (= re 1) X (sprintf prompt "%c Pattern%s: " (if dir 25 24 ) (if re "" " (RE off)" )) X (return (!= prompt " Pattern: ")) X ) X) X(macro test5_macro X ( X (string s1) X (= s1 "XYZ") X (returns (if 1 s1 "def")) X ) X) SHAR_EOF chmod 0444 src/crisp/regress.m || echo "restore of src/crisp/regress.m fails" mkdir src src/crisp >/dev/null 2>&1 echo "x - extracting src/crisp/sdb.m (Text)" sed 's/^X//' << 'SHAR_EOF' > src/crisp/sdb.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 sdb X ( X (sdb_display_file "main.c" 15) X ) X) X(macro sdb_display_file X ( X (int sdb_buffer sdb_file_window) X (int line lines current_buffer current_window) X (string file sdb_file) X (global sdb_file sdb_buffer sdb_file_window) X X (get_parm 0 file) X (get_parm 1 line) X X (= current_buffer (inq_buffer)) X (= current_window (inq_window)) X X (if (== sdb_file_window 0) ( X (create_edge 2) X (= sdb_file_window (inq_window)) X ) X ;else X (set_window sdb_file_window) X ) X X (if sdb_buffer X (set_buffer sdb_buffer) X (= sdb_buffer (create_buffer "Sdb File" file 1)) X ) X X (attach_buffer sdb_buffer) X (goto_old_line line) X (inq_window_size lines) X (set_top_left (- line (/ lines 2))) X (insert "==> ") X X (set_window current_window) X ) X) SHAR_EOF chmod 0444 src/crisp/sdb.m || echo "restore of src/crisp/sdb.m fails" mkdir src src/crisp >/dev/null 2>&1 echo "x - extracting src/crisp/search.m (Text)" sed 's/^X//' << 'SHAR_EOF' > src/crisp/search.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 search-options X ( X (list r_list s_list) X (put_nth 0 r_list search-regexp) X (put_nth 1 r_list search-case) X (put_nth 2 r_list search-block) X (put_nth 3 r_list search-syntax) X (= s_list (quote_list X "Regular Expressions : " ("No" "Yes") X "Case sensitive : " ("No" "Yes") X "Block selection : " ("Off" "On") X "Syntax mode : " ("CRISP" "Unix") X )) X (= r_list (field_list "Search Parameters" r_list s_list)) X (= search-regexp (nth 0 r_list)) X (= search-case (nth 1 r_list)) X (= search-block (nth 2 r_list)) X (= search-syntax (nth 3 r_list)) X ) X) X(macro translate-fwd X ( X (int old_msg_level) X X (if (<= (get_parm NULL translate-pattern "Translate: " NULL translate-pattern) 0) X (return)) X (if (<= (get_parm NULL translate-replacement "Replacement: " NULL translate-replacement) 0) X (return)) X (= old_msg_level (inq_msg_level)) X (set_msg_level 0) X (translate translate-pattern translate-replacement NULL X search-regexp search-case search-block) X (set_msg_level old_msg_level) X ) X) X(macro search-fwd X ( X (int old_msg_level X match_len) X X (if (<= (get_parm NULL search-pattern "Search for: " NULL search-pattern) 0) X (return)) X (= old_msg_level (inq_msg_level)) X (set_msg_level 0) X (= match_len (search_fwd search-pattern search-regexp search-case search-block)) X (set_msg_level old_msg_level) X (return (search-hilite match_len)) X ) X) X(macro search-back X ( X (int old_msg_level X match_len) X X (if (<= (get_parm NULL search-pattern "Search back: " NULL search-pattern) 0) X (return)) X (= old_msg_level (inq_msg_level)) X (set_msg_level 0) X (= match_len (search_back search-pattern search-regexp search-case search-block)) X (set_msg_level old_msg_level) X (return (search-hilite match_len)) X ) X) X X(macro search_next X ( X (int old_msg_level X match_len) X X (save_position) X (next_char) X (= old_msg_level (inq_msg_level)) X (set_msg_level 0) X X (= match_len (search_fwd search-pattern search-regexp search-case search-block)) X (if (<= match_len 0) X (restore_position) X ;else X (restore_position 0)) X X (set_msg_level old_msg_level) X (return (search-hilite match_len)) X ) X) X(macro search_prev X ( X (int old_msg_level X match_len) X X (save_position) X (prev_char) X (= old_msg_level (inq_msg_level)) X (set_msg_level 0) X X (= match_len (search_back search-pattern search-regexp search-case search-block)) X (if (<= match_len 0) X (restore_position) X ;else X (restore_position 0)) X X (set_msg_level old_msg_level) X (return (search-hilite match_len)) X ) X) X X/************************************************************* X/* Macro to hilite a group of characters until a key is X/* pressed. Used by search-fwd and search-back macros. X/*************************************************************/ X(macro search-hilite X ( X (int ch) X (int match_len) X X (get_parm 0 match_len) X X (if (<= match_len 2) X (return match_len)) X X /*---------------------------------------- X /* If search is successful, hilite the X /* matched string but only if the matched X /* string len is at least 2 chars wide, X /* otherwise we have real problems on X /* a mono screen. We hilite the X /* string until the user presses another X /* key. X /*----------------------------------------*/ X (next_char (- match_len 1)) X (drop_anchor MK_NONINC) X (prev_char (- match_len 1)) X (refresh) X (while (== (= ch (read_char)) -1) X ) X (push_back ch) X (raise_anchor) X (return match_len) X ) X) X(macro _init X ( X (int search-regexp X search-case X search-block X search-syntax X ) X (string search-pattern X translate-pattern X translate-replacement) X (global search-regexp X search-case X search-block X search-pattern X search-syntax X translate-pattern X translate-replacement) X X (= search-regexp TRUE) X (= search-case TRUE) X (= search-block FALSE) X (= search-syntax 0) /* Set to 1 for Unix syntax. */ X ) X) X SHAR_EOF chmod 0444 src/crisp/search.m || echo "restore of src/crisp/search.m fails" mkdir src src/crisp >/dev/null 2>&1 echo "x - extracting src/crisp/select.m (Text)" sed 's/^X//' << 'SHAR_EOF' > src/crisp/select.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# define TRUE 1 X# define FALSE 0 X# define TOP_LINE 3 X# define WINDOW_OFFSET 6 X# define MARGIN 12 X X(macro _init X ( X (int top_line X window_offset X select_nest_level) X (global top_line X window_offset X select_nest_level) X X (= top_line TOP_LINE) X (= window_offset WINDOW_OFFSET) X ) X) X;* X;* Display list of buffers on screen, and allow user to make a selection. X;* X;* First parameter says whether to display in long or short format. X;* Short format is compatible with the BRIEF display; Long mode is X;* adds extra status fields, demonstrating CRISP's enhancements. X;* X;* Second parameter says whether to display system buffers as well. X;* X(macro buffer_list X ( X (int curbuf X curwin) X (int shortmode) X (int sysbuffers) X (int buf_no) X (int buffer_list) X (int win) X (int retval) X (int this_buf) X (int position) X (string file_name) X (string tmp line modes) X X (get_parm 0 shortmode) X (get_parm 1 sysbuffers) X X (= shortmode (! shortmode)) X X (= curbuf (inq_buffer)) X (= buffer_list (create_buffer "Buffer List" NULL 1)) X (set_buffer buffer_list) X X (= buf_no 1) X (set_buffer curbuf) X (set_buffer (next_buffer)) X (while (1) ( X (inq_names file_name) X (= this_buf (inq_buffer)) X (if (|| sysbuffers (! (inq_system))) ( X (if shortmode X (sprintf tmp "%d) %s%s\n" X buf_no X file_name X (if (inq_modified) "*" "")) X ;else X ( X (inq_position position) X (= modes "") X (+= modes (if (& (inq_buffer_flags) BF_CHANGED) "*" " ")) X (+= modes (if (& (inq_buffer_flags) BF_PROCESS) "P" " ")) X (+= modes (if (& (inq_buffer_flags) BF_BACKUP) "B" " ")) X (+= modes (if (& (inq_buffer_flags) BF_READONLY) "R" " ")) X (+= modes (if (inq_system) "S" " ")) X (+= modes (if (& (inq_buffer_flags) BF_BINARY) " <Bin> " " ")) X (sprintf tmp "%d) %5d %5d %s %s" X buf_no X (inq_lines) X position X modes X file_name) X ) X ) X (set_buffer buffer_list) X (if (> buf_no 1) X (insert "\n")) X (insert tmp) X (++ buf_no) X (set_buffer this_buf) X )) X (if (== (inq_buffer) curbuf) X (break)) X (set_buffer (next_buffer sysbuffers)) X )) X X (message "List created.") X X (= win (sized_window buf_no 70 "<Up>, <Down> to move. <Enter> to select, D to delete, W to write")) X (= retval (select_buffer buffer_list win SEL_NORMAL X ( X (assign_to_key "d" "buf_delete") X (assign_to_key "D" "buf_delete") X (assign_to_key "w" "buf_write") X (assign_to_key "W" "buf_write") X ) X NULL X "help_display \"features/Buflist.hlp\" \"List Buffers\"" X )) X X (if (< retval 0) ( X (delete_buffer buffer_list) X (set_buffer curbuf) X (attach_buffer curbuf) X (return) X )) X X (set_buffer buffer_list) X (move_abs retval 0) X (= line (trim (read))) X (delete_buffer buffer_list) X (set_buffer curbuf) X X (= line (substr line (+ (rindex line " ") 1))) X (if (== (substr line (strlen line)) "*") X (= line (substr line (- (strlen line) 1)))) X (edit_file line) X ) X) X(macro buf_delete X ( X (string line str) X (int buf) X X (= line (trim (read))) X (= line (substr line (+ (rindex line " ") 1))) X (if (== (substr line (strlen line)) "*") X (= line (substr line (- (strlen line) 1)))) X X (= buf (inq_file_buffer line)) X ;* X ;* Dont let user delete a buffer which is currently X ;* being displayed. X ;* X (if (inq_views buf) ( X (error "Cannot delete a buffer being displayed.") X (return))) X ;* X ;* If buffer has been modified, check whether user X ;* is really sure. X ;* X (if (inq_modified buf) ( X (= str "X") X (while (&& (!= str "y") (!= str "Y")) ( X (if (! (get_parm NULL str "Buffer has not been saved. Delete [ynw]? " 1)) X (= str "n")) X (if (|| (== str "n") (== str "N")) ( X (message "") X (return) X )) X (if (|| (== str "w") (== str "W")) ( X (int curbuf) X (= curbuf (inq_buffer)) X (set_buffer buf) X (write_buffer) X (set_buffer curbuf) X (break) X )) X )) X )) X (delete_buffer buf) X (delete_line) X ) X) X(macro buf_write X ( X (string line str) X (int curbuf buf) X X (= line (trim (read))) X (= line (substr line (+ (rindex line " ") 1))) X (if (== (substr line (strlen line)) "*") X (= line (substr line (- (strlen line) 1)))) X X (= buf (inq_file_buffer line)) X (if (! (inq_modified buf)) ( X (error "Buffer already saved.") X (return) X )) X (= curbuf (inq_buffer)) X (set_buffer buf) X (write_buffer) X (set_buffer curbuf) X (translate "*" " " 0 0) X (beginning_of_line) X (message "Buffer saved.") X ) X) X(macro select_file X ( X (string file path cwd wild_card title) X (int i) X X (getwd NULL cwd) X (get_parm 0 wild_card) X (get_parm 1 title) X (if (== wild_card "") X (= wild_card "*") X ; X (+= wild_card "*") X ) X (if (= i (rindex wild_card "/")) ( X (= path (substr wild_card 1 (- i 1))) X (cd path) X )) X (while 1 ( X (getwd NULL path) X (= file (_select_file path wild_card title)) X (if (== file "") X (break)) X (if (!= (substr file (strlen file)) "/") X (break)) X (cd file) X (= wild_card "*") X )) X (refresh) X (cd cwd) X (return (+ path (+ "/" file))) X ) X) X(macro _select_file X ( X (string name X file X path X wild-card X nl X title X tmpbuf) X (int size X ret X mtime X mode X curbuf X width X min_width X i X buf X win) X X (= curbuf (inq_buffer)) X (get_parm 0 path) X (= min_width (+ (strlen path) 6)) X (get_parm 2 title) X (= buf (create_buffer (if (!= title "") title path) NULL 1)) SHAR_EOF echo "End of part 4" echo "File src/crisp/select.m is continued in part 5" echo "5" > 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