SED Extensions - An example of a complex extension

SED  -  An Example of a Complex Extension

Top  Previous  Next

 

The following extension implements a “walk” function which is provided as a standard part of QM in the &SED.EXTENSIONS& file of the QMSYS account.

 

This function allows you to define a rectangular block of text and use the cursor keys to “walk” it left, right, up or down. As the text block “runs over” other text, this reappears on the opposite side of the block being moved. The walk function is very useful in rearranging tabular data.

 

To use this extension, first position the cursor at the top left of the block. Execute the extension and move the cursor to the bottom right of the block by using the up, down, left and right functions then press the return key. Further use of the up, down, left and right functions will move the defined block until the return key is pressed again.

 

 

PROC

(

(if %read.only

   (status.msg 'Read only buffer')

   (beep)

   (wait.input)

   (return)

)

 

* Step 1 - Get block coordinates

 

(set top %line)

(set left %col)

 

(status.msg 'Set block limits')

(loop

   (switch (get.key)

      case .up.line

         (set ct %prefix.count)

         (loop

            (if (le %line top) (exit))

 

            (retype (trimb %current.line))     * Remove trailing spaces

            (up.line 1)

            (if (lt %line.len %col)            * Must extend line

               (retype (pad %current.line %col))

            )

 

            (set ct (sub ct 1))

            (if (eq ct 0) (exit))

         )

 

      case .down.line

         (set ct %prefix.count)

         (loop

            (if (gt %line %lines) (exit))

 

            (down.line 1)

            (if (lt %line.len %col)            * Must extend line

               (retype (pad %current.line %col))

            )

 

            (set ct (sub ct 1))

            (if (eq ct 0) (exit))

         )

 

      case .fwd.char

         (set x (add %col %prefix.count))

         (if (gt x %line.len) (retype (pad %current.line x)))

         (goto.col x)

 

      case .back.char

         (set x (sub %col %prefix.count))

         (if (le x left) (set x left))

         (goto.col x)

 

      case .newline

         (set height (add (sub %line top) 1))

         (set width (add (sub %col left) 1))

         (exit)

 

      case .cancel

         (status.msg '')

         (stop)

 

      else

         (beep)

   )

)

 

* Step 2 - Move the block

 

 

(goto.line top)

(goto.col left)

 

(status.msg 'Move block')

(loop

   (switch (get.key)

      case .up.line  * Move block up

         (set rpt %prefix.count)

         (loop

            (set lw (sub left 1))       * Width of bit to left of block

            (set right (add left width)) * Col of bit to right of block

            (set rc (sub right 1))       * Righmost column of block

 

            (if (le %line 1) (exit))

 

            (up.line 1)

            (if (lt %line.len rc)            * Must extend line

               (retype (pad %current.line rc))

            )

            (set wrapped.bit (substr %current.line left width))

 

            (set ct height)

            (loop

               (down.line 1)

               (set moving.bit (substr %current.line left width))

               (up.line 1)

               (retype (cat (substr %current.line 1 lw) moving.bit

                            (substr %current.line right 999999)))

 

               (down.line 1)

               (set ct (sub ct 1))

               (if (eq ct 0) (exit))

            )

 

            (retype (trimb (cat (substr %current.line 1 lw) wrapped.bit

                                (substr %current.line right 999999))))

            (set top (sub top 1))

            (goto.line top)

            (goto.col left)

 

            (set rpt (sub rpt 1))

            (if (eq rpt 0) (exit))

         )

 

      case .down.line  * Move block down

         (set rpt %prefix.count)

         (loop

            (set lw (sub left 1))       * Width of bit to left of block

            (set right (add left width)) * Col of bit to right of block

            (set rc (sub right 1))       * Righmost column of block

 

            (if (gt (add %line height) %lines) (exit))

 

            (down.line height)

            (if (lt %line.len rc)        * Must extend line

               (retype (pad %current.line rc))

            )

            (set wrapped.bit (substr %current.line left width))

 

            (set ct height)

            (loop

               (up.line 1)

               (set moving.bit (substr %current.line left width))

               (down.line 1)

               (retype (cat (substr %current.line 1 lw) moving.bit

                            (substr %current.line right 999999)))

 

               (up.line 1)

               (set ct (sub ct 1))

               (if (eq ct 0) (exit))

            )

 

            (retype (trimb (cat (substr %current.line 1 lw) wrapped.bit

                                (substr %current.line right 999999))))

            (set top (add top 1))

            (goto.line top)

            (goto.col left)

 

            (set rpt (sub rpt 1))

            (if (eq rpt 0) (exit))

         )

 

      case .fwd.char   * Move block to the right

         (set rpt %prefix.count)

         (loop

            (set lw (sub left 1))       * Width of bit to left of block

            (set right (add left width)) * Col of bit to right of block

 

            (set x (add right 1))

            (set ct height)

            (loop

               (if (lt %line.len right)            * Must extend line

                  (retype (pad %current.line right))

               )

               (set wrapped.bit (substr %current.line right 1))

               (set moving.bit (substr %current.line left width))

               (retype (cat (substr %current.line 1 lw) wrapped.bit

                            moving.bit

                            (substr %current.line x 999999)))

 

               (down.line 1)

               (set ct (sub ct 1))

               (if (eq ct 0) (exit))

            )

            (set left (add left 1))

            (goto.line top)

            (goto.col left)

            (set rpt (sub rpt 1))

            (if (eq rpt 0) (exit))

         )

 

      case .back.char

         (set rpt %prefix.count)

         (loop

            (set lw (sub left 1))       * Width of bit to left of block

            (set right (add left width)) * Col of bit to right of block

            (set rc (sub right 1))       * Righmost column of block

 

            (if (le left 1) (exit))

 

            (set x (sub lw 1))

            (set ct height)

            (loop

               (if (lt %line.len rc)            * Must extend line

                  (retype (pad %current.line rc))

               )

               (set wrapped.bit (substr %current.line lw 1))

               (set moving.bit (substr %current.line left width))

               (retype (cat (substr %current.line 1 x) moving.bit

                             wrapped.bit

                            (substr %current.line right 999999)))

 

               (down.line 1)

               (set ct (sub ct 1))

               (if (eq ct 0) (exit))

            )

            (set left (sub left 1))

            (goto.line top)

            (goto.col left)

 

            (set rpt (sub rpt 1))

            (if (eq rpt 0) (exit))

         )

 

      case .newline

         (exit)

 

      case .cancel

         (status.msg '')

         (stop)

 

      else

         (beep)

   )

)

 

* Step 3 - Tidy up by trimming trailing spaces from lines in block

 

(status.msg '')

(set ct height)

(loop

   (retype (trimb %current.line))

   (down.line 1)

   (set ct (sub ct 1))

   (if (eq ct 0) (exit))

)

(goto.line top)

(goto.col left)

)