SECTION "Imessage"

GET "Libhdr"
GET "String-to-Number"


STATIC
$(  mess.stream     = 0      // input file stream
    prompting       = 0      // whether to issue prompts or not!
    item.space      = 0      // space for rdargs to use
    item.size       = 0      // size of item.space
$)


MANIFEST
$(  yes = TRUE
    no  = FALSE
    no.output = 0
    max.messages = 150
$)




LET rewind.input(mess.file, current.message) = VALOF
$(  LET new.in=findinput(mess.file)
    TEST new.in=0 THEN writef("Can't open %S for input*N",mess.file) ELSE
    $(  LET savein=input()
        selectinput(mess.stream)
        endread()
        mess.stream := new.in
        selectinput(savein)
        current.message := 0
    $)
    RESULTIS current.message
$)




LET init.messages(mess.file, message.state) = VALOF
$(  LET current = rewind.input(mess.file, 42)
    TEST message.state=0 THEN writes("Not enough memory*N") ELSE
    FOR i=0 TO max.messages/bitsperword DO message.state!i := 0
    RESULTIS message.state~=0 & current~=42
$)




LET tidyup() BE
$(  UNLESS mess.stream = 0 THEN
    $(  LET savein=input()
        selectinput(mess.stream)
        endread()
        selectinput(savein)
    $)
$)




//
//                     Message  Deletion  Bit  Map
//





LET will.delete.message(message.state, current.message) =
    (current.message>max.messages -> FALSE,
     0~=((message.state!(current.message/(8*bytesperword)) >>
         (current.message REM (8*bytesperword))) & 1))




LET mark.message.delete(message.state, current.message, deleted) BE
$(  LET index = (current.message/(8*bytesperword))
    LET mask  = 1 << (current.message REM (8*bytesperword))
    TEST deleted=yes THEN
        message.state!index := message.state!index | mask
    ELSE
        message.state!index := message.state!index & ~mask
$)





//
//                  File    List    Procedures
//




LET rename.file(file1, file2) = VALOF
$(  LET ans = (0~=renameobj(file1, file2))
    UNLESS ans THEN
    $(  LET r2 = result2
        writef("Failed to rename *"%S*" as *"%S*" - ", file1, file2)
        fault(r2)
        result2 := r2
    $)
    RESULTIS ans
$)





LET enter.file(at.file, stream, filename) = VALOF
$(  LET ans=(at.file~=0)
    IF ans THEN
    $(  LET new.entry = getvec(2+filename%0/bytesperword)
        TEST new.entry=0 THEN ans:=FALSE ELSE
        $(  new.entry!1 := stream
            FOR i=0 TO filename%0 DO (new.entry+2)%i := filename%i
            new.entry!0 := !at.file
            !at.file   := new.entry
        $)
    $)
    RESULTIS ans
$)




LET close.file(at.file) = VALOF
$(  LET ans=(!at.file~=0)
    IF ans THEN
    $(  LET deleted=!at.file
        LET saveout = output()
        selectoutput(deleted!1)
        endwrite()
        selectoutput(saveout)
        !at.file := !!at.file
        freevec(deleted)
    $)
    RESULTIS ans
$)



LET find.file(filename, at.filelist) = VALOF
$(  LET p=at.filelist
    LET n=100  // safty limit
    WHILE !p~=0 & n>0 & 0~=compstring(filename, !p+2) DO
    $(  p:=!p
        n:=n-1
    $)
    RESULTIS (n>0 & !p~=0 -> p, 0)
$)



LET close.all.files(at.filelist) BE
    WHILE !at.filelist~=0 DO close.file(at.filelist)



LET close(filename, at.filelist) BE
$(  LET p = find.file(filename, at.filelist)
    TEST p=0 THEN writef("%S is not open*N", filename) ELSE close.file(p)
$)


LET my.findoutput(filename, at.filelist) = VALOF
$(  LET p=find.file(filename, at.filelist)
    LET ans=0
    TEST p=0 THEN
    $(  ans:=findoutput(filename)
        IF ans~=0 & ~enter.file(at.filelist, ans, filename) THEN
        $(  LET saveout=output()
            selectoutput(ans)
            endwrite()
            selectoutput(saveout)
            writef("Can't enter %S into file list*N",filename)
            ans := 0
        $)
    $) ELSE ans := (!p)!1
    RESULTIS ans
$)




