unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* table.el extension?
@ 2003-05-17 18:09 David Abrahams
  0 siblings, 0 replies; only message in thread
From: David Abrahams @ 2003-05-17 18:09 UTC (permalink / raw)
  Cc: Jeremy Siek

[-- Attachment #1: Type: text/plain, Size: 524 bytes --]


Please let me know if there's a better place to post this...

I have implemented an extension to table.el which lets me use several
characters for horizontal dividers.  I needed it to edit
ReStructuredText
(http://docutils.sourceforge.net/docs/rst/quickstart.html) tables,
which divide headers from body with '=' characters.

I realize that it's probably not sufficiently general (nor
backward-compatible) to accept as-is, but it works for me and I
thought it might give someone impetus to finish the job.

Patch enclosed.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: table.el.patch --]
[-- Type: text/x-patch, Size: 10987 bytes --]

--- table.el	2003-04-27 11:05:18.000000000 -0400
+++ c:/tmp/table.el	2003-05-17 13:57:00.000000000 -0400
@@ -688,9 +688,9 @@
   :tag "Cell Face"
   :group 'table)
 
-(defcustom table-cell-horizontal-char ?\-
-  "*Character that forms table cell's horizontal border line."
-  :tag "Cell Horizontal Boundary Character"
+(defcustom table-cell-horizontal-chars "-="
+  "*Characters that can forms table cell's horizontal border line."
+  :tag "Cell Horizontal Boundary Characters"
   :type 'character
   :group 'table)
 
@@ -1658,7 +1658,7 @@
       (setq cw cell-width)
       (setq i 0)
       (while (< i columns)
-	(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)
 	(if (cdr cw) (setq cw (cdr cw)))
 	(setq i (1+ i)))
       (setq border-str (buffer-substring (point-min) (point-max)))
@@ -1748,7 +1748,7 @@
 	  (while (> i 0)
 	    (setq rect (cons
 			(concat (if exclude-left "" (char-to-string table-cell-intersection-char))
-				(make-string (- (cadr this) (caar this)) table-cell-horizontal-char)
+				(make-string (- (cadr this) (caar this)) (string-to-char table-cell-horizontal-chars))
 				(if exclude-right "" (char-to-string table-cell-intersection-char)))
 			rect))
 	    (let ((j cell-height))
@@ -1801,7 +1801,7 @@
 	 (coord-list (table--cell-list-to-coord-list (table--vertical-cell-list t nil 'left)))
 	 (append-column (if coord-list nil (setq coord-list (table--find-row-column 'column))))
 	 (cell-width (car (table--min-coord-list coord-list)))
-	 (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-char))
 						     (char-to-string table-cell-intersection-char)) n))
 	 (cell-str (table--multiply-string (concat (table--cell-blank-str cell-width)
 						   (let ((str (string table-cell-vertical-char)))
@@ -1915,13 +1915,13 @@
     (if (>= arg 0)
 	(save-excursion
 	  (goto-char (point-min))
-	  (let* ((border (format "[%c%c%c]"
-				 table-cell-horizontal-char
+	  (let* ((border (format "[%s%c%c]"
+				 table-cell-horizontal-chars
 				 table-cell-vertical-char
 				 table-cell-intersection-char))
 		 (border3 (concat border border border))
-		 (non-border (format "^[^%c%c%c]*$"
-				     table-cell-horizontal-char
+		 (non-border (format "^[^%s%c%c]*$"
+				     table-cell-horizontal-chars
 				     table-cell-vertical-char
 				     table-cell-intersection-char)))
 	    ;; `table-recognize-region' is an expensive function so minimize
@@ -1964,12 +1964,12 @@
 	(table--remove-cell-properties beg end)
       (save-excursion
 	(goto-char beg)
-	(let* ((border (format "[%c%c%c]"
-			       table-cell-horizontal-char
+	(let* ((border (format "[%s%c%c]"
+			       table-cell-horizontal-chars
 			       table-cell-vertical-char
 			       table-cell-intersection-char))
-	       (non-border (format "[^%c%c%c]"
-				   table-cell-horizontal-char
+	       (non-border (format "[^%s%c%c]"
+				   table-cell-horizontal-chars
 				   table-cell-vertical-char
 				   table-cell-intersection-char))
 	       (inhibit-read-only t))
@@ -2318,18 +2318,21 @@
 			       (1+ (cdr (cdr this)))
 			     (cdr (cdr this))))))
 	       (tmp (extract-rectangle (1- beg) end))
-	       (border (format "[%c%c]\\%c"
-			       table-cell-horizontal-char
+	       (border (format "[%s%c]\\%c"
+			       table-cell-horizontal-chars
 			       table-cell-intersection-char
 			       table-cell-intersection-char))
 	       (blank (table--cell-blank-str))
 	       rectangle)
 	  ;; create a single wide vertical bar of empty cell fragment
 	  (while tmp
-	    (setq rectangle (cons (if (string-match border (car tmp))
-				      (string table-cell-horizontal-char)
+;        (message "tmp is %s" tmp)
+	    (setq rectangle (cons
+                         (if (string-match border (car tmp))
+				      (substring (car tmp) 0 1)
 				    blank)
 				  rectangle))
+;        (message "rectangle is %s" rectangle)
 	    (setq tmp (cdr tmp)))
 	  (setq rectangle (nreverse rectangle))
 	  ;; untabify the area right of the bar that is about to be inserted
@@ -2656,7 +2659,7 @@
 	    (setq rectangle
 		  (cons (if below-contp
 			    (char-to-string table-cell-intersection-char)
-			  (char-to-string table-cell-horizontal-char))
+			  (substring table-cell-horizontal-chars 0 1))
 			rectangle))
 	    (while (> n-element 0)
 	      (setq rectangle (cons (table--cell-blank-str 1) rectangle))
@@ -2664,7 +2667,7 @@
 	    (setq rectangle
 		  (cons (if above-contp
 			    (char-to-string table-cell-intersection-char)
-			  (char-to-string table-cell-horizontal-char))
+			  (substring table-cell-horizontal-chars 0 1))
 			rectangle))
 	    (delete-rectangle beg end)
 	    (goto-char beg)
@@ -2673,11 +2676,11 @@
 	(insert (if (and (> (point) (point-min))
 			 (save-excursion
 			   (forward-char -1)
-			   (looking-at (regexp-quote (char-to-string table-cell-horizontal-char)))))
+			   (looking-at (regexp-opt-charset table-cell-horizontal-chars))))
 		    table-cell-intersection-char
 		  table-cell-vertical-char)
 		(table--cell-blank-str (- end beg 2))
-		(if (looking-at (regexp-quote (char-to-string table-cell-horizontal-char)))
+		(if (looking-at (regexp-opt-charset table-cell-horizontal-chars))
 		    table-cell-intersection-char
 		  table-cell-vertical-char))))
     ;; recognize the newly created spanned cell
@@ -2711,7 +2714,7 @@
       (goto-char beg)
       (delete-region beg end)
       (insert table-cell-intersection-char
-	      (make-string table-cell-info-width table-cell-horizontal-char)
+	      (make-string table-cell-info-width (string-to-char table-cell-horizontal-chars))
 	      table-cell-intersection-char)
       (table--goto-coordinate old-coordinate)
       (forward-line 1)
@@ -3284,6 +3287,10 @@
 			 ((eq language 'cals) 10)))
 	(insert ?\n)))))
 
+(defun table--is-horizontal ( c )
+  (find (char-to-string c)
+        (string-to-list table-cell-horizontal-chars)))
+
 (defun table--generate-source-scan-lines (dest-buffer language origin-cell tail-cell col-list row-list)
   "Scan the table line by line.
 Currently this method is for LaTeX only."
@@ -3303,18 +3310,18 @@
 	     start i c)
 	(if border-p
 	    ;; horizontal cell border processing
-	    (if (and (eq (car border-char-list) table-cell-horizontal-char)
+	    (if (and (table--is-horizontal (car border-char-list))
 		     (table--uniform-list-p border-char-list))
 		(with-current-buffer dest-buffer
 		  (insert "\\hline\n"))
 	      (setq i 0)
 	      (while (setq c (nth i border-char-list))
-		(if (and start (not (eq c table-cell-horizontal-char)))
+		(if (and start (not (table--is-horizontal c)))
 		    (progn
 		      (with-current-buffer dest-buffer
 			(insert (format "\\cline{%d-%d}\n" (1+ start) i)))
 		      (setq start nil)))
-		(if (and (not start) (eq c table-cell-horizontal-char))
+		(if (and (not start) (table--is-horizontal c))
 		    (setq start i))
 		(setq i (1+ i)))
 	      (if start
@@ -3534,7 +3541,7 @@
 	      (delete-char 1)
 	      (insert table-cell-intersection-char))
 	  (delete-char 1)
-	  (insert table-cell-horizontal-char))
+	  (insert (string-to-char table-cell-horizontal-chars)))
 	(setq n (1- n))
 	(setcar coord (1+ (car coord)))))
     ;; goto appropriate end point
@@ -3576,9 +3583,9 @@
 	(table--goto-coordinate coord)
 	(if (save-excursion
 	      (or (and (table--goto-coordinate (cons (1- (car coord)) (cdr coord)) 'no-extension)
-		       (looking-at (regexp-quote (char-to-string table-cell-horizontal-char))))
+		       (looking-at (regexp-opt-charset table-cell-horizontal-chars)))
 		  (and (table--goto-coordinate (cons (1+ (car coord)) (cdr coord)) 'no-extension)
-		       (looking-at (regexp-quote (char-to-string table-cell-horizontal-char))))))
+		       (looking-at (regexp-opt-charset table-cell-horizontal-chars)))))
 	    (progn
 	      (delete-char 1)
 	      (insert table-cell-intersection-char))
@@ -4412,9 +4419,9 @@
 (defun table--spacify-frame ()
   "Spacify table frame.
 Replace frame characters with spaces."
-  (let ((frame-char (list table-cell-intersection-char
-			  table-cell-horizontal-char
-			  table-cell-vertical-char)))
+  (let ((frame-char
+         (append (string-to-list table-cell-horizontal-chars)
+                 (list table-cell-intersection-char table-cell-vertical-char))))
     (while
 	(progn
 	  (cond
@@ -4427,11 +4434,11 @@
 		     (table--spacify-frame))))
 	    (delete-char 1)
 	    (insert-before-markers ?\ ))
-	   ((eq (char-after) table-cell-horizontal-char)
+	   ((table--is-horizontal (char-after))
 	    (while (progn
 		     (delete-char 1)
 		     (insert-before-markers ?\ )
-		     (eq (char-after) table-cell-horizontal-char))))
+		     (table--is-horizontal (char-after)))))
 	   ((eq (char-after) table-cell-vertical-char)
 	    (while (let ((col (current-column)))
 		     (delete-char 1)
@@ -4685,8 +4692,8 @@
 		(>= (if columnp (car coord) (cdr coord)) 0))
 	    (while (progn
 		     (table--goto-coordinate coord 'no-extension 'no-tab-expansion)
-		     (not (looking-at (format "[%c%c%c]"
-					      table-cell-horizontal-char
+		     (not (looking-at (format "[%s%c%c]"
+					      table-cell-horizontal-chars
 					      table-cell-vertical-char
 					      table-cell-intersection-char))))
 	      (if columnp (setcar coord (1- (car coord)))
@@ -5037,7 +5044,7 @@
     (let ((vertical-str (regexp-quote (char-to-string table-cell-vertical-char)))
 	  (intersection-str (regexp-quote (char-to-string table-cell-intersection-char)))
 	  (v-border (format "[%c%c]" table-cell-vertical-char table-cell-intersection-char))
-	  (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))
 	  (limit (save-excursion (beginning-of-line) (point))))
       (catch 'end
 	(while t
@@ -5075,7 +5082,7 @@
     (let ((vertical-str (regexp-quote (char-to-string table-cell-vertical-char)))
 	  (intersection-str (regexp-quote (char-to-string table-cell-intersection-char)))
 	  (v-border (format "[%c%c]" table-cell-vertical-char table-cell-intersection-char))
-	  (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))
 	  (limit (save-excursion (end-of-line) (point))))
       (catch 'end
 	(while t
@@ -5124,8 +5131,8 @@
 When it fails to find either one of the cell corners it returns nil or
 signals error if the optional ABORT-ON-ERROR is non-nil."
   (let (lu rb
-	(border (format "^[%c%c%c]+$"
-			table-cell-horizontal-char
+	(border (format "^[%s%c%c]+$"
+			table-cell-horizontal-chars
 			table-cell-vertical-char
 			table-cell-intersection-char)))
     (if (and (condition-case nil

[-- Attachment #3: Type: text/plain, Size: 70 bytes --]


Regards,
-- 
Dave Abrahams
Boost Consulting
www.boost-consulting.com

[-- Attachment #4: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2003-05-17 18:09 UTC | newest]

Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2003-05-17 18:09 table.el extension? David Abrahams

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).