;;; table.el --- create and edit WYSIWYG text based embedded tables
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+;; 2009, 2010 Free Software Foundation, Inc.
;; Keywords: wp, convenience
;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com>
;; Created: Sat Jul 08 2000 13:28:45 (PST)
-;; Revised: Wed Jan 03 2007 13:23:46 (PST)
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, 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
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; lines. A valid character of a cell's vertical border is either
;; table-cell-vertical-char `|' or table-cell-intersection-char `+'.
;; A valid character of a cell's horizontal border is either
-;; table-cell-horizontal-char `-' or table-cell-intersection-char `+'.
+;; one of table-cell-horizontal-chars (`-' or `=')
+;; or table-cell-intersection-char `+'.
;; A valid character of the four corners of a cell must be
;; table-cell-intersection-char `+'. A cell must contain at least one
;; character space inside. There is no restriction about the contents
;;;
(defgroup table nil
- "Text based table manipulation utilities.
-See `table-insert' for examples about how to use."
+ "Text based table manipulation utilities."
:tag "Table"
:prefix "table-"
- :group 'editing
:group 'wp
- :group 'paragraphs
- :group 'fill
:version "22.1")
(defgroup table-hooks nil
:group 'table)
(defcustom table-time-before-update 0.2
- "*Time in seconds before updating the cell contents after typing.
+ "Time in seconds before updating the cell contents after typing.
Updating the cell contents on the screen takes place only after this
specified amount of time has passed after the last modification to the
cell contents. When the contents of a table cell changes repetitively
:group 'table)
(defcustom table-time-before-reformat 0.2
- "*Time in seconds before reformatting the table.
+ "Time in seconds before reformatting the table.
This many seconds must pass in addition to `table-time-before-update'
before the table is updated with newly widened width or heightened
height."
:group 'table)
(defcustom table-command-prefix [(control c) (control c)]
- "*Key sequence to be used as prefix for table command key bindings."
+ "Key sequence to be used as prefix for table command key bindings."
:type '(vector (repeat :inline t sexp))
:tag "Table Command Prefix"
:group 'table)
(((class color))
(:foreground "gray90" :background "blue"))
(t (:bold t)))
- "*Face used for table cell contents."
+ "Face used for table cell contents."
:tag "Cell Face"
:group 'table)
(defcustom table-cell-horizontal-chars "-="
- "*Characters that may be used for table cell's horizontal border line."
+ "Characters that may be used for table cell's horizontal border line."
:tag "Cell Horizontal Boundary Characters"
:type 'string
:group 'table)
(defcustom table-cell-vertical-char ?\|
- "*Character that forms table cell's vertical border line."
+ "Character that forms table cell's vertical border line."
:tag "Cell Vertical Boundary Character"
:type 'character
:group 'table)
(defcustom table-cell-intersection-char ?\+
- "*Character that forms table cell's corner."
+ "Character that forms table cell's corner."
:tag "Cell Intersection Character"
:type 'character
:group 'table)
(defcustom table-word-continuation-char ?\\
- "*Character that indicates word continuation into the next line.
+ "Character that indicates word continuation into the next line.
This character has a special meaning only in the fixed width mode,
that is when `table-fixed-width-mode' is non-nil . In the fixed width
mode this character indicates that the location is continuing into the
(set variable value))
(defcustom table-fixed-width-mode nil
- "*Cell width is fixed when this is non-nil.
+ "Cell width is fixed when this is non-nil.
Normally it should be nil for allowing automatic cell width expansion
that widens a cell when it is necessary. When non-nil, typing in a
cell does not automatically expand the cell width. A word that is too
:group 'table)
(defcustom table-detect-cell-alignment t
- "*Detect cell contents alignment automatically.
+ "Detect cell contents alignment automatically.
When non-nil cell alignment is automatically determined by the
appearance of the current cell contents when recognizing tables as a
whole. This applies to `table-recognize', `table-recognize-region'
:group 'table)
(defcustom table-dest-buffer-name "table"
- "*Default buffer name (without a suffix) for source generation."
+ "Default buffer name (without a suffix) for source generation."
:tag "Source Buffer Name"
:type 'string
:group 'table)
(defcustom table-html-delegate-spacing-to-user-agent nil
- "*Non-nil delegates cell contents spacing entirely to user agent.
+ "Non-nil delegates cell contents spacing entirely to user agent.
Otherwise, when nil, it preserves the original spacing and line breaks."
:tag "HTML delegate spacing"
:type 'boolean
:group 'table)
(defcustom table-html-th-rows 0
- "*Number of top rows to become header cells automatically in HTML generation."
+ "Number of top rows to become header cells automatically in HTML generation."
:tag "HTML Header Rows"
:type 'integer
:group 'table)
(defcustom table-html-th-columns 0
- "*Number of left columns to become header cells automatically in HTML generation."
+ "Number of left columns to become header cells automatically in HTML generation."
:tag "HTML Header Columns"
:type 'integer
:group 'table)
(defcustom table-html-table-attribute "border=\"1\""
- "*Table attribute that applies to the table in HTML generation."
+ "Table attribute that applies to the table in HTML generation."
:tag "HTML table attribute"
:type 'string
:group 'table)
(defcustom table-html-cell-attribute ""
- "*Cell attribute that applies to all cells in HTML generation.
+ "Cell attribute that applies to all cells in HTML generation.
Do not specify \"align\" and \"valign\" because they are determined by
the cell contents dynamically."
:tag "HTML cell attribute"
:group 'table)
(defcustom table-cals-thead-rows 1
- "*Number of top rows to become header rows in CALS table."
+ "Number of top rows to become header rows in CALS table."
:tag "CALS Header Rows"
:type 'integer
:group 'table)
;;;###autoload
(defcustom table-cell-map-hook nil
- "*Normal hooks run when finishing construction of `table-cell-map'.
+ "Normal hooks run when finishing construction of `table-cell-map'.
User can modify `table-cell-map' by adding custom functions here."
:tag "Cell Keymap Hooks"
:type 'hook
:group 'table-hooks)
(defcustom table-disable-incompatibility-warning nil
- "*Disable compatibility warning notice.
+ "Disable compatibility warning notice.
When nil user is reminded of known incompatible issues."
:tag "Disable Incompatibility Warning"
:type 'boolean
:group 'table)
(defcustom table-abort-recognition-when-input-pending t
- "*Abort current recognition process when input pending.
+ "Abort current recognition process when input pending.
Abort current recognition process when we are not sure that no input
is available. When non-nil lengthy recognition process is aborted
simply by any key input."
;;;###autoload
(defcustom table-load-hook nil
- "*List of functions to be called after the table is first loaded."
+ "List of functions to be called after the table is first loaded."
:type 'hook
:group 'table-hooks)
;;;###autoload
(defcustom table-point-entered-cell-hook nil
- "*List of functions to be called after point entered a table cell."
+ "List of functions to be called after point entered a table cell."
:type 'hook
:group 'table-hooks)
;;;###autoload
(defcustom table-point-left-cell-hook nil
- "*List of functions to be called after point left a table cell."
+ "List of functions to be called after point left a table cell."
:type 'hook
:group 'table-hooks)
;;; No need of user configuration
(defconst table-paragraph-start "[ \t\n\f]"
- "*Regexp for beginning of a line that starts OR separates paragraphs.")
+ "Regexp for beginning of a line that starts OR separates paragraphs.")
(defconst table-cache-buffer-name " *table cell cache*"
"Cell cache buffer name.")
(defvar table-cell-info-lu-coordinate nil
(defvar table-source-info-plist nil
"General storage for temporary information used while generating source.")
-;;; The following history containers not only keep the history of user
-;;; entries but also serve as the default value providers. When an
-;;; interactive command is invoked it offers a user the latest entry
-;;; of the history as a default selection. Therefore the values below
-;;; are the first default value when a command is invoked for the very
-;;; first time when there is no real history existing yet.
+;; The following history containers not only keep the history of user
+;; entries but also serve as the default value providers. When an
+;; interactive command is invoked it offers a user the latest entry
+;; of the history as a default selection. Therefore the values below
+;; are the first default value when a command is invoked for the very
+;; first time when there is no real history existing yet.
(defvar table-cell-span-direction-history '("right"))
(defvar table-cell-split-orientation-history '("horizontally"))
(defvar table-cell-split-contents-to-history '("split"))
(defvar table-capture-columns-history '(""))
(defvar table-target-history '("cell"))
-;;; Some entries in `table-cell-bindings' are duplicated in
-;;; `table-command-remap-alist'. There is a good reason for
-;;; this. Common key like return key may be taken by some other
-;;; function than normal `newline' function. Thus binding return key
-;;; directly for `*table--cell-newline' ensures that the correct enter
-;;; operation in a table cell. However
-;;; `table-command-remap-alist' has an additional role than
-;;; replacing commands. It is also used to construct a table command
-;;; list. This list is very important because it is used to check if
-;;; the previous command was one of them in this list or not. If the
-;;; previous command is found in the list the current command will not
-;;; refill the table cache. If the command were not listed fast
-;;; typing can cause unwanted cache refill.
+;; Some entries in `table-cell-bindings' are duplicated in
+;; `table-command-remap-alist'. There is a good reason for
+;; this. Common key like return key may be taken by some other
+;; function than normal `newline' function. Thus binding return key
+;; directly for `*table--cell-newline' ensures that the correct enter
+;; operation in a table cell. However
+;; `table-command-remap-alist' has an additional role than
+;; replacing commands. It is also used to construct a table command
+;; list. This list is very important because it is used to check if
+;; the previous command was one of them in this list or not. If the
+;; previous command is found in the list the current command will not
+;; refill the table cache. If the command were not listed fast
+;; typing can cause unwanted cache refill.
(defconst table-cell-bindings
'(([(control i)] . table-forward-cell)
([(control I)] . table-backward-cell)
(interactive "i\ni\np")
(table--make-cell-map)
(if (or force (not (memq (table--get-last-command) table-command-list)))
- (let* ((cell (table--probe-cell (interactive-p)))
+ (let* ((cell (table--probe-cell (called-interactively-p 'interactive)))
(cache-buffer (get-buffer-create table-cache-buffer-name))
(modified-flag (buffer-modified-p))
(inhibit-read-only t))
(setq table-rb (cdr starting-cell))
(setq col-list (cons (car (table--get-coordinate (car starting-cell))) nil))
(setq row-list (cons (cdr (table--get-coordinate (car starting-cell))) nil))
- (and (interactive-p)
+ (and (called-interactively-p 'interactive)
(message "Computing cell dimension..."))
(while
(progn
(th (+ 3 (- (cdr table-rb-coordinate) (cdr table-lu-coordinate))))
(c (length col-list))
(r (length row-list)))
- (and (interactive-p)
+ (and (called-interactively-p 'interactive)
(message "Cell: (%dw, %dh), Table: (%dw, %dh), Dim: (%dc, %dr), Total Cells: %d" cw ch tw th c r cells))
(list cw ch tw th c r cells))))))
References used for this implementation:
HTML:
- http://www.w3.org
+ URL `http://www.w3.org'
LaTeX:
- http://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html
+ URL `http://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html'
CALS (DocBook DTD):
- http://www.oasis-open.org/html/a502.htm
- http://www.oreilly.com/catalog/docbook/chapter/book/table.html#AEN114751
+ URL `http://www.oasis-open.org/html/a502.htm'
+ URL `http://www.oreilly.com/catalog/docbook/chapter/book/table.html#AEN114751'
"
(interactive
(let* ((dummy (unless (table--probe-cell) (error "Table not found here")))
(read-buffer "Destination buffer: " (concat table-dest-buffer-name "." language))
(table--read-from-minibuffer '("Table Caption" . table-source-caption-history)))))
(let ((default-buffer-name (concat table-dest-buffer-name "." (symbol-name language))))
- (unless (or (interactive-p) (table--probe-cell)) (error "Table not found here"))
+ (unless (or (called-interactively-p 'interactive) (table--probe-cell))
+ (error "Table not found here"))
(unless (bufferp dest-buffer)
(setq dest-buffer (get-buffer-create (or dest-buffer default-buffer-name))))
(if (string= (buffer-name dest-buffer) default-buffer-name)
(let ((wheel [?- ?\\ ?| ?/]))
(while
(progn
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(progn
(message "Analyzing table...%c" (aref wheel i))
(if (eq (setq i (1+ i)) (length wheel))
;; insert closing
(table--generate-source-epilogue dest-buffer language col-list row-list))
;; lastly do some convenience work
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(save-selected-window
(pop-to-buffer dest-buffer t)
(goto-char (point-min))
(format "Justify (default %s): " default)
'(("left") ("center") ("right"))
nil t nil 'table-sequence-justify-history default)))))))
- (unless (or (interactive-p) (table--probe-cell)) (error "Table not found here"))
+ (unless (or (called-interactively-p 'interactive) (table--probe-cell))
+ (error "Table not found here"))
(string-match "\\([0-9]*\\)\\([]})>]*\\)\\'" str)
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "Sequencing..."))
(let* ((prefix (substring str 0 (match-beginning 1)))
(index (match-string 1 str))
(setq cells (1- cells))
(and (> n 0) (> cells 0)))))
(table-recognize-cell 'force)
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "Sequencing...done"))
))
(table--read-from-minibuffer '("Minimum cell width" . table-capture-min-cell-width-history)))
(if (and (not (string= col-delim-regexp "")) (string= row-delim-regexp ""))
(string-to-number
- (table--read-from-minibuffer '("Number of columns" . 'table-capture-columns-history)))
+ (table--read-from-minibuffer '("Number of columns" . table-capture-columns-history)))
nil)
)))
(if (> beg end) (let ((tmp beg)) (setq beg end) (setq end tmp)))
(defun *table--cell-self-insert-command ()
"Table cell version of `self-insert-command'."
(interactive "*")
- (let ((char (table--unibyte-char-to-multibyte last-command-char)))
+ (let ((char last-command-event))
(if (eq buffer-undo-list t) nil
(if (not (eq last-command this-command))
(setq table-cell-self-insert-command-count 0)
(defun *table--cell-quoted-insert (arg)
"Table cell version of `quoted-insert'."
(interactive "*p")
- (let ((char (table--unibyte-char-to-multibyte (read-quoted-char))))
+ (let ((char (read-quoted-char)))
(while (> arg 0)
(table--cell-insert-char char nil)
(setq arg (1- arg)))))
(call-interactively 'describe-mode)
(with-output-to-temp-buffer "*Help*"
(princ "Table mode: (in ")
- (princ mode-name)
+ (princ (format-mode-line mode-name nil nil (current-buffer)))
(princ " mode)
Table is not a mode technically. You can regard it as a pseudo mode
folded location is marked by a continuation character which is
specified in the variable `table-word-continuation-char'.
")
- (print-help-return-message))))
+ (help-print-return-message))))
(defun *table--cell-describe-bindings ()
"Table cell version of `describe-bindings'."
(key-description (car binding))
(cdr binding))))
table-cell-bindings)
- (print-help-return-message))))
+ (help-print-return-message))))
(defun *table--cell-dabbrev-expand (arg)
"Table cell version of `dabbrev-expand'."
(cdr (symbol-value (cdr prompt-history)))))
(car (symbol-value (cdr prompt-history))))
-(defun table--unibyte-char-to-multibyte (char)
- "Convert CHAR by `unibyte-char-to-multibyte' when possible and necessary."
- ;; This part is take from `quoted-insert'.
- ;; Assume character codes 0240 - 0377 stand for characters in some
- ;; single-byte character set, and convert them to Emacs
- ;; characters.
- (if (and enable-multibyte-characters
- (fboundp 'unibyte-char-to-multibyte)
- (>= char ?\240)
- (<= char ?\377))
- (unibyte-char-to-multibyte char)
- char))
-
(defun table--buffer-substring-and-trim (beg end)
"Extract buffer substring and remove blanks from front and the rear of it."
(save-excursion
(px (or internal-px (car (if (eq pivot 'left) lu-coordinate rb-coordinate))))
(ty (- (cdr lu-coordinate) 2))
(by (+ (cdr rb-coordinate) 2)))
- ;; in case of finding the the first cell, get the last adding item on the list
+ ;; in case of finding the first cell, get the last adding item on the list
(if (and (null internal-dir) first-only) (setq top-to-bottom (null top-to-bottom)))
;; travel up and process as recursion traces back (reverse order)
(and cell
(py (or internal-py (if (eq pivot 'top) (cdr lu-coordinate) (1+ (cdr rb-coordinate)))))
(lx (1- (car lu-coordinate)))
(rx (1+ (car rb-coordinate))))
- ;; in case of finding the the first cell, get the last adding item on the list
+ ;; in case of finding the first cell, get the last adding item on the list
(if (and (null internal-dir) first-only) (setq left-to-right (null left-to-right)))
;; travel left and process as recursion traces back (reverse order)
(and cell
This feature is disabled when `table-disable-incompatibility-warning'
is non-nil. The warning is done only once per session for each item."
(unless (and table-disable-incompatibility-warning
- (not (interactive-p)))
+ (not (called-interactively-p 'interactive)))
(cond ((and (featurep 'xemacs)
(not (get 'table-disable-incompatibility-warning 'xemacs)))
(put 'table-disable-incompatibility-warning 'xemacs t)
*** Warning ***
Flyspell minor mode is known to be incompatible with this table
-package. The flyspell version 1.5d at http://kaolin.unice.fr/~serrano
+package. The flyspell version 1.5d at URL `http://kaolin.unice.fr/~serrano'
works better than the previous versions however not fully compatible.
"
(provide 'table)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Local Variables: ***
-;; time-stamp-line-limit: 16 ***
-;; time-stamp-start: ";; Revised:[ \t]+" ***
-;; time-stamp-end: "$" ***
-;; time-stamp-format: "%3a %3b %02d %:y %02H:%02M:%02S (%Z)" ***
-;; End: ***
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
;; arch-tag: 0d69b03e-aa5f-4e72-8806-5727217617e0
;;; table.el ends here
HCoop / bpt / emacs.git / blobdiff