allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) (07/23/89)
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