Mercurial > emacs
view lisp/delim-col.el @ 54341:80dfe07a1d65
New file (image.c) for Image consolidation:
(COLOR_TABLE_SUPPORT): New define to control whether
color table support is available (X only).
(Bitmap_Record): Common name for x_bitmap_record,
w32_bitmap_record, and mac_bitmap_record.
(XImagePtr): Common name for pointer to XImage or equivalent.
(XImagePtr_or_DC): New type to simplify code sharing; equivalent
to XImagePtr on X+MAC, and to HDC on W32.
(GET_PIXEL): Wrapper for XGetPixel or equivalent.
(NO_PIXMAP): Common name for "None" or equivalent.
(PNG_BG_COLOR_SHIFT): Bits to shift PNG background colors.
(RGB_PIXEL_COLOR): Common type for an integer "pixel color" value.
(PIX_MASK_RETAIN, PIX_MASK_DRAW): Portability macros (from macfns.c).
(FRAME_X_VISUAL, x_defined_color, DefaultDepthOfScreen): Define
with suitable equivalents on W32 and MAC for code sharing.
(XDrawLine): Define on MAC for code sharing.
(Destroy_Image, Free_Pixmap): Wrappers for code sharing.
(IF_LIB_AVAILABLE): Macro to simplify code sharing.
(Vx_bitmap_file_path, Vimage_cache_eviction_delay)
(x_bitmap_height, x_bitmap_width, x_bitmap_pixmap)
(x_reference_bitmap, x_create_bitmap_from_data)
(x_create_bitmap_from_file, x_destroy_bitmap)
(x_destroy_all_bitmaps, x_create_bitmap_mask)
(XGetImage, XPutPixel, XGetPixel, XDestroyImage)
(QCascent, QCmargin, QCrelief, QCconversion, QCcolor_symbols)
(QCheuristic_mask, QCindex, QCmatrix, QCcolor_adjustment, QCmask)
(Qlaplace, Qemboss, Qedge_detection, Qheuristic, Qcenter)
(define_image_type, lookup_image_type, valid_image_p)
(image_error, enum image_value_type, struct image_keyword)
(parse_image_spec, image_spec_value, Fimage_size, Fimage_mask_p)
(make_image, free_image, prepare_image_for_display, image_ascent)
(four_corners_best, image_background, image_background_transparent)
(x_clear_image_1, x_clear_image, x_alloc_image_color)
(make_image_cache, free_image_cache, clear_image_cache)
(Fclear_image_cache, postprocess_image, lookup_image, cache_image)
(forall_images_in_image_cache, x_create_x_image_and_pixmap)
(x_destroy_x_image, x_put_x_image, x_find_image_file, slurp_file)
(find_image_fsspec, image_load_qt_1, image_load_quicktime)
(init_image_func_pointer, image_load_quartz2d)
(struct ct_color, init_color_table, free_color_table)
(lookup_rgb_color, lookup_pixel_color, colors_in_color_table)
(cross_disabled_images, x_to_xcolors, x_from_xcolors)
(x_detect_edges, x_emboss, x_laplace, x_edge_detection)
(x_disable_image, x_build_heuristic_mask)
(XBM support, XPM support, PBM support, PNG support, JPEG support)
(TIFF support, GIF support, Ghostscript support): Consolidate image
code from xfns.c, w32fns.c, and macfns.c.
(syms_of_image): Consolidate image related symbol setup here.
(init_image): Consolidate image related initializations here.
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Thu, 11 Mar 2004 00:28:24 +0000 |
parents | 814ffa309985 |
children | bf6ae7cf12eb |
line wrap: on
line source
;;; delim-col.el --- prettify all columns in a region or rectangle ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Time-stamp: <2004/03/09 21:32:06 vinicius> ;; Version: 2.1 ;; Keywords: internal ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; delim-col helps to prettify columns in a text region or rectangle. ;; ;; To use it, make sure that this file is in load-path and insert in your ;; .emacs: ;; ;; (require 'delim-col) ;; ;; If you have, for example, the following columns: ;; ;; a b c d ;; aaaa bb ccc ddddd ;; aaa bbb cccc dddd ;; aa bb ccccccc ddd ;; ;; And the following settings: ;; ;; (setq delimit-columns-str-before "[ ") ;; (setq delimit-columns-str-after " ]") ;; (setq delimit-columns-str-separator ", ") ;; (setq delimit-columns-before "") ;; (setq delimit-columns-after "") ;; (setq delimit-columns-separator "\t") ;; (setq delimit-columns-format 'separator) ;; (setq delimit-columns-extra t) ;; ;; If you select the lines above and type: ;; ;; M-x delimit-columns-region RET ;; ;; You obtain the following result: ;; ;; [ a , b , c , d ] ;; [ aaaa, bb , ccc , ddddd ] ;; [ aaa , bbb, cccc , dddd ] ;; [ aa , bb , ccccccc, ddd ] ;; ;; But if you select start from the very first b to the very last c and type: ;; ;; M-x delimit-columns-rectangle RET ;; ;; You obtain the following result: ;; ;; a [ b , c ] d ;; aaaa [ bb , ccc ] ddddd ;; aaa [ bbb, cccc ] dddd ;; aa [ bb , ccccccc ] ddd ;; ;; Now, if we change settings to: ;; ;; (setq delimit-columns-before "<") ;; (setq delimit-columns-after ">") ;; ;; For the `delimit-columns-region' example above, the result is: ;; ;; [ <a> , <b> , <c> , <d> ] ;; [ <aaaa>, <bb> , <ccc> , <ddddd> ] ;; [ <aaa> , <bbb>, <cccc> , <dddd> ] ;; [ <aa> , <bb> , <ccccccc>, <ddd> ] ;; ;; And for the `delimit-columns-rectangle' example above, the result is: ;; ;; a [ <b> , <c> ] d ;; aaaa [ <bb> , <ccc> ] ddddd ;; aaa [ <bbb>, <cccc> ] dddd ;; aa [ <bb> , <ccccccc> ] ddd ;; ;; Note that `delimit-columns-region' operates over all text region ;; selected, extending the region start to the beginning of line and the ;; region end to the end of line. While `delimit-columns-rectangle' ;; operates over the text rectangle selected which rectangle diagonal is ;; given by the region start and end. ;; ;; See `delimit-columns-format' variable documentation for column formating. ;; ;; `delimit-columns-region' is useful when you have columns of text that ;; are not well aligned, like: ;; ;; horse apple bus ;; dog pineapple car ;; porcupine strawberry airplane ;; ;; `delimit-columns-region' and `delimit-columns-rectangle' handle lines ;; with different number of columns, like: ;; ;; horse apple bus ;; dog pineapple car EXTRA ;; porcupine strawberry airplane ;; ;; Use `delimit-columns-customize' to customize delim-col package variables. ;;; Code: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User Options: (defgroup columns nil "Prettify columns" :link '(emacs-library-link :tag "Source Lisp File" "delim-col.el") :prefix "delimit-columns-" :group 'internal) (defcustom delimit-columns-str-before "" "*Specify a string to be inserted before all columns." :type '(string :tag "Before All Columns") :group 'columns) (defcustom delimit-columns-str-separator ", " "*Specify a string to be inserted between each column." :type '(string :tag "Between Each Column") :group 'columns) (defcustom delimit-columns-str-after "" "*Specify a string to be inserted after all columns." :type '(string :tag "After All Columns") :group 'columns) (defcustom delimit-columns-before "" "*Specify a string to be inserted before each column." :type '(string :tag "Before Each Column") :group 'columns) (defcustom delimit-columns-after "" "*Specify a string to be inserted after each column." :type '(string :tag "After Each Column") :group 'columns) (defcustom delimit-columns-separator "\t" "*Specify a regexp which separates each column." :type '(regexp :tag "Column Separator") :group 'columns) (defcustom delimit-columns-format t "*Specify how to format columns. For examples below, consider: + columns `ccc' and `dddd', + the maximum column length for each column is 6, + and the following settings: (setq delimit-columns-before \"<\") (setq delimit-columns-after \">\") (setq delimit-columns-separator \":\") Valid values are: nil no formating. That is, `delimit-columns-after' is followed by `delimit-columns-separator'. For example, the result is: \"<ccc>:<dddd>:\" t align columns. That is, `delimit-columns-after' is followed by `delimit-columns-separator' and then followed by spaces. For example, the result is: \"<ccc>: <dddd>: \" 'separator align separators. That is, `delimit-columns-after' is followed by spaces and then followed by `delimit-columns-separator'. For example, the result is: \"<ccc> :<dddd> :\" 'padding format column by filling with spaces before `delimit-columns-after'. That is, spaces are followed by `delimit-columns-after' and then followed by `delimit-columns-separator'. For example, the result is: \"<ccc >:<dddd >:\" Any other value is treated as t." :type '(choice :menu-tag "Column Formating" :tag "Column Formating" (const :tag "No Formating" nil) (const :tag "Column Alignment" t) (const :tag "Separator Aligment" separator) (const :tag "Column Padding" padding)) :group 'columns) (defcustom delimit-columns-extra t "*Non-nil means that lines will have the same number of columns. This has effect only when there are lines with different number of columns." :type '(boolean :tag "Lines With Same Number Of Column") :group 'columns) (defcustom delimit-columns-start 0 "*Specify column number to start prettifing. See also `delimit-columns-end' for documentation. The following relation must hold: 0 <= delimit-columns-start <= delimit-columns-end The column number start from 0 and it's relative to the beginning of selected region. So if you selected a text region, the first column (column 0) is located at beginning of line. If you selected a text rectangle, the first column (column 0) is located at left corner." :type '(integer :tag "Column Start") :group 'columns) (defcustom delimit-columns-end 1000000 "*Specify column number to end prettifing. See also `delimit-columns-start' for documentation. The following relation must hold: 0 <= delimit-columns-start <= delimit-columns-end The column number start from 0 and it's relative to the beginning of selected region. So if you selected a text region, the first column (column 0) is located at beginning of line. If you selected a text rectangle, the first column (column 0) is located at left corner." :type '(integer :tag "Column End") :group 'columns) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User Commands: ;;;###autoload (defun delimit-columns-customize () "Customization of `columns' group." (interactive) (customize-group 'columns)) (defmacro delimit-columns-str (str) `(if (stringp ,str) ,str "")) ;;;###autoload (defun delimit-columns-region (start end) "Prettify all columns in a text region. START and END delimits the text region." (interactive "*r") (let ((delimit-columns-str-before (delimit-columns-str delimit-columns-str-before)) (delimit-columns-str-separator (delimit-columns-str delimit-columns-str-separator)) (delimit-columns-str-after (delimit-columns-str delimit-columns-str-after)) (delimit-columns-before (delimit-columns-str delimit-columns-before)) (delimit-columns-after (delimit-columns-str delimit-columns-after)) (delimit-columns-start (if (and (integerp delimit-columns-start) (>= delimit-columns-start 0)) delimit-columns-start 0)) (delimit-columns-end (if (integerp delimit-columns-end) delimit-columns-end 1000000)) (delimit-columns-limit (make-marker)) (the-end (copy-marker end)) delimit-columns-max) (when (<= delimit-columns-start delimit-columns-end) (save-excursion (goto-char start) (beginning-of-line) ;; get maximum length for each column (and delimit-columns-format (save-excursion (while (< (point) the-end) (delimit-columns-rectangle-max (prog1 (point) (end-of-line))) (forward-char 1)))) ;; prettify columns (while (< (point) the-end) (delimit-columns-rectangle-line (prog1 (point) (end-of-line))) (forward-char 1)) ;; nullify markers (set-marker delimit-columns-limit nil) (set-marker the-end nil))))) (require 'rect) ;;;###autoload (defun delimit-columns-rectangle (start end) "Prettify all columns in a text rectangle. START and END delimits the corners of text rectangle." (interactive "*r") (let ((delimit-columns-str-before (delimit-columns-str delimit-columns-str-before)) (delimit-columns-str-separator (delimit-columns-str delimit-columns-str-separator)) (delimit-columns-str-after (delimit-columns-str delimit-columns-str-after)) (delimit-columns-before (delimit-columns-str delimit-columns-before)) (delimit-columns-after (delimit-columns-str delimit-columns-after)) (delimit-columns-start (if (and (integerp delimit-columns-start) (>= delimit-columns-start 0)) delimit-columns-start 0)) (delimit-columns-end (if (integerp delimit-columns-end) delimit-columns-end 1000000)) (delimit-columns-limit (make-marker)) (the-end (copy-marker end)) delimit-columns-max) (when (<= delimit-columns-start delimit-columns-end) ;; get maximum length for each column (and delimit-columns-format (save-excursion (operate-on-rectangle 'delimit-columns-rectangle-max start the-end nil))) ;; prettify columns (save-excursion (operate-on-rectangle 'delimit-columns-rectangle-line start the-end nil)) ;; nullify markers (set-marker delimit-columns-limit nil) (set-marker the-end nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal Variables and Functions: ;; to avoid compilation gripes (defvar delimit-columns-max nil) (defvar delimit-columns-limit nil) (defun delimit-columns-rectangle-max (startpos &optional ignore1 ignore2) (set-marker delimit-columns-limit (point)) (goto-char startpos) (let ((ncol 1) origin values) ;; get current column length (while (progn (setq origin (current-column)) (re-search-forward delimit-columns-separator delimit-columns-limit 'move)) (save-excursion (goto-char (match-beginning 0)) (setq values (cons (- (current-column) origin) values))) (setq ncol (1+ ncol))) (setq values (cons (- (current-column) origin) values)) ;; extend delimit-columns-max, if needed (let ((index (length delimit-columns-max))) (and (> ncol index) (let ((extend (make-vector ncol 0))) (while (> index 0) (setq index (1- index)) (aset extend index (aref delimit-columns-max index))) (setq delimit-columns-max extend)))) ;; get maximum column length (while values (setq ncol (1- ncol)) (aset delimit-columns-max ncol (max (aref delimit-columns-max ncol) (car values))) (setq values (cdr values))))) (defun delimit-columns-rectangle-line (startpos &optional ignore1 ignore2) (let ((len (length delimit-columns-max)) (ncol 0) origin) (set-marker delimit-columns-limit (point)) (goto-char startpos) ;; skip initial columns (while (and (< ncol delimit-columns-start) (< (point) delimit-columns-limit) (re-search-forward delimit-columns-separator delimit-columns-limit 'move)) (setq ncol (1+ ncol))) ;; insert first formating (insert delimit-columns-str-before delimit-columns-before) ;; Adjust all columns but last one (while (progn (setq origin (current-column)) (and (< (point) delimit-columns-limit) (re-search-forward delimit-columns-separator delimit-columns-limit 'move) (or (< ncol delimit-columns-end) (progn (goto-char (match-beginning 0)) nil)))) (delete-region (match-beginning 0) (point)) (delimit-columns-format (and delimit-columns-format (make-string (- (aref delimit-columns-max ncol) (- (current-column) origin)) ?\ ))) (setq ncol (1+ ncol))) ;; Prepare last column spaces (let ((spaces (and delimit-columns-format (make-string (- (aref delimit-columns-max ncol) (- (current-column) origin)) ?\ )))) ;; Adjust extra columns, if needed (and delimit-columns-extra (while (and (< (setq ncol (1+ ncol)) len) (<= ncol delimit-columns-end)) (delimit-columns-format spaces) (setq spaces (and delimit-columns-format (make-string (aref delimit-columns-max ncol) ?\ ))))) ;; insert last formating (cond ((null delimit-columns-format) (insert delimit-columns-after delimit-columns-str-after)) ((eq delimit-columns-format 'padding) (insert spaces delimit-columns-after delimit-columns-str-after)) (t (insert delimit-columns-after spaces delimit-columns-str-after)) )) (goto-char (max (point) delimit-columns-limit)))) (defun delimit-columns-format (spaces) (cond ((null delimit-columns-format) (insert delimit-columns-after delimit-columns-str-separator delimit-columns-before)) ((eq delimit-columns-format 'separator) (insert delimit-columns-after spaces delimit-columns-str-separator delimit-columns-before)) ((eq delimit-columns-format 'padding) (insert spaces delimit-columns-after delimit-columns-str-separator delimit-columns-before)) (t (insert delimit-columns-after delimit-columns-str-separator spaces delimit-columns-before)) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (provide 'delim-col) ;;; arch-tag: 1cc0c5c5-1b2a-43e4-9ba5-bf9441cfd1a9 ;;; delim-col.el ends here