🚀 go-pugleaf

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 8.1
$!   On 18-DEC-1992 15:37:53.35   By user FAIRFIELD   
$!
$! The VMS_SHARE software that created this archive
$!    was written by  Andy Harper, Kings College London UK
$!    -- September 1992
$!
$! Credit is due to these people for their original ideas:
$!    James Gray, Michael Bednarek 
$!
$!+ THIS PACKAGE DISTRIBUTED IN 3 PARTS, TO KEEP EACH PART
$!  BELOW 30 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. KHF$FORMAT.TPU;8
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_UNPACK_TEMP","SYS$SCRATCH:."+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if .not. f$trnlnm("SHARE_UNPACK_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto start
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$unpack: subroutine ! P1=filename, P2=checksum, P3=attributes
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'"
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn' File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-UNPACK, Unpacking file ''P1'"
$ n=P1
$ if P3 .nes. "" then $ n=f
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='n'
PROCEDURE GetHex LOCAL x1,x2;x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,
ERASE_CHARACTER(1))-1;RETURN 16*x1+x2;ENDPROCEDURE;
PROCEDURE SkipPartsep LOOP EXITIF INDEX(ERASE_LINE,"-+-+-+-+-+-+-+-+")=1;
ENDLOOP;ENDPROCEDURE;
PROCEDURE ExpandChar CASE CURRENT_CHARACTER FROM ' ' TO 'z' ["`"]
:ERASE_CHARACTER(1);COPY_TEXT(ASCII(GetHex));[" "]:ERASE_CHARACTER(1);[
OUTRANGE,INRANGE]:MOVE_HORIZONTAL(1);ENDCASE;ENDPROCEDURE;
PROCEDURE ProcessLine s:=ERASE_CHARACTER(1);LOOP EXITIF CURRENT_OFFSET>=LENGTH(
CURRENT_LINE);ExpandChar;ENDLOOP;IF s="V" THEN APPEND_LINE;ENDIF;ENDPROCEDURE;
PROCEDURE AdvanceLine MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);
ENDPROCEDURE;PROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE)=
END_OF(b);IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN SkipPartSep;
ELSE ProcessLine;AdvanceLine;ENDIF;ENDLOOP;ENDPROCEDURE;SET(FACILITY_NAME,
"UNPACK");SET(SUCCESS,OFF);SET(INFORMATIONAL,OFF);t:="0123456789ABCDEF";f:=
GET_INFO(COMMAND_LINE,"file_name");b:=CREATE_BUFFER(f,f);Decode;WRITE_FILE(b,
GET_INFO(COMMAND_LINE,"output_file"));QUIT;
$ if p3 .eqs. "" then $ goto dl
$ open/write fdl &f
$ write fdl "RECORD"
$ write fdl P3
$ close fdl
$ w "-I-CONVRFM, Converting record format to ", P3
$ convert/fdl=&f &f-1 &P1
$dl: delete 'f'*
$ if P2 .eqs. "" then $ goto ckskip
$ checksum 'P1'
$ if checksum$checksum .nes. P2 then $ -
  e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ exit
