421 lines
17 KiB
EmacsLisp
421 lines
17 KiB
EmacsLisp
;;; my.el --- Personal library -*- lexical-binding: t -*-
|
|
|
|
;;; Commentary:
|
|
;; Org:
|
|
;; Colored text in Org buffer and export.
|
|
;; [[color:gray][text]]
|
|
;; [[color:#cccccc][text]]
|
|
|
|
;;; Code:
|
|
;; ELisp:
|
|
;; (equal (symbol-name 'tmp) "tmp") ;; get symbol as string and compare with string
|
|
;; (equal (intern "tmp") 'tmp) ;; get string as symbol and compare with symbol
|
|
;; (regexp-quote "/foo/baz/*") ;; => "/foo/baz/\\*"
|
|
;; (add-hook 'help-mode-hook 'virtual-auto-fill-mode) ;; add a mode-hook
|
|
;; (add-hook 'org-mode-hook (lambda () (add-hook 'after-save-hook 'a-test-save-hook nil t))) ;; add local hook to a mode-hook
|
|
;; Org:
|
|
;; https://orgmode.org/worg/dev/org-element-api.html
|
|
;; https://orgmode.org/worg/dev/org-syntax.html
|
|
;; Over an element, like a table. The key must start with attr_.
|
|
;; The lower line shows the plist elements inside the org element context.
|
|
|
|
(defgroup my nil
|
|
"My concept mapping"
|
|
:prefix "my-"
|
|
:group 'emacs)
|
|
|
|
(defun my-eval-string (string)
|
|
"Evaluate elisp code stored in a string."
|
|
(eval (car (read-from-string (format "(progn %s)" string)))))
|
|
|
|
(defun my-list-delete (element list)
|
|
"Destructive version of `delete'.
|
|
LIST will be nil if the last ELEMENT was deleted.
|
|
Example:
|
|
(setq my-list '(\"a\"))
|
|
(my-list-delete \"a\" 'my-list)
|
|
(setq my-list '(a))
|
|
(my-list-delete 'a 'my-list)
|
|
(add-to-list 'my-list '(\"a\"))
|
|
(my-list-delete '(\"a\") 'my-list)"
|
|
(set list (delete element (symbol-value list))))
|
|
|
|
(defun my-list-to-org-table (lst)
|
|
"Convert list into an Org table."
|
|
(let ((lines lst)
|
|
(rows)
|
|
(tbl))
|
|
(while lines
|
|
(setq rows (car lines))
|
|
(setq tbl (concat tbl "|"))
|
|
(while rows
|
|
(setq tbl (concat tbl (format "%s|" (car rows))))
|
|
(setq rows (cdr rows)))
|
|
(setq tbl (concat tbl "\n"))
|
|
(setq lines (cdr lines)))
|
|
tbl))
|
|
|
|
(defmacro my-plist-put (plist &rest args)
|
|
"Example usage:
|
|
(my-plist-put my-org-table-colored-cells 'table-name '(\"@23$3\" \"blue\"))
|
|
(my-plist-put my-org-table-colored-cells
|
|
'table-name-1 '(\"@13$3\" \"red\") 'table-name-2 '(\"@33$3\" \"green\"))"
|
|
(let ((list nil))
|
|
(while args
|
|
(push `(setq ,plist (plist-put ,plist ,(pop args) ,(pop args))) list))
|
|
(cons 'progn (nreverse list))))
|
|
|
|
(defun my-interpolate (low high r rlow rhigh)
|
|
"Return the point between LOW and HIGH that corresponds to where R is \
|
|
between RLOW and RHIGH.
|
|
|
|
Linear interpolate of R in the interval RLOW RHIGH.
|
|
|
|
RESULT - LOW HIGH - LOW
|
|
------------ = ------------
|
|
R - RLOW RHIGH - RLOW
|
|
|
|
HIGH - LOW
|
|
RESULT = LOW + (R - RLOW) * ------------
|
|
RHIGH - RLOW
|
|
|
|
Example:
|
|
(my-interpolate 0 100 12 0 10) => 120"
|
|
(+ low (/ (* (- high low) (- r rlow)) (- rhigh rlow))))
|
|
|
|
(defun my-color-luminance (R G B)
|
|
"Luminosity, relative luminance.
|
|
|
|
L = 0.2126*R' + 0.7152*G' + 0.0722*B' with
|
|
[R',G',B'] = [R,G,B] / 12.92 if [R,G,B] <= 0.03928 else (([R,G,B]+0.055)/1.055)^2.4
|
|
earlier
|
|
L = 0.2126*R^2.2 + 0.7152*G^2.2 + 0.0722*B^2.2
|
|
|
|
R,G,B,L = [0, 1]
|
|
See also `my-color-contrast'"
|
|
;; https://www.w3.org/Graphics/Color/sRGB.html
|
|
(let ((R (if (<= R 0.03928) (/ R 12.92) (expt (/ (+ R 0.055) 1.055) 2.4)))
|
|
(G (if (<= G 0.03928) (/ G 12.92) (expt (/ (+ G 0.055) 1.055) 2.4)))
|
|
(B (if (<= B 0.03928) (/ B 12.92) (expt (/ (+ B 0.055) 1.055) 2.4))))
|
|
(+ (* 0.2126 R) (* 0.7152 G) (* 0.0722 B)))
|
|
;; earlier
|
|
;;(+ (* 0.2126 (expt R 2.2)) (* 0.7152 (expt G 2.2)) (* 0.0722 (expt B 2.2)))
|
|
)
|
|
|
|
(defun my-color-contrast (R1 G1 B1 &optional R2 G2 B2)
|
|
"Luminosity contrast ratio.
|
|
Calculate the difference between the given colors R1, G1, B1 and R2,
|
|
G2, B2. The returned value should be greater than or equal to 4.5
|
|
\(earlier greater than 5) for best readability. Using
|
|
`my-color-luminance'. R2, G2, B2 defaults to black. See also
|
|
`color-dark-p'."
|
|
;; https://www.w3.org/TR/WCAG20/#contrast-ratiodef
|
|
;; https://www.w3.org/TR/2016/NOTE-WCAG20-TECHS-20161007/G18
|
|
(let* ((L1 (my-color-luminance R1 G1 B1))
|
|
(R2 (if R2 R2 0)) (G2 (if G2 G2 0)) (B2 (if B2 B2 0))
|
|
(L2 (my-color-luminance R2 G2 B2)))
|
|
(if (> L1 L2) ;; normally L1 defined as the lighter color and L2 as the darker color
|
|
(/ (+ L1 0.05) (+ L2 0.05))
|
|
(/ (+ L2 0.05) (+ L1 0.05)))))
|
|
|
|
(defun my-color-rgb-gradient (rgbsteps position)
|
|
"RGBSTEPS is a list of four element lists.
|
|
The list consists
|
|
- a start position value for the color d
|
|
- and the three color parameters r g b
|
|
- example
|
|
'((d1 r1 g1 b1)
|
|
(d2 r2 g2 b2)
|
|
(d3 r3 g3 b3)
|
|
(d4 r4 g4 b4))
|
|
with d1 < d2 < d3 < d4
|
|
if POSITION <= d1 then return (r1 g1 b1)
|
|
else remove the rgbstep_i where POSITION > di+1 from RGBSTEPS
|
|
if there is only one rgbstep left in RGBSTEPS return the (rn gn bn) values
|
|
otherwise interpolate of the first two rgbstep elements of the remaining
|
|
RGBSTEPS list.
|
|
|
|
Examples:
|
|
(my-rgb-gradient '((1 1 1 1) (2 2 2 2) (3 3 3 3)) 2)
|
|
(my-rgb-gradient '((1 1 1 1) (2 2 2 2)) 2)"
|
|
;; if position <= first element of first element (d1)
|
|
;; then return other elements of first element (r1 g1 b1)
|
|
(if (<= position (caar rgbsteps))
|
|
(cdar rgbsteps)
|
|
;; if there are other elements and if position > d1(,new) of the first other element
|
|
;; then remove first element
|
|
(while (and (cdr rgbsteps) (> position (caadr rgbsteps)))
|
|
(setq rgbsteps (cdr rgbsteps)))
|
|
;; if there is no other element, return other elements (rn gn bn) of the element in list
|
|
(if (null (cdr rgbsteps))
|
|
(cdar rgbsteps)
|
|
;; else there are at least two elements left.
|
|
;; return interpolation of the first two elements
|
|
(list
|
|
;; r1 g1 b1 r2 g2 b2 d1 d2
|
|
(my-interpolate (nth 1 (car rgbsteps)) (nth 1 (cadr rgbsteps)) position (caar rgbsteps) (caadr rgbsteps))
|
|
(my-interpolate (nth 2 (car rgbsteps)) (nth 2 (cadr rgbsteps)) position (caar rgbsteps) (caadr rgbsteps))
|
|
(my-interpolate (nth 3 (car rgbsteps)) (nth 3 (cadr rgbsteps)) position (caar rgbsteps) (caadr rgbsteps))))))
|
|
|
|
(with-eval-after-load 'org
|
|
|
|
;;; colored table cells
|
|
;; https://emacs.stackexchange.com/questions/7375/can-i-format-cells-in-an-org-mode-table-differently-depending-on-a-formula
|
|
(require 'ov)
|
|
|
|
(defun my-org-keywords ()
|
|
"Parse the buffer and return a cons list of (key . value)
|
|
from lines like:
|
|
#+KEY: value"
|
|
(org-element-map (org-element-parse-buffer 'greater-element) 'keyword
|
|
(lambda (keyword) (cons (org-element-property :key keyword)
|
|
(org-element-property :value keyword)))))
|
|
|
|
(defun my-org-keyword (keyword)
|
|
"Get the value of a KEYWORD in the form of #+KEYWORD: value
|
|
|
|
Using `my-org-keywords' to find all keywords."
|
|
(cdr (assoc keyword (my-org-keywords))))
|
|
|
|
(defun my-org-keyword-re (KEYWORD)
|
|
"Get the value from a line like this
|
|
#+KEYWORD: value
|
|
in a buffer.
|
|
|
|
Using a case-insensitive regular expressions search in the buffer to grab the value."
|
|
(interactive)
|
|
(let ((case-fold-search t)
|
|
(re (format "^#\\+%s:[ \t]+\\([^\t\n]+\\)" KEYWORD)))
|
|
(if (not (save-excursion
|
|
(or (re-search-forward re nil t)
|
|
(re-search-backward re nil t))))
|
|
(error (format "No line containing #+%s: value found" KEYWORD)))
|
|
(match-string 1)))
|
|
|
|
(defun my-org-attr-to-list (attr)
|
|
"
|
|
ATTR is the for example (plist-get table :attr_color)
|
|
|
|
#+ATTR_MY_KEY: this and that
|
|
:attr_my_key (\"this and that\")
|
|
|
|
#+ATTR_MY_KEY: this and that
|
|
#+ATTR_MY_KEY: foo baz
|
|
:attr_my_key (\"this and that\" \"foo baz\")"
|
|
;;(split-string (car attr)) ;; this was only the first string, meaning only one (the last) attr_color line.
|
|
;;(split-string (string-join attr " ")) ;; splits on space but also inside quotes
|
|
(split-string-and-unquote (string-join attr " ")))
|
|
|
|
(defun my-org-table-get ()
|
|
"Check if cursor is inside an Org table or on #+TBLFM lines \
|
|
then return the table element otherwise return nil.
|
|
`org-at-table-p' is nil if cursor on #+TBLFM"
|
|
(let ((element (org-element-at-point))) ;; get org element
|
|
(while (and element (not (eq (car element) 'table))) ;; check if it is table
|
|
(setq element (plist-get (cadr element) :parent))) ;; if not check if parent element is table
|
|
(cond
|
|
((equal (car element) 'table) ;; only if table found
|
|
(cadr element))))) ;; return element
|
|
|
|
(defun my-org-table-range-to-list (desc &optional val)
|
|
"
|
|
Example usage:
|
|
\(my-org-table-range-to-list \"@3$1\") -> (@3$1)
|
|
\(my-org-table-range-to-list \"@3$1\" \"red\") -> (@3$1 red)
|
|
\(my-org-table-range-to-list \"@3$1..@3$3\") -> (@3$1 @3$2 @3$3)
|
|
\(my-org-table-range-to-list \"@3$1..@3$3\" \"red\") -> (@3$1 red @3$2 red @3$3 red)
|
|
|
|
Used in `my-org-table-list-of-range-to-list'"
|
|
(if (string-match-p (regexp-quote "..") desc)
|
|
(let (from-row from-column to-row to-column result)
|
|
(string-match "@\\([0-9]+\\)\$\\([0-9]+\\)\\.\\.@\\([0-9]+\\)\$\\([0-9]+\\)" desc)
|
|
(setq from-row (string-to-number (match-string 1 desc))) ;; 1st parentheses match from string-match
|
|
(setq from-column (string-to-number (match-string 2 desc))) ;; 2nd parentheses match from string-match
|
|
(setq to-row (string-to-number (match-string 3 desc))) ;; 3rd parentheses match from string-match
|
|
(setq to-column (string-to-number (match-string 4 desc))) ;; 4th parentheses match from string-match
|
|
(loop for i upfrom to-row downto from-row ;; push prepends
|
|
do
|
|
(cl-loop for j upfrom to-column downto from-column
|
|
do
|
|
(when val (push val result)) ;; push prepends
|
|
(push (concat "@" (number-to-string i) "$" (number-to-string j)) result)
|
|
))
|
|
result)
|
|
(if val (list desc val) (list desc))))
|
|
|
|
(defun my-org-table-list-of-range-to-list (seq)
|
|
"
|
|
@3$1..@3$3 red @1$3 #0055aa -> (@3$1 red @3$2 red @3$3 red @1$3 #0055aa)
|
|
|
|
Used in `my-org-table-cell-color-attr'
|
|
uses `my-org-table-range-to-list'"
|
|
(when seq
|
|
(let (result)
|
|
;;(message "%s" seq)
|
|
(while seq
|
|
(setq result
|
|
(append result
|
|
(my-org-table-range-to-list (car seq) (cadr seq))))
|
|
(setq seq (cddr seq)))
|
|
result)))
|
|
|
|
(defun my-org-table-cell-color (beg end seq)
|
|
"BEG and END are the beginning and the end of the table.
|
|
SEQ is a list of cell name and color name pairs."
|
|
(save-excursion ;; save cursor and go back to it after, important for other features
|
|
(goto-char beg) ;; go inside the table, required for org-table-analyse
|
|
(org-table-analyze) ;; required for org-table-goto-field
|
|
(ov-clear beg end)
|
|
(while seq ;; run as long elements are in list
|
|
(let* ((cell (car seq)) ;; get first "key"
|
|
(color-name (cadr seq)) ;; get first "value"
|
|
(color-rgb (color-name-to-rgb color-name))
|
|
(bg (apply #'color-rgb-to-hex color-rgb))
|
|
;;(fg (if (>= (apply #'my-color-contrast color-rgb) 4.5) "#000000" "#ffffff"))
|
|
(fg (if (>= (apply #'my-color-contrast (append color-rgb (color-name-to-rgb "gray10"))) 4.5) "gray10" "gray80"))
|
|
;;(fg (if (>= (apply #'my-color-contrast color-rgb) 4.5) "gray10" 'default))
|
|
(beg (progn (org-table-goto-field cell) (backward-char) (point))) ;; beginning of the cell
|
|
;;(end (progn (org-table-end-of-field 1) (forward-char) (point))) ;; for left aligned cells end is end of content not of cell
|
|
(end (1- (plist-get (cadr (org-element-context)) :end)))
|
|
)
|
|
(ov beg end 'face (list :background bg
|
|
:foreground fg))
|
|
(setq seq (cddr seq)))))) ;; remove first element from list
|
|
|
|
(defvar-local my-org-table-cell-color-list
|
|
nil
|
|
"Plist of table names with list of cells to color.
|
|
It is used for the function `my-org-table-cell-color-var'.
|
|
Example usage:
|
|
(my-plist-put my-org-table-cell-color-list 'table-name '(\"@23$3\" \"blue\"))
|
|
(setq my-org-table-cell-color-list '(
|
|
table-name-1 (
|
|
\"@33$3\" \"blue\"
|
|
\"@34$2\" \"red\"
|
|
\"@34$3\" \"green\"
|
|
)
|
|
table-name-2 (\"@13$3\" \"blue\" \"@14$2\" \"red\" \"@14$3\" \"green\")
|
|
))")
|
|
|
|
(defun my-org-table-cell-color-var ()
|
|
"Function to color cells.
|
|
It uses the variable `my-org-table-cell-color-list'.
|
|
Example usage to add a (normal, global) hook:
|
|
(add-hook 'org-ctrl-c-ctrl-c-hook 'my-org-table-cell-color-var)
|
|
Example usage to add a local hook:
|
|
(add-hook 'org-ctrl-c-ctrl-c-hook 'my-org-table-cell-color-var nil t)"
|
|
(let* ((table (my-org-table-get)) ;; get table element
|
|
(table-name (plist-get table :name))) ;; get table name (string)
|
|
(cond
|
|
(table-name ;; only if table found
|
|
(let ((begcont (plist-get table :contents-begin)) ;; :begin at the beginning of #+NAME:, #+ATTR_...
|
|
(endcont (plist-get table :contents-end)) ;; :end at the end of #+TBLFM: ...
|
|
(tmp-list (plist-get my-org-table-cell-color-list (intern table-name)))) ;; get value of key (string to symbol)
|
|
(my-org-table-cell-color begcont endcont tmp-list))))))
|
|
|
|
(defun my-org-table-cell-color-attr ()
|
|
"Function to color cells.
|
|
It uses the Org keyword #+ATTR_COLOR: CELL COLOR ...
|
|
COLOR is either a color name (see `list-colors-display') or a
|
|
Multiple #+ATTR_COLOR are possible. They are joint together.
|
|
Example usage to add a (normal, global) hook:
|
|
(add-hook 'org-ctrl-c-ctrl-c-hook 'my-org-table-cell-color-attr)
|
|
Example usage to add a local hook:
|
|
(add-hook 'org-ctrl-c-ctrl-c-hook 'my-org-table-cell-color-attr nil t)
|
|
Example usage
|
|
#+ATTR_COLOR: @1$3 #0055aa @1$1 #887744 @1$2 #008822
|
|
#+ATTR_COLOR: @2$3 blue @2$1 yellow @2$2 green
|
|
#+ATTR_COLOR: @3$1..@4$3 #cc0000 @5$3 red
|
|
"
|
|
(let* ((table (my-org-table-get)) ;; get table element
|
|
(table-attr (plist-get table :attr_color))) ;; nil if attr not set, table can be nil
|
|
(cond
|
|
(table-attr ;; only if table attr found
|
|
(let ((begcont (plist-get table :contents-begin)) ;; :begin at the beginning of #+NAME:, #+ATTR_...
|
|
(endcont (plist-get table :contents-end)) ;; :end at the end of #+TBLFM: ...
|
|
(color-list
|
|
(my-org-table-list-of-range-to-list
|
|
(my-org-attr-to-list table-attr))))
|
|
(my-org-table-cell-color begcont endcont color-list))))))
|
|
|
|
;; colored text in org-mode using links
|
|
;; http://kitchingroup.cheme.cmu.edu/blog/2016/01/16/Colored-text-in-org-mode-with-export-to-HTML/
|
|
;; https://en.wikibooks.org/wiki/LaTeX/Colors
|
|
;; this will be evaluated during export
|
|
(require 'ol)
|
|
(require 'color)
|
|
(require 'ov)
|
|
(org-link-set-parameters
|
|
"color"
|
|
:follow
|
|
;;(org-add-link-type
|
|
;; "color"
|
|
'(lambda (path)
|
|
"No follow action.")
|
|
:export
|
|
'(lambda (color description backend)
|
|
"if link description is empty use color as description.
|
|
[[color:COLOR][DESCRIPTION]]"
|
|
(cond
|
|
((eq backend 'html)
|
|
(let ((rgb (color-name-to-rgb color))
|
|
r g b)
|
|
(if rgb
|
|
(progn
|
|
(setq r (truncate (* 255 (nth 0 rgb))))
|
|
(setq g (truncate (* 255 (nth 1 rgb))))
|
|
(setq b (truncate (* 255 (nth 2 rgb))))
|
|
(format "<span style=\"color: rgb(%s,%s,%s)\">%s</span>"
|
|
r g b
|
|
(or description color)))
|
|
(format "No Color RGB for %s" color))))
|
|
((eq backend 'latex)
|
|
(let ((rgb (color-name-to-rgb color)))
|
|
(if rgb
|
|
(progn
|
|
(format "\\textcolor[rgb]{%s,%s,%s}{%s}"
|
|
(nth 0 rgb) (nth 1 rgb) (nth 2 rgb)
|
|
(or description color)))
|
|
(format "No Color RGB for %s" color))))
|
|
)))
|
|
(defun my-org-link-color (limit)
|
|
"Helper function for colored text in buffer.
|
|
Usage:
|
|
[[color:gray][text]]
|
|
[[color:#cccccc][text]]"
|
|
(when (re-search-forward
|
|
"color:[#0-9a-zA-Z]\\{2,\\}" limit t)
|
|
(forward-char -2)
|
|
(let ((link (org-element-context))
|
|
color beg end post-blanks)
|
|
(if link
|
|
(progn
|
|
(setq color (org-element-property :path link)
|
|
beg (org-element-property :begin link)
|
|
end (org-element-property :end link)
|
|
post-blanks (org-element-property :post-blank link))
|
|
(set-match-data
|
|
(list beg
|
|
(- end post-blanks)))
|
|
(ov-clear beg end 'color)
|
|
(ov beg
|
|
(- end post-blanks)
|
|
'color t
|
|
'face
|
|
`((:foreground ,color)))
|
|
(goto-char end))
|
|
(goto-char limit)
|
|
nil))))
|
|
(defun my-org-link-color-hook ()
|
|
"activate with e.g. (add-hook 'org-mode-hook 'my-org-link-color-hook)"
|
|
(font-lock-add-keywords
|
|
nil
|
|
'((my-org-link-color (0 'org-link t)))
|
|
t)
|
|
)
|
|
|
|
) ;; with-eval-after-load 'org
|
|
|
|
(provide 'my)
|
|
;;; my.el ends here
|