294 lines
10 KiB
EmacsLisp
294 lines
10 KiB
EmacsLisp
;;; mir-orgstuff.el --- Hacking on top of Org mode.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Some of the things I want to do with org aren't built-in or intended. This
|
|
;; file is the cum total of my intent to implement these things.
|
|
|
|
;;; Code:
|
|
|
|
(require 'dash)
|
|
(require 'f)
|
|
(require 'ox-publish)
|
|
(require 'hyperbole)
|
|
|
|
(defvar org-directory (expand-file-name "org/" "~"))
|
|
(defvar org-agenda-files '("~/org/"))
|
|
(defvar org-vw-staging-dir "/unicron_shared/webbed-site/staging/")
|
|
(defvar org-vw-export-dir "/unicron_shared/webbed-site/public/")
|
|
(defvar org-wiki-regex "\\`[^.].*\\.org\\'")
|
|
(defvar org-vw--link-re (rx "[[" (* any) (+ alnum)
|
|
".org][" (* any) "]]"))
|
|
|
|
;; need to make a hyperbole
|
|
(add-to-list 'hkey-alist '((and
|
|
(eq major-mode 'org-mode)
|
|
(not (smart-org)))
|
|
. ((org-vw-make-newlink) . nil)))
|
|
|
|
;; ------------------- links and exporting -------------------------------------
|
|
(defun org-vw-link-at-point ()
|
|
(interactive)
|
|
(save-match-data
|
|
(string-match org-vw--link-re (thing-at-point 'line))
|
|
(with-current-buffer (
|
|
;; it was at this point that she gave up from scratch
|
|
))
|
|
(buffer-substring-no-properties match-beginning match-end)))
|
|
(defun org-vw--get-link-basename (link)
|
|
(if (string-match-p org-vw--link-re link)
|
|
(--> link
|
|
(split-string it "]\\[")
|
|
(car it)
|
|
(string-trim it "\\[\\[" "]]")
|
|
(string-trim-right it "/index\.org$"))
|
|
(error "malformed link, what are you doing")))
|
|
;; (org-vw--get-link-basename "[[lasdfjl/index.org][asdlkfj]]")
|
|
(defun fix-links-temporarily-in-current-buffer ()
|
|
"Run every link thru `org-vw-preexp-link'."
|
|
(interactive)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (save-excursion
|
|
(re-search-forward
|
|
org-vw--link-re nil 'no-error))
|
|
(goto-char (match-beginning 0))
|
|
(org-vw-preexp-link))))
|
|
(string-match-p org-vw--link-re
|
|
"[[maybe-not.org][maybe not]]")
|
|
(defun htmlize-current-buffer-to-file (file)
|
|
"Run `htmlize-buffer' and save the result to FILE."
|
|
(interactive "sWrite to file: ")
|
|
(with-current-buffer (htmlize-buffer)
|
|
(write-file file)
|
|
(kill-buffer (current-buffer))))
|
|
(defun mir/export-buffer-to-html-fixed-links (file)
|
|
"Synthesis of `fix-links-temporarily-in-current-buffer' and `htmlize-current-buffer-to-file'. FILE is to be written."
|
|
(interactive "sExport to file: ")
|
|
(ignore-errors
|
|
(evil-with-single-undo
|
|
(fix-links-temporarily-in-current-buffer)
|
|
(htmlize-current-buffer-to-file file))
|
|
(evil-undo-pop)) ;todo later: can we wrap in something less evil?
|
|
)
|
|
(defun org-vw-get-index-name (source basedir)
|
|
"Given SOURCE, return the org link pointing to the corresponding html."
|
|
(let* ((basename (file-name-directory source)))
|
|
(if (string= (expand-file-name "index" basedir) basename)
|
|
"./"
|
|
(progn
|
|
;; (ignore-errors (mkdir (format "%s/%s/" basedir basename) t))
|
|
(format "./%s/" basename)) )))
|
|
;; (file-name-directory "test/index.tft")
|
|
|
|
;; big folder level export
|
|
(defun all-orgs-mds-in-dir (dir)
|
|
"Return a list of every markdown and org file in DIR."
|
|
(let ((default-directory dir))
|
|
(--remove
|
|
(or
|
|
(f-directory-p it)
|
|
(not (or
|
|
(string= (f-ext it) "md")
|
|
(string= (f-ext it) "org")
|
|
))
|
|
)
|
|
(f-entries dir nil t))))
|
|
;; (all-orgs-mds-in-dir "/unicron_shared/webbed-site/public/")
|
|
;; loop over this
|
|
|
|
(defun do-file-in-sitedir (file sitedir)
|
|
"too tired to write words. only code sry"
|
|
(with-current-buffer (or (get-file-buffer file) (find-file file))
|
|
(mir/export-buffer-to-html-fixed-links
|
|
(org-vw-get-index-name file sitedir))))
|
|
(defun org-vw-export ()
|
|
"htmlize recursively all org files in SITEDIR."
|
|
(interactive "sDirectory (leave blank for current): ")
|
|
(let* ((orgs-mds (all-orgs-mds-in-dir org-vw-staging-dir)))
|
|
(message "------- org and markdown files: %s" orgs-mds)
|
|
(--map
|
|
(progn
|
|
(message "operating on %s" it)
|
|
(do-file-in-sitedir it (org-vw-get-index-name it sitedir)))
|
|
orgs-mds)
|
|
))
|
|
|
|
;; --------------------
|
|
|
|
;; --------------------- below be dragons --------------------------------------
|
|
|
|
(defun org-vw-preexp-link ()
|
|
"Re-format the next instance of name.org to name/ ."
|
|
(let* ((link-regex org-vw--link-re)
|
|
(endpoint (re-search-forward link-regex))
|
|
(startpoint (re-search-backward link-regex))
|
|
(old-link-text (buffer-substring-no-properties startpoint endpoint))
|
|
(old-link-components
|
|
(--map (string-trim it (rx (+ "[")) (rx (+ "]")))
|
|
(split-string old-link-text "]\\[" t)))
|
|
(new-link-components
|
|
(list (org-vw-get-index-name
|
|
(car old-link-components)
|
|
org-vw-export-dir
|
|
;; default-directory ; figure because we're necessarily in the buffer right?
|
|
)
|
|
(cadr old-link-components)))
|
|
(new-link-text (format "[[%s][%s]]"
|
|
(car new-link-components)
|
|
(cadr new-link-components)))
|
|
(length-diff (- (length old-link-text) (length new-link-text))))
|
|
(delete-region startpoint endpoint)
|
|
(insert new-link-text)
|
|
)
|
|
)
|
|
;; ----------- that was a big dragon. carry on ---------------------------------
|
|
|
|
(defun org-vw-named-index-org (word)
|
|
"given word, generate the absolute filename for that org-vw entry."
|
|
(expand-file-name
|
|
(format "%s/index.org" (downcase word)) org-vw-staging-dir))
|
|
|
|
(defun org-vw-make-newlink ()
|
|
"Make the word at point the link to an org file, like in VimWiki."
|
|
(interactive)
|
|
;; todo: can we use `save-excusion' ?
|
|
(let* ((oldpoint (point))
|
|
(current-word (thing-at-point 'word 'no-properties))
|
|
(cw-file-name (org-vw-named-index-org current-word)))
|
|
(backward-word)
|
|
(kill-word 1)
|
|
(org-insert-link nil cw-file-name current-word)
|
|
(goto-char oldpoint)))
|
|
;; (org-insert-link nil "~/" "a file or sth")
|
|
|
|
;; (defun org-vw-show-markup () ;;broken, just use org-appear or sth
|
|
;; "When on a line containing hidden characters, show them."
|
|
;; (interactive)
|
|
;; (let ((point (point))
|
|
;; (bol (point-at-bol))
|
|
;; (eol (point-at-eol)))
|
|
;; (remove-text-properties bol eol
|
|
;; '(invisible nil))
|
|
;; t))
|
|
(defun org-vw-back ()
|
|
"Go back to the previous org file and bury this buffer."
|
|
(interactive)
|
|
(if (buffer-modified-p)
|
|
(if (y-or-n-p "Do you want to save this file?")
|
|
(save-buffer)))
|
|
(bury-buffer)
|
|
(other-window 1))
|
|
|
|
(defvar org-vw-pre-hook nil
|
|
"Hook to run before org-vw-mode has been loaded.")
|
|
(define-minor-mode org-vw-mode
|
|
"Org VimWiki mode."
|
|
:lighter " VW"
|
|
:keymap (make-sparse-keymap)
|
|
(run-hooks org-vw-pre-hook)
|
|
;; TODO: This is a hack, because hyperbole is scary. Ideal implementation
|
|
;; would add a proper case rather than this weird fallback.
|
|
;; (require 'hyperbole)
|
|
;; (make-local-variable action-key-default-function)
|
|
;; (setq-local action-key-default-function #'org-vw-make-newlink)
|
|
;; General:
|
|
(general-define-key
|
|
:keymaps 'local
|
|
:states 'normal
|
|
"DEL" 'org-vw-back)
|
|
(dolist (key mir/org-dwim-char-chars)
|
|
(general-define-key
|
|
:keymaps 'local
|
|
key 'mir/org-dwim-char))
|
|
)
|
|
;; (add-to-list 'auto-mode-alist `(,org-wiki-regex . org-vw-mode))
|
|
(add-hook 'org-mode-hook #'org-vw-mode)
|
|
|
|
;; ------------------ ABANDON ALL SANITY, YE WHO ENTER HERE --------------------
|
|
|
|
(defvar mir/org-dwim-char-chars '("_" "/" "*" "+" "~" "="))
|
|
(defun mir/org-dwim-char (&optional char)
|
|
"If a region is active (visual mode), surround selection with CHAR.
|
|
|
|
If in a word, surround it with CHAR (like `evil-surround') or, if word is
|
|
already surrounded with CHAR, un-surround it. If on the first character of a
|
|
word, run the default function that Evil binds the key CHAR to.
|
|
|
|
If the next character is the same as CHAR, move cursor past it \(like
|
|
`electric-pair').
|
|
|
|
If the line is a block delimiter or heading, or when in a protected block \(see
|
|
variable `org-protecting-blocks') or properties drawer, just insert the
|
|
character CHAR.
|
|
|
|
Otherwise, insert two of CHAR and put point between them like `electric-pair'."
|
|
(interactive) ; TODO: can we make CHAR an arg to `interactive'?
|
|
(let* ((char (or char (string-to-char (this-command-keys))))
|
|
(word (thing-at-point 'word 'no-properties))
|
|
;;; test conditions here to be eval'd, separating flow from data
|
|
;; at beginning of line
|
|
(beginning-of-line-test '(bolp))
|
|
;; at beginning of word
|
|
(beginning-of-word-test `(or ,beginning-of-line-test
|
|
(eq (char-before (point)) ?\ )))
|
|
;; word is surrounded by `char'
|
|
(surrounded-by-char-test
|
|
'(and (eq (char-before (beginning-of-thing 'word)) char)
|
|
(eq (char-after (end-of-thing 'word)) char)))
|
|
;; char before and char after are the same
|
|
(double-char-test (eq char (char-after)))
|
|
;; Weird Org exceptions because org
|
|
(org-exceptions-test
|
|
'(or (and (bolp)
|
|
(string-match-p (rx bol (or "#" "*"))
|
|
(thing-at-point 'line 'no-properties)))
|
|
(org-in-block-p org-protecting-blocks)
|
|
(org-at-property-p))))
|
|
(cond
|
|
((eq evil-state 'visual)
|
|
(let* ((beg (region-beginning))
|
|
(end (region-end)))
|
|
(evil-surround-region beg end evil-visual-selection char nil)))
|
|
((eq evil-state 'normal)
|
|
(if (eval beginning-of-word-test)
|
|
;; run original function bound to key
|
|
(let ((charstr (make-string 1 char)))
|
|
(call-interactively (alist-get charstr org-vw-old-binds-alist
|
|
nil nil #'string=)))
|
|
(save-excursion
|
|
(if (eval surrounded-by-char-test)
|
|
(progn
|
|
(search-backward (char-to-string char)) (delete-char 1)
|
|
(search-forward (char-to-string char)) (delete-char -1))
|
|
(evil-with-single-undo
|
|
(beginning-of-thing 'word)
|
|
(insert char)
|
|
(end-of-thing 'word)
|
|
(insert char))))))
|
|
((eval double-char-test) (right-char))
|
|
((eval org-exceptions-test) (insert char))
|
|
((and (eval beginning-of-line-test) (eq char ?*))
|
|
(insert char))
|
|
(t (progn
|
|
(insert (make-string 2 char))
|
|
(left-char))))))
|
|
(defun org-vw-snapshot-bindings ()
|
|
"Make an alist of the functions formerly ran by keys to be bound to `mir/org-dwim-char'.
|
|
|
|
Store it in the variable `org-vw-old-binds-alist'."
|
|
(unless org-vw-old-binds-alist
|
|
(defvar-local org-vw-old-binds-alist
|
|
(mapcar (lambda (key)
|
|
(cons key (key-binding key)))
|
|
mir/org-dwim-char-chars))))
|
|
(add-hook 'org-vw-pre-hook #'org-vw-snapshot-bindings nil 'local)
|
|
|
|
;; (defun org-vw-backspace)
|
|
|
|
;; (setq debug-on-error t)
|
|
;; --------- LET THY BRAIN NO LONGER TREMBLE, FOR I AM BECOME COMPLETE ---------
|
|
|
|
(provide 'mir-orgstuff)
|
|
;;; mir-orgstuff.el ends here
|