lisp/delim-col.el

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