;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; line editor widget
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-widget editline:
  lambda editline-ctor ()
    define super new-basic-widget()
    define max-text-length 512
    define erase-line-on-type #t
    define read-only #f
    define left-skip-x 0
    define cursor-pos 0
    ;;
    method-lambda editline-widget
      super: (self)
        super
      type: (self)
        editline:
      selectable?: (self)
        {not self[ignore?:]}
      want-text-input?: (self)
        {not read-only}
      active-flag-set!: (self value)
        inherited active-flag-set!: value
        self[make-cursor-visible:]
        self
      ;;
      read-only: (self)
        read-only
      read-only-set!: (self value)
        assert {boolean? value} "read-only value should be boolean"
        if {{read-only <> value} and self[active?:]}
          if value
            self[%stop-text-input:]
            self[%start-text-input:]
        {read-only := value}
        self
      ;;
      text-set!: (self value)
        assert {string? value} "editline text value should be a string"
        if {self[text:] <> value}
          then
            self[send-desktop-notify: text-set!: value]
            inherited text-set!: value
            {erase-line-on-type := #t}
            {left-skip-x := 0}
            {cursor-pos := string-length(value)}
            self[make-cursor-visible:]
            need-repaint!()
        self
      %text-set!: (self value)
        assert {string? value} "editline text value should be a string"
        if {self[text:] <> value}
          then
            self[send-desktop-notify: text-set!: value]
            inherited text-set!: value
        self
      ;;
      clear-text: (self)
        {self[text:] := ""}
        {erase-line-on-type := #f}
      ;;
      max-text-length: (self)
        max-text-length
      max-text-length-set!: (self value)
        assert {{fixnum? value} and between?(value 0 32767)}
          "invalid maximum editline text length"
        {max-text-length := value}
        define text self[text:]
        if {string-length(text) > value}
          {self[text:] := substring(text 0 value)}
        self
      ;;
      make-cursor-visible: (self)
        define text self[text:]
        define wdt {self[final-width:] - 2}
        if {wdt > 4}
          then
            define old-cpos cursor-pos
            define old-xofs left-skip-x
            {cursor-pos := clamp(cursor-pos 0 string-length(text))}
            define cxofs lgfx:text-width(substring(text 0 cursor-pos))
            ;printf "000: cxofs=%d; left-skip-x=%d; wdt=%d\n" cxofs left-skip-x wdt
            if {cxofs > {left-skip-x + wdt + -3}}
              {left-skip-x := max(0 {cxofs - wdt - -3})}
            if {cxofs < {left-skip-x + 4}}
              {left-skip-x := max(0 {cxofs - 4})}
            if {{old-cpos <> cursor-pos} or {left-skip-x <> old-xofs}}
              need-repaint!()
            ;printf "001: cxofs=%d; left-skip-x=%d; wdt=%d\n" cxofs left-skip-x wdt
        self
      ;;
      cursor-pos: (self)
        cursor-pos
      ;;
      cursor-pos-set!: (self pos)
        define ocp cursor-pos
        {cursor-pos := pos}
        self[make-cursor-visible:]
        if {cursor-pos <> ocp}
          need-repaint!()
      ;;
      paint: (self)
        define text self[text:]
        define th lgfx:text-height()
        define wdt self[final-width:]
        define hgt self[final-height:]
        define bc self[style-color-prop: "back"]
        define fc self[style-color-prop: "frame"]
        define tc self[style-color-prop: (if erase-line-on-type "text-initial" "text")]
        define cc self[style-color-prop: "cursor"]
        if self[read-only:]
          {tc := self[style-color-prop: "read-only"]}
        lgfx:draw-round-rect 0 0 wdt hgt fc
        self[update-clip-rect: 1 1 {wdt - 2} {hgt - 2}]
        lgfx:fill-rect 0 0 wdt hgt bc
        dec! hgt 2
        define y0 {{{hgt - lgfx:text-height()} div 2} + 1}
        lgfx:print-str {2 - left-skip-x} {y0 + lgfx:text-ascender()} text tc
        define cxofs lgfx:text-width(substring(text 0 cursor-pos))
        if self[active?:]
          lgfx:fill-rect {{2 - left-skip-x} + cxofs} y0 2 lgfx:text-height() cc
        self
      ;;
      handle-event: (self evt)
        define ins-char(ch)
          if {{not read-only} and between?(ch 32 126)}
            then
              define maxlen self[max-text-length:]
              if {positive? maxlen}
                then
                  define text self[text:]
                  define cpos self[cursor-pos:]
                  if erase-line-on-type
                    then
                      {erase-line-on-type := #f}
                      {self[%text:] := string-append("" ch)}
                      {self[cursor-pos:] := 1}
                    if {string-length(text) < maxlen}
                      then
                        if {cpos = string-length(text)}
                          {self[%text:] := string-append(text ch)}
                          {self[%text:] := string-append(substring(text 0 cpos) ch substring(text cpos))}
                        {self[cursor-pos:] := {cpos + 1}}
        ;;
        define ins-str(str)
          define idx 0
          define slen string-length(str)
          while {idx <> slen}
            ins-char str[idx]
            inc! idx
        ;;
        define word-char?(ch)
          (or between?(ch #\0 #\9)
              between?(ch #\A #\z)
              between?(ch #\a #\z)
              {ch = #\_})
        ;;
        define do-word-left()
          define skip-word-chars
          define text self[text:]
          define cpos self[cursor-pos:]
          if {positive? cpos}
            then
              {skip-word-chars := word-char?(text[{cpos - 1}])}
              while {{positive? cpos} and {skip-word-chars = word-char?(text[{cpos - 1}])}}
                dec! cpos
          if {cpos <> self[cursor-pos:]}
            {self[cursor-pos:] := cpos}
        ;;
        define do-word-right()
          define skip-word-chars
          define text self[text:]
          define tlen string-length(text)
          define cpos self[cursor-pos:]
          if {cpos < tlen}
            then
              {skip-word-chars := word-char?(text[cpos])}
              while {{cpos < tlen} and {skip-word-chars = word-char?(text[cpos])}}
                inc! cpos
          if {cpos <> self[cursor-pos:]}
            {self[cursor-pos:] := cpos}
        ;;
        if evt[alive?:]
          case evt[type:]
            (KEY-DOWN)
              define ks evt[keysym:]
              cond
                self[active?:]
                  define text
                  define cpos
                  define maxlen
                  cond
                    {sdl:names-equal?("home" ks) or
                     sdl:names-equal?("kp-7" ks)}
                      evt[eat!:]
                      {erase-line-on-type := #f}
                      {self[cursor-pos:] := 0}
                    {sdl:names-equal?("end" ks) or
                     sdl:names-equal?("kp-1" ks)}
                      evt[eat!:]
                      {erase-line-on-type := #f}
                      {self[cursor-pos:] := string-length(self[text:])}
                    {sdl:names-equal?("left" ks) or
                     sdl:names-equal?("kp-4" ks)}
                      evt[eat!:]
                      {erase-line-on-type := #f}
                      {self[cursor-pos:] := {self[cursor-pos:] - 1}}
                    {sdl:names-equal?("right" ks) or
                     sdl:names-equal?("kp-6" ks)}
                      evt[eat!:]
                      {erase-line-on-type := #f}
                      {self[cursor-pos:] := {self[cursor-pos:] + 1}}
                    {sdl:names-equal?("C-left" ks) or
                     sdl:names-equal?("C-kp-4" ks)}
                      evt[eat!:]
                      {erase-line-on-type := #f}
                      do-word-left()
                    {sdl:names-equal?("C-right" ks) or
                     sdl:names-equal?("C-kp-6" ks)}
                      evt[eat!:]
                      {erase-line-on-type := #f}
                      do-word-right()
                    sdl:names-equal?("delete" ks)
                      evt[eat!:]
                      if {not read-only}
                        if erase-line-on-type
                          self[clear-text:]
                          else
                            {erase-line-on-type := #f}
                            {cpos := self[cursor-pos:]}
                            {text := self[text:]}
                            if {cpos < string-length(text)}
                              then
                                {self[%text:] := string-append(substring(text 0 cpos)
                                                               substring(text {cpos + 1}))}
                                self[make-cursor-visible:]
                    sdl:names-equal?("backspace" ks)
                      evt[eat!:]
                      if {not read-only}
                        then
                          {erase-line-on-type := #f}
                          {cpos := self[cursor-pos:]}
                          {text := self[text:]}
                          if {positive? cpos}
                            then
                              {self[%text:] := string-append(substring(text 0 {cpos - 1})
                                                             substring(text cpos))}
                              {self[cursor-pos:] := {cpos - 1}}
                    {sdl:names-equal?("return" ks) and self[has-action?:]}
                      evt[eat!:]
                      self[perform-action:]
                    sdl:names-equal?("C-insert" ks)
                      evt[eat!:]
                      define cct self[text:]
                      if {not empty-string?(cct)}
                        then
                          sdl:clipboard:set! self[text:]
                          sdl:clipboard:primary-set! self[text:]
                    sdl:names-equal?("S-insert" ks)
                      evt[eat!:]
                      define clip sdl:clipboard:ref()
                      if {empty-string? clip}
                        {clip := sdl:clipboard:primary-ref()}
                      if {not empty-string?(clip)}
                        ins-str clip
                    else
                      #void
                (and self[selectable?:]
                     evt[key-broadcast?:]
                     sdl:names-equal?(self[hotkey:] ks))
                  evt[eat!:]
                  self[top-widget:][activate-widget: self]
                else #void
            (TEXT-INPUT)
              evt[eat!:]
              if {not read-only}
                ins-str evt[text:]
            else #void
        if evt[alive?:]
          inherited handle-event: evt
      ;;
      handle-property: (self name value)
        self[property-changed: name value]
        case name
          (max-text-length:)
            {self[max-text-length:] := value}
            #t
          (read-only:)
            {self[read-only:] := value}
            #t
          else
            inherited handle-property: name value
      ;;
      else
        super
