lisp/delim-col.el

   1 ;;; delim-col.el --- Prettify all columns in a region or rectangle.
   2
   3 ;; Copyright (C) 1999 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:  <99/08/21 19:51:13 vinicius>
   8 ;; Version: 1.3
   9 ;; Keywords: internal
  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 2, or (at your option)
  16 ;; 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; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; delim-col helps to prettify columns in a text region or rectangle.
  31 ;;
  32 ;; To use it, make sure that this file is in load-path and insert in your
  33 ;; .emacs:
  34 ;;
  35 ;;    (require 'delim-col)
  36 ;;
  37 ;; If you have, for example, the following columns:
  38 ;;
  39 ;;      a       b       c       d
  40 ;;      aaaa    bb      ccc     ddddd
  41 ;;      aaa     bbb     cccc    dddd
  42 ;;      aa      bb      ccccccc ddd
  43 ;;
  44 ;; And the following settings:
  45 ;;
  46 ;;    (setq delimit-columns-str-before "[ ")
  47 ;;    (setq delimit-columns-str-after " ]")
  48 ;;    (setq delimit-columns-str-separator ", ")
  49 ;;    (setq delimit-columns-separator "\t")
  50 ;;
  51 ;; If you select the lines above and type:
  52 ;;
  53 ;;    M-x delimit-columns-region RET
  54 ;;
  55 ;; You obtain the following result:
  56 ;;
  57 ;;      [ a   , b  , c      , d     ]
  58 ;;      [ aaaa, bb , ccc    , ddddd ]
  59 ;;      [ aaa , bbb, cccc   , dddd  ]
  60 ;;      [ aa  , bb , ccccccc, ddd   ]
  61 ;;
  62 ;; But if you select start from the very first b and the very last c and type:
  63 ;;
  64 ;;    M-x delimit-columns-rectangle RET
  65 ;;
  66 ;; You obtain the following result:
  67 ;;
  68 ;;      a       [ b  , c       ]        d
  69 ;;      aaaa    [ bb , ccc     ]        ddddd
  70 ;;      aaa     [ bbb, cccc    ]        dddd
  71 ;;      aa      [ bb , ccccccc ]        ddd
  72 ;;
  73 ;; Note that `delimit-columns-region' operates over all text region
  74 ;; selected, extending the region start to the beginning of line and the
  75 ;; region end to the end of line.  While `delimit-columns-rectangle'
  76 ;; operates over the text rectangle selected which rectangle diagonal is
  77 ;; given by the region start and end.
  78 ;;
  79 ;; `delimit-columns-region' is useful when you have columns of text that
  80 ;; are not well aligned, like:
  81 ;;
  82 ;;      horse   apple   bus
  83 ;;      dog     pineapple       car
  84 ;;      porcupine       strawberry      airplane
  85 ;;
  86 ;; `delimit-columns-region' and `delimit-columns-rectangle' handle lines
  87 ;; with different number of columns, like:
  88 ;;
  89 ;;      horse   apple   bus
  90 ;;      dog     pineapple       car     EXTRA
  91 ;;      porcupine       strawberry      airplane
  92
  93 ;;; Code:
  94
  95
  96 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  97 ;; User Options:
  98
  99 (defvar delimit-columns-str-before ""
 100   "*Specify a string to be inserted before all columns.")
 101
 102 (defvar delimit-columns-str-separator ", "
 103   "*Specify a string to be inserted between each column.")
 104
 105 (defvar delimit-columns-str-after ""
 106   "*Specify a string to be inserted after all columns.")
 107
 108 (defvar delimit-columns-separator "\t"
 109   "*Specify a regexp which separates each column.")
 110
 111 \f
 112 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 113 ;; User Commands:
 114
 115
 116 ;;;###autoload
 117 (defun delimit-columns-region (start end)
 118   "Prettify all columns in a text region.
 119
 120 START and END delimits the text region."
 121   (interactive "*r")
 122   (let ((delimit-columns-str-before
 123          (if (stringp delimit-columns-str-before)
 124              delimit-columns-str-before
 125            ""))
 126         (delimit-columns-str-separator
 127          (if (stringp delimit-columns-str-separator)
 128              delimit-columns-str-separator
 129            " "))
 130         (delimit-columns-str-after
 131          (if (stringp delimit-columns-str-after)
 132              delimit-columns-str-after
 133            ""))
 134         (delimit-columns-limit (make-marker))
 135         (the-end (copy-marker end))
 136         delimit-columns-max)
 137     (save-excursion
 138       (goto-char start)
 139       (beginning-of-line)
 140       ;; get maximum length for each column
 141       (save-excursion
 142         (while (< (point) the-end)
 143           (delimit-columns-rectangle-max
 144            (prog1
 145                (point)
 146              (end-of-line)))
 147           (forward-char 1)))
 148       ;; prettify columns
 149       (while (< (point) the-end)
 150         (delimit-columns-rectangle-line
 151          (prog1
 152              (point)
 153            (end-of-line)))
 154         (forward-char 1))
 155       ;; nullify markers
 156       (set-marker delimit-columns-limit nil)
 157       (set-marker the-end nil))))
 158
 159
 160 (require 'rect)
 161
 162
 163 ;;;###autoload
 164 (defun delimit-columns-rectangle (start end)
 165   "Prettify all columns in a text rectangle.
 166
 167 START and END delimits the corners of text rectangle."
 168   (interactive "*r")
 169   (let ((delimit-columns-str-before
 170          (if (stringp delimit-columns-str-before)
 171              delimit-columns-str-before
 172            ""))
 173         (delimit-columns-str-separator
 174          (if (stringp delimit-columns-str-separator)
 175              delimit-columns-str-separator
 176            " "))
 177         (delimit-columns-str-after
 178          (if (stringp delimit-columns-str-after)
 179              delimit-columns-str-after
 180            ""))
 181         (delimit-columns-limit (make-marker))
 182         (the-end (copy-marker end))
 183         delimit-columns-max)
 184     ;; get maximum length for each column
 185     (save-excursion
 186       (operate-on-rectangle 'delimit-columns-rectangle-max
 187                             start the-end t))
 188     ;; prettify columns
 189     (save-excursion
 190       (operate-on-rectangle 'delimit-columns-rectangle-line
 191                             start the-end t))
 192     ;; nullify markers
 193     (set-marker delimit-columns-limit nil)
 194     (set-marker the-end nil)))
 195
 196 \f
 197 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 198 ;; Internal Variables and Functions:
 199
 200
 201 ;; to avoid compilation gripes
 202 (defvar delimit-columns-max nil)
 203 (defvar delimit-columns-limit nil)
 204
 205
 206 (defun delimit-columns-rectangle-max (startpos &optional ignore ignore)
 207   (set-marker delimit-columns-limit (point))
 208   (goto-char startpos)
 209   (let ((ncol 1)
 210         origin values)
 211     ;; get current column length
 212     (while (progn
 213              (setq origin (current-column))
 214              (re-search-forward delimit-columns-separator
 215                                 delimit-columns-limit 'move))
 216       (save-excursion
 217         (goto-char (match-beginning 0))
 218         (setq values (cons (- (current-column) origin)
 219                            values)))
 220       (setq ncol (1+ ncol)))
 221     (setq values (cons (- (current-column) origin)
 222                        values))
 223     ;; extend delimit-columns-max, if needed
 224     (let ((index (length delimit-columns-max)))
 225       (and (> ncol index)
 226            (let ((extend (make-vector ncol 0)))
 227              (while (> index 0)
 228                (setq index (1- index))
 229                (aset extend index (aref delimit-columns-max index)))
 230              (setq delimit-columns-max extend))))
 231     ;; get maximum column length
 232     (while values
 233       (setq ncol (1- ncol))
 234       (aset delimit-columns-max ncol (max (aref delimit-columns-max ncol)
 235                                           (car values)))
 236       (setq values (cdr values)))))
 237
 238
 239 (defun delimit-columns-rectangle-line (startpos &optional ignore ignore)
 240   (let ((ncol 0)
 241         (len (length delimit-columns-max))
 242         origin)
 243     (set-marker delimit-columns-limit (point))
 244     (goto-char startpos)
 245     (insert delimit-columns-str-before)
 246     ;; Adjust all columns but last one
 247     (while (progn
 248              (setq origin (current-column))
 249              (and (< (point) delimit-columns-limit)
 250                   (re-search-forward delimit-columns-separator
 251                                      delimit-columns-limit 'move)))
 252       (delete-region (match-beginning 0) (point))
 253       (insert (make-string (- (aref delimit-columns-max ncol)
 254                               (- (current-column) origin))
 255                            ?\ )
 256               delimit-columns-str-separator)
 257       (setq ncol (1+ ncol)))
 258     ;; Adjust last column
 259     (insert (make-string (- (aref delimit-columns-max ncol)
 260                             (- (current-column) origin))
 261                          ?\ ))
 262     ;; Adjust extra columns, if needed
 263     (while (< (setq ncol (1+ ncol)) len)
 264       (insert delimit-columns-str-separator
 265               (make-string (aref delimit-columns-max ncol) ?\ )))
 266     (insert delimit-columns-str-after)))
 267
 268 \f
 269 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 270
 271
 272 (provide 'delim-col)
 273
 274
 275 ;;; delim-col.el ends here