;;; table.el --- create and edit WYSIWYG text based embedded tables -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2016 Free Software Foundation, Inc.
;; Keywords: wp, convenience
;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com>
;; Todo: (in the order of priority, some are just possibility)
;; -----
;;
-;; Fix compatibilities with other input method than quail
+;; Fix incompatibilities with input methods other than quail
;; Resolve conflict with flyspell
;; Use mouse for resizing cells
;; A mechanism to link cells internally
;; Maybe provide complete XEmacs support in the future however the
;; "extent" is the single largest obstacle lying ahead, read the
;; document in Emacs info.
-;; (eval '(progn (require 'info) (Info-find-node "elisp" "Not Intervals")))
+;; (progn (require 'info) (Info-find-node "elisp" "Not Intervals"))
;;
;;
;; ---------------
:type 'integer
:group 'table)
-;;;###autoload
(defcustom table-cell-map-hook nil
"Normal hooks run when finishing construction of `table-cell-map'.
User can modify `table-cell-map' by adding custom functions here."
:type 'boolean
:group 'table)
-;;;###autoload
(defcustom table-load-hook nil
"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."
: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."
:type 'hook
"Cache point coordinate based from the cell origin.")
(defvar table-cell-cache-mark-coordinate nil
"Cache mark coordinate based from the cell origin.")
-(defvar table-cell-entered-state nil
- "Records the state whether currently in a cell or nor.")
(defvar table-update-timer nil
"Timer id for deferred cell update.")
(defvar table-widen-timer nil
([(shift backtab)] . table-backward-cell) ; for HPUX console keyboard
([(shift iso-lefttab)] . table-backward-cell) ; shift-tab on a microsoft natural keyboard and redhat linux
([(shift tab)] . table-backward-cell)
+ ([backtab] . table-backward-cell) ; for terminals (e.g., xterm)
([return] . *table--cell-newline)
([(control m)] . *table--cell-newline)
([(control j)] . *table--cell-newline-and-indent)
;; does not cause a problem in the old implementation. Sigh...
(when (featurep 'xemacs)
(defun table--tweak-menu-for-xemacs (menu)
- (cond
- ((listp menu)
- (mapcar #'table--tweak-menu-for-xemacs menu))
- ((vectorp menu)
- (let ((len (length menu)))
- (dotimes (i len)
- ;; replace :help with something harmless.
- (if (eq (aref menu i) :help) (aset menu i :included)))))))
+ (cond
+ ((listp menu)
+ (mapcar #'table--tweak-menu-for-xemacs menu))
+ ((vectorp menu)
+ (let ((len (length menu)))
+ (dotimes (i len)
+ ;; replace :help with something harmless.
+ (if (eq (aref menu i) :help) (aset menu i :included)))))))
(mapcar #'table--tweak-menu-for-xemacs
(list table-global-menu table-cell-menu))
(defvar mark-active t))
(while (and (re-search-forward border3 (point-max) t)
(not (and (input-pending-p)
table-abort-recognition-when-input-pending)))
- (message "Recognizing tables...(%d%%)" (/ (* 100 (match-beginning 0)) (- (point-max) (point-min))))
+ (message "Recognizing tables...(%d%%)"
+ (floor (* 100.0 (match-beginning 0))
+ (- (point-max) (point-min))))
(let ((beg (match-beginning 0))
end)
(if (re-search-forward non-border (point-max) t)
;;;###autoload
(defun table-justify (what justify)
"Justify contents of a cell, a row of cells or a column of cells.
-WHAT is a symbol 'cell, 'row or 'column. JUSTIFY is a symbol 'left,
-'center, 'right, 'top, 'middle, 'bottom or 'none."
+WHAT is a symbol `cell', `row' or `column'. JUSTIFY is a symbol
+`left', `center', `right', `top', `middle', `bottom' or `none'."
(interactive
(list (let* ((_ (barf-if-buffer-read-only))
(completion-ignore-case t)
;;;###autoload
(defun table-justify-cell (justify &optional paragraph)
"Justify cell contents.
-JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or 'top,
-'middle, 'bottom or 'none for vertical. When optional PARAGRAPH is
+JUSTIFY is a symbol `left', `center' or `right' for horizontal, or `top',
+`middle', `bottom' or `none' for vertical. When optional PARAGRAPH is
non-nil the justify operation is limited to the current paragraph,
otherwise the entire cell contents is justified."
(interactive
;;;###autoload
(defun table-justify-row (justify)
"Justify cells of a row.
-JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or top,
-'middle, 'bottom or 'none for vertical."
+JUSTIFY is a symbol `left', `center' or `right' for horizontal,
+or `top', `middle', `bottom' or `none' for vertical."
(interactive
(list (table--query-justification)))
(let((cell-list (table--horizontal-cell-list nil nil 'top)))
;;;###autoload
(defun table-justify-column (justify)
"Justify cells of a column.
-JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or top,
-'middle, 'bottom or 'none for vertical."
+JUSTIFY is a symbol `left', `center' or `right' for horizontal,
+or `top', `middle', `bottom' or `none' for vertical."
(interactive
(list (table--query-justification)))
(let((cell-list (table--vertical-cell-list nil nil 'left)))
(defun table-generate-source (language &optional dest-buffer caption)
"Generate source of the current table in the specified language.
LANGUAGE is a symbol that specifies the language to describe the
-structure of the table. It must be either 'html, 'latex or 'cals.
+structure of the table. It must be either `html', `latex' or `cals'.
The resulted source text is inserted into DEST-BUFFER and the buffer
object is returned. When DEST-BUFFER is omitted or nil the default
buffer specified in `table-dest-buffer-name' is used. In this case
insertion which is normally 1. When zero or less is given for
INTERVAL it is interpreted as number of cells per row so that sequence
is placed straight down vertically as long as the table's cell
-structure is uniform. JUSTIFY is one of the symbol 'left, 'center or
-'right, that specifies justification of the inserted string.
+structure is uniform. JUSTIFY is a symbol `left', `center' or
+`right' that specifies justification of the inserted string.
Example:
(progn
(table-insert 16 3 5 1)
(table-forward-cell 15)
- (table-insert-sequence \"D0\" -16 1 1 'center)
+ (table-insert-sequence \"D0\" -16 1 1 \\='center)
(table-forward-cell 16)
- (table-insert-sequence \"A[0]\" -16 1 1 'center)
+ (table-insert-sequence \"A[0]\" -16 1 1 \\='center)
(table-forward-cell 1)
- (table-insert-sequence \"-\" 16 0 1 'center))
+ (table-insert-sequence \"-\" 16 0 1 \\='center))
(progn
(table-insert 16 8 5 1)
- (table-insert-sequence \"@\" 0 1 2 'right)
+ (table-insert-sequence \"@\" 0 1 2 \\='right)
(table-forward-cell 1)
- (table-insert-sequence \"64\" 0 1 2 'left))"
+ (table-insert-sequence \"64\" 0 1 2 \\='left))"
(interactive
(progn
(barf-if-buffer-read-only)
columns and rows of the table automatically. If COL-DELIM-REGEXP and
ROW-DELIM-REGEXP are omitted the result table has only one cell and
the entire region contents is placed in that cell. Optional JUSTIFY
-is one of 'left, 'center or 'right, which specifies the cell
+is one of `left', `center' or `right', which specifies the cell
justification. Optional MIN-CELL-WIDTH specifies the minimum cell
width. Optional COLUMNS specify the number of columns when
ROW-DELIM-REGEXP is not specified.
(defun table--justify-cell-contents (justify &optional paragraph)
"Justify the current cell contents.
-JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or 'top,
-'middle, 'bottom or 'none for vertical. When PARAGRAPH is non-nil the
+JUSTIFY is a symbol `left', `center' or `right' for horizontal, or `top',
+`middle', `bottom' or `none' for vertical. When PARAGRAPH is non-nil the
justify operation is limited to the current paragraph."
(table-with-cache-buffer
(let ((beg (point-min))
(defun table--put-cell-point-entered/left-property (beg end &optional object)
"Put point-entered/left property."
- (put-text-property beg end 'point-entered 'table--point-entered-cell-function object)
- (put-text-property beg end 'point-left 'table--point-left-cell-function object))
+ (put-text-property beg end 'cursor-sensor-functions
+ '(table--point-entered/left-cell-function) object))
(defun table--remove-cell-properties (beg end &optional object)
"Remove all cell properties.
'table-valign nil
'face nil
'rear-nonsticky nil
- 'point-entered nil
- 'point-left nil
+ 'cursor-sensor-functions nil
'keymap nil)
object))
(setq beg next)))
"Put cell's vertical alignment property."
(table--put-property cell 'table-valign valign))
-(defun table--point-entered-cell-function (&optional _old-point _new-point)
+(defun table--point-entered/left-cell-function (_window _oldpos dir)
"Point has entered a cell.
Refresh the menu bar."
;; Avoid calling point-motion-hooks recursively.
(let ((inhibit-point-motion-hooks t))
- (unless table-cell-entered-state
- (setq table-cell-entered-state t)
+ (force-mode-line-update)
+ (pcase dir
+ ('left
+ (setq table-mode-indicator nil)
+ (run-hooks 'table-point-left-cell-hook))
+ ('entered
(setq table-mode-indicator t)
- (force-mode-line-update)
(table--warn-incompatibility)
- (run-hooks 'table-point-entered-cell-hook))))
-
-(defun table--point-left-cell-function (&optional _old-point _new-point)
- "Point has left a cell.
-Refresh the menu bar."
- ;; Avoid calling point-motion-hooks recursively.
- (let ((inhibit-point-motion-hooks t))
- (when table-cell-entered-state
- (setq table-cell-entered-state nil)
- (setq table-mode-indicator nil)
- (force-mode-line-update)
- (run-hooks 'table-point-left-cell-hook))))
+ (run-hooks 'table-point-entered-cell-hook)))))
(defun table--warn-incompatibility ()
"If called from interactive operation warn the know incompatibilities.