Function: shr-make-table-1

shr-make-table-1 is a byte-compiled function defined in shr.el.gz.

Signature

(shr-make-table-1 DOM WIDTHS &optional FILL)

Source Code

;; Defined in /usr/src/emacs/lisp/net/shr.el.gz
(defun shr-make-table-1 (dom widths &optional fill)
  (let ((trs nil)
	(rowspans (make-vector (length widths) 0))
	(colspan-remaining 0)
	colspan-width colspan-count
	width colspan)
    (dolist (row (dom-non-text-children dom))
      (when (eq (dom-tag row) 'tr)
	(let ((tds nil)
	      (columns (dom-non-text-children row))
	      (i 0)
	      (width-column 0)
	      column)
	  (while (< i (length widths))
	    ;; If we previously had a rowspan definition, then that
	    ;; means that we now have a "missing" td/th element here.
	    ;; So just insert a dummy, empty one to (sort of) emulate
	    ;; rowspan.
	    (setq column
		  (if (zerop (aref rowspans i))
		      (pop columns)
		    (aset rowspans i (1- (aref rowspans i)))
		    '(td)))
	    (when (and (not (stringp column))
		       (or (memq (dom-tag column) '(td th))
			   (not column)))
	      (when-let* ((span (dom-attr column 'rowspan)))
		(aset rowspans i (+ (aref rowspans i)
				    (1- (string-to-number span)))))
	      ;; Sanity check for invalid column-spans.
	      (when (>= width-column (length widths))
		(setq width-column 0))
	      (setq width
		    (if column
			(aref widths width-column)
		      (* 10 shr-table-separator-pixel-width)))
	      (when (setq colspan (dom-attr column 'colspan))
		(setq colspan (min (string-to-number colspan)
				   ;; The colspan may be wrong, so
				   ;; truncate it to the length of the
				   ;; remaining columns.
				   (- (length widths) i)))
		(dotimes (j (1- colspan))
		  (setq width
			(if (> (+ i 1 j) (1- (length widths)))
			    ;; If we have a colspan spec that's longer
			    ;; than the table is wide, just use the last
			    ;; width as the width.
			    (aref widths (1- (length widths)))
			  ;; Sum up the widths of the columns we're
			  ;; spanning.
			  (+ width
			     shr-table-separator-length
			     (aref widths (+ i 1 j))))))
		(setq width-column (+ width-column (1- colspan))
		      colspan-count colspan
		      colspan-remaining colspan))
	      (when column
		(let ((data (shr-render-td column width fill)))
		  (if (and (not fill)
			   (> colspan-remaining 0))
		      (progn
			(setq colspan-width (car data))
			(let ((this-width (/ colspan-width colspan-count)))
			  (push (cons this-width (cadr data)) tds)
			  (setq colspan-remaining (1- colspan-remaining))))
		    (if (not fill)
			(push (cons (car data) (cadr data)) tds)
		      (push data tds)))))
	      (when (and colspan
			 (> colspan 1))
		(dotimes (_ (1- colspan))
		  (setq i (1+ i))
		  (push
		   (if fill
		       (list 0 0 -1 nil 1 nil nil)
		     '(0 . 0))
		   tds)))
	      (setq i (1+ i)
		    width-column (1+ width-column))))
	  (push (nreverse tds) trs))))
    (nreverse trs)))