diff options
Diffstat (limited to 'lisp/org/org-table.el')
-rw-r--r-- | lisp/org/org-table.el | 317 |
1 files changed, 155 insertions, 162 deletions
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 0e93fb271f3..89c57fb06ce 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2004-2021 Free Software Foundation, Inc. -;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Author: Carsten Dominik <carsten.dominik@gmail.com> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: https://orgmode.org ;; @@ -66,6 +66,7 @@ (declare-function org-export-install-filters "ox" (info)) (declare-function org-export-table-has-special-column-p "ox" (table)) (declare-function org-export-table-row-is-special-p "ox" (table-row info)) +(declare-function org-forward-paragraph "org" (&optional arg)) (declare-function org-id-find "org-id" (id &optional markerp)) (declare-function org-indent-line "org" ()) (declare-function org-load-modules-maybe "org" (&optional force)) @@ -331,7 +332,7 @@ relies on the variables to be present in the list." The default value is `hours', and will output the results as a number of hours. Other allowed values are `seconds', `minutes' and `days', and the output will be a fraction of seconds, minutes or -days. `hh:mm' selects to use hours and minutes, ignoring seconds. +days. `hh:mm' selects to use hours and minutes, ignoring seconds. The `U' flag in a table formula will select this specific format for a single formula." :group 'org-table-calculation @@ -461,36 +462,41 @@ This may be useful when columns have been shrunk." (when pos (goto-char pos)) (goto-char (line-beginning-position)) (let ((end (line-end-position)) str) + (backward-char) (while (progn (forward-char 1) (< (point) end)) (let ((ov (car (overlays-at (point))))) (if (not ov) (push (char-to-string (char-after)) str) (push (overlay-get ov 'display) str) (goto-char (1- (overlay-end ov)))))) - (format "|%s" (mapconcat #'identity (reverse str) ""))))) + (format "%s" (mapconcat #'identity (reverse str) ""))))) (defvar-local org-table-header-overlay nil) (defun org-table-header-set-header () "Display the header of the table at point." - (when (overlayp org-table-header-overlay) - (delete-overlay org-table-header-overlay)) - (let* ((ws (window-start)) - (beg (save-excursion - (goto-char (org-table-begin)) - (while (or (org-at-table-hline-p) - (looking-at-p ".*|\\s-+<[rcl]?\\([0-9]+\\)?>")) - (move-beginning-of-line 2)) - (point))) - (end (save-excursion (goto-char beg) (point-at-eol)))) - (if (pos-visible-in-window-p beg) - (when (overlayp org-table-header-overlay) - (delete-overlay org-table-header-overlay)) - (setq org-table-header-overlay - (make-overlay ws (+ ws (- end beg)))) - (org-overlay-display - org-table-header-overlay - (org-table-row-get-visible-string beg) - 'org-table-header)))) + (let ((gcol temporary-goal-column)) + (unwind-protect + (progn + (when (overlayp org-table-header-overlay) + (delete-overlay org-table-header-overlay)) + (let* ((ws (window-start)) + (beg (save-excursion + (goto-char (org-table-begin)) + (while (or (org-at-table-hline-p) + (looking-at-p ".*|\\s-+<[rcl]?\\([0-9]+\\)?>")) + (move-beginning-of-line 2)) + (line-beginning-position))) + (end (save-excursion (goto-char beg) (point-at-eol)))) + (if (pos-visible-in-window-p beg) + (when (overlayp org-table-header-overlay) + (delete-overlay org-table-header-overlay)) + (setq org-table-header-overlay + (make-overlay ws (+ ws (- end beg)))) + (org-overlay-display + org-table-header-overlay + (org-table-row-get-visible-string beg) + 'org-table-header)))) + (setq temporary-goal-column gcol)))) ;;;###autoload (define-minor-mode org-table-header-line-mode @@ -679,8 +685,6 @@ Will be filled automatically during use.") ("_" . "Names for values in row below this one.") ("^" . "Names for values in row above this one."))) -(defvar org-tbl-calc-modes nil) - (defvar org-pos nil) @@ -724,18 +728,6 @@ Field is restored even in case of abnormal exit." (org-table-goto-column ,column) (set-marker ,line nil))))) -(defsubst org-table--set-calc-mode (var &optional value) - (if (stringp var) - (setq var (assoc var '(("D" calc-angle-mode deg) - ("R" calc-angle-mode rad) - ("F" calc-prefer-frac t) - ("S" calc-symbolic-mode t))) - value (nth 2 var) var (nth 1 var))) - (if (memq var org-tbl-calc-modes) - (setcar (cdr (memq var org-tbl-calc-modes)) value) - (cons var (cons value org-tbl-calc-modes))) - org-tbl-calc-modes) - ;;; Predicates @@ -870,52 +862,52 @@ nil When nil, the command tries to be smart and figure out the (let* ((beg (min beg0 end0)) (end (max beg0 end0)) re) - (if (> (count-lines beg end) org-table-convert-region-max-lines) - (user-error "Region is longer than `org-table-convert-region-max-lines' (%s) lines; not converting" - org-table-convert-region-max-lines) - (when (equal separator '(64)) - (setq separator (read-regexp "Regexp for field separator"))) - (goto-char beg) - (beginning-of-line 1) - (setq beg (point-marker)) - (goto-char end) - (if (bolp) (backward-char 1) (end-of-line 1)) - (setq end (point-marker)) - ;; Get the right field separator - (unless separator - (goto-char beg) - (setq separator - (cond - ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) - ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) - (t 1)))) + (when (> (count-lines beg end) org-table-convert-region-max-lines) + (user-error "Region is longer than `org-table-convert-region-max-lines' (%s) lines; not converting" + org-table-convert-region-max-lines)) + (when (equal separator '(64)) + (setq separator (read-regexp "Regexp for field separator"))) + (goto-char beg) + (beginning-of-line 1) + (setq beg (point-marker)) + (goto-char end) + (if (bolp) (backward-char 1) (end-of-line 1)) + (setq end (point-marker)) + ;; Get the right field separator + (unless separator (goto-char beg) - (if (equal separator '(4)) - (while (< (point) end) - ;; parse the csv stuff + (setq separator (cond - ((looking-at "^") (insert "| ")) - ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) - ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") - (replace-match "\\1") - (if (looking-at "\"") (insert "\""))) - ((looking-at "[^,\n]+") (goto-char (match-end 0))) - ((looking-at "[ \t]*,") (replace-match " | ")) - (t (beginning-of-line 2)))) - (setq re (cond - ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") - ((equal separator '(16)) "^\\|\t") - ((integerp separator) - (if (< separator 1) - (user-error "Number of spaces in separator must be >= 1") - (format "^ *\\| *\t *\\| \\{%d,\\}" separator))) - ((stringp separator) - (format "^ *\\|%s" separator)) - (t (error "This should not happen")))) - (while (re-search-forward re end t) - (replace-match "| " t t))) - (goto-char beg) - (org-table-align)))) + ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) + ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) + (t 1)))) + (goto-char beg) + (if (equal separator '(4)) + (while (< (point) end) + ;; parse the csv stuff + (cond + ((looking-at "^") (insert "| ")) + ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) + ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") + (replace-match "\\1") + (if (looking-at "\"") (insert "\""))) + ((looking-at "[^,\n]+") (goto-char (match-end 0))) + ((looking-at "[ \t]*,") (replace-match " | ")) + (t (beginning-of-line 2)))) + (setq re (cond + ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") + ((equal separator '(16)) "^\\|\t") + ((integerp separator) + (if (< separator 1) + (user-error "Number of spaces in separator must be >= 1") + (format "^ *\\| *\t *\\| \\{%d,\\}" separator))) + ((stringp separator) + (format "^ *\\|%s" separator)) + (t (error "This should not happen")))) + (while (re-search-forward re end t) + (replace-match "| " t t))) + (goto-char beg) + (org-table-align))) ;;;###autoload (defun org-table-import (file separator) @@ -938,7 +930,8 @@ lines. It can have the following values: - regexp When a regular expression, use it to match the separator." (interactive "f\nP") (when (and (called-interactively-p 'any) - (not (string-match-p (rx "." (or "txt" "tsv" "csv") eos) file))) + (not (string-match-p (rx "." (or "txt" "tsv" "csv") eos) file)) + (not (yes-or-no-p "The file's extension is not .txt, .tsv or .csv. Import? "))) (user-error "Cannot import such file")) (unless (bolp) (insert "\n")) (let ((beg (point)) @@ -1936,8 +1929,9 @@ of lists of fields." (forward-line)) (set-marker end nil)) (when cut (org-table-align)) - (message (substitute-command-keys "Cells in the region copied, use \ -\\[org-table-paste-rectangle] to paste them in a table.")) + (when (called-interactively-p 'any) + (message (substitute-command-keys "Cells in the region copied, use \ +\\[org-table-paste-rectangle] to paste them in a table."))) (setq org-table-clip (nreverse region)))) ;;;###autoload @@ -2168,7 +2162,7 @@ LOCATION instead." (goto-char (match-beginning 3)) (delete-region (match-beginning 3) (match-end 0))) (org-indent-line) - (insert (or (match-string 2) "#+TBLFM:"))) + (insert "#+TBLFM:")) (insert " " (mapconcat (lambda (x) (concat (car x) "=" (cdr x))) (sort alist #'org-table-formula-less-p) @@ -2436,51 +2430,45 @@ location of point." equation (org-table-get-formula equation (equal arg '(4))))) (n0 (org-table-current-column)) - (org-tbl-calc-modes (copy-sequence org-calc-default-modes)) + (calc-modes (copy-sequence org-calc-default-modes)) (numbers nil) ; was a variable, now fixed default (keep-empty nil) - n form form0 formrpl formrg bw fmt x ev orig c lispp literal + form form0 formrpl formrg bw fmt ev orig lispp literal duration duration-output-format) ;; Parse the format string. Since we have a lot of modes, this is ;; a lot of work. However, I think calc still uses most of the time. - (if (string-match ";" formula) - (let ((tmp (org-split-string formula ";"))) - (setq formula (car tmp) - fmt (concat (cdr (assoc "%" org-table-local-parameters)) - (nth 1 tmp))) + (if (string-match "\\(.*\\);\\(.*\\)" formula) + (progn + (setq fmt (concat (cdr (assoc "%" org-table-local-parameters)) + (match-string-no-properties 2 formula))) + (setq formula (match-string-no-properties 1 formula)) (while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt) - (setq c (string-to-char (match-string 1 fmt)) - n (string-to-number (match-string 2 fmt))) - (if (= c ?p) - (setq org-tbl-calc-modes - (org-table--set-calc-mode 'calc-internal-prec n)) - (setq org-tbl-calc-modes - (org-table--set-calc-mode - 'calc-float-format - (list (cdr (assoc c '((?n . float) (?f . fix) - (?s . sci) (?e . eng)))) - n)))) + (let ((c (string-to-char (match-string 1 fmt))) + (n (string-to-number (match-string 2 fmt)))) + (cl-case c + (?p (setf (cl-getf calc-modes 'calc-internal-prec) n)) + (?n (setf (cl-getf calc-modes 'calc-float-format) (list 'float n))) + (?f (setf (cl-getf calc-modes 'calc-float-format) (list 'fix n))) + (?s (setf (cl-getf calc-modes 'calc-float-format) (list 'sci n))) + (?e (setf (cl-getf calc-modes 'calc-float-format) (list 'eng n))))) + ;; Remove matched flags from the mode string. (setq fmt (replace-match "" t t fmt))) - (if (string-match "[tTU]" fmt) - (let ((ff (match-string 0 fmt))) - (setq duration t numbers t - duration-output-format - (cond ((equal ff "T") nil) - ((equal ff "t") org-table-duration-custom-format) - ((equal ff "U") 'hh:mm)) - fmt (replace-match "" t t fmt)))) - (if (string-match "N" fmt) - (setq numbers t - fmt (replace-match "" t t fmt))) - (if (string-match "L" fmt) - (setq literal t - fmt (replace-match "" t t fmt))) - (if (string-match "E" fmt) - (setq keep-empty t - fmt (replace-match "" t t fmt))) - (while (string-match "[DRFS]" fmt) - (setq org-tbl-calc-modes - (org-table--set-calc-mode (match-string 0 fmt))) + (while (string-match "\\([tTUNLEDRFSu]\\)" fmt) + (let ((c (string-to-char (match-string 1 fmt)))) + (cl-case c + (?t (setq duration t numbers t + duration-output-format org-table-duration-custom-format)) + (?T (setq duration t numbers t duration-output-format nil)) + (?U (setq duration t numbers t duration-output-format 'hh:mm)) + (?N (setq numbers t)) + (?L (setq literal t)) + (?E (setq keep-empty t)) + (?D (setf (cl-getf calc-modes 'calc-angle-mode) 'deg)) + (?R (setf (cl-getf calc-modes 'calc-angle-mode) 'rad)) + (?F (setf (cl-getf calc-modes 'calc-prefer-frac) t)) + (?S (setf (cl-getf calc-modes 'calc-symbolic-mode) t)) + (?u (setf (cl-getf calc-modes 'calc-simplify-mode) 'units)))) + ;; Remove matched flags from the mode string. (setq fmt (replace-match "" t t fmt))) (unless (string-match "\\S-" fmt) (setq fmt nil)))) @@ -2582,17 +2570,17 @@ location of point." (setq form0 form) ;; Insert the references to fields in same row (while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form) - (setq n (+ (string-to-number (match-string 1 form)) - (if (match-end 2) n0 0)) - x (nth (1- (if (= n 0) n0 (max n 1))) fields) - formrpl (save-match-data - (org-table-make-reference - x keep-empty numbers lispp))) - (when (or (not x) - (save-match-data - (string-match (regexp-quote formula) formrpl))) - (user-error "Invalid field specifier \"%s\"" - (match-string 0 form))) + (let* ((n (+ (string-to-number (match-string 1 form)) + (if (match-end 2) n0 0))) + (x (nth (1- (if (= n 0) n0 (max n 1))) fields))) + (setq formrpl (save-match-data + (org-table-make-reference + x keep-empty numbers lispp))) + (when (or (not x) + (save-match-data + (string-match (regexp-quote formula) formrpl))) + (user-error "Invalid field specifier \"%s\"" + (match-string 0 form)))) (setq form (replace-match formrpl t t form))) (if lispp @@ -2624,7 +2612,7 @@ location of point." (setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form)) form - (calc-eval (cons form org-tbl-calc-modes) + (calc-eval (cons form calc-modes) (when (and (not keep-empty) numbers) 'num))) ev (if duration (org-table-time-seconds-to-string (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev) @@ -3280,7 +3268,7 @@ Parameters get priority." (org-defkey map "\C-c}" 'org-table-fedit-toggle-coordinates) map)) -(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu" +(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu." '("Edit-Formulas" ["Finish and Install" org-table-fedit-finish t] ["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c C-c"] @@ -4674,19 +4662,24 @@ blank, and the content is appended to the field above." (if (org-region-active-p) ;; There is a region: fill as a paragraph. (let ((start (region-beginning))) - (org-table-cut-region (region-beginning) (region-end)) - (when (> (length (car org-table-clip)) 1) - (user-error "Region must be limited to single column")) - (let ((nlines (cond ((not arg) (length org-table-clip)) - ((< arg 1) (+ (length org-table-clip) arg)) - (t arg)))) - (setq org-table-clip - (mapcar #'list - (org-wrap (mapconcat #'car org-table-clip " ") - nil - nlines)))) - (goto-char start) - (org-table-paste-rectangle)) + (save-restriction + (narrow-to-region + (save-excursion (goto-char start) (move-beginning-of-line 1)) + (save-excursion (org-forward-paragraph) (point))) + (org-table-cut-region (region-beginning) (region-end)) + (when (> (length (car org-table-clip)) 1) + (user-error "Region must be limited to single column")) + (let ((nlines (cond ((not arg) (length org-table-clip)) + ((< arg 1) (+ (length org-table-clip) arg)) + (t arg)))) + (setq org-table-clip + (mapcar #'list + (org-wrap (mapconcat #'car org-table-clip " ") + nil + nlines)))) + (goto-char start) + (org-table-paste-rectangle)) + (org-table-align)) ;; No region, split the current field at point. (unless (org-get-alist-option org-M-RET-may-split-line 'table) (skip-chars-forward "^\r\n|")) @@ -5084,7 +5077,7 @@ When LOCAL is non-nil, show references for the table at point." (put 'orgtbl-mode :included t) (put 'orgtbl-mode :menu-tag "Org Table Mode") -(easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu" +(easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu." '("OrgTbl" ["Create or convert" org-table-create-or-convert-from-region :active (not (org-at-table-p)) :keys "C-c |" ] @@ -5334,7 +5327,7 @@ With prefix arg, also recompute table." (defun orgtbl-create-or-convert-from-region (_arg) "Create table or convert region to table, if no conflicting binding. This installs the table binding `C-c |', but only if there is no -conflicting binding to this key outside orgtbl-mode." +conflicting binding to this key outside `orgtbl-mode'." (interactive "P") (let* (orgtbl-mode (cmd (key-binding "\C-c|"))) (if cmd @@ -5573,7 +5566,7 @@ First element has index 0, or I0 if given." ;;;###autoload (defun orgtbl-to-generic (table params) - "Convert the orgtbl-mode TABLE to some other format. + "Convert the `orgtbl-mode' TABLE to some other format. This generic routine can be used for many standard cases. @@ -5960,12 +5953,12 @@ information." ;;;###autoload (defun orgtbl-to-tsv (table params) - "Convert the orgtbl-mode table to TAB separated material." + "Convert the `orgtbl-mode' TABLE to TAB separated material." (orgtbl-to-generic table (org-combine-plists '(:sep "\t") params))) ;;;###autoload (defun orgtbl-to-csv (table params) - "Convert the orgtbl-mode table to CSV material. + "Convert the `orgtbl-mode' TABLE to CSV material. This does take care of the proper quoting of fields with comma or quotes." (orgtbl-to-generic table (org-combine-plists '(:sep "," :fmt org-quote-csv-field) @@ -5973,7 +5966,7 @@ This does take care of the proper quoting of fields with comma or quotes." ;;;###autoload (defun orgtbl-to-latex (table params) - "Convert the orgtbl-mode TABLE to LaTeX. + "Convert the `orgtbl-mode' TABLE to LaTeX. TABLE is a list, each entry either the symbol `hline' for a horizontal separator line, or a list of fields for that line. @@ -6006,7 +5999,7 @@ supported. It is also possible to use the following ones: ;;;###autoload (defun orgtbl-to-html (table params) - "Convert the orgtbl-mode TABLE to HTML. + "Convert the `orgtbl-mode' TABLE to HTML. TABLE is a list, each entry either the symbol `hline' for a horizontal separator line, or a list of fields for that line. @@ -6037,7 +6030,7 @@ supported. It is also possible to use the following one: ;;;###autoload (defun orgtbl-to-texinfo (table params) - "Convert the orgtbl-mode TABLE to Texinfo. + "Convert the `orgtbl-mode' TABLE to Texinfo. TABLE is a list, each entry either the symbol `hline' for a horizontal separator line, or a list of fields for that line. @@ -6068,7 +6061,7 @@ supported. It is also possible to use the following one: ;;;###autoload (defun orgtbl-to-orgtbl (table params) - "Convert the orgtbl-mode TABLE into another orgtbl-mode table. + "Convert the `orgtbl-mode' TABLE into another orgtbl-mode table. TABLE is a list, each entry either the symbol `hline' for a horizontal separator line, or a list of fields for that line. @@ -6083,7 +6076,7 @@ be set to provide ORGTBL directives for the generated table." (orgtbl-to-generic table (org-combine-plists params (list :backend 'org)))) (defun orgtbl-to-table.el (table params) - "Convert the orgtbl-mode TABLE into a table.el table. + "Convert the `orgtbl-mode' TABLE into a table.el table. TABLE is a list, each entry either the symbol `hline' for a horizontal separator line, or a list of fields for that line. PARAMS is a property list of parameters that can influence the @@ -6097,7 +6090,7 @@ supported." (replace-regexp-in-string "|-" "+-" (buffer-substring 1 (buffer-size)))))) (defun orgtbl-to-unicode (table params) - "Convert the orgtbl-mode TABLE into a table with unicode characters. + "Convert the `orgtbl-mode' TABLE into a table with unicode characters. TABLE is a list, each entry either the symbol `hline' for a horizontal separator line, or a list of fields for that line. @@ -6109,7 +6102,7 @@ supported. It is also possible to use the following ones: When non-nil, use \"ascii-art-to-unicode\" package to translate the table. You can download it here: - http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el. + https://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el. :narrow @@ -6214,7 +6207,7 @@ which will prompt for the width." (defun orgtbl-uc-draw-grid (value min max &optional width) "Draw a bar in a table using block unicode characters. -It is a variant of orgtbl-ascii-draw with Unicode block +It is a variant of `orgtbl-ascii-draw' with Unicode block characters, for a smooth display. Bars appear as grids (to the extent the font allows)." ;; https://en.wikipedia.org/wiki/Block_Elements @@ -6224,7 +6217,7 @@ extent the font allows)." (defun orgtbl-uc-draw-cont (value min max &optional width) "Draw a bar in a table using block unicode characters. -It is a variant of orgtbl-ascii-draw with Unicode block +It is a variant of `orgtbl-ascii-draw' with Unicode block characters, for a smooth display. Bars are solid (to the extent the font allows)." (orgtbl-ascii-draw value min max width |