emacs/lisp/mitch-orgstuff.el

;;; mitch-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:

(defvar org-directory (expand-file-name "org/" "~"))
(defvar org-agenda-files '("~/org/"))
(defvar org-vw-dir org-directory) ;; whoops
(defvar org-wiki-regex "\\`[^.].*\\.org\\'")

(defun org-vw-get-filename (word)
  "Given WORD, generate the absolute filename for that org-vw entry."
  (expand-file-name (format "%s.org" (downcase word)) org-vw-dir))
;; (org-vw-get-filename "wordWERD")

(defun org-vw-make-newlink ()
  "Make the word at point the link to an org file, like in VimWiki."
  (interactive)
  (let* ((oldpoint (point))
	 (current-word (thing-at-point 'word 'no-properties))
	 (cw-file-name (org-vw-get-filename 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 mitch/org-dwim-char-chars)
    (general-define-key
     :keymaps 'local
     key 'mitch/org-dwim-char))
  )
;; (add-to-list 'auto-mode-alist `(,org-wiki-regex . org-vw-mode))
(add-hook 'org-mode-hook #'org-vw-mode)

(defun mitch-insert-current-datetime ()
  "Insert the current date and time in my preffered format, with a newline at
the end."
  (interactive)
  (let ((calendar-date-display-form calendar-iso-date-display-form))
    (insert
     (downcase
      (format "%s %s\n" (calendar-date-string (calendar-current-date))
	      (format-time-string "%-l:%M %p"))))))
(defun mitch-1st-heading-now ()
  "Insert a brand new 2nd level Org heading containing the current date/time.
Start insert mode."
  (interactive)
  (goto-char (point-max))
  (insert "* ")
  (mitch-insert-current-datetime)
  (evil-insert 1))

;; ------------------ ABANDON ALL SANITY, YE WHO ENTER HERE --------------------

(defvar mitch/org-dwim-char-chars '("_" "/" "*" "+" "~" "="))
(defun mitch/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 word
	 (beginning-of-word-test '(or (bolp) (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 (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)))
	    ;; (pcase charstr
	    ;;   ;; TODO: can we not hard-code this?
	    ;;   ;; MAYBE: with Advice on each below function.
	    ;;   ;; MAYBE: with `key-binding' fn
	    ;;   ("_" (call-interactively 'evil-next-line-1-first-non-blank))
	    ;;   ("/" (call-interactively 'evil-search-forward))
	    ;;   ("*" (call-interactively 'evil-search-word-forward))
	    ;;   ("+" (call-interactively 'evil-next-line-first-non-blank))
	    ;;   ("~" (call-interactively 'evil-invert-char))
	    ;;   ("=" (call-interactively 'evil-indent)))
	    (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))
     (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 `mitch/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)))
		  mitch/org-dwim-char-chars))))
(add-hook 'org-vw-pre-hook #'org-vw-snapshot-bindings nil 'local)
;; (setq debug-on-error t)
;; --------- LET THY BRAIN NO LONGER TREMBLE, FOR I AM BECOME COMPLETE ---------

(provide 'mitch-orgstuff)
;;; mitch-orgstuff.el ends here