Selaa lähdekoodia

Remove visual effect of width cookies in tables

* lisp/org-colview.el (org-dblock-write:columnview): Remove :width
  parameter.

* lisp/org-table.el (org-narrow-column-arrow): Remove variable.
(org-table-cleanup-narrow-column-properties): Remove function.
(org-table-align): Ignore width cookies when aligning table.
(org-table-justify-field-maybe):
(org-table-finish-edit-field):
(org-table-follow-fields-with-editor):
(orgtbl-setup): Remove reference to `org-cwidth' property.

* lisp/org.el (org-mode):
(org-hide-wide-columns): Remove function.
(org-set-font-lock-defaults): Apply previous removal.
(org-shorten-string): Ignore `org-cwidth' property.

* testing/lisp/test-org-colview.el (test-org-colview/dblock): Remove
  a test.

Export back-ends may still use width cookie to alter table's output.
Nicolas Goaziou 7 vuotta sitten
vanhempi
commit
23a2fde6fe
4 muutettua tiedostoa jossa 32 lisäystä ja 134 poistoa
  1. 0 9
      lisp/org-colview.el
  2. 32 100
      lisp/org-table.el
  3. 0 12
      lisp/org.el
  4. 0 13
      testing/lisp/test-org-colview.el

+ 0 - 9
lisp/org-colview.el

@@ -1372,7 +1372,6 @@ PARAMS is a property list of parameters:
 :maxlevel When set to a number, don't capture headlines below this level.
 :skip-empty-rows
 	  When t, skip rows where all specifiers other than ITEM are empty.
-:width    apply widths specified in columns format using <N> specifiers.
 :format   When non-nil, specify the column view format to use."
   (let ((table
 	 (let ((id (plist-get params :id))
@@ -1428,14 +1427,6 @@ PARAMS is a property list of parameters:
 			  (concat "\\_" (make-string (* 2 (1- level)) ?\s) item)
 			item))))
 	    (push (cdr row) new-table))))