$ckskip: e "-W-CHKSUMSKIP, checksum validation unavailable for ''P1'"
$ endsubroutine
$start:
$!
$ create 'f'
Xprocedure`20KHF$FORMAT_MODULE_IDENT
X`20`20`20`20return`20"V02-001";
Xendprocedure;
X
X!++
X!`20`20`20KHF$FORMAT.TPU
X!
X!`20`20`20The`20procedures`20found`20here`20implement`20new`20EVE`20commands
V`20JUSTIFY,`20JUSTIFY
X!`20`20`20PARAGRAPH,`20and`20JUSTIFY`20RANGE.`20`20In`20order`20to`20avoid`20d
Vuplicate`20code,`20the
X!`20`20`20various`20EVE`20FILLxxxx`20procedures`20are`20found`20here,`20slight
Vly`20modified`20to
X!`20`20`20support`20calls`20to`20Khf$Fill_Edit`20and`20Khf$Justify.`20`20The
V`20modifications
X!`20`20`20are`20indicated`20by`20a`20"KHF"`20comments.`20`20Eve_Fill_paragraph
V`20was`20split`20into
X!`20`20`20two`20procedures`20to`20facilitate`20access`20from`20Eve_Justify_Par
Vagraph.
X!
X!
X!`20`20`20Modified`20procedures`20extracted`20from`20EVE$FORMAT.TPU`20(V02-100
Vb):
X!`09`09`09`09`20`20`20`20`20`20`20--------------
X!`09eve_fill_paragraph`09`09Now`20calls`20eve$fill_paragraph
X!`09eve$fill_paragraph`09`09Fill`20paragraph`20between`20margins`20using
X!`09`09`09`09`09`20`20spaces
X!`09eve$fill_range`09`09`09Fill`20a`20range
X!
X!`20`20`20New`20procedures`20in`20this`20file:
X!
X!`09Eve_Justify`09`09`09Fill`20and`20justify`20a`20range`20or`20paragraph
X!`09Eve_Justify_Paragraph`09`09Fill`20and`20justify`20a`20paragraph
X!`09Eve_Justify_Range`09`09Fill`20and`20justify`20the`20selected`20range
X!`09Eve_Unjustify`09`09`09Fill_Edit`20and`20fill`20a`20range`20or`20paragraph
X!`09Eve_Unjustify_Paragraph`09`09Fill_Edit`20and`20fill`20a`20paragraph
X!`09Eve_Unjustify_Range`09`09Fill_Edit`20and`20fill`20the`20selected`20range
X!`09Khf$Justify`09`09`09Does`20the`20work`20of`20right-justifying
X!`09`09`09`09`09`20`20a`20range
X!`09Khf$Fill_Edit`09`09`09Prepares`20a`20range`20for`20filling
X!
X!`20Author/Date:`09`09K.H.`20Fairfield,`09`0917-DEC-1992
X!
X!`20Revisions:
X!
X!--
X
X
X!-------------------------Modified`20EVE`20Procedures-------------------------
V-----
X
X
Xprocedure`20eve_fill_paragraph
X
X`20`20`20`20return`20(eve$fill_paragraph);
X
Xendprocedure;`09`09!`20eve_fill_paragraph
X
X
Xprocedure`20eve$fill_paragraph`09!`20Fill`20paragraph`20between`20margins`20us
Ving`20spaces
X!`09`20`20------------------
X`09`20`20`20`20`20(;do_justify,`09!`20Flag`20whether`20to`20justify`20the`20pa
Vragraph
X`09`09`09`09!`20`20`20(DEFAULT`20=`20FALSE)
X`09`20`20`20`20`20`20`20do_fill_edit)`09!`20Flag`20whether`20to`20callKhf$Fill
V_Edit`20before
X`09`09`09`09!`20`20`20fill`20(DEFAULT`20=`20do_justify)
X
Xlocal`09saved_mark,`09`09!`20Marker`20for`20current`20cursor`20position
X`09start_paragraph,`09!`20Marker`20for`20start`20of`20current`20paragraph
X`09stop_paragraph,`09`09!`20Marker`20for`20end`20of`20current`20paragraph
X`09the_right_margin,
X`09the_left_margin,
X`09the_indent,
X`09fill_range;`09`09!`20Range`20for`20current`20paragraph
X
Xon_error
X`20`20`20`20`5BOTHERWISE`5D:
Xendon_error;
X
Xif`20get_info`20(current_buffer,`20"system")
Xthen
X`20`20`20`20eve$message`20(EVE$_CANTSYSTEMBUF);
X`20`20`20`20eve$learn_abort;
X`20`20`20`20return`20(FALSE);
Xendif;
X
X!`20Can't`20fill`20an`20empty`20buffer`20-`20avoid`20additional`20checks`20lat
Ver`20on
X
Xif`20beginning_of`20(current_buffer)`20=`20end_of`20(current_buffer)
Xthen
X`20`20`20`20eve$message`20(EVE$_NOFILL);
X`20`20`20`20eve$learn_abort;
X`20`20`20`20return`20(FALSE);
Xendif;
X
Xif`20not`20eve$declare_intention`20(eve$k_action_format)
Xthen
X`20`20`20`20return`20(FALSE);
Xendif;
X
Xif`20do_justify`20=`20tpu$k_unspecified`09`09`09`09`09!`20KHF
Xthen`09`09`09`09`09`09`09`09`09!`20KHF
X`20`20`20`20do_justify`20:=`20FALSE;`09`09`09`09`09`09!`20KHF
Xendif;`09`09`09`09`09`09`09`09`09!`20KHF
X
Xif`20do_fill_edit`20=`20tpu$k_unspecified`09`09`09`09`09!`20KHF
Xthen`09`09`09`09`09`09`09`09`09!`20KHF
X`20`20`20`20do_fill_edit`20:=`20do_justify;`09`09`09`09`09`09!`20KHF
Xendif;`09`09`09`09`09`09`09`09`09!`20KHF
X
Xposition`20(TEXT);
Xsaved_mark`20:=`20mark`20(NONE);
X
X!`20Find`20beginning`20of`20paragraph.`20`20Paragraph`20breaks`20are`20blank
V`20lines,`20DOCUMENT`20tags,
X!`20runoff`20commands,`20FF`20(hard`20FF),`20or`20FF+NL`20(soft`20FF).`20`20If
V`20on`20a`20paragraph`20break
X!`20other`20than`20a`20DOCUMENT`20tag`20or`20runoff`20command`20line,`20then
V`20do`20preceding`20paragraph.
X
Xposition`20(LINE_BEGIN);
Xif`20search_quietly`20(ANCHOR`20+`20LINE_BEGIN`20+
X`09`09`20`20`20(("."`20`7C`20"<")`20+`20any`20(eve$x_runoff_characters)),
X`09`09`20`20`20FORWARD)`20<>`200
Xthen
X`20`20`20`20!`20on`20DOCUMENT`20tag`20or`20runoff`20command`20line,`20go`20to
V`20next`20line
X`20`20`20`20position`20(LINE_END);
X`20`20`20`20move_horizontal`20(1);
X`20`20`20`20start_paragraph`20:=`20mark`20(NONE);
Xelse
X`20`20`20`20loop
X`09!`20stop`20at`20top`20of`20buffer
X`09exitif`20mark`20(NONE)`20=`20beginning_of`20(current_buffer);
X`09move_vertical`20(-1);
X`09position`20(LINE_BEGIN);`20`20!`20incase`20set(column_move_vertical,on)
X`09!`20stop`20at`20a`20break`20and`20move`20to`20start`20of`20next`20line
X`09if`20eve$paragraph_break
X`09then
X`09`20`20`20`20position`20(LINE_END);
X`09`20`20`20`20move_horizontal`20(1);
X`09`20`20`20`20exitif;
X`09endif;
X`20`20`20`20endloop;
X`20`20`20`20start_paragraph`20:=`20mark`20(NONE);
X`20`20`20`20position`20(saved_mark);
Xendif;
X
X!`20find`20end`20of`20paragraph
X
Xloop
X`20`20`20`20position`20(LINE_BEGIN);
X`20`20`20`20exitif`20mark`20(NONE)`20=`20end_of`20(current_buffer);
X`20`20`20`20exitif`20eve$paragraph_break;
X`20`20`20`20move_vertical`20(1);
Xendloop;
X
Xif`20start_paragraph`20=`20mark`20(NONE)
Xthen
X`20`20`20`20eve$message`20(EVE$_NOFILL);
X`20`20`20`20position`20(saved_mark);
X`20`20`20`20eve$learn_abort;
X`20`20`20`20return`20(FALSE);
Xelse
X`20`20`20`20move_horizontal`20(-1);
X`20`20`20`20stop_paragraph`20:=`20mark`20(NONE);
X
X`20`20`20`20!`20Now`20fill`20the`20paragraph
X
X
X`20`20`20`20the_right_margin`20:=`20get_info`20(current_buffer,`20"right_margi
Vn");
X
X`20`20`20`20if`20eve$$x_word_wrap_indent`20`7Bcurrent_buffer`7D`20<>`20tpu$k_u
Vnspecified
X`20`20`20`20then
X`09the_left_margin`20:=`20eve$$x_word_wrap_indent`20`7Bcurrent_buffer`7D;
X`20`20`20`20else
X`09the_left_margin`20:=`20get_info`20(current_buffer,`20"left_margin");
X`20`20`20`20endif;
X
X`20`20`20`20if`20eve$$x_paragraph_indent`20`7Bcurrent_buffer`7D`20<>`20tpu$k_u
Vnspecified
X`20`20`20`20then
X`09the_indent`20:=`20eve$$x_paragraph_indent`20`7Bcurrent_buffer`7D
X`09`09`20`20`20`20`20`20-`20the_left_margin;
X`20`20`20`20else
X`09the_indent`20:=`20get_info`20(current_buffer,`20"left_margin")`20-
X`09`09`20`20`20`20`20`20the_left_margin;
X`20`20`20`20endif;
X
X`20`20`20`20fill_range`20:=`20create_range`20(start_paragraph,`20stop_paragrap
Vh,`20NONE);
X
X`20`20`20`20if`20do_fill_edit`09`09`09`09`09`09`09!`20KHF
X`20`20`20`20then`09`09`09`09`09`09`09`09!`20KHF
X`09khf$fill_edit`20(fill_range);`09`09`09`09`09!`20KHF
X`09!`20`20Replace`20the`20previous`20line`20by:`09`09`09`09!`20KHF
X`09!`20`20`20`20edit`20(fill_range,`20COMPRESS,`20TRIM,`20OFF);`09`09`09!`20KH
VF
X`09!`20`20to`20suppress`20extra`20space`20following`20sentences...`09`09!`20KH
VF
X`20`20`20`20else`09`09`09`09`09`09`09`09!`20KHF
X`09edit`20(fill_range,`20TRIM_LEADING,`20OFF);
X`20`20`20`20endif;`09`09`09`09`09`09`09`09!`20KHF
X
X`20`20`20`20fill`20(fill_range,`20eve$x_fill_separators,
X`09`20`20the_left_margin,`20the_right_margin,`20the_indent);
X
X`20`20`20`20if`20do_justify`09`09`09`09`09`09`09!`20KHF
X`20`20`20`20then`09`09`09`09`09`09`09`09!`20KHF
X`09khf$justify`20(fill_range);`09`09`09`09`09!`20KHF
X`20`20`20`20endif;`09`09`09`09`09`09`09`09!`20KHF
X
X`20`20`20`20position`20(stop_paragraph);
X`20`20`20`20eve$show_first_line;
Xendif;
Xreturn`20(TRUE);
X
Xendprocedure;`09!`20eve$fill_paragraph
X
X`0C
X!`20EVE$FORMAT.TPU`09`09`09`09`09`09`09Page`2012
X
Xprocedure`20eve$fill_range`09`09!`20Fill`20a`20range
X`20`20`20`20(range_arg;
X`20`20`20`20`20do_justify,`09`09!`20Flag`20whether`20to`20right-justify`20the
V`20range
X`09`09`09`09!`20`20`20(DEFAULT`20=`20FALSE)
X`20`20`20`20`20do_fill_edit)`09`09!`20Flag`20whether`20to`20callKhf$Fill_Edit
V`20before
X`09`09`09`09!`20`20`20fill`20(DEFAULT`20=`20do_justify)
X
Xlocal`09the_range,
X`09start_mark,`09`09`09!`20Start`20of`20the`20range`20to`20fill
X`09the_right_margin,
X`09the_left_margin,
X`09the_indent,
X`09status,
X`09old_right_margin,
X`09end_mark;`09`09`09!`20Marker`20for`20end`20of`20range
X
Xon_error
X`20`20`20`20`5BTPU$_CONTROLC`5D:
X`09eve$$release_scratch_buffer;
X`09if`20old_right_margin`20<>`200
X`09then
X`09`20`20`20`20set`20(RIGHT_MARGIN,`20eve$$x_scratch_buffer,`20old_right_margi
Vn);
X`09endif;
X`09eve$learn_abort;
X`09abort;
X`20`20`20`20`5BOTHERWISE`5D:
X`09eve$$release_scratch_buffer;
X`09if`20old_right_margin`20<>`200
X`09then
X`09`20`20`20`20set`20(RIGHT_MARGIN,`20eve$$x_scratch_buffer,`20old_right_margi
Vn);
X`09endif;
Xendon_error;
X
Xif`20not`20eve$declare_intention`20(eve$k_action_format)
Xthen
X`20`20`20`20return`20(FALSE);
Xendif;
X
Xif`20do_justify`20=`20TPU$K_UNSPECIFIED`09`09`09`09`09!`20KHF
Xthen`09`09`09`09`09`09`09`09`09!`20KHF
X`20`20`20`20do_justify`20:=`20FALSE;`09`09`09`09`09`09!`20KHF
Xendif;`09`09`09`09`09`09`09`09`09!`20KHF
X
Xif`20do_fill_edit`20=`20TPU$K_UNSPECIFIED`09`09`09`09`09!`20KHF
Xthen`09`09`09`09`09`09`09`09`09!`20KHF
X`20`20`20`20do_fill_edit`20:=`20do_justify;`09`09`09`09`09`09!`20KHF
Xendif;`09`09`09`09`09`09`09`09`09!`20KHF
X
Xthe_range`20:=`20range_arg;
Xif`20the_range`20<>`200
Xthen
X`20`20`20`20if`20get_info`20(the_range,`20"type")`20=`20ARRAY
X`20`20`20`20then
X`09!`20box`20selection
X`09if`20not`20eve$$reserve_scratch_buffer
X`09then
X`09`20`20`20`20eve$message`20(EVE$_ILLSCRATCHRES);
X`09`20`20`20`20return`20(FALSE);
X`09endif;
X`09erase`20(eve$$x_scratch_buffer);
X`09position`20(the_range`20`7B1`7D);
X`09!`20cut`20box`20to`20scratch`20buffer
X`09eve$$box_cut`20(the_range,`20eve$$x_scratch_buffer,
X`09`09`20`20`20`20`20`20TRUE,`09!`20delete`20the`20box
X`09`09`20`20`20`20`20`20FALSE);`09!`20no`20messages
X`09!`20set`20up`20the`20scratch`20buffer`20to`20be`20filled`20to`20box's`20wid
Vth
X`09old_right_margin`20:=`20get_info`20(eve$$x_scratch_buffer,`20"right_margin"
V);
X`09if`20length`20(the_range`20`7B1`7D)`20=`201
X`09then`09!`20avoid`20left=right=1
X`09`20`20`20`20set`20(RIGHT_MARGIN,`20eve$$x_scratch_buffer,`202);
X`09else
X`09`20`20`20`20set`20(RIGHT_MARGIN,`20eve$$x_scratch_buffer,`20length`20(the_r
Vange`20`7B1`7D));
X`09endif;
X`09eve$trim_buffer`20(eve$$x_scratch_buffer);
X`09position`20(eve$$x_scratch_buffer);
X`09if`20eve$fill_range`20(create_range`20(BUFFER_BEGIN,`20BUFFER_END),`09!`20K
VHF
X`09`09`09`20`20`20do_justify,`20do_fill_edit)`09`09`09!`20KHF
X`09then
X`09`20`20`20`20!`20Now`20overstrike`20the`20filled`20scratch`20buffer`20over
V`20original`20box.
X`09`20`20`20`20!`20This`20can't`20add`20more`20lines`20since`20no`20text`20tha
Vt`20exceeds`20the
X`09`20`20`20`20!`20box`20right`20side`20is`20ever`20wrapped`20down.
X`09`20`20`20`20position`20(beginning_of`20(the_range`20`7B1`7D));
X`09`20`20`20`20eve$$box_overstrike`20(eve$$x_scratch_buffer);
X`09`20`20`20`20eve$clear_message;
X`09`20`20`20`20status`20:=`20TRUE;
X`09else
X`09`20`20`20`20status`20:=`20FALSE;
X`09endif;
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-