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: <2001-10-13 10:02:26 pavel>
   8 ;; Version: 2.1
   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 (defmacro delimit-columns-str (str)
 254   `(if (stringp ,str) ,str ""))
 255
 256
 257 ;;;###autoload
 258 (defun delimit-columns-region (start end)
 259   "Prettify all columns in a text region.
 260
 261 START and END delimits the text region."
 262   (interactive "*r")
 263   (let ((delimit-columns-str-before
 264          (delimit-columns-str delimit-columns-str-before))
 265         (delimit-columns-str-separator
 266          (delimit-columns-str delimit-columns-str-separator))
 267         (delimit-columns-str-after
 268          (delimit-columns-str delimit-columns-str-after))
 269         (delimit-columns-before
 270          (delimit-columns-str delimit-columns-before))
 271         (delimit-columns-after
 272          (delimit-columns-str delimit-columns-after))
 273         (delimit-columns-start
 274          (if (and (integerp delimit-columns-start)
 275                   (>= delimit-columns-start 0))
 276              delimit-columns-start
 277            0))
 278         (delimit-columns-end
 279          (if (integerp delimit-columns-end)
 280              delimit-columns-end
 281            1000000))
 282         (delimit-columns-limit (make-marker))
 283         (the-end (copy-marker end))
 284         delimit-columns-max)
 285     (when (<= delimit-columns-start delimit-columns-end)
 286       (save-excursion
 287         (goto-char start)
 288         (beginning-of-line)
 289         ;; get maximum length for each column
 290         (and delimit-columns-format
 291              (save-excursion
 292                (while (< (point) the-end)
 293                  (delimit-columns-rectangle-max
 294                   (prog1
 295                       (point)
 296                     (end-of-line)))
 297                  (forward-char 1))))
 298         ;; prettify columns
 299         (while (< (point) the-end)
 300           (delimit-columns-rectangle-line
 301            (prog1
 302                (point)
 303              (end-of-line)))
 304           (forward-char 1))
 305         ;; nullify markers
 306         (set-marker delimit-columns-limit nil)
 307         (set-marker the-end nil)))))
 308
 309
 310 (require 'rect)
 311
 312
 313 ;;;###autoload
 314 (defun delimit-columns-rectangle (start end)
 315   "Prettify all columns in a text rectangle.
 316
 317 START and END delimits the corners of text rectangle."
 318   (interactive "*r")
 319   (let ((delimit-columns-str-before
 320          (delimit-columns-str delimit-columns-str-before))
 321         (delimit-columns-str-separator
 322          (delimit-columns-str delimit-columns-str-separator))
 323         (delimit-columns-str-after
 324          (delimit-columns-str delimit-columns-str-after))
 325         (delimit-columns-before
 326          (delimit-columns-str delimit-columns-before))
 327         (delimit-columns-after
 328          (delimit-columns-str delimit-columns-after))
 329         (delimit-columns-start
 330          (if (and (integerp delimit-columns-start)
 331                   (>= delimit-columns-start 0))
 332              delimit-columns-start
 333            0))
 334         (delimit-columns-end
 335          (if (integerp delimit-columns-end)
 336              delimit-columns-end
 337            1000000))
 338         (delimit-columns-limit (make-marker))
 339         (the-end (copy-marker end))
 340         delimit-columns-max)
 341     (when (<= delimit-columns-start delimit-columns-end)
 342       ;; get maximum length for each column
 343       (and delimit-columns-format
 344            (save-excursion
 345              (operate-on-rectangle 'delimit-columns-rectangle-max
 346                                    start the-end nil)))
 347       ;; prettify columns
 348       (save-excursion
 349         (operate-on-rectangle 'delimit-columns-rectangle-line
 350                               start the-end nil))
 351       ;; nullify markers
 352       (set-marker delimit-columns-limit nil)
 353       (set-marker the-end nil))))
 354
 355 \f
 356 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 357 ;; Internal Variables and Functions:
 358
 359
 360 ;; to avoid compilation gripes
 361 (defvar delimit-columns-max nil)
 362 (defvar delimit-columns-limit nil)
 363
 364
 365 (defun delimit-columns-rectangle-max (startpos &optional ignore1 ignore2)
 366   (set-marker delimit-columns-limit (point))
 367   (goto-char startpos)
 368   (let ((ncol 1)
 369         origin values)
 370     ;; get current column length
 371     (while (progn
 372              (setq origin (current-column))
 373              (re-search-forward delimit-columns-separator
 374                                 delimit-columns-limit 'move))
 375       (save-excursion
 376         (goto-char (match-beginning 0))
 377         (setq values (cons (- (current-column) origin)
 378                            values)))
 379       (setq ncol (1+ ncol)))
 380     (setq values (cons (- (current-column) origin)
 381                        values))
 382     ;; extend delimit-columns-max, if needed
 383     (let ((index (length delimit-columns-max)))
 384       (and (> ncol index)
 385            (let ((extend (make-vector ncol 0)))
 386              (while (> index 0)
 387                (setq index (1- index))
 388                (aset extend index (aref delimit-columns-max index)))
 389              (setq delimit-columns-max extend))))
 390     ;; get maximum column length
 391     (while values
 392       (setq ncol (1- ncol))
 393       (aset delimit-columns-max ncol (max (aref delimit-columns-max ncol)
 394                                           (car values)))
 395       (setq values (cdr values)))))
 396
 397
 398 (defun delimit-columns-rectangle-line (startpos &optional ignore1 ignore2)
 399   (let ((len  (length delimit-columns-max))
 400         (ncol 0)
 401         origin)
 402     (set-marker delimit-columns-limit (point))
 403     (goto-char startpos)
 404     ;; skip initial columns
 405     (while (and (< ncol delimit-columns-start)
 406                 (< (point) delimit-columns-limit)
 407                 (re-search-forward delimit-columns-separator
 408                                    delimit-columns-limit 'move))
 409       (setq ncol (1+ ncol)))
 410     ;; insert first formating
 411     (insert delimit-columns-str-before delimit-columns-before)
 412     ;; Adjust all columns but last one
 413     (while (progn
 414              (setq origin (current-column))
 415              (and (< (point) delimit-columns-limit)
 416                   (re-search-forward delimit-columns-separator
 417                                      delimit-columns-limit 'move)
 418                   (or (< ncol delimit-columns-end)
 419                       (progn
 420                         (goto-char (match-beginning 0))
 421                         nil))))
 422       (delete-region (match-beginning 0) (point))
 423       (delimit-columns-format
 424        (and delimit-columns-format
 425             (make-string (- (aref delimit-columns-max ncol)
 426                             (- (current-column) origin))
 427                          ?\ )))
 428       (setq ncol (1+ ncol)))
 429     ;; Prepare last column spaces
 430     (let ((spaces (and delimit-columns-format
 431                        (make-string (- (aref delimit-columns-max ncol)
 432                                        (- (current-column) origin))
 433                                     ?\ ))))
 434       ;; Adjust extra columns, if needed
 435       (and delimit-columns-extra
 436            (while (and (< (setq ncol (1+ ncol)) len)
 437                        (<= ncol delimit-columns-end))
 438              (delimit-columns-format spaces)
 439              (setq spaces (and delimit-columns-format
 440                                (make-string (aref delimit-columns-max ncol)
 441                                             ?\ )))))
 442       ;; insert last formating
 443       (cond ((null delimit-columns-format)
 444              (insert delimit-columns-after delimit-columns-str-after))
 445             ((eq delimit-columns-format 'padding)
 446              (insert spaces delimit-columns-after delimit-columns-str-after))
 447             (t
 448              (insert delimit-columns-after spaces delimit-columns-str-after))
 449             ))
 450     (goto-char (max (point) delimit-columns-limit))))
 451
 452
 453 (defun delimit-columns-format (spaces)
 454   (cond ((null delimit-columns-format)
 455          (insert delimit-columns-after
 456                  delimit-columns-str-separator
 457                  delimit-columns-before))
 458         ((eq delimit-columns-format 'separator)
 459          (insert delimit-columns-after
 460                  spaces
 461                  delimit-columns-str-separator
 462                  delimit-columns-before))
 463         ((eq delimit-columns-format 'padding)
 464          (insert spaces
 465                  delimit-columns-after
 466                  delimit-columns-str-separator
 467                  delimit-columns-before))
 468         (t
 469          (insert delimit-columns-after
 470                  delimit-columns-str-separator
 471                  spaces
 472                  delimit-columns-before))
 473         ))
 474
 475 \f
 476 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 477
 478
 479 (provide 'delim-col)
 480
 481
 482 ;;; delim-col.el ends here