code.delx.au - gnu-emacs/blob - lisp/delim-col.el

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