* PTERM
* PTERM verb.
* Copyright (c) 2006 Ladybridge Systems, All Rights Reserved
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
* 
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
* GNU General Public License for more details.
* 
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software Foundation,
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
* 
* Ladybridge Systems can be contacted via the www.openqm.com web site.
* 
* START-HISTORY:
* 27 Jun 07  2.5-7 Added PTERM TELNET ON/OFF.
* 17 Aug 06  2.4-11 Added PTERM PROMPT s1 {s2}.
* 21 Apr 05  2.1-12 Display break character.
* 06 Mar 05  2.1-8 Added report of telnet binary mode.
* 14 Oct 04  2.0-5 Use message handler.
* 16 Sep 04  2.0-1 OpenQM launch. Earlier history details suppressed.
* END-HISTORY
*
* START-DESCRIPTION:
*
*   PTERM DISPLAY          Display current settings
*   PTERM LPTR             Send current settings to default printer
*
*   PTERM BREAK OFF        Disable break key
*   PTERM BREAK ON         Enable break key
*   PTERM BREAK c          Set break character
*
*   PTERM CASE INVERT      Enable case inversion
*   PTERM CASE NOINVERT    Disable case inversion
*
*   PTERM NEWLINE CR       Set output newline as CR
*   PTERM NEWLINE LF       Set output newline as LF
*   PTERM NEWLINE CRLF     Set output newline as CRLF
*
*   PTERM RESET string     Set terminal reset string
*
*   PTERM RETURN CR        Set input newline as CR
*   PTERM RETURN LF        Set input newline as LF
*
*   PTERM BINARY OFF       Set binary mode off
*   PTERM BINARY ON        Set binary mode on
*
*   PTERM TELNET OFF       Disable recognition of TN_IAC
*   PTERM TELNET ON        Enable recognition of TN_IAC
*
*   PTERM PROMPT ":" "::"  Change command prompt(s)
*
* END-DESCRIPTION
*
* START-CODE

$internal
program pterm
$catalogue $PTERM

$include parser.h
$include int$keys.h
$include syscom.h

   parser = '!PARSER'
   call @parser(parser$reset, 0, @sentence, 0)
   call @parser(parser$get.token, token.type, token, keyword) ;* Verb

   loop
      call @parser(parser$get.token, token.type, token, keyword)

   while token.type # PARSER$END

      begin case
         case keyword = KW$DISPLAY or keyword = KW$LPTR
            if keyword = KW$LPTR then printer on

            * Break trapping
            c = char(pterm(PT$BRKCH, 0) + 64)
            print if pterm(PT$BREAK, -1) then sysmsg(6830,c) else sysmsg(6831,c)

            * Case inversion
            print if pterm(PT$INVERT, -1) then sysmsg(6832) else sysmsg(6833)

            s = pterm(PT$INEWLINE,'')
            s = change(s, char(10), 'LF')
            s = change(s, char(13), 'CR')
            print sysmsg(6834, s) ;* Input newline:  xx

            s = pterm(PT$ONEWLINE,'')
            s = change(s, char(10), 'LF')
            s = change(s, char(13), 'CR')
            print sysmsg(6835, s) ;* Output newline:  xx
            * Binary mode
            print if pterm(PT$BINARY.IN, -1) then sysmsg(6854) else sysmsg(6855)
            print if pterm(PT$BINARY.OUT, -1) then sysmsg(6856) else sysmsg(6857)

            if not(pterm(PT$TELNET, -1)) then
               print sysmsg(7753)   ;* Telnet negotiation: Off
            end

            if term.reset.string # '' then
               s = term.reset.string
               for i = len(s) to 1 step - 1
                  c = s[i,1]
                  n = seq(c)
                  begin case
                     case n = 8
                        s = s[1,i-1] : '\B' : s[i + 1, 9999]
                     case n = 9
                        s = s[1,i-1] : '\T' : s[i + 1, 9999]
                     case n = 10
                        s = s[1,i-1] : '\N' : s[i + 1, 9999]
                     case n = 12
                        s = s[1,i-1] : '\F' : s[i + 1, 9999]
                     case n = 13
                        s = s[1,i-1] : '\R' : s[i + 1, 9999]
                     case n = 27
                        s = s[1,i-1] : '\E' : s[i + 1, 9999]
                     case c = '\'
                        s = s[1,i-1] : '\\' : s[i + 1, 9999]
                     case c = '^'
                        s = s[1,i-1] : '\^' : s[i + 1, 9999]
                     case n < 32
                        s = s[1,i-1] : '^' : char(64 + n) : s[i + 1, 9999]
                  end case
               next i
               print sysmsg(6836, s) ;* Reset string: xx
            end

            print
            if keyword = KW$LPTR then printer off

         case keyword = KW$BINARY
            call @parser(parser$get.token, token.type, token, keyword)
            begin case
               case keyword = KW$ON
                  i = pterm(PT$BINARY.IN, @true)
                  i = pterm(PT$BINARY.OUT, @true)

               case keyword = KW$OFF
                  i = pterm(PT$BINARY.IN, @false)
                  i = pterm(PT$BINARY.OUT, @false)

               case 1
                  display sysmsg(2029, token) ;* Unrecognised option (xx)
                  return
            end case

         case keyword = KW$BREAK
            call @parser(parser$get.token, token.type, token, keyword)
            begin case
               case keyword = KW$ON
                  i = pterm(PT$BREAK, @true)

               case keyword = KW$OFF
                  i = pterm(PT$BREAK, @false)

               case token matches '1-3N'
                  n = token + 0
                  if n >= 1 and n <= 31 then
                     i = pterm(PT$BRKCH, n)
                  end else
                     display sysmsg(6837) ;* Break character must be in range 1 - 31
                  end

               case token matches '^1X'
                  n = seq(upcase(token)[2,1])
                  if n >= 65 and n <= 95 then
                     i = pterm(PT$BRKCH, n - 64)
                  end else
                     display sysmsg(6838) ;* Invalid break key
                  end

               case token.type = PARSER$END
                  n = pterm(PT$BRKCH,0)
                  display sysmsg(6839, n, char(n+64)) ;* Break key is character %1 (^%2)
                  display if pterm(PT$BREAK,-1) then sysmsg(6840) else sysmsg(6841)
                  * Break recognition is xx
               
               case 1
                  display sysmsg(2029, token) ;* Unrecognised option (xx)
                  return
            end case

         case keyword = KW$CASE
            call @parser(parser$get.token, token.type, token, keyword)
            begin case
               case keyword = KW$INVERT
                  i = pterm(PT$INVERT, @true)

               case keyword = KW$NOINVERT
                  i = pterm(PT$INVERT, @false)

               case 1
                  display sysmsg(6842) ;* INVERT or NOINVERT required
                  return
            end case

         case keyword = KW$NEWLINE
            call @parser(parser$get.token, token.type, token, keyword)
            token = upcase(token)
            begin case
               case token = 'CR'
                  i = pterm(PT$ONEWLINE, char(13))
               case token = 'LF'
                  i = pterm(PT$ONEWLINE, char(10))
               case token = 'CRLF'
                  i = pterm(PT$ONEWLINE, char(13):char(10))
               case 1
                  display sysmsg(6843) ;* Newline mode required
            end case

         case keyword = KW$PROMPT
            call @parser(parser$get.token, token.type, s, keyword)
            if token.type # PARSER$STRING then
               stop sysmsg(7750)  ;* Quoted command prompt string required
            end
            if len(s) > 10 or s = '' then
               stop sysmsg(7751)  ;* Invalid command prompt string
            end

            call @parser(parser$get.token, token.type, s2, keyword)
            if token.type = PARSER$END then
               s2 = ''
            end else
               if token.type # PARSER$STRING then
                  stop sysmsg(7750)  ;* Quoted command prompt string required
               end
               if len(s2) > 10 or s2 = '' then
                  stop sysmsg(7751)  ;* Invalid command prompt string
               end
            end

            command.prompt<1> = s
            if s2 # '' then command.prompt<2> = s2

         case keyword = KW$RESET
            call @parser(parser$get.rest, token.type, s, keyword)
            s = trimf(s)
            for i = 1 to len(s)
               begin case
                  case s[i,2] = '@('
                     args = matchfield(s[i,9999], '"@("0X")"0X', 2)
                     begin case
                        case args matches '0N-0N'
                           x = @(args)
                           s = s[1,i-1] : x : s[i + len(args) + 3,9999]
                        case args matches '0N,0N-0N,0N'
                           x = @(field(args, ',', 1),field(args, ',', 2))
                           s = s[1,i-1] : x : s[i + len(args) + 3,9999]
                     end case

                  case s[i,1] = '\'
                     c = upcase(s[i+1,1])
                     begin case
                        case c = 'B' ; s = s[1,i-1] : char(8) : s[i + 2,9999]
                        case c = 'E' ; s = s[1,i-1] : char(27) : s[i + 2,9999]
                        case c = 'F' ; s = s[1,i-1] : char(12) : s[i + 2,9999]
                        case c = 'N' ; s = s[1,i-1] : char(10) : s[i + 2,9999]
                        case c = 'R' ; s = s[1,i-1] : char(13) : s[i + 2,9999]
                        case c = 'T' ; s = s[1,i-1] : char(9) : s[i + 2,9999]
                        case c = '^' ; s = s[1,i-1] : '^' : s[i + 2,9999]
                        case c = '\' ; s = s[1,i-1] : '\' : s[i + 2,9999]
                     end case

                  case s[i,1] = '^'
                     c = upcase(s[i+1,1])
                     x = index(c, '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_', 1)
                     s = s[1,i-1] : char(x - 1) : s[i + 2,9999]
               end case
            next i
            term.reset.string = s

         case keyword = KW$RETURN
            call @parser(parser$get.token, token.type, token, keyword)
            token = upcase(token)
            begin case
               case token = 'CR'
                  i = pterm(PT$INEWLINE, char(13))
               case token = 'LF'
                  i = pterm(PT$INEWLINE, char(10))
               case 1
                  display sysmsg(6858) ;* Rturn key mode required
            end case

         case keyword = KW$TELNET
            call @parser(parser$get.token, token.type, token, keyword)
            begin case
               case keyword = KW$ON
                  i = pterm(PT$TELNET, @true)

               case keyword = KW$OFF
                  i = pterm(PT$TELNET, @false)

               case 1
                  display sysmsg(2029, token) ;* Unrecognised option (xx)
                  return
            end case

         case 1
            display sysmsg(2029, token) ;* Unrecognised option (xx)
            return
      end case
  repeat

  return
end

* END-CODE