-      (when (plist-get params :width)
-	(setq table
-	      (append table
-		      (list
-		       (mapcar (lambda (spec)
-				 (let ((w (nth 2 spec)))
-				   (if w (format "<%d>" (max 3 w)) "")))
-			       org-columns-current-fmt-compiled)))))
       (when (plist-get params :vlines)
 	(setq table
 	      (let ((size (length org-columns-current-fmt-compiled)))

+ 32 - 100
lisp/org-table.el

@@ -771,9 +771,6 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
   "Overlay coordinates after each align of a table.")
 
 (defvar org-last-recalc-line nil)
-(defvar org-table-do-narrow t)   ; for dynamic scoping
-(defconst org-narrow-column-arrow "=>"
-  "Used as display property in narrowed table columns.")
 
 ;;;###autoload
 (defun org-table-align ()
@@ -790,17 +787,19 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
      (goto-char beg)
      (org-table-with-shrunk-columns
       (let* ((indent (progn (looking-at "[ \t]*") (match-string 0)))
-	     ;; Table's rows.  Separators are replaced by nil.  Trailing
-	     ;; spaces are also removed.
-	     (lines (mapcar (lambda (l)
-			      (and (not (string-match-p "\\`[ \t]*|-" l))
-				   (let ((l (org-trim l)))
-				     (remove-text-properties
-				      0 (length l) '(display t org-cwidth t) l)
-				     l)))
-			    (org-split-string (buffer-substring beg end) "\n")))
-	     ;; Get the data fields by splitting the lines.
-	     (fields (mapcar (lambda (l) (org-split-string l " *| *"))
+	     (align-cookie?
+	      (save-excursion
+		(re-search-forward "|[ \t]*<[lrc][0-9]*>[ \t]*\\(?:|\\|$\\)"
+				   end t)))
+	     ;; Table's rows.  Rules are replaced by nil.  Trailing
+	     ;; spaces are removed.
+	     (lines (mapcar
+		     (lambda (l)
+		       (and (not (string-match-p org-table-hline-regexp l))
+			    l))
+		     (split-string (buffer-substring beg end) "\n" t "[ \t]")))
+	     ;; List of lists of data fields.
+	     (fields (mapcar (lambda (l) (org-split-string l "[ \t]*|[ \t]*"))
 			     (remq nil lines)))
 	     ;; Compute number of fields in the longest line.  If the
 	     ;; table contains no field, create a default table.
@@ -811,58 +810,23 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
 	     ;; A list of empty strings to fill any short rows on output.
 	     (emptycells (make-list maxfields ""))
 	     lengths typenums)
-	;; Check for special formatting.
+	;; Compute alignment and width for each column.
 	(dotimes (i maxfields)
-	  (let ((column (mapcar (lambda (x) (or (nth i x) "")) fields))
-		fmax falign)
-	    ;; Look for an explicit width or alignment.
-	    (when (save-excursion
-		    (or (re-search-forward "| *<[lrc][0-9]*> *\\(|\\|$\\)" end t)
-			(and org-table-do-narrow
-			     (re-search-forward
-			      "| *<[lrc]?[0-9]+> *\\(|\\|$\\)" end t))))
-	      (catch :exit
-		(dolist (cell column)
-		  (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" cell)
-		    (when (match-end 1) (setq falign (match-string 1 cell)))
-		    (when (and org-table-do-narrow (match-end 2))
-		      (setq fmax (string-to-number (match-string 2 cell))))
-		    (when (or falign fmax) (throw :exit nil)))))
-	      ;; Find fields that are wider than FMAX, and shorten them.
-	      (when fmax
-		(dolist (x column)
-		  (when (> (org-string-width x) fmax)
-		    (org-add-props x nil
-		      'help-echo
-		      (concat
-		       "Clipped table field, use `\\[org-table-edit-field]' to \
-edit.  Full value is:\n"
-		       (substring-no-properties x)))
-		    (let ((l (length x))
-			  (f1 (min fmax
-				   (or (string-match org-bracket-link-regexp x)
-				       fmax)))
-			  (f2 1))
-		      (unless (> f1 1)
-			(user-error
-			 "Cannot narrow field starting with wide link \"%s\""
-			 (match-string 0 x)))
-		      (if (= (org-string-width x) l) (setq f2 f1)
-			(setq f2 1)
-			(while (< (org-string-width (substring x 0 f2)) f1)
-			  (cl-incf f2)))
-		      (add-text-properties f2 l (list 'org-cwidth t) x)
-		      (add-text-properties
-		       (if (>= (string-width (substring x (1- f2) f2)) 2) (1- f2)
-			 (- f2 2))
-		       f2
-		       (list 'display org-narrow-column-arrow)
-		       x))))))
-	    ;; Get the maximum width for each column
-	    (push (apply #'max (or fmax 1) 1 (mapcar #'org-string-width column))
+	  (let* ((column (mapcar (lambda (x) (or (nth i x) ""))
+				 fields))
+		 (falign
+		  (and align-cookie?
+		       (cl-some (lambda (cell)
+				  (and (string-match "\\`<\\([lrc]\\)[0-9]*>\\'"
+						     cell)
+				       (match-string 1 cell)))
+				column))))
+	    ;; Get the maximum width for each column.
+	    (push (apply #'max 1 (mapcar #'org-string-width column))
 		  lengths)
-	    ;; Get the fraction of numbers among non-empty cells to
-	    ;; decide about alignment of the column.
+	    ;; If there is no alignment cookie, get the fraction of
+	    ;; numbers among non-empty cells to decide about alignment
+	    ;; of the column.
 	    (if falign (push (equal (downcase falign) "r") typenums)
 	      (let ((cnt 0)
 		    (frac 0.0))
@@ -911,29 +875,16 @@ edit.  Full value is:\n"
 	    (let ((ty (if (pop typenums) "" "-"))) ; Flush numbers right.
 	      (setq rfmt (concat rfmt (format rfmt1 ty l)))
 	      (setq hfmt (concat hfmt (format hfmt1 (make-string l ?-))))))
-	  ;; Replace modified lines only.  Check not only contents, but
-	  ;; also columns' width.
+	  ;; Replace modified lines only.
 	  (dolist (l lines)
 	    (let ((line
 		   (if l (apply #'format rfmt (append (pop fields) emptycells))
 		     hfmt))
 		  (previous (buffer-substring (point) (line-end-position))))
-	      (if (and (equal previous line)
-		       (let ((a 0)
-			     (b 0))
-			 (while (and (progn
-				       (setq a (next-single-property-change
-						a 'org-cwidth previous))
-				       (setq b (next-single-property-change
-						b 'org-cwidth line)))
-				     (eq a b)))
-			 (eq a b)))
+	      (if (equal previous line)
 		  (forward-line)
 		(insert line "\n")
 		(delete-region (point) (line-beginning-position 2))))))
-	(when (and orgtbl-mode (not (derived-mode-p 'org-mode)))
-	  (goto-char org-table-aligned-begin-marker)
-	  (while (org-hide-wide-columns org-table-aligned-end-marker)))
 	(set-marker end nil)
 	(when org-table-overlay-coordinates (org-table-overlay-coordinates))
 	(setq org-table-may-need-update nil))))))
@@ -2093,8 +2044,7 @@ toggle `org-table-follow-field-mode'."
    (arg
     (let ((b (save-excursion (skip-chars-backward "^|") (point)))
 	  (e (save-excursion (skip-chars-forward "^|\r\n") (point))))
-      (remove-text-properties b e '(org-cwidth t invisible t
-					       display t intangible t))
+      (remove-text-properties b e '(invisible t intangible t))
       (if (and (boundp 'font-lock-mode) font-lock-mode)
 	  (font-lock-fontify-block))))
    (t
@@ -2121,9 +2071,7 @@ toggle `org-table-follow-field-mode'."
       (setq word-wrap t)
       (goto-char (setq p (point-max)))
       (insert (org-trim field))
-      (remove-text-properties p (point-max)
-			      '(invisible t org-cwidth t display t
-					  intangible t))
+      (remove-text-properties p (point-max) '(invisible t intangible t))
       (goto-char p)
       (setq-local org-finish-function 'org-table-finish-edit-field)
       (setq-local org-window-configuration cw)
@@ -4667,15 +4615,12 @@ FACE, when non-nil, for the highlight."
 		    (concat orgtbl-line-start-regexp "\\|"
 			    auto-fill-inhibit-regexp)
 		  orgtbl-line-start-regexp))
-    (add-to-invisibility-spec '(org-cwidth))
     (when (fboundp 'font-lock-add-keywords)
       (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords)
       (org-restart-font-lock))
     (easy-menu-add orgtbl-mode-menu))
    (t
     (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp)
-    (org-table-cleanup-narrow-column-properties)
-    (org-remove-from-invisibility-spec '(org-cwidth))
     (remove-hook 'before-change-functions 'org-before-change-function t)
     (when (fboundp 'font-lock-remove-keywords)
       (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords)
@@ -4683,19 +4628,6 @@ FACE, when non-nil, for the highlight."
     (easy-menu-remove orgtbl-mode-menu)
     (force-mode-line-update 'all))))
 
-(defun org-table-cleanup-narrow-column-properties ()
-  "Remove all properties related to narrow-column invisibility."
-  (let ((s (point-min)))
-    (while (setq s (text-property-any s (point-max)
-				      'display org-narrow-column-arrow))
-      (remove-text-properties s (1+ s) '(display t)))
-    (setq s (point-min))
-    (while (setq s (text-property-any s (point-max) 'org-cwidth 1))
-      (remove-text-properties s (1+ s) '(org-cwidth t)))
-    (setq s (point-min))
-    (while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth))
-      (remove-text-properties s (1+ s) '(invisible t)))))
-
 (defun orgtbl-make-binding (fun n &rest keys)
   "Create a function for binding in the table minor mode.
 FUN is the command to call inside a table.  N is used to create a unique

+ 0 - 12
lisp/org.el

@@ -5439,7 +5439,6 @@ The following commands are available:
   (org-load-modules-maybe)
   (org-install-agenda-files-menu)
   (when org-descriptive-links (add-to-invisibility-spec '(org-link)))
-  (add-to-invisibility-spec '(org-cwidth))
   (add-to-invisibility-spec '(org-hide-block . t))
   (setq-local outline-regexp org-outline-regexp)
   (setq-local outline-level 'org-outline-level)
@@ -6163,16 +6162,6 @@ Also refresh fontification if needed."
       (when (memq 'radio org-highlight-links)
 	(org-restart-font-lock)))))
 
-(defun org-hide-wide-columns (limit)
-  (let (s e)
-    (setq s (text-property-any (point) (or limit (point-max))
-			       'org-cwidth t))
-    (when s
-      (setq e (next-single-property-change s 'org-cwidth))
-      (add-text-properties s e '(invisible org-cwidth))
-      (goto-char e)
-      t)))
-
 (defvar org-latex-and-related-regexp nil
   "Regular expression for highlighting LaTeX, entities and sub/superscript.")
 
@@ -6347,7 +6336,6 @@ needs to be inserted at a specific position in the font-lock sequence.")
 	   '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
 	   ;; Macro
 	   '(org-fontify-macros)
-	   '(org-hide-wide-columns (0 nil append))
 	   ;; TODO keyword
 	   (list (format org-heading-keyword-regexp-format
 			 org-todo-regexp)

+ 0 - 13
testing/lisp/test-org-colview.el

@@ -1435,19 +1435,6 @@
         "* H\n<point>#+BEGIN: columnview :format \"%ITEM(Name)\"\n#+END:"
       (let ((org-columns-default-format "%ITEM")) (org-update-dblock))
       (buffer-substring-no-properties (point) (point-max)))))
-  ;; Test `:width' parameter
-  (should
-   (equal
-    "#+BEGIN: columnview :width t
-| ITEM       | A |
-|------------+---|
-| H          |   |
-| <10>       |   |
-#+END:"
-    (org-test-with-temp-text
-        "* H\n<point>#+BEGIN: columnview :width t\n#+END:"
-      (let ((org-columns-default-format "%10ITEM %A")) (org-update-dblock))
-      (buffer-substring-no-properties (point) (point-max)))))
   ;; When inserting ITEM values, make sure to clean sensitive
   ;; contents, like unique targets or forbidden inline src-blocks.
   (should