5 |
;; Keywords: wp, convenience |
;; Keywords: wp, convenience |
6 |
;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com> |
;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com> |
7 |
;; Created: Sat Jul 08 2000 13:28:45 (PST) |
;; Created: Sat Jul 08 2000 13:28:45 (PST) |
8 |
;; Revised: mar feb 18 2003 10:03:18 (Romance Standard Time) |
;; Revised: jue jun 05 2003 22:00:02 (Hora de verano romance) |
9 |
|
|
10 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
11 |
|
|
688 |
:tag "Cell Face" |
:tag "Cell Face" |
689 |
:group 'table) |
:group 'table) |
690 |
|
|
691 |
(defcustom table-cell-horizontal-char ?\- |
(defcustom table-cell-horizontal-chars "-=" |
692 |
"*Character that forms table cell's horizontal border line." |
"*Characters that may be used for table cell's horizontal border line." |
693 |
:tag "Cell Horizontal Boundary Character" |
:tag "Cell Horizontal Boundary Characters" |
694 |
:type 'character |
:type 'string |
695 |
:group 'table) |
:group 'table) |
696 |
|
|
697 |
(defcustom table-cell-vertical-char ?\| |
(defcustom table-cell-vertical-char ?\| |
986 |
) |
) |
987 |
"Bindings for table cell commands.") |
"Bindings for table cell commands.") |
988 |
|
|
989 |
(defconst table-command-remap-alist |
(defvar table-command-remap-alist |
990 |
'((self-insert-command . *table--cell-self-insert-command) |
'((self-insert-command . *table--cell-self-insert-command) |
991 |
(completion-separator-self-insert-autofilling . *table--cell-self-insert-command) |
(completion-separator-self-insert-autofilling . *table--cell-self-insert-command) |
992 |
(completion-separator-self-insert-command . *table--cell-self-insert-command) |
(completion-separator-self-insert-command . *table--cell-self-insert-command) |
1004 |
(dabbrev-completion . *table--cell-dabbrev-completion)) |
(dabbrev-completion . *table--cell-dabbrev-completion)) |
1005 |
"List of cons cells consisting of (ORIGINAL-COMMAND . TABLE-VERSION-OF-THE-COMMAND).") |
"List of cons cells consisting of (ORIGINAL-COMMAND . TABLE-VERSION-OF-THE-COMMAND).") |
1006 |
|
|
1007 |
(defconst table-command-list nil |
(defvar table-command-list nil |
1008 |
"List of commands that override original commands.") |
"List of commands that override original commands.") |
1009 |
;; construct the real contents of the `table-command-list' |
;; construct the real contents of the `table-command-list' |
1010 |
(let ((remap-alist table-command-remap-alist)) |
(let ((remap-alist table-command-remap-alist)) |
1658 |
(setq cw cell-width) |
(setq cw cell-width) |
1659 |
(setq i 0) |
(setq i 0) |
1660 |
(while (< i columns) |
(while (< i columns) |
1661 |
(insert (make-string (car cw) table-cell-horizontal-char) table-cell-intersection-char) |
(insert (make-string (car cw) (string-to-char table-cell-horizontal-chars)) table-cell-intersection-char) |
1662 |
(if (cdr cw) (setq cw (cdr cw))) |
(if (cdr cw) (setq cw (cdr cw))) |
1663 |
(setq i (1+ i))) |
(setq i (1+ i))) |
1664 |
(setq border-str (buffer-substring (point-min) (point-max))) |
(setq border-str (buffer-substring (point-min) (point-max))) |
1748 |
(while (> i 0) |
(while (> i 0) |
1749 |
(setq rect (cons |
(setq rect (cons |
1750 |
(concat (if exclude-left "" (char-to-string table-cell-intersection-char)) |
(concat (if exclude-left "" (char-to-string table-cell-intersection-char)) |
1751 |
(make-string (- (cadr this) (caar this)) table-cell-horizontal-char) |
(make-string (- (cadr this) (caar this)) (string-to-char table-cell-horizontal-chars)) |
1752 |
(if exclude-right "" (char-to-string table-cell-intersection-char))) |
(if exclude-right "" (char-to-string table-cell-intersection-char))) |
1753 |
rect)) |
rect)) |
1754 |
(let ((j cell-height)) |
(let ((j cell-height)) |
1801 |
(coord-list (table--cell-list-to-coord-list (table--vertical-cell-list t nil 'left))) |
(coord-list (table--cell-list-to-coord-list (table--vertical-cell-list t nil 'left))) |
1802 |
(append-column (if coord-list nil (setq coord-list (table--find-row-column 'column)))) |
(append-column (if coord-list nil (setq coord-list (table--find-row-column 'column)))) |
1803 |
(cell-width (car (table--min-coord-list coord-list))) |
(cell-width (car (table--min-coord-list coord-list))) |
1804 |
(border-str (table--multiply-string (concat (make-string cell-width table-cell-horizontal-char) |
(border-str (table--multiply-string (concat (make-string cell-width (string-to-char table-cell-horizontal-chars)) |
1805 |
(char-to-string table-cell-intersection-char)) n)) |
(char-to-string table-cell-intersection-char)) n)) |
1806 |
(cell-str (table--multiply-string (concat (table--cell-blank-str cell-width) |
(cell-str (table--multiply-string (concat (table--cell-blank-str cell-width) |
1807 |
(let ((str (string table-cell-vertical-char))) |
(let ((str (string table-cell-vertical-char))) |
1915 |
(if (>= arg 0) |
(if (>= arg 0) |
1916 |
(save-excursion |
(save-excursion |
1917 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1918 |
(let* ((border (format "[%c%c%c]" |
(let* ((border (format "[%s%c%c]" |
1919 |
table-cell-horizontal-char |
table-cell-horizontal-chars |
1920 |
table-cell-vertical-char |
table-cell-vertical-char |
1921 |
table-cell-intersection-char)) |
table-cell-intersection-char)) |
1922 |
(border3 (concat border border border)) |
(border3 (concat border border border)) |
1923 |
(non-border (format "^[^%c%c%c]*$" |
(non-border (format "^[^%s%c%c]*$" |
1924 |
table-cell-horizontal-char |
table-cell-horizontal-chars |
1925 |
table-cell-vertical-char |
table-cell-vertical-char |
1926 |
table-cell-intersection-char))) |
table-cell-intersection-char))) |
1927 |
;; `table-recognize-region' is an expensive function so minimize |
;; `table-recognize-region' is an expensive function so minimize |
1964 |
(table--remove-cell-properties beg end) |
(table--remove-cell-properties beg end) |
1965 |
(save-excursion |
(save-excursion |
1966 |
(goto-char beg) |
(goto-char beg) |
1967 |
(let* ((border (format "[%c%c%c]" |
(let* ((border (format "[%s%c%c]" |
1968 |
table-cell-horizontal-char |
table-cell-horizontal-chars |
1969 |
table-cell-vertical-char |
table-cell-vertical-char |
1970 |
table-cell-intersection-char)) |
table-cell-intersection-char)) |
1971 |
(non-border (format "[^%c%c%c]" |
(non-border (format "[^%s%c%c]" |
1972 |
table-cell-horizontal-char |
table-cell-horizontal-chars |
1973 |
table-cell-vertical-char |
table-cell-vertical-char |
1974 |
table-cell-intersection-char)) |
table-cell-intersection-char)) |
1975 |
(inhibit-read-only t)) |
(inhibit-read-only t)) |
2318 |
(1+ (cdr (cdr this))) |
(1+ (cdr (cdr this))) |
2319 |
(cdr (cdr this)))))) |
(cdr (cdr this)))))) |
2320 |
(tmp (extract-rectangle (1- beg) end)) |
(tmp (extract-rectangle (1- beg) end)) |
2321 |
(border (format "[%c%c]\\%c" |
(border (format "[%s%c]\\%c" |
2322 |
table-cell-horizontal-char |
table-cell-horizontal-chars |
2323 |
table-cell-intersection-char |
table-cell-intersection-char |
2324 |
table-cell-intersection-char)) |
table-cell-intersection-char)) |
2325 |
(blank (table--cell-blank-str)) |
(blank (table--cell-blank-str)) |
2326 |
rectangle) |
rectangle) |
2327 |
;; create a single wide vertical bar of empty cell fragment |
;; create a single wide vertical bar of empty cell fragment |
2328 |
(while tmp |
(while tmp |
2329 |
(setq rectangle (cons (if (string-match border (car tmp)) |
; (message "tmp is %s" tmp) |
2330 |
(string table-cell-horizontal-char) |
(setq rectangle (cons |
2331 |
|
(if (string-match border (car tmp)) |
2332 |
|
(substring (car tmp) 0 1) |
2333 |
blank) |
blank) |
2334 |
rectangle)) |
rectangle)) |
2335 |
|
; (message "rectangle is %s" rectangle) |
2336 |
(setq tmp (cdr tmp))) |
(setq tmp (cdr tmp))) |
2337 |
(setq rectangle (nreverse rectangle)) |
(setq rectangle (nreverse rectangle)) |
2338 |
;; untabify the area right of the bar that is about to be inserted |
;; untabify the area right of the bar that is about to be inserted |
2659 |
(setq rectangle |
(setq rectangle |
2660 |
(cons (if below-contp |
(cons (if below-contp |
2661 |
(char-to-string table-cell-intersection-char) |
(char-to-string table-cell-intersection-char) |
2662 |
(char-to-string table-cell-horizontal-char)) |
(substring table-cell-horizontal-chars 0 1)) |
2663 |
rectangle)) |
rectangle)) |
2664 |
(while (> n-element 0) |
(while (> n-element 0) |
2665 |
(setq rectangle (cons (table--cell-blank-str 1) rectangle)) |
(setq rectangle (cons (table--cell-blank-str 1) rectangle)) |
2667 |
(setq rectangle |
(setq rectangle |
2668 |
(cons (if above-contp |
(cons (if above-contp |
2669 |
(char-to-string table-cell-intersection-char) |
(char-to-string table-cell-intersection-char) |
2670 |
(char-to-string table-cell-horizontal-char)) |
(substring table-cell-horizontal-chars 0 1)) |
2671 |
rectangle)) |
rectangle)) |
2672 |
(delete-rectangle beg end) |
(delete-rectangle beg end) |
2673 |
(goto-char beg) |
(goto-char beg) |
2676 |
(insert (if (and (> (point) (point-min)) |
(insert (if (and (> (point) (point-min)) |
2677 |
(save-excursion |
(save-excursion |
2678 |
(forward-char -1) |
(forward-char -1) |
2679 |
(looking-at (regexp-quote (char-to-string table-cell-horizontal-char))))) |
(looking-at (regexp-opt-charset |
2680 |
|
(string-to-list table-cell-horizontal-chars))))) |
2681 |
table-cell-intersection-char |
table-cell-intersection-char |
2682 |
table-cell-vertical-char) |
table-cell-vertical-char) |
2683 |
(table--cell-blank-str (- end beg 2)) |
(table--cell-blank-str (- end beg 2)) |
2684 |
(if (looking-at (regexp-quote (char-to-string table-cell-horizontal-char))) |
(if (looking-at (regexp-opt-charset |
2685 |
|
(string-to-list table-cell-horizontal-chars))) |
2686 |
table-cell-intersection-char |
table-cell-intersection-char |
2687 |
table-cell-vertical-char)))) |
table-cell-vertical-char)))) |
2688 |
;; recognize the newly created spanned cell |
;; recognize the newly created spanned cell |
2716 |
(goto-char beg) |
(goto-char beg) |
2717 |
(delete-region beg end) |
(delete-region beg end) |
2718 |
(insert table-cell-intersection-char |
(insert table-cell-intersection-char |
2719 |
(make-string table-cell-info-width table-cell-horizontal-char) |
(make-string table-cell-info-width (string-to-char table-cell-horizontal-chars)) |
2720 |
table-cell-intersection-char) |
table-cell-intersection-char) |
2721 |
(table--goto-coordinate old-coordinate) |
(table--goto-coordinate old-coordinate) |
2722 |
(forward-line 1) |
(forward-line 1) |
3289 |
((eq language 'cals) 10))) |
((eq language 'cals) 10))) |
3290 |
(insert ?\n))))) |
(insert ?\n))))) |
3291 |
|
|
3292 |
|
(defun table--cell-horizontal-char-p (c) |
3293 |
|
"Test if character C is one of the horizontal characters" |
3294 |
|
(memq c (string-to-list table-cell-horizontal-chars))) |
3295 |
|
|
3296 |
(defun table--generate-source-scan-lines (dest-buffer language origin-cell tail-cell col-list row-list) |
(defun table--generate-source-scan-lines (dest-buffer language origin-cell tail-cell col-list row-list) |
3297 |
"Scan the table line by line. |
"Scan the table line by line. |
3298 |
Currently this method is for LaTeX only." |
Currently this method is for LaTeX only." |
3312 |
start i c) |
start i c) |
3313 |
(if border-p |
(if border-p |
3314 |
;; horizontal cell border processing |
;; horizontal cell border processing |
3315 |
(if (and (eq (car border-char-list) table-cell-horizontal-char) |
(if (and (table--cell-horizontal-char-p (car border-char-list)) |
3316 |
(table--uniform-list-p border-char-list)) |
(table--uniform-list-p border-char-list)) |
3317 |
(with-current-buffer dest-buffer |
(with-current-buffer dest-buffer |
3318 |
(insert "\\hline\n")) |
(insert "\\hline\n")) |
3319 |
(setq i 0) |
(setq i 0) |
3320 |
(while (setq c (nth i border-char-list)) |
(while (setq c (nth i border-char-list)) |
3321 |
(if (and start (not (eq c table-cell-horizontal-char))) |
(if (and start (not (table--cell-horizontal-char-p c))) |
3322 |
(progn |
(progn |
3323 |
(with-current-buffer dest-buffer |
(with-current-buffer dest-buffer |
3324 |
(insert (format "\\cline{%d-%d}\n" (1+ start) i))) |
(insert (format "\\cline{%d-%d}\n" (1+ start) i))) |
3325 |
(setq start nil))) |
(setq start nil))) |
3326 |
(if (and (not start) (eq c table-cell-horizontal-char)) |
(if (and (not start) (table--cell-horizontal-char-p c)) |
3327 |
(setq start i)) |
(setq start i)) |
3328 |
(setq i (1+ i))) |
(setq i (1+ i))) |
3329 |
(if start |
(if start |
3543 |
(delete-char 1) |
(delete-char 1) |
3544 |
(insert table-cell-intersection-char)) |
(insert table-cell-intersection-char)) |
3545 |
(delete-char 1) |
(delete-char 1) |
3546 |
(insert table-cell-horizontal-char)) |
(insert (string-to-char table-cell-horizontal-chars))) |
3547 |
(setq n (1- n)) |
(setq n (1- n)) |
3548 |
(setcar coord (1+ (car coord))))) |
(setcar coord (1+ (car coord))))) |
3549 |
;; goto appropriate end point |
;; goto appropriate end point |
3585 |
(table--goto-coordinate coord) |
(table--goto-coordinate coord) |
3586 |
(if (save-excursion |
(if (save-excursion |
3587 |
(or (and (table--goto-coordinate (cons (1- (car coord)) (cdr coord)) 'no-extension) |
(or (and (table--goto-coordinate (cons (1- (car coord)) (cdr coord)) 'no-extension) |
3588 |
(looking-at (regexp-quote (char-to-string table-cell-horizontal-char)))) |
(looking-at (regexp-opt-charset |
3589 |
|
(string-to-list table-cell-horizontal-chars)))) |
3590 |
(and (table--goto-coordinate (cons (1+ (car coord)) (cdr coord)) 'no-extension) |
(and (table--goto-coordinate (cons (1+ (car coord)) (cdr coord)) 'no-extension) |
3591 |
(looking-at (regexp-quote (char-to-string table-cell-horizontal-char)))))) |
(looking-at (regexp-opt-charset |
3592 |
|
(string-to-list table-cell-horizontal-chars)))))) |
3593 |
(progn |
(progn |
3594 |
(delete-char 1) |
(delete-char 1) |
3595 |
(insert table-cell-intersection-char)) |
(insert table-cell-intersection-char)) |
4423 |
(defun table--spacify-frame () |
(defun table--spacify-frame () |
4424 |
"Spacify table frame. |
"Spacify table frame. |
4425 |
Replace frame characters with spaces." |
Replace frame characters with spaces." |
4426 |
(let ((frame-char (list table-cell-intersection-char |
(let ((frame-char |
4427 |
table-cell-horizontal-char |
(append (string-to-list table-cell-horizontal-chars) |
4428 |
table-cell-vertical-char))) |
(list table-cell-intersection-char table-cell-vertical-char)))) |
4429 |
(while |
(while |
4430 |
(progn |
(progn |
4431 |
(cond |
(cond |
4438 |
(table--spacify-frame)))) |
(table--spacify-frame)))) |
4439 |
(delete-char 1) |
(delete-char 1) |
4440 |
(insert-before-markers ?\ )) |
(insert-before-markers ?\ )) |
4441 |
((eq (char-after) table-cell-horizontal-char) |
((table--cell-horizontal-char-p (char-after)) |
4442 |
(while (progn |
(while (progn |
4443 |
(delete-char 1) |
(delete-char 1) |
4444 |
(insert-before-markers ?\ ) |
(insert-before-markers ?\ ) |
4445 |
(eq (char-after) table-cell-horizontal-char)))) |
(table--cell-horizontal-char-p (char-after))))) |
4446 |
((eq (char-after) table-cell-vertical-char) |
((eq (char-after) table-cell-vertical-char) |
4447 |
(while (let ((col (current-column))) |
(while (let ((col (current-column))) |
4448 |
(delete-char 1) |
(delete-char 1) |
4696 |
(>= (if columnp (car coord) (cdr coord)) 0)) |
(>= (if columnp (car coord) (cdr coord)) 0)) |
4697 |
(while (progn |
(while (progn |
4698 |
(table--goto-coordinate coord 'no-extension 'no-tab-expansion) |
(table--goto-coordinate coord 'no-extension 'no-tab-expansion) |
4699 |
(not (looking-at (format "[%c%c%c]" |
(not (looking-at (format "[%s%c%c]" |
4700 |
table-cell-horizontal-char |
table-cell-horizontal-chars |
4701 |
table-cell-vertical-char |
table-cell-vertical-char |
4702 |
table-cell-intersection-char)))) |
table-cell-intersection-char)))) |
4703 |
(if columnp (setcar coord (1- (car coord))) |
(if columnp (setcar coord (1- (car coord))) |
5048 |
(let ((vertical-str (regexp-quote (char-to-string table-cell-vertical-char))) |
(let ((vertical-str (regexp-quote (char-to-string table-cell-vertical-char))) |
5049 |
(intersection-str (regexp-quote (char-to-string table-cell-intersection-char))) |
(intersection-str (regexp-quote (char-to-string table-cell-intersection-char))) |
5050 |
(v-border (format "[%c%c]" table-cell-vertical-char table-cell-intersection-char)) |
(v-border (format "[%c%c]" table-cell-vertical-char table-cell-intersection-char)) |
5051 |
(h-border (format "[%c%c]" table-cell-horizontal-char table-cell-intersection-char)) |
(h-border (format "[%s%c]" table-cell-horizontal-chars table-cell-intersection-char)) |
5052 |
(limit (save-excursion (beginning-of-line) (point)))) |
(limit (save-excursion (beginning-of-line) (point)))) |
5053 |
(catch 'end |
(catch 'end |
5054 |
(while t |
(while t |
5086 |
(let ((vertical-str (regexp-quote (char-to-string table-cell-vertical-char))) |
(let ((vertical-str (regexp-quote (char-to-string table-cell-vertical-char))) |
5087 |
(intersection-str (regexp-quote (char-to-string table-cell-intersection-char))) |
(intersection-str (regexp-quote (char-to-string table-cell-intersection-char))) |
5088 |
(v-border (format "[%c%c]" table-cell-vertical-char table-cell-intersection-char)) |
(v-border (format "[%c%c]" table-cell-vertical-char table-cell-intersection-char)) |
5089 |
(h-border (format "[%c%c]" table-cell-horizontal-char table-cell-intersection-char)) |
(h-border (format "[%s%c]" table-cell-horizontal-chars table-cell-intersection-char)) |
5090 |
(limit (save-excursion (end-of-line) (point)))) |
(limit (save-excursion (end-of-line) (point)))) |
5091 |
(catch 'end |
(catch 'end |
5092 |
(while t |
(while t |
5135 |
When it fails to find either one of the cell corners it returns nil or |
When it fails to find either one of the cell corners it returns nil or |
5136 |
signals error if the optional ABORT-ON-ERROR is non-nil." |
signals error if the optional ABORT-ON-ERROR is non-nil." |
5137 |
(let (lu rb |
(let (lu rb |
5138 |
(border (format "^[%c%c%c]+$" |
(border (format "^[%s%c%c]+$" |
5139 |
table-cell-horizontal-char |
table-cell-horizontal-chars |
5140 |
table-cell-vertical-char |
table-cell-vertical-char |
5141 |
table-cell-intersection-char))) |
table-cell-intersection-char))) |
5142 |
(if (and (condition-case nil |
(if (and (condition-case nil |
5587 |
;; End: *** |
;; End: *** |
5588 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
5589 |
|
|
5590 |
|
;;; arch-tag: 0d69b03e-aa5f-4e72-8806-5727217617e0 |
5591 |
;;; table.el ends here |
;;; table.el ends here |