comparison lisp/textmodes/table.el @ 64059:77cc3a2cedb3

(table-hooks): Finish `defgroup' description with period. (table-insert, table-shorten-cell, table--generate-source-scan-lines, table-delete-row, *table--cell-delete-char, table--spacify-frame, table--horizontally-shift-above-and-below, table--cell-insert-char, table--cell-blank-str, table--fill-region-strictly): "?\ " -> "?\s".

64058:7e00d33823d3

  :group 'paragraphs
  :group 'fill
  :version "22.1")

(defgroup table-hooks nil
  "Hooks for table manipulation utilities"
  :group 'table)

(defcustom table-time-before-update 0.2
  "*Time in seconds before updating the cell contents after typing.
Updating the cell contents on the screen takes place only after this

      (insert table-cell-vertical-char)
      (setq cw cell-width)
      (setq i 0)
      (while (< i columns)
	(let ((beg (point)))
	  (insert (make-string (car cw) ?\ ))
	  (insert table-cell-vertical-char)
	  (table--put-cell-line-property beg (1- (point))))
	(if (cdr cw) (setq cw (cdr cw)))
	(setq i (1+ i)))
      (setq cell-str (buffer-substring (point-min) (point-max))))

	     (exclude-right (and right (<= (cddr right) (cddr this))))
	     (beg (table--goto-coordinate (cons (caar this) (cdar this))))
	     (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)) ?\ )))
	;; 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
	(if (> n bottom-budget)
	    (let ((props (text-properties-at 0 (car rect))))

			       (replace-match (concat "$" (match-string 3) "$")) t t)))
			 (setq line (buffer-substring (point-min) (point-max))))
		       ;; insert a column separator and column/multicolumn contents
		       (with-current-buffer dest-buffer
			 (unless first-p
			   (insert (if (eq (char-before) ?\ ) "" " ") "& "))
			 (if (> span 1)
			     (insert (format "\\multicolumn{%d}{%sl|}{%s}" span (if first-p "|" "") line))
			   (insert line)))
		       (setq first-p nil)
		       (setq span 1)

		  (funcall insert-column start (1- (nth i col-list)))
		(setq span (1+ span)))
	      (setq i (1+ i)))
	    (funcall insert-column start x1))
	  (with-current-buffer dest-buffer
	    (insert (if (eq (char-before) ?\ ) "" " ") "\\\\\n"))))
      (setq y (1+ y)))
    (with-current-buffer dest-buffer
      (insert "\\hline\n"))
    ))

     (table--goto-coordinate (cons (1+ (car rb-coord)) (1+ (cdr bt-coord)))))
    (table--goto-coordinate (cons (1- (car lu-coord)) (1- (cdr lu-coord))))
    ;; 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))) ?\ ))))
    ;; 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))))
    ;; fix up intersections
    (let ((coord (cons (car lu-coord) (1- (cdr lu-coord))))

		    (unless (zerop (cdr coordinate))
		      (table--goto-coordinate (cons (1- table-cell-info-width) (1- (cdr coordinate))))
		      (unless (eolp)
			(delete-char 1)))
		  (delete-char -1)
		  (insert ?\ )
		  (forward-char -1)))
	      (setq n (1+ n)))
	    (setq table-inhibit-auto-fill-paragraph t))
	(let ((coordinate (table--get-coordinate))
	      (end-marker (copy-marker (+ (point) n)))

		(and (zerop (forward-line 1))
		     (zerop (current-column))
		     (move-to-column col)
		     (table--spacify-frame))))
	    (delete-char 1)
	    (insert-before-markers ?\ ))
	   ((table--cell-horizontal-char-p (char-after))
	    (while (progn
		     (delete-char 1)
		     (insert-before-markers ?\ )
		     (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 ?\ )
		     (and (zerop (forward-line 1))
			  (zerop (current-column))
			  (move-to-column col)
			  (eq (char-after) table-cell-vertical-char))))))
	  (memq (char-after) frame-char)))))

	  (if (< columns-to-extend 0)
	      (progn
		(table--untabify-line)
		(delete-char columns-to-extend))
	    (table--untabify-line (point))
	    (insert (make-string columns-to-extend ?\ )))
	  (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)))))
	(setcar coord (1+ (car coord)))
	(setcdr coord (+ (cdr coord) 2))

	  (if (< columns-to-extend 0)
	      (progn
		(table--untabify-line)
		(delete-char columns-to-extend))
	    (table--untabify-line (point))
	    (insert (make-string columns-to-extend ?\ )))
	  (setcdr coord (1+ (cdr coord)))))
      (while (<= (cdr beg-coord) (cdr end-coord))
	(table--untabify-line (table--goto-coordinate beg-coord 'no-extension))
	(setcdr beg-coord (1+ (cdr beg-coord)))))))

		  (unless (eolp)
		    (delete-char 1)))
	      (insert char)
	      (unless (eolp)
		(delete-char 1))))
	(if (not (eq char ?\ ))
	    (if char (insert char))
	  (if (not (looking-at "\\s *$"))
	      (if (and table-fixed-width-mode
		       (> (point) 2)
		       (save-excursion

	    (save-excursion (forward-line 1) (point))))
	  )))

(defun table--cell-blank-str (&optional n)
  "Return blank table cell string of length N."
  (let ((str (make-string (or n 1) ?\ )))
    (table--put-cell-content-property 0 (length str) str)
    str))

(defun table--remove-eol-spaces (beg end &optional bol force)
  "Remove spaces at the end of each line in the BEG END region of the current buffer.

		  (looking-at " *$"))
	     (delete-region (match-beginning 0) (match-end 0))
	     (and (zerop (forward-line 1))
		  (< (point) end)))
	    (t (forward-char -1)
	       (insert-before-markers (if (equal (char-before) ?\ ) ?\  table-word-continuation-char)
				      "\n")
	       t)))))

(defun table--goto-coordinate (coordinate &optional no-extension no-tab-expansion)
  "Move point to the given COORDINATE and return the location.

64059:77cc3a2cedb3

  :group 'paragraphs
  :group 'fill
  :version "22.1")

(defgroup table-hooks nil
  "Hooks for table manipulation utilities."
  :group 'table)

(defcustom table-time-before-update 0.2
  "*Time in seconds before updating the cell contents after typing.
Updating the cell contents on the screen takes place only after this

      (insert table-cell-vertical-char)
      (setq cw cell-width)
      (setq i 0)
      (while (< i columns)
	(let ((beg (point)))
	  (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)))
	(setq i (1+ i)))
      (setq cell-str (buffer-substring (point-min) (point-max))))

	     (exclude-right (and right (<= (cddr right) (cddr this))))
	     (beg (table--goto-coordinate (cons (caar this) (cdar this))))
	     (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)) ?\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
	(if (> n bottom-budget)
	    (let ((props (text-properties-at 0 (car rect))))

			       (replace-match (concat "$" (match-string 3) "$")) t t)))
			 (setq line (buffer-substring (point-min) (point-max))))
		       ;; insert a column separator and column/multicolumn contents
		       (with-current-buffer dest-buffer
			 (unless first-p
			   (insert (if (eq (char-before) ?\s) "" " ") "& "))
			 (if (> span 1)
			     (insert (format "\\multicolumn{%d}{%sl|}{%s}" span (if first-p "|" "") line))
			   (insert line)))
		       (setq first-p nil)
		       (setq span 1)

		  (funcall insert-column start (1- (nth i col-list)))
		(setq span (1+ span)))
	      (setq i (1+ i)))
	    (funcall insert-column start x1))
	  (with-current-buffer dest-buffer
	    (insert (if (eq (char-before) ?\s) "" " ") "\\\\\n"))))
      (setq y (1+ y)))
    (with-current-buffer dest-buffer
      (insert "\\hline\n"))
    ))

     (table--goto-coordinate (cons (1+ (car rb-coord)) (1+ (cdr bt-coord)))))
    (table--goto-coordinate (cons (1- (car lu-coord)) (1- (cdr lu-coord))))
    ;; 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))) ?\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))))
    ;; fix up intersections
    (let ((coord (cons (car lu-coord) (1- (cdr lu-coord))))

		    (unless (zerop (cdr coordinate))
		      (table--goto-coordinate (cons (1- table-cell-info-width) (1- (cdr coordinate))))
		      (unless (eolp)
			(delete-char 1)))
		  (delete-char -1)
		  (insert ?\s)
		  (forward-char -1)))
	      (setq n (1+ n)))
	    (setq table-inhibit-auto-fill-paragraph t))
	(let ((coordinate (table--get-coordinate))
	      (end-marker (copy-marker (+ (point) n)))

		(and (zerop (forward-line 1))
		     (zerop (current-column))
		     (move-to-column col)
		     (table--spacify-frame))))
	    (delete-char 1)
	    (insert-before-markers ?\s))
	   ((table--cell-horizontal-char-p (char-after))
	    (while (progn
		     (delete-char 1)
		     (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 ?\s)
		     (and (zerop (forward-line 1))
			  (zerop (current-column))
			  (move-to-column col)
			  (eq (char-after) table-cell-vertical-char))))))
	  (memq (char-after) frame-char)))))

	  (if (< columns-to-extend 0)
	      (progn
		(table--untabify-line)
		(delete-char columns-to-extend))
	    (table--untabify-line (point))
	    (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)))))
	(setcar coord (1+ (car coord)))
	(setcdr coord (+ (cdr coord) 2))

	  (if (< columns-to-extend 0)
	      (progn
		(table--untabify-line)
		(delete-char columns-to-extend))
	    (table--untabify-line (point))
	    (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))
	(setcdr beg-coord (1+ (cdr beg-coord)))))))

		  (unless (eolp)
		    (delete-char 1)))
	      (insert char)
	      (unless (eolp)
		(delete-char 1))))
	(if (not (eq char ?\s))
	    (if char (insert char))
	  (if (not (looking-at "\\s *$"))
	      (if (and table-fixed-width-mode
		       (> (point) 2)
		       (save-excursion

	    (save-excursion (forward-line 1) (point))))
	  )))

(defun table--cell-blank-str (&optional n)
  "Return blank table cell string of length N."
  (let ((str (make-string (or n 1) ?\s)))
    (table--put-cell-content-property 0 (length str) str)
    str))

(defun table--remove-eol-spaces (beg end &optional bol force)
  "Remove spaces at the end of each line in the BEG END region of the current buffer.

		  (looking-at " *$"))
	     (delete-region (match-beginning 0) (match-end 0))
	     (and (zerop (forward-line 1))
		  (< (point) end)))
	    (t (forward-char -1)
	       (insert-before-markers (if (equal (char-before) ?\s) ?\s table-word-continuation-char)
				      "\n")
	       t)))))

(defun table--goto-coordinate (coordinate &optional no-extension no-tab-expansion)
  "Move point to the given COORDINATE and return the location.