lisp/delim-col.el

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