Files
dot-emacs/lisp/init-orgtable.el

428 lines
15 KiB
EmacsLisp

;; *** org table mode
;; I'm so used to lovely org mode tables, I need them everywhere!
(when (package-installed-p 'org)
(require 'org-table)
;; convert CSV region to table
(defun tablify (regex)
"Convert a whitespace separated column list into
an org mode table and enable orgtbl-mode. You can
specify another regex for cell splitting."
(interactive "MConvert [region] to table with regex ([\t\s]+): ")
(let ((spc "[\t\s]+"))
(when (string= regex "")
(setq regex spc))
(delete-trailing-whitespace)
(if (org-region-active-p)
(org-table-convert-region (region-beginning) (region-end) regex)
(org-table-convert-region (point-min) (point-max) regex))
(when (not (eq major-mode 'org-mode))
(orgtbl-mode))))
;; table sorting shortcuts
(defun sort-table-numeric ()
"sort org table numerically by current column"
(interactive)
(org-table-sort-lines nil ?n))
(defun sort-table-numeric-desc ()
"reverse sort org table numerically by current column"
(interactive)
(org-table-sort-lines nil ?N))
(defun sort-table-alphanumeric ()
"sort org table charwise by current column"
(interactive)
(org-table-sort-lines nil ?a))
(defun sort-table-alphanumeric-desc ()
"reverse sort org table charwise by current column"
(interactive)
(org-table-sort-lines nil ?A))
(defun sort-table-time ()
"sort org table by times by current column"
(interactive)
(org-table-sort-lines nil ?t))
(defun sort-table-time-desc ()
"reverse sort org table by times by current column"
(interactive)
(org-table-sort-lines nil ?T))
;; [[http://irreal.org/blog/?p=3542][via jcs/irreal.org]]
;; however, I renamed the actual sort wrappers to match my
;; naming scheme
(defun jcs-ip-lessp (ip1 ip2 &optional op)
"Compare two IP addresses.
Unless the optional argument OP is provided, this function will return T
if IP1 is less than IP2 or NIL otherwise. The optional argument OP is
intended to be #'> to support reverse sorting."
(setq cmp (or op #'<))
(cl-labels ((compare (l1 l2)
(if (or (null l1) (null l2))
nil
(let ((n1 (string-to-number (car l1)))
(n2 (string-to-number (car l2))))
(cond
((funcall cmp n1 n2) t)
((= n1 n2) (compare (cdr l1) (cdr l2)))
(t nil))))))
(compare (split-string ip1 "\\.") (split-string ip2 "\\."))))
(defun sort-table-ip ()
(interactive)
(org-table-sort-lines nil ?f #'org-sort-remove-invisible #'jcs-ip-lessp))
(defun sort-table-ip-desc ()
(interactive)
(org-table-sort-lines nil ?F #'org-sort-remove-invisible
(lambda (ip1 ip2) (jcs-ip-lessp ip1 ip2 #'>))))
;; easy access for the shortcuts
(defalias 'stn 'sort-table-numeric)
(defalias 'stnd 'sort-table-numeric-desc)
(defalias 'sta 'sort-table-alphanumeric)
(defalias 'stad 'sort-table-alphanumeric-desc)
(defalias 'stt 'sort-table-time)
(defalias 'sttd 'sort-table-time-desc)
(defalias 'sti 'sort-table-ip)
(defalias 'stid 'sort-table-ip-desc)
;; generic table exporter
(defun tvd-export-org-table (fmt)
"export an org table using format FMT"
(interactive)
(let ((efile "/tmp/org-table-export.tmp")
(ebuf (format "*table-%s*" fmt)))
(when (file-exists-p efile)
(delete-file efile))
(org-table-export efile (format "orgtbl-to-%s" fmt))
(other-window 1)
(if (not (eq (get-buffer ebuf) nil))
(kill-buffer (get-buffer ebuf)))
(set-buffer (get-buffer-create ebuf))
(insert-file-contents efile)
(switch-to-buffer ebuf)
(delete-file efile)))
;; FIXME: once there's an org solution to this, remove this code
;; format specific exporters
(defun tvd-org-quote-csv-field (s)
"Quote every field."
(if (string-match "." s)
(concat "=\"" (mapconcat 'identity
(split-string s "\"") "\"\"") "\"")
s))
(defun table-to-excel ()
"export current org table to CSV format suitable for MS Excel."
(interactive)
;; quote everything, map temporarily 'org-quote-csv-field
;; to my version
(cl-letf (((symbol-function 'org-quote-csv-field)
#'tvd-org-quote-csv-field))
(tvd-export-org-table "csv")))
(defun table-to-csv ()
"export current org table to CSV format"
(interactive)
(tvd-export-org-table "csv"))
(defun table-to-latex ()
"export current org table to LaTeX format"
(interactive)
(tvd-export-org-table "latex"))
(defun table-to-html ()
"export current org table to HTML format"
(interactive)
(tvd-export-org-table "html"))
(defun table-to-csv-tab ()
"export current org table to CSV format, separated by <tab>"
(interactive)
(tvd-export-org-table "tsv"))
(defun table-to-aligned ()
"export current org table to space-aligned columns format"
(interactive)
(tvd-export-org-table "csv")
(with-current-buffer "*table-csv*"
(align-regexp (point-min) (point-max) "\\(\\s-*\\)," 1 1 t)
(while (re-search-forward " ," nil t)
(replace-match " "))))
;; exporter shortcuts
(defalias 'ttc 'table-to-csv)
(defalias 'tte 'table-to-excel)
(defalias 'ttl 'table-to-latex)
(defalias 'tth 'table-to-html)
(defalias 'ttt 'table-to-csv-tab)
(defalias 'tta 'table-to-aligned)
;; In org mode I sometimes want to copy the content of a table cell
(defun tvd-beginning-of-cell (&optional arg)
"move (point) to the beginning of a org mode table cell"
(interactive)
(if (re-search-backward "|" (line-beginning-position) 3 1)
(forward-char)))
(defun tvd-end-of-cell (&optional arg)
"move (point) to the end of a org mode table cell"
(interactive)
(if (re-search-forward "|" (line-end-position) 3 1)
(backward-char)))
(defun tvd-copy-org-table-cell(&optional arg)
"Copy an org mode table cell to the kill ring using MCYT"
(interactive "P")
(mcyt--blink-and-copy-thing 'tvd-beginning-of-cell 'tvd-end-of-cell arg))
(defun tvd-del-org-table-cell (&optional arg)
"Delete a cell"
(interactive "P")
(let
((beg (progn (tvd-beginning-of-cell) (point)))
(end (progn (tvd-end-of-cell) (point))))
(delete-region beg end)
(org-table-align)))
(defun tvd-del-org-table-row ()
"Delete a table row's contents"
(interactive)
(org-beginning-of-line 1)
(kill-line)
(org-table-insert-row nil))
(defun tvd-del-org-table-col ()
"Delete a table column's contents, keep heading as is"
(interactive)
(let ((head (org-table-get 1 nil)))
(org-table-delete-column)
(re-search-forward "|")
(org-table-insert-column)
(tvd-org-table-goto-col-beginning)
(insert head)
(org-table-align))
)
;; Sometimes I need to copy whole columns too:
;; via [[https://emacs.stackexchange.com/questions/28270/how-to-select-and-copy-a-column-of-an-org-table-without-rectangle-selection][stackoverflow]]
(defun tvd-org-table-goto-col-beginning ()
"Go to beginning of current column and return `point'."
(interactive)
(assert (org-table-p) "Not in org-table.")
(org-table-align)
(let ((col (org-table-current-column)))
(goto-char (org-table-begin))
(org-table-goto-column col))
(point))
(defun tvd-org-table-col-beginning ()
"Return beginning position of current column."
(save-excursion
(tvd-org-table-goto-col-beginning)))
(defun tvd-org-table-goto-col-end ()
"Goto end of current column and return `point'."
(interactive)
(assert (org-table-p) "Not in org-table.")
(org-table-align)
(let ((col (org-table-current-column)))
(goto-char (1- (org-table-end)))
(org-table-goto-column col)
(skip-chars-forward "^|"))
(point))
(defun tvd-org-table-col-end ()
"Return end position of current column."
(save-excursion
(tvd-org-table-goto-col-end)))
(defun tvd-org-table-select-col ()
"Select current column."
(interactive)
(set-mark (tvd-org-table-col-beginning))
(tvd-org-table-goto-col-end)
(rectangle-mark-mode))
(defun tvd-copy-org-table-col ()
"Copy current column."
(interactive)
(tvd-org-table-select-col)
(sit-for 0.2 t)
(copy-region-as-kill nil nil t)
(with-temp-buffer
(yank)
(delete-trailing-whitespace)
(delete-whitespace-rectangle (point-min) (point-max))
(font-lock-unfontify-buffer)
(copy-region-as-kill (point-min) (point-max))))
(defun tvd-copy-org-table-row ()
"Copy current row, space aligned"
(interactive)
(mcyt-copy-line)
(with-temp-buffer
(yank)
(goto-char (point-min))
(let ((spc ""))
(while (re-search-forward "|[ ]*" nil t)
(replace-match spc)
(setq spc " ")))
(delete-trailing-whitespace)
(copy-region-as-kill (point-min) (point-max))))
;; Move single cells using C-M-up C-M-down C-M-left C-M-right
;; [[https://cs.gmu.edu/~kauffman/software/org-table-move-single-cell.el][via Kauffmann]]
(defun org-table-swap-cells (i1 j1 i2 j2)
"Swap two cells"
(let ((c1 (org-table-get i1 j1))
(c2 (org-table-get i2 j2)))
(org-table-put i1 j1 c2)
(org-table-put i2 j2 c1)
(org-table-align)))
(defun org-table-move-single-cell (direction)
"Move the current cell in a cardinal direction according to the
parameter symbol: 'up 'down 'left 'right. Swaps contents of
adjacent cell with current one."
(unless (org-at-table-p)
(error "No table at point"))
(let ((di 0) (dj 0))
(cond ((equal direction 'up) (setq di -1))
((equal direction 'down) (setq di +1))
((equal direction 'left) (setq dj -1))
((equal direction 'right) (setq dj +1))
(t (error "Not a valid direction, must be up down left right")))
(let* ((i1 (org-table-current-line))
(j1 (org-table-current-column))
(i2 (+ i1 di))
(j2 (+ j1 dj)))
(org-table-swap-cells i1 j1 i2 j2)
(org-table-goto-line i2)
(org-table-goto-column j2))))
(defun org-table-move-single-cell-up ()
"Move a single cell up in a table; swap with anything in target cell"
(interactive)
(org-table-move-single-cell 'up))
(defun org-table-move-single-cell-down ()
"Move a single cell down in a table; swap with anything in target cell"
(interactive)
(org-table-move-single-cell 'down))
(defun org-table-move-single-cell-left ()
"Move a single cell left in a table; swap with anything in target cell"
(interactive)
(org-table-move-single-cell 'left))
(defun org-table-move-single-cell-right ()
"Move a single cell right in a table; swap with anything in target cell"
(interactive)
(org-table-move-single-cell 'right))
(defun tvd-org-sum-column()
"Calculate sum of current row and put it into current cell, replacing cell"
(interactive)
(org-table-blank-field)
(org-table-sum)
(yank)
(org-table-align))
;; actual org table config
(with-eval-after-load "org"
(add-hook 'org-mode-hook
(lambda ()
(local-set-key (kbd "C-c t l") 'tvd-copy-org-table-col)
(local-set-key (kbd "C-c t r") 'tvd-copy-org-table-row)
(local-set-key (kbd "C-c t c") 'tvd-copy-org-table-cell)
(local-set-key (kbd "C-M-<left>") 'org-table-move-single-cell-left)
(local-set-key (kbd "C-M-<right>") 'org-table-move-single-cell-right)
(local-set-key (kbd "C-M-<up>") 'org-table-move-single-cell-up)
(local-set-key (kbd "C-M-<down>") 'org-table-move-single-cell-down))))
;; eval-after-load 'orgtbl doesn't work
(add-hook 'orgtbl-mode-hook '(lambda ()
(define-key orgtbl-mode-map (kbd "C-c t l") 'tvd-copy-org-table-col)
(define-key orgtbl-mode-map (kbd "C-c t r") 'tvd-copy-org-table-row)
(define-key orgtbl-mode-map (kbd "C-c t c") 'tvd-copy-org-table-cell)))
;; integers, reals, positives, set via custom
(setq org-table-number-regexp "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$")
;; table hydras, maybe better than aliases?!
(defhydra hydra-org-tables (:color blue)
"
^Sort by^ ^Transform to^ ^Copy/Del what^ ^Modify^ ^Outside Org^
^^^^^^^^-----------------------------------------------------------------------------------------------------------------------
_sa_: alphanumeric _tc_: CSV _cl_: Copy Column (C-c t l) _ic_: Insert Column _ot_: Table to Org Mode
_sA_: -alphanumeric _te_: Excel _cr_: Copy Row (C-c t r) _ir_: Insert Row _oe_: Enable Org-Tbl Mode
_si_: ip _tl_: Latex _cc_: Copy Cell (C-c t c) _il_: Insert Line _oc_: Turn region to columns
_sI_: -ip _th_: HTML _dd_: Delete Cell _tr_: Transpose Table
_sn_: numeric _tt_: Tab _dc_: Delete Column _mr_: Move Cell right
_sN_: -numeric _ta_: Aligned _dr_: Delete Row _ml_: Move Cell left
_st_: time ^^ _kr_: Kill Row _mu_: Move Cell up _S_: sum current column
_sT_: -time ^^ _kc_: Kill Column _md_: Move Cell down _q_: Cancel
^^^^^^^^-----------------------------------------------------------------------------------------------------------------------
Reach this hydra with <C-x t>
^^^^^^^^-----------------------------------------------------------------------------------------------------------------------
"
("mr" org-table-move-single-cell-right)
("ml" org-table-move-single-cell-left)
("mu" org-table-move-single-cell-up)
("md" org-table-move-single-cell-down)
("sa" sort-table-alphanumeric nil)
("sA" sort-table-alphanumeric-desc nil)
("si" sort-table-ip nil)
("sI" sort-table-ip-desc nil)
("sn" sort-table-numeric nil)
("sN" sort-table-numeric-desc nil)
("st" sort-table-time nil)
("sT" sort-table-time-desc nil)
("tc" table-to-csv nil)
("te" table-to-excel nil)
("tl" table-to-latex nil)
("th" table-to-html nil)
("tt" table-to-csv-tab nil)
("ta" table-to-aligned nil)
("cl" tvd-copy-org-table-col nil)
("cr" tvd-copy-org-table-row nil)
("cc" tvd-copy-org-table-cell nil)
("dd" org-table-blank-field nil)
("dr" tvd-del-org-table-row nil)
("dc" tvd-del-org-table-col nil)
("kc" org-table-delete-column nil)
("kr" org-table-kill-row nil)
("ic" org-table-insert-column nil)
("ir" org-table-insert-row nil)
("il" org-table-hline-and-move nil)
("tr" org-table-transpose-table-at-point nil)
("ot" tablify nil)
("oe" orgtbl-mode nil)
("oc" align-repeat nil)
("S" tvd-org-sum-column)
("q" nil nil :color red))
;; allow me to insert org tables everywhere on request
(defalias 'table 'hydra-org-tables/body)
(global-set-key (kbd "C-x t") 'hydra-org-tables/body))
(provide 'init-orgtable)
;;; init-orgtable.el ends here