;;; table.el --- create and edit WYSIWYG text based embedded tables
-;; Copyright (C) 2000, 01, 02, 03, 04 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005
+;; 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: Tue Jun 01 2004 11:36:39 (PDT)
+;; Revised: Fri Mar 18 2005 13:50:13 (PST)
;; This file is part of GNU Emacs.
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
:group 'editing
:group 'wp
:group 'paragraphs
- :group 'fill)
+ :group 'fill
+ :version "22.1")
(defgroup table-hooks nil
- "Hooks for table manipulation utilities"
+ "Hooks for table manipulation utilities."
:group 'table)
(defcustom table-time-before-update 0.2
:tag "Table Command Prefix"
:group 'table)
-(defface table-cell-face
- '((((class color))
+(defface table-cell
+ '((((min-colors 88) (class color))
+ (:foreground "gray90" :background "blue1"))
+ (((class color))
(:foreground "gray90" :background "blue"))
(t (:bold t)))
"*Face used for table cell contents."
:tag "Cell Face"
:group 'table)
+;; backward-compatibility alias
+(put 'table-cell-face 'face-alias 'table-cell)
(defcustom table-cell-horizontal-chars "-="
"*Characters that may be used for table cell's horizontal border line."
:group 'table-hooks)
(defcustom table-yank-handler '(nil nil t nil)
- "*yank-handler for table.")
+ "*yank-handler for table."
+ :group 'table)
(setplist 'table-disable-incompatibility-warning nil)
:active (and (not buffer-read-only) (not (table--probe-cell)))
:help "Insert a text based table at point"]
["Row" table-insert-row
- :active (and (not buffer-read-only)
- (or (table--probe-cell)
- (save-excursion
- (table--find-row-column nil t))))
+ :active (table--row-column-insertion-point-p)
:help "Insert row(s) of cells in table"]
["Column" table-insert-column
- :active (and (not buffer-read-only)
- (or (table--probe-cell)
- (save-excursion
- (table--find-row-column 'column t))))
+ :active (table--row-column-insertion-point-p 'column)
:help "Insert column(s) of cells in table"])
"----"
("Recognize"
'("Table"
("Insert"
["Row" table-insert-row
- :active (and (not buffer-read-only)
- (or (table--probe-cell)
- (save-excursion
- (table--find-row-column nil t))))
+ :active (table--row-column-insertion-point-p)
:help "Insert row(s) of cells in table"]
["Column" table-insert-column
- :active (and (not buffer-read-only)
- (or (table--probe-cell)
- (save-excursion
- (table--find-row-column 'column t))))
+ :active (table--row-column-insertion-point-p 'column)
:help "Insert column(s) of cells in table"])
("Delete"
["Row" table-delete-row
(if (featurep 'xemacs)
(progn
(easy-menu-add-item nil '("Tools") table-global-menu-map))
- (easy-menu-add-item (current-global-map) '("menu-bar" "tools") '("--"))
+ (easy-menu-add-item (current-global-map) '("menu-bar" "tools") "--")
(easy-menu-add-item (current-global-map) '("menu-bar" "tools") table-global-menu-map)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq i 0)
(while (< i columns)
(let ((beg (point)))
- (insert (make-string (car cw) ?\ ))
+ (insert (make-string (car cw) ?\s))
(insert table-cell-vertical-char)
(table--put-cell-line-property beg (1- (point))))
(if (cdr cw) (setq cw (cdr cw)))
(end (table--goto-coordinate (cons (cadr this) bottom-border-y)))
(rect (extract-rectangle beg end))
(height (+ (- (cddr this) (cdar this)) 1))
- (blank-line (make-string (- (cadr this) (caar this)) ?\ )))
+ (blank-line (make-string (- (cadr this) (caar this)) ?\s)))
;; delete lines from the bottom of the cell
(setcdr (nthcdr (- height bottom-budget 1) rect) (nthcdr height rect))
;; delete lines from the top of the cell
;; insert a column separator and column/multicolumn contents
(with-current-buffer dest-buffer
(unless first-p
- (insert (if (eq (char-before) ?\ ) "" " ") "& "))
+ (insert (if (eq (char-before) ?\s) "" " ") "& "))
(if (> span 1)
(insert (format "\\multicolumn{%d}{%sl|}{%s}" span (if first-p "|" "") line))
(insert line)))
(setq i (1+ i)))
(funcall insert-column start x1))
(with-current-buffer dest-buffer
- (insert (if (eq (char-before) ?\ ) "" " ") "\\\\\n"))))
+ (insert (if (eq (char-before) ?\s) "" " ") "\\\\\n"))))
(setq y (1+ y)))
(with-current-buffer dest-buffer
(insert "\\hline\n"))
;; insert the remaining area while appending blank lines below it
(table--insert-rectangle
(append rect (make-list (+ 2 (- (cdr rb-coord) (cdr lu-coord)))
- (make-string (+ 2 (- (car rb-coord) (car lu-coord))) ?\ ))))
+ (make-string (+ 2 (- (car rb-coord) (car lu-coord))) ?\s))))
;; remove the appended blank lines below the table if they are unnecessary
(table--goto-coordinate (cons 0 (- (cdr bt-coord) (- (cdr rb-coord) (cdr lu-coord)))))
(table--remove-blank-lines (+ 2 (- (cdr rb-coord) (cdr lu-coord))))
(unless (eolp)
(delete-char 1)))
(delete-char -1)
- (insert ?\ )
+ (insert ?\s)
(forward-char -1)))
(setq n (1+ n)))
(setq table-inhibit-auto-fill-paragraph t))
(move-to-column col)
(table--spacify-frame))))
(delete-char 1)
- (insert-before-markers ?\ ))
+ (insert-before-markers ?\s))
((table--cell-horizontal-char-p (char-after))
(while (progn
(delete-char 1)
- (insert-before-markers ?\ )
+ (insert-before-markers ?\s)
(table--cell-horizontal-char-p (char-after)))))
((eq (char-after) table-cell-vertical-char)
(while (let ((col (current-column)))
(delete-char 1)
- (insert-before-markers ?\ )
+ (insert-before-markers ?\s)
(and (zerop (forward-line 1))
(zerop (current-column))
(move-to-column col)
(table--untabify-line)
(delete-char columns-to-extend))
(table--untabify-line (point))
- (insert (make-string columns-to-extend ?\ )))
+ (insert (make-string columns-to-extend ?\s)))
(setcdr coord (1- (cdr coord)))))
(table--goto-coordinate (caar (last top-to-bottom-coord-list)))
(let ((coord (table--get-coordinate (cdr (table--horizontal-cell-list nil 'first-only 'bottom)))))
(table--untabify-line)
(delete-char columns-to-extend))
(table--untabify-line (point))
- (insert (make-string columns-to-extend ?\ )))
+ (insert (make-string columns-to-extend ?\s)))
(setcdr coord (1+ (cdr coord)))))
(while (<= (cdr beg-coord) (cdr end-coord))
(table--untabify-line (table--goto-coordinate beg-coord 'no-extension))
(setq multiplier (1- multiplier)))
ret-str))
+(defun table--line-column-position (line column)
+ "Return the location of LINE forward at COLUMN."
+ (save-excursion
+ (forward-line line)
+ (move-to-column column)
+ (point)))
+
+(defun table--row-column-insertion-point-p (&optional columnp)
+ "Return non nil if it makes sense to insert a row or a column at point."
+ (and (not buffer-read-only)
+ (or (get-text-property (point) 'table-cell)
+ (let ((column (current-column)))
+ (if columnp
+ (or (text-property-any (line-beginning-position 0)
+ (table--line-column-position -1 column)
+ 'table-cell t)
+ (text-property-any (line-beginning-position) (point) 'table-cell t)
+ (text-property-any (line-beginning-position 2)
+ (table--line-column-position 1 column)
+ 'table-cell t))
+ (text-property-any (table--line-column-position -2 column)
+ (table--line-column-position -2 (+ 2 column))
+ 'table-cell t))))))
+
(defun table--find-row-column (&optional columnp no-error)
"Search table and return a cell coordinate list of row or column."
(let ((current-coordinate (table--get-coordinate)))
(insert char)
(unless (eolp)
(delete-char 1))))
- (if (not (eq char ?\ ))
+ (if (not (eq char ?\s))
(if char (insert char))
(if (not (looking-at "\\s *$"))
(if (and table-fixed-width-mode
(defun table--editable-cell-p (&optional abort-on-error)
(and (not buffer-read-only)
- (table--probe-cell abort-on-error)))
+ (get-text-property (point) 'table-cell)))
(defun table--probe-cell (&optional abort-on-error)
"Probes a table cell around the point.
(defun table--put-cell-face-property (beg end &optional object)
"Put cell face property."
- (put-text-property beg end 'face 'table-cell-face object))
+ (put-text-property beg end 'face 'table-cell object))
(defun table--put-cell-keymap-property (beg end &optional object)
"Put cell keymap property."
(defun table--update-cell-face ()
"Update cell face according to the current mode."
(if (featurep 'xemacs)
- (set-face-property 'table-cell-face 'underline table-fixed-width-mode)
- (set-face-inverse-video-p 'table-cell-face table-fixed-width-mode)))
+ (set-face-property 'table-cell 'underline table-fixed-width-mode)
+ (set-face-inverse-video-p 'table-cell table-fixed-width-mode)))
(table--update-cell-face)
(defun table--cell-blank-str (&optional n)
"Return blank table cell string of length N."
- (let ((str (make-string (or n 1) ?\ )))
+ (let ((str (make-string (or n 1) ?\s)))
(table--put-cell-content-property 0 (length str) str)
str))
(and (zerop (forward-line 1))
(< (point) end)))
(t (forward-char -1)
- (insert-before-markers (if (equal (char-before) ?\ ) ?\ table-word-continuation-char)
+ (insert-before-markers (if (equal (char-before) ?\s) ?\s table-word-continuation-char)
"\n")
t)))))
;; End: ***
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; arch-tag: 0d69b03e-aa5f-4e72-8806-5727217617e0
+;; arch-tag: 0d69b03e-aa5f-4e72-8806-5727217617e0
;;; table.el ends here
HCoop / bpt / emacs.git / blobdiff