Sacha Chua's Emacs configuration

Table of Contents


About this file

This is my personal config. It's really long, but that's partly because I sometimes leave blog posts in it as commentary. (And also because I've got a lot of little customizations that I might not even remember. =) ). If you want to see a table of contents and other useful niceties, go to . Other links for this page: Org Mode version, Github repository

If you're new to Emacs Lisp, you probably don't want to copy and paste large chunks of this code. Instead, copy small parts of it (always making sure to copy a complete set of parentheses) into your *scratch* buffer or some other buffer in emacs-lisp-mode. Use M-x eval-buffer to evaluate the code and see if you like the way that Emacs behaves. See An Introduction to Programming in Emacs Lisp for more details on Emacs Lisp. You can also find the manual by using C-h i (info) and choosing "Emacs Lisp Intro".

I've installed a lot of packages. See the section to add the repositories to your configuration. When you see use-package and a package name you might like, you can use M-x package-install to install the package of that name. Note that use-package is itself provided by a package, so you'll probably want to install that and bind-key.

If you're viewing the Org file, you can open source code blocks (those are the ones in begin_src) in a separate buffer by moving your point inside them and typing C-c ' (org-edit-special). This opens another buffer in emacs-lisp-mode, so you can use M-x eval-buffer to load the changes. If you want to explore how functions work, use M-x edebug-defun to set up debugging for that function, and then call it. You can learn more about edebug in the Emacs Lisp manual.

I like using (setq ...) more than Customize because I can neatly organize my configuration that way. Ditto for use-package - I mostly use it to group together package-related config without lots of with-eval-after-load calls, and it also makes declaring keybindings easier.

My ~/.emacs.d/init.el is now a symlink to Sacha.el, which is what M-x org-babel-tangle (C-c C-v t) produces. A note about Org updates: I like running Org Mode from checked-out source code instead of package.el. I add the Lisp directories to my load-path, and I also use the :load-path option in my first use-package org call to set the load path. One of those is probably doing the trick and the other one is redundant, but maybe it's a belt-and-suspenders sort of thing. Using the git checkout also makes upgrading Org easy. All I have to do is git pull; make, and stuff happens in an external Emacs process. Since I create Sacha.el via org-babel-tangle, my Emacs config can load Sacha.el without loading Org first.

Starting up

Here's how we start:

;; This sets up the load path so that we can override it
(setq use-package-always-ensure t)
(add-to-list 'load-path "~/Dropbox/2014/presentations/org-reveal")
(add-to-list 'load-path "/usr/local/share/emacs/site-lisp")
(setq custom-file "~/.emacs.d/custom-settings.el")
(load custom-file t)

System information

(defun my/laptop-p ()
  (equal (system-name) "sacha-kubuntu"))
(defun my/server-p ()
  (and (equal (system-name) "localhost") (equal user-login-name "sacha")))
(defun my/phone-p ()
  (and (equal (system-name) "localhost") (not (equal user-login-name "sacha"))))
(when (my/phone-p) (setq gnutls-algorithm-priority "NORMAL:-VERS-TLS1.3"))
(global-auto-revert-mode)  ; simplifies syncing

Personal information

(setq user-full-name "Sacha Chua"
      user-mail-address "")

Emacs initialization

Add package sources

(unless (assoc-default "melpa" package-archives)
  (add-to-list 'package-archives '("melpa" . "") t))
(unless (assoc-default "org" package-archives)
  (add-to-list 'package-archives '("org" . "") t))

Use M-x package-refresh-contents to reload the list of packages after adding these for the first time.

Add my elisp directory and other files

Sometimes I load files outside the package system. As long as they're in a directory in my load-path, Emacs can find them.

(add-to-list 'load-path "~/elisp")
(unless (package-installed-p 'use-package)
  (package-install 'use-package))
(setq use-package-verbose t)
(setq use-package-always-ensure t)
(require 'use-package)
(use-package auto-compile
  :config (auto-compile-on-load-mode))
(setq load-prefer-newer t)

Load secrets

I keep slightly more sensitive information in a separate file so that I can easily publish my main configuration.

(load "~/.emacs.secrets" t)

General configuration


(defun my/reload-emacs-configuration ()
  (load-file "~/.emacs.d/init.el"))


(use-package dash :ensure t)
(use-package diminish :ensure t)


This is one of the things people usually want to change right away. By default, Emacs saves backup files in the current directory. These are the files ending in ~ that are cluttering up your directory lists. The following code stashes them all in ~/.emacs.d/backups, where I can find them with C-x C-f (find-file) if I really need to.

(setq backup-directory-alist '(("." . "~/.emacs.d/backups")))

Disk space is cheap. Save lots.

(setq delete-old-versions -1)
(setq version-control t)
(setq vc-make-backup-files t)
(setq auto-save-file-name-transforms '((".*" "~/.emacs.d/auto-save-list/" t)))



(setq savehist-file "~/.emacs.d/savehist")
(savehist-mode 1)
(setq history-length t)
(setq history-delete-duplicates t)
(setq savehist-save-minibuffer-history 1)
(setq savehist-additional-variables

Windows configuration   drill

When you're starting out, the tool bar can be very helpful. (Emacs Basics: Using the Mouse). Eventually, you may want to reclaim that extra little bit of screenspace. The following code turns that thing off. (Although I changed my mind about the menu - I want that again.)

(tool-bar-mode -1)

Time in the modeline

I like having the clock.

(display-time-mode 1)

Winner mode - undo and redo window configuration

winner-mode lets you use C-c <left> and C-c <right> to switch between window configurations. This is handy when something has popped up a buffer that you want to look at briefly before returning to whatever you were working on. When you're done, press C-c <left>.

(use-package winner
  :defer t)

Sentences end with a single space

In my world, sentences end with a single space. This makes sentence navigation commands work for me.

(setq sentence-end-double-space nil)

Helm - interactive completion

Helm makes it easy to complete various things. I find it to be easier to configure than ido in order to get completion in as many places as possible, although I prefer ido's way of switching buffers.

(use-package helm
  :diminish helm-mode
    (require 'helm-config)
    (setq helm-candidate-number-limit 100)
    ;; From
    (setq helm-idle-delay 0.0 ; update fast sources immediately (doesn't).
          helm-input-idle-delay 0.01  ; this actually updates things
                                        ; reeeelatively quickly.
          helm-yas-display-key-on-candidate t
          helm-quick-update t
          helm-M-x-requires-pattern nil
          helm-ff-skip-boring-files t)
  :bind (("C-c h" . helm-mini)
         ("C-h a" . helm-apropos)
         ("C-x C-b" . helm-buffers-list)
         ("C-x b" . helm-buffers-list)
         ("M-y" . helm-show-kill-ring)
         ("M-x" . helm-M-x)
         ("C-x c o" . helm-occur)
         ("C-x c s" . helm-swoop)
         ("C-x c y" . helm-yas-complete)
         ("C-x c Y" . helm-yas-create-snippet-on-region)
         ("C-x c b" . my/helm-do-grep-book-notes)
         ("C-x c SPC" . helm-all-mark-rings)))
(ido-mode -1) ;; Turn off ido mode in case I enabled it accidentally

Great for describing bindings. I'll replace the binding for where-is too.

(use-package helm-descbinds
  :defer t
  :bind (("C-h b" . helm-descbinds)
         ("C-h w" . helm-descbinds)))

helm-grep? Bit slow and hard to read, though.

(defvar my/book-notes-directory "~/Dropbox/books")
(defun my/helm-do-grep-book-notes ()
  "Search my book notes."
  (helm-do-grep-1 (list my/book-notes-directory)))
Getting Helm and org-refile to clock in or create tasks   emacs org helm

I've been thinking about how to improve the way that I navigate to, clock in, and create tasks in Org Mode. If the task is one of the ones I've planned for today, I use my Org agenda. If I know that the task exists, I use C-u C-c C-w (org-refile) to jump to it, and then ! (one of my org-speed-commands-user options) to clock in and track it on Quantified Awesome. If I want to resume an interrupted task, I use C-u C-c j (my shortcut for org-clock-goto). For new tasks, I go to the appropriate project entry and create it, although I really should be using org-capture instead.

2015-01-30 Org Mode jumping to tasks – index card #emacs #org

I thought about how I can reduce some of these distinctions. For example, what if it didn't matter whether or not a task already exists? I can modify the org-refile interface to make it easier for me to create tasks if my description doesn't match anything. To make things simpler, I'll just reuse one of my org-capture-templates, and I'll pre-fill it with the candidate from Helm.

(ert-deftest my/org-capture-prefill-template ()
   ;; It should fill things in one field at ia time
     "* TODO %^{Task}\nSCHEDULED: %^t\n:PROPERTIES:\n:Effort: %^{effort|1:00|0:05|0:15|0:30|2:00|4:00}\n:END:\n%?\n"
     "Hello World")
    "* TODO Hello World\nSCHEDULED: %^t\n:PROPERTIES:\n:Effort: %^{effort|1:00|0:05|0:15|0:30|2:00|4:00}\n:END:\n%?\n"
     "* TODO %^{Task}\nSCHEDULED: %^t\n:PROPERTIES:\n:Effort: %^{effort|1:00|0:05|0:15|0:30|2:00|4:00}\n:END:\n%?\n"
     "Hello World" "<2015-01-01>")
    "* TODO Hello World\nSCHEDULED: <2015-01-01>\n:PROPERTIES:\n:Effort: %^{effort|1:00|0:05|0:15|0:30|2:00|4:00}\n:END:\n%?\n"))
     "* TODO %^{Task}\nSCHEDULED: %^t\n:PROPERTIES:\n:Effort: %^{effort|1:00|0:05|0:15|0:30|2:00|4:00}\n:END:\n%?\n"
     "Hello World" "<2015-01-01>" "0:05")
    "* TODO Hello World\nSCHEDULED: <2015-01-01>\n:PROPERTIES:\n:Effort: 0:05\n:END:\n%?\n")))

(declare-function org-capture-get "org-capture")
(defun my/org-capture-prefill-template (template &rest values)
  "Pre-fill TEMPLATE with VALUES."
  (setq template (or template (org-capture-get :template)))
    (insert template)
    (goto-char (point-min))
    (while (re-search-forward
            (concat "%\\("
                    "\\)") nil t)
      (if (car values)
          (replace-match (car values) nil t))
      (setq values (cdr values)))

(defun my/org-get-current-refile-location ()
  "Return the current entry as a location understood by org-refile."
  (list (elt (org-heading-components) 4)
        (or buffer-file-name
            (with-current-buffer (buffer-base-buffer (current-buffer))

(defun my/helm-org-create-task (candidate)
  "Creates the task and returns the location."
  (let ((entry (org-capture-select-template "T")))
    (org-capture-set-plist entry)
    (condition-case error
            (my/org-capture-prefill-template (org-capture-get :template)
           (equal (car (org-capture-get :target)) 'function))
          (setq org-refile-target-table (org-refile-get-targets))
          ;; Return the new location
      ((error quit)
       (if (get-buffer "*Capture*") (kill-buffer "*Capture*"))
       (error "Capture abort: %s" error)))))

;; (my/org-refile-get-location-by-substring "Try again")

Next, I want to add this to the way that Helm prompts me to refile. That means that my creation task should return something ready for org-refile. Actually, maybe I don't have to do that if I know I'm always going to call it when I want to jump to something. I might as well add that bit of code that sets up clocking in, too.

    (defvar my/helm-org-refile-locations nil)
    (defvar my/org-refile-last-location nil)

    (defun my/helm-org-clock-in-and-track-from-refile (candidate)
(let ((location (org-refile--get-location candidate my/helm-org-refile-locations)))
    (org-refile 4 nil location)

  (defun my/org-get-todays-items-as-refile-candidates ()
    "Return items scheduled for today, ready for choosing during refiling."
(lambda (s)
  (if (get-text-property 0 'org-marker s)
       (buffer-file-name (marker-buffer (get-text-property 0 'org-marker s)))
       (marker-position (get-text-property 0 'org-marker s)))))
(save-window-excursion (my/org-get-entries-fn (calendar-current-date) (calendar-current-date))))))

  ;; Based on
  (defun my/org-get-entries-fn (begin end)
  "Return org schedule items between BEGIN and END.
  USAGE:  (org-get-entries-fn '(6 1 2015) '(6 30 2015))"
    (require 'calendar)
    (require 'org)
    (require 'org-agenda)
    (require 'cl)
    (calendar-date-is-valid-p begin)
    (calendar-date-is-valid-p end))
(let ((debug-on-quit nil))
  (signal 'quit `("One or both of your gregorian dates are invalid."))))
    (let* (
  (org-agenda-entry-types '(:scheduled))
    (lambda (date num)
      "Return the date after NUM days from DATE."
       (+ (calendar-absolute-from-gregorian date) num))))
    (lambda (begin end)
      "Enumerate date objects between BEGIN and END."
      (when (> (calendar-absolute-from-gregorian begin)
         (calendar-absolute-from-gregorian end))
  (error "Invalid period : %S - %S" begin end))
      (let ((d begin) ret (cont t))
  (while cont
    (push (copy-sequence d) ret)
    (setq cont (not (equal d end)))
    (setq d (funcall date-after d 1)))
  (nreverse ret)))) )
(setq org-agenda-buffer
  (when (buffer-live-p org-agenda-buffer)
(org-compile-prefix-format nil)
(setq result
  (loop for date in (funcall enumerate-days begin end) append
    (loop for file in (org-agenda-files nil 'ifmode)
  (org-check-agenda-file file)
  (apply 'org-agenda-get-day-entries file date org-agenda-entry-types)))))
(unless (buffer-live-p (get-buffer org-agenda-buffer-name))
  (get-buffer-create org-agenda-buffer-name))
(with-current-buffer (get-buffer org-agenda-buffer-name)
  (setq buffer-read-only t)
  (let ((inhibit-read-only t))
    (lambda (x)
      (let ((inhibit-read-only t))
  (insert (format "%s" x) "\n")))
  ;;    (display-buffer org-agenda-buffer-name t)

    (defun my/helm-org-refile-read-location (tbl)
(setq my/helm-org-refile-locations tbl)
  ;; (helm-build-sync-source "Today's tasks"
  ;;   :candidates (mapcar (lambda (a) (cons (car a) a))
  ;;                       (my/org-get-todays-items-as-refile-candidates))
  ;;   :action '(("Select" . identity)
  ;;             ("Clock in and track" . my/helm-org-clock-in-and-track-from-refile)
  ;;             ("Draw index card" . my/helm-org-prepare-index-card-for-subtree))
  ;;   :history 'org-refile-history)
  (helm-build-sync-source "Refile targets"
    :candidates (mapcar (lambda (a) (cons (car a) a)) tbl)
    :action '(("Select" . identity)
        ("Clock in and track" . my/helm-org-clock-in-and-track-from-refile)
        ("Draw index card" . my/helm-org-prepare-index-card-for-subtree))
    :history 'org-refile-history)
  (helm-build-dummy-source "Create task"
    :action (helm-make-actions
       "Create task"

    (defun my/org-refile-get-location (&optional prompt default-buffer new-nodes no-exclude)
"Prompt the user for a refile location, using PROMPT.
    PROMPT should not be suffixed with a colon and a space, because
    this function appends the default value from
    `org-refile-history' automatically, if that is not empty."
    (let ((org-refile-targets org-refile-targets)
    (org-refile-use-outline-path org-refile-use-outline-path))
(setq org-refile-target-table
      (org-refile-get-targets default-buffer))
(unless org-refile-target-table
  (user-error "No refile targets"))
(let* ((cbuf (current-buffer))
       (partial-completion-mode nil)
       (cfn (buffer-file-name (buffer-base-buffer cbuf)))
       (cfunc (if (and org-refile-use-outline-path
       (extra (if org-refile-use-outline-path "/" ""))
       (cbnex (concat (buffer-name) extra))
       (filename (and cfn (expand-file-name cfn)))
       (tbl (mapcar
       (lambda (x)
         (if (and (not (member org-refile-use-outline-path
             '(file full-file-path)))
      (not (equal filename (nth 1 x))))
       (cons (concat (car x) extra " ("
         (file-name-nondirectory (nth 1 x)) ")")
       (cdr x))
     (cons (concat (car x) extra) (cdr x))))
       (completion-ignore-case t)
       (prompt (concat prompt
           (or (and (car org-refile-history)
        (concat " (default " (car org-refile-history) ")"))
         (and (assoc cbnex tbl) (setq cdef cbnex)
        (concat " (default " cbnex ")"))) ": "))
       pa answ parent-target child parent old-hist)
  (setq old-hist org-refile-history)
  ;; Use Helm's sources instead
  (setq answ (my/helm-org-refile-read-location tbl))
   ((and (stringp answ)
   (setq pa (org-refile--get-location answ tbl)))
    (org-refile-check-position pa)
    (when (or (not org-refile-history)
        (not (eq old-hist org-refile-history))
        (not (equal (car pa) (car org-refile-history))))
      (setq org-refile-history
      (cons (car pa) (if (assoc (car org-refile-history) tbl)
           (cdr org-refile-history))))
      (if (equal (car org-refile-history) (nth 1 org-refile-history))
    (pop org-refile-history)))
    (setq my/org-refile-last-location pa)
   ((and (stringp answ) (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ))
    (setq parent (match-string 1 answ)
    child (match-string 2 answ))
    (setq parent-target (org-refile--get-location parent tbl))
    (when (and parent-target
         (or (eq new-nodes t)
       (and (eq new-nodes 'confirm)
      (y-or-n-p (format "Create new node \"%s\"? "
      (org-refile-new-child parent-target child)))
   ((listp answ) answ) ;; Sacha: Helm returned a refile location
   ((not (equal answ t))
    (user-error "Invalid target location"))))))

    (fset 'org-refile-get-location 'my/org-refile-get-location)

Hooray! Now C-u C-c C-w (org-refile) also lets me use TAB or F2 to select the alternative action of quickly clocking in on a task. Mwahaha.

I think I'm getting the hang of tweaking Helm. Yay!

Mode line format

Display a more compact mode line

(use-package smart-mode-line)

Change "yes or no" to "y or n"

Lazy people like me never want to type "yes" when "y" will suffice.

(fset 'yes-or-no-p 'y-or-n-p)

Minibuffer editing - more space!

Sometimes you want to be able to do fancy things with the text that you're entering into the minibuffer. Sometimes you just want to be able to read it, especially when it comes to lots of text. This binds C-M-e in a minibuffer) so that you can edit the contents of the minibuffer before submitting it.

(use-package miniedit
  :commands minibuffer-edit
  :init (miniedit-install))

Set up a light-on-dark color scheme

I like light on dark because I find it to be more restful. The color-theme in ELPA was a little odd, though, so we define some advice to make it work. Some things still aren't quite right.

(defun my/setup-color-theme ()
  (when (display-graphic-p) 
  (set-background-color "black")
  (set-face-foreground 'secondary-selection "darkblue")
  (set-face-background 'secondary-selection "lightblue")
  (set-face-background 'font-lock-doc-face "black")
  (set-face-foreground 'font-lock-doc-face "wheat")
  (set-face-background 'font-lock-string-face "black"))
(use-package color-theme-solarized :config (my/setup-color-theme))

I sometimes need to switch to a lighter background for screenshots. For that, I use color-theme-vim.

Some more tweaks to solarized:

(when window-system
   '(erc-input-face ((t (:foreground "antique white"))))
   '(helm-selection ((t (:background "ForestGreen" :foreground "black"))))
   '(org-agenda-clocking ((t (:inherit secondary-selection :foreground "black"))) t)
   '(org-agenda-done ((t (:foreground "dim gray" :strike-through nil))))
   '(org-done ((t (:foreground "PaleGreen" :weight normal :strike-through t))))
   '(org-clock-overlay ((t (:background "SkyBlue4" :foreground "black"))))
   '(org-headline-done ((((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon" :strike-through t))))
   '(outline-1 ((t (:inherit font-lock-function-name-face :foreground "cornflower blue"))))))

Undo tree mode - visualize your undos and branches

People often struggle with the Emacs undo model, where there's really no concept of "redo" - you simply undo the undo.

This lets you use C-x u (undo-tree-visualize) to visually walk through the changes you've made, undo back to a certain point (or redo), and go down different branches.

(use-package undo-tree
  :diminish undo-tree-mode
    (setq undo-tree-visualizer-timestamps t)
    (setq undo-tree-visualizer-diff t)))

Help - guide-key

It's hard to remember keyboard shortcuts. The guide-key package pops up help after a short delay.

(use-package guide-key
  :defer t
  :diminish guide-key-mode
  (setq guide-key/guide-key-sequence '("C-x r" "C-x 4" "C-c"))
  (guide-key-mode 1)))  ; Enable guide-key-mode



(prefer-coding-system 'utf-8)
(when (display-graphic-p)
  (setq x-select-request-type '(UTF8_STRING COMPOUND_TEXT TEXT STRING)))

Killing text


(defadvice kill-region (before slick-cut activate compile)
  "When called interactively with no active region, kill a single line instead."
    (if mark-active (list (region-beginning) (region-end))
      (list (line-beginning-position)
        (line-beginning-position 2)))))

Repeatable commands

Based on . Modified to accept nil as the first value if you don't want the keymap to run a command by default, and to use kbd for the keybinding definitions.

  (defun my/def-rep-command (alist)
    "Return a lambda that calls the first function of ALIST.
It sets the transient map to all functions of ALIST,
allowing you to repeat those functions as needed."
    (let ((keymap (make-sparse-keymap))
                  (func (cdar alist)))
      (mapc (lambda (x)
              (when x
                (define-key keymap (kbd (car x)) (cdr x))))
      (lambda (arg)
        (interactive "p")
        (when func
          (funcall func arg))
        (set-transient-map keymap t))))
TODO Look for opportunities to use this


Pop to mark

Handy way of getting back to previous places.

(bind-key "C-x p" 'pop-to-mark-command)
(setq set-mark-command-repeat-pop t)

Helm-swoop - quickly finding lines

This promises to be a fast way to find things. Let's bind it to Ctrl-Shift-S to see if I can get used to that…

(use-package helm-swoop
 (("C-S-s" . helm-swoop)
  ("M-i" . helm-swoop)
  ("M-s s" . helm-swoop)
  ("M-s M-s" . helm-swoop)
  ("M-I" . helm-swoop-back-to-last-point)
  ("C-c M-i" . helm-multi-swoop)
  ("C-x M-i" . helm-multi-swoop-all)
   (define-key isearch-mode-map (kbd "M-i") 'helm-swoop-from-isearch)
   (define-key helm-swoop-map (kbd "M-i") 'helm-multi-swoop-all-from-helm-swoop))

Windmove - switching between windows

Windmove lets you move between windows with something more natural than cycling through C-x o (other-window). Windmove doesn't behave well with Org, so we need to use different keybindings.

(use-package windmove
  (("<f2> <right>" . windmove-right)
   ("<f2> <left>" . windmove-left)
   ("<f2> <up>" . windmove-up)
   ("<f2> <down>" . windmove-down)

Frequently-accessed files

Registers allow you to jump to a file or other location quickly. To jump to a register, use C-x r j followed by the letter of the register. Using registers for all these file shortcuts is probably a bit of a waste since I can easily define my own keymap, but since I rarely go beyond register A anyway. Also, I might as well add shortcuts for refiling.

(defvar my/refile-map (make-sparse-keymap))

(defmacro my/defshortcut (key file)
     (set-register ,key (cons 'file ,file))
     (define-key my/refile-map
       (char-to-string ,key)
       (lambda (prefix)
         (interactive "p")
         (let ((org-refile-targets '(((,file) :maxlevel . 6)))
               (current-prefix-arg (or current-prefix-arg '(4))))
           (call-interactively 'org-refile))))))

  (define-key my/refile-map "," 'my/org-refile-to-previous-in-file)

(my/defshortcut ?e "~/.emacs.d/")
(my/defshortcut ?E "~/sync/emacs-news/")
(my/defshortcut ?f "~/code/font/")
(my/defshortcut ?i "~/orgzly/")
(my/defshortcut ?o "~/orgzly/")
(my/defshortcut ?s "~/personal/")
(my/defshortcut ?b "~/personal/")
(my/defshortcut ?p "~/personal/")
(my/defshortcut ?P "~/personal/")
(my/defshortcut ?B "~/Dropbox/books")
(my/defshortcut ?n "~/sync/notes")
(my/defshortcut ?N "~/sync/notes/")
(my/defshortcut ?w "~/Dropbox/public/sharing/")
(my/defshortcut ?W "~/Dropbox/public/sharing/")
(my/defshortcut ?r "~/personal/")
(my/defshortcut ?j "~/personal/")
(my/defshortcut ?J "~/cloud/a/Journal.csv")
(my/defshortcut ?I "~/Dropbox/Inbox")
(my/defshortcut ?g "~/")
(my/defshortcut ?c "~/code/dev/")
(my/defshortcut ?C "~/personal/")
(my/defshortcut ?l "~/dropbox/public/sharing/")
(my/defshortcut ?q "~/sync/notes/")
(my/defshortcut ?Q "~/personal/")

Key chords and Hydras

I'm on a Dvorak keyboard, so these might not work for you. Experimenting with this. key-chord lets you define keyboard shortcuts that use ordinary keys.

Some code from

(defun my/key-chord-define (keymap keys command)
  "Define in KEYMAP, a key-chord of two keys in KEYS starting a COMMAND.
\nKEYS can be a string or a vector of two elements. Currently only elements
that corresponds to ascii codes in the range 32 to 126 can be used.
\nCOMMAND can be an interactive function, a string, or nil.
If COMMAND is nil, the key-chord is removed.

MODIFICATION: Do not define the transposed key chord.
  (if (/= 2 (length keys))
      (error "Key-chord keys must have two elements"))
  ;; Exotic chars in a string are >255 but define-key wants 128..255 for those
  (let ((key1 (logand 255 (aref keys 0)))
        (key2 (logand 255 (aref keys 1))))
    (define-key keymap (vector 'key-chord key1 key2) command)))
(fset 'key-chord-define 'my/key-chord-define)

(defun my/switch-to-previous-buffer ()
  "Switch to previously open buffer.
Repeated invocations toggle between the two most recently open buffers."
  (switch-to-buffer (other-buffer (current-buffer) 1)))

(defun my/org-check-agenda ()
  "Peek at agenda."
   ((derived-mode-p 'org-agenda-mode)
    (if (window-parent) (delete-window) (bury-buffer)))
   ((get-buffer "*Org Agenda*")
    (switch-to-buffer-other-window "*Org Agenda*"))
   (t (org-agenda nil "a"))))

(defun my/goto-random-char ()
  (goto-char (random (point-max))))

(use-package hydra
  (defhydra my/goto-random-char-hydra ()
    ("r" my/goto-random-char))

  (defhydra my/window-movement ()
    ("<left>" windmove-left)
    ("<right>" windmove-right)
    ("<down>" windmove-down)
    ("<up>" windmove-up)
    ("y" other-window "other")
    ("h" switch-window "switch-window")
    ("f" find-file "file")
    ("F" find-file-other-window "other file")
    ("v" (progn (split-window-right) (windmove-right)))
    ("o" delete-other-windows :color blue)
    ("a" ace-window)
    ("s" ace-swap-window)
    ("d" delete-window "delete")
    ("D" ace-delete-window "ace delete")
    ("i" ace-maximize-window "maximize")
    ("b" helm-buffers-list)
    ("q" nil))
  (defhydra join-lines ()
    ("<up>" join-line)
    ("<down>" (join-line 1))
    ("t" join-line)
    ("n" (join-line 1)))
  (defhydra my/quantified-hydra (:color blue)
    "Quick tracking of Quantified Awesome stuff"
    ("c" (my/org-clock-in-and-track-by-name "Childcare") "Childcare")
    ("f" (my/org-clock-in-and-track-by-name "Family") "Family")
    ("F" (my/org-clock-in-and-track-by-name "Read fiction") "Fiction")
    ("k" (my/org-clock-in-and-track-by-name "Clean the kitchen") "Kitchen")
    ("D" (my/org-clock-in-and-track-by-name "Draw") "Draw")
    ("w" (my/org-clock-in-and-track-by-name "Walk for 30+ minutes") "Walk")
    ("W" (my/org-clock-in-and-track-by-name "Write") "Write")
    ("r" (my/org-clock-in-and-track-by-name "Personal routines") "Routines")
    ("R" (my/org-clock-in-and-track-by-name "Relax") "Relax")
    ("t" (my/org-clock-in-and-track-by-name "Tidy") "Tidy")
    ("b" (my/org-clock-in-and-track-by-name "Play Borderlands 2") "Borderlands 2")
    ("l" (my/org-clock-in-and-track-by-name "Eat lunch") "Lunch")
    ("L" (my/org-clock-in-and-track-by-name "Do laundry") "Laundry")
    ("d" (my/org-clock-in-and-track-by-name "Eat dinner") "Dinner")
    ("e" (my/org-clock-in-and-track-by-name "Process my inbox") "E-mail")
  (defhydra my/org (:color blue)
    "Convenient Org stuff."
    ("p" my/org-show-active-projects "Active projects")
    ("a" (org-agenda nil "a") "Agenda"))
  (defhydra my/key-chord-commands ()
    ("k" kill-sexp)
    ("h" my/org-jump :color blue)
    ("x" my/org-finish-previous-task-and-clock-in-new-one "Finish and clock in" :color blue)
    ("i" my/org-quick-clock-in-task "Clock in" :color blue)
    ("b" helm-buffers-list :color blue)
    ("f" find-file :color blue)
    ("a" my/org-check-agenda :color blue)
    ("c" (call-interactively 'org-capture) "capture" :color blue)
    ("t" (org-capture nil "T") "Capture task")
    ("." repeat)
    ("C-t" transpose-chars)
    ("o" my/org-off-my-computer :color blue)
    ("w" my/engine-mode-hydra/body "web" :exit t)
    ("m" imenu :color blue)
    ("q" quantified-track :color blue)
    ("r" my/describe-random-interactive-function)
    ("l" org-insert-last-stored-link)
    ("L" my/org-insert-link)
    ("+" text-scale-increase)
    ("-" text-scale-decrease))
  (defhydra my/engine-mode-hydra (:color blue)
    "Engine mode"
    ("b" engine/search-my-blog "blog")
    ("f" engine/search-my-photos "flickr")
    ("m" engine/search-mail "mail")
    ("g" engine/search-google "google")
    ("e" engine/search-emacswiki "emacswiki"))
  ;; From
  (defhydra hydra-buffer-menu (:color pink
                             :hint nil)
^Mark^             ^Unmark^           ^Actions^          ^Search
_m_: mark          _u_: unmark        _x_: execute       _R_: re-isearch
_s_: save          _U_: unmark up     _b_: bury          _I_: isearch
_d_: delete        ^ ^                _g_: refresh       _O_: multi-occur
_D_: delete up     ^ ^                _T_: files only: % -28`Buffer-menu-files-only
_~_: modified
  ("m" Buffer-menu-mark)
  ("u" Buffer-menu-unmark)
  ("U" Buffer-menu-backup-unmark)
  ("d" Buffer-menu-delete)
  ("D" Buffer-menu-delete-backwards)
  ("s" Buffer-menu-save)
  ("~" Buffer-menu-not-modified)
  ("x" Buffer-menu-execute)
  ("b" Buffer-menu-bury)
  ("g" revert-buffer)
  ("T" Buffer-menu-toggle-files-only)
  ("O" Buffer-menu-multi-occur :color blue)
  ("I" Buffer-menu-isearch-buffers :color blue)
  ("R" Buffer-menu-isearch-buffers-regexp :color blue)
  ("c" nil "cancel")
  ("v" Buffer-menu-select "select" :color blue)
  ("o" Buffer-menu-other-window "other-window" :color blue)
  ("q" quit-window "quit" :color blue))

  (define-key Buffer-menu-mode-map "." 'hydra-buffer-menu/body)

  (defun my/org-update-link-description (description)
    "Update the current link's DESCRIPTION."
    (interactive "MDescription: ")
    (let (link)
         ((org-in-regexp org-link-bracket-re 1)
          (setq link (org-link-unescape (match-string-no-properties 1)))
          (delete-region (match-beginning 0) (match-end 0))
          (insert (org-link-make-string link description))
          (sit-for 0))
         ((or (org-in-regexp org-link-angle-re)
              (org-in-regexp org-link-plain-re))
          (setq link (org-unbracket-string "<" ">" (match-string 0)))
          (delete-region (match-beginning 0) (match-end 0))
          (insert (org-link-make-string link description))
          (sit-for 0))))))

  (defhydra my/phone (:exit t)
    "Shortcuts for my phone"
    ("j" jump-to-register "Jump")
    ("d" my/emacs-news-check-duplicates "Dupe")
    ("c" my/org-categorize-emacs-news/body "Categorize")
    ("h" (lambda () (interactive) (my/org-update-link-description "HN")) "Link HN")
    ("i" (lambda () (interactive) (my/org-update-link-description "Irreal")) "Link Irreal")
    ("s" save-buffer "Save")
    ("m" my/share-emacs-news "Mail"))
  (global-set-key (kbd "<f5>") 'my/phone/body))

(defun my/org-insert-link ()
  (when (org-in-regexp org-bracket-link-regexp 1)
    (goto-char (match-end 0))
    (insert "\n"))
  (call-interactively 'org-insert-link))

Now let's set up the actual keychords.

(use-package key-chord
    (fset 'key-chord-define 'my/key-chord-define)
    (setq key-chord-one-key-delay 0.16)
    ;; k can be bound too
    (key-chord-define-global "uu"     'undo)
    (key-chord-define-global "jr"     'my/goto-random-char-hydra/my/goto-random-char)
    (key-chord-define-global "kk"     'kill-whole-line)
    (key-chord-define-global "jj"     'avy-goto-word-1)
    (key-chord-define-global "yy"    'my/window-movement/body)
    (key-chord-define-global "jw"     'switch-window)
    (key-chord-define-global "jl"     'avy-goto-line)
    (key-chord-define-global "j."     'join-lines/body)
    ;(key-chord-define-global "jZ"     'avy-zap-to-char)
    (key-chord-define-global "FF"     'find-file)
    (key-chord-define-global "qq"     'my/quantified-hydra/body)
    (key-chord-define-global "hh"     'my/key-chord-commands/body)
    (key-chord-define-global "xx"     'er/expand-region)
    (key-chord-define-global "  "     'my/insert-space-or-expand)
    (key-chord-define-global "vv" 'god-mode-all)
    (key-chord-define-global "JJ"     'my/switch-to-previous-buffer)))

Hmm, good point about C-t being more useful as a Hydra than as transpose-char. It turns out I actually do use C-t a fair bit, but I can always add it back as an option.

(bind-key "C-t" 'my/key-chord-commands/body)

I used to have these as part of my main hydra, but I haven't been doing transcripts lately, so I'll free up those keystrokes for something else.

("h" emms-pause :color blue)
("t" emms-seek-backward)
("s" emms-seek-to :color blue)


From, this makes M-n and M-p look for the symbol at point.

(use-package smartscan
  :defer t
  :config (global-smartscan-mode t))



(require 'find-dired)
(setq find-ls-option '("-print0 | xargs -0 ls -ld" . "-ld"))

Allow my use of C-x C-q while in peep-dired mode.

(use-package peep-dired
  :bind (:map peep-dired-mode-map 
         ("SPC" . nil)
         ("<backspace>" . nil)))
Saving photos
(defun my/save-photo (name)
  (interactive "MName: ")
  (let* ((file (dired-get-filename))
    ((string-match "CameraZOOM-\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9][0-9]\\)" file)
      (setq new-name
            (format "%s-%s-%s %s.%s.%s.%s %s.jpg"
                    (match-string 1 file)
                    (match-string 2 file)
                    (match-string 3 file)
                    (match-string 4 file)
                    (match-string 5 file)
                    (match-string 6 file)
                    (match-string 7 file)
    ((string-match "\\([0-9][0-9][0-9][0-9]\\)[\\.-]\\([0-9][0-9]\\)[\\.-]\\([0-9][0-9]\\)[\\.- ]\\([0-9][0-9]\\)\\.\\([0-9][0-9]\\)\\.\\([0-9][0-9]\\)" file)
      (setq new-name
            (format "%s-%s-%s %s.%s.%s %s.jpg"
                    (match-string 1 file)
                    (match-string 2 file)
                    (match-string 3 file)
                    (match-string 4 file)
                    (match-string 5 file)
                    (match-string 6 file)
    (t (setq new-name (concat (file-name-sans-extension (file-name-nondirectory file)) " " name ".jpg"))))
    (when (string-match "A-" name)
      (copy-file file (expand-file-name new-name my/kid-photo-directory)))
    (rename-file file (expand-file-name new-name "~/archives/2016/photos/selected/"))))
(defun my/backup-media ()
  (mapcar (lambda (file)
              (file-name-nondirectory file)
               ((string-match "mp4" file) "~/archives/2016/videos/")
               ((string-match "mp3\\|wav" file) "~/archives/2016/audio/")
               (t "~/archives/2016/photos/backup/")))))
(bind-key "b" 'my/save-photo dired-mode-map)
(bind-key "r" 'my/backup-media dired-mode-map)

Move to beginning of line

Copied from

(defun my/smarter-move-beginning-of-line (arg)
  "Move point back to indentation of beginning of line.

Move point to the first non-whitespace character on this line.
If point is already there, move to the beginning of the line.
Effectively toggle between the first non-whitespace character and
the beginning of the line.

If ARG is not nil or 1, move forward ARG - 1 lines first.  If
point reaches the beginning or end of the buffer, stop there."
  (interactive "^p")
  (setq arg (or arg 1))

  ;; Move lines first
  (when (/= arg 1)
    (let ((line-move-visual nil))
      (forward-line (1- arg))))

  (let ((orig-point (point)))
    (when (= orig-point (point))
      (move-beginning-of-line 1))))

;; remap C-a to `smarter-move-beginning-of-line'
(global-set-key [remap move-beginning-of-line]

Recent files

(require 'recentf)
(setq recentf-max-saved-items 200
      recentf-max-menu-items 15)

Copy filename to clipboard

(defun prelude-copy-file-name-to-clipboard ()
  "Copy the current buffer file name to the clipboard."
  (let ((filename (if (equal major-mode 'dired-mode)
    (when filename
      (kill-new filename)
      (message "Copied buffer file name '%s' to the clipboard." filename))))

Open files externally

Copied from Prelude:

(defun prelude-open-with (arg)
  "Open visited file in default external program.

With a prefix ARG always prompt for command to use."
  (interactive "P")
  (when buffer-file-name
    (shell-command (concat
                     ((and (not arg) (eq system-type 'darwin)) "open")
                     ((and (not arg) (member system-type '(gnu gnu/linux gnu/kfreebsd))) "xdg-open")
                     (t (read-shell-command "Open current file with: ")))
                    " "
                    (shell-quote-argument buffer-file-name)))))

Don't use docview for PDFs. (add-to-list 'org-file-apps '("pdf" . "evince %s"))

Reading From Xah Lee:

(defun xah-toggle-margin-right ()
  "Toggle the right margin between `fill-column' or window width.
This command is convenient when reading novel, documentation."
  (if (eq (cdr (window-margins)) nil)
      (set-window-margins nil 0 (- (window-body-width) fill-column))
    (set-window-margins nil 0 0)))

Shuffling lines

(defun my/shuffle-lines-in-region (beg end)
  (interactive "r")
  (let ((list (split-string (buffer-substring beg end) "[\r\n]+")))
    (delete-region beg end)
    (insert (mapconcat 'identity (shuffle-list list) "\n"))))


Avoiding weasel words

(use-package artbollocks-mode
  :defer t
  :load-path  "~/elisp/artbollocks-mode"
    (setq artbollocks-weasel-words-regex
          (concat "\\b" (regexp-opt
                         '("one of the"
                           "sort of"
                           "a lot"
                           "I think"
                           "leverage") t) "\\b"))
    ;; Don't show the art critic words, or at least until I figure
    ;; out my own jargon
    (setq artbollocks-jargon nil)))

Unfill paragraph

I unfill paragraphs a lot because Wordpress likes adding extra <br> tags if I don't. (I should probably just tweak my Wordpress installation.)

  (defun my/unfill-paragraph (&optional region)
    "Takes a multi-line paragraph and makes it into a single line of text."
    (interactive (progn
                   (list t)))
    (let ((fill-column (point-max)))
      (fill-paragraph nil region)))
(bind-key "M-Q" 'my/unfill-paragraph)

I never actually justify text, so I might as well change the way fill-paragraph works. With the code below, M-q will fill the paragraph normally, and C-u M-q will unfill it.

  (defun my/fill-or-unfill-paragraph (&optional unfill region)
    "Fill paragraph (or REGION).
  With the prefix argument UNFILL, unfill it instead."
    (interactive (progn
                   (list (if current-prefix-arg 'unfill) t)))
    (let ((fill-column (if unfill (point-max) fill-column)))
      (fill-paragraph nil region)))
(bind-key "M-q" 'my/fill-or-unfill-paragraph)

Also, visual-line-mode is so much better than auto-fill-mode. It doesn't actually break the text into multiple lines - it only looks that way.

(remove-hook 'text-mode-hook #'turn-on-auto-fill)
(add-hook 'text-mode-hook 'turn-on-visual-line-mode)


(defmacro my/insert-unicode (unicode-name)
  `(lambda () (interactive)
     (insert-char (cdr (assoc-string ,unicode-name (ucs-names))))))
(bind-key "C-x 8 s" (my/insert-unicode "ZERO WIDTH SPACE"))
(bind-key "C-x 8 S" (my/insert-unicode "SNOWMAN"))

Clean up spaces

(bind-key "M-SPC" 'cycle-spacing)


(bind-key "M-/" 'hippie-expand)

From - Exclude very large buffers from dabbrev

(defun sanityinc/dabbrev-friend-buffer (other-buffer)
  (< (buffer-size other-buffer) (* 1 1024 1024)))
(setq dabbrev-friend-buffer-function 'sanityinc/dabbrev-friend-buffer)
(setq hippie-expand-try-functions-list

Org   org

I use Org Mode to take notes, publish my blog, and do all sorts of stuff.

   (use-package org
   ; Use this when I want to load from source
   :load-path ("~/vendor/org-mode/lisp" "~/vendor/org-mode/contrib/lisp")

Filling in for obsolete functions

   (use-package org
   ; Use this when I want to load from source
   (unless (functionp 'org-link-make-string)
     (fset 'org-link-make-string 'org-make-link-string))

My files


Here are the Org files I use. I should probably organize them better. =) My main Org file. Inbox for M-x org-capture, tasks, weekly reviews, etc. Sewing projects, fabric tracking, etc. Business-related notes and TODOs People-related tasks
evil-plans/ High-level goals
sharing/ Things to write about Pending, current, and reviewed decisions Topic index for my blog Learning plan Huge outline of notes by category Temporary Org file for tracking various things Templates for assigning tasks - now using Google Docs instead Huge file with book notes Now using this with org-gcal Planning ideal days Archived subtrees Latin notes Old goals for 101 things in 1001 days Questions, processes, tools


Org has a whole bunch of optional modules. These are the ones I'm currently experimenting with.

  (setq org-modules '(org-bbdb
(eval-after-load 'org
 '(org-load-modules-maybe t))
;; Prepare stuff for org-export-backends
(setq org-export-backends '(org latex icalendar html ascii))

Keyboard shortcuts

(bind-key "C-c r" 'org-capture)
(bind-key "C-c a" 'org-agenda)
(bind-key "C-c l" 'org-store-link)
(bind-key "C-c L" 'org-insert-link-global)
(bind-key "C-c O" 'org-open-at-point-global)
(bind-key "<f9> <f9>" 'org-agenda-list)
(bind-key "<f9> <f8>" (lambda () (interactive) (org-capture nil "r")))

append-next-kill is more useful to me than org-table-copy-region.

(with-eval-after-load 'org
  (bind-key "C-M-w" 'append-next-kill org-mode-map)
  (bind-key "C-TAB" 'org-cycle org-mode-map)
  (bind-key "C-c v" 'org-show-todo-tree org-mode-map)
  (bind-key "C-c C-r" 'org-refile org-mode-map)
  (bind-key "C-c R" 'org-reveal org-mode-map)
  (bind-key "C-c o" 'my/org-follow-entry-link org-mode-map)
  (bind-key "C-c d" 'my/org-move-line-to-destination org-mode-map)
  (bind-key "C-c f" 'my/org-file-blog-index-entries org-mode-map)
  (bind-key "C-c t s"  'my/split-sentence-and-capitalize org-mode-map)
  (bind-key "C-c t -"  'my/split-sentence-delete-word-and-capitalize org-mode-map)
  (bind-key "C-c t d"  'my/delete-word-and-capitalize org-mode-map)

  (bind-key "C-c C-p C-p" 'my/org-publish-maybe org-mode-map)
  (bind-key "C-c C-r" 'my/org-refile-and-jump org-mode-map))

I don't use the diary, but I do use the clock a lot.

(with-eval-after-load 'org-agenda
  (bind-key "i" 'org-agenda-clock-in org-agenda-mode-map))
Speed commands

These are great for quickly acting on tasks.

  • hello
    • world
    • this
  • world here
   (setq org-use-effective-time t)

   (defun my/org-use-speed-commands-for-headings-and-lists ()
     "Activate speed commands on list items too."
     (or (and (looking-at org-outline-regexp) (looking-back "^\**" nil))
         (save-excursion (and (looking-at (org-item-re)) (looking-back "^[ \t]*" nil)))))
   (setq org-use-speed-commands 'my/org-use-speed-commands-for-headings-and-lists)

(with-eval-after-load 'org
   (add-to-list 'org-speed-commands-user '("x" org-todo "DONE"))
   (add-to-list 'org-speed-commands-user '("y" org-todo-yesterday "DONE"))
   (add-to-list 'org-speed-commands-user '("!" my/org-clock-in-and-track))
   (add-to-list 'org-speed-commands-user '("s" call-interactively 'org-schedule))
   (add-to-list 'org-speed-commands-user '("d" my/org-move-line-to-destination))
   (add-to-list 'org-speed-commands-user '("i" call-interactively 'org-clock-in))
   (add-to-list 'org-speed-commands-user '("P" call-interactively 'org2blog/wp-post-subtree))
   (add-to-list 'org-speed-commands-user '("o" call-interactively 'org-clock-out))
   (add-to-list 'org-speed-commands-user '("$" call-interactively 'org-archive-subtree))
   (bind-key "!" 'my/org-clock-in-and-track org-agenda-mode-map))



(setq org-goto-interface 'outline
      org-goto-max-level 10)
(require 'imenu)
(setq org-startup-folded nil)
(bind-key "C-c j" 'org-clock-goto) ;; jump to current task from anywhere
(bind-key "C-c C-w" 'org-refile)
(setq org-cycle-include-plain-lists 'integrate)
Link Org subtrees and navigate between them

The following code makes it easier for me to link trees with entries, as in

(defun my/org-follow-entry-link ()
  "Follow the defined link for this entry."
  (if (org-entry-get (point) "LINK")
      (org-open-link-from-string (org-entry-get (point) "LINK"))

(defun my/org-link-projects (location)
  "Add link properties between the current subtree and the one specified by LOCATION."
   (list (let ((org-refile-use-cache nil))
     (org-refile-get-location "Location"))))
  (let ((link1 (org-store-link nil)) link2)
      (org-refile 4 nil location)
      (setq link2 (org-store-link nil))
      (org-set-property "LINK" link1))
    (org-set-property "LINK" link2)))
Viewing, navigating, and editing the Org tree

I often cut and paste subtrees. This makes it easier to cut something and paste it elsewhere in the hierarchy.

(with-eval-after-load 'org
     (bind-key "C-c k" 'org-cut-subtree org-mode-map)
     (setq org-yank-adjusted-subtrees t))
Finding my place on a small mobile screen with org-back-to-heading

There's probably a better way to do this. I'm surprised org-back-to-heading isn't interactive yet. It's useful.

(defun my/org-back-to-heading ()

(use-package org
  :bind (:map org-mode-map 
              ("C-c b" . my/org-back-to-heading)
              ("C-c p" . org-display-outline-path))) 
Dealing with big tables

Sometimes I forget where I am in a big table. This would be nice to turn into a minor mode someday.

(defun my/org-show-row-and-column (point)
  (interactive "d")
    (goto-char point)
    (let ((row (s-trim (org-table-get nil 1)))
          (col (s-trim (org-table-get 1 nil)))
          (message-log-max nil))
      (message "%s - %s" row col))))

Taking notes

My org files are in my personal directory, which is actually a symlink to a directory in my Dropbox. That way, I can update my Org files from multiple computers.

(setq org-directory "~/personal")
(setq org-default-notes-file "~/orgzly/")

This makes it easier to add links from outside.

(defun my/yank-more ()
  (insert "[[")
  (insert "][more]]"))
(global-set-key (kbd "<f6>") 'my/yank-more)
Date trees

This quickly adds a same-level heading for the succeeding day.

(defun my/org-insert-heading-for-next-day ()
  "Insert a same-level heading for the following day."
  (let ((new-date
          (+ 86400.0
              (org-read-date nil 'to-time (elt (org-heading-components) 4)))))))
    (insert (format-time-string "%Y-%m-%d\n\n" new-date))))

I use org-capture templates to quickly jot down tasks, ledger entries, notes, and other semi-structured pieces of information.

(defun my/org-contacts-template-email (&optional return-value)
    "Try to return the contact email for a template.
  If not found return RETURN-VALUE or something that would ask the user."
    (eval-when-compile (require 'gnus-art nil t))
    (eval-when-compile (require 'org-contacts nil t))
    (or (cadr (if (gnus-alive-p)
                     (or (mail-fetch-field "Reply-To") (mail-fetch-field "From") "")))))
        (concat "%^{" org-contacts-email-property "}p")))

    (defvar my/org-basic-task-template "* TODO %^{Task}
  :Effort: %^{effort|1:00|0:05|0:15|0:30|2:00|4:00}
  Captured %<%Y-%m-%d %H:%M>

  " "Basic task data")
    (defvar my/org-inbox-file "~/orgzly/")
    (defvar my/ledger-file "~/cloud/ledger/current.ledger")
    (setq org-capture-templates
          `(("t" "Quick task" entry
             (file ,my/org-inbox-file)
             "* TODO %^{Task}\n"
             :immediate-finish t)
            ("T" "Task" entry
             (file ,my/org-inbox-file)
             "* TODO %^{Task}\n")
            ("." "Today" entry
             (file ,my/org-inbox-file)
             "* TODO %^{Task}\nSCHEDULED: %t\n"
             :immediate-finish t)
            ("v" "Video" entry
             (file ,my/org-inbox-file)
             "* TODO %^{Task}  :video:\nSCHEDULED: %t\n"
             :immediate-finish t)
            ("e" "Errand" entry
             (file ,my/org-inbox-file)
             "* TODO %^{Task}  :errands:\n"
             :immediate-finish t)
            ("n" "Note" entry
             (file ,my/org-inbox-file)
             "* %^{Note}\n"
             :immediate-finish t)
            ("r" "Note" entry
             (file ,my/org-inbox-file)
             "* %?\n%U - %a")
            ("N" "Note" entry
             (file ,my/org-inbox-file)
             "* %^{Note}\n")
            ("i" "Interrupting task" entry
             (file ,my/org-inbox-file)
             "* STARTED %^{Task}"
             :clock-in :clock-resume)
            ("b" "Business task" entry
             (file+headline "~/personal/" "Tasks")
            ("p" "People task" entry
             (file "~/orgzly/")
            ("j" "Journal entry" plain
             (file+datetree "~/personal/")
             "%K - %a\n%i\n%?\n"
             :unnarrowed t)
            ("J" "Journal entry with date" plain
             (file+datetree+prompt "~/personal/")
             "%K - %a\n%i\n%?\n"
             :unnarrowed t)
            ("s" "Journal entry with date, scheduled" entry
             (file+datetree+prompt "~/personal/")
             "* \n%K - %a\n%t\t%i\n%?\n"
             :unnarrowed t)
            ("w" "Web site" entry
             (file+headline ,org-default-notes-file "Inbox")
             "* %a :website:\n\n%U %?\n\n%:initial")
            ("c" "Protocol Link" entry (file+headline ,org-default-notes-file "Inbox")
             "* [[%:link][%:description]] \n\n#+BEGIN_QUOTE\n%i\n#+END_QUOTE\n\n%?\n\nCaptured: %U")
            ("db" "Done - Business" entry
             (file+headline "~/personal/" "Tasks")
             "* DONE %^{Task}\nSCHEDULED: %^t\n%?")
            ("dp" "Done - People" entry
             (file+headline "~/personal/" "Tasks")
             "* DONE %^{Task}\nSCHEDULED: %^t\n%?")
            ("dt" "Done - Task" entry
             (file+headline "~/orgzly/" "Inbox")
             "* DONE %^{Task}\nSCHEDULED: %^t\n%?")
            ("q" "Quick note" item
             (file+headline "~/orgzly/" "Quick notes"))
            ("l" "Ledger")
            ("lc" "Cash expense" plain
             (file ,my/ledger-file)
             "%(ledger-read-date \"Date: \") * %^{Payee}
      Expenses:%^{Account}  %^{Amount}
            ("lb" "BDO CAD" plain
    (file ,my/ledger-file)
    "%(ledger-read-date \"Date: \") * %^{Payee}
      Expenses:Play    $ %^{Amount}
            ("lp" "BDO PHP" plain
    (file ,my/ledger-file)
    "%(ledger-read-date \"Date: \") * %^{Payee}
      Expenses:Play    PHP %^{Amount}
            ("B" "Book" entry
             (file+datetree "~/personal/" "Inbox")
             "* %^{Title}  %^g
    *Author(s):* %^{Author} \\\\
    *ISBN:* %^{ISBN}


    *Review on:* %^t \\
             :clock-in :clock-resume)
             ("C" "Contact" entry (file "~/personal/")
              "* %(org-contacts-template-name)
    :EMAIL: %(my/org-contacts-template-email)
    (bind-key "C-M-r" 'org-capture)
    ;(bind-key (kbd "<f5>") 'org-capture)
  • Allow refiling in the middle(ish) of a capture

    This lets me use C-c C-r to refile a capture and then jump to the new location. I wanted to be able to file tasks under projects so that they could inherit the QUANTIFIED property that I use to track time (and any Beeminder-related properties too), but I also wanted to be able to clock in on them.

    (defun my/org-refile-and-jump ()
      (if (derived-mode-p 'org-capture-mode)
        (call-interactively 'org-refile))
    (eval-after-load 'org-capture
     '(bind-key "C-c C-r" 'my/org-refile-and-jump org-capture-mode-map))

org-refile lets you organize notes by typing in the headline to file them under.

(setq org-reverse-note-order t)
(setq org-refile-use-outline-path 'file)
(setq org-outline-path-complete-in-steps nil)
(setq org-refile-allow-creating-parent-nodes 'confirm)
(setq org-refile-use-cache nil)
(setq org-refile-targets '((org-agenda-files . (:maxlevel . 3))))
(setq org-blank-before-new-entry nil)
  • TEACH Jump to Org location by substring
    ;; Example: (org-refile 4 nil (my/org-refile-get-location-by-substring "Other Emacs"))
    (defun my/org-refile-get-location-by-substring (regexp &optional file)
      "Return the refile location identified by REGEXP."
      (let ((org-refile-targets org-refile-targets) tbl)
        (setq org-refile-target-table (org-refile-get-targets)))
      (unless org-refile-target-table
        (user-error "No refile targets"))
      (cl-find regexp org-refile-target-table
               (lambda (a b)
                  (string-match a (car b))
                  (or (null file)
                      (string-match file (elt b 1)))))))
    (defun my/org-refile-subtree-to (name)
      (org-refile nil nil (my/org-refile-get-location-exact name)))
     (defun my/org-refile-get-location-exact (name &optional file)
      "Return the refile location identified by NAME."
      (let ((org-refile-targets org-refile-targets) tbl)
        (setq org-refile-target-table (org-refile-get-targets)))
      (unless org-refile-target-table
        (user-error "No refile targets"))
      (cl-find name org-refile-target-table
               :test (lambda (a b)
                     (and (string-equal a (car b))
                  (or (null file)
                      (string-match file (elt b 1)))))))
    ;; Example: (my/org-clock-in-refile "Off my computer")
     (defun my/org-clock-in-refile (location &optional file)
      "Clocks into LOCATION.
    LOCATION and FILE can also be regular expressions for `my/org-refile-get-location-by-substring'."
      (interactive (list (my/org-refile-get-location)))
          (if (stringp location) (setq location (my/org-refile-get-location-by-substring location file)))
          (org-refile 4 nil location)
     (defun my/org-finish-previous-task-and-clock-in-new-one (location &optional file)
      (interactive (list (my/org-refile-get-location)))
        (org-todo 'done))
      (my/org-clock-in-and-track-by-name location file))
    (defun my/org-clock-in-and-track-by-name (location &optional file)
      (interactive (list (my/org-refile-get-location)))
          (if (stringp location) (setq location (my/org-refile-get-location-exact location file)))
          (org-refile 4 nil location)
    (defun my/org-off-my-computer (category)
      (interactive "MCategory: ")
      (eval-when-compile (require 'quantified nil t))
      (my/org-clock-in-refile "Off my computer")
      (quantified-track category))
  • Quick way to jump
    (defun my/org-jump ()
      (let ((current-prefix-arg '(4)))
        (call-interactively 'org-refile)))
TODO Bounce to my phone inbox   computer phone

On my phone, Emacs in Termux is nice for scripting, and Orgzly is nice for editing long text. Let's see if this function lets me quickly bounce things around from one place to another.

(defun my/org-bounce-to-inbox ()
  "Toggle subtree between `my/org-inbox-file' and current file.
Limitations: Reinserts entry at bottom of subtree, uses kill ring."
  (if (string= (buffer-file-name) (expand-file-name my/org-inbox-file))
      ;; Return it
      (let ((location (org-entry-get (point) "BOUNCE")))
        (when location
          (setq location (read location))
          (with-current-buffer (find-file (car location))
              (goto-char (org-find-olp location))
              (unless (bolp) (insert "\n"))
              (org-paste-subtree (length location) nil nil t)
    (org-entry-put (point) "BOUNCE" (prin1-to-string (cons (buffer-file-name) (org-get-outline-path))))
    (with-current-buffer (find-file my/org-inbox-file)
        (goto-char (point-max))
        (unless (bolp) (insert "\n"))
Estimating WPM

I'm curious about how fast I type some things.

(require 'org-clock)
(defun my/org-entry-wpm ()
      (goto-char (point-min))
      (let* ((words (count-words-region (point-min) (point-max)))
       (minutes (org-clock-sum-current-item))
       (wpm (/ words minutes)))
  (message "WPM: %d (words: %d, minutes: %d)" wpm words minutes)
  (kill-new (number-to-string wpm))))))


Managing tasks
  • Track TODO state

    The parentheses indicate keyboard shortcuts that I can use to set the task state. @ and ! toggle logging. @ prompts you for a note, and ! automatically logs the timestamp of the state change.

    (setq org-todo-keywords
        "TODO(t)"  ; next action
        "TOBLOG(b)"  ; next action
        "SOMEDAY(.)" "|" "DONE(x!)" "CANCELLED(c)")
       (sequence "LEARN" "TRY" "TEACH" "|" "COMPLETE(x)")
       (sequence "TOSKETCH" "SKETCHED" "|" "POSTED")
       (sequence "TOBUY" "TOSHRINK" "TOCUT"  "TOSEW" "|" "DONE(x)")
       (sequence "TODELEGATE(-)" "DELEGATED(d)" "|" "COMPLETE(x)")))
    (setq org-todo-keyword-faces
          '(("TODO" . (:foreground "green" :weight bold))
            ("DONE" . (:foreground "cyan" :weight bold))
            ("WAITING" . (:foreground "red" :weight bold))
            ("SOMEDAY" . (:foreground "gray" :weight bold))))
    (setq org-log-done 'time)
  • Projects

    Projects are headings with the :project: tag, so we generally don't want that tag inherited, except when we display unscheduled tasks that don't belong to any projects.

    (setq org-tags-exclude-from-inheritance '("project"))

    This code makes it easy for me to focus on one project and its tasks.

    (use-package org
       (add-to-list 'org-speed-commands-user '("N" org-narrow-to-subtree))
       (add-to-list 'org-speed-commands-user '("W" widen))
       (add-to-list 'org-speed-commands-user '("T" my/org-agenda-for-subtree))
       (add-to-list 'org-speed-commands-user '("b" my/org-bounce-to-inbox)))
       (defun my/org-agenda-for-subtree ()
         (when (derived-mode-p 'org-agenda-mode) (org-agenda-switch-to))
          (let ((org-agenda-view-columns-initially t))
            (org-agenda nil "t" 'subtree))))

    There's probably a proper way to do this, maybe with <. Oh, that would work nicely. < C-c a t too.

    And sorting:

    (add-to-list 'org-speed-commands-user '("S" call-interactively 'org-sort))
  • Tag tasks with GTD-ish contexts

    This defines keyboard shortcuts for those, too.

    (setq org-tag-alist '(("work" . ?b)
                          ("home" . ?h)
                          ("writing" . ?w)
                          ("errands" . ?e)
                          ("drawing" . ?d)
                          ("coding" . ?c)
                          ("video" . ?v)
                          ("kaizen" . ?k)
                          ("phone" . ?p)
                          ("learning" . ?a)
                          ("reading" . ?r)
                          ("computer" . ?l)
                          ("quantified" . ?q)
                          ("shopping" .?s)
                          ("focus" . ?f)))
  • Enable filtering by effort estimates

    That way, it's easy to see short tasks that I can finish.

    (add-to-list 'org-global-properties
          '("Effort_ALL". "0:05 0:15 0:30 1:00 2:00 3:00 4:00"))
  • Track time
    (use-package org
      (setq org-expiry-inactive-timestamps t)
      (setq org-clock-idle-time nil)
      (setq org-log-done 'time)
      (setq org-clock-auto-clock-resolution nil)
      (setq org-clock-continuously nil)
      (setq org-clock-persist t)
      (setq org-clock-in-switch-to-state "STARTED")
      (setq org-clock-in-resume nil)
      (setq org-show-notification-handler 'message)
      (setq org-clock-report-include-clocking-task t))

    Too many clock entries clutter up a heading.

    (setq org-log-into-drawer "LOGBOOK")
    (setq org-clock-into-drawer 1)
  • Habits

    I like using org-habits to track consistency. My task names tend to be a bit long, though, so I've configured the graph column to show a little bit more to the right.

    (setq org-habit-graph-column 80)
    (setq org-habit-show-habits-only-for-today nil)

    If you want to use habits, be sure to schedule your tasks and add a STYLE property with the value of habit to the tasks you want displayed.

Estimating tasks

From "Add an effort estimate on the fly when clocking in" on the Org Hacks page:

(add-hook 'org-clock-in-prepare-hook

(defun my/org-mode-ask-effort ()
  "Ask for an effort estimate when clocking in."
  (unless (org-entry-get (point) "Effort")
    (let ((effort
            "Effort: "
            (org-entry-get-multivalued-property (point) "Effort"))))
      (unless (equal effort "")
        (org-set-property "Effort" effort)))))
Flexible scheduling of tasks

I (theoretically) want to be able to schedule tasks for dates like the first Saturday of every month. Fortunately, someone else has figured that out!

;; Get this from
(load "~/elisp/next-spec-day.el" t)
Task dependencies
(setq org-enforce-todo-dependencies t)
(setq org-track-ordered-property-with-tag t)
(setq org-agenda-dim-blocked-tasks t)
Quick way to archive all DONE from inbox   emacs computer
     (defun my/org-clean-up-inbox ()
       "Archive all DONE tasks and sort the remainder by TODO order."
       (with-current-buffer (find-file my/org-inbox-file)
         (my/org-archive-done-tasks 'file)
         (goto-char (point-min))
         (if (org-at-heading-p) (save-excursion (insert "\n")))
         (org-sort-entries nil ?p)
         (goto-char (point-min))
         (org-sort-entries nil ?o)

     (defun my/org-archive-done-tasks (&optional scope)
       "Archive finished or cancelled tasks.
SCOPE can be 'file or 'tree."
        (lambda ()
          (setq org-map-continue-from (outline-previous-heading)))
        "TODO=\"DONE\"|TODO=\"CANCELLED\"" (or scope (if (org-before-first-heading-p) 'file 'tree))))


Structure templates

Org makes it easy to insert blocks by typing <s[TAB], etc. I hardly ever use LaTeX, but I insert a lot of Emacs Lisp blocks, so I redefine <l to insert a Lisp block instead.

(setq org-structure-template-alist
'(("a" . "export ascii")
    ("c" . "center")
    ("C" . "comment")
    ("e" . "example")
    ("E" . "export")
    ("h" . "export html")
    ("l" . "src emacs-lisp")
    ("p" . "src python")
    ("q" . "quote")
    ("s" . "src")
    ("v" . "verse")))

This lets me nest quotes.

(defun my/org-html-quote2 (block backend info)
  (when (org-export-derived-backend-p backend 'html)
  (when (string-match "\\`<div class=\"quote2\">" block)
  (setq block (replace-match "<blockquote>" t nil block))
  (string-match "</div>\n\\'" block)
  (setq block (replace-match "</blockquote>\n" t nil block))
(eval-after-load 'ox
'(add-to-list 'org-export-filter-special-block-functions 'my/org-html-quote2))
Emacs chats, Emacs hangouts
(defun my/org-link-youtube-time (url beg end)
  "Link times of the form h:mm to YouTube video at URL.
Works on region defined by BEG and END."
  (interactive (list (read-string "URL: " (org-entry-get-with-inheritance "YOUTUBE")) (point) (mark)))
      (narrow-to-region beg end)
      (goto-char (point-min))
      (let ((char (if (string-match "\\?" url) "&" "?")))
        (while (re-search-forward "\\(\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\) ::" nil t)
           (format "[[%s%st=%sh%sm%ss][%s]] "
                   (match-string 2)
                   (match-string 3)
                   (or (match-string 5) "0")
                   (match-string 1)) nil t))))))

(defun my/clean-up-google-hangout-chat ()
    (while (re-search-forward "<hr.*?div class=\"Kc-Ma-m\".*?>" nil t)
      (replace-match "\n| ")))
    (while (re-search-forward "</div><div class=\"Kc-yi-m\">" nil t)
      (replace-match " | ")))
    (while (re-search-forward "</div></div><div class=\"Kc-ib\">" nil t)
      (replace-match " | ")))
    (while (re-search-forward "<a rel=\"nofollow\" target=\"_blank\" href=\"\\(.*?\\)\">\\(.*?\\)</a>" nil t)
      (replace-match "[[\\1][\\2]]")))
    (while (re-search-forward "</div></div></div></div>" nil t)
      (replace-match " |")))
    (while (re-search-forward "&nbsp;" nil t)
      (replace-match " ")))
    (while (re-search-forward "</div><div class=\"Kc-ib\">" nil t)
      (replace-match " ")))
    (while (re-search-forward "<img.*?>" nil t)
      (replace-match "")))
    (while (re-search-forward "<wbr>" nil t)
      (replace-match "")))

Org agenda

Basic configuration

I have quite a few Org files, but I keep my agenda items and TODOs in only a few of them them for faster scanning.

(defvar my/kid-org-file nil "Defined in secrets")
(setq org-agenda-files
      (delq nil
            (mapcar (lambda (x) (and x (file-exists-p x) x))
(add-to-list 'auto-mode-alist '("\\.txt$" . org-mode))

I like looking at two days at a time when I plan using the Org agenda. I want to see my log entries, but I don't want to see scheduled items that I've finished. I like seeing a time grid so that I can get a sense of how appointments are spread out.

 (setq org-agenda-span 2)
 (setq org-agenda-tags-column -100) ; take advantage of the screen width
 (setq org-agenda-sticky nil)
 (setq org-agenda-inhibit-startup t)
 (setq org-agenda-use-tag-inheritance t)
 (setq org-agenda-show-log t)
 (setq org-agenda-skip-scheduled-if-done t)
 (setq org-agenda-skip-deadline-if-done t)
 (setq org-agenda-skip-deadline-prewarning-if-scheduled 'pre-scheduled)
 (setq org-agenda-time-grid
       '((daily today require-timed)
(800 1000 1200 1400 1600 1800 2000)
"......" "----------------"))
 (setq org-columns-default-format "%14SCHEDULED %Effort{:} %1PRIORITY %TODO %50ITEM %TAGS")

Some other keyboard shortcuts:

(bind-key "Y" 'org-agenda-todo-yesterday org-agenda-mode-map)
Starting my weeks on Saturday

I like looking at weekends as week beginnings instead, so I want the Org agenda to start on Saturdays.

(setq org-agenda-start-on-weekday 6)
Display projects with associated subtasks

I wanted a view that showed projects with a few subtasks underneath them. Here's a sample of the output:

Headlines with TAGS match: +PROJECT
Press `C-u r' to search again with new search string
  organizer:  Set up communication processes for Awesome Foundation Toronto
  organizer:  TODO Announce the next pitch night
  organizer:  TODO Follow up with the winner of the previous pitch night for any news to include in the updates

  organizer:  Tidy up the house so that I can find things quickly
  organizer:  TODO Inventory all the things in closets and boxes         :@home:
  organizer:  TODO Drop things off for donation                       :@errands:

  organizer:  Learn how to develop for Android devices
(defun my/org-agenda-project-agenda ()
  "Return the project headline and up to `org-agenda-max-entries' tasks."
    (let* ((marker (org-agenda-new-marker))
            (org-agenda-format-item "" (org-get-heading) (org-get-category) nil))
           (org-agenda-restrict t)
           (org-agenda-restrict-begin (point))
           (org-agenda-restrict-end (org-end-of-subtree 'invisible))
           ;; Find the TODO items in this subtree
           (list (org-agenda-get-day-entries (buffer-file-name) (calendar-current-date) :todo)))
      (org-add-props heading
          (list 'face 'defaults
                'done-face 'org-agenda-done
                'undone-face 'default
                'mouse-face 'highlight
                'org-not-done-regexp org-not-done-regexp
                'org-todo-regexp org-todo-regexp
                'org-complex-heading-regexp org-complex-heading-regexp
                (format "mouse-2 or RET jump to org file %s"
                         (or (buffer-file-name (buffer-base-buffer))
                             (buffer-name (buffer-base-buffer))))))
        'org-marker marker
        'org-hd-marker marker
        'org-category (org-get-category)
        'type "tagsmatch")
      (concat heading "\n"
              (org-agenda-finalize-entries list)))))

(defun my/org-agenda-projects-and-tasks (match)
  "Show TODOs for all `org-agenda-files' headlines matching MATCH."
  (interactive "MString: ")
  (let ((todo-only nil))
    (if org-agenda-overriding-arguments
        (setq todo-only (car org-agenda-overriding-arguments)
              match (nth 1 org-agenda-overriding-arguments)))
    (let* ((org-tags-match-list-sublevels
           (completion-ignore-case t)
           rtn rtnall files file pos matcher
      (when (and (stringp match) (not (string-match "\\S-" match)))
        (setq match nil))
      (when match
        (setq matcher (org-make-tags-matcher match)
              match (car matcher) matcher (cdr matcher)))
      (catch 'exit
        (if org-agenda-sticky
            (setq org-agenda-buffer-name
                  (if (stringp match)
                      (format "*Org Agenda(%s:%s)*"
                              (or org-keys (or (and todo-only "M") "m")) match)
                    (format "*Org Agenda(%s)*" (or (and todo-only "M") "m")))))
        (org-agenda-prepare (concat "TAGS " match))
        (org-compile-prefix-format 'tags)
        (org-set-sorting-strategy 'tags)
        (setq org-agenda-query-string match)
        (setq org-agenda-redo-command
              (list 'org-tags-view `(quote ,todo-only)
                    (list 'if 'current-prefix-arg nil `(quote ,org-agenda-query-string))))
        (setq files (org-agenda-files nil 'ifmode)
              rtnall nil)
        (while (setq file (pop files))
          (catch 'nextfile
            (org-check-agenda-file file)
            (setq buffer (if (file-exists-p file)
                             (org-get-agenda-file-buffer file)
                           (error "No such file %s" file)))
            (if (not buffer)
                ;; If file does not exist, error message to agenda
                (setq rtn (list
                           (format "ORG-AGENDA-ERROR: No such org-file %s" file))
                      rtnall (append rtnall rtn))
              (with-current-buffer buffer
                (unless (derived-mode-p 'org-mode)
                  (error "Agenda file %s is not in `org-mode'" file))
                    (if org-agenda-restrict
                        (narrow-to-region org-agenda-restrict-begin
                    (setq rtn (org-scan-tags 'my/org-agenda-project-agenda matcher todo-only))
                    (setq rtnall (append rtnall rtn))))))))
        (if org-agenda-overriding-header
            (insert (org-add-props (copy-sequence org-agenda-overriding-header)
                        nil 'face 'org-agenda-structure) "\n")
          (insert "Headlines with TAGS match: ")
          (add-text-properties (point-min) (1- (point))
                               (list 'face 'org-agenda-structure
                                     (concat "Match: " match)))
          (setq pos (point))
          (insert match "\n")
          (add-text-properties pos (1- (point)) (list 'face 'org-warning))
          (setq pos (point))
          (unless org-agenda-multi
            (insert "Press `C-u r' to search again with new search string\n"))
          (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
        (org-agenda-mark-header-line (point-min))
        (when rtnall
          (insert (mapconcat 'identity rtnall "\n") ""))
        (goto-char (point-min))
        (or org-agenda-multi (org-agenda-fit-window-to-buffer))
        (add-text-properties (point-min) (point-max)
                             `(org-agenda-type tags
                                               org-last-args (,todo-only ,match)
                                               org-redo-cmd ,org-agenda-redo-command
                                               org-series-cmd ,org-cmd))
        (setq buffer-read-only t)))))
Org agenda custom commands

There are quite a few custom commands here, and I often forget to use them. =) But it's good to define them, and over time, I'll get the hang of using these more!

Key Description
. What am I waiting for?
T Not really an agenda command - shows the to-do tree in the current file
b Shows business-related tasks
o Shows personal tasks and miscellaneous tasks (o: organizer)
w Show all tasks for the upcoming week
W Show all tasks for the upcoming week, aside from the routine ones
g … Show tasks by context: b - business; c - coding; w - writing; p - phone; d - drawing, h - home
0 Show common contexts with up to 3 tasks each, so that I can choose what I feel like working on
) (shift-0) Show common contexts with all the tasks associated with them
9 Show common contexts with up to 3 unscheduled tasks each
( (shift-9) Show common contexts with all the unscheduled tasks associated with them
d Timeline for today (agenda, clock summary)
u Unscheduled tasks to do if I have free time
U Unscheduled tasks that are not part of projects
P Tasks by priority
p My projects
2 Projects with tasks
(bind-key "<apps> a" 'org-agenda)
(defvar my/org-agenda-contexts
  '((tags-todo "phone")
    (tags-todo "work")
    (tags-todo "drawing")
    (tags-todo "coding")
    (tags-todo "writing")
    (tags-todo "computer")
    (tags-todo "home")
    (tags-todo "errands"))
  "Usual list of contexts.")
(defun my/org-agenda-skip-scheduled ()
  (org-agenda-skip-entry-if 'scheduled 'deadline 'regexp "\n]+>"))
(setq org-agenda-custom-commands
      `(("a" "Agenda"
         ((agenda "" ((org-agenda-span 2)))
          ;; Unscheduled
          (tags-todo "TODO=\"TODO\"-project-cooking-routine-errands-shopping-video-evilplans" 
                     ((org-agenda-skip-function 'my/org-agenda-skip-scheduled)
                      (org-agenda-overriding-header "Unscheduled TODO entries: ")
                      (org-agenda-sorting-strategy '(priority-down effort-up tag-up category-keep))))
          ;; Active projects
          (tags "+project-someday-TODO=\"DONE\"-TODO=\"SOMEDAY\"-inactive-evilplans"
                ((org-tags-exclude-from-inheritance '("project"))
                 (org-agenda-overriding-header "Projects: ")
                 (org-agenda-sorting-strategy '(priority-down tag-up category-keep effort-down))))
        ("t" tags-todo "-cooking"
         ((org-agenda-sorting-strategy '(todo-state-up priority-down effort-up))))
        ("T" tags-todo "TODO=\"TODO\"-goal-routine-cooking-SCHEDULED={.+}" nil "~/cloud/agenda/nonroutine.html")
        ("f" tags-todo "focus-TODO=\"DONE\"-TODO=\"CANCELLED\"")
        ("b" todo ""
         ((org-agenda-files '("~/personal/"))))
        ("B" todo ""
         ((org-agenda-files '("~/Dropbox/books"))))
        ("x" "Column view" todo ""  ; Column view
         ((org-agenda-prefix-format "")
          (org-agenda-cmp-user-defined 'my/org-sort-agenda-items-todo)
          (org-agenda-view-columns-initially t)
        ;; Weekly review
        ("w" "Weekly review" agenda ""
         ((org-agenda-span 7)
          (org-agenda-log-mode 1)) "~/cloud/agenda/this-week.html")
        ("W" "Weekly review sans routines" agenda ""
         ((org-agenda-span 7)
          (org-agenda-log-mode 1)
          (org-agenda-tag-filter-preset '("-routine"))) "~/cloud/agenda/this-week-nonroutine.html")
        ("2" "Bi-weekly review" agenda "" ((org-agenda-span 14) (org-agenda-log-mode 1)))
        ("5" "Quick tasks" tags-todo "EFFORT>=\"0:05\"&EFFORT<=\"0:15\"")
        ("0" "Unestimated tasks" tags-todo "EFFORT=\"\"")
        ("gb" "Business" todo ""
         ((org-agenda-files '("~/personal/"))
          (org-agenda-view-columns-initially t)))
        ("gc" "Coding" tags-todo "@coding"
         ((org-agenda-view-columns-initially t)))
        ("gw" "Writing" tags-todo "@writing"
         ((org-agenda-view-columns-initially t)))
        ("gp" "Phone" tags-todo "@phone"
         ((org-agenda-view-columns-initially t)))
        ("gd" "Drawing" tags-todo "@drawing"
         ((org-agenda-view-columns-initially t)))
        ("gh" "Home" tags-todo "@home"
         ((org-agenda-view-columns-initially t)))
        ("gk" "Kaizen" tags-todo "kaizen"
         ((org-agenda-view-columns-initially t))
        ("ge" "Errands" tags-todo "errands"
         ((org-agenda-view-columns-initially t))
        ("c" "Top 3 by context"
         ((org-agenda-sorting-strategy '(priority-up effort-down))
          (org-agenda-max-entries 3)))
        ("C" "All by context"
         ((org-agenda-sorting-strategy '(priority-down effort-down))
          (org-agenda-max-entries nil)))
        ("9" "Unscheduled top 3 by context"
         ((org-agenda-skip-function 'my/org-agenda-skip-scheduled)
          (org-agenda-sorting-strategy '(priority-down effort-down))
          (org-agenda-max-entries 3)))
        ("(" "All unscheduled by context"
         ((org-agenda-skip-function 'my/org-agenda-skip-scheduled)
          (org-agenda-sorting-strategy '(priority-down effort-down))
        ("d" "Timeline for today" ((agenda "" ))
         ((org-agenda-ndays 1)
          (org-agenda-show-log t)
          (org-agenda-log-mode-items '(clock closed))
          (org-agenda-clockreport-mode t)
          (org-agenda-entry-types '())))
        ("." "Waiting for" todo "WAITING")
        ("u" "Unscheduled tasks" tags-todo "-someday-TODO=\"SOMEDAY\"-TODO=\"DELEGATED\"-TODO=\"WAITING\"-project-cooking-routine"
         ((org-agenda-skip-function 'my/org-agenda-skip-scheduled)
          (org-agenda-view-columns-initially nil)
          (org-tags-exclude-from-inheritance '("project"))
          (org-agenda-overriding-header "Unscheduled TODO entries: ")
          (org-columns-default-format "%50ITEM %TODO %3PRIORITY %Effort{:} %TAGS")
          (org-agenda-sorting-strategy '(todo-state-up priority-down effort-up tag-up category-keep))))
        ("r" "Unscheduled, untagged tasks" tags-todo "-someday-TODO=\"SOMEDAY\"-TODO=\"DELEGATED\"-TODO=\"WAITING\"-project-cooking-routine-evilplans-computer-writing-phone-sewing-home-errands-shopping"
         ((org-agenda-skip-function 'my/org-agenda-skip-scheduled)
          (org-agenda-view-columns-initially nil)
          (org-tags-exclude-from-inheritance '("project"))
          (org-agenda-overriding-header "Unscheduled TODO entries: ")
          (org-columns-default-format "%50ITEM %TODO %3PRIORITY %Effort{:} %TAGS")
          (org-agenda-sorting-strategy '(todo-state-up priority-down effort-up tag-up category-keep))))
        ("s" "Someday" tags-todo "TODO=\"SOMEDAY\""
         ((org-agenda-skip-function 'my/org-agenda-skip-scheduled)
          (org-agenda-view-columns-initially nil)
          (org-tags-exclude-from-inheritance '("project"))
          (org-agenda-overriding-header "Someday: ")
          (org-columns-default-format "%50ITEM %TODO %3PRIORITY %Effort{:} %TAGS")
          (org-agenda-sorting-strategy '(todo-state-up priority-down effort-up tag-up category-keep))))
        ("U" "Unscheduled tasks outside projects" tags-todo "-project-cooking-routine"
         ((org-agenda-skip-function 'my/org-agenda-skip-scheduled)
          (org-tags-exclude-from-inheritance nil)
          (org-agenda-view-columns-initially nil)
          (org-agenda-overriding-header "Unscheduled TODO entries outside projects: ")
          (org-agenda-sorting-strategy '(todo-state-up priority-down tag-up category-keep effort-down))))
        ("P" "By priority"
         ((tags-todo "+PRIORITY=\"A\"")
          (tags-todo "+PRIORITY=\"B\"")
          (tags-todo "+PRIORITY=\"\"")
          (tags-todo "+PRIORITY=\"C\""))
         ((org-agenda-prefix-format "%-10c %-10T %e ")
          (org-agenda-sorting-strategy '(priority-down tag-up category-keep effort-down))))
        ("pp" tags "+project-someday-TODO=\"DONE\"-TODO=\"SOMEDAY\"-inactive"
         ((org-tags-exclude-from-inheritance '("project"))
          (org-agenda-sorting-strategy '(priority-down tag-up category-keep effort-down))))
        ("p." tags "+project-TODO=\"DONE\""
         ((org-tags-exclude-from-inheritance '("project"))
          (org-agenda-sorting-strategy '(priority-down tag-up category-keep effort-down))))
        ("S" tags-todo "TODO=\"STARTED\"")
        ("C" "Cooking"
         ((tags "vegetables")
          (tags "chicken")
          (tags "beef")
          (tags "pork")
          (tags "other"))
         ((org-agenda-files '("~/orgzly/"))
          (org-agenda-view-columns-initially t)
          (org-agenda-sorting-strategy '(scheduled-up time-down todo-state-up)))
        ("8" "List projects with tasks" my/org-agenda-projects-and-tasks
         ((org-agenda-max-entries 3)))))

Make it easy to mark a task as done

Great for quickly going through the to-do list. Gets rid of one extra keystroke. ;)

(defun my/org-agenda-done (&optional arg)
  "Mark current TODO as done.
This changes the line at point, all other lines in the agenda referring to
the same tree node, and the headline of the tree node in the Org-mode file."
  (interactive "P")
  (org-agenda-todo "DONE"))
;; Override the key definition for org-exit
(define-key org-agenda-mode-map "x" 'my/org-agenda-done)
Make it easy to mark a task as done and create a follow-up task
  (defun my/org-agenda-mark-done-and-add-followup ()
    "Mark the current TODO as done and add another task after it.
Creates it at the same level as the previous task, so it's better to use
this with to-do items than with projects or headings."
    (org-agenda-todo "DONE")
    (org-capture 0 "t"))
;; Override the key definition
(define-key org-agenda-mode-map "X" 'my/org-agenda-mark-done-and-add-followup)
Capture something based on the agenda
(defun my/org-agenda-new ()
  "Create a new note or task at the current agenda item.
Creates it at the same level as the previous task, so it's better to use
this with to-do items than with projects or headings."
  (org-capture 0))
;; New key assignment
(define-key org-agenda-mode-map "N" 'my/org-agenda-new)
Sorting by date and priority
(setq org-agenda-sorting-strategy
      '((agenda time-up priority-down tag-up category-keep effort-up)
        ;; (todo user-defined-up todo-state-up priority-down effort-up)
        (todo todo-state-up priority-down effort-up) 
        (tags user-defined-up)
        (search category-keep)))
(setq org-agenda-cmp-user-defined 'my/org-sort-agenda-items-user-defined)
(require 'cl)
(defun my/org-get-context (txt)
  "Find the context."
  (car (member-if
        (lambda (item) (string-match "@" item))
        (get-text-property 1 'tags txt))))

(defun my/org-compare-dates (a b)
  "Return 1 if A should go after B, -1 if B should go after A, or 0 if a = b."
   ((and (= a 0) (= b 0)) nil)
   ((= a 0) 1)
   ((= b 0) -1)
   ((> a b) 1)
   ((< a b) -1)
   (t nil)))

(defun my/org-complete-cmp (a b)
  (let* ((state-a (or (get-text-property 1 'todo-state a) ""))
         (state-b (or (get-text-property 1 'todo-state b) "")))
     (if (member state-a org-done-keywords-for-agenda) 1)
     (if (member state-b org-done-keywords-for-agenda) -1))))

(defun my/org-date-cmp (a b)
  (let* ((sched-a (or (get-text-property 1 'org-scheduled a) 0))
         (sched-b (or (get-text-property 1 'org-scheduled b) 0))
         (deadline-a (or (get-text-property 1 'org-deadline a) 0))
         (deadline-b (or (get-text-property 1 'org-deadline b) 0)))
      (my/org-min-date sched-a deadline-a)
      (my/org-min-date sched-b deadline-b)))))

(defun my/org-min-date (a b)
  "Return the smaller of A or B, except for 0."
  (funcall (if (and (> a 0) (> b 0)) 'min 'max) a b))

(defun my/org-sort-agenda-items-user-defined (a b)
  ;; compare by deadline, then scheduled date; done tasks are listed at the very bottom
   (my/org-complete-cmp a b)
   (my/org-date-cmp a b)))

(defun my/org-context-cmp (a b)
  "Compare CONTEXT-A and CONTEXT-B."
  (let ((context-a (my/org-get-context a))
        (context-b (my/org-get-context b)))
     ((null context-a) +1)
     ((null context-b) -1)
     ((string< context-a context-b) -1)
     ((string< context-b context-a) +1)
     (t nil))))

(defun my/org-sort-agenda-items-todo (a b)
   (org-cmp-time a b)
   (my/org-complete-cmp a b)
   (my/org-context-cmp a b)
   (my/org-date-cmp a b)
   (org-cmp-todo-state a b)
   (org-cmp-priority a b)
   (org-cmp-effort a b)))
Preventing things from falling through the cracks

This helps me keep track of unscheduled tasks, because I sometimes forget to assign tasks a date. I also want to keep track of stuck projects.

(defun my/org-agenda-list-unscheduled (&rest ignore)
  "Create agenda view for tasks that are unscheduled and not done."
  (let* ((org-agenda-todo-ignore-with-date t)
   (org-agenda-overriding-header "List of unscheduled tasks: "))
(setq org-stuck-projects
Synchronizing with Google Calendar
(defun my/org-gcal-notify (title mes)
  (message "%s - %s" title mes))
(use-package org-gcal
  :load-path "~/elisp/org-gcal.el"
  :init (fset 'org-gcal-notify 'my/org-gcal-notify))
(defun my/org-show-active-projects ()
  "Show my current projects."
  (org-tags-view nil "project-inactive-someday"))


Weekly review

I regularly post weekly reviews to keep track of what I'm done, remind me to plan for the upcoming week, and list blog posts, sketches, and links. I want to try out grouping tasks by topic first, then breaking it down into previous/next week.

(defvar my/weekly-review-line-regexp
  "^  \\([^:]+\\): +\\(Sched[^:]+: +\\)?TODO \\(.*?\\)\\(?:[      ]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[        ]*$"
  "Regular expression matching lines to include.")
(defvar my/weekly-done-line-regexp
  "^  \\([^:]+\\): +.*?\\(?:Clocked\\|Closed\\):.*?\\(TODO\\|DONE\\) \\(.*?\\)\\(?:[       ]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[        ]*$"
  "Regular expression matching lines to include as completed tasks.")

(defun my/quantified-get-hours (category time-summary)
  "Return the number of hours based on the time summary."
  (if (stringp category)
      (if (assoc category time-summary) (/ (cdr (assoc category time-summary)) 3600.0) 0)
    (apply '+ (mapcar (lambda (x) (my/quantified-get-hours x time-summary)) category))))

(defun _my/extract-tasks-from-agenda (string matchers prefix line-re)
    (insert string)
    (goto-char (point-min))
    (while (re-search-forward line-re nil t)
      (let ((temp-list matchers))
        (while temp-list
          (if (save-match-data
                (string-match (car (car temp-list)) (match-string 1)))
                (add-to-list (cdr (car temp-list)) (concat prefix (match-string 3)) t)
                (setq temp-list nil)))
          (setq temp-list (cdr temp-list)))))))

(ert-deftest _my/extract-tasks-from-agenda ()
  (let (list-a list-b (line-re "\\([^:]+\\):\\( \\)\\(.*\\)"))
     "listA: Task 1\nother: Task 2\nlistA: Task 3"
     '(("listA" . list-a)
       ("." . list-b))
     "- [ ] "
    (should (equal list-a '("- [ ] Task 1" "- [ ] Task 3")))
    (should (equal list-b '("- [ ] Task 2")))))

(defun _my/get-upcoming-tasks ()
      (org-agenda nil "W")
      (_my/extract-tasks-from-agenda (buffer-string)
                                        '(("routines" . ignore)
                                          ("business" . business-next)
                                          ("people" . relationships-next)
                                          ("tasks" . emacs-next)
                                          ("." . life-next))
                                        "  - [ ] "
(defun _my/get-previous-tasks ()
  (let (string)
      (org-agenda nil "W")
      (org-agenda-later -1)
      (org-agenda-log-mode 16)
      (setq string (buffer-string))
      ;; Get any completed tasks from the current week as well
      (org-agenda-later 1)
      (org-agenda-log-mode 16)
      (setq string (concat string "\n" (buffer-string)))
      (_my/extract-tasks-from-agenda string
                                        '(("routines" . ignore)
                                          ("business" . business)
                                          ("people" . relationships)
                                          ("tasks" . emacs)
                                          ("." . life))
                                        "  - [X] "

(defun my/org-summarize-focus-areas (date)
  "Summarize previous and upcoming tasks as a list."
  (interactive (list (org-read-date-analyze (if current-prefix-arg (org-read-date) "-fri") nil '(0 0 0))))
  (let (business relationships life business-next relationships-next life-next string emacs emacs-next
                 start end time-summary biz-time ignore base-date)
    (setq base-date (apply 'encode-time date))
    (setq start (format-time-string "%Y-%m-%d" (days-to-time (- (time-to-number-of-days base-date) 6))))
    (setq end (format-time-string "%Y-%m-%d" (days-to-time (1+ (time-to-number-of-days base-date)))))
    (setq time-summary (quantified-summarize-time start end))
    (setq biz-time (my/quantified-get-hours "Business" time-summary))
    (setq string
           (format "- *A- (Childcare)* (%.1fh - %d%% of total)\n"
                   (my/quantified-get-hours '("A-") time-summary)
                   (/ (my/quantified-get-hours '("A-") time-summary) 1.68))
           (format "- *Business* (%.1fh - %d%%)\n" biz-time (/ biz-time 1.68))
           (mapconcat 'identity business "\n") "\n"
           (mapconcat 'identity business-next "\n")
           (format "  - *Earn* (%.1fh - %d%% of Business)\n"
                   (my/quantified-get-hours "Business - Earn" time-summary)
                   (/ (my/quantified-get-hours "Business - Earn" time-summary) (* 0.01 biz-time)))
           (format "  - *Build* (%.1fh - %d%% of Business)\n"
                   (my/quantified-get-hours "Business - Build" time-summary)
                   (/ (my/quantified-get-hours "Business - Build" time-summary) (* 0.01 biz-time)))
           (format "  - *Connect* (%.1fh - %d%% of Business)\n"
                   (my/quantified-get-hours "Business - Connect" time-summary)
                   (/ (my/quantified-get-hours "Business - Connect" time-summary) (* 0.01 biz-time)))
           (format "- *Relationships* (%.1fh - %d%%)\n"
                   (my/quantified-get-hours '("Discretionary - Social"
                                                 "Discretionary - Family") time-summary)
                   (/ (my/quantified-get-hours '("Discretionary - Social"
                                                    "Discretionary - Family") time-summary) 1.68))
           (mapconcat 'identity relationships "\n") "\n"
           (mapconcat 'identity relationships-next "\n") "\n"
           (format "- *Discretionary - Productive* (%.1fh - %d%%)\n"
                   (my/quantified-get-hours "Discretionary - Productive" time-summary)
                   (/ (my/quantified-get-hours "Discretionary - Productive" time-summary) 1.68))
           (format "  - *Drawing* (%.1fh)\n"
                   (my/quantified-get-hours '("Discretionary - Productive - Drawing")  time-summary))
           (format "  - *Emacs* (%.1fh)\n"
                   (my/quantified-get-hours "Discretionary - Productive - Emacs" time-summary))
           (mapconcat 'identity emacs "\n") "\n"
           (mapconcat 'identity emacs-next "\n") "\n"
           (format "  - *Coding* (%.1fh)\n"
                   (my/quantified-get-hours "Discretionary - Productive - Coding" time-summary))
           (mapconcat 'identity life "\n") "\n"
           (mapconcat 'identity life-next "\n") "\n"
           (format "  - *Sewing* (%.1fh)\n"
                   (my/quantified-get-hours "Discretionary - Productive - Sewing" time-summary))
           (format "  - *Writing* (%.1fh)\n"
                   (my/quantified-get-hours "Discretionary - Productive - Writing" time-summary))
           (format "- *Discretionary - Play* (%.1fh - %d%%)\n"
                   (my/quantified-get-hours "Discretionary - Play" time-summary)
                   (/ (my/quantified-get-hours "Discretionary - Play" time-summary) 1.68))
           (format "- *Personal routines* (%.1fh - %d%%)\n"
                   (my/quantified-get-hours "Personal" time-summary)
                   (/ (my/quantified-get-hours "Personal" time-summary) 1.68))
           (format "- *Unpaid work* (%.1fh - %d%%)\n"
                   (my/quantified-get-hours "Unpaid work" time-summary)
                   (/ (my/quantified-get-hours "Unpaid work" time-summary) 1.68))
           (format "- *Sleep* (%.1fh - %d%% - average of %.1f per day)\n"
                   (my/quantified-get-hours "Sleep" time-summary)
                   (/ (my/quantified-get-hours "Sleep" time-summary) 1.68)
                   (/ (my/quantified-get-hours "Sleep" time-summary) 7)
    (if (called-interactively-p 'any)
        (insert string)

I use this to put together a quick summary of how I spent my time.

The following code makes it easy to add a line:

(defun my/org-add-line-item-task (task)
  (interactive "MTask: ")
  (insert "[ ] " task)
  (let ((org-capture-entry '("t" "Tasks" entry
                             (file+headline "~/sync/orgzly/" "Tasks")
    (org-capture nil "t")
    (insert "TODO " task "\nSCHEDULED: <" (org-read-date) ">")))
;(define-key org-mode-map (kbd "C-c t") 'my/org-add-line-item-task)

Now we put it all together…

 (defun my/org-prepare-weekly-review (&optional date skip-urls)
   "Prepare weekly review template."
   (interactive (list (org-read-date))) 
   (let ((base-date (apply 'encode-time (org-read-date-analyze date nil '(0 0 0))))
         start end links prev)
     (setq start (format-time-string "%Y-%m-%d 0:00" (days-to-time (- (time-to-number-of-days base-date) 6)) (current-time-zone)))
     (setq end (format-time-string "%Y-%m-%d 0:00" (days-to-time (1+ (time-to-number-of-days base-date))) (current-time-zone)))
     (setq prev (format-time-string "%Y-%m-%d 0:00" (days-to-time (- (time-to-number-of-days base-date) 7 6)) (current-time-zone)))
      "** Weekly review: Week ending " (format-time-string "%B %e, %Y" base-date) "  :weekly:\n"
      (my/org-summarize-journal-csv start end nil my/journal-category-map my/journal-categories)
      "\n\n*Blog posts*\n\n"
      (my/org-list-from-rss "" start end)
      (my/sketches-export-and-extract start end) "\n"
       (my/quantified-compare prev start start end
                                "Discretionary - Play"
                                "Unpaid work"
                                "Discretionary - Social"
                                "Discretionary - Family"
                                "Discretionary - Productive"
                              "The other week %" "Last week %")
(defun my/prepare-missing-weekly-reviews ()
  "Prepare missing weekly reviews based on LAST_REVIEW property."
  (let ((today (substring (org-read-date nil nil ".") 0 10))
         (date (org-entry-get (point) "LAST_REVIEW")))
    (while (string< date today)
      (setq date (substring (org-read-date nil nil "++1w" nil (org-time-string-to-time date)) 0 10))
      (unless (string< today date)
          (my/org-prepare-weekly-review date))
        (org-entry-put (point) "LAST_REVIEW" date)))))
  • Flickr extract
      (defun _my/clean-up-flickr-list (list)
        (setq list
              (replace-regexp-in-string "\\[\"" "[" list))
        (setq list
              (replace-regexp-in-string "<a href=\"\"\\([^\"]+\\).*?>.*?</a>"
                                        "[[\\1][\\2]]" list))
        (setq list
              (replace-regexp-in-string "\"
    " "" (replace-regexp-in-string "\"\\]" "]" list))))
      (defun _my/format-flickr-link-for-org (x)
        (let ((title (assoc-default "FileName" x)))
           "- %s %s"
             (assoc-default "URL" x)
           (if (string= (assoc-default "Description" x) "")
             (concat "- "
                      "<a href=\"\"\\(.*?\\)\"\".*?>\\(.*?\\)</a>"
                      (lambda (string)
                         (match-string 1 string)
                         (match-string 2 string)))
                      (assoc-default "Description" x)))))))
      (defun _my/parse-and-filter-flickr-csv-buffer (start end)
         (delq nil
               (mapcar (lambda (x)
                         (if (and (string< (assoc-default "FileName" x) end)
                                  (org-string<= start (assoc-default "FileName" x)))
                       (csv-parse-buffer t)))
         (lambda (a b)
           (string< (assoc-default "FileName" a)
                    (assoc-default "FileName" b)))))
      (defun my/sketches-export-and-extract (start end &optional do-insert update-db filter)
        "Create a list of links to sketches."
        (interactive (list (org-read-date) (org-read-date) t current-prefix-arg (read-string "Filter: ")))
        (let ((value
                ((eq system-type 'windows-nt)
                 (when update-db (shell-command "c:/sacha/dropbox/bin/flickr.bat"))
                 (my/flickr-extract-links-for-review "c:/sacha/dropbox/bin/flickr_metadata.csv" start end))
                ;; ((eq system-type 'gnu/linux)  ; Flickr
                ;;  (shell-command-to-string
                ;;  (format "cd /home/sacha/code/node; nodejs flickr-list.js -b \"%s\" -e \"%s\" -f \"%s\"" 
                ;;   (or start "") (or end "") (or filter ""))))
                ;; below method not used at the moment, but useful if flickr is being weird
                ((and t (eq system-type 'gnu/linux)) ;; Create links to; not used at the moment
                 ;; because Org does weird things with escaped # links
                  (lambda (filename)
                    (let ((base (file-name-nondirectory filename)))
                      (format "- %s\n"
                               (replace-regexp-in-string "#" "%23"
                                                         (concat ""
                                                                 (if (string-match "^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9][a-z]" base)
                                                                     (concat "id/" (match-string 0 base))
                                                                   (concat "filename/" base))))
                  (let ((my/sketch-directories '("~/sketches"))) (my/get-sketch-filenames-between-dates start end filter))
          (if do-insert
              (insert value)
    ;; (my/sketches-export-and-extract "2015-11-01" "2015-12-01")
      (defun my/flickr-extract-links-for-review (filename start end)
      "Extract Flickr titles and URLs from FILENAME from START to END.
      The file should be a CSV downloaded by the Flickr metadata downloader.
             Start date and end date should be strings in the form yyyy-mm-dd."
        (require 'csv)
        (let (list)
            (insert-file-contents filename)
            (goto-char (point-min))
            (setq list
                   (_my/parse-and-filter-flickr-csv-buffer start end)
            (setq list (_my/clean-up-flickr-list list))
            (if (called-interactively-p 'any)
                (insert list)
    (defun my/replace-flickr-links-with-sketches ()
      (while (re-search-forward
              "\\[\\[\\(https://www\\.flickr\\.com/photos/sachac/.*?\\)\\]\\[\\([0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9][a-z]\\) " nil t)
        (replace-match "\\2" t nil nil 1)))
  • Link-related convenience functions
    (defun kensanata/resolve-redirect (url)
      "Resolve shortened URL by launching `curl --head' and parsing the result."
      (let* ((curl (shell-command-to-string
                    (format "curl --silent --head %s" url)))
             (location (when (and (string-match "^HTTP/1\.1 301" curl)
                                  (string-match "^Location: \\(.*\\)" curl))
                         (match-string 1 curl))))
        (or location url)))
    (defun my/resolve-urls-in-region (beg end)
      "Expand URLs between BEG and END."
      (interactive "r")
          (narrow-to-region beg end)
          (goto-char (point-min))
          (while (re-search-forward org-bracket-link-regexp nil t)
            (replace-match (save-match-data (kensanata/resolve-redirect
                                             (match-string 1))) t t nil 1))
          (goto-char (point-min))
          (while (re-search-forward org-link-re-with-space nil t)
            (replace-match (save-match-data (kensanata/resolve-redirect
                                             (match-string 0))) t t nil)))))
    (defun my/open-urls-in-region (beg end)
      "Open URLs between BEG and END.
    TODO: Get better at detecting and opening all URLs"
      (interactive "r")
          (narrow-to-region beg end)
          (goto-char (point-min))
          (while (re-search-forward org-any-link-re nil t)
  • Evernote-related extract
    (defun my/evernote-export-and-extract (start-date end-date)
      "Extract notes created on or after START-DATE and before END-DATE."
      (let ((filename "c:/sacha/tmp/Evernote.enex"))
         "c:/Program Files (x86)/Evernote/Evernote/enscript.exe"
         nil t t
         "/q" (concat
               " tag:roundup"
               " created:" (replace-regexp-in-string "-" "" start-date)
               " -created:" (replace-regexp-in-string "-" "" end-date))
         "/f" filename)
        (my/evernote-extract-links-for-review filename)))
    (defun my/evernote-extract-links-for-review (filename)
      "Extract note names and URLs from FILENAME.
         The file should be an ENEX export."
      (interactive (list (read-file-name "File: ")
      (let (list)
          (insert-file-contents filename)
          (goto-char (point-min))
          (while (re-search-forward "<title>\\(.+?\\)</title>\\(.*?\n\\)*?via Diigo.*?href=\"\\(.*?\\)\"" nil t)
            (setq list
                    (match-string-no-properties 1)
                    (match-string-no-properties 3)) list))))
        (setq list
              (mapconcat (lambda (x)
                           (concat "- [["
                                   (kensanata/resolve-redirect (cdr x))
                                   "][" (car x) "]]: ")) list "\n"))
              (if (called-interactively-p 'any)
                  (insert list)
    • For copying journal entries

        (defun my/evernote-export-and-extract-journal ()
          "Extract and file journal entries."
          (let ((filename "c:\\sacha\\tmp\\journal.enex")
                (journal-file "~/personal/"))
             "c:/Program Files (x86)/Evernote/Evernote/enscript.exe"
             nil t t
             "/q" (concat
                   " notebook:!Inbox"
                   " intitle:Journal")
             "/f" filename)
            (my/evernote-process-journal-entries filename journal-file)))
        (defun my/evernote-process-journal-entries (filename journal-file)
          "Insert all the journal entries if they do not yet exist."
          (let ((data (car (xml-parse-file filename))))
            (mapc (lambda (x)
                    (if (and  (listp x) (equal (car x) 'note))
                        (my/evernote-create-journal-note x journal-file)))
        (defun my/evernote-get-creation-date (note)
          "Return NOTE's created date as (month day year)."
          (let ((created (cadr (assoc-default 'created note))))
            (list (string-to-number (substring created 4 6)) ; month
                  (string-to-number (substring created 6 8)) ; day
                  (string-to-number (substring created 0 4))))) ; year
      (defun my/evernote-create-journal-note (note journal-file)
        "Save the given NOTE to the JOURNAL-FILE."
        (with-current-buffer (find-file journal-file)
          (org-datetree-find-date-create (my/evernote-get-creation-date note))
          (forward-line 1)
          (when (org-at-heading-p) (save-excursion (insert "\n")))
          (let ((content (my/evernote-convert-content-to-org note)))
            (unless (save-excursion
                      (re-search-forward (regexp-quote content)
                      (max (point) (save-excursion (org-end-of-subtree t))) t))
              (insert content)))))
      (defun my/evernote-convert-content-to-org (note)
        "Convert Evernote content for NOTE to HTML"
          (insert (cadr (assoc-default 'content note)))
          (goto-char (point-min))
          (while (re-search-forward "div>" nil t)
            (replace-match "p>"))
          (shell-command-on-region (point-min) (point-max) "pandoc -f html -t org" nil t)
          (goto-char (point-min))
          (while (re-search-forward "^\\\\+" nil t)
           (replace-match ""))
          (goto-char (point-min))
          (while (re-search-forward "\\\\+$" nil t)
           (replace-match ""))
          (goto-char (point-min))
          (while (re-search-forward "\n\n\n+" nil t)
           (replace-match "\n\n"))
          (s-trim (buffer-string))))
Monthly reviews

I want to be able to see what I worked on in a month so that I can write my monthly reviews. This code makes it easy to display a month's clocked tasks and time. I haven't been particularly thorough in tracking time before, but now that I have a shortcut that logs in Quantified Awesome as well as in Org, I should end up clocking more.

(defun my/org-review-month (start-date)
  "Review the month's clocked tasks and time."
  (interactive (list (org-read-date)))
  ;; Set to the beginning of the month
  (setq start-date (concat (substring start-date 0 8) "01"))
  (let ((org-agenda-show-log t)
        (org-agenda-start-with-log-mode t)
        (org-agenda-start-with-clockreport-mode t)
        (org-agenda-clockreport-parameter-plist '(:link t :maxlevel 3)))
    (org-agenda-list nil start-date 'month)))

Here's a function like my/org-prepare-weekly-review:

   (defun _my/extract-posts-from-webpage (url)
     (with-current-buffer (url-retrieve-synchronously url)
       (goto-char (point-min))
       (re-search-forward "<pre>")
        (progn (re-search-forward "</pre>") (match-beginning 0)))))
   (defun my/org-get-last-week ()
     "Return dates for filtering last week."
     (if (string= (format-time-string "%u") "6") ;; my week starts on Saturday
         (cons (org-read-date nil nil "-1w") (org-read-date nil nil "."))
       (cons (org-read-date nil nil "-2sat") (org-read-date nil nil "-sat"))))
   (defun my/org-get-month (&optional date-string)
     "Return start of month containing DATE and start of following month.
Result is (START . NEXT)."
     (let* ((date (decode-time (if (stringp date-string) (org-read-date nil t date-string) date-string)))
            (month (elt date 4))
            (year (elt date 5))
       (calendar-increment-month month year 1)
        (format "%4d-%02d-01" (elt date 5) (elt date 4))
        (format "%4d-%02d-01" year month))))

   (defun my/org-prepare-monthly-review (time)
     (interactive (list (org-read-date nil t)))
     (let* ((date (decode-time time))
            (month (elt date 4))
            (year (elt date 5))
       (calendar-increment-month month year -1)
       (setq start-date (format "%4d-%02d-01 0:00" year month)
             end-date (format "%4d-%02d-01 0:00" (elt date 5) (elt date 4))
             title (format-time-string "%B %Y" (encode-time 0 0 0 1 month year))
             posts (_my/extract-posts-from-webpage
                    (format ""
                            year month))
             sketches (my/sketches-export-and-extract start-date nil nil t))
       (calendar-increment-month month year -1)
       (setq previous-date (format "%4d-%02d-01 0:00" year month))
       (setq time (my/quantified-compare previous-date start-date start-date end-date '("Business" "Discretionary - Play" "Unpaid work" "A-" "Discretionary - Social" "Discretionary - Family" "Sleep" "Discretionary - Productive" "Personal") "Previous month %" "This month %"))
       (goto-char (line-end-position))
        "\n\n** Monthly review: "
        "  :monthly:review:\n\n"
        (my/org-summarize-journal-csv start-date end-date nil my/journal-category-map my/journal-categories '(zid)) "\n\n"
        "*Blog posts*\n"
        posts "\n\n"
        (orgtbl-to-orgtbl time nil))))


Moving lines around

This makes it easier to reorganize lines in my weekly review.

    (defun my/org-move-line-to-destination ()
      "Moves the current list item to <<destination>> in the current buffer.
If no <<destination>> is found, move it to the end of the list
and indent it one level."
          (let ((string
                  (line-beginning-position) (line-end-position)))
            (delete-region (line-beginning-position) (1+ (line-end-position)))
              (goto-char (point-min))
              (when (re-search-forward "<<destination>>" nil t)
                (insert "\n" (make-string (- (match-beginning 0) (line-beginning-position)) ?\ ) (s-trim string))
                (setq found t)))
            (unless found
              (insert string "\n"))))))

(defun my/org-move-line-to-end-of-list ()
  "Move the current list item to the end of the list."
    (let ((string (buffer-substring-no-properties (line-beginning-position)
      (delete-region (line-beginning-position) (1+ (line-end-position)))
      (insert string))))

Organizing my blog index
(defun my/org-file-blog-index-entries ()
  "Keep filing until I press `C-g'."
  (while t
     (line-beginning-position) (1+ (line-end-position))
     (let ((org-refile-targets
            '(("~/code/sharing/" . (:maxlevel . 3)))))
       (save-excursion (org-refile-get-location "Location"))))))

(defun my/org-file-blog-index-entry (beg end location)
  "Copy entries into"
    (if (region-active-p) (point) (line-beginning-position))
    (if (region-active-p) (mark) (1+ (line-end-position)))
    (let ((org-refile-targets
           '(("~/code/sharing/" . (:maxlevel . 3)))))
      (save-excursion (org-refile-get-location "Location")))))
    (let ((s
            "^[ \t]*- \\(\\[X\\] \\)?"
            "- [X] "
            (buffer-substring-no-properties beg end))))
    ;; if we're already in, delete the previous entry
    (if (string= buffer-file-name (expand-file-name "~/code/sharing/"))
        (delete-region beg end))
        (find-file (nth 1 location))
            (goto-char (nth 3 location))
            (re-search-forward org-list-full-item-re nil t)
            (goto-char (line-beginning-position))
            (insert s)
            (org-update-statistics-cookies nil)))))))
Quickly refiling Org Mode notes to headings in the same file

I wanted a quick way to organize random notes from my inbox into an outline, organizing from the bottom up instead of starting with a top-down hierarchy. My old code for refiling to an Org heading in the current buffer didn't work any more, but helm-org-in-buffer-headings seems to be promising. I made it a speed command (see the value of org-use-speed-commands elsewhere in my config) so that I can easily refile.

(defvar my/org-last-refile-marker nil "Marker for last refile")
(defun my/org-refile-in-file (&optional prefix)
  "Refile to a target within the current file."
  (let ((helm-org-headings-actions
         '(("Refile to this heading" . helm-org-heading-refile))))
      (org-end-of-subtree t)
      (setq my/org-last-refile-marker (point-marker)))))

(defun my/org-refile-to-previous ()
  "Refile subtree to last position from `my/org-refile-in-file'."
    (when (eq major-mode 'org-agenda-mode)
      (let* ((marker my/org-last-refile-marker)
              (with-current-buffer (marker-buffer marker)
                (goto-char (marker-position marker))
        (helm-org-goto-marker marker)
        (org-end-of-subtree t t)
        (org-paste-subtree target-level)))))

(add-to-list 'org-speed-commands-user '("w" call-interactively 'my/org-refile-in-file))
(add-to-list 'org-speed-commands-user '("." call-interactively 'my/org-refile-to-previous))

TODO: Figure out why I'm getting duplicates. Next step might be to fiddle with helm-org-in-buffer-headings so that it preselects the previous candidate, but that can happen later.

Tech note: helm-org doesn't use the usual org-refile mechanism. Instead, it cuts the subtree, goes to the marker, and pastes it in at the appropriate level.

Inserting code

(defun my/org-insert-defun (function)
  "Inserts an Org source block with the definition for FUNCTION."
  (interactive (find-function-read))
  (let* ((buffer-point (condition-case nil (find-definition-noselect function nil) (error nil)))
         (new-buf (car buffer-point))
         (new-point (cdr buffer-point))
    (if buffer-point        
      (with-current-buffer new-buf ;; Try to get original definition
          (goto-char new-point)
          (setq definition (buffer-substring-no-properties (point) (save-excursion (end-of-defun) (point))))))
      ;; Fallback: Print function definition
      (setq definition (concat (prin1-to-string (symbol-function function)) "\n")))
    (insert "#+begin_src emacs-lisp\n" definition "#+end_src\n")))


Timestamps and section numbers make my published files look more complicated than they are. Let's turn them off by default.

(setq org-export-with-section-numbers nil)
(setq org-html-include-timestamps nil)
(setq org-export-with-sub-superscripts nil)
(setq org-export-with-toc nil)
(setq org-html-toplevel-hlevel 2)
(setq org-export-htmlize-output-type 'css)

Sometimes I have broken or local links, and that's okay.

(setq org-export-with-broken-links t)

Don't wrap ASCII exports.

(setq org-ascii-text-width 10000)

This makes it easier to publish my files:

    (if (string= system-name "webdev")
       (setq my/emacs-notes-directory "~/code/dev/emacs-notes")
     (setq my/emacs-notes-directory "c:/sacha/code/dev/emacs-notes"))
    (setq org-publish-project-alist
             :base-directory "c:/sacha/Dropbox/public"
             :publishing-directory "c:/sacha/Dropbox/public"
             :publishing-function my/org-html-publish-to-html-trustingly
             :base-directory "c:/sacha/Dropbox/public/sharing"
             :publishing-directory "c:/sacha/Dropbox/public/sharing"
             :publishing-function my/org-html-publish-to-html-trustingly
             :base-directory "~/.emacs.d"
             :publishing-directory "~/.emacs.d"
             :publishing-function my/org-html-publish-to-html-trustingly
             :base-directory "c:/sacha/Dropbox/books"
             :publishing-directory "c:/sacha/Dropbox/books/html"
             :publishing-function my/org-html-publish-to-html-trustingly
             :makeindex t)))
(load "~/code/dev/emacs-chats/build-site.el" t)
(load "~/code/dev/emacs-notes/build-site.el" t)

If a file is in a publishing project, publish it.

(defun my/org-publish-maybe ()
  (require 'ox-publish)
    (if (org-publish-get-project-from-filename
           (buffer-file-name (buffer-base-buffer)) 'up)
           (org-publish-current-file t)

Make it easy to publish and browse a file.

(defun my/org-publish-and-browse ()
  (browse-url (org-export-output-file-name ".html" nil default-directory)))
(bind-key "<apps> b" 'my/org-publish-and-browse)

I use org2blog to post to my blog, which is Wordpress-based. I used to use punchagan's org2blog, but there's a completely different one in ELPA, so I figured I'd give that a try. UPDATE 2014-10-29: Overriding it with the Git version (see the first section of this config) so that I can use thumbnail support for now…

(use-package org2blog
  :commands 'org2blog/wp-post-subtree
    (setq org2blog/wp-track-posts nil)
    (setq org2blog/wp-use-tags-as-categories t)
    (defadvice org2blog/wp-post-buffer (around sacha activate)
    (let ((org-confirm-babel-evaluate nil)
          (org-html-toplevel-hlevel 3))

(defun my/org2blog-subtree ()
  "Post to my blog and get files ready."
  (shell-command "start c:\\sacha\\dropbox\\inbox\\selection")
  (browse-url ""))

(defun my/org2blog-edit-post ()
  "Browse to the edit page."
  (browse-url (concat "" (org-entry-get (point) "POSTID"))))
(use-package htmlize)
Publish without prompting

I want to be able to export without having to say yes to code blocks all the time.

(defun my/org-html-export-trustingly ()
  (let ((org-confirm-babel-evaluate nil))

(defun my/org-html-publish-to-html-trustingly (plist filename pub-dir)
  (let ((org-confirm-babel-evaluate nil))
    (org-html-publish-to-html plist filename pub-dir)))
Stylesheet / header

Might as well take advantage of my stylesheet:

(setq org-html-head "<link rel=\"stylesheet\" type=\"text/css\"
<link rel=\"stylesheet\" type=\"text/css\" href=\"\"></link>
<link rel=\"stylesheet\" type=\"text/css\" href=\"\"></link>
<script src=\"\"></script>")
(setq org-html-htmlize-output-type 'css)
(setq org-src-fontify-natively t)

Make it easy to scroll to the top:

(setq org-html-preamble "<a name=\"top\" id=\"top\"></a>")
(setq org-html-postamble "
<style type=\"text/css\">
.back-to-top {
    position: fixed;
    bottom: 2em;
    right: 0px;
    text-decoration: none;
    color: #000000;
    background-color: rgba(235, 235, 235, 0.80);
    font-size: 12px;
    padding: 1em;
    display: none;

.back-to-top:hover {
    background-color: rgba(135, 135, 135, 0.50);

<div class=\"back-to-top\">
<a href=\"#top\">Back to top</a> | <a href=\"\">E-mail me</a>

<script type=\"text/javascript\">
    var offset = 220;
    var duration = 500;
    jQuery(window).scroll(function() {
        if (jQuery(this).scrollTop() > offset) {
        } else {
Copy region

Sometimes I want a region's HTML in my kill-ring/clipboard without any of the extra fluff:

(defun my/org-copy-region-as-html (beg end &optional level)
  "Make it easier to copy code for Wordpress posts and other things."
  (interactive "r\np")
  (let ((org-export-html-preamble nil)
        (org-html-toplevel-hlevel (or level 3)))
     (org-export-string-as (buffer-substring beg end) 'html t))))

Sometimes I want a subtree:

(defun my/org-copy-subtree-as-html ()
UTF-8 checkboxes

This snippet turns - [X] into ☑ and - [ ] into ☐, but leaves [-] alone.

(setq org-html-checkbox-type 'unicode)
(setq org-html-checkbox-types
 '((unicode (on . "<span class=\"task-done\">&#x2611;</span>")
            (off . "<span class=\"task-todo\">&#x2610;</span>")
            (trans . "<span class=\"task-in-progress\">[-]</span>"))))
Share my Emacs configuration

This code gets around the fact that my config is called, but I want it to export as in my Dropbox's public directory. Although now that I'm shifting to Github Pages, maybe I don't need this any more…

(defun my/org-share-emacs ()
  "Share my Emacs configuration."
  (let* ((destination-dir "~/Dropbox/Public/")
         (destination-filename ""))
    (with-current-buffer (find-file "~/.emacs.d/")
          (write-region (point-min) (point-max)
                        (expand-file-name destination-filename destination-dir))
          (with-current-buffer (find-file-noselect (expand-file-name
                                                    destination-filename destination-dir))
            (org-babel-tangle-file buffer-file-name
                                    "sacha-emacs.el" destination-dir) "emacs-lisp")
(with-eval-after-load 'org
  (require 'ox-latex)
  (add-to-list 'org-latex-classes
               ("\\section\{%s\}" . "\\section*\{%s\}")
               ("\\subsection\{%s\}" . "\\subsection*\{%s\}")
               ("\\subsubsection\{%s\}" . "\\subsubsection*\{%s\}")))
  (add-to-list 'org-latex-classes
               ("\\section\{%s\}" . "\\section*\{%s\}")
               ("\\subsection\{%s\}" . "\\subsection*\{%s\}")
               ("\\subsubsection\{%s\}" . "\\subsubsection*\{%s\}"))))

Fix incompatible changes from Org 8 to Org 9

(defun org-repair-export-blocks ()
  "Repair export blocks and INCLUDE keywords in current buffer."
  (when (eq major-mode 'org-mode)
    (let ((case-fold-search t)
          (back-end-re (regexp-opt
                        '("HTML" "ASCII" "LATEX" "ODT" "MARKDOWN" "MD" "ORG"
                          "MAN" "BEAMER" "TEXINFO" "GROFF" "KOMA-LETTER")
       (goto-char (point-min))
       (let ((block-re (concat "^[ \t]*#\\+BEGIN_" back-end-re)))
           (while (re-search-forward block-re nil t)
             (let ((element (save-match-data (org-element-at-point))))
               (when (eq (org-element-type element) 'special-block)
                   (goto-char (org-element-property :end element))
                   (save-match-data (search-backward "_"))
                   (insert "EXPORT")
                   (delete-region (point) (line-end-position)))
                 (replace-match "EXPORT \\1" nil nil nil 1))))))
       (let ((include-re
              (format "^[ \t]*#\\+INCLUDE: .*?%s[ \t]*$" back-end-re)))
         (while (re-search-forward include-re nil t)
           (let ((element (save-match-data (org-element-at-point))))
             (when (and (eq (org-element-type element) 'keyword)
                        (string= (org-element-property :key element) "INCLUDE"))
               (replace-match "EXPORT \\1" nil nil nil 1)))))))))
(with-eval-after-load 'org
  (add-to-list 'org-mode-hook 'org-repair-export-blocks))


Quick links
  (setq org-link-abbrev-alist
    '(("google" . "")
("gmap" . "")
("blog" . "")))
Custom links


(org-add-link-type "tag" 'endless/follow-tag-link)

(defun endless/follow-tag-link (tag) "Display a list of TODO headlines with tag TAG. With prefix argument, also display headlines without a TODO keyword." (org-tags-view (null current-prefix-arg) tag))

Links from org-protocol

So that I can easily add links at point. Formatted as an Org list for now.

(defun my/org-protocol-insert-link (info) 
  "Store and insert the link at point based on INFO."
  (org-protocol-store-link info)
  (with-current-buffer (window-buffer (selected-window))
    (insert "- ")
    (org-insert-last-stored-link 1)
    (insert "\n")))
(eval-after-load 'org-protocol
 '(add-to-list 'org-protocol-protocol-alist
    '("insert-link" :protocol "insert-link" :function my/org-protocol-insert-link)))
(defun my/org-get-links-in-region (beg end)
    (let (results)
      (goto-char (min beg end))
      (while (re-search-forward org-any-link-re (max beg end) t)
        (add-to-list 'results (org-element-context)))

(defun my/org-dired-file-links-in-region (beg end)
  "Display a Dired buffer for the file links in the selected region."
  (interactive "r")
  (let ((files
          (lambda (x)
            (expand-file-name (org-link-unescape (plist-get (cadr x) :path))))
           (lambda (x)
             (string= (plist-get (cadr x) :type) "file"))
           (my/org-get-links-in-region beg end)))))
    (with-current-buffer (get-buffer-create "*Files*")
      (let ((inhibit-read-only t))
        (apply 'call-process "ls" nil t nil "-lR" files))
      (dired-virtual "/")
      (switch-to-buffer (current-buffer)))))

Journal from Memento Database

  (defvar my/journal-category-map
    '(("Gross" . "Gross motor")
      ("Fine" . "Fine motor")
      ("8 - Kaizen" . "Kaizen")
      ("9 - Us" . "Us")
      ("Self-care" . "Self-care and independence"))
    "Alist of string replacements for journal categories.")
  (defvar my/journal-categories
    '("Kaizen" "Us" "Field trip" "Gross motor" "Fine motor"
      "Sensory" "Language" "Music" "Art"
      "Self-care and independence" "Eating" "Sleep" "Emotion"
      "Household" "Social" "Pretend" "Cognition" "World" "Other" "Oops" "Thoughts")
    "List of categories to display. 
Unknown categories will be added to the end.")

(defun my/journal-date (o) (elt o 3))
(defun my/journal-note (o) (car o))
(defun my/journal-week-highlight (o) (elt o 4))
(defun my/journal-category (o) (elt o 1))
(defun my/journal-pictures (o) (when (string> (elt o 2) "") (split-string (elt o 2) ",")))
(defun my/journal-id (o) (elt o 7))
(defun my/journal-status (o) (elt o 8))
(defun my/journal-other (o) (elt o 9))
(defun my/journal-zidstring (o) (elt o 11))
(defun my/org-group-journal-entries (filtered &optional category-map categories)
  (setq category-map (or category-map (my/journal-category-map)))
  (setq categories (or categories (my/journal-categories)))
  (let* ((grouped (-group-by 'my/journal-category filtered))    
           (lambda (o)
             (cons (or (assoc-default (car o) category-map) (car o))
                   (cdr o)))
          (delq nil
                 (mapcar (lambda (cat)
                           (when (assoc-default cat mapped-list)
                             (cons cat (assoc-default cat mapped-list))))
                 (-remove (lambda (o) (member (car o) categories)) mapped-list)))))

(defun my/org-date-to-string (date &optional base-date)
  "Return the Org date specified by DATE.
This is relative to BASE-DATE if specified."
  (org-read-date nil nil date nil (when base-date (org-read-date nil t base-date))))

(ert-deftest my/org-date-to-string ()
  (should (string= (my/org-date-to-string "++1" "2018-08-01") "2018-08-02")))

(defun my/org-filter-journal-csv (filename &optional from to highlight base-date)
  "Return a list of matching entries."
  (setq from (and from (substring (my/org-date-to-string from base-date) 0 10))
        to (and to (substring (my/org-date-to-string to base-date) 0 10)))
  (let* ((data (pcsv-parse-file filename))
           (lambda (o)
             (let ((date (my/journal-date o)))
               (and (or (null from) (not (string< date from)))
                    (or (null to) (string< date to))
                    (and (not (string= (my/journal-status o) "Deleted")))
                    (not (string-match "^!" (my/journal-note o)))
                      ((null highlight) "true")
                      ((string-equal highlight "week") (my/journal-week-highlight o))
                      (t "true"))))))

(defun my/journal-get-entries (from to &optional search)
      (url-retrieve-synchronously (format "" from to (or search "")))
    (goto-char (point-min))
    (delete-region (point-min) (search-forward "\n\n"))

(defun my/org-journal-summarize (from to &optional search category-map categories)
  (my/org-group-journal-entries (my/journal-get-entries from to search) category-map categories))

(defun my/org-journal-format-tree (groups &optional include)
   (lambda (o)
     (concat "- *" (car o) "*\n"
           (lambda (i)
             (concat "  - "
                     (if (member 'date include) (concat (my/journal-date i) " ") "")
                     (replace-regexp-in-string "\\\"" "\"" (my/journal-note i))
                     (if (member 'zid include) (concat " " (my/journal-zidstring i)) "")
                     ;; (if (string= "" (my/journal-category i))
                     ;;     ""
                     ;;   (format " (%s)" (my/journal-category i)))
           (reverse (cdr o)) "")))
   groups ""))

(defun my/org-summarize-journal-csv (from to &optional search category-map categories include)
    (list (org-read-date nil nil nil "From: ")
          (org-read-date nil nil nil "To: ")
          (read-string "Search: ")
   (let ((list (my/org-journal-format-tree
                  (my/journal-get-entries from to search) 
                  category-map categories)
      (if (called-interactively-p 'any) (insert list) list)))

Some code to talk to Memento Database via Tasker on my phone:

(defun my/format-intent (intent &optional params)
  "Return a command string for sending INTENT with PARAMS.
PARAMS is an alist of (\"key\" . \"value\") pairs."
  (format "am broadcast --user 0 -a %s %s"
           (lambda (o)
              "-e %s %s"
              (shell-quote-argument (car o))
              (shell-quote-argument (cdr o))))
           " ")))

(defun my/send-intent (intent &optional params)
  "Send broadcast INTENT to my phone.
PARAMS is a plist of :key value pairs."
  (let ((command (my/format-intent intent params)))
    (if (my/phone-p)
        (shell-command command)
      (shell-command (format "ssh phone %s" (shell-quote-argument command))))))

(defun my/read-journal-category ()
  (completing-read "Category: " my/journal-categories))

(defun my/update-journal-entry (old-text new-text category)
  (interactive (list (read-string "Old: ")
                     (read-string "New: ")
  (my/send-intent "com.sachachua.journal.categorize"
                  (list (cons "text" old-text)
                        (cons "newtext" (or new-text old-text))
                        (cons "category" (or category "Uncategorized")))))

(defun my/create-journal-entry (new-text category)
  (interactive (list (read-string "Text: ")
  (my/update-journal-entry new-text new-text category))

(defun my/export-journal-entries ()
  "Trigger task to export. Phone must be unlocked."
  (my/send-intent "com.sachachua.journal.export" '(("a" . "b"))))

(use-package csv
  :commands csv--read-line)
(defun my/prompt-for-uncategorized-entries ()
  (let ((key-list '("Note" "Date" "highlight week" "Category" "month" "Time" "Link" "ELECT"))
        x new-text category done)
    (while (and (not (eobp)) (not done))
      (forward-char 1)
      (setq x (csv--read-line key-list))
      (when (string= (assoc-default "Category" x nil "") "")
        (setq text (read-string "Text: " (assoc-default "Note" x nil "")))
        (setq category (completing-read "Category: " (cons "." my/journal-categories)))
        (if (string= category ".")
            (setq done t)
          (my/update-journal-entry (assoc-default "Note" x nil "") text category))))))
(defun my/get-image-caption (file)
  (let ((caption (shell-command-to-string (format "exiftool -s -s -s -ImageDescription %s" (shell-quote-argument file)))))
    (when (> (length caption) 0) (format "#+CAPTION: %s" caption))))

(defun my/insert-image-link-with-caption (file)
  (let ((caption (my/get-image-caption file)))
    (insert (or caption "") (org-link-make-string file) "\n")))

(defun my/caption-current-image ()
  (let ((link (org-element-link-parser)) caption)
    (when (and link (org-element-property :path link))
      (setq caption (my/get-image-caption (org-element-property :path link)))
      (when caption (insert caption)))))

(defun my/set-image-caption (file caption)
  (interactive (list (if (derived-mode-p 'dired-mode) (dired-get-filename) (buffer-file-name))
    (read-string "Caption: ")))
  (shell-command (format "exiftool -ImageDescription=\"%s\" %s" (shell-quote-argument caption) (shell-quote-argument file))))
  (defvar my/photo-directory "/mnt/nfs/photos/inbox")
  (defun my/get-photo-rating (file)
    (let ((rating (shell-command-to-string (concat "exiftool -s -s -s -Rating " (shell-quote-argument file)))))
      (string-to-number rating)))

  (defun my/make-photo-list (start end &optional rating require-description)
    (interactive (list (org-read-date "Start: ") (org-read-date "End: ")))
     (lambda (filename)
       (and (string> (file-name-nondirectory filename) start)
            (string> end (file-name-nondirectory filename))
            (if rating (>= (my/get-photo-rating filename) rating) t)
            (if require-description (my/get-image-caption filename) t)))
     (directory-files my/photo-directory t ".*\\.jpg$")))

  (defun my/org-get-photo (id)
    "Open the photo identified by ID."
    (car (directory-files my/photo-directory t (concat id ".*\\.jpg"))))

  (defun my/org-open-photo (id)
    (find-file (my/org-get-photo id)))

  ;(my/make-photo-list "2018-06-10" "2018-06-15" nil t)
  ;(my/get-photo-rating  (my/org-get-photo "2018-06-10-18-16-31"))

(defun my/org-significant-moments (start end &optional rating)
  (interactive (list (org-read-date "Start: ") (org-read-date "End: ") 3))
  (let ((result
         (mapconcat (lambda (file)
                      (let ((caption (my/get-image-caption file)))
                        (if caption
                            (concat caption (org-link-make-string file) "\n")
                          (concat (org-link-make-string file) "\n"))))
                    (my/make-photo-list start end 3)
    (if (called-interactively-p 'any) (insert result) result)))


Org lets you attach files to an Org file. Haven't gotten the hang of this yet, but looks interesting.

(setq org-attach-store-link-p 'attached)
(setq org-attach-auto-tag nil)


(use-package ob-http)

Diagrams and graphics

Ooooh. Graphviz and Ditaa make it easier to create diagrams from Emacs. See for examples and source.

(setq org-ditaa-jar-path "c:/sacha/Dropbox/bin/ditaa.jar")
(setq org-startup-with-inline-images t)
(use-package org
(add-hook 'org-babel-after-execute-hook 'org-display-inline-images)
 '((dot . t)
   (ditaa . t)
   (emacs-lisp . t)
   (python . t)
   (shell . t)
   (calc . t)
   (sqlite . t)
   (http . t)
   (ledger . t)
   (shell . t)
   (R . t)
   (jupyter . t)))
(setq org-babel-python-command "python3")
(setq python-shell-interpreter "python3")
(add-to-list 'org-src-lang-modes '("dot" . graphviz-dot))))


Good way to remind myself that I have lots of STARTED tasks.

(defun my/org-summarize-task-status ()
  "Count number of tasks by status.
Probably should make this a dblock someday."
  (let (result)
     (lambda ()
       (let ((todo (elt (org-heading-components) 2)))
         (if todo
             (if (assoc todo result)
                 (setcdr (assoc todo result)
                         (1+ (cdr (assoc todo result))))
               (setq result (cons (cons todo 1) result)))))))
    (message "%s" (mapconcat (lambda (x) (format "%s: %d" (car x) (cdr x)))
                             result "\n"))))


(defun my/org-days-between (start end)
  "Number of days between START and END (exclusive).
This includes START but not END."
  (- (calendar-absolute-from-gregorian (org-date-to-gregorian end))
     (calendar-absolute-from-gregorian (org-date-to-gregorian start))))

Literate programming

Editing source code

I don't want to get distracted by the same code in the other window, so I want org src to use the current window.

(setq org-src-window-setup 'current-window)
Copying and sharing code
(defun my/copy-code-as-org-block-and-gist (beg end)
  (interactive "r")
  (let ((filename (file-name-base))
        (mode (symbol-name major-mode))
         (if (use-region-p) (buffer-substring beg end) (buffer-string)))
        (gist (if (use-region-p) (gist-region beg end) (gist-buffer))))
     (format "\n%s\n#+begin_src %s\n%s\n#+end_src\n"
             (org-link-make-string (oref (oref gist :data) :html-url) filename)
             (replace-regexp-in-string "-mode$" "" mode)


(setq calendar-week-start-day 6) ;; My weeks start on Saturday

(defun my/org-get-invoice-range-based-on-date (date)
  (let* ((invoice-date (org-date-to-gregorian date))
         (start (list (1- (car invoice-date)) 1 (elt invoice-date 2)))
         (end (list (car invoice-date) 1 (elt invoice-date 2))))
    (mapcar (lambda (date)
              (format-time-string "%F %H:%M" (encode-time 0 0 0 1 (elt date 0) (elt date 2))))
            (list start end))))

(defun my/org-quantified-get-hours-based-on-range (category start end)
  "Return the number of hours for the specified category."
  (/ (assoc-default category
                    (quantified-summarize-time start end)) 3600.0))

;; TODO: paginate
(defun my/org-quantified-get-detailed-hours-based-on-range (category start end)
  "Return a list of (date week-ending-date dow seconds) for CATEGORY from START to END."
  (let ((entries
         (gethash "entries"
                   (quantified-request (format "records.json?start=%s&end=%s&filter_string=%s&per_page=1000&split=split" start end (url-encode-url category))
                                       nil "GET")))))
     (lambda (entry)
       (let ((time (date-to-time (gethash "timestamp" entry))))
          (format-time-string "%F" time)
          (format-time-string "%F" (my/get-week-end-for-time time))
          (format-time-string "%a" time)
          (gethash "duration" entry))))

(defun my/get-week-end-for-time (time &optional week-ends-on-day)
  "WEEK-ENDS-ON-DAY: 0 is Sunday"
  (let* ((decoded (decode-time time))
         (dow (elt decoded 6))
         (end-week (or week-ends-on-day (% (+ 6 calendar-week-start-day) 7))))
     (elt decoded 0)
     (elt decoded 1)
     (elt decoded 2)
     (+ (elt decoded 3)
        (% (+ 7 (- end-week dow)) 7))
     (elt decoded 4)
     (elt decoded 5))))

(ert-deftest my/org-get-week-ending-date ()
  (let ((calendar-week-start-day 6)
        (tests '(
                 ("2015-09-03" . "2015-09-04")
                 ("2015-12-01" . "2015-12-04")
                 ("2015-12-03" . "2015-12-04")
                 ("2015-12-04" . "2015-12-04")
                 ("2015-12-05" . "2015-12-11"))))
    (dolist (test tests)
      (should (string=
                (my/get-week-end-for-time (org-time-string-to-time (car test))))
               (cdr test)))
      (should (string=
                (my/get-week-end-for-time (org-time-string-to-time (car test)) 5))
               (cdr test))))))

(defun my/org-quantified-format-detailed-hours-as-table (list)
  "Return a table with rows for LIST.
  | Week ending ____ | Sat | Sun | Mon | Tue | Wed | Thu | Fri | Total |
  LIST elements should be in the form (date week-end-date dow seconds).
  See `my/org-quantified-get-detailed-hours-based-on-range'."
  ;; Group by week ending date
  (let ((days '("Sat" "Sun" "Mon" "Tue" "Wed" "Thu" "Fri")))
     (list (append '("Week ending") days '("Total")))
      (lambda (row)
        (let ((day-values (-group-by (lambda (x) (elt x 2)) (cdr row)))
              (week-total 0))
           (list (format "Week ending %s" (format-time-string "%b %-e" (org-time-string-to-time (car row)))))
           (mapcar (lambda (day)
                     (if (assoc-default day day-values)
                         (format "%.1f"
                                 (apply '+
                                         (lambda (day-val) (/ (elt day-val 3) 3600.0))
                                         (assoc-default day day-values))))
           (list (format "%.1f"
                         (apply '+ (mapcar (lambda (day-val) (/ (elt day-val 3) 3600.0)) (cdr row)))))
      (-sort (lambda (a b) (string< (car a) (car b))) (-group-by (lambda (x) (elt x 1)) list))))))

(defun my/org-quantified-hours-table ()
   (apply 'my/org-quantified-get-detailed-hours-based-on-range 
          (org-entry-get-with-inheritance "QUANTIFIED_CATEGORY")
          (my/org-get-invoice-range-based-on-date (org-entry-get-with-inheritance "INVOICE_DATE")))))

(ert-deftest my/org-get-invoice-range-based-on-date ()
  "Check if invoice range is sane."
  (should (equal (my/org-get-invoice-range-based-on-date "2015-12-05")
                 '("2015-11-01 00:00" "2015-12-01 00:00"))))


Don't ask me for confirmation:

(add-to-list 'org-speed-commands-user '("a" call-interactively 'org-archive-subtree-default))


(use-package ox-reveal :disabled t)

Allow dashes in tags

(defun my/org-add-dashes-to-tag-regexps ()
  (setq org-complex-heading-regexp
        (concat "^\\(\\*+\\)"
                "\\(?: +" org-todo-regexp "\\)?"
                "\\(?: +\\(\\[#.\\]\\)\\)?"
                "\\(?: +\\(.*?\\)\\)??"
                (org-re "\\(?:[ \t]+\\(:[-[:alnum:]_@#%:]+:\\)\\)?")
                "[ \t]*$")
        (concat "^\\(\\*+\\)"
                "\\(?: +" org-todo-regexp "\\)?"
                "\\(?: +\\(\\[#.\\]\\)\\)?"
                "\\(?: +"
                ;; Stats cookies can be stuck to body.
                "\\(?:\\[[0-9%%/]+\\] *\\)*"
                "\\(?: *\\[[0-9%%/]+\\]\\)*"
                (org-re "\\(?:[ \t]+\\(:[-[:alnum:]_@#%%:]+:\\)\\)?")
                "[ \t]*$")
        (concat "^\\(\\*+\\)"
                "\\(?: +" org-todo-regexp "\\)?"
                "\\(?: +\\(.*?\\)\\)??"
                (org-re "\\(?:[ \t]+\\(:[-[:alnum:]:_@#%]+:\\)\\)?")
                "[ \t]*$")))
(add-hook 'org-mode-hook 'my/org-add-dashes-to-tag-regexps)

Copying information from my phone

I have a tiny Tasker script that makes it easy to log timestamped entries as files in a directory that I synchronize with Dropbox. This code pulls that information into my ~/Dropbox/tasker/

(defun my/read-phone-entries ()
  "Copy phone data to a summary Org file."
   (lambda (filename)
     (let ((base (file-name-base filename)) contents timestamp category encoded-time date)
       (when (string-match "^[^ ]+ [^ ]+ \\([^ ]+\\) - \\(.*\\)" base)
         (setq time (seconds-to-time (/ (string-to-number (match-string 1 base)) 1000))
               encoded-time (decode-time time)
               date (list (elt encoded-time 4) (elt encoded-time 3) (elt encoded-time 5))
               category (match-string 2 base))
           (insert-file-contents filename)
           (setq contents (s-trim (buffer-string))))
             (find-file "~/dropbox/tasker/summary.txt")
           (org-datetree-find-date-create date)
           (unless (save-excursion (re-search-forward (regexp-quote base) nil t))
             (goto-char (line-end-position))
             (insert "\n")
             (insert "**** " contents "  :" category ":\n" base "\n")
             (insert (format-time-string "[%Y-%m-%d %a %H:%M]\n" time))

             (if (member category '("Think" "Do"))
                   (org-back-to-heading t)
                   (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
                   (unless (looking-at org-todo-regexp)
                     (org-todo "TODO"))))
             (if (string-match "^Energy \\([0-9]\\)" contents)
                 (org-set-property "ENERGY" (match-string 1 contents)))))
         (delete-file filename))))
   (directory-files "~/dropbox/tasker/data" t "\\.txt$")))

Emacs packages, other settings for easy Emacs News generation

Package links
(defun my/org-package-open (package-name)
  (interactive "MPackage name: ")
  (describe-package (intern package-name)))

(ert-deftest my/org-package-export ()
    (my/org-package-export "transcribe" "transcribe" 'html)
    "<a target=\"_blank\" href=\"\">transcribe</a>"
    (my/org-package-export "fireplace" "fireplace" 'html)
    "<a target=\"_blank\" href=\"\">fireplace</a>"
(defun my/org-package-export (link description format)
  (let* ((package-info (car (assoc-default (intern link) package-archive-contents)))
         (package-source (package-desc-archive package-info))
         (path (format
                 ((string= package-source "gnu") "")
                 ((string= package-source "melpa") "")
                 (t (throw 'unknown-source)))
         (desc (or description link)))
     ((eq format 'html) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
     ((eq format 'wp) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
     ((eq format 'latex) (format "\\href{%s}{%s}" path desc))
     ((eq format 'texinfo) (format "@uref{%s,%s}" path desc))
     ((eq format 'ascii) (format "%s <%s>" desc path))
     (t path))))

(org-link-set-parameters "package" :follow 'my/org-package-open :export 'my/org-package-export)
ASCII export

This setting puts Org ASCII export links right after the text instead of in a separate section:

(setq org-ascii-links-to-notes nil)

This one exports links from my secret my/reddit-upvoted-json. You can get your Reddit upvoted JSON URL at .

(defun my/reddit-list-upvoted (date)
  (interactive (list (org-read-date)))
  (let ((threshold (org-read-date nil t (concat (substring date 0 (min (length date) 10)) " 0:00")))
        (url my/reddit-upvoted-json)
    (while url
      (with-current-buffer (url-retrieve-synchronously url)
        (goto-char (point-min))
        (re-search-forward "^$")
        (let* ((data (json-read))
               (items (assoc-default 'children (assoc-default 'data data)))
               (after (assoc-default 'after (assoc-default 'data data)))
                 (lambda (item)
                   (let* ((o (assoc-default 'data item))
                          (title (assoc-default 'title o))
                          (url (helm-html-decode-entities-string (assoc-default 'url o)))
                          (date (seconds-to-time (assoc-default 'created_utc o)))
                          (permalink (concat "" (assoc-default 'permalink o)))
                          (num-comments (assoc-default 'num_comments o 'eq 0)))
                     (when (time-less-p threshold date)
                       (if (and (> num-comments 0) (not (string-match "reddit\\.com" url)))
                           (format "- %s (%s)\n"
                                   (org-link-make-string url title)
                                   (org-link-make-string permalink "Reddit"))
                         (format "- %s\n" (org-link-make-string url title))))))
                 items "")))

          (setq results (concat result "\n" results))
          (setq url
                (if (and after (> (length result) 0))
                    (concat my/reddit-upvoted-json "&after=" after)
;;  (my/reddit-list-upvoted "-mon")
Sorting Org Mode lists using a sequence of regular expressions   emacs org

I manually categorize Emacs News links into an Org unordered list, and then I reorganize the list by using M-S-up (org-shiftmetaup) and M-S-down (org-shiftmetadown). I decide to combine or split categories depending on the number of links. I have a pretty consistent order. John Wiegley suggested promoting Emacs Lisp and Emacs development links at the top of the list. I like to sort the rest of the list roughly by interest: general links first, then Org, then coding, then other links at the bottom.

Here's some code that sorts Org lists in a custom sequence, with unknown items at the bottom for easy re-ordering. It will take a list like:

- Other:
  - Link A
  - Link B
- Emacs development:
  - Link A
  - Link B
- Emacs Lisp:
  - Link A
  - Link B

and turn it into:

- Emacs Lisp:
  - Link A
  - Link B
- Emacs development:
  - Link A
  - Link B
- Other:
  - Link A
  - Link B
(defun my/org-sort-list-in-custom-order (order)
  "Sort the current Org list so that items are in the specified order.
ORDER is a list of regexps."
   nil ?f
   (lambda ()
     (let ((case-fold-search t)
            (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
              (org-sort-remove-invisible (buffer-substring (match-end 0) (point-at-eol))))))
       (or (cl-position item order :test (lambda (a b) (string-match b a))) (1+ (length order)))))

(defun my/emacs-news-sort-list ()
  (goto-char (org-list-get-top-point (org-list-struct)))
     "Emacs configuration"
     "Emacs Lisp"
     "Emacs development"
     "Org Mode"
     "Doom Emacs"
     "Outside Emacs"
     "New packages?")))

One more little thing automated…

Other functions
(defun my/emacs-news-escape-link-description (s)
  (let ((replace-map '(("\\[" . "")
                       ("\\]" . ":"))))
    (mapc (lambda (rule)
            (setq s (replace-regexp-in-string (car rule) (cdr rule) s)))
(use-package xml-rpc)
(defun my/org-list-from-rss (url from-date &optional to-date)
  "Convert URL to an Org list"
  (with-current-buffer (url-retrieve-synchronously url)
    (goto-char (point-min))  
    (re-search-forward "<\\?xml")
    (goto-char (match-beginning 0))
    (let* ((feed (xml-parse-region (point) (point-max)))
          (from-time (org-read-date nil t from-date))
          (to-time (if to-date (org-read-date nil t to-date)))
          (is-rss (> (length (xml-get-children (car feed) 'entry)) 0)))
      (mapconcat (lambda (link)
                   (format "- %s\n" 
                           (org-link-make-string (car link) (cdr link))))
                 (if is-rss
                      (lambda (entry)
                         (xml-get-attribute (car
                                              (seq-filter (lambda (x) (string= (xml-get-attribute x 'rel) "alternate"))
                                                          (xml-get-children entry 'link))
                                              (xml-get-children entry 'link))) 'href)
                         (elt (car (xml-get-children entry 'title)) 2)))
                      (-filter (lambda (entry)
                                 (let ((entry-date (elt (car (xml-get-children entry 'updated)) 2)))
                                    (org-string<= from-date entry-date)
                                    (or (null to-date) (string< entry-date to-date)))))
                               (xml-get-children (car feed) 'entry)))
                   (mapcar (lambda (entry)
                              (caddr (car (xml-get-children entry 'link)))
                              (caddr (car (xml-get-children entry 'title)))))
                           (-filter (lambda (entry)
                                      (let ((entry-time (date-to-time (elt (car (xml-get-children entry 'pubDate)) 2))))
                                         (not (time-less-p entry-time from-time))
                                         (or (null to-time) (time-less-p entry-time to-time)))))
                                    (xml-get-children (car (xml-get-children (car feed) 'channel)) 'item))))

(defun my/describe-packages (list)
  "Return an Org list of package descriptions for LIST."
   (lambda (symbol)
     (let ((package-desc (assoc symbol package-archive-contents)))
       (if package-desc
           (format "  - %s: %s"
                   (org-link-make-string (concat "package:" (symbol-name symbol))
                                         (symbol-name symbol))
                   (package-desc-summary (cadr package-desc)))

(defun my/list-new-packages (&optional date)
  (let ((packages
           (insert-file-contents "~/.emacs-news/package-list.el")
           (goto-char (point-min))
            (reverse (-difference (mapcar 'car package-archive-contents)
                         (mapcar 'car
                                 (seq-filter (lambda (o)
                                               (or (null date) (string< (cdr o) date)))
                                             (read (current-buffer))))))))))
    (if (called-interactively-p 'any)
        (insert packages)

(defun my/save-new-packages ()
  (require 'dash)
  (when package-archive-contents
      (find-file "~/.emacs-news/package-list.el")
      (goto-char (point-min))
      (git-auto-commit-mode 1)
      (let* ((old-list (read (current-buffer)))
             (date (format-time-string "%Y-%m-%d"))
             (new-packages (seq-difference (mapcar 'car package-archive-contents)
                                           (mapcar 'car old-list))))
        (insert "("
                (mapconcat 'prin1-to-string
                           (append (mapcar (lambda (o) (cons o date))
Get info from the Emacs NEWS file in the git repository
(defun my/insert-emacs-news-from-git (date)
  (interactive (list (org-read-date)))
  (let ((result 
         (shell-command-to-string (format "cd ~/vendor/emacs; git pull > /dev/null; git log --pretty=oneline --after=%s etc/NEWS" (substring date 0 10)))))
      (insert result)
      (goto-char (point-min))
      (while (re-search-forward "^\\([0-9a-f]+\\) \\(.+\\)$" nil t)
        (replace-match "  - [[\\1][\\2]]"))
      (setq result (buffer-string)))
    (if (called-interactively-p 'any) (insert result) result)))
DONE Publishing Emacs News as plain text, HTML, and attached Org file

I've been publishing these weekly summaries of Emacs-related links on my blog and to the emacs-tangents mailing list / newsgroup. I started by posting plain text from Org Mode's ASCII export, and people asked for Org Mode and HTML formats. So here's some code that prepares things for pasting into a Gnus message buffer.

It turns out that order matters for multipart/alternative - start with plain text, then include richer alternatives. First time around, I put the HTML version first, so people didn't end up seeing it. Anyway, here's something that shows up properly now: text/plain, then text/html, with text/x-org attached. The heavy lifting is done with org-export-string-as, which exports into different formats.

  (defun my/share-emacs-news ()
    "Prepare current subtree for yanking into post."
    ;; Draft Gnus article
      (let ((org-export-html-preamble nil)
            (org-html-toplevel-hlevel 3)
            (title (org-get-heading))
        (setq output
               "<#multipart type=alternative>
<#part type=\"text/plain\" disposition=inline>

You're receiving this message via the Emacs Tangents mailing list.
View list info/unsubscribe:
<#part type=\"text/html\" disposition=inline>

<p>You're receiving this message via the Emacs Tangents mailing list.<br />
<a href=\"\">View list info/unsubscribe</a></p>

<#part type=\"text/x-org\" disposition=attachment name=\"\">

You're receiving this message via the Emacs Tangents mailing list.
[[][View list info/unsubscribe]]
                (lambda (format)
                  (org-export-string-as (buffer-substring (point-min) (point-max)) format t))
                '(ascii html org))))
        (kill-new output)
        (let ((gnus-newsgroup-name ""))
                  (insert title)
        (insert output)))))

For cleaning things up:

(replace-regexp "    - \\[\\|[][()]" "")

Howard Abrams showed me something like this in June 2015's Emacs Hangout (~1:18:26) using org-mime-org-buffer-htmlize, which probably does the job in a much cooler way. =) I thought he had a blog post about it, but I can't seem to find it. Anyway, there's my little hack above!

TODO Prepare Emacs News
(defvar my/emacs-news-feeds nil "Feeds to check for Emacs-related news")

(setq my/emacs-news-feeds
                                        ;                                                 ";tag%3Demacs"

(defun my/get-rss-items-from-individual-feeds ()
  (mapconcat #'identity
             (delq nil
                   (mapcar (lambda (x)
                             (condition-case nil
                                 (my/org-list-from-rss x (substring date 0 10))
                               (error nil)))
                           my/emacs-news-feeds)) ""))

(defun my/prepare-emacs-news (date parts)
  (interactive (list (org-read-date nil nil "-mon 0:00") '(refresh-packages reddit rss)))
  (setq date (substring date 0 10))
  (when (member 'refresh-packages parts)
   "** " (substring (org-read-date nil nil "++1" nil (org-read-date nil t "-sun 0:00")) 0 10) " Emacs news\n\n"
   (if (member 'git parts)
        "- Emacs development:\n"
        (my/insert-emacs-news-from-git date)
   "- Other:\n"
   (if (member 'rss parts)
       ;; I used to use (my/get-rss-items-from-individual-feeds)
       (my/org-list-from-rss "" (substring date 0 10))
   (if (member 'reddit parts) (my/reddit-list-upvoted (substring date 0 10)) "")
   "- New packages:\n"
   (my/list-new-packages date) 
   "\n\nLinks from "
   (mapconcat (lambda (x) (org-link-make-string (car x) (cdr x)))
              '(("" . "")
                ("" . "r/orgmode")
                ("" . "r/spacemacs")
                ("" . "r/planetemacs")
                ("" . "Hacker News")
                ("" . "")
                ("" . "YouTube")
                ("" . "the Emacs NEWS file"))
              ", ")
   " and "
   (org-link-make-string (concat "" (format-time-string "%Y-%m"))
Collect Emacs News
(defun my/emacs-news-collect-entries ()
  "Collect Emacs News by category and put them in another buffer."
  (let ((parsed (org-element-parse-buffer))
    (setq result
           (lambda (x)
             (concat "* " (car x) "\n\n"
                     (mapconcat (lambda (y) (concat "- " (cdr y))) (cdr x) "")
           (sort (seq-group-by
                  (delq nil
                        (org-element-map parsed '(paragraph)
                          (lambda (x)
                            (let ((contents (org-element-interpret-data x)))
                               ((string-match "^\\(.*\\):[ \t\n]*$" contents)
                                (setq category (match-string-no-properties 1 contents))
                               ((string-match "^\\[" contents)
                                (cons category (substring-no-properties contents)))))))))
                 (lambda (a b) (string< (car a) (car b))))
    (switch-to-buffer (get-buffer-create "*Emacs News*"))
    (insert result)
    (goto-char (point-min))))
DONE Detect duplicates
(defun my/emacs-news-check-duplicates ()
  (let ((end (save-excursion (org-end-of-subtree)))
        (search-fn (lambda (point search description)
                       (goto-char point)
                       (let (found)
                         (if (re-search-forward (regexp-quote search) nil t)
                             (setq found (point))
                           ;; Does this look like a package name?
                           (let ((case-fold-search nil))
                             (when (string-match "^\\([-\\.a-z0-9]+?\\)\\(:\\|\\.el\\) " description)
                               (when (re-search-forward (match-string 1 description) nil t)
                                 (setq found (point))))))
        search start
    (while (and (not done) (re-search-forward "- \\[\\[\\([^[]+\\)\\]\\[\\([^[]+\\)\\]" end t) )
      (setq found nil search (match-string 1) start (match-beginning 0) description (match-string 2))
      (goto-char (match-end 0))
      (let ((p (point)))
        ;; Search for the URL
        (setq found (funcall search-fn (match-end 0) search description))
        (while found
          (goto-char found)
          (setq context
                 (string-join (org-get-outline-path t) " > ") "\n"
                 (buffer-substring (line-beginning-position) (line-end-position))))
          (push-mark found)
          (goto-char start)
          (let ((input (read-char (concat context "\n(d)elete, (k)eep, (z)ap next one, e(x)change mark, (n)ext match, (q)quit?"))))
             ((eq input ?k)
              (setq found nil))
             ((eq input ?x)
              (goto-char found)
              (setq done t found nil))
             ((eq input ?z)
              (goto-char found)
              (delete-region (point-at-bol)
                             (progn (forward-line 1) (point)))
              (goto-char start)
              (setq found nil))
             ((eq input ?d)
              (delete-region (point-at-bol)
                             (progn (forward-line 1) (point)))
              (setq found nil))
             ((eq input ?n)
              ;; Look for the next match
              (setq found (funcall search-fn (save-excursion (goto-char found) (line-end-position))
                                   search description)))
             ((eq input ?q)
              (setq done t found nil)))))))))
Making a numpad-based hydra for organizing Emacs News

I like to categorize links for Emacs News so that it's not an overwhelmingly long wall of text. After I've deleted duplicate links, there are around a hundred links left to categorize. I used to use Helm and some custom code to simplify moving Org list items into different categories in the same list. Then I can type "org" to move something to the Org Mode category and "dev" to move something to the Emacs development category.

When I don't have a lot of computer time, I usually do this categorization by SSHing into my server from my phone. It's hard to type on my phone, though. I thought a numpad-based Hydra might be better for quick entry, like a phone system. I wanted to be able to use the numeric keypad to sort items into the most common categories, with a few shortcuts for making it easier to organize. Here's a list of shortcuts:

0-9 Select options from the list, with 0 for other.
\/ Opens the URL in a web browser
, Selects a category by name, creating as needed
\* Shows the URL in the messages buffer, and toggles it
- Deletes the item
. Quits

Here's what the Helm version looked like on the left, and here's the new numpad-powered one on the right. I liked how fewer buttons made it easier to hit the right one when I'm sorting on my phone. I can add new categories with completion. Because I assigned numbers to specific categories instead of having them automatically calculated based on the headings in the list, it was easy to get into the rhythm of tapping 6 for Org, 7 for coding, and so on.

Comparison of Helm and Hydra approaches

Here's the code that makes it happen. I experimented with dynamically defining a hydra using eval and defmacro so that I could more easily define the menu in a variable. It seems to work fine so far.

(defvar my/org-categorize-emacs-news-menu 
  '(("0" . "Other")
    ("1" . "Emacs Lisp")
    ("2" . "Emacs development")
    ("3" . "Emacs configuration")
    ("4" . "Appearance")
    ("5" . "Navigation")
    ("6" . "Org Mode")
    ("7" . "Coding")
    ("8" . "Community")
    ("9" . "Spacemacs")))

(defun my/org-move-current-item-to-category (category)
  "Move current list item under CATEGORY earlier in the list.
CATEGORY can be a string or a list of the form (text indent regexp).
Point should be on the next line to process, even if a new category
has been inserted."
  (interactive (list (completing-read "Category: " (my/org-get-list-categories))))
  (when category
    (let* ((beg (line-beginning-position))
           (end (line-end-position))
           (string (org-trim (buffer-substring-no-properties beg end)))
           (category-text (if (stringp category) category (elt category 0)))
           (category-indent (if (stringp category) 2 (+ 2 (elt category 1))))
           (category-regexp (if (stringp category) category (elt category 2)))
           (pos (point))
      (delete-region beg (min (1+ end) (point-max)))
      (unless (string= category-text "x")
        (if (re-search-backward category-regexp nil t)
            (forward-line 1)
          (setq s (concat "- " category-text "\n"))
          (insert s)
          (setq pos (+ (length s) pos)))
        (insert (make-string category-indent ?\ )
                string "\n")
        (goto-char (+ pos (length string) category-indent 1))        

 `(defhydra my/org-categorize-emacs-news (global-map "C-c e" :foreign-keys nil)  
       (lambda (x)
         `(,(car x)
           (lambda () (interactive) (my/org-move-current-item-to-category ,(concat (cdr x) ":")))
           ,(cdr x)))
     (lambda () (interactive)
        (completing-read "Category: " (my/org-get-list-categories))))
     "By string")
    ("/" (lambda () (interactive)
             (re-search-forward "\\[\\[")
     (lambda () (interactive)
       (if (string= (buffer-name) "*Messages*")
           (re-search-forward org-link-bracket-re)
           (message (match-string 1)))
         (switch-to-buffer "*Messages*")))
     "Show URL")
    ("-" kill-whole-line "Kill")
    ("p" org-next-link "Previous link")
    ("n" org-next-link "Next link")
    ("h" (lambda () (interactive) (my/org-update-link-description "HN")) "Link HN")
    ("i" (lambda () (interactive) (my/org-update-link-description "Irreal")) "Link Irreal")
    ("." nil "Done")))

Save when Emacs loses focus

(use-package org
  (add-function :after after-focus-change-function 'org-save-all-org-buffers))


Web development

;; from FAQ at for smartparens
(defun my/web-mode-hook ()
  (setq web-mode-enable-auto-pairing nil))

(defun my/sp-web-mode-is-code-context (id action context)
  (when (and (eq action 'insert)
             (not (or (get-text-property (point) 'part-side)
                      (get-text-property (point) 'block-side))))

(use-package web-mode
  :mode "\\.html?\\'"
    (setq web-mode-markup-indent-offset 2)
    (setq web-mode-code-indent-offset 2)
    (setq web-mode-enable-current-element-highlight t)
    (setq web-mode-ac-sources-alist
          '(("css" . (ac-source-css-property))
            ("html" . (ac-source-words-in-buffer ac-source-abbrev)))

Tab width of 2 is compact and readable

(setq-default tab-width 2)

New lines are always indented

I almost always want to go to the right indentation on the next line.

(global-set-key (kbd "RET") 'newline-and-indent)


(defun sanityinc/kill-back-to-indentation ()
  "Kill from point back to the first non-whitespace character on the line."
  (let ((prev-pos (point)))
    (kill-region (point) prev-pos)))

(bind-key "C-M-<backspace>" 'sanityinc/kill-back-to-indentation)

Adapt to being on Windows

I'm on Windows, so I use Cygwin to add Unix-y tools to make my life easier. These config snippets seem to help too.

(when (eq system-type 'windows-nt)
  (setenv "CYGWIN" "nodosfilewarning")
  (setq shell-file-name "C:/emacs/libexec/emacs/24.4/i686-pc-mingw32/cmdproxy.exe")
  (add-hook 'comint-output-filter-functions 'shell-strip-ctrl-m nil t)
  (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt nil t))

Expand region

This is something I have to get the hang of too. It gradually expands the selection. Handy for Emacs Lisp.

(use-package expand-region
  :defer t
  :bind ("C-=" . er/expand-region)
  ("C-<prior>" . er/expand-region)
  ("C-<next>" . er/contract-region))


(eval-after-load 'python-mode
  '(bind-key "C-c C-c" 'compile python-mode-map))

Emacs Lisp


Eldoc provides minibuffer hints when working with Emacs Lisp.

(use-package "eldoc"
  :diminish eldoc-mode
  :commands turn-on-eldoc-mode
  :defer t
  (add-hook 'emacs-lisp-mode-hook 'turn-on-eldoc-mode)
  (add-hook 'lisp-interaction-mode-hook 'turn-on-eldoc-mode)
  (add-hook 'ielm-mode-hook 'turn-on-eldoc-mode)))
Refactoring   drill

More things that I need to get used to…

;; C-c C-v l : elint current buffer in clean environment.
;; C-c C-v L : elint current buffer by multiple emacs binaries.
;;             See `erefactor-lint-emacsen'
;; C-c C-v r : Rename symbol in current buffer.
;;             Resolve `let' binding as long as i can.
;; C-c C-v R : Rename symbol in requiring modules and current buffer.
;; C-c C-v h : Highlight current symbol in this buffer
;;             and suppress `erefacthr-highlight-mode'.
;; C-c C-v d : Dehighlight all by above command.
;; C-c C-v c : Switch prefix bunch of symbols.
;;             ex: '(hoge-var hoge-func) -> '(foo-var foo-func)
;; C-c C-v ? : Display flymake elint warnings/errors

  (use-package erefactor
  :defer t
  :bind (:map emacs-lisp-mode-map ("C-c C-v" . erefactor-map)))

  (use-package paredit :defer t)
  (use-package redshank
    :disabled t
    :defer t
    :init (add-hook 'emacs-lisp-mode-hook 'redshank-mode))

Jumping to code
(define-key emacs-lisp-mode-map (kbd "C-c .") 'find-function-at-point)
(bind-key "C-c f" 'find-function)
  (defun my/sort-sexps-in-region (beg end)
    "Can be handy for sorting out duplicates.
Sorts the sexps from BEG to END. Leaves the point at where it
couldn't figure things out (ex: syntax errors)."
    (interactive "r")
    (let ((input (buffer-substring beg end))
          list last-point form result)
          (narrow-to-region beg end)
          (goto-char (point-min))
          (setq last-point (point-min))
          (setq form t)
          (while (and form (not (eobp)))
            (setq form (ignore-errors (read (current-buffer))))
            (when form
                (prin1-to-string form)
                (buffer-substring last-point (point))))
              (setq last-point (point))))
          (setq list (sort list (lambda (a b) (string< (car a) (car b)))))
          (delete-region (point-min) (point))
          (insert (mapconcat 'cdr list "\n"))))))

Borrowed from Steve Purcell's config. This pretty-prints the results.

(bind-key "M-:" 'pp-eval-expression)

(defun sanityinc/eval-last-sexp-or-region (prefix)
  "Eval region from BEG to END if active, otherwise the last sexp."
  (interactive "P")
  (if (and (mark) (use-region-p))
      (eval-region (min (point) (mark)) (max (point) (mark)))
    (pp-eval-last-sexp prefix)))

(bind-key "C-x C-e" 'sanityinc/eval-last-sexp-or-region emacs-lisp-mode-map)


(use-package yasnippet
  :diminish yas-minor-mode
  :init (yas-global-mode)
    (add-hook 'hippie-expand-try-functions-list 'yas-hippie-try-expand)
    (setq yas-key-syntaxes '("w_" "w_." "^ "))
    (setq yas-installed-snippets-dir "~/elisp/yasnippet-snippets")
    (setq yas-expand-only-for-last-commands nil)
    (yas-global-mode 1)
    (bind-key "\t" 'hippie-expand yas-minor-mode-map)
    (add-to-list 'yas-prompt-functions 'shk-yas/helm-prompt)))
;;        (global-set-key (kbd "C-c y") (lambda () (interactive)
;;                                         (yas/load-directory "~/elisp/snippets")))


(defun shk-yas/helm-prompt (prompt choices &optional display-fn)
  "Use helm to select a snippet. Put this into `yas/prompt-functions.'"
  (setq display-fn (or display-fn 'identity))
  (if (require 'helm-config)
      (let (tmpsource cands result rmap)
        (setq cands (mapcar (lambda (x) (funcall display-fn x)) choices))
        (setq rmap (mapcar (lambda (x) (cons (funcall display-fn x) x)) choices))
        (setq tmpsource
               (cons 'name prompt)
               (cons 'candidates cands)
               '(action . (("Expand" . (lambda (selection) selection))))
        (setq result (helm-other-buffer '(tmpsource) "*helm-select-yasnippet"))
        (if (null result)
            (signal 'quit "user quit!")
          (cdr (assoc result rmap))))


(setq default-cursor-color "gray")
(setq yasnippet-can-fire-cursor-color "purple")

;; It will test whether it can expand, if yes, cursor color -> green.
(defun yasnippet-can-fire-p (&optional field)
  (setq yas--condition-cache-timestamp (current-time))
  (let (templates-and-pos)
    (unless (and yas-expand-only-for-last-commands
                 (not (member last-command yas-expand-only-for-last-commands)))
      (setq templates-and-pos (if field
                                    (narrow-to-region (yas--field-start field)
                                                      (yas--field-end field))
    (and templates-and-pos (first templates-and-pos))))

(defun my/change-cursor-color-when-can-expand (&optional field)
  (when (eq last-command 'self-insert-command)
    (set-cursor-color (if (my/can-expand)

(defun my/can-expand ()
  "Return true if right after an expandable thing."
  (or (abbrev--before-point) (yasnippet-can-fire-p)))

                                        ; As pointed out by Dmitri, this will make sure it will update color when needed.
(remove-hook 'post-command-hook 'my/change-cursor-color-when-can-expand)

(defun my/insert-space-or-expand ()
  "For binding to the SPC SPC keychord."
  (condition-case nil (or (my/hippie-expand-maybe nil) (insert "  "))))

This requires me to modify the behaviour of hippie-expand so that it doesn't ding so much.

(defun my/hippie-expand-maybe (arg)
  "Try to expand text before point, using multiple methods.
The expansion functions in `hippie-expand-try-functions-list' are
tried in order, until a possible expansion is found.  Repeated
application of `hippie-expand' inserts successively possible
With a positive numeric argument, jumps directly to the ARG next
function in this list.  With a negative argument or just \\[universal-argument],
undoes the expansion."
  (interactive "P")
  (require 'hippie-exp)
  (if (or (not arg)
          (and (integerp arg) (> arg 0)))
      (let ((first (or (= he-num -1)
                       (not (equal this-command last-command)))))
        (if first
              (setq he-num -1)
              (setq he-tried-table nil)))
        (if arg
            (if (not first) (he-reset-string))
          (setq arg 0))
        (let ((i (max (+ he-num arg) 0)))
          (while (not (or (>= i (length hippie-expand-try-functions-list))
                          (apply (nth i hippie-expand-try-functions-list)
                                 (list (= he-num i)))))
            (setq i (1+ i)))
          (setq he-num i))
        (if (>= he-num (length hippie-expand-try-functions-list))
            (progn (setq he-num -1) nil)
          (if (and hippie-expand-verbose
                   (not (window-minibuffer-p)))
              (message "Using %s"
                       (nth he-num hippie-expand-try-functions-list)))))
    (if (and (>= he-num 0)
             (eq (marker-buffer he-string-beg) (current-buffer)))
          (setq he-num -1)
          (if (and hippie-expand-verbose
                   (not (window-minibuffer-p)))
              (message "Undoing expansions"))))))

yas/expand yas-expand

because because Because

Show column number

I sometimes need to know where I am in a line.

(column-number-mode 1)

Don't show whitespace in diff, but show context

(setq vc-diff-switches '("-b" "-B" "-u"))
(setq vc-git-diff-switches nil)


I like js2-mode.

(add-to-list 'auto-mode-alist '("\\.js\\'\\|\\.json\\'" . js2-mode))

Handy shortcuts:

(use-package js2-mode
  ;; :mode "\\.js\\'"
  :bind (:map js2-mode-map ("C-c C-c" . compile)))
(use-package coffee-mode
  :mode "\\.coffee\\'"
  :bind (:map coffee-mode-map ("C-c C-c" . compile)))
(use-package jasminejs-mode
  :after js2-mode
  :hook ((js2-mode . jasminejs-mode)
         (jasminejs-mode-hook . jasminejs-add-snippets-to-yas-snippet-dirs)))

This makes script blocks easier to copy:

(defvar my/javascript-test-regexp (concat (regexp-quote "/** Testing **/") "\\(.*\n\\)*")
  "Regular expression matching testing-related code to remove.
See `my/copy-javascript-region-or-buffer'.")

(defun my/copy-javascript-region-or-buffer (beg end)
  "Copy the active region or the buffer, wrapping it in script tags.
Add a comment with the current filename and skip test-related
code. See `my/javascript-test-regexp' to change the way
test-related code is detected."
  (interactive "r")
  (unless (region-active-p)
    (setq beg (point-min) end (point-max)))
    "<script type=\"text/javascript\">\n"
    (if (buffer-file-name) (concat "// " (file-name-nondirectory (buffer-file-name)) "\n") "")
     (buffer-substring (point-min) (point-max))

This makes it easier to debug:

(defvar my/debug-counter 1)
(defun my/insert-or-flush-debug (&optional reset beg end)
  (interactive "pr")
   ((= reset 4)
      (flush-lines "console.log('DEBUG: [0-9]+" (point-min) (point-max))
      (setq my/debug-counter 1)))
      (goto-char end)
      (insert ");\n")
      (goto-char beg)
      (insert (format "console.log('DEBUG: %d', " my/debug-counter))
      (setq my/debug-counter (1+ my/debug-counter))
    ;; Wrap the region in the debug
    (insert (format "console.log('DEBUG: %d');\n" my/debug-counter))
    (setq my/debug-counter (1+ my/debug-counter))
    (backward-char 3)

And the rest of the js2 config:

(use-package js2-mode
  :commands js2-mode
  :defer t
  :interpreter "node"
  :init (setq js2-basic-offset 2)
  :bind (:map js2-mode-map
    ("C-x C-e" . js-send-last-sexp)
    ("C-M-x" . js-send-last-sexp-and-go)
    ("C-c b" . js-send-buffer)
    ("C-c d" . my/insert-or-flush-debug)
    ("C-c C-b" . js-send-buffer-and-go)
    ("C-c w" . my/copy-javascript-region-or-buffer))
  :config (js2-imenu-extras-setup))
(use-package coffee-mode
:defer t
:config (setq-default coffee-js-mode 'js2-mode coffee-tab-width 2))
(use-package rjsx-mode
  :mode "\\.js\\'")


Convenience function for getting rid of annoying spans offby1 says there's (setq nxml-sexp-element-flag t)

<span><span>Hello world</span></span>

(defun my/clean-up-spans-in-region (beg end)
  (interactive "r")
    (let ((changed t))
      (while changed
        (setq changed nil)
        (goto-char beg)
        (while (re-search-forward "<span>\\([^<]*\\)</span>" end t)
          (replace-match "\\1")
          (setq changed t)))
      (setq changed t)
      (while changed
        (setq changed nil)
        (goto-char beg)
        (while (re-search-forward "<span>*\\(<a[^<]+>[^<]*</a>\\)</span>" end t)
          (replace-match "\\1")
          (setq changed t))))))

(defun my/clean-up-spans-in-string (string)
    (insert string)
    (my/clean-up-spans-in-region (point-min) (point-max))

(ert-deftest my/clean-up-spans-in-string ()
  (should (string= (my/clean-up-spans-in-string "<span><span>Hello world</span></span>")
          "Hello world"))
  (should (string= (my/clean-up-spans-in-string "<span><span><a href=\"\">Hello another world</a></span></span>")
                   "<a href=\"\">Hello another world</a>"))
  (should (string= (my/clean-up-spans-in-string "<span><h1>Leave alone</h1></span>") "<span><h1>Leave alone</h1></span>"))
  (should (string= (my/clean-up-spans-in-string "<span><a href=\"\">Leave</a> alone</span>")
                   "<span><a href=\"\">Leave</a> alone</span>")))

;; (ert "my/clean-up-spans-in-string")

Magit - nice git interface

Thanks to sheijk for hints on tweaking magit to limit it to the current directory!

    (defun my/magit-commit-all ()
      "Publish the current file and commit all the current changes."
      (magit-status default-directory)
      (call-interactively 'magit-log-edit))

    (use-package magit
      :load-path "~/elisp/magit"
      :defer t
        (when (equal system-type 'windows-nt)
          (setq magit-git-executable "c:/program files (x86)/git/bin/git.exe"))
        (setq magit-diff-options '("-b")) ; ignore whitespace
        (define-key magit-mode-map "#gg" 'endless/load-gh-pulls-mode)
        (defvar my/magit-limit-to-directory nil "Limit magit status to a specific directory.")
        (defun my/magit-status-in-directory (directory)
          "Displays magit status limited to DIRECTORY.
  Uses the current `default-directory', or prompts for a directory
  if called with a prefix argument. Sets `my/magit-limit-to-directory'
  so that it's still active even after you stage a change. Very experimental."
          (interactive (list (expand-file-name
                              (if current-prefix-arg
                                  (read-directory-name "Directory: ")
          (setq my/magit-limit-to-directory directory)
          (magit-status directory))

        (defadvice magit-insert-untracked-files (around sacha activate)
          (if my/magit-limit-to-directory
              (magit-with-section (section untracked 'untracked "Untracked files:" t)
                (let ((files (cl-mapcan
                              (lambda (f)
                                (when (eq (aref f 0) ??) (list f)))
                               "status" "--porcelain" "--" my/magit-limit-to-directory))))
                  (if (not files)
                      (setq section nil)
                    (dolist (file files)
                      (setq file (magit-decode-git-path (substring file 3)))
                      (magit-with-section (section file file)
                        (insert "\t" file "\n")))
                    (insert "\n"))))

        (defadvice magit-insert-unstaged-changes (around sacha activate)
          (if my/magit-limit-to-directory
              (let ((magit-current-diff-range (cons 'index 'working))
                    (magit-diff-options (copy-sequence magit-diff-options)))
                (magit-git-insert-section (unstaged "Unstaged changes:")
                  "--" my/magit-limit-to-directory

        (defadvice magit-insert-staged-changes (around sacha activate)
          "Limit to `my/magit-limit-to-directory' if specified."
          (if my/magit-limit-to-directory
              (let ((no-commit (not (magit-git-success "log" "-1" "HEAD"))))
                (when (or no-commit (magit-anything-staged-p))
                  (let ((magit-current-diff-range (cons "HEAD" 'index))
                        (base (if no-commit
                                  (magit-git-string "mktree")
                        (magit-diff-options (append '("--cached") magit-diff-options)))
                    (magit-git-insert-section (staged "Staged changes:")
                        (apply-partially #'magit-wash-raw-diffs t)
                      "diff-index" "--cached" base "--" my/magit-limit-to-directory))))
      :bind (("C-x v d" . magit-status)
             ("C-x v C-d" . my/magit-status-in-directory)
             ("C-x v p" . magit-push)
             ("C-x v c" . my/magit-commit-all)))

;; From
(defun endless/load-gh-pulls-mode ()
  "Start `magit-gh-pulls-mode' only after a manual request."
  (require 'magit-gh-pulls)
  (add-hook 'magit-mode-hook 'turn-on-magit-gh-pulls)
  (magit-gh-pulls-mode 1)

(use-package magit-gh-pulls)

The proper way to implement this is probably to patch or override the definition of magit-git-insert-section so that it takes a list of options to add at the end of the command, but that can wait for another time (or braver souls).

TODO Make this better by adding a post command options variable

git-messenger - shows commit message

(use-package git-messenger
  :bind (("C-x v m" . git-messenger:popup-message)))

Tag files

I don't often use a TAGS file, but when I do, I don't want to have to set my tags file per project. I search for it in the directory tree instead.

(defun my/recursive-find-file (file &optional directory)
  "Find the first FILE in DIRECTORY or its parents."
  (setq directory (or directory (file-name-directory (buffer-file-name)) (pwd)))
  (if (file-exists-p (expand-file-name file directory))
      (expand-file-name file directory)
    (unless (string= directory "/")
      (my/recursive-find-file file (expand-file-name ".." directory)))))

(defun my/find-tags ()
  "Set the TAGS file."
  (set (make-variable-buffer-local 'tags-table-list) nil)
  (set (make-variable-buffer-local 'tags-file-name)
       (my/recursive-find-file "TAGS")))

(eval-after-load 'drupal-mode
     (add-hook 'drupal-mode-hook 'my/find-tags)))


(use-package projectile
  :diminish projectile-mode
  (define-key projectile-mode-map (kbd "C-c p") 'projectile-command-map)
  (projectile-mode +1)
    (setq projectile-completion-system 'default)
    (setq projectile-enable-caching t)
    (setq projectile-indexing-method 'alien)
    (add-to-list 'projectile-globally-ignored-files "node-modules")))
(use-package helm-projectile)

Exploring MELPA recipes


(use-package rinari)
(use-package bundler)
    (use-package robe
      (progn (add-hook 'ruby-mode-hook 'robe-mode)
             (add-hook 'robe-mode-hook 'ac-robe-setup)
             (add-hook 'ruby-mode-hook 'auto-complete-mode)))
(defun my/rspec-verify-single ()
  "Runs the specified example at the point of the current buffer."
     (rspec-spec-file-for (buffer-file-name))
               (number-to-string (line-number-at-pos))))

(use-package rspec-mode
    (setq rspec-command-options "--fail-fast --format documentation")
    (bind-key "C-c , ," 'rspec-rerun rspec-mode-map)
    (fset 'rspec-verify-single 'my/rspec-verify-single)))


(add-hook 'sass-mode-hook
          (lambda () (setq indent-tabs-mode nil)))
(setq-default indent-tabs-mode nil)


This lets you send HTML, CSS, and Javascript fragments to Google Chrome. You may need to start Chrome with chrome --allow-running-insecure-content, if you're using the user script with HTTPS sites.

(use-package skewer-mode
  :config (skewer-setup))


(use-package company
  :config (add-hook 'prog-mode-hook 'company-mode))

Tern - for Javascript

(use-package tern
  (bind-key "C-c C-c" 'compile tern-mode-keymap)
  (when (eq system-type 'windows-nt) (setq tern-command '("cmd" "/c" "tern")))
  (add-hook 'js2-mode-hook 'tern-mode))

(use-package company-tern
:init (add-to-list 'company-backends 'company-tern))


(use-package dockerfile-mode
  :mode ("Dockerfile\\'" . dockerfile-mode))

Internet Relay Chat

IRC is a great way to hang out with other Emacs geeks.

(when (my/laptop-p)
  (use-package erc
    (setq erc-hide-list '("PART" "QUIT" "JOIN"))
    (setq erc-autojoin-channels-alist '((""
          erc-server ""
          erc-nick "sachac")
    (defun erc-cmd-OPME ()
      "Request chanserv to op me."
      (erc-message "PRIVMSG"
                   (format "chanserv op %s %s"
                           (erc-current-nick)) nil))

    (defun erc-cmd-DEOPME ()
      "Deop myself from current channel."
      (erc-cmd-DEOP (format "%s" (erc-current-nick))))
    (defun erc-cmd-BAN (nick)
      (let* ((chan (erc-default-target))
             (who (erc-get-server-user nick))
             (host (erc-server-user-host who))
             (user (erc-server-user-login who)))
        (erc-server-send (format "MODE %s +b *!%s@%s" chan user host))))

    (defun erc-cmd-KICKBAN (nick &rest reason)
      (setq reason (mapconcat #'identity reason " "))
      (and (string= reason "")
           (setq reason nil))
      (erc-cmd-BAN nick)
      (erc-server-send (format "KICK %s %s %s"
                               (or reason
                                   "Kicked (kickban)"))))

Self-tracking, statistics, and other data transformations

Quantified Awesome

(defmacro my/org-with-current-task (&rest body)
  "Execute BODY with the point at the subtree of the current task."
  `(if (derived-mode-p 'org-agenda-mode)

(defun my/org-clock-in-and-track ()
  "Start the clock running. Clock into Quantified Awesome."
   (call-interactively 'my/org-quantified-track)
   (when (org-entry-get (point) "AUTO")
     (org-open-link-from-string (org-entry-get (point) "AUTO")))))
(bind-key "!" 'my/org-clock-in-and-track org-agenda-mode-map)

(defmacro my/with-org-task (&rest body)
  "Run BODY within the current agenda task, clocked task, or cursor task."
    ((derived-mode-p 'org-agenda-mode)
     (let* ((marker (org-get-at-bol 'org-marker))
            (buffer (marker-buffer marker))
            (pos (marker-position marker)))
       (with-current-buffer buffer
             (goto-char pos)
    ((and (derived-mode-p 'org-mode) (org-at-heading-p)) (save-excursion ,@body))
    ((org-clocking-p) (save-excursion (org-clock-goto) ,@body))
    ((derived-mode-p 'org-mode) ,@body)))

(defun my/org-quantified-track (&optional category note)
  "Create a tracking record using CATEGORY and NOTE.
Default to the current task in the agenda, the currently-clocked
entry, or the current subtree in Org."
  (interactive (list nil nil))
  (unless (and category note)
     (setq category (or category
                        (org-entry-get-with-inheritance "QUANTIFIED")))
      ((null category)
       (setq category (read-string "Category: "))
       (org-set-property "QUANTIFIED" category))
      ((string= category "ask")
       (setq category (read-string "Category: "))))
     (setq note
            (if (string= (or (org-entry-get-with-inheritance "QUANTIFIEDQUIET") "") "t")
                "!private "
            (or note (elt (org-heading-components) 4) (read-string "Note: "))))))
  (quantified-track (concat category " | " note)))

(defun my/org-quick-clock-in-task (location jump)
  "Track and clock in on the specified task.
If JUMP is non-nil or the function is called with the prefix argument, jump to that location afterwards."
  (interactive (list (save-excursion (my/org-refile-get-location "Location")) current-prefix-arg))
  (when location
    (if jump
        (progn (org-refile 4 nil location) (my/org-clock-in-and-track))
        (org-refile 4 nil location)
(bind-key "C-c q" 'my/org-quick-clock-in-task)

(require 'quantified nil t)

Compare times and effort estimates

This is for comparing times in column view and in tables.

(defun my/compare-times (clocked estimated)
  (if (and (> (length clocked) 0) estimated)
      (format "%.2f"
            (/ (* 1.0 (org-hh:mm-string-to-minutes clocked))
               (org-hh:mm-string-to-minutes estimated)))

Use with #+COLUMNS: %40ITEM %17Effort(Estimated){:} %CLOCKSUM, #+BEGIN: columnview :hlines 1#+END:, and

#+TBLFM: $4='(my/compare-times $3 $2)


(use-package ess-site
  :commands R)


(defvar my/workrave-file (expand-file-name ".\\Workrave\\historystats" (getenv "AppData")))

(defun my/workrave-transform-statistics (&optional file)
  (interactive (list my/workrave-file))
  (with-current-buffer (find-file-noselect file)
  ;; D day month-1 year hour min day month-1 year hour min
    (let ((result "Date\tStart\tEnd\tClicks\tKeystrokes\n"))
      (goto-char (point-min))
      (while (re-search-forward "^D \\(.*\\)" nil t)
  (let ((dates (split-string (match-string 1))))
    (if (re-search-forward "^m \\(.*\\)" nil t)
        (let ((info (split-string (match-string 1))))
    (setq result
          (concat result
            (format "%d-%d-%s\t%s:%02d\t%s:%02d\t%s\t%s\n"
              (+ 1900 (string-to-number (elt dates 2))) ; year
              (1+ (string-to-number (elt dates 1))) ; month
              (elt dates 0) ; day
              (elt dates 3) ; start hour
              (string-to-number (elt dates 4)) ; start min
              (elt dates 8) ; end hour
              (string-to-number (elt dates 9)) ; end min
              (elt info 5) ; clicks
              (elt info 6) ; keystrokes
      (if (interactive-p)
    (kill-new result)


(defun my/strip-blog-share ()
  (let (base)
      (goto-char (point-min))
      (while (re-search-forward
              "<div class=\"sharedaddy sd-sharing-enabled\">.*?<div class=\"sharing-clear\"></div></div></div></div>" nil t)
        (replace-match "")))))


        (defun my/artrage-export-png (directory &optional prefix)
          "Change an Artrage script file (arscript) to export images to DIRECTORY.
    If PREFIX is specified, use that instead of image-."
          (interactive "MPath: ")
          (unless (file-directory-p directory)
            (make-directory directory t))
          (while (re-search-forward "[0-9\\.]+s" nil t)
            (replace-match "0.000s"))
          (goto-char (point-min))
          (while (search-forward "<StrokeEvent>" nil t)
            (replace-match (concat
                            "EvType: Command    CommandID: ExportLayer    Idx: -1    Channels: NO    Path: \""
                            "/" (or prefix "image-")
<StrokeEvent>") t t)))


GnuTLS on Windows has lots of tips.

(setq gnutls-trustfiles '("c:/sacha/cacert.pem.txt"))

color-theme sometimes comes across lists. Odd!

(defadvice face-attribute (around sacha activate)
  (if (symbolp (ad-get-arg 0))

ido-sort-mtime stopped working when I upgraded to Windows 8

(defadvice ido-sort-mtime (around sacha activate)
  (setq ido-temp-list
        (sort ido-temp-list
              (lambda (a b)
                (let ((ta (or (nth 5 (file-attributes (concat ido-current-directory a))) '(0 0)))
                      (tb (or (nth 5 (file-attributes (concat ido-current-directory b))) '(0 0))))
                  (if (= (nth 0 ta) (nth 0 tb))
                      (> (nth 1 ta) (nth 1 tb))
                    (> (nth 0 ta) (nth 0 tb)))))))
  (setq ad-return-value
        (ido-to-end  ;; move . files to end (again)
         (delq nil (mapcar
                    (lambda (x) (if (string-equal (substring x 0 1) ".") x))

Cygwin mogrify doesn't work for me, but ImageMagick does

;(setq eimp-mogrify-program "c:/Program Files/ImageMagick-6.8.3-Q16/mogrify.exe")

SSH and –daemon


(defun my/ssh-refresh ()
  "Reset the environment variable SSH_AUTH_SOCK"
  (let (ssh-auth-sock-old (getenv "SSH_AUTH_SOCK"))
    (setenv "SSH_AUTH_SOCK"
            (car (split-string
                   "ls -t $(find /tmp/ssh-* -user $USER -name 'agent.*' 2> /dev/null)"))))
     (format "SSH_AUTH_SOCK %s --> %s"
             ssh-auth-sock-old (getenv "SSH_AUTH_SOCK")))))


(defun sanityinc/adjust-opacity (frame incr)
  (let* ((oldalpha (or (frame-parameter frame 'alpha) 100))
         (newalpha (+ incr oldalpha)))
    (when (and (<= frame-alpha-lower-limit newalpha) (>= 100 newalpha))
      (modify-frame-parameters frame (list (cons 'alpha newalpha))))))
(global-set-key (kbd "M-C-8") (lambda () (interactive) (sanityinc/adjust-opacity nil -2)))
(global-set-key (kbd "M-C-9") (lambda () (interactive) (sanityinc/adjust-opacity nil 2)))
(global-set-key (kbd "M-C-0") (lambda () (interactive) (modify-frame-parameters nil `((alpha . 100)))))

Web browsing

(setq browse-url-browser-function 'browse-url-xdg-open)


(use-package clipmon
  :disabled t
  :init (progn (setq clipmon-action 'kill-new clipmon-timeout nil clipmon-sound nil clipmon-cursor-color nil clipmon-suffix nil) (clipmon-mode)))

On my phone:

(when (my/phone-p)
  (use-package xclip :config (xclip-mode 1)))


(use-package engine-mode
    (defengine my-blog "" :keybinding "b")
    (defengine mail "" :keybinding "m")
    (defengine google "" :keybinding "g")
    (defengine emacswiki "" :keybinding "e")
    (bind-key* "C-c s" 'my/engine-mode-hydra/body)



I use Gmail for my mail because it:

  • synchronizes with my phone, which is handy for notifications and quick replies
  • filters most of the spam for me
  • works with a few interesting extensions such as Boomerang for Gmail

However, I like the way the Gnus mail/news client in Emacs gives me a much more keyboard-friendly way to manage lots of mail, and I can even write code to partially automate some of my common operations.

I used to have my config in in ~/.gnus, but people might find it handy, so I've added it to my public Emacs configuration.

I like using Gmane to read mailing lists, and I use IMAP to read my Gmail.

(setq gnus-select-method '(nnnil ""))
(setq gnus-secondary-select-methods
      '((nntp "")
        ;; (nnmaildir "mail"
        ;;            (directory "~/Maildir")
        ;;            (directory-files nnheader-directory-files-safe) 
        ;;            (get-new-mail nil))
        ;; (nnimap ""
        ;;         (nnimap-address "")
        ;;         (nnimap-server-port 993)
        ;;         (nnimap-stream ssl)
        ;;         (nnimap-authenticator login))
        (nnimap "localhost" 
          (nnimap-address "localhost")
          (nnimap-stream network)
          (nnimap-user "sacha")
          (nnimap-authenticator login)
          (nnimap-authinfo-file "~/.authinfo.gpg"))))

I now use Dovecot with OfflineIMAP for local IMAP access to my mail and synchronization with Gmail, but you can see the commented-out information for Gmail in case you prefer that. I have two-factor authentication enabled for Gmail, so I set up an app-specific password for Gnus. I have GPG set up for encryption, and an ~/.authinfo.gpg file set up with something like:

machine login password mysecretapppassword
machine login password mysecretapppassword port 993
machine login password mysecretapppassword port 587
machine localhost login sacha password mysecretlocalpassword port 993
machine localhost login sacha password mysecretlocalpassword port 143

If you don't have GPG set up and you don't mind saving your passwords in the clear, you can set up an ~/.authinfo file instead.

Sending e-mail on Windows was a bit of a pain. Fortunately, I eventually found something that works. I've configured emailrelay to accept the mail and forward it to Gmail. The server starts with this batch file:

start "emailrelay" "C:\Program Files (x86)\emailrelay\emailrelay.exe" --as-proxy --client-auth "C:/sacha/.emailrelay" --client-tls --log --pid-file "C:\Program Files (x86)\emailrelay\" --spool-dir C:\sacha\tmp\emailrelay

Sending queued mail works with this batch file:

"c:\Program Files (x86)\emailrelay\emailrelay.exe" --as-client --client-auth c:\sacha\.emailrelay --client-tls --spool-dir c:\sacha\tmp\emailrelay

I should probably get around to using --as-proxy properly, since it still seems to hold mail until I explicitly send it.

On Linux, it's simply a matter of setting up a mail server such as Postfix.

Some more config. Not sure how much of this is needed.

(setq message-send-mail-function 'smtpmail-send-it
      smtpmail-starttls-credentials '(("localhost" 25 "" nil))
      smtpmail-auth-credentials '(("localhost" 25 "" nil))
      smtpmail-default-smtp-server "localhost"
      smtpmail-smtp-server "localhost"
      smtpmail-smtp-service 25
      smtpmail-local-domain "")
(setq send-mail-function 'smtpmail-send-it)
(setq smtpmail-smtp-server "")
(setq smtpmail-smtp-service 25)
(setq user-mail-address "")

Hide HTML mail. I need to fiddle with this some more, since Gnus still tries to display them. Sometimes my Gnus crashes when it tries to display HTML mail.

(use-package gnus
(require 'mm-decode)
(setq mm-discouraged-alternatives
      '("text/html" "text/richtext")
      (-difference mm-automatic-display '("text/html" "text/enriched" "text/richtext"))))

Hide quoted text.

(setq gnus-treat-hide-citation t)

Get smarter about filtering depending on what I reed or mark. I use ! (tick) for marking threads as something that interests me.

(setq gnus-use-adaptive-scoring t)
(setq gnus-default-adaptive-score-alist
       (gnus-ticked-mark (subject 10))
       (gnus-killed-mark (subject -5))
       (gnus-catchup-mark (subject -1))))


(setq notmuch-message-headers '("Subject" "To" "Cc" "Date" "Reply-To"))

Ledger (personal finance)

Make it easier to review my credit card transactions

(use-package ledger-mode
:load-path "~/vendor/ledger-mode"
:mode "\\.ledger$" 
:bind (:map ledger-mode-map
            ("C-c a" . my/ledger-set-unknown-account)
            ("C-c f" . (lambda () (interactive) (find-file (my/latest-file "~/Downloads"))))))

(defvar my/ledger-account-list-cache nil)
(make-variable-buffer-local 'my/ledger-account-list-cache)
(defadvice ledger-accounts-list (around sacha activate)
  (setq ad-return-value (or my/ledger-account-list-cache
                           (setq my/ledger-account-list-cache ad-do-it))))

(defun my/ledger-set-unknown-account (account point)
  (interactive (list (ledger-read-account-with-prompt "Account") (point)))
  (let ((extents (ledger-navigate-find-xact-extents point)))
      (goto-char (car extents))
      (if (re-search-forward "Expenses:Unknown" (cadr extents) t)
          (replace-match account t t)
        (goto-char point)
        (when (re-search-forward "\\([^ \t]+\\)  " (line-end-position) nil)
          (replace-match account t t nil 1))))))

(defun my/ledger-go-to-beginning-of-entry ()
    "Move to the beginning of the current entry."
    (while (and (not (bobp))
                (eq (ledger-context-line-type (ledger-context-at-point))
      (forward-line -1)))

  (defun my/ledger-entry-date ()
    "Returns the date of the entry containing point or nil."
      (let ((context-info (ledger-context-other-line 0)))
        (when (eq (ledger-context-line-type context-info) 'entry)
          (goto-char (line-beginning-position))
          (if (looking-at "\\([-0-9\\./]+\\)")
              (match-string-no-properties 1))))))

  (defun my/ledger-guess-mbna ()
    "Adds a sub-account for the dates for my credit card transactions."
      (forward-line 1)
      (let ((amount 0) (date (my/ledger-entry-date)) month)
        (if (string-match "[0-9]+[-\\.]\\([0-9]+\\)[-\\.]\\([0-9]+\\)" date)
            (setq month (string-to-number (match-string 1 date))))
        ;; Is this a payment or a charge?
          (while (and (eq (ledger-context-line-type (ledger-context-at-point))
                      (not (eobp)))
            (let ((context (ledger-context-at-point)))
              (if (ledger-context-field-value context 'amount)
                  (if (string-match "MBNA" (ledger-context-field-value context 'account))
                      (setq amount (string-to-number (ledger-context-field-value context 'amount)))
                    (setq amount (- (string-to-number (ledger-context-field-value context 'amount)))))))
            (forward-line 1)))
          (while (and (eq (ledger-context-line-type (ledger-context-at-point))
                      (not (eobp)))
            (let ((context (ledger-context-at-point)))
              (if (string-match "MBNA" (ledger-context-field-value context 'account))
                  (if (re-search-forward "\\(MBNA\\)[ \t]*[-$\.0-9]*[ \t]*$" (line-end-position) t)
                       (concat "MBNA:"
                                '("January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December")
                                (% (+ (if (> amount 0) 10 11) month) 12)))
                               t t nil 1))))
            (forward-line 1))))))

  (defun my/latest-file (path)
    (car (directory-files path 'full nil #'file-newer-than-file-p)))

Emacs server

(server-start) permits the use of emacsclient, emacsclientw, and org-protocol. I used to start a server as part of my config. Now I'm switching to using emacs --daemon, which starts a server automatically. Anyway, with --daemon, Emacs doesn't start off in a graphical environment, so the frames that emacsclient -c creates don't get the theme applied. This fixes that:

(add-hook 'after-make-frame-functions
          (lambda (frame)
            (select-frame frame)


Handy when I'm in tablet mode.

(define-key-after global-map [menu-bar my-menu] (cons "Shortcuts" (make-sparse-keymap "Custom shortcuts")) 'tools)
(define-key global-map [menu-bar my-menu journal] '("Show journal entries" . my/show-missing-journal-entries))
(define-key global-map [menu-bar my-menu agenda] '("Org agenda" . (lambda () (interactive) (org-agenda nil "a"))))
(define-key global-map [menu-bar my-menu audio] '("Process audio" . (lambda () (interactive) (shell-command "~/bin/process-audio &"))))
(define-key global-map [menu-bar my-menu new-index-card] '("New index card" . (lambda () (interactive)
                                     (my/org-sketch-open (my/prepare-index-card-template)))))

Advanced stuff / things I tend to forget about

Editing multiple things

Multiple cursors mode   drill

I often define keyboard macros to process multiple lines in a region. Maybe multiple-cursors will be an even better way. Looks promising! See Emacs Rocks episode 13 (multiple-cursors) for a great demo.

(use-package multiple-cursors
   (("C-c m t" . mc/mark-all-like-this)
    ("C-c m m" . mc/mark-all-like-this-dwim)
    ("C-c m l" . mc/edit-lines)
    ("C-c m e" . mc/edit-ends-of-lines)
    ("C-c m a" . mc/edit-beginnings-of-lines)
    ("C-c m n" . mc/mark-next-like-this)
    ("C-c m p" . mc/mark-previous-like-this)
    ("C-c m s" . mc/mark-sgml-tag-pair)
    ("C-c m d" . mc/mark-all-like-this-in-defun)))
(use-package phi-search)
(use-package phi-search-mc :config (phi-search-mc/setup-keys))
(use-package mc-extras :config (define-key mc/keymap (kbd "C-. =") 'mc/compare-chars))

Thanks to Irreal and Planet Emacsen for the link!

Edit list   drill

M-x edit-list makes it easier to edit an Emacs Lisp list.

(use-package edit-list :commands edit-list)

Quickly jump to positions

Quickly jump to a position in the current view.

(use-package avy)
(use-package avy-zap
(("M-z" . avy-zap-up-to-char-dwim)
("M-Z" . avy-zap-to-char-dwim)))

Deleting things

From Steve Purcell, who linked to

(defun zap-to-isearch (rbeg rend)
  "Kill the region between the mark and the closest portion of
the isearch match string. The behaviour is meant to be analogous
to zap-to-char; let's call it zap-to-isearch. The deleted region
does not include the isearch word. This is meant to be bound only
in isearch mode.  The point of this function is that oftentimes
you want to delete some portion of text, one end of which happens
to be an active isearch word. The observation to make is that if
you use isearch a lot to move the cursor around (as you should,
it is much more efficient than using the arrows), it happens a
lot that you could just delete the active region between the mark
and the point, not include the isearch word."
  (interactive "r")
  (when (not mark-active)
    (error "Mark is not active"))
  (let* ((isearch-bounds (list isearch-other-end (point)))
         (ismin (apply 'min isearch-bounds))
         (ismax (apply 'max isearch-bounds))
    (if (< (mark) ismin)
        (kill-region (mark) ismin)
      (if (> (mark) ismax)
          (kill-region ismax (mark))
        (error "Internal error in isearch kill function.")))

(define-key isearch-mode-map [(meta z)] 'zap-to-isearch)
TODO Get zap-to-isearch to work with helm-swoop

Network: TRAMP and editing files over SSH

Emacs lets you edit files on remote servers, which is pretty darn cool. On Windows, these things help a little.

(when (eq system-type 'windows-nt)
  (setq tramp-default-method "plink")
  (setq tramp-auto-save-directory "c:\\sacha\\tmp"))

Other nifty Emacs things I want to learn

Smartparens mode   drill

(use-package smartparens
    (require 'smartparens-config)
    (add-hook 'emacs-lisp-mode-hook 'smartparens-mode)
    (add-hook 'emacs-lisp-mode-hook 'show-smartparens-mode)

    ;; keybinding management

    (define-key sp-keymap (kbd "C-c s r n") 'sp-narrow-to-sexp)
    (define-key sp-keymap (kbd "C-M-f") 'sp-forward-sexp)
    (define-key sp-keymap (kbd "C-M-b") 'sp-backward-sexp)
    (define-key sp-keymap (kbd "C-M-d") 'sp-down-sexp)
    (define-key sp-keymap (kbd "C-M-a") 'sp-backward-down-sexp)
    (define-key sp-keymap (kbd "C-S-a") 'sp-beginning-of-sexp)
    (define-key sp-keymap (kbd "C-S-d") 'sp-end-of-sexp)

    (define-key sp-keymap (kbd "C-M-e") 'sp-up-sexp)
    (define-key emacs-lisp-mode-map (kbd ")") 'sp-up-sexp)
    (define-key sp-keymap (kbd "C-M-u") 'sp-backward-up-sexp)
    (define-key sp-keymap (kbd "C-M-t") 'sp-transpose-sexp)

    (define-key sp-keymap (kbd "C-M-n") 'sp-next-sexp)
    (define-key sp-keymap (kbd "C-M-p") 'sp-previous-sexp)

    (define-key sp-keymap (kbd "C-M-k") 'sp-kill-sexp)
    (define-key sp-keymap (kbd "C-M-w") 'sp-copy-sexp)

    (define-key sp-keymap (kbd "M-<delete>") 'sp-unwrap-sexp)
    (define-key sp-keymap (kbd "M-<backspace>") 'sp-backward-unwrap-sexp)

    (define-key sp-keymap (kbd "C-<right>") 'sp-forward-slurp-sexp)
    (define-key sp-keymap (kbd "C-<left>") 'sp-forward-barf-sexp)
    (define-key sp-keymap (kbd "C-M-<left>") 'sp-backward-slurp-sexp)
    (define-key sp-keymap (kbd "C-M-<right>") 'sp-backward-barf-sexp)

    (define-key sp-keymap (kbd "M-D") 'sp-splice-sexp)
    (define-key sp-keymap (kbd "C-M-<delete>") 'sp-splice-sexp-killing-forward)
    (define-key sp-keymap (kbd "C-M-<backspace>") 'sp-splice-sexp-killing-backward)
    (define-key sp-keymap (kbd "C-S-<backspace>") 'sp-splice-sexp-killing-around)

    (define-key sp-keymap (kbd "C-]") 'sp-select-next-thing-exchange)
    (define-key sp-keymap (kbd "C-<left_bracket>") 'sp-select-previous-thing)
    (define-key sp-keymap (kbd "C-M-]") 'sp-select-next-thing)

    (define-key sp-keymap (kbd "M-F") 'sp-forward-symbol)
    (define-key sp-keymap (kbd "M-B") 'sp-backward-symbol)

    (define-key sp-keymap (kbd "C-c s t") 'sp-prefix-tag-object)
    (define-key sp-keymap (kbd "C-c s p") 'sp-prefix-pair-object)
    (define-key sp-keymap (kbd "C-c s c") 'sp-convolute-sexp)
    (define-key sp-keymap (kbd "C-c s a") 'sp-absorb-sexp)
    (define-key sp-keymap (kbd "C-c s e") 'sp-emit-sexp)
    (define-key sp-keymap (kbd "C-c s p") 'sp-add-to-previous-sexp)
    (define-key sp-keymap (kbd "C-c s n") 'sp-add-to-next-sexp)
    (define-key sp-keymap (kbd "C-c s j") 'sp-join-sexp)
    (define-key sp-keymap (kbd "C-c s s") 'sp-split-sexp)

    ;; pair management

    (sp-local-pair 'minibuffer-inactive-mode "'" nil :actions nil)
    (sp-local-pair 'web-mode "<" nil :when '(my/sp-web-mode-is-code-context))

;;; markdown-mode
    (sp-with-modes '(markdown-mode gfm-mode rst-mode)
      (sp-local-pair "*" "*" :bind "C-*")
      (sp-local-tag "2" "**" "**")
      (sp-local-tag "s" "```scheme" "```")
      (sp-local-tag "<"  "<_>" "</_>" :transform 'sp-match-sgml-tags))

;;; tex-mode latex-mode
    (sp-with-modes '(tex-mode plain-tex-mode latex-mode)
      (sp-local-tag "i" "1d5f8e69396c521f645375107197ea4dfbc7b792quot;<" "1d5f8e69396c521f645375107197ea4dfbc7b792quot;>"))

;;; html-mode
    (sp-with-modes '(html-mode sgml-mode web-mode)
      (sp-local-pair "<" ">"))

;;; lisp modes
    (sp-with-modes sp--lisp-modes
      (sp-local-pair "(" nil :bind "C-("))))

Weather forecast

(use-package forecast
  (setq forecast-city "Toronto"
        forecast-latitude 43.6486
        forecast-longitude -79.3853


(setq epa-file-encrypt-to '(""))
        (setq epa-pinentry-mode 'loopback)
        (setq epg-pinentry-mode 'loopback)

DONE Scan ~/bin and turn the scripts into interactive commands

I want to automate little things on my computer so that I don't have to look up command lines or stitch together different applications. Many of these things make sense to turn into shell scripts. That way, I can call them from other programs and assign keyboard shortcuts to them. Still, I spend most of my computer time in Emacs, and I don't want to think about whether I've defined a command in Emacs Lisp or in a shell script. Besides, I like the way Helm lets me type parts of commands in order to select and call them.

Emacs Lisp allows you to define a macro that results in Emacs Lisp code. In this case, I want to define interactive functions so I can call them with M-x. In case I decide to call them from Emacs Lisp, such as (my/shell/rotate-screen "left"), I want to be able to pass arguments. I'm also using dash.el to provide functions like -filter and -not, although I could rewrite this to just use the standard Emacs Lisp functions.

Here's the code that scans a given directory for executable files and creates interactive functions, and some code that calls it for my ~/bin directory.

(require 'dash)
(require 'dash-functional)
(defmacro my/convert-shell-scripts-to-interactive-commands (directory)
  "Make the shell scripts in DIRECTORY available as interactive commands."
  (cons 'progn
           (lambda (filename)
             (let ((function-name (intern (concat "my/shell/" (file-name-nondirectory filename)))))
               `(defun ,function-name (&rest args)
                   ((not (called-interactively-p 'any))
                    (shell-command-to-string (mapconcat 'shell-quote-argument (cons ,filename args) " ")))
                    (apply 'call-process-region (point) (mark) ,filename nil (if current-prefix-arg t nil) t args))
                    (apply 'call-process ,filename nil (if current-prefix-arg t nil) nil args))))))
           (-filter (-not #'file-directory-p)
                    (-filter #'file-executable-p (directory-files directory t))))))

(my/convert-shell-scripts-to-interactive-commands "~/bin")

Let's see how that goes!


From In termux, you also need to pkg install diffutils.

(defun my/resolve-orgzly-syncthing ()
  (ibizaman/syncthing-resolve-conflicts "~/sync/orgzly"))

(defun ibizaman/syncthing-resolve-conflicts (directory)
  "Resolve all conflicts under given DIRECTORY."
  (interactive "D")
  (let* ((all (ibizaman/syncthing--get-sync-conflicts directory))
        (chosen (ibizaman/syncthing--pick-a-conflict all)))
    (ibizaman/syncthing-resolve-conflict chosen)))

(defun ibizaman/syncthing-show-conflicts-dired (directory)
  "Open dired buffer at DIRECTORY showing all syncthing conflicts."
  (interactive "D")
  (find-name-dired directory "*.sync-conflict-*"))

(defun ibizaman/syncthing-resolve-conflict-dired (&optional arg)
  "Resolve conflict of first marked file in dired or close to point with ARG."
  (interactive "P")
  (let ((chosen (car (dired-get-marked-files nil arg))))
    (ibizaman/syncthing-resolve-conflict chosen)))

(defun ibizaman/syncthing-resolve-conflict (conflict)
  "Resolve CONFLICT file using ediff."
  (let* ((normal (ibizaman/syncthing--get-normal-filename conflict)))
     (list conflict normal)
     `(lambda ()
       (when (y-or-n-p "Delete conflict file? ")
         (kill-buffer (get-file-buffer ,conflict))
         (delete-file ,conflict))))))

(defun ibizaman/syncthing--get-sync-conflicts (directory)
  "Return a list of all sync conflict files in a DIRECTORY."
  (directory-files-recursively directory "\\.sync-conflict-"))

(defvar ibizaman/syncthing--conflict-history nil
  "Completion conflict history")

(defun ibizaman/syncthing--pick-a-conflict (conflicts)
  "Let user choose the next conflict from CONFLICTS to investigate."
  (completing-read "Choose the conflict to investigate: " conflicts
                   nil t nil ibizaman/syncthing--conflict-history))

(defun ibizaman/syncthing--get-normal-filename (conflict)
  "Get non-conflict filename matching the given CONFLICT."
  (replace-regexp-in-string "\\.sync-conflict-.*\\(\\..*\\)$" "\\1" conflict))

(defun ibizaman/ediff-files (&optional files quit-hook)
  (lexical-let ((files (or files (dired-get-marked-files)))
                (quit-hook quit-hook)
                (wnd (current-window-configuration)))
    (if (<= (length files) 2)
        (let ((file1 (car files))
              (file2 (if (cdr files)
                         (cadr files)
                        "file: "
          (if (file-newer-than-file-p file1 file2)
              (ediff-files file2 file1)
            (ediff-files file1 file2))
          (add-hook 'ediff-after-quit-hook-internal
                    (lambda ()
                      (setq ediff-after-quit-hook-internal nil)
                      (when quit-hook (funcall quit-hook))
                      (set-window-configuration wnd))))
      (error "no more than 2 files should be marked"))))

Search logs

(defun my/search-irc-logs (string)
  (interactive "MSearch for: ")
  (grep (concat "grep -nH -r -P " (shell-quote-argument string) " ~/backups/server/home/.znc/users/sacha/moddata/log/freenode")))

Temporary workarounds

Tablet clicks count as drags

(defun widget-button-click (event)
  "Invoke the button that the mouse is pointing at."
  (interactive "e")
  (if (widget-event-point event)
      (let* ((oevent event)
       (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1)))
       (pos (widget-event-point event))
       (start (event-start event))
       (button (get-char-property
          pos 'button (and (windowp (posn-window start))
               (window-buffer (posn-window start)))))
  (when (or (null button)
      (catch 'button-press-cancelled
        ;; Mouse click on a widget button.  Do the following
        ;; in a save-excursion so that the click on the button
        ;; doesn't change point.
    (select-window (posn-window (event-start event)))
      (goto-char (posn-point (event-start event)))
      (let* ((overlay (widget-get button :button-overlay))
       (pressed-face (or (widget-get button :pressed-face)
       (face (overlay-get overlay 'face))
       (mouse-face (overlay-get overlay 'mouse-face)))
      ;; Read events, including mouse-movement
      ;; events, waiting for a release event.  If we
      ;; began with a mouse-1 event and receive a
      ;; movement event, that means the user wants
      ;; to perform drag-selection, so cancel the
      ;; button press and do the default mouse-1
      ;; action.  For mouse-2, just highlight/
      ;; unhighlight the button the mouse was
      ;; initially on when we move over it.
        (when face  ; avoid changing around image
          (overlay-put overlay 'face pressed-face)
          (overlay-put overlay 'mouse-face pressed-face))
        (unless (widget-apply button :mouse-down-action event)
          (let ((track-mouse t))
            (while (not (widget-button-release-event-p event))
              (setq event (read-event))

              ;; Sacha: Commented this section out so that my stylus
              ;; clicks don't get reported as mouse movement

        ;; (when (and mouse-1 (mouse-movement-p event))
        ;;   (push event unread-command-events)
        ;;   (setq event oevent)
        ;;   (throw 'button-press-cancelled t))
        (unless (or (integerp event)
              (memq (car event) '(switch-frame select-window))
              (eq (car event) 'scroll-bar-movement))
          (setq pos (widget-event-point event))
          (if (and pos
             (eq (get-char-property pos 'button)
              (when face
          (overlay-put overlay 'face pressed-face)
          (overlay-put overlay 'mouse-face pressed-face))
            (overlay-put overlay 'face face)
            (overlay-put overlay 'mouse-face mouse-face))))))

        ;; When mouse is released over the button, run
        ;; its action function.
        (when (and pos (eq (get-char-property pos 'button) button))
          (goto-char pos)
          (widget-apply-action button event)
          (if widget-button-click-moves-point
        (setq newpoint (point)))))
          (overlay-put overlay 'face face)
          (overlay-put overlay 'mouse-face mouse-face))))

    (if newpoint (goto-char newpoint))
    ;; This loses if the widget action switches windows. -- cyd
    ;; (unless (pos-visible-in-window-p (widget-event-point event))
    ;;   (mouse-set-point event)
    ;;   (beginning-of-line)
    ;;   (recenter))
    (let ((up t) command)
      ;; Mouse click not on a widget button.  Find the global
      ;; command to run, and check whether it is bound to an
      ;; up event.
      (if mouse-1
    (cond ((setq command  ;down event
           (lookup-key widget-global-map [down-mouse-1]))
           (setq up nil))
          ((setq command  ;up event
           (lookup-key widget-global-map [mouse-1]))))
        (cond ((setq command  ;down event
         (lookup-key widget-global-map [down-mouse-2]))
         (setq up nil))
        ((setq command  ;up event
         (lookup-key widget-global-map [mouse-2])))))
      (when up
        ;; Don't execute up events twice.
        (while (not (widget-button-release-event-p event))
    (setq event (read-event))))
      (when command
        (call-interactively command)))))
    (message "You clicked somewhere weird.")))

Inactive/infrequent things


(use-package paint
  :load-path "~/cloud/elisp"
   (setq paint-foreground-color "white" paint-background-color "black")
   (defun my/paint () (interactive) (delete-other-windows) (paint 1600 900 nil))))


(setq yaoddmuse-wikis
  '(("EmacsWiki" "" utf-8 "uihnscuskc=1;")))

Building a today-I-learned habit, and displaying the documentation for random Emacs commands   emacs

I'd like to build a habit of regularly learning one small thing each day in one of three domains: tech, life, and learning. My measurable output would probably be in the form of index cards, tweets, blog posts, and notes (in org-capture, Dropbox, or Evernote). I can get input from various sources like blog posts, videos, books, webpages, and so on.

A little bit of randomness might be useful for learning more about Emacs. Emacswiki has a random page function, but the chunks are often a little large or irrelevant. On the other hand, displaying a random command from the packages that I already have loaded into my Emacs - that might be a good way to discover interesting things.

I started by looking at apropos-command, which led me to apropos-internal, which is a C function that referred to obarray. Using obarray by itself didn't work (suspiciously few elements, so I often ended up looking at emms-related functions). I eventually found mapatoms, which seems to do a better job at listing an appreciable number of interactive functions. I filtered the list to include only documented functions that had not been marked as obsolete: 8,415 in my current Emacs, which should be plenty to go through. =)

(defun my/describe-random-interactive-function ()
  "Show the documentation for a random interactive function.
Consider only documented, non-obsolete functions."
  (let (result)
     (lambda (s)
       (when (and (commandp s) 
                  (documentation s t)
                  (null (get s 'byte-obsolete-info)))
         (setq result (cons s result)))))
    (describe-function (elt result (random (length result))))))

I've added this to a key-chord + hydra keymap as a repeatable function, so I can type hh to start my Hydra and then type r as many times as I want in order to show the documentation for a random interactive function. If you're curious about that, you can see the key-chord section of my config.

Anyway, today I learned more about obarray and mapatoms - they're not interactive functions, but they were handy for building this little bit of code. We'll see how it goes! =)

Org - mapping blog posts and image URLs from bulk exports

(defun my/org-map-blog-and-image-urls ()
  "Extract and map blog post / image URLs."
  (goto-char (point-min))
  (keep-lines "h2\\|img")
  (goto-char (point-min))
  (while (re-search-forward
          "^.*?h2.*?a href=\"\\(.*?\\)\".*$" nil t)
    (replace-match "\\1"))
  (goto-char (point-min))
  (while (re-search-forward
          "^.*?src=\"\\(.*?\\)\".*$" nil t)
    (replace-match "\\1"))
  (let (last-post current-url result)
    (goto-char (point-min))
    (while (re-search-forward "http://\\(.*\\)" nil t)
      (setq current-url (match-string 0))
      (if (string-match "/\\([^/]*?\\)\\(_thumb\\|-640x.*\\)?.png" current-url)
          (setq result (cons (concat (match-string 1 current-url) "\t" last-post) result))
        (setq last-post current-url)))
    (kill-new (mapconcat 'identity result "\n"))))

Transcript editing

(use-package emms
    (require 'emms-player-simple)
    (require 'emms-source-file)
    (require 'emms-source-playlist)
    (require 'emms-player-mplayer)
    (setq emms-player-list '(emms-player-mplayer))))

(defun my/split-sentence-and-capitalize ()
  (delete-char 1)
  (insert ".")
  (capitalize-word 1))
(defun my/split-sentence-delete-word-and-capitalize ()
  (delete-char 1)
  (insert ".")
  (kill-word 1)
  (capitalize-word 1))
(defun my/delete-word-and-capitalize ()
  (skip-syntax-backward "w")
  (kill-word 1)
  (capitalize-word 1))

(defun my/emms-player-mplayer-set-speed (speed)
  "Depends on mplayer's -slave mode"
  (interactive "MSpeed: ")
  (process-send-string emms-player-simple-process-name
     (format "speed_set %s\n" speed)))

(defvar my/emms-player-mplayer-speed-increment 0.1)

(defun my/emms-player-mplayer-speed-up ()
  "Depends on mplayer's -slave mode"
  (process-send-string emms-player-simple-process-name
     (format "speed_incr %f\n" my/emms-player-mplayer-speed-increment)))
(defun my/emms-player-mplayer-slow-down ()
  "Depends on mplayer's -slave mode"
  (process-send-string emms-player-simple-process-name
     (format "speed_incr %f\n" (- 0 my/emms-player-mplayer-speed-increment))))


Got sdic from . Attempting to get this to work on Windows…

(add-to-list 'load-path "~/elisp/sdic-2.1.3/lisp")
(require 'sdic)
(cond ((file-exists-p "~/Dropbox/Japanese/edict.txt")
       (setq sdic-waei-dictionary-list
        '(sdicf-client "~/Dropbox/Japanese/edict.txt" (add-keys-to-headword t))
(cond ((file-exists-p "~/Dropbox/Japanese/jedict.sdic.txt")
       (setq sdic-waei-dictionary-list
        '(sdicf-client "~/Dropbox/Japanese/jedict.sdic.txt" (add-keys-to-headword t))


This bit of code lets me track sent messages in Gnus:

(defun my/beeminder-track-message ()
    (goto-char (point-min))
    (when (re-search-forward "Newsgroups: .*emacs")
      (goto-char (point-min))
      (when (re-search-forward "Subject: \\(.*\\)" nil t)
        (beeminder-add-data "orgml" "1" (match-string 1))))))

And this loads the beeminder code:

(use-package beeminder
  :disabled t
  :config (add-hook 'message-send-news-hook 'my/beeminder-track-message))

Strike through DONE headlines

I wanted a quick way to visually distinguish DONE tasks from tasks I still need to do. This handy snippet from the Emacs Org-mode mailing list does the trick by striking through the headlines for DONE tasks.

(setq org-fontify-done-headline t)
 '(org-done ((t (:foreground "PaleGreen"
                 :weight normal
                 :strike-through t))))
            ((((class color) (min-colors 16) (background dark))
               (:foreground "LightSalmon" :strike-through t)))))

Rainbow delimiters

I don't automatically turn this on because I think it slows things down a little.

(use-package rainbow-delimiters :disabled t)


(use-package php-mode)
(define-derived-mode drupal-mode php-mode "Drupal"
  "Major mode for Drupal source code.
  (setq case-fold-search t)
  (setq indent-tabs-mode nil)
  (setq c-basic-offset 2)
  (setq indent-tabs-mode nil)
  (setq tab-width 2)
  (setq fill-column 78)
  (c-set-offset 'arglist-cont 0)
  (c-set-offset 'arglist-intro '+)
  (c-set-offset 'case-label 2)
  (c-set-offset 'arglist-close 0)
  (setq yas/buffer-local-condition
   ((looking-at "\\w") nil)
     (not (bobp))
     (or (equal "font-lock-comment-face"
                (get-char-property (1- (point)) 'face))
         (equal "font-lock-string-face"
                (get-char-property (1- (point)) 'face))))
    '(require-snippet-condition . force-in-comment))
   (t t))))
(define-key drupal-mode-map (kbd "TAB") 'indent-according-to-mode)
(add-hook 'drupal-mode-hook (lambda () (flymake-mode 1)))
(add-hook 'drupal-mode-hook (lambda () (yas/minor-mode 1)))
(add-to-list 'auto-mode-alist '("\\.\\(php\\|test\\|module\\|inc\\|install\\|engine\\|profile\\|.theme\\)$" . drupal-mode))
(add-to-list 'auto-mode-alist '("\\.tpl.php$" . html-helper-mode))
(define-key drupal-mode-map '[M-S-up] 'flymake-goto-prev-error)
(define-key drupal-mode-map '[M-S-down] 'flymake-goto-next-error)
(define-key drupal-mode-map (kbd "C-c C-c") 'comment-dwim)

(defun my/drupal-module-name ()
  "Return the Drupal module name for .module and .install files."    (file-name-sans-extension (file-name-nondirectory
(add-to-list 'hs-special-modes-alist '(drupal-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning))

Autoconnect to IRC so that I don't forget

(erc :server "" :port 6667 :nick "sachac")

Org - send things to the bottom of the list

Handy for collecting items together.

(defun my/org-send-to-bottom-of-list ()
  "Send the current line to the bottom of the list."
  (let ((kill-whole-line t))
      (kill-line 1)

Time tracking, previous weekly review

  (defvar my/org-quantified-categories
       ("Earn" . "Business - Earn")
       ("E1" . "Business - Earn - Consulting - E1")
       ("Connect" . "Business - Connect")
       ("Build" . "Business - Build"))
       ("Social" . "Discretionary - Social")
       ("Productive" . "Discretionary - Productive")
       ("Sewing" . "Discretionary - Productive - Sewing")
       ("Writing" . "Discretionary - Productive - Writing")
       ("Emacs" . "Discretionary - Productive - Emacs")
       ("Play" . "Discretionary - Play"))
      ("Personal" ;("Biking" . "Personal - Bike")
       ("Routines" . "Personal - Routines"))
      ("Sleep" nil)
      ("Unpaid work"
       ("Commuting" . "Unpaid work - Subway")
       ("Cook" . "Unpaid work - Cook")
       ("Tidy" . "Unpaid work - Tidy up")))
    "Categories for time summary.")

  (defun my/org-summarize-time-use (&optional start end)
    (interactive (list (org-read-date) (org-read-date)))
    (let ((time-summary (quantified-summarize-time start end))
          (categories my/org-quantified-categories)
      (setq result
             (lambda (a)
               (if (assoc (car a) time-summary)
                    (format "- %s: %.1f hours" (car a) (/ (cdr (assoc (car a) time-summary)) 3600.0))
                    (if (cdr a)
                        (let ((detail
                               (delq nil
                                     (mapcar (lambda (b)
                                               (if (assoc (cdr b) time-summary)
                                                   (format "%s: %.1f"
                                                           (car b)
                                                           (/ (cdr (assoc (cdr b) time-summary)) 3600.0))
                                             (cdr a)))))
                          (if detail
                              (concat " (" (mapconcat 'identity detail ", ") ")")
                    (if (string-equal (car a) "Sleep")
                        (format " - average of %.1f hours per day" (/ (cdr (assoc (car a) time-summary)) 3600.0 7.0))
       categories ""))
(if (called-interactively-p 'any)
    (insert result)

List upcoming tasks so that I can see if I'm overloaded

(defun my/org-summarize-upcoming-week ()
  "Summarize upcoming tasks as a list."
  (org-agenda nil "w")
  (let ((string (buffer-string))
        business relationships life)
      (insert string)
      (goto-char (point-min))
      (while (re-search-forward my/weekly-review-line-regexp nil t)
         ((string= (match-string 1) "routines") nil) ; skip routine tasks
         ((string= (match-string 1) "business")
          (add-to-list 'business (concat "  - [ ] " (match-string 3))))
         ((string= (match-string 1) "people")
          (add-to-list 'relationships (concat "  - [ ] " (match-string 3))))
         (t (add-to-list 'life (concat "  - [ ] " (match-string 3)))))))
    (setq string
      "*Plans for next week*\n"
      "- Business\n"
      (mapconcat 'identity business "\n")
      "\n- Relationships\n"
      (mapconcat 'identity relationships "\n")
      "\n- Life\n"
      (mapconcat 'identity life "\n")))
    (if (called-interactively-p 'any)
        (kill-new string)

This uses Org Agenda's log mode to summarize the tasks that I checked off. I still need to match it up with the plans for the previous week to see which items I'd planned ahead, and which ones were new tasks. (Hmm, is it important to track those separately? I might just skip it.)

(defun my/org-summarize-previous-week ()
  "Summarize previously-completed tasks as a list."
    (org-agenda nil "w")
    (org-agenda-later -1)
    (org-agenda-log-mode 16)
    (let ((string (buffer-string))
          business relationships life)
        (insert string)
      (goto-char (point-min))
      (while (re-search-forward my/weekly-review-line-regexp nil t)
         ((string= (match-string 1) "routines") nil) ; skip routine tasks
         ((string= (match-string 1) "business")
          (add-to-list 'business (concat "  - " (match-string 2))))
         ((string= (match-string 1) "people")
          (add-to-list 'relationships (concat "  - " (match-string 2))))
         (t (add-to-list 'life (concat "  - " (match-string 2)))))))
    (setq string
           "*Accomplished this week*\n\n"
           "- Business\n"
           (mapconcat 'identity business "\n")
           "\n- Relationships\n"
           (mapconcat 'identity relationships "\n")
           "\n- Life\n"
           (mapconcat 'identity life "\n")))
    (if (called-interactively-p 'any)
        (kill-new string)

Compare time use

(defun my/quantified-compare (start1 end1 start2 end2 &optional categories label1 label2)
  "Return a table comparing the times for START1 - END1 and START2 - END2."
  (let* ((start2 (org-read-date nil nil (or start2 "-sat")))
         (end2 (org-read-date nil nil (or end2 "+1")))
         (start1 (org-read-date nil nil (or start1 "-4sat")))
         (end1 (org-read-date nil nil (or end1 "-sat")))
         (time2 (quantified-summarize-time start2 end2))
         (time1 (quantified-summarize-time start1 end1))
         (label1 (or label1 "Period 1 %"))
         (label2 (or label2 "Period 2 %"))
         (total2 (* 0.01 (- (org-time-string-to-seconds end2) (org-time-string-to-seconds start2))))
         (total1 (* 0.01 (- (org-time-string-to-seconds end1) (org-time-string-to-seconds start1))))
         (keys (or categories (-union (mapcar 'car time1) (mapcar 'car time2)))))
    ;; Build a list comparing the two
     `(("Category" ,label1 ,label2 "Diff %" "h/wk" "Diff h/wk") hline)
      (mapcar (lambda (key)
                 (format "%.1f" (/ (or (assoc-default key time1) 0) total1))
                 (format "%.1f" (/ (or (assoc-default key time2) 0) total2))
                 (format "%.1f" (- (/ (or (assoc-default key time2) 0) total2)
                                   (/ (or (assoc-default key time1) 0) total1)))
                 (format "%.1f" (* (/ (or (assoc-default key time2) 0) total1) 1.68))
                 (format "%.1f"
                         (* (- (/ (or (assoc-default key time2) 0) total2)
                               (/ (or (assoc-default key time1) 0) total1)) 1.68))
                 )) keys)
      (lambda (a b)
         (string-to-number (car (last b)))
         (string-to-number (car (last a)))))))))

Animation for Emacs chats

(defun my/animate-emacs-chat ()
  (text-scale-set 6)
  (sit-for 3)
  (let ((list '("Emacs Chat: Sacha Chua"
                "interviewed by Bastien Guerry"
                "July 24, 2013"
        (approx-width 41)
        (approx-height 16)
    (setq row (/ (- approx-height (length list)) 2))
     (lambda (x)
       (animate-string x
                       (/ (- approx-width (length x)) 2))
       (setq row (1+ row)))

Idle timer

This snippet is from John Wiegley - It shows the org agenda when Emacs is idle.

Thanks to winner-mode, I can get back to my previous buffers with C-c left.

(defun jump-to-org-agenda ()
  (let ((buf (get-buffer "*Org Agenda*"))
    (if buf
        (if (setq wind (get-buffer-window buf))
            (select-window wind)
          (if (called-interactively-p 'any)
                (select-window (display-buffer buf t t))
                ;; (org-agenda-redo)
            (with-selected-window (display-buffer buf)
              ;; (org-agenda-redo)
      (call-interactively 'org-agenda-list)))
  ;;(let ((buf (get-buffer "*Calendar*")))
  ;;  (unless (get-buffer-window buf)
  ;;    (org-agenda-goto-calendar)))

(run-with-idle-timer 300 t 'jump-to-org-agenda)

Old Flickr/Evernote export

;; I don't use these as much now that I have the functions above.
(defun my/evernote-extract-links (filename)
  "Extract note names and URLs from an ENEX file."

  (goto-char (point-min))
  (let (list)
    (while (re-search-forward "<title>\\(.+?\\)</title>\\(.*?\n\\)*?.*?href=\"\\(.*?\\)\"" nil t)
      (setq list (cons (cons (match-string-no-properties 1) (match-string-no-properties 3)) list)))
    (delete-region (point-min) (point-max))
    (insert (mapconcat (lambda (x) (concat "- [[" (cdr x) "][" (car x) "]]")) list "\n"))))

(defun my/flickr-extract-this-week ()
  "Extract this week's sketch titles and URLs from the flickr_metadata CSV."
  (let ((base-date (apply 'encode-time (org-read-date-analyze "-fri" nil '(0 0 0))))
        start end list)
    (setq start (format-time-string "%Y-%m-%d" (days-to-time (- (time-to-number-of-days base-date) 6))))
    (setq end (format-time-string "%Y-%m-%d" (days-to-time (1+ (time-to-number-of-days base-date)))))
    (setq list (csv-parse-buffer t))
     (mapconcat (lambda (x) (concat "- [[" (car x) "][" (cdr x) "]]"))
                 (delq nil
                       (mapcar (lambda (x)
                                 (let ((title (cdr (assoc "FileName" x))))
                                   (if (and (not (string< title start))
                                            (string< title end))
                                       (cons (cdr (assoc "URL" x)) title))))
                 (lambda (a b) (string<  (cdr a) (cdr b)))

Presentation code for Emacs Conference

(defvar my/org-show-presentation-file "~/Dropbox/Emacs Conference/" "File containing the presentation.")
(defvar my/org-show-slide-tag "slide" "Tag that marks slides.")
(defvar my/org-show-slide-tag-regexp (concat ":" (regexp-quote my/org-show-slide-tag) ":"))
(require 'eimp)

;; From org-pres--eimp-fit
(defun my/org-show-eimp-fit ()
  "Function used as a hook, fits the image found to the window."
  (when (eq major-mode 'image-mode)
    (eimp-fit-image-to-window nil)))
(add-hook 'find-file-hook 'my/org-show-eimp-fit)

(defun my/org-show-execute-slide ()
  "Process slide at point.
  If it contains an Emacs Lisp source block, evaluate it.
  If it contains an image, view it and switch to that buffer.
  Else, focus on that buffer.
  Hide all drawers."
  (find-file my/org-show-presentation-file)
  (let ((heading-text (nth 4 (org-heading-components))))
     ;; view images
     ((and (goto-char (point-min))
           (re-search-forward "\\[\\[.*\\.\\(jpg\\|gif\\|png\\)" nil t))
      (let ((org-link-frame-setup '((file . find-file))))
      (goto-char (point-min)))
     ;; find and execute source code blocks
     ((and (goto-char (point-min))
           (re-search-forward "#\\+begin_src" nil t))
      (let ((info (org-babel-get-src-block-info)))
            (eval (read (concat "(progn " (nth 1 info) ")"))))))
      (switch-to-buffer (current-buffer))
      (text-scale-set 4)
      (org-cycle-hide-drawers t)
    (set-frame-name heading-text)))

(defun my/org-show-next-slide ()
  "Show the next slide."
  (find-file my/org-show-presentation-file)
  (goto-char (line-end-position))
  (when (re-search-forward my/org-show-slide-tag-regexp nil t)

(defun my/org-show-previous-slide ()
  "Show the next slide."
  (find-file my/org-show-presentation-file)
  (goto-char (line-beginning-position))
  (when (re-search-backward my/org-show-slide-tag-regexp nil t)

;(global-set-key '[f5] 'my/org-show-previous-slide)
;(global-set-key '[f6] 'my/org-show-execute-slide)
;(global-set-key '[f7] 'my/org-show-next-slide)

Enable minibuffer completion

[2013-03-31 Sun] Superseded by ido-hacks?

It can be difficult to remember the full names of Emacs commands, so I use icomplete-mode for minibuffer completion. This also makes it easier to discover commands.

(icomplete-mode 1)

Because I'm trying to use helm instead of ido…

Ido-mode: Much better navigationy things

[2013-03-31 Sun]: Let's try using Helm instead.

Ido-mode is awesome. Let's make it awesomer. I usually want to go to recently-opened files first.

(use-package ido :disabled t
  (ido-mode 1)
  (setq ido-default-buffer-method 'selected-window)
  (add-hook 'ido-make-file-list-hook 'ido-sort-mtime)
  (add-hook 'ido-make-dir-list-hook 'ido-sort-mtime)
  (defun ido-sort-mtime ()
    (setq ido-temp-list
          (sort ido-temp-list
                (lambda (a b)
                  (let ((ta (nth 5 (file-attributes (concat ido-current-directory a))))
                        (tb (nth 5 (file-attributes (concat ido-current-directory b)))))
                    (if (= (nth 0 ta) (nth 0 tb))
                        (> (nth 1 ta) (nth 1 tb))
                      (> (nth 0 ta) (nth 0 tb)))))))
    (ido-to-end  ;; move . files to end (again)
     (delq nil (mapcar
                (lambda (x) (if (string-equal (substring x 0 1) ".") x))

Ido and Org

When I use org-refile to organize my notes, I like seeing the latest entries on top. Ido-related and verify-related snippets are from "Using ido-mode for org-refile (and archiving via refile)" in Org Hacks.

(setq ido-everywhere t)
(setq ido-enable-flex-matching t)
(setq ido-max-directory-size 100000)
(ido-mode (quote both))
(setq org-completion-us-ido t)

Finding files

I don't want to think about directory structures, I just want to open files.

(require 'filecache)
(require 'ido)
(defun file-cache-ido-find-file (file)
  "Using ido, interactively open file from file cache'.
First select a file, matched using ido-switch-buffer against the contents
in `file-cache-alist'. If the file exist in more than one
directory, select directory. Lastly the file is opened."
  (interactive (list (file-cache-ido-read "File: "
                                           (lambda (x)
                                             (car x))
  (let* ((record (assoc file file-cache-alist)))
      (if (= (length record) 2)
          (car (cdr record))
         (format "Find %s in dir: " file) (cdr record)))))))

(defun file-cache-ido-read (prompt choices)
  (let ((ido-make-buffer-list-hook
         (lambda ()
           (setq ido-temp-list choices))))
    (ido-read-buffer prompt)))
(add-to-list 'file-cache-filter-regexps "docs/html")
(add-to-list 'file-cache-filter-regexps "\\.svn-base$")
(add-to-list 'file-cache-filter-regexps "\\.dump$")

To use this code, I add something like

(my/file-cache-setup-tree "my/proj1" "C-c d"

to my config. Then C-c d (or whatever keyboard shortcut I use) searches for files within the specified directories.

Keywiz - keyboard quizzes

(use-package keywiz :disabled t)
(defun my/load-keybindings ()
  "Since we don't want to have to pass through a keywiz game each time..."
  (setq keywiz-cached-commands nil)
  (do-all-symbols (sym)
    (when (and (commandp sym)
               (not (memq sym '(self-insert-command
                                digit-argument undefined))))
      (let ((keys (apply 'nconc (mapcar
                                 (lambda (key)
                                   (when (keywiz-key-press-event-p key)
                                     (list key)))
                                 (where-is-internal sym)))))
        ;;  Politically incorrect, but clearer version of the above:
        ;;    (let ((keys (delete-if-not 'keywiz-key-press-event-p
        ;;                               (where-is-internal sym))))
        (and keys
             (push (list sym keys) keywiz-cached-commands))))))
;; Might be good to use this in org-agenda...
(defun my/random-keybinding ()
  "Describe a random keybinding."
  (let* ((command (keywiz-random keywiz-cached-commands))
         (doc (and command (documentation (car command)))))
    (if command
        (concat (symbol-name (car command)) " "
                "(" (mapconcat 'key-description (cadr command) ", ") ")"
                (if doc
                    (concat ": " (substring doc 0 (string-match "\n" doc)))

MobileOrg for Android

I've been playing around with MobileOrg so that I can review my agenda and capture notes on my smartphone. My main Org file is too big to open easily there, though.

(use-package org-mobile :disabled t
    (autoload 'org-mobile-pull "org-mobile" nil t)
    (autoload 'org-mobile-push "org-mobile" nil t))
    (setq org-mobile-directory "~/Dropbox/mobile")
    (setq org-mobile-inbox-for-pull "~/personal/")
    (setq default-buffer-file-coding-system 'utf-8)
    (setq org-mobile-files '("/cygdrive/c/my/personal/"
    (setq org-mobile-agendas '("a"))))


(require 'org-crypt)
(setq org-tags-exclude-from-inheritance (quote ("crypt")))

(setq org-crypt-key nil)
  ;; GPG key to use for encryption
  ;; Either the Key ID or set to nil to use symmetric encryption.

  ;;     (setq auto-save-default nil)
  ;; Auto-saving does not cooperate with org-crypt.el: so you need
  ;; to turn it off if you plan to use org-crypt.el quite often.
  ;; Otherwise, you'll get an (annoying) message each time you
  ;; start Org.

  ;; To turn it off only locally, you can insert this:
  ;; # -*- buffer-auto-save-file-name: nil; -*-


Finding sketches

 (defvar my/sketch-directories
     "~/Dropbox/Inbox/To blog"))

 (defun my/get-sketch-filenames-between-dates (start end filter)
   "Returns index card filenames between START and END."
    (lambda (filename)
      (and (string> (file-name-nondirectory filename) start)
           (string> end (file-name-nondirectory filename))
           (or (not filter) (string-match filter filename))))))

 (defun my/get-sketch-filenames (base &optional as-regexp)
   "Check several directories for files matching BASE.
     Return the matching filenames, if any.
     If AS-REGEXP is non-nil, treat BASE as a regular expression.
     If BASE is a function, use that to filter."
    (lambda (o) (not (string-match "\\.xmp" o)))
    (sort (-flatten
           (delq nil
                  (lambda (dir)
                    (and (file-directory-p dir)
                         (if (functionp base)
                             (-filter base (directory-files dir t ".*\\.\\(png\\|psd\\|tiff\\|jpg\\)?$"))
                            dir t
                             (if as-regexp base (regexp-quote base))

 (defun my/get-sketch-filename (base &optional as-regexp)
   "Check several directories for files matching BASE.
     Return the first matching filename, if any.
     If AS-REGEXP is non-nil, treat BASE as a regular expression."
   (car (my/get-sketch-filenames base as-regexp)))

(defun my/list-sketches (regexp &optional full-filename directories)
  "Return a list of sketch filenames matching REGEXP."
  (interactive (list (read-string "Filter: ")))
  (let ((my/sketch-directories (or directories my/sketch-directories)))
    (funcall (if (called-interactively-p 'interactive)
                 (lambda (x) (insert (mapconcat (lambda (y) (concat "- " (org-link-make-string (concat "sketch:" y)))) x "\n"))) 'identity)
             (sort (-uniq
                    (mapcar (if full-filename 'identity
                            (my/get-sketch-filenames regexp t)))

Org Mode sketch: links

(defun my/sketch-open-in-krita (files)
  (apply 'call-process "krita" nil 0 nil "--nosplash"
         (mapcar (lambda (o) (my/get-sketch-filename o)) (if (listp files) files (list files)))))
(defun my/sketch-open-in-gwenview (files)
  (apply 'call-process "gwenview" nil 0 nil "--slideshow"
         (mapcar (lambda (o) (my/get-sketch-filename o)) (if (listp files) files (list files)))))
(defun my/sketch-open-in-feh (files)
  (apply 'call-process "feh" nil nil nil "-D" "1" "-F"
         (mapcar (lambda (o) (my/get-sketch-filename o)) (if (listp files) files (list files)))))

(defun my/org-sketch-open (id &optional arg)
  "Open sketch named ID.
If ARG is specified, prompt for application to open it in."
  (interactive (list
                (completing-read "Sketch ID: " (my/list-sketches "."))
  (let ((input (if arg (read-char "(k)rita, (g)wenview, (f)eh: ") ?k)))
      ((eq input ?g) 'my/sketch-open-in-gwenview)
      ((eq input ?f) 'my/sketch-open-in-feh)
      (t 'my/sketch-open-in-krita))

(defun my/org-sketch-export (link description format)
  (let* ((path (concat "" link))
         (image (concat "" link))
         (desc (or description link)))
     ((or (eq format 'html) (eq format 'wp))
      (if description
          (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc)
        (format "<a target=\"_blank\" href=\"%s\"><img src=\"%s\"><br />%s</a>" path image desc)))
     ((eq format 'latex) (format "\\href{%s}{%s}" path desc))
     ((eq format 'texinfo) (format "@uref{%s,%s}" path desc))
     ((eq format 'ascii) (format "%s <%s>" desc path))
     (t path))))

(defun my/org-sketch-complete (&optional prefix)
  (concat "sketch:"
          (completing-read "Sketch: " (my/list-sketches "."))))

;; Based on
(defun my/org-sketch-preview (start end path bracketp)
  "Include overlays for sketches."
  (when (display-graphic-p)
    (let ((filename (my/get-sketch-filename path))
          (refresh nil)
          (link (save-excursion
                  (goto-char start)
                   (save-match-data (org-element-context))
                   '(link) t)))) ;; set this someday
      (when (and (not (org-element-property :contents-begin link)) filename)
        (let ((width
               ;; Apply `org-image-actual-width' specifications.
                ((not (image-type-available-p 'imagemagick)) nil)
                ((eq org-image-actual-width t) nil)
                ((numberp org-image-actual-width) org-image-actual-width)
                ;; Pick this up from the paragraph someday
              (old (get-char-property-and-overlay start 'org-image-overlay)))
          (if (and (car-safe old) refresh)
              (image-refresh (overlay-get (cdr old) 'display))
            (let ((image (create-image filename
                                       (and width 'imagemagick)
                                       :width width)))
              (when image
                (let* ((ov (make-overlay start end)))
                  (overlay-put ov 'display image)
                  (overlay-put ov 'face 'default)
                  (overlay-put ov 'org-image-overlay t)
                   ov 'modification-hooks
                   (list 'org-display-inline-remove-overlay))
                  (push ov org-inline-image-overlays))))))))))

(use-package org
  (setq org-image-actual-width 600)
   :follow 'my/org-sketch-open
   :export 'my/org-sketch-export
   :complete 'my/org-sketch-complete
   :activate-func 'my/org-sketch-preview))

Helm completion with my/helm-org-sketches

(defun my/helm-source-org-sketch-list ()
  (my/list-sketches "."))

(defun my/helm-org-insert-sketch-candidates (candidates)
  (mapc (lambda (o)
          (org-insert-link nil (concat "sketch:" o))
          (insert "\n"))

(defun my/helm-open-sketches-in-krita (candidates)
  (my/sketch-open-in-krita (helm-marked-candidates)))

(defun my/helm-open-sketches-in-gwenview (candidates)
  (my/sketch-open-in-gwenview (helm-marked-candidates)))

(defun my/helm-open-sketches-in-feh (candidates)
  (my/sketch-open-in-feh (helm-marked-candidates)))

(defvar my/helm-source-org-sketches
  '((name . "Sketches")
    (candidates . my/helm-source-org-sketch-list)
    (action . (("Insert" . my/helm-org-insert-sketch-candidates)
               ("Open in Krita" . my/helm-open-sketches-in-krita)
               ("Open in Gwenview" . my/helm-open-sketches-in-gwenview)
               ("Open as Feh slideshow" . my/helm-open-sketches-in-feh)))))

(defun my/helm-org-sketches ()
  (helm :sources '(my/helm-source-org-sketches)
        :buffer "*helm-org-sketches*"))

Button-based interface

This makes a buffer with big buttons so that I can easily tap them with my stylus.

(defun my/set-up-sketch-buffer ()
  "Populate a widget buffer with a few handy buttons."
  (with-current-buffer (get-buffer-create "*Done*")
    (let ((inhibit-read-only t))
      (widget-create 'push-button
                     :notify (lambda (&rest ignore)
                               (my/org-clock-in-and-track-by-name "Draw"))
                     "Track: Draw")        
      (widget-create 'push-button
                     :notify (lambda (&rest ignore)
                               (my/org-clock-in-and-track-by-name "Draw journal entries"))
                     "Track: Journal")
      (widget-create 'push-button
                     :notify (lambda (&rest ignore)
                               (my/org-sketch-open (my/prepare-index-card-template)))
      (widget-create 'push-button
                     :notify (lambda (&rest ignore)
                               (my/org-sketch-open (my/prepare-large-template)))
                     "New large")
      (widget-create 'push-button
                     :notify (lambda (&rest ignore)
                               (my/org-sketch-open (my/prepare-index-card-template nil (org-read-date))))
      (widget-create 'push-button
                     :notify (lambda (&rest ignore) (shell-command "~/bin/rotate-screen")) "Rotate")
      (insert "\n")        
      (widget-create 'push-button
                     :notify (lambda (&rest ignore)
                               (shell-command "~/bin/add-output-png"))
                     "Add output.png")
      (widget-create 'push-button
                     :notify (lambda (&rest ignore)
                               (my/rotate-screen 0)
      (widget-create 'push-button
                     :notify (lambda (&rest ignore)
                               (my/rotate-screen 0)
      (widget-create 'push-button
                     :notify (lambda (&rest ignore)
                               (my/rotate-screen 0)
      (widget-create 'push-button
                     :notify (lambda (&rest ignore)
                               (my/rotate-screen 0)
      (text-scale-set 10)
      (pop-to-buffer (current-buffer))
      (goto-char (point-min))

(setq my/sketch-executable "krita"
      my/index-card-template-file "~/Dropbox/drawings/templates/0 - index.psd")
(defun my/prepare-index-cards (n)
  (interactive (list (or current-prefix-arg 5)))
  (let ((counter 1)
        (directory "~/Dropbox/Inbox")
        (template my/index-card-template-file)
        (date (substring (org-read-date nil nil ".") 0 10))
    (quantified-track "Drawing")
    (dotimes (i 5) (my/org-sketch-open (my/prepare-index-card-template)))
    (my/rotate-screen 180)

(defvar my/index-card-file-name nil "Most recent index card file name.")
(defun my/rotate-screen (degrees)
   ((eq system-type 'windows-nt)
    (shell-command (format "c:/sacha/Dropbox/bin/orient /rotate:%d" degrees)))
   ((eq system-type 'gnu/linux)
    (shell-command (format "~/bin/rotate-screen %s"
                            ((= degrees 0) "normal")
                            ((= degrees 180) "inverted")
                            ((= degrees 90) "left")
                            ((= degrees 270) "right")))))))


(defun my/prepare-drawing-template (&optional name date template)
  "Create the image file for NAME. Return the new filename."
  (let* ((directory "~/Dropbox/Inbox")
         (date (or date (substring (org-read-date nil nil ".") 0 10)))
         (counter ?a))
    (when name
      (setq found (my/get-sketch-filename (concat date ".*" (regexp-quote name)) t)))
    (unless found
      (while (my/get-sketch-filename (concat date (char-to-string counter)))
        (setq counter (1+ counter)))
      (setq name (expand-file-name
                  (concat date (char-to-string counter)
                          (if name
                              (concat " "
                                      (my/convert-sketch-title-to-filename (or name "")))

                          "." (file-name-extension template))
      (unless (file-exists-p name) (copy-file template name)))
    (or found name)))

(defun my/org-insert-new-index-card-link ()
  (let ((filename
    (insert "[[sketch:" filename "]]\n")
      (my/rotate-screen 180)
       (concat (shell-quote-argument my/sketch-executable)
               " " (shell-quote-argument filename) " &")))))

(defun my/prepare-index-card-template (&optional name date)
  "Create the image file for NAME. Return the new filename."
  (my/prepare-drawing-template name date my/index-card-template-file))

(defun my/prepare-large-template (&optional name date)
  "Create the image file for NAME. Return the new filename."
  (my/prepare-drawing-template name date "/home/sacha/Dropbox/drawings/templates/0 - base.psd"))

(defun my/prepare-index-card (&optional name date)
  "Prepare the index card for NAME.
        Rotate the screen and show a button to un-rotate the screen."
  (interactive (list (read-string "Name: ")
                     (substring (if current-prefix-arg (org-read-date) (org-read-date nil nil ".")) 0 10)))
  (setq my/index-card-file-name (my/prepare-index-card-template name date))
    (my/rotate-screen 180)
     (concat (shell-quote-argument my/sketch-executable)
             " " (shell-quote-argument my/index-card-file-name) " &")))

(defun my/prepare-index-card-for-subtree ()
  "Create an index card template for the current subtree."
  (let* ((heading (elt (org-heading-components) 4)))
    (unless (org-entry-get (point) "Effort") (org-set-property "Effort" "0:15"))
    (if (derived-mode-p 'org-agenda-mode) (org-agenda-clock-in) (org-clock-in))
    (my/org-quantified-track "Drawing")
    (if (org-at-heading-p) (forward-line 1))
    (my/prepare-index-card heading)))

(defun my/helm-org-prepare-index-card-for-subtree (candidate)
  (let ((location (org-refile--get-location candidate my/helm-org-refile-locations)))
        (org-refile 4 nil location)
        (my/prepare-index-card-for-subtree)) t)))

Easily backfill my journal

(defun my/draw-journal-entry (date)
  "Creates a blank journal entry for DATE and brings up the log."
  (interactive (list (org-read-date)))
  ;; Open the Quantified Awesome time log for that date
  (let ((filename (my/get-journal-entry date))
        (day (format-time-string "%A" (org-time-string-to-time date))))
    (if filename
        (my/org-sketch-open filename)
      ;; (browse-url (format ""
      ;;                     date
      ;;                     (format-time-string
      ;;                      "%Y-%m-%d"
      ;;                      (seconds-to-time
      ;;                       (+ (org-time-string-to-seconds date) 86400)))))
      (setq filename
            (my/prepare-index-card-template (concat day " #daily #journal") date))
      (my/org-sketch-open filename))))

(defun my/get-journal-entry (date)
  "Returns the filename for the journal sketch for DATE."
   (-filter (lambda (x) (not (string-match "weekly" x)))
             (format "%s.* .*#daily" date)

(defun my/get-missing-journal-dates (start-date end-date)
  "Return a list of dates missing journal entries.
Range is specified by START-DATE (inclusive) and END-DATE (exclusive)."
  (let* ((current-day (org-time-string-to-absolute end-date))
         (start-day (org-time-string-to-absolute start-date))
    (while (>= current-day start-day)
      (setq current-date (calendar-gregorian-from-absolute current-day))
      (setq current-date-string (format "%04d-%02d-%02d" (elt current-date 2) (elt current-date 0) (elt current-date 1)))
      (unless (my/get-journal-entry current-date-string)
        (add-to-list 'missing-list current-date-string))
      (setq current-day (1- current-day)))

(defun my/show-missing-journal-entries (since)
  (interactive (list (if current-prefix-arg (org-read-date) (org-read-date nil nil "-7"))))
  (let ((missing-dates (my/get-missing-journal-dates since (org-read-date nil nil "."))))
    (with-current-buffer (my/set-up-sketch-buffer)
       (lambda (date)
         (widget-create 'push-button
                        :date date
                        :notify (lambda (widget &rest ignore)
                                  (my/draw-journal-entry (plist-get (cdr widget) :date)))

Rename scanned index cards

(use-package s)
(defun my/process-tiff (files)
  "Convert, display, rename, and upload FILES."
  (interactive (list (dired-get-marked-files)))
  (unless (listp files) (setq files (list files)))
    (apply 'call-process "mogrify" nil nil nil (append (list "-format" "png" "-quality" "1") files))
    (setq files
           (lambda (filename)
             (find-file (setq filename (s-append ".png" (s-chop-suffix ".tif" filename))))
             (let ((new-name
                    (read-string "New name: "
                                  (if (string-match "/\\(\\([0-9]+-[0-9]+-[0-9]+\\)\\( ?.*\\)?\\)\\.png" filename)
                                      (match-string 1 filename)
                                  " "))))
               (rename-file filename (concat new-name ".png"))
               (setq filename (expand-file-name (concat new-name ".png") (file-name-directory filename)))))
  (find-file "~/Dropbox/Public/sharing/")
  (goto-char (point-min))
  (when (re-search-forward (regexp-quote "#+ORGLST: sketchinbox"))
    (forward-line 1)
    (apply 'call-process "up" nil t nil files)))

(defun my/convert-index-card-to-png (o)
  (lambda (o)
    (call-process "krita" nil nil nil o "--export" "--export-filename"
                  (concat (file-name-sans-extension o) ".png"))
    (rename-file o "~/Dropbox/Inbox/backup/" t)))

(defun my/convert-index-card-tiffs-to-pngs ()
  (let ((pattern "^\\(IMG\\|[0-9]+-[0-9]+-[0-9]+\\).*.\\(tif\\|psd\\)$"))
    (when (directory-files "~/Dropbox/Inbox/" t pattern)
      ;; Convert the TIFFs first
      (mapc 'my/convert-index-card-to-png
            (directory-files "~/Dropbox/Inbox/" t pattern)))))

(defun my/convert-and-upload-cards ()
  "Trust in existing filenames, upload without modification."

(defun my/rename-scanned-card (filename)
  (find-file filename)
  (let ((base (file-name-sans-extension filename))
    (when (string-match "/IMG.*\\|\\(\\([0-9]+-[0-9]+-[0-9]+\\)\\( ?.*\\)?\\)" base)
      (let ((kill-buffer-query-functions nil)
            (new-name (read-string "New name: "
                                   (if (match-string 1 base)
                                       (concat (match-string 1 base))
        (while (and (string-match "^[0-9]+-[0-9]+-[0-9]+[a-z]" new-name)
                    (setq old-name (my/get-sketch-filename (match-string 0 new-name)))
                    (and old-name
                         (not (string= old-name filename))
                         (not (string= (file-name-nondirectory old-name)
                                       (concat (s-trim new-name) "." (file-name-extension filename))))))
          (setq new-name
                (read-string (format "Already exists (%s) - new name: " old-name)
        (when (string-match new-name "^\\(.*?\\) *| *\\(.*\\)")
          (with-current-buffer (find-file "~/Dropbox/orgzly/")
            (goto-char (point-max))
            (insert "\n* " (match-string 1 new-name) "\n" (match-string 2 new-name))
          (setq new-name (match-string 1 new-name)))
        (when (> (length new-name) 0)
          (revert-buffer t t)
          (rename-file filename (concat (s-trim new-name) "." (file-name-extension filename)) t)

(defun my/rename-scanned-cards ()
  "Display and rename the scanned or saved files."
  (mapc (lambda (o)
          (when (string= (file-name-extension o) "psd")
            (my/convert-index-card-to-png o)
            (setq o (concat (file-name-sans-extension o) ".png")))
          (my/rename-scanned-card o))
        (reverse (directory-files "~/Dropbox/Inbox/" t "^\\(IMG\\|[0-9]+-[0-9]+-[0-9]+\\).*.\\(psd\\|png\\|jpg\\)")))

(defun my/clean-index-card-directory ()
  "Remove files marked for deletion and move private files."
  (shell-command "mv ~/Dropbox/Inbox/*delete* ~/Dropbox/Inbox/backup")
  (shell-command "mv ~/Dropbox/Inbox/*private* ~/cloud/private-sketches/"))

(defun my/upload-scanned-cards ()
  (with-current-buffer (get-buffer-create "*Files to be uploaded*")
    (insert (mapconcat 'identity (directory-files "~/Dropbox/Inbox" nil "^[0-9]+-[0-9]+-[0-9]+[^ ]? .*.\\(png\\|jpg\\)") "\n"))
    (goto-char (point-min))
    (switch-to-buffer (current-buffer))
  (shell-command "~/bin/copy-sketches"))

I might tweak the files a little more after I rename them, so I don't automatically upload them. When I'm happy with the files, I use a Node script to upload the files to Flickr, move them to my To blog directory, and copy Org-formatted text that I can paste into my learning outline.

Automatically resize images

The image+ package is handy for displaying the images so that they're scaled to the window size.

   (use-package image+
;    :load-path "~/elisp/Emacs-imagex"
    :commands (imagex-global-sticky-mode imagex-auto-adjust-mode)
    :init (progn (imagex-global-sticky-mode) (imagex-auto-adjust-mode)))

Get information for sketched books

For sketchnotes of books, I set up the filename based on properties in my Org Mode tree for that book.

(defun my/prepare-sketchnote-file ()
  (let* ((base-name (org-entry-get-with-inheritance  "BASENAME")))
    (unless base-name (error "Missing basename property"))
    (my/org-sketch-open (my/prepare-large-template base-name))))

By using Emacs Lisp functions to set up files that I'm going to use in an external application, I minimize fussing about with the keyboard while still being able to take advantage of structured information.

Do you work with external applications? Where does it make sense to use Emacs Lisp to make setup or processing easier?

Make it easy to follow up on a sketch

  (defun my/follow-up-on-sketch (filename)
    "Prompt for FILENAME to follow up on.
Create an index card with it as a layer, and add the ref to the filename."
    (interactive (list (helm-read-file-name "Image: " :initial-input "~/sketches/")))
    ;; Allow the specification of a short identifier
    (unless (file-exists-p filename) 
      (setq filename (car (directory-files "~/sketches" t (concat "^" filename)))))
    (let ((async-shell-command-buffer 'new-buffer)
          (index-card (my/prepare-index-card-template      
                       (format "-- index card ref %s"
                               (and (string-match "^[^ \\.]+" (file-name-nondirectory filename))
                                    (match-string 0 (file-name-nondirectory filename)))))))
      (shell-command (format "convert %s %s -colorspace cmyk %s"
                             (shell-quote-argument (expand-file-name my/index-card-template-file))
                             (shell-quote-argument (expand-file-name filename))
                             (shell-quote-argument (expand-file-name index-card))))
      (shell-command (format "%s %s &"
                             (shell-quote-argument my/sketch-executable)
                             (shell-quote-argument (expand-file-name index-card))))
      (my/rotate-screen 180)

Move to-blog sketches to a staging folder for easier upload

This function moves the specified files from my To blog folder to my Selection folder. That makes it easier to upload them to Wordpress and then delete them afterwards. I use the Wordpress web interface instead of org2blog's file upload support because sometimes the Org2blog file uploads don't work as well as I'd like, and I haven't looked into debugging that yet.

(defun my/org-stage-image-files-in-subtree ()
  "Move corresponding linked images to staging directory."
      (goto-char (point-min))
      (while (re-search-forward org-bracket-link-regexp nil t)
        (let ((filename (file-name-nondirectory (or (match-string 3) (match-string 1)))))
          (when (and (string-match "\\.png$" filename)
                     (file-exists-p (expand-file-name filename "~/Dropbox/Inbox/To blog")))
             (expand-file-name filename "~/Dropbox/Inbox/To blog")

Digital index piles with Emacs

Somewhat daunted by the prospect of categorizing more than a hundred sketches and blog posts for my monthly review, I spent some time figuring out how to create the digital equivalent of sorting index cards into various piles.

2015-02-01 Digital piles of index cards – index card #indexing #organization #pkm

In fact, wouldn't it be super-cool if the items could automatically guess which category they should probably go in, prompting me only if it wasn't clear?

I wanted to write a function that could take a list structured like this:

  • Keyword A
    • Previous links
  • Keyword B
    • Previous links
  • Link 1 with Keyword A
  • Link 2 with Keyword B
  • Link 3 with Keyword A
  • Link 4

It should file Link 1 and 3 under Keyword A, Link 2 under Keyword B, and prompt me for the category for Link 4. At that prompt, I should be able to select Keyword A or Keyword B, or specify a new category.

Inspired by John Kitchin's recent post on defining a Helm source, I wanted to get it to work with Helm.

First step: I needed to figure out the structure of the list, maybe including a sample from the category to make it clearer what's included. org-list.el seemed to have useful functions for this. org-list-struct gave me the structure of the current list. Let's say that a category is anything whose text does not match org-bracket-link-regexp.

(defun my/org-get-list-categories ()
  "Return a list of (category indent matching-regexp sample).
List categories are items that don't contain links."
  (let ((list (org-list-struct)) last-category results)
       (lambda (x)
         (goto-char (car x))
         (let ((current-item
                 (+ (point)
                    (elt x 1)
                    (length (elt x 2)))
           (if (string-match
               ;; Link - update the last category
               (when last-category
                 (if (< (elt x 1) (elt last-category 1))
                     (setq results
                           (cons (append last-category
                                 (cdr results))))
                 (setq last-category nil))
             ;; Category
             (setq results
                      (setq last-category
                             (elt x 1)
                             (concat "^"
                                     (make-string (elt x 1) ?\ )
                                      (concat (elt x 2)
    (append '(("x" 2 "^$" nil)) results)))

The next step was to write a function that guessed the list category based on the item text, and moved the item there.

(defvar my/helm-org-list-candidates nil)
(defun my/helm-org-list-categories-init-candidates ()
  "Return a list of categories from this list in a form ready for Helm."
  (setq my/helm-org-list-candidates
        (mapcar (lambda (x)
                  (cons (if (elt x 3)
                            (format "%s - %s" (car x) (elt x 3))
                          (car x))

(defun my/org-guess-list-category (&optional categories)
  (require 'cl-lib)
  (unless categories
    (setq categories
  (let* ((beg (line-beginning-position))
         (end (line-end-position))
         (string (buffer-substring-no-properties beg end))
          (cl-member string
                     (lambda (string cat-entry)
                       (unless (string= (car cat-entry) "x")
                         (string-match (regexp-quote (downcase (car cat-entry)))
    (when (car found)
       (cdr (car found)))

After that, I wrote a function that used Helm to prompt me for a category in case it couldn't guess the category. It took me a while to figure out that I needed to use :init instead of :candidates because I wanted to read information from the buffer before Helm kicked in.

(setq my/helm-org-list-category-source
          "Non-link categories in the current list"
        :init 'my/helm-org-list-categories-init-candidates
        :candidates 'my/helm-org-list-candidates
        :action 'my/org-move-current-item-to-category
        :fuzzy-match t))

(defvar my/org-browse-link-while-categorizing 'eww-readable
  "Set to nil to skip browsing.")

(defun my/org-guess-uncategorized ()
  "Interactively move linked list items to categories from the list.
Try to guess categories based on substring matches."
  (let ((categories (my/org-get-list-categories))
    (while (and (looking-at "^[-+] \\[\\[\\([^]]+\\)\\]\\[\\([^]]+*\\)")
                (not (string= "done" category)))
        ;; (when (eq my/org-browse-link-while-categorizing 'eww-readable)
        ;;   (save-excursion (save-match-data (my/eww-browse-readable (match-string 1)))))
        (setq category (completing-read (match-string 2) categories))
        (unless (string= category "done")
          (my/org-move-current-item-to-category category))))))

;; From
(defun my/eww-readable-nonce ()
  "Once-off call to `eww-readable' after EWW is done rendering."
    (remove-hook 'eww-after-render-hook #'my/eww-readable-nonce)))

(defun my/eww-browse-readable (url)
  (when (looking-at "^[-+] \\[\\[\\([^]]+\\)")
    (add-hook 'eww-after-render-hook #'my/eww-readable-nonce)
    (eww (match-string 1))))

Actually, it might be helpful to be able to sort lists by a keyword.

(defun my/org-sort-list-by-regexp (regexp)
  (interactive "MRegexp: ")
  (let ((sort-func
         (lambda ()
           (let ((line (buffer-substring-no-properties (point) (line-end-position))))
             (if (string-match regexp line)
                 (if (string-match org-bracket-link-regexp line)
                     (match-string 2 line)
      ((org-at-table-p) 'org-table-sort-lines)
      ((org-at-item-p) 'org-sort-list)
      (t 'org-sort-entries))
     nil ?f sort-func 'string<)))

This one files sketches into the headings I've started using in

(defun my/refile-sketches-to-questions ()
(while (looking-at "^  \\+ \\[\\[.*?\\]\\[\\(.*?\\) -- \\(.*?\\)\\]\\]\n")
  (let ((link (match-string 0))
        (title (match-string 1)))
      (if (save-match-data (search-forward (concat "* " title) nil t))
          (progn (forward-line) (insert (match-string 0)) (replace-match ""))
        (forward-line 1))))))

The :action above refers to this function, which creates a category if it doesn't exist yet.

(setq my/helm-org-list-category-create-source
          "Create category"
        :action (helm-make-actions
                 "Create category"
                 (lambda (candidate)
                     (let* ((beg (line-beginning-position))
                            (end (line-end-position))
                            (string (buffer-substring beg end)))
                       (delete-region beg (min (1+ end) (point-max)))
                       (insert "- " candidate "\n  " string "\n")))

I'm new to fiddling with Helm, so this implementation is not the best it could be. But it's nifty and it works the way I want it to, hooray! Now I can generate a list of blog posts and unblogged sketches, categorize them quickly, and then tweak the categorizations afterwards.

2015-02-01 Index card sketches and monthly reviews – index card #organization #pkm #indexing

You can see the results in my January 2015 review.

My next step for learning more about Helm sources is probably to write a Helm command that creates a montage of selected images. John Kitchin has a post about handling multiple selection in Helm, so I just need to combine that with my code for using Imagemagick to create a montage of images. Whee!

Sketched books

Convenience functions to make my life easier when sketchnoting books.

  (setq yas-indent-line 'fixed)
  (defun my/convert-sketch-title-to-filename (text)
    (setq text (replace-regexp-in-string "[?!]$" "" text))
    (setq text (replace-regexp-in-string "[?!:] " " - " text)))
  (ert-deftest my/convert-sketch-title-to-filename ()
    (should (string= (my/convert-sketch-title-to-filename "Test") "Test"))
    (should (string= (my/convert-sketch-title-to-filename "Another Test!") "Another Test"))
    (should (string= (my/convert-sketch-title-to-filename "Does this work? Yes") "Does this work - Yes"))
    (should (string= (my/convert-sketch-title-to-filename "Title: Subtitle") "Title - Subtitle"))

(defun my/convert-sketched-book-to-png ()
  "Convert TIFF to PNG."
  (let ((basename (org-entry-get-with-inheritance "BASENAME")))
    (shell-command (format "convert \"c:/sacha/dropbox/inbox/%s.tif\" \"c:/sacha/dropbox/inbox/%s.png\""

(defun my/index-sketched-book ()
  "Add entries to sketched books index."
  (let* ((title (org-entry-get-with-inheritance "SHORT_TITLE"))
        (author (org-entry-get-with-inheritance "AUTHOR"))
        (basename (org-entry-get-with-inheritance "BASENAME"))
        (base-file (format "~/Dropbox/Inbox/%s.png" basename)))
    (when (file-exists-p base-file)
      (copy-file base-file
                 (format "~/Dropbox/Packaging/sketched-books/%s.png" basename) t t))
    (find-file "~/Dropbox/Packaging/sketched-books/")
    (vc-git-register (list (format "%s.png" basename)))
    (goto-char (point-min))
    (re-search-forward "<<insert-point>>")
    (insert (format "\n- [[file:%s.png][%s - %s (sketched %s)]]\n  [[file:%s.png]]\n\n"
                    (substring basename 0 10)
    (find-file "~/Dropbox/Packaging/sketched-books/")
    (goto-char (point-min))
    (re-search-forward "<<insert-point>>")
    (insert (format "\n* %s - %s (sketched %s)\n\n[[file:%s.png]]\n\n"
                    (substring basename 0 10)

(defun my/package-sketched-book ()
  "Add the latest sketch and package the collection."
   (format "plink -A vagrant@ -P 2222 \"cd ~/Dropbox/Packaging/sketched-books; git add '%s.png'; git commit -m 'Added %s - %s' -a; git push; make all\" &"
           (org-entry-get-with-inheritance "BASENAME")
           (org-entry-get-with-inheritance "SHORT_TITLE")
           (org-entry-get-with-inheritance "AUTHOR"))))

Other sketches

Based on Aspect ratio is width / height

(defun my/get-tile-dimensions (num-items orig-width orig-height target-aspect-ratio)
  (let ((rows 1) (cols 1)
        (current-aspect (/ orig-width (float orig-height)))
    (while (< (* rows cols) num-items)
      (setq add-col-aspect (/ (* (1+ cols) (float orig-width))
                              (* rows orig-height))
            add-row-aspect (/ (* cols (float orig-width))
                              (* (1+ rows) orig-height)))
      (if (<  (abs (- add-col-aspect target-aspect-ratio))
              (abs (- add-row-aspect target-aspect-ratio)))
          (setq cols (1+ cols))
        (setq rows (1+ rows))))
    (cons cols rows)))
(ert-deftest my/get-tile-dimensions ()
  (should (equal (my/get-tile-dimensions 2 2 1 1) (cons 1 2)))
  (should (equal (my/get-tile-dimensions 4 2 1 0.5) (cons 1 4)))
  (should (equal (my/get-tile-dimensions 12 1 1 (/ 4.0 3.0)) (cons 4 3)))
  (should (equal (my/get-tile-dimensions 11 1 1 (/ 4.0 3.0)) (cons 4 3)))
  (should (equal (my/get-tile-dimensions 13 1 1 (/ 4.0 3.0)) (cons 4 4))))

(defun my/extract-image-filenames (beg end)
  "Return the filenames from the links in this region."
  (let (files)
      (goto-char (min beg end))
      (while (re-search-forward "sketch:" (max beg end) t)
        (let ((link (org-element-context)))
          (add-to-list 'files (org-element-property :path link))))

(defun my/create-sketch-montage (files &optional tiles)
  "Combine the sketches in the region."
    (if (derived-mode-p 'dired-mode)
      (mapcar 'my/get-sketch-filename
              (my/extract-image-filenames (min (point) (mark)) (max (point) (mark)))))
    (if current-prefix-arg (read-string "Tiling: "))))
  ;; Extract the links
  (let ((output-file "~/Dropbox/Inbox/output.png"))
    (unless tiles
      (setq tiles
            (format "%dx"
              (car (my/get-tile-dimensions (length files) 1500 900 (/ 4.0 3))))))
      (cd "~/Dropbox/Inbox/To blog")
      (apply 'call-process
             "montage" nil nil nil
               "-geometry" "1500x900>+0+0"
               "-tile" tiles
               (expand-file-name output-file)))))
    (if (called-interactively-p 'any) (find-file output-file))))

(defun my/create-week-montage (beg end)
  (interactive "r")
  (let* ((date (org-read-date nil nil (unless current-prefix-arg "-fri")))
         (filename (format "Week ending %s #journal #weekly" date))
         (full-filename (my/get-sketch-filename filename)))
    (if full-filename
        (my/org-sketch-open full-filename)
       (mapcar 'my/get-sketch-filename
               (my/extract-image-filenames (min (point) (mark)) (max (point) (mark)))) 
       (my/prepare-index-card-template filename)))))

(defun my/create-index-card-montage (files &optional tiling filename)
  "Prepare an index card with a montage of the selected sketches as a layer."
    (if (derived-mode-p 'dired-mode)
      (mapcar 'my/get-sketch-filename
              (my/extract-image-filenames (min (point) (mark)) (max (point) (mark)))))))
  (let ((async-shell-command-buffer 'new-buffer)
        (index-card (or filename (my/prepare-index-card-template))))
    (my/create-sketch-montage files tiling)
     (format "convert %s \\( %s -resize 1500x900 \\) -colorspace cmyk %s"
             (shell-quote-argument (expand-file-name my/index-card-template-file))
             (shell-quote-argument (expand-file-name "~/Dropbox/Inbox/output.png"))
             (shell-quote-argument (expand-file-name index-card))))
    (shell-command (format "%s %s &"
                           (shell-quote-argument my/sketch-executable)
                           (shell-quote-argument (expand-file-name index-card))))
    (my/rotate-screen 180)

add-output-png is:


xdotool windowactivate --sync $(xdotool search --name krita | tail -1); sleep 1
xdotool key --delay 50 Alt+l n m ; sleep 3
xdotool type ~/Dropbox/Inbox/output.png ; sleep 1
xdotool key Return ; sleep 3
xdotool key Alt+l l ; sleep 1
xdotool key Tab Tab ; sleep 1
xdotool type 896 ; sleep 1
xdotool key Return

Other sketch-related functions

(defun my/show-sketches-as-slideshow (list &optional shuffle)
  "Display a quick slideshow of sketches in LIST.
    If LIST is a string, look up those sketch filenames in my Flickr copy."
  (interactive "MFilter: \nP")
  (apply 'call-process "feh" nil nil nil "-D" "1" "-F" (if shuffle "-z" """") 
         (-filter (lambda (x) (string-match "photostream" x))
                  (if (stringp list)
                      (my/list-sketches list t)

(defvar my/org-index-card-source nil)
(defun my/org-prompt-index-cards ()
  "Display a buffer for easy selection of questions to work on."
  (find-file "~/personal/")
  (let ((questions
         (cl-sort (org-map-entries 'org-heading-components "TODO=\"DRAW\"")
                  '< :key (lambda (x) (or (elt x 3) 100)))))
    (setq my/org-index-card-source (current-buffer))
    (my/rotate-screen 180)
    (mapc (lambda (q)
            (widget-create 'push-button
                           :notify (lambda (widget &rest ignore)
                                       (widget-value widget)))
                                     (with-current-buffer my/org-index-card-source
                                         (goto-char (org-find-exact-headline-in-buffer (widget-value widget) my/org-index-card-source t))
                                         (org-set-property "Effort" "0:15")
                                         (org-todo "LINK")))
                                     (widget-delete widget))
                           (elt q 4))
            (insert "\n"))
    (text-scale-set 5)
    (goto-char (point-min))
    (when (functionp 'scroll-bar-mode) (scroll-bar-mode))
    (switch-to-buffer (current-buffer))))

(defun my/prepare-index-card-for-journal ()
  "Create an index card for my process journal."
  (quantified-track "Drawing")
  (my/prepare-index-card "Journal"))

(add-to-list 'org-speed-commands-user '("d" call-interactively 'my/prepare-index-card-for-subtree))

Tools for organizing

(defun my/rename-bank-statements ()
  (let ((months '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))
    (cl-loop for i from 1 to 12 do
             (message "%d" i)
             (goto-char (point-min))
             (while (re-search-forward (elt months (1- i)) nil t)
                   (replace-match (format "%02d" i))

(defun my/rename-scanned-receipts ()
  "Display and rename the scanned or saved files."
  (mapc (lambda (o)
          (find-file o)
          (let ((new-name (concat (read-string "New filename: ") ".jpg")))
            (unless (string= new-name ".jpg")
              (rename-file o new-name))))
        (or (if (derived-mode-p 'dired-mode)
             (directory-files default-directory t "^[-_0-9]+\\.jpg"))))


Typing of Emacs

(use-package typing :disabled t
  (autoload 'typing-of-emacs "typing" nil t)
    (setq toe-starting-length 6)
    (setq toe-starting-time-per-word 2)
    (setq toe-max-length 20)))

Speech synthesis (experimental)

(defvar my/espeak-command "c:/program files (x86)/espeak/command_line/espeak.exe")
(defun my/say (string &optional speed)
  (interactive "MString: ")
  (setq speed (or speed 175))
  (call-process my/espeak-command nil nil nil string "-s" speed))


Hmmm, I'm having a hard time getting used to this.

(when (my/laptop-p)
  (use-package exwm
      (require 'exwm-config)
      (exwm-input-set-key (kbd "s-p") 'fhd/toggle-exwm-input-line-mode-passthrough)
      (exwm-input-set-key (kbd "s-i") #'fhd/exwm-input-toggle-mode)))

  (defun fhd/exwm-input-line-mode ()
    "Set exwm window to line-mode and show mode line"
    (call-interactively #'exwm-input-grab-keyboard)

  (defun fhd/exwm-input-char-mode ()
    "Set exwm window to char-mode and hide mode line"
    (call-interactively #'exwm-input-release-keyboard)

  (defun fhd/exwm-input-toggle-mode ()
    "Toggle between line- and char-mode"
    (with-current-buffer (window-buffer)
      (when (eq major-mode 'exwm-mode)
        (if (equal (second (second mode-line-process)) "line")

  (defun fhd/toggle-exwm-input-line-mode-passthrough ()
    (if exwm-input-line-mode-passthrough
        (setq exwm-input-line-mode-passthrough nil)
        (message "App receives all the keys now (with some simulation)"))
       (setq exwm-input-line-mode-passthrough t)
       (message "emacs receives all the keys now")))


(when (eq system-type 'windows-nt)
(setenv "PATH" (concat "\"c:/program files/postgresql/9.3/bin;\"" (getenv "PATH"))))
Back to top | E-mail me