/[emacs]/emacs/lisp/textmodes/table.el
ViewVC logotype

Diff of /emacs/lisp/textmodes/table.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5.2.1 by miles, Fri Apr 4 06:20:40 2003 UTC revision 1.5.2.2 by miles, Tue Oct 14 23:30:22 2003 UTC
# Line 5  Line 5 
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    
# Line 688  height." Line 688  height."
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 ?\|
# Line 986  This is always set to nil at the entry t Line 986  This is always set to nil at the entry t
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)
# Line 1004  This is always set to nil at the entry t Line 1004  This is always set to nil at the entry t
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))
# Line 1658  Inside a table cell has a special keymap Line 1658  Inside a table cell has a special keymap
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)))
# Line 1748  are appended at the bottom of the table. Line 1748  are appended at the bottom of the table.
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))
# Line 1801  created column(s) are appended at the ri Line 1801  created column(s) are appended at the ri
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)))
# Line 1915  all the table specific features." Line 1915  all the table specific features."
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
# Line 1964  specific features." Line 1964  specific features."
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))
# Line 2318  table's rectangle structure." Line 2318  table's rectangle structure."
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
# Line 2656  DIRECTION is one of symbols; right, left Line 2659  DIRECTION is one of symbols; right, left
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))
# Line 2664  DIRECTION is one of symbols; right, left Line 2667  DIRECTION is one of symbols; right, left
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)
# Line 2673  DIRECTION is one of symbols; right, left Line 2676  DIRECTION is one of symbols; right, left
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
# Line 2711  Creates a cell above and a cell below th Line 2716  Creates a cell above and a cell below th
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)
# Line 3284  CALS (DocBook DTD): Line 3289  CALS (DocBook DTD):
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."
# Line 3303  Currently this method is for LaTeX only. Line 3312  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
# Line 3534  consists from cells of same height." Line 3543  consists from cells of same height."
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
# Line 3576  column must consists from cells of same Line 3585  column must consists from cells of same
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))
# Line 4412  Returns the coordinate of the final poin Line 4423  Returns the coordinate of the final poin
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
# Line 4427  Replace frame characters with spaces." Line 4438  Replace frame characters with spaces."
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)
# Line 4685  of line." Line 4696  of line."
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)))
# Line 5037  Focus only on the corner pattern.  Furth Line 5048  Focus only on the corner pattern.  Furth
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
# Line 5075  Focus only on the corner pattern.  Furth Line 5086  Focus only on the corner pattern.  Furth
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
# Line 5124  the right-bottom is the position after t Line 5135  the right-bottom is the position after 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
# Line 5576  It returns COLUMN unless STR contains so Line 5587  It returns COLUMN unless STR contains so
5587  ;; End: ***  ;; End: ***
5588  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5589    
5590    ;;; arch-tag: 0d69b03e-aa5f-4e72-8806-5727217617e0
5591  ;;; table.el ends here  ;;; table.el ends here

Legend:
Removed from v.1.5.2.1  
changed lines
  Added in v.1.5.2.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26