//
//                          Editor  Commands
//





LET getarg(arg.string) = VALOF
$(  // uses the globals 'item.space' and 'item.size' as space
    // for "rdargs" string.  Returns TRUE if call is successfull
    LET rc = (0~=rdargs(arg.string, item.space, item.size))
    IF ~rc THEN writes("Syntax error*N")
    RESULTIS rc
$)




LET nowrch(ch) BE RETURN




LET next.message(current.message, outstream) = VALOF
$(  LET none.found = TRUE
    LET ch=?
    LET savein=input()
    LET mywrch = (outstream=no.output -> nowrch, wrch)
    LET saveout = output()
    UNLESS outstream=no.output THEN selectoutput(outstream)
    selectinput(mess.stream)
    ch:=rdch()
    WHILE none.found & ch~=endstreamch DO
    $(  IF ch='+' THEN
        $(  ch:=rdch()
            none.found := (ch~='+')
            IF none.found THEN mywrch('+')
        $)
        IF none.found THEN
        $(  $(rpt
                mywrch(ch)
                ch:=rdch()
            $)rpt REPEATUNTIL ch='*N' | ch=0 | ch=endstreamch
            mywrch('*N')
        $)
        UNLESS ch=endstreamch THEN ch:=rdch()
    $)
    UNLESS none.found THEN
    IF current.message = max.messages THEN
    $(  writes("Too many messages!")
        none.found := TRUE
    $)
    selectinput(savein)
    selectoutput(saveout)
    RESULTIS ~none.found
$)



LET get.next.header(message.buff, message.size) BE
$(  LET bytes = bytesperword*message.size-1
    LET ch=?
    LET i=1
    LET savein=input()
    selectinput(mess.stream)
    ch:=rdch()
    WHILE ch~='*N' & ch\=0 & ch~=endstreamch DO
    $(  UNLESS i>bytes THEN
        $(  message.buff%i := ch
            i:=i+1
        $)
        ch:=rdch()
    $)
    message.buff%0 := i-1
    selectinput(savein)
$)



LET type(current.message, header) = VALOF
$(  LET ans = ?
    TEST current.message=0 | header%0 = 0 THEN
    $(  writes("No current message*N")
        ans:=next.message(current.message, output())
    $) ELSE
    $(  writef("++ %S*N", header)
        ans := next.message(current.message, output())
        IF \ans THEN header%0 := 0
    $)
    RESULTIS ans
$)






LET type.command(current.message, header, at.filelist) = VALOF
$(  LET ans=TRUE
    IF getarg("to") THEN
    TEST item.space!0=0 THEN ans:=type(current.message, header) ELSE
    $(  LET new.out = my.findoutput(item.space!0, at.filelist)
        TEST new.out=0 THEN
        writef("Can't open %S for output*N", item.space!0) ELSE
        $(  LET saveout = output()
            selectoutput(new.out)
            ans := type(current.message, header)
            selectoutput(saveout)
        $)
    $)
    RESULTIS ans
$)




LET close.command(at.filelist) BE
    IF getarg("file/a") THEN close(item.space!0, at.filelist)




LET verify(message.state, current.message, header) = VALOF
$(  LET ans = TRUE
    TEST current.message=0 | header%0 = 0 THEN
    $(  writes("No current message*N")
        ans := FALSE
    $) ELSE
    writef("Message %I2 %C %S*N", current.message,
           (will.delete.message(message.state, current.message) ->
                                                    '**', '*S'), header)
    RESULTIS ans
$)




LET summarise.file(mess.state, mess.file, this.message, last.message) BE
$(  LET new.in = findinput(mess.file)
    TEST new.in=0 THEN
    writef("MESSAGE: can't open '%S' for reading!*N", mess.file) ELSE
    $(  LET savein = input()
        LET save.mess = mess.stream
        LET current.message = 0
        mess.stream := new.in
        TEST ~next.message(current.message, no.output) THEN
        writes("Message file is empty*N") ELSE
        $(  LET any.deleted = FALSE
            $(rpt
                LET deleteit = will.delete.message(mess.state, current.message)
                LET heading = VEC 50
                current.message := current.message+1
                get.next.header(heading, 50)
                TEST current.message<this.message THEN writes("| ") ELSE
                TEST current.message=this.message &
                     last.message=this.message THEN
                writes("V ") ELSE writes("  ")
                verify(mess.state, current.message, heading)
                any.deleted := any.deleted | deleteit
            $)rpt REPEATUNTIL ~next.message(current.message, no.output)
            IF any.deleted THEN
            writef("*N** - message will be deleted on wind up*N")
        $)
        selectinput(mess.stream)
        endread()
        mess.stream := save.mess
        selectinput(savein)
    $)
$)



LET send.message() BE
$(  IF getarg("User/a,From,About") THEN
    callseg("SYS:C.SEND", item.space!0, item.space!1, 0, item.space!1)
$)



LET recieve.message() BE
$(  IF getarg("User/a,to,Opt") THEN
    callseg("SYS:C.MESSAGE", item.space!0, item.space!1, item.space!2)
$)




LET find.help(commands) BE
$(  TEST rdargs(",,,,,,,,,,", item.space+3, item.size-3)=0 THEN
    writes("too many args for HELP*N") ELSE
    TEST (item.space+3)!0 = 0 THEN
    $(  writef("Commands are:*N")
        writes(commands)
        newline()
        writef("Use HELP <args> for further information*N")
    $) ELSE
    $(  item.space!0 := 12
        item.space!1 := "MAIL"
        item.space!2 := "EDITOR"
        callseg("SYS:C.HELP", item.space, 0, 0, 0)
    $)
$)



LET repeat.command() BE
$(  STATIC $(  repeats=0  $)
    IF getarg("times") THEN
    IF item.space!0=0 | VALOF
    $(  LET ans = string.to.number(item.space!0)
        UNLESS ans THEN
        writef("'%S' is not a valid repeat count*N",item.space!0)
        RESULTIS ans
    $) THEN
    $(  LET repeat.count = (item.space=0 -> 0, result2)
        TEST testflags(1) | testflags(2) THEN
        $(  writes("****** BREAK*N")
            repeats:=0
        $) ELSE
        $(  IF repeats=0 THEN repeats:=repeat.count
            repeats := repeats-1
            UNLESS repeats=0 THEN WHILE unrdch() DO LOOP
        $)
        prompting := (repeats=0)
    $)
$)




LET do.deletes(mess.state, mess.file, backup.file) = VALOF
$(  LET ans = FALSE
    IF getarg("file") THEN
    IF rewind.input(mess.file, 1)=0 THEN
    $(  LET temp.file = backup.file
        LET out = findoutput(temp.file)
        TEST out=0 THEN writef("Cannot open *"%S*" for output*N",temp.file) ELSE
        $(  LET saveout = output()
            LET header = VEC 50
            LET savein = input()
            LET included = ?
            LET to.file = (item.space!0=0 -> mess.file, item.space!0)
            LET current.message = 0
            LET any.written = FALSE
            ans := TRUE
            selectoutput(out)
            IF next.message(current.message, no.output) THEN
            $(rpt
                current.message := current.message+1
                included := ~will.delete.message(mess.state, current.message)
                IF included THEN
                $(  any.written := TRUE
                    get.next.header(header, 50)
                $)
            $)rpt REPEATUNTIL (included ->
                               ~type(current.message, header),
                               ~next.message(current.message, no.output))
            endwrite()
            selectoutput(saveout)
            selectinput(mess.stream)
            endread()
            // must be closed before the rename !
            mess.stream := 0
            selectinput(savein)
            TEST NOT any.written THEN
            $(  deleteobj(temp.file)
                deleteobj(to.file)
            $) ELSE
            UNLESS rename.file(temp.file, to.file) THEN
            $(  mess.stream := findinput(mess.file)
                // (open it again)
                ans := FALSE
            $)
        $)
    $)
    RESULTIS ans
$)




LET ask(prompt, item, item.size) = VALOF
$(  // request line with prompt 'prompt', put first string on reply
    // line in 'item' (which has size 'item.size' words).
    LET needs.prompt = (unrdch() -> rdch()='*N', TRUE)
    LET eof = FALSE
    LET rc=?
    $(  IF needs.prompt & prompting THEN writef("%S *E",prompt)
    $) REPEATUNTIL VALOF
    $(  rc := rditem(item, item.size)
        needs.prompt := FALSE
        IF rc=0 THEN
        $(  LET ch=rdch()
            needs.prompt := (ch='*N')
            eof:=(endstreamch=ch)
        $)
        IF (rc<0 | rc=2) & ~eof THEN getarg("illegal item! nothing")
        IF rc<0 | rc=2 THEN writes("illegal item*N")
        RESULTIS rc=1 | eof
    $)
    UNLESS rc=1 THEN writes("End Of File*N")
    RESULTIS ~eof
$)




LET start(mess.file, backup.file) BE
$(  LET arg = VEC 30
    LET message.state = getvec (max.messages/(8*bytesperword))
    IF mess.file\=0 | VALOF
    $(  LET ans = FALSE
        TEST rdargs("File/a", arg, 30)=0 THEN
        writef("Illegal command line syntax*N") ELSE
        $(  mess.file := arg!0
            backup.file := "T:Message-ed"
            ans:=TRUE
        $)
        RESULTIS ans
    $) THEN
    IF init.messages(mess.file, message.state) THEN
    $(  LET prompt="*C<>"
        LET commands ="SND=send,MSG=message,S=summary,D=delete,U=undelete,*
                     *N=next,*N*
                     *   =T=type,CF=close,?=V=verify,RPT=repeat,**=rewind,*N*
                     *   =Q=quit,W=windup,H=help"
        LET header = VEC 50
        LET quiting = FALSE
        LET open.files = 0
        LET current.message = 0
        LET last.typed.message = -1
        LET item = VEC 40
        item.space := item
        item.size  := 40
        header%0 := 0
        prompting := TRUE
        WHILE ~quiting DO
        $(  quiting := ~ask(prompt, item, item.size)
            UNLESS quiting THEN
            SWITCHON findarg(commands, item) INTO
            $(  CASE -1:
                    getarg("no such command! nothing")
                    writes("unknown command*N")
                    ENDCASE
                CASE 0:     // send
                    send.message()
                    ENDCASE
                CASE 1:     // message
                    recieve.message()
                    ENDCASE
                CASE 2:     // summary
                    summarise.file(message.state, mess.file, current.message,
                        last.typed.message)
                    ENDCASE
                CASE 3:     // delete
                    mark.message.delete(message.state, current.message, yes)
                    ENDCASE
                CASE 4:     // undelete
                    mark.message.delete(message.state, current.message, no)
                    ENDCASE
                CASE 5:     // next
                    TEST current.message = last.typed.message THEN
                    $(  IF verify(message.state, current.message+1, header) THEN
                        current.message := current.message + 1
                    $) ELSE
                    TEST next.message(current.message, no.output) THEN
                    $(  get.next.header(header,50)
                        current.message := current.message + 1
                        verify(message.state, current.message, header)
                    $) ELSE
                    writes("****** no more messages*N")
                    ENDCASE
                CASE 6:     // type
                    TEST current.message = last.typed.message THEN
                    writef("Message %N already displayed - rewind*N",
                           current.message) ELSE
                    $(  TEST type.command(current.message, header, @open.files)
                        THEN
                          get.next.header(header, 50)
                        ELSE writes("****** no more messages*N")
                        last.typed.message := current.message
                    $)
                    ENDCASE
                CASE 7:     // close
                    close.command(@open.files)
                    ENDCASE
                CASE 8:     // verify
                    verify(message.state, current.message, header)
                    ENDCASE
                CASE 9:     // repeat
                    repeat.command(mess.file)
                    ENDCASE
                CASE 10:    // rewind
                    current.message:=rewind.input(mess.file, current.message)
                    IF current.message=0 THEN last.typed.message := -1
                    ENDCASE
                CASE 11:    // quit
                    getarg("goodbye")
                    quiting := TRUE
                    ENDCASE
                CASE 12:    // windup
                    quiting := do.deletes(message.state, mess.file, backup.file)
                    ENDCASE
                CASE 13:    // help
                    find.help(commands)
                    ENDCASE
                DEFAULT:
                    writes("strange command code! quitting")
                    quiting := TRUE
            $)
        $)
        close.all.files(@open.files)
        tidyup()
    $)
    UNLESS message.state=0 THEN freevec(message.state)
$)

 

