lisp/delim-col.el

   1 ;;; delim-col.el --- Prettify all columns in a region or rectangle.
   2
   3 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
   4
   5 ;; Author:      Vinicius Jose Latorre <vinicius@cpqd.com.br>
   6 ;; Maintainer:  Vinicius Jose Latorre <vinicius@cpqd.com.br>
   7 ;; Time-stamp:  <2000/10/23 10:51:25 vinicius>
   8 ;; Version:     2.0
   9 ;; Keywords:    internal
  10 ;; X-URL:       http://www.cpqd.com.br/~vinicius/emacs/
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Commentary:
  30
  31 ;; delim-col helps to prettify columns in a text region or rectangle.
  32 ;;
  33 ;; To use it, make sure that this file is in load-path and insert in your
  34 ;; .emacs:
  35 ;;
  36 ;;    (require 'delim-col)
  37 ;;
  38 ;; If you have, for example, the following columns:
  39 ;;
  40 ;;      a       b       c       d
  41 ;;      aaaa    bb      ccc     ddddd
  42 ;;      aaa     bbb     cccc    dddd
  43 ;;      aa      bb      ccccccc ddd
  44 ;;
  45 ;; And the following settings:
  46 ;;
  47 ;;    (setq delimit-columns-str-before "[ ")
  48 ;;    (setq delimit-columns-str-after " ]")
  49 ;;    (setq delimit-columns-str-separator ", ")
  50 ;;    (setq delimit-columns-before "")
  51 ;;    (setq delimit-columns-after "")
  52 ;;    (setq delimit-columns-separator "\t")
  53 ;;    (setq delimit-columns-format 'separator)
  54 ;;    (setq delimit-columns-extra t)
  55 ;;
  56 ;; If you select the lines above and type:
  57 ;;
  58 ;;    M-x delimit-columns-region RET
  59 ;;
  60 ;; You obtain the following result:
  61 ;;
  62 ;;      [ a   , b  , c      , d     ]
  63 ;;      [ aaaa, bb , ccc    , ddddd ]
  64 ;;      [ aaa , bbb, cccc   , dddd  ]
  65 ;;      [ aa  , bb , ccccccc, ddd   ]
  66 ;;
  67 ;; But if you select start from the very first b to the very last c and type:
  68 ;;
  69 ;;    M-x delimit-columns-rectangle RET
  70 ;;
  71 ;; You obtain the following result:
  72 ;;
  73 ;;      a       [ b  , c       ]        d
  74 ;;      aaaa    [ bb , ccc     ]        ddddd
  75 ;;      aaa     [ bbb, cccc    ]        dddd
  76 ;;      aa      [ bb , ccccccc ]        ddd
  77 ;;
  78 ;; Now, if we change settings to:
  79 ;;
  80 ;;    (setq delimit-columns-before "<")
  81 ;;    (setq delimit-columns-after ">")
  82 ;;
  83 ;; For the `delimit-columns-region' example above, the result is:
  84 ;;
  85 ;;      [ <a>   , <b>  , <c>      , <d>     ]
  86 ;;      [ <aaaa>, <bb> , <ccc>    , <ddddd> ]
  87 ;;      [ <aaa> , <bbb>, <cccc>   , <dddd>  ]
  88 ;;      [ <aa>  , <bb> , <ccccccc>, <ddd>   ]
  89 ;;
  90 ;; And for the `delimit-columns-rectangle' example above, the result is:
  91 ;;
  92 ;;      a       [ <b>  , <c>       ]    d
  93 ;;      aaaa    [ <bb> , <ccc>     ]    ddddd
  94 ;;      aaa     [ <bbb>, <cccc>    ]    dddd
  95 ;;      aa      [ <bb> , <ccccccc> ]    ddd
  96 ;;
  97 ;; Note that `delimit-columns-region' operates over all text region
  98 ;; selected, extending the region start to the beginning of line and the
  99 ;; region end to the end of line.  While `delimit-columns-rectangle'
 100 ;; operates over the text rectangle selected which rectangle diagonal is
 101 ;; given by the region start and end.
 102 ;;
 103 ;; See `delimit-columns-format' variable documentation for column formating.
 104 ;;
 105 ;; `delimit-columns-region' is useful when you have columns of text that
 106 ;; are not well aligned, like:
 107 ;;
 108 ;;      horse   apple   bus
 109 ;;      dog     pineapple       car
 110 ;;      porcupine       strawberry      airplane
 111 ;;
 112 ;; `delimit-columns-region' and `delimit-columns-rectangle' handle lines
 113 ;; with different number of columns, like:
 114 ;;
 115 ;;      horse   apple   bus
 116 ;;      dog     pineapple       car     EXTRA
 117 ;;      porcupine       strawberry      airplane
 118 ;;
 119 ;; Use `delimit-columns-customize' to customize delim-col package variables.
 120
 121 ;;; Code:
 122
 123
 124 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 125 ;; User Options:
 126
 127 (defgroup columns nil
 128   "Prettify columns"
 129   :link '(emacs-library-link :tag "Source Lisp File" "delim-col.el")
 130   :prefix "delimit-columns-"
 131   :group 'internal)
 132
 133 (defcustom delimit-columns-str-before ""
 134   "*Specify a string to be inserted before all columns."
 135   :type '(string :tag "Before All Columns")
 136   :group 'columns)
 137
 138 (defcustom delimit-columns-str-separator ", "
 139   "*Specify a string to be inserted between each column."
 140   :type '(string :tag "Between Each Column")
 141   :group 'columns)
 142
 143 (defcustom delimit-columns-str-after ""
 144   "*Specify a string to be inserted after all columns."
 145   :type '(string :tag "After All Columns")
 146   :group 'columns)
 147
 148 (defcustom delimit-columns-before ""
 149   "*Specify a string to be inserted before each column."
 150   :type '(string :tag "Before Each Column")
 151   :group 'columns)
 152
 153 (defcustom delimit-columns-after ""
 154   "*Specify a string to be inserted after each column."
 155   :type '(string :tag "After Each Column")
 156   :group 'columns)
 157
 158 (defcustom delimit-columns-separator "\t"
 159   "*Specify a regexp which separates each column."
 160   :type '(regexp :tag "Column Separator")
 161   :group 'columns)
 162
 163 (defcustom delimit-columns-format t
 164   "*Specify how to format columns.
 165
 166 For examples below, consider:
 167
 168    + columns `ccc' and `dddd',
 169    + the maximum column length for each column is 6,
 170    + and the following settings:
 171       (setq delimit-columns-before \"<\")
 172       (setq delimit-columns-after \">\")
 173       (setq delimit-columns-separator \":\")
 174
 175 Valid values are:
 176
 177    nil          no formating.  That is, `delimit-columns-after' is followed by
 178                 `delimit-columns-separator'.
 179                 For example, the result is: \"<ccc>:<dddd>:\"
 180
 181    t            align columns.  That is, `delimit-columns-after' is followed by
 182                 `delimit-columns-separator' and then followed by spaces.
 183                 For example, the result is: \"<ccc>:   <dddd>:  \"
 184
 185    'separator   align separators.  That is, `delimit-columns-after' is followed
 186                 by spaces and then followed by `delimit-columns-separator'.
 187                 For example, the result is: \"<ccc>   :<dddd>  :\"
 188
 189    'padding     format column by filling with spaces before
 190                 `delimit-columns-after'.  That is, spaces are followed by
 191                 `delimit-columns-after' and then followed by
 192                 `delimit-columns-separator'.
 193                 For example, the result is: \"<ccc   >:<dddd  >:\"
 194
 195 Any other value is treated as t."
 196   :type '(choice :menu-tag "Column Formating"
 197                  :tag "Column Formating"
 198                  (const :tag "No Formating" nil)
 199                  (const :tag "Column Alignment" t)
 200                  (const :tag "Separator Aligment" separator)
 201                  (const :tag "Column Padding" padding))
 202   :group 'columns)
 203
 204 (defcustom delimit-columns-extra t
 205   "*Non-nil means that lines will have the same number of columns.
 206
 207 This has effect only when there are lines with different number of columns."
 208   :type '(boolean :tag "Lines With Same Number Of Column")
 209   :group 'columns)
 210
 211 (defcustom delimit-columns-start 0
 212   "*Specify column number to start prettifing.
 213
 214 See also `delimit-columns-end' for documentation.
 215
 216 The following relation must hold:
 217    0 <= delimit-columns-start <= delimit-columns-end
 218
 219 The column number start from 0 and it's relative to the beginning of selected
 220 region.  So if you selected a text region, the first column (column 0) is
 221 located at beginning of line.  If you selected a text rectangle, the first
 222 column (column 0) is located at left corner."
 223   :type '(integer :tag "Column Start")
 224   :group 'columns)
 225
 226 (defcustom delimit-columns-end 1000000
 227   "*Specify column number to end prettifing.
 228
 229 See also `delimit-columns-start' for documentation.
 230
 231 The following relation must hold:
 232    0 <= delimit-columns-start <= delimit-columns-end
 233
 234 The column number start from 0 and it's relative to the beginning of selected
 235 region.  So if you selected a text region, the first column (column 0) is
 236 located at beginning of line.  If you selected a text rectangle, the first
 237 column (column 0) is located at left corner."
 238   :type '(integer :tag "Column End")
 239   :group 'columns)
 240
 241 \f
 242 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 243 ;; User Commands:
 244
 245
 246 ;;;###autoload
 247 (defun delimit-columns-customize ()
 248   "Customization of `columns' group."
 249   (interactive)
 250   (customize-group 'columns))
 251
 252
 253 ;;;###autoload
 254 (defun delimit-columns-region (start end)
 255   "Prettify all columns in a text region.
 256
 257 START and END delimits the text region."
 258   (interactive "*r")
 259   (let ((delimit-columns-str-before
 260          (if (stringp delimit-columns-str-before)
 261              delimit-columns-str-before
 262            ""))
 263         (delimit-columns-str-separator
 264          (if (stringp delimit-columns-str-separator)
 265              delimit-columns-str-separator
 266            " "))
 267         (delimit-columns-str-after
 268          (if (stringp delimit-columns-str-after)
 269              delimit-columns-str-after
 270            ""))
 271         (delimit-columns-before
 272          (if (stringp delimit-columns-before)
 273              delimit-columns-before
 274            ""))
 275         (delimit-columns-after
 276          (if (stringp delimit-columns-after)
 277              delimit-columns-after
 278            ""))
 279         (delimit-columns-start
 280          (if (and (integerp delimit-columns-start)
 281                   (>= delimit-columns-start 0))
 282              delimit-columns-start
 283            0))
 284         (delimit-columns-end
 285          (if (integerp delimit-columns-end)
 286              delimit-columns-end
 287            1000000))
 288         (delimit-columns-limit (make-marker))
 289         (the-end (copy-marker end))
 290         delimit-columns-max)
 291     (when (<= delimit-columns-start delimit-columns-end)
 292       (save-excursion
 293         (goto-char start)
 294         (beginning-of-line)
 295         ;; get maximum length for each column
 296         (and delimit-columns-align-columns
 297              (save-excursion
 298                (while (< (point) the-end)
 299                  (delimit-columns-rectangle-max
 300                   (prog1
 301                       (point)
 302                     (end-of-line)))
 303                  (forward-char 1))))
 304         ;; prettify columns
 305         (while (< (point) the-end)
 306           (delimit-columns-rectangle-line
 307            (prog1
 308                (point)
 309              (end-of-line)))
 310           (forward-char 1))
 311         ;; nullify markers
 312         (set-marker delimit-columns-limit nil)
 313         (set-marker the-end nil)))))
 314
 315
 316 (require 'rect)
 317
 318
 319 ;;;###autoload
 320 (defun delimit-columns-rectangle (start end)
 321   "Prettify all columns in a text rectangle.
 322
 323 START and END delimits the corners of text rectangle."
 324   (interactive "*r")
 325   (let ((delimit-columns-str-before
 326          (if (stringp delimit-columns-str-before)
 327              delimit-columns-str-before
 328            ""))
 329         (delimit-columns-str-separator
 330          (if (stringp delimit-columns-str-separator)
 331              delimit-columns-str-separator
 332            " "))
 333         (delimit-columns-str-after
 334          (if (stringp delimit-columns-str-after)
 335              delimit-columns-str-after
 336            ""))
 337         (delimit-columns-before
 338          (if (stringp delimit-columns-before)
 339              delimit-columns-before
 340            ""))
 341         (delimit-columns-after
 342          (if (stringp delimit-columns-after)
 343              delimit-columns-after
 344            ""))
 345         (delimit-columns-start
 346          (if (and (integerp delimit-columns-start)
 347                   (>= delimit-columns-start 0))
 348              delimit-columns-start
 349            0))
 350         (delimit-columns-end
 351          (if (integerp delimit-columns-end)
 352              delimit-columns-end
 353            1000000))
 354         (delimit-columns-limit (make-marker))
 355         (the-end (copy-marker end))
 356         delimit-columns-max)
 357     (when (<= delimit-columns-start delimit-columns-end)
 358       ;; get maximum length for each column
 359       (and delimit-columns-align-columns
 360            (save-excursion
 361              (operate-on-rectangle 'delimit-columns-rectangle-max
 362                                    start the-end nil)))
 363       ;; prettify columns
 364       (save-excursion
 365         (operate-on-rectangle 'delimit-columns-rectangle-line
 366                               start the-end nil))
 367       ;; nullify markers
 368       (set-marker delimit-columns-limit nil)
 369       (set-marker the-end nil))))
 370
 371 \f
 372 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 373 ;; Internal Variables and Functions:
 374
 375
 376 ;; to avoid compilation gripes
 377 (defvar delimit-columns-max nil)
 378 (defvar delimit-columns-limit nil)
 379
 380
 381 (defun delimit-columns-rectangle-max (startpos &optional ignore ignore)
 382   (set-marker delimit-columns-limit (point))
 383   (goto-char startpos)
 384   (let ((ncol 1)
 385         origin values)
 386     ;; get current column length
 387     (while (progn
 388              (setq origin (current-column))
 389              (re-search-forward delimit-columns-separator
 390                                 delimit-columns-limit 'move))
 391       (save-excursion
 392         (goto-char (match-beginning 0))
 393         (setq values (cons (- (current-column) origin)
 394                            values)))
 395       (setq ncol (1+ ncol)))
 396     (setq values (cons (- (current-column) origin)
 397                        values))
 398     ;; extend delimit-columns-max, if needed
 399     (let ((index (length delimit-columns-max)))
 400       (and (> ncol index)
 401            (let ((extend (make-vector ncol 0)))
 402              (while (> index 0)
 403                (setq index (1- index))
 404                (aset extend index (aref delimit-columns-max index)))
 405              (setq delimit-columns-max extend))))
 406     ;; get maximum column length
 407     (while values
 408       (setq ncol (1- ncol))
 409       (aset delimit-columns-max ncol (max (aref delimit-columns-max ncol)
 410                                           (car values)))
 411       (setq values (cdr values)))))
 412
 413
 414 (defun delimit-columns-rectangle-line (startpos &optional ignore ignore)
 415   (let ((len  (length delimit-columns-max))
 416         (ncol 0)
 417         origin)
 418     (set-marker delimit-columns-limit (point))
 419     (goto-char startpos)
 420     ;; skip initial columns
 421     (while (and (< ncol delimit-columns-start)
 422                 (< (point) delimit-columns-limit)
 423                 (re-search-forward delimit-columns-separator
 424                                    delimit-columns-limit 'move))
 425       (setq ncol (1+ ncol)))
 426     ;; insert first formating
 427     (insert delimit-columns-str-before delimit-columns-before)
 428     ;; Adjust all columns but last one
 429     (while (progn
 430              (setq origin (current-column))
 431              (and (< (point) delimit-columns-limit)
 432                   (re-search-forward delimit-columns-separator
 433                                      delimit-columns-limit 'move)
 434                   (or (< ncol delimit-columns-end)
 435                       (progn
 436                         (goto-char (match-beginning 0))
 437                         nil))))
 438       (delete-region (match-beginning 0) (point))
 439       (delimit-columns-format
 440        (and delimit-columns-format
 441             (make-string (- (aref delimit-columns-max ncol)
 442                             (- (current-column) origin))
 443                          ?\ )))
 444       (setq ncol (1+ ncol)))
 445     ;; Prepare last column spaces
 446     (let ((spaces (and delimit-columns-format
 447                        (make-string (- (aref delimit-columns-max ncol)
 448                                        (- (current-column) origin))
 449                                     ?\ ))))
 450       ;; Adjust extra columns, if needed
 451       (and delimit-columns-extra
 452            (while (and (< (setq ncol (1+ ncol)) len)
 453                        (<= ncol delimit-columns-end))
 454              (delimit-columns-format spaces)
 455              (setq spaces (and delimit-columns-format
 456                                (make-string (aref delimit-columns-max ncol)
 457                                             ?\ )))))
 458       ;; insert last formating
 459       (cond ((null delimit-columns-format)
 460              (insert delimit-columns-after delimit-columns-str-after))
 461             ((eq delimit-columns-format 'padding)
 462              (insert spaces delimit-columns-after delimit-columns-str-after))
 463             (t
 464              (insert delimit-columns-after spaces delimit-columns-str-after))
 465             ))
 466     (goto-char (max (point) delimit-columns-limit))))
 467
 468
 469 (defun delimit-columns-format (spaces)
 470   (cond ((null delimit-columns-format)
 471          (insert delimit-columns-after
 472                  delimit-columns-str-separator
 473                  delimit-columns-before))
 474         ((eq delimit-columns-format 'separator)
 475          (insert delimit-columns-after
 476                  spaces
 477                  delimit-columns-str-separator
 478                  delimit-columns-before))
 479         ((eq delimit-columns-format 'padding)
 480          (insert spaces
 481                  delimit-columns-after
 482                  delimit-columns-str-separator
 483                  delimit-columns-before))
 484         (t
 485          (insert delimit-columns-after
 486                  delimit-columns-str-separator
 487                  spaces
 488                  delimit-columns-before))
 489         ))
 490
 491 \f
 492 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 493
 494
 495 (provide 'delim-col)
 496
 497
 498 ;;; delim-col.el ends here