Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
2052 lines (1833 sloc) 76 KB

Load this file with:

(require 'org-loaddefs)
(org-babel-load-file "~/dotemacs/" t)

The contents of this file may be modified and/or redistributed according to the terms of the WTFPL.



with-eval-after-load was introduced in Emacs 24.4.

(unless (fboundp 'with-eval-after-load)
  (defmacro with-eval-after-load (file &rest body)
    "Execute BODY after FILE is loaded.
FILE is normally a feature name, but it can also be a file name,
in case that file does not provide any feature."
    (declare (indent 1) (debug t))
    `(eval-after-load ,file '(progn ,@body))))


advice-add was added in Emacs 24.4. Not much to do about this…

(unless (require 'nadvice nil t)
  (defalias 'advice-add 'ignore))


string-suffix-p was added in Emacs 24.4. Let’s copy the implementation here.

(unless (fboundp 'string-suffix-p)
  (defun string-suffix-p (suffix string  &optional ignore-case)
    "Return non-nil if SUFFIX is a suffix of STRING.
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences."
    (let ((start-pos (- (length string) (length suffix))))
      (and (>= start-pos 0)
           (eq t (compare-strings suffix nil nil
                                  string start-pos nil ignore-case))))))

Set up org-capture and bind it to F8

(require 'org-capture)

(defvar my-org-current-file "~/org/"
  "The file where new activities are started.")

(defun my-org-capture-current-file ()
  (set-buffer (org-capture-target-buffer my-org-current-file))
  ;; Now we need to move somewhere that's not a headline...
  (goto-char (point-min))
  (unless (org-at-heading-p)
  (when (org-at-heading-p)
    (insert "\n")
    (forward-char -1))
  ;; (goto-char (point-max))
  ;; (or (bolp) (insert "\n"))
  ;; (insert "* \n")
  ;; (beginning-of-line 0)
  ;; (while (and (org-at-heading-p) (not (bobp)))
  ;;   (forward-line -1))

(defun my-org-set-current-file (new-file)
   (let ((dir "~/org/"))
      (expand-file-name (read-file-name "New org file for captures: "
                                        dir nil t nil (lambda (f) (string-match-p "\\.org$" f)))
  (setq my-org-current-file new-file))

(defun my-org-dotemacs-key-binding ()
  (let* ((key (read-key-sequence "Bind key: " nil t))
         (key-description (key-description key))
         (command (read-command (format "Bind %s to command: " key-description))))
    (format "* %s is %s\nAdded on %%U.\n\n%%?\n#+BEGIN_SRC emacs-lisp\n  (global-set-key (kbd %S) '%s)\n#+END_SRC"
            key-description command key-description command)))

(add-to-list 'org-capture-templates '("n" "Note" entry (clock) "* %^{Note title} %T\n%?"))
(add-to-list 'org-capture-templates '("4" "New activity" entry (function my-org-capture-current-file) "* %^{New activity}\n%?\n%a" :prepend t :clock-in t))
(add-to-list 'org-capture-templates '("e" "dotemacs" entry (file "~/dotemacs/") "* %^{dotemacs snippet titled}\nAdded on %U.\n#+BEGIN_SRC emacs-lisp\n  %?\n#+END_SRC" :unnarrowed))
(add-to-list 'org-capture-templates '("E" "Key binding for dotemacs" entry (file "~/dotemacs/") (function my-org-dotemacs-key-binding)))
(add-to-list 'org-capture-templates '("l" "List item from active region" item (clock) "- %i\n" :immediate-finish t))
(global-set-key [f8] 'org-capture)
(global-set-key [S-f8] 'org-capture-goto-last-stored)

Useful key bindings

Bind C-c c to compile+reload emacs lisp file

(eval-after-load "lisp-mode"
     (define-key emacs-lisp-mode-map (kbd "C-c c") 'emacs-lisp-byte-compile-and-load)))

Bind `l’ to “back” in help mode

(add-hook 'help-mode-hook
          (lambda () (local-set-key "l" 'help-go-back)))

Bind C-backspace to bury-buffer

(global-set-key (kbd "C-<backspace>") 'bury-buffer)
;; For whatever reason, this is what I get now on OSX:
(global-set-key (kbd "<clear> <M-backspace> <clear>") 'bury-buffer)

Bind super-i to imenu

(global-set-key [(super ?i)] 'imenu)

Bind PrintScreen to various compile commands

(global-set-key [print] 'recompile)
(global-set-key [(shift print)] 'compile)
;; On my macbook, PrintScreen is called F13...
(global-set-key [f13] 'recompile)
(global-set-key [(shift f13)] 'compile)

Switch windows with C-s-up and C-s-down

(defun other-window-backwards ()
  (other-window -1))

(global-set-key [(control super down)] 'other-window)
(global-set-key [(control super up)] 'other-window-backwards)

Also M-s-up and M-s-down, as it seems Ubuntu’s window manager eats C-s-up and C-s-down:

(global-set-key [(meta super down)] 'other-window)
(global-set-key [(meta super up)] 'other-window-backwards)

Scroll line by line with s-up and s-down

(defun scroll-down-one-line ()
  "Scroll down one line."
  (scroll-down 1))

(defun scroll-up-one-line ()
  "Scroll up one line."
  (scroll-up 1))

(global-set-key [(super up)] 'scroll-down-one-line)
(global-set-key [(super down)] 'scroll-up-one-line)

org-agenda is s-a

(global-set-key [(super ?a)] 'org-agenda)

Also s-‘, if s-a is taken by the window manager:

(global-set-key [(super ?')] 'org-agenda)

Bind M-/ to hippie-expand

(global-set-key [(meta ?/)] 'hippie-expand)

Bind C-c l to org-store-link

(global-set-key "\C-cl" 'org-store-link)

Bind s-l to find-library

(global-set-key [(super l)] 'find-library)

Bind C-c f to find-function

(global-set-key (kbd "C-c f") 'find-function)

Various keys for opening URL at point in Firefox

(global-set-key (kbd "s-<kp-5>") 'browse-url-firefox)
(global-set-key (kbd "s-<kp-begin>") 'browse-url-firefox)
(global-set-key (kbd "s-t") 'browse-url-firefox)

EMMS key bindings

(global-set-key [Scroll_Lock] 'emms-pause)
(global-set-key (kbd "<S-Scroll_Lock>") 'emms-next)
(global-set-key (kbd "<M-Scroll_Lock>") 'emms-previous)
(global-set-key (kbd "<C-Scroll_Lock>") 'emms-show)

;; Also use F12, for when scroll lock is not available
(global-set-key [f12] 'emms-pause)
(global-set-key (kbd "<S-f12>") 'emms-next)
(global-set-key (kbd "<M-f12>") 'emms-previous)
(global-set-key (kbd "<C-f12>") 'emms-show)

F9 for org-clock-goto

(global-set-key [f9] 'org-clock-goto)
;; Also C-f9, if the Mac wants to steal plain f9.
(global-set-key (kbd "<C-f9>") 'org-clock-goto)

Clock in recent task with F7

(defun org-clock-in-menu ()
  (org-clock-in (list 4)))
(global-set-key [f7] 'org-clock-in-menu)

s-SPC for ace-jump


(define-key global-map (kbd "s-SPC") 'ace-jump-mode)

s-r is rgrep

(define-key global-map (kbd "s-r") 'rgrep)

s-m is magit-status

(define-key global-map (kbd "s-m") 'magit-status)

C-x C-b is for switching buffers

Added on [2014-03-07 Fri 16:50].

I keep pressing this when I mean C-x b.

(global-set-key "\C-x\C-b" 'ido-switch-buffer)

§ is backward-kill-word

Added on [2014-04-07 Mon 15:11].

I’m not using it for anything else, so…

(global-set-key "§" 'backward-kill-word)

Also, not using ± for anything, which is on the same key but shifted. This is bound to be more useful:

(global-set-key "±" "🐈")

C-h C-c is C-h c

Added on [2014-07-01 Tue 15:52].

I keep hitting C-h C-c (describe-copying) when I mean C-h c (describe-key-briefly). Let’s rebind:

(with-eval-after-load "help"
  (define-key help-map "\C-c" 'describe-key-briefly))


Added on [2013-05-29 Wed 12:31].

(global-set-key (kbd "C-S-c C-S-c") 'mc/edit-lines)
(global-set-key (kbd "C->") 'mc/mark-next-like-this)
(global-set-key (kbd "C-s->") 'mc/skip-to-next-like-this)
(global-set-key (kbd "C-<") 'mc/mark-previous-like-this)
(global-set-key (kbd "C-c C-<") 'mc/mark-all-like-this)

In multiple-cursors-mode, Super-0 inserts numbers

Added on [2015-06-08 Mon 16:31].

Use a numeric prefix to specify the number to insert at the first cursor (defaults to zero), and it gets incremented by one for each cursor.

(with-eval-after-load "multiple-cursors-core"
  (define-key mc/keymap (kbd "s-0") 'mc/insert-numbers))

C-M-c exits multiple-cursors-mode

Added on [2018-01-15 Mon 14:11].

C-g is the normal keybinding for exiting multiple-cursors-mode, but it seems like it gets eaten if a filter function is running? or quits are inhibited for some other reason? Let’s try using C-M-c (normally bound to exit-recursive-edit) for that.

Check recursion-depth first, just to be sure…

(with-eval-after-load "multiple-cursors-core"

  (defun my-mc/quit ()
    (if (zerop (recursion-depth))
        ;; No recursive edit in progress - exit multiple-cursors-mode
      ;; Recursive edit in progress - use normal binding for C-M-c

  (define-key mc/keymap (kbd "C-M-c") 'my-mc/quit))

Toggle full screen

Added on [2013-09-11 Wed 17:59].

Stolen from Why is this not part of Emacs? This is available as toggle-frame-fullscreen as of Emacs 24.4.

(defun toggle-fullscreen ()
  "Toggle full screen"
     nil 'fullscreen
     (when (not (frame-parameter nil 'fullscreen)) 'fullboth)))

Erlang stuff

compilation-error-regexp-alist hack for eunit

Added on [2012-06-25 Mon 11:07].

(require 'compile)

Hm, the format string thing doesn’t seem to work… See .

(setq compilation-error-regexp-alist-alist
      (delq (assq 'erlang-eunit compilation-error-regexp-alist-alist)
   "^ *\\(\\([^.:( \t\n]+\\):\\([0-9]+\\)\\):.*\\.\\.\\.\\(?:\\([^*]\\)\\|[*]\\)"
   ;; file
   (list 2 "%s.erl" "src/%s.erl" "test/%s.erl")
   ;; line
   ;; column
   ;; type - need to match [^*] after the three dots to be info,
   ;; otherwise it's an error
   (cons nil 4)
   ;; highlight
(add-to-list 'compilation-error-regexp-alist 'erlang-eunit)

And let’s do stacktraces too

(setq compilation-error-regexp-alist-alist
      (delq (assq 'erlang-eunit-stacktrace compilation-error-regexp-alist-alist)
   "^[ *]*in \\(?:function\\|call from\\) .* [[(]\\(\\([^:,]+\\)\\(?::\\|, line \\)\\([0-9]+\\)\\)[])]$"
   ;; file
   ;; line
   ;; column
   ;; type
   ;; hyperlink
(add-to-list 'compilation-error-regexp-alist 'erlang-eunit-stacktrace)

And assertions

(setq compilation-error-regexp-alist-alist
      (delq (assq 'erlang-eunit-assert compilation-error-regexp-alist-alist)
    "[ \n]*\\[{module,\\([^}]+\\)},"
    "[ \n]*{line,\\([0-9]+\\)}")
   ;; file
   (list 2 "%s.erl" "src/%s.erl" "test/%s.erl")
   ;; line
   ;; column
   ;; type
   ;; hyperlink
(add-to-list 'compilation-error-regexp-alist 'erlang-eunit-assert)

And raw stacktraces that end up in the output

(setq compilation-error-regexp-alist-alist
      (delq (assq 'erlang-raw-stacktrace compilation-error-regexp-alist-alist)
   ;; file
   ;; line
   ;; column
   ;; type
   ;; hyperlink
(add-to-list 'compilation-error-regexp-alist 'erlang-raw-stacktrace)

And let’s do lager output (possibly with column numbers) as well

(setq compilation-error-regexp-alist-alist
      (delq (assq 'erlang-lager-message compilation-error-regexp-alist-alist)
   "^....-..-.. ..:..:..\\.... \\[\\(?:\\(info\\)\\|[a-z]+\\)\\] <[0-9.]+>@\\([^:]+\\):\\(?:[^:]+\\):{\\([0-9]+\\),\\([0-9]+\\)}"
   ;; file
   (list 2 "%s.erl")
   ;; line
   ;; column
   ;; type
   (cons nil 1)
   ;; hyperlink
(add-to-list 'compilation-error-regexp-alist 'erlang-lager-message)

Ignore .eunit, .qc and _rel in rgrep

Added on [2012-05-30 Wed 16:28].

These directories are created by rebar and/or relx, and contain complete copies of the source code in src/. No point in searching through those directories.

(eval-after-load "grep"
     (add-to-list 'grep-find-ignored-directories ".eunit")
     (add-to-list 'grep-find-ignored-directories ".qc")
     (add-to-list 'grep-find-ignored-directories "_rel")))

rgrep alias for *.[eh]rl

Added on [2010-08-03 Tue 15:08].

(eval-after-load "grep"
  '(add-to-list 'grep-files-aliases '("erl" . "*.[eh]rl") :append))

Try harder to find include files in flymake

(defvar mh-erlang-flymake-code-path-dirs (list "../../*/ebin")
  "List of directories to add to code path for Erlang Flymake.
Wildcards are expanded.")

(defun mh-simple-get-deps-code-path-dirs ()
  ;; Why complicate things?
  (and (buffer-file-name)
       (let ((default-directory (file-name-directory (buffer-file-name))))
         (apply 'append
                 (lambda (wildcard)
                   ;; If the wild card expands to a directory you
                   ;; don't have read permission for, this would throw
                   ;; an error.
                     (file-expand-wildcards wildcard)))

(defun mh-simple-get-deps-include-dirs ()
  (list "../include" "../src" ".."))

(setq erlang-flymake-get-code-path-dirs-function 'mh-simple-get-deps-code-path-dirs
      erlang-flymake-get-include-dirs-function 'mh-simple-get-deps-include-dirs)

Don’t warn for exported variables in erlang-flymake

[2010-12-21 Tue 18:14]

(eval-after-load "erlang-flymake"
  '(setq erlang-flymake-extra-opts
         (delete "+warn_export_vars" erlang-flymake-extra-opts)))

Flymake: disable GUI warnings, log in message buffer

Added on [2012-05-25 Fri 12:13].

(setq flymake-gui-warnings-enabled nil
      flymake-log-level 0

color-identifiers-mode plus Erlang

Added on [2014-10-15 Wed 16:07].


(with-eval-after-load "color-identifiers-mode"
  (add-to-list 'color-identifiers:modes-alist
                 (nil font-lock-variable-name-face))))

(with-eval-after-load "erlang"
  (with-eval-after-load "color-identifiers-mode"
    (add-hook 'erlang-mode-hook 'color-identifiers-mode)))

Don’t interrupt on color-identifiers-mode regexp overflow

Added on [2015-06-12 Fri 13:14].

When opening some Erlang files, I get this stacktrace:

Debugger entered--Lisp error: (error "Stack overflow in regexp matcher")
  re-search-forward("\\('\\(?:[^\\']\\|\\(?:\\\\.\\)\\)*'\\|\\_<[[:lower:]]\\(?:\\sw\\|\\s_\\)*\\_>\\)\\s-*(" 49982 t)
  font-lock-fontify-keywords-region(1 49982 nil)
  font-lock-default-fontify-region(1 49982 nil)
  font-lock-fontify-region(1 49982 nil)
  set-auto-mode-0(erlang-mode nil)
  after-find-file(nil t)
  find-file-noselect-1(#<buffer foo.erl> "~/foo.erl" nil nil "~/foo.erl" (35172384 16777220))
  find-file-noselect("/Users/magnus/foo.erl" nil nil nil)
  call-interactively(dired-find-file nil nil)

The file is opened in a buffer, but the buffer is hidden and I have to switch to it manually. This is annoying, so I’d rather ignore that error and keep going without identifier colouring.

(defun my-color-identifiers-catch-error (oldfun &rest r)
  (condition-case e
      (apply oldfun r)
      ((string= (cadr e) "Stack overflow in regexp matcher")
       ;; Ignore this
       ;; Something else...
       (message "got error %S in color-identifiers-mode; resignalling" e)
       (signal (car e) (cdr e)))))))

(with-eval-after-load "color-identifiers-mode"
  (advice-add 'color-identifiers-mode :around 'my-color-identifiers-catch-error))

Be careful about flymake

Added on [2012-06-25 Mon 16:11].

Flymake errors out when activated on a buffer not visiting a file.

Also, file/directory local variables are not taken into account somehow if flymake is activated in the mode hook. That could result in using the wrong Erlang version (erlang-flymake-command), or not picking up include paths (see this section). Use a timer to avoid that problem.

(defun maybe-turn-on-flymake()
  (when (and buffer-file-name (file-name-directory buffer-file-name))
    (unless (file-remote-p buffer-file-name)
      (run-with-timer 0.1 nil 'flymake-mode))))

(eval-after-load "erlang-flymake"
     (remove-hook 'erlang-mode-hook 'flymake-mode)
     (add-hook 'erlang-mode-hook 'maybe-turn-on-flymake)))

(eval-after-load "erlang" '(require 'erlang-flymake))

Did you mean underscore?

Added on [2013-12-04 Wed 17:21].

(defun erlang-did-you-mean-underscore ()
  "Insert either a hyphen or an underscore.
Why is it so hard to hold down the shift key when I really want
an underscore?

If the word before point consists only of lowercase letters and
underscores, then I'm probably writing an atom and want an
underscore.  Otherwise, I'm probably writing a variable name, and
want a hyphen / minus sign."
  (let ((case-fold-search nil)
        (parser-state (syntax-ppss)))
    (if (and
         ;; This does not apply to comments.
         (null (nth 4 parser-state))
         ;; Nor to strings.
         (null (nth 3 parser-state))
         (save-match-data (looking-back "\\<[a-z_]+" (line-beginning-position))))
          (message "Did you mean underscore?")
          (insert "_"))
      (insert "-"))))

(eval-after-load "erlang"
  '(define-key erlang-mode-map "-" 'erlang-did-you-mean-underscore))

sys.config and rebar.config are Erlang

Added on [2015-02-17 Tue 13:05].

(add-to-list 'auto-mode-alist '("/\\(?:sys\\|rebar\\).config\\'" . erlang-mode))

Ignore boring stuff when spell-checking Erlang docs

Don’t bother spell-checking variable names etc.

(defun my-setup-ispell-for-docbook ()
  (when (save-excursion
          (goto-char (point-min))
          (search-forward "<!DOCTYPE erlref" 1000 t))
    (setq ispell-skip-html t)
    (setq ispell-html-skip-alists
              (lambda (s)
                (list (format "<%s\\>[^/>]*>" s) (format "</%s>" s)))
              '("input" "c" "pre" "code" "name" "v" "title" "module" "file" "anno" "type_desc"))
            '(("<seealso marker=\"[^\"]*\">" "</seealso>"))
            '(("<[^ \t\n>]" ">")
              ("&[^ \t\n;]" "[; \t\n]"))))))
(add-hook 'nxml-mode-hook 'my-setup-ispell-for-docbook)

Remind erlang.el which buffer is my inferior erlang

Added on [2015-06-11 Thu 17:10].

Hitting C-c C-k makes erlang.el compile the current Erlang file in the most recently started inferior Erlang shell, unless that shell has already been killed, in which case it opens a new shell. This little function lets you nudge it into using another Erlang shell.

(defun this-is-my-inferior-erlang (buffer)
  (interactive "bCurrent inferior Erlang buffer: ")
  ;; This is the _name_ of a buffer.  Get the actual buffer.
  (setq buffer (get-buffer buffer))
  (setq inferior-erlang-buffer buffer
        inferior-erlang-process (get-buffer-process buffer)))

Open erlang log files with dos coding system

Added on [2017-04-06 Thu 13:33].

“Erlang log files” as written by the run_erl utility have a strange mix of LF and CR-LF line separators that makes Emacs decide to use Unix line separators, leaving plenty of CRs visible as ^M in the file. Since those CRs are not useful, let’s ask Emacs to consider such files to be using DOS-style line separators:

(modify-coding-system-alist 'file "\\(^\\|/\\)erlang\\.log\\." 'dos)

(It turns out that the lines with just LF get read just fine.)

Special mode for Erlang boot files

Added on [2017-11-29 Wed 16:26].

Erlang boot files are just the corresponding script file converted to the external term format. Seeing the binary format isn’t very interesting, so let’s decode it automatically whenever we happen to open a boot file!

This function replaces the binary contents of the boot file with the text representation. That means that you can’t modify the binary file, but why would you do that… (Well, I guess we could reencode the text representation as a binary term and write that…)

(define-derived-mode erlang-boot-file-mode special-mode "Erlang-Boot"
  "Major mode for binary Erlang boot files.
It invokes Erlang to decode the file."
  (let ((file-buffer (current-buffer))
        (temp-buffer (generate-new-buffer " *erlang-boot*")))
        (let* ((coding-system-for-write 'binary)
                 (point-min) (point-max)
                 "erl" nil temp-buffer nil
                 (format "{ok, X} = file:read(standard_io, %d), io:format(\"~p~n\", [binary_to_term(list_to_binary(X))])"
                 "-s" "erlang" "halt")))
          (if (eq exit-status 0)
                ;; We're replacing the buffer contents with the text
                ;; representation, so try to make sure we don't save
                ;; the file.
                (add-hook 'write-contents-functions
                          (apply-partially 'user-error "Cannot modify files in `erlang-boot-file-mode'")
                          nil t)
                (with-current-buffer temp-buffer
                  (copy-to-buffer file-buffer (point-min) (point-max))))
            (error "Term conversion failed with %S; %s"
                   exit-status (with-current-buffer temp-buffer (buffer-string)))))
      (kill-buffer temp-buffer))))

(add-to-list 'auto-mode-alist '("\\.boot\\'" . erlang-boot-file-mode))

Org-mode stuff

Wrap in example tags

Added on [2012-05-21 Mon 15:10].

(defun wrap-in-example-tags (beg end)
  (interactive "r")
  (goto-char end)
  (unless (bolp)
    (insert "\n"))
  (insert "#+end_example\n")
  (goto-char beg)
  (unless (bolp)
    (insert "\n"))
  (insert "#+begin_example\n"))
(eval-after-load "org"
  '(define-key org-mode-map (kbd "C-c e") 'wrap-in-example-tags))

In org-mode, the equal sign is “punctuation”

Added on [2017-01-12 Thu 15:14].

In org-mode, the equal sign should have syntax “punctuation”, so that hippie-expand can pick up words inside literal markers.

(with-eval-after-load "org"
  (modify-syntax-entry ?= "." org-mode-syntax-table))

Add org HTML export command for data URI

Added on [2017-09-15 Fri 11:55].

So I just want to export my org section to HTML in order to open it in a graphical browser, and copy it to clipboard as rich text. Normally you’d export to a file, transfer the file to wherever the graphical browser is running, and open the file. Let’s cut out a few steps by directly opening a data URI containing the exported HTML.

(with-eval-after-load "ox-html"
  (let* ((ox-html-backend (org-export-get-backend 'html))
         (menu (org-export-backend-menu ox-html-backend))
         (sub-entries (cl-third menu)))
    (nconc sub-entries
           (list (list ?d "Open HTML data URI" 'my-org-html-export-data-uri)))))

(defun my-org-html-export-data-uri (&optional async subtreep visible-only body-only ext-plist)
  (let ((org-buffer (current-buffer)))
      (let ((temp-buffer (current-buffer)))
        (with-current-buffer org-buffer
          (org-export-to-buffer 'html temp-buffer
            async subtreep visible-only body-only ext-plist
            (lambda () (set-auto-mode t)))))
      (let ((data-uri
             (concat "data:text/html;charset=utf-8;base64,"
                      (encode-coding-string (buffer-string) 'utf-8)
        (browse-url data-uri)))))

Theme for org html export

Added on [2017-09-27 Wed 17:17].

For exporting to HTML, my usual dark theme interferes with syntax highlighting. Let’s switch to a light theme temporarily, say tsdh-light, when exporting.

(defvar my-org-html-export-theme 'tsdh-light)

(defun my-with-theme (orig-fun &rest args)
  (load-theme my-org-html-export-theme)
      (apply orig-fun args)
    (disable-theme my-org-html-export-theme)))

(with-eval-after-load "ox-html"
  (advice-add 'org-export-to-buffer :around 'my-with-theme))

In org-mode, use flat list of headings for imenu

Added on [2017-10-19 Thu 10:51].

In org-mode, imenu by default shows the top-level headings, and then lets you drill down into sub-headings. But when I use imenu, I might have the text of a sub-heading in mind, and I want to be able to find it directly without having to remember what the top-level heading might have been.

(defun my-org-imenu-hack (fun)
  ;; Let's make everything look like a top-level heading, by changing
  ;; `outline-level' to a function that always returns 1 if the
  ;; heading is shallow enough.  I'm ignoring `org-reduced-level'.
  (let* ((my-original-outline-level outline-level)
          (lambda ()
            (let ((actual-level (funcall my-original-outline-level)))
              (if (<= actual-level org-imenu-depth)
    (funcall fun)))

(advice-add 'org-imenu-get-tree :around 'my-org-imenu-hack)

M-x ecd, to open eshell in the specified directory

(defun ecd (d)
   (list (expand-file-name (read-directory-name "cd: " nil nil t))))
  (eshell)(eshell/cd d))

diff-mode bindings for magit-commit-mode

Added on [2013-11-11 Mon 16:08].

(with-eval-after-load "magit"
  (when (boundp 'magit-commit-mode-map)
    ;; XXX: this map seems to have disappeared
    (define-key magit-commit-mode-map (kbd "C-c C-w") #'diff-tell-file-name)
    (define-key magit-commit-mode-map (kbd "C-c C-a") #'diff-apply-hunk)
    (define-key magit-commit-mode-map (kbd "C-c C-s") #'diff-split-hunk)))

ANSI colours in compilation buffer

Added on [2013-12-10 Tue 10:08].

Inspired by

(require 'ansi-color)
(defun colourise-compilation-buffer ()
  ;; grep output gets all red for some reason
  (unless (derived-mode-p 'grep-mode)
    (let ((inhibit-read-only t))
      (ansi-color-apply-on-region (point-min) (point-max)))))
(eval-after-load "compile"
  '(add-hook 'compilation-filter-hook 'colourise-compilation-buffer))

Fix Wingdings in shr

Added on [2013-12-20 Fri 17:05].

(defun wingdings-to-unicode (text)
  (let ((mapping '((?J . #x263a)
                   (?K . #x1f610)
                   (?L . #x2639))))
    (cl-map 'string (lambda (c)
                      (or (cdr (assq c mapping))

(eval-after-load "shr"
  '(defadvice shr-tag-span (around wingdings-to-unicode (cont) activate)
     ;; NB: this will catch wingdings2 too
     (if (let ((case-fold-search t)) (string-match-p "font-family:\s*wingdings" (or (cdr (assq :style cont)) "")))
         (dolist (sub cont)
            ((eq (car sub) 'text)
             (shr-insert (wingdings-to-unicode (cdr sub))))
            ((listp (cdr sub))
             (shr-descend sub))))

Get info from Junit XML files

Added on [2013-12-27 Fri 11:14].

If you run your build with M-x compile, and it produces JUnit-style XML files in one and only one directory, then call my-junit-xml-always-display-after-compile for a summary of the test results, sorted by most frequent failures.

(defvar my-junit-xml-failures ())

(defvar my-junit-xml-dir nil)

(defvar my-junit-xml-wildcard nil)

(defun my-junit-xml-read-dir (dir wildcard)
   (if (and my-junit-xml-dir my-junit-xml-wildcard
            (y-or-n-p (format "Use %s and %s? " my-junit-xml-dir my-junit-xml-wildcard)))
       (list my-junit-xml-dir my-junit-xml-wildcard)
      (read-directory-name "Directory: " nil nil t)
      (read-string "Wildcard (default *.xml): " nil nil "*.xml"))))
  (let* ((default-directory dir)
         (files (file-expand-wildcards wildcard))
         (skipped 0)
         (failure 0))
    (if (null files)
        (user-error "No *.xml files in %s" dir)
      (dolist (file files)
        (let ((root (car (xml-parse-file file)))
              (timestamp (nth 5 (file-attributes file))))
                (prefix xml-node)
                (cl-case (car-safe xml-node)
                   ;; Just descend
                   (mapc (apply-partially #'read-junit-xml prefix)
                         (xml-node-children xml-node)))
                   (let ((testsuite-name (xml-get-attribute-or-nil xml-node 'name)))
                     (mapc (apply-partially
                            (if testsuite-name
                                (concat prefix testsuite-name ":")
                           (xml-node-children xml-node))))
                   (let* ((name (concat prefix (xml-get-attribute xml-node 'name)))
                          (entry (or (assoc name my-junit-xml-failures)
                                     (list name () ()))))
                      ((or (xml-get-children xml-node 'failure)
                           (xml-get-children xml-node 'error))
                       (incf failure)
                       (cl-pushnew timestamp (second entry) :test 'equal))
                      ((xml-get-children xml-node 'skipped)
                       (incf skipped)
                       (cl-pushnew timestamp (third entry) :test 'equal)))
                     (when (or (second entry) (third entry))
                       (cl-pushnew entry my-junit-xml-failures)))))))
            (mapc (apply-partially #'read-junit-xml nil) (xml-node-children root))))))
    (message "%d failures, %d skipped" failure skipped)))

(defvar my-junit-xml-latest-display (list 0 0 0)
  "The time when `my-junit-xml-display' was last called.
We keep this to be able to highlight recent failures.")

(defun my-junit-xml-display ()
  (with-current-buffer (get-buffer-create "*junit*")
    (let ((inhibit-read-only t)
          (longest-length 0)

      (dolist (testcase my-junit-xml-failures)
        (setq longest-length (max longest-length (length (first testcase))))
        (push (list (first testcase)
                    (+ (length (second testcase))
                       (length (third testcase)))
                    (car (sort (append (second testcase) (third testcase))
                               (lambda (x y) (time-less-p y x)))))

      (setq testcases (sort testcases (lambda (x y)
                                         (> (second x) (second y))
                                         (and (= (second x) (second y))
                                              (time-less-p (third y) (third x)))))))

      (dolist (testcase testcases)
        (let ((text (concat (first testcase) (make-string (- longest-length (length (first testcase))) ?\s) "   "
                            (number-to-string (second testcase)) " failures, "
                            "last on " (format-time-string "%Y-%m-%d %T" (third testcase)) "\n")))
          ;; If this test failed since we last displayed junit
          ;; results, highlight it.
          (when (time-less-p my-junit-xml-latest-display (third testcase))
            (add-text-properties 0 (length text) '(face highlight) text))
          (insert text)))

      (setq my-junit-xml-latest-display (current-time))

      (display-buffer (current-buffer)))))

(defun my-junit-xml-always-display-after-compile (dir wildcard)
  "After a compilation finishes, display JUnit info.
Update from all *.xml files in DIR."
  (interactive (list
                (read-directory-name "Directory: " nil nil t)
                (read-string "Wildcard (default *.xml): " nil nil "*.xml")))
  (setq my-junit-xml-dir dir
        my-junit-xml-wildcard wildcard)
  (add-hook 'compilation-finish-functions 'my-junit-xml-after-compilation))

(defun my-junit-xml-never-display-after-compile ()
  (remove-hook 'compilation-finish-functions 'my-junit-xml-after-compilation))

(defun my-junit-xml-after-compilation (compilation-buffer _status)
  (unless (with-current-buffer compilation-buffer
            (derived-mode-p 'grep-mode))
    (my-junit-xml-read-dir my-junit-xml-dir my-junit-xml-wildcard)

eval-last-sexp-dwim for C-x C-e

If there are unbound variables, ask for their values.

(defun eval-last-sexp-dwim ()
  "Evaluate sexp before point, asking for values of unbound variables."
  (let ((sexp (preceding-sexp)))
        ((eval-it (the-sexp)
                  (condition-case e
                      (eval the-sexp)
                     (let* ((var (cadr e))
                            (val (car
                                    (format "Value for `%s': " var)))))
                            (new-sexp `(let ((,var ,val))
                       (eval-it new-sexp))))))
      (message "%S" (eval-it sexp)))))
(eval-after-load "lisp-mode"
     (define-key emacs-lisp-mode-map (kbd "C-x C-e") 'eval-last-sexp-dwim)))

Pretty lambdas in Lisp modes

;; stolen from
(defun pretty-lambdas ()
   nil `(("(\\(lambda\\>\\)"
          (0 (progn (compose-region (match-beginning 1) (match-end 1)
                                    ,(make-char 'greek-iso8859-7 107))
(add-hook 'emacs-lisp-mode-hook 'pretty-lambdas)
(add-hook 'lisp-mode-hook 'pretty-lambdas)

Auto fill mode in org-capture mode

Added on [2014-01-14 Tue 14:44].

(eval-after-load "org-capture"
  '(add-hook 'org-capture-mode-hook 'turn-on-auto-fill))

Convert Libreoffice document to PDF

Added on [2013-06-14 Fri 20:15].

(defun my-libreoffice-to-pdf (filename)
  "Convert Libreoffice document to PDF.
Note that Libreoffice must not be running."
  (interactive "fLibreoffice document to convert to PDF: ")
  (let ((buffer (get-buffer-create "*Libreoffice to PDF*")))
    (unless (zerop
              nil buffer t
              "--headless" "--convert-to" "pdf" filename))
      (message "Conversion failed")
      (display-buffer buffer))))


Added on [2010-08-16 Mon 16:52].

(defun delete-process-i(p)(interactive `(,(completing-read"Kill proc: "(mapcar 'process-name(process-list))()t)))(delete-process p))

proced erlang magic

Added on [2014-01-27 Mon 10:53].

Add a filter for viewing only BEAM processes (hit f in the proced buffer and type beam):

(eval-after-load "proced"
  '(add-to-list 'proced-filter-alist
                '(beam (comm . "^beam"))))

Add an extra field for the node name of the Erlang node:

(defun my-proced-erlang-node-name (attrs)
  ;; Proced only displays attributes that are present for the Emacs
  ;; process - so we need to return a non-nil value for non-beam
  ;; processes.
  (cons 'node
         (when (string-prefix-p "beam" (cdr (assq 'comm attrs)))
           (let ((args (or (cdr (assq 'args attrs))
                           ;; On OSX, process-attributes doesn't return args (yet?)
                            (concat "ps -p " (number-to-string (cdr (assq 'pid attrs)))
                                    " -o args=")))))
             (when (string-match "-s?name \\([^[:space:]]+\\)" args)
               (match-string 1 args))))

(eval-after-load "proced"
     (add-to-list 'proced-custom-attributes 'my-proced-erlang-node-name)
     (add-to-list 'proced-grammar-alist
                  '(node "Erlang node" "%s" left proced-string-lessp nil (node pid) (nil t nil)))))

And add it to a new format config (hit F in the proced buffer and type erlang:

(eval-after-load "proced"
  '(add-to-list 'proced-format-alist
                '(erlang user pid tree pcpu pmem start time node (args comm))))

Set SMTP server depending on From address

Added on [2014-02-21 Fri 14:45].

An amalgamation of various solutions proposed at .

(defvar my-smtp-servers ()
  "Map e-mail address to SMTP server hostname.
This is an alist, where the car of each entry is the email
address of the sender, and the cdr is the SMTP server to use for
that address.  By default, the port specified in
`smtpmail-smtp-service' is used, but that can be overridden for
an individual server by specifying it as \"\".

To set username, add \"machine login foo\" to ~/.authinfo.

To force a certain username when looking up the password, specify
the server as \"\".  The
last @ sign separates the username and the hostname.")

(with-eval-after-load "smtpmail"
  (defadvice smtpmail-via-smtp (around set-smtp-server-from-header activate)
    (let* ((from-address (save-restriction
                           (mail-fetch-field "from")))
            (when from-address
              (cdr (assoc-string (cadr
            (when (and server-entry
                       ;; greedy match: stop at last @ sign
                       (string-match "^\\(.*\\)@" server-entry))
              (match-string 1 server-entry)))
            (when server-entry
              (string-match "\\([^@:]*\\)\\(?::\\([0-9]+\\)\\)?$" server-entry)
              (cons (match-string 1 server-entry) (match-string 2 server-entry))))
            (or (and hostname-port (car hostname-port))
            (or (and hostname-port (cdr hostname-port) (string-to-number (cdr hostname-port)))
      (message "Using SMTP server %s:%s%s" smtpmail-smtp-server smtpmail-smtp-service
               (if smtpmail-smtp-user (concat ", username " smtpmail-smtp-user) ""))

Fix org-mode-line-clock

Added on [2014-02-21 Fri 16:28].

org-mode-line-clock is defined through org-copy-face as inheriting from mode-line. However, that’s not what I want, because it gets the “mode line active” face even in inactive buffers.

(eval-after-load "org-faces"
  '(set-face-attribute 'org-mode-line-clock nil
                       :inherit nil))

Update mode line face on focus

Added on [2014-02-21 Fri 16:45].

By default, the mode line of the current buffer has a light grey background and the mode lines of other buffers have a dark grey background. With this little hack, the mode line of the current buffer will be equally dark grey when Emacs is not the current application.

(defvar my-mode-line-active-background "gray75")
(defvar my-mode-line-inactive-background "gray40")

(defun my-unhighlight-mode-line ()
  (set-face-attribute 'mode-line nil
                      :background my-mode-line-inactive-background))

(add-hook 'focus-out-hook 'my-unhighlight-mode-line)

(defun my-highlight-mode-line ()
  (set-face-attribute 'mode-line nil
                      :background my-mode-line-active-background))

(add-hook 'focus-in-hook 'my-highlight-mode-line)

Always save buffer text before reverting (saves lives!)

(defun maybe-save-before-reverting ()
  (unless (or (bound-and-true-p auto-revert-mode)
              (bound-and-true-p auto-revert-tail-mode))
    (kill-new (buffer-string))
    (message "Previous buffer text saved to kill ring")))
(add-hook 'before-revert-hook 'maybe-save-before-reverting)

If playing a URL, stop instead of pausing

Added on [2013-07-30 Tue 11:46].

(defun my-emms-pause-or-stop ()
  (if emms-player-playing-p
      (if (eq (cdr (assq 'type (emms-playlist-current-selected-track))) 'url)

(global-set-key [f12] 'my-emms-pause-or-stop)

Pause music when Emacs is unfocussed

Added on [2014-04-07 Mon 01:44].

(defvar my-emms-pause-on-unfocus t)
(defvar my-emms-was-playing nil)

(defun my-emms-focus-out-pause ()
  (when my-emms-pause-on-unfocus
    (setq my-emms-was-playing
          (and (bound-and-true-p emms-player-playing-p)
               (not emms-player-paused-p)))
    (when my-emms-was-playing

(add-hook 'focus-out-hook 'my-emms-focus-out-pause)

(defun my-emms-focus-in-play ()
  (when my-emms-pause-on-unfocus
    (when my-emms-was-playing
      ;; Make sure nothing is actually playing... That should never happen.
      (unless (and emms-player-playing-p (not emms-player-paused-p))

(add-hook 'focus-in-hook 'my-emms-focus-in-play)

escript zip support for archive-mode

Added on [2014-05-23 Fri 18:26].

(defvar archive-escript-zip-hook nil)

(defun archive-escript-zip--narrow ()
  (goto-char (point-min))
  (search-forward-regexp "^\\(PK00\\)?[P]K\003\004")
  (narrow-to-region (match-beginning 0) (point-max)))

(defun archive-escript-zip-summarize ()

(defun archive-escript-zip-extract (_archive name)
  (let ((temp-file (make-temp-file "escript-archive" nil ".zip"))
        (coding-system-for-write 'binary))
          (with-current-buffer archive-superior-buffer
              (write-region archive-proper-file-start
                            temp-file nil :silent)))
          (archive-zip-extract temp-file name))
      (delete-file temp-file))))

(defun archive-escript-zip-find-type (old-fun)
  (goto-char (point-min))
  (let (case-fold-search)
     ((and (looking-at "#!.*escript")
           (search-forward-regexp "^\\(PK00\\)?[P]K\003\004" nil t))
      (funcall old-fun)))))

(with-eval-after-load "arc-mode"
  (advice-add 'archive-find-type :around #'archive-escript-zip-find-type))

(defun archive-escript-zip--maybe-turn-on ()
  (require 'arc-mode)
      (when (eq (ignore-errors (archive-find-type)) 'escript-zip)
         0.1 nil
         (lambda (buffer)
           (with-current-buffer buffer

(with-eval-after-load "erlang"
  (add-hook 'erlang-mode-hook 'archive-escript-zip--maybe-turn-on))

Avoid “ControlPath too long” with Tramp on OSX

Added on [2014-06-19 Thu 14:51].

For some reason, the function tramp-compat-temporary-file-directory disregards any customization for temporary-file-directory, and always goes with the standard value. On OSX, the standard value is likely to be fairly long, but /tmp is equivalent to it anyway:

Though on Windows, /tmp doesn’t exist, so check for that first:

(when (file-directory-p "/tmp/")
  (put 'temporary-file-directory 'standard-value (list "/tmp/")))

Avoid CFGERR disabling Flymake

Added on [2014-06-30 Mon 12:18].

Adapted from

If a Flymake compilation fails, but there are no error messages for the file being compiled (i.e., all errors are in included files), then Flymake will switch itself off and say:

switched OFF Flymake mode for buffer foo.erl|src due to fatal status CFGERR

This change makes it just display :CFGERR in the mode line, without deactivating Flymake.

(require 'cl-lib)
(defun my-flymake-cfgerr-is-benign (orig-fun &rest args)
  "Don't let `flymake-post-syntax-check' deactivate Flymake.
As described in,
CFGERR errors can be benign conditions."
  ;; Using `cl-letf' as a kind of temporary advice.
  (cl-letf (((symbol-function 'flymake-report-fatal-status)
             (lambda (_status _warning)
               (flymake-report-status "0/0" ":CFGERR"))))
    (apply orig-fun args)))

(with-eval-after-load "flymake"
  (advice-add 'flymake-post-syntax-check :around 'my-flymake-cfgerr-is-benign))

No nroff-mode for *.[1-9]

Added on [2014-08-26 Tue 11:33].

I never open nroff files, but often open log files matching this pattern. The nroff-mode font locking slows scrolling down considerably, so I prefer fundamental-mode for these.

(setq auto-mode-alist (delete '("\\.[1-9]\\'" . nroff-mode) auto-mode-alist))

Add Dvorak layout to quail-keyboard-layout-alist

Added on [2014-10-31 Fri 12:41].

This makes it possible to use input methods that emulate a different keyboard layout, such as ЙЦУКЕН.

(with-eval-after-load "quail"
  (let ((dvorak-layout
         (concat "                              "
                 "  1!2@3#4$5%6^7&8*9(0)[{]}`~  "
                 "  '\",<.>pPyYfFgGcCrRlL/?=+    "
                 "  aAoOeEuUiIdDhHtTnNsS-_\\|  "
                 "    ;:qQjJkKxXbBmMwWvVzZ      "
                 "                                "))
        (current-entry (assoc "dvorak" quail-keyboard-layout-alist)))
    (if current-entry
        (setf (cdr current-entry) dvorak-layout)
      (push (cons "dvorak" dvorak-layout) quail-keyboard-layout-alist))))
(quail-set-keyboard-layout "dvorak")

Try whatever flymake is doing

Added on [2013-01-07 Mon 17:48].

If flymake gives confusing results, try this function, to run the exact same command that flymake uses in a compilation buffer.

;; see `flymake-start-syntax-check'
(defun my-flymake-compile-manually ()
  (let* ((init-f (flymake-get-init-function buffer-file-name))
         (cmd-and-args (funcall init-f))
         (cmd (nth 0 cmd-and-args))
         (args (nth 1 cmd-and-args))
         (dir (nth 2 cmd-and-args)))
    (let ((default-directory (or dir default-directory)))
       (apply 'concat cmd " " (mapcar (lambda (arg) (concat (shell-quote-argument arg) " ")) args))))))

insert-pair bindings for square brackets and curly braces

Added on [2014-11-20 Thu 11:33].

;; XXX: this binding breaks decoding of PgUp / PgDn on terminals
;;(global-set-key (kbd "M-[") 'insert-pair)
(global-set-key (kbd "M-{") 'insert-pair)

Kill windows with S-s-up/down

Added on [2015-01-14 Wed 17:23].

(defun my-delete-next-window ()
  (delete-window (next-window)))
(global-set-key [S-s-down] 'my-delete-next-window)
(defun my-delete-previous-window ()
  (delete-window (previous-window)))
(global-set-key [S-s-up] 'my-delete-previous-window)

Fix the display of Emoji

Added on [2015-02-11 Wed 18:46].

Stolen from wasamasa.

For some reason, Emacs fails to find a fallback font for characters not supported by the default font, such as 🐈 (CAT). Annoyingly, it freezes for around a second when displaying a buffer containing such a character (at least on OSX). Let’s define a specific font for that character range.

;; `set-fontset-font' is not defined when Emacs is built without a
;; window system.
(when (fboundp 'set-fontset-font)
  (defun my-fix-emojis (&optional frame)
    (set-fontset-font "fontset-default" '(#x10000 . #x1ffff) "Symbola" frame))
  (add-hook 'after-make-frame-functions 'my-fix-emojis))

Automate MobileOrg push/pull

Push MobileOrg files asynchronously

Added on [2015-03-02 Mon 09:34].

This is somewhat annoying: after 60 seconds of idle time after saving an org-mode file, it blocks the entire Emacs session with agenda creation, copying etc. I find it’s better than the alternative, which is remembering to push manually.

(defun my-org-mobile-push-async ()
   `(lambda ()
      (require 'org-mobile)
      ,(async-inject-variables "org-\\(agenda-files\\|agenda-custom-commands\\|mobile\\)")
      ,(async-inject-variables "\\`version-control\\'")
      ;; Need to avoid prompting to delete old backups:
      (setq delete-old-versions 'never)
      ;; XXX: need to avoid queries about "stealing" unsaved org files
      ;; XXX: is this the right way to do it?
      (setq org-mobile-force-id-on-agenda-items nil)
      ;; XXX: necessary?
      ;; (save-some-buffers t)
   (lambda (result)
     (unless (equal result "Files for mobile viewer staged")
       (warn "push result: %S" result)))))

;; Let's do better than this:
;; (with-eval-after-load "org"
;;   (add-hook 'org-mode-hook
;;             (lambda ()
;;               (add-hook 'after-save-hook 'my-org-mobile-push-async nil t))))

(defvar my-org-mobile-push-timer nil)

(defun my-org-mobile-push-later ()
  (unless my-org-mobile-push-timer
    (setq my-org-mobile-push-timer
           60 nil
           (lambda ()
             (setq my-org-mobile-push-timer nil)
             (let ((my-org-mobile-push-timer t))

(when (file-exists-p "~/Dropbox/mobileorg/")
  (with-eval-after-load "org"
    (add-hook 'org-mode-hook
              (lambda ()
                (add-hook 'after-save-hook 'my-org-mobile-push-later nil t)))))

Automatically pull from MobileOrg

Added on [2015-03-02 Mon 12:02].

(defun my-org-mobile-maybe-pull ()
  (require 'org-mobile)
  (let* ((capture-file (expand-file-name org-mobile-capture-file org-mobile-directory))
         (attributes (file-attributes capture-file)))
    (if (null attributes)
        (warn "MobileOrg capture file `%s' not found" capture-file)
      (when (> (nth 7 attributes) 1)

;; Check every five minutes (assuming we're on the right box)
(when (file-exists-p "~/Dropbox/mobileorg/")
  (run-with-timer 300 300 'my-org-mobile-maybe-pull))

jabber.el hacks for specific servers

Hacks for jabber.el + Hipchat

Mention someone in a Hipchat chat room

Added on [2015-03-10 Tue 18:11].

Hipchat uses a non-standard mechanism for mentions in chat rooms: look for a special mention_name attribute in the roster entry. Good thing that we save the entire roster XML “just in case”.

Hit C-c C-m in a groupchat buffer and select “Hipchat mention” from the menu. Type the name of the person you want to mention, and their “mention name” will be inserted into the buffer.

Further work: replace the TAB binding for group chat buffers when the server is a Hipchat server.

(defun my-jabber-hipchat-mention (jid)
     "User: " (plist-get (fsm-get-state-data jabber-buffer-connection) :roster)
  (let* ((roster-xml (get (jabber-jid-symbol jid) 'xml))
         (mention-name (jabber-xml-get-attribute roster-xml 'mention_name)))
    (insert "@" mention-name " ")))

(with-eval-after-load "jabber-muc"
  (add-to-list 'jabber-jid-muc-menu
               (cons "Hipchat mention" 'my-jabber-hipchat-mention)))

Autojoin Hipchat rooms

Hipchat lists chat rooms using XEP-0048, but the “autojoin” field is off, and you can’t turn it on. Thus, here is a piece of magic that treats the autojoin field as if it were on, and autojoins all your Hipchat chat rooms after you connect.

(defun my-join-hipchat-rooms (c)
    (or (jabber-find-connection "")
        (error "Hipchat connection not found"))))
  (when (string= (jabber-jid-server (jabber-connection-jid c)) "")
     (lambda (jc bookmarks)
       (dolist (bookmark bookmarks)
         ;; same as jabber-muc-autojoin, but don't check autojoin,
         ;; because Hipchat inexplicably doesn't set that.
         (setq bookmark (jabber-parse-conference-bookmark bookmark))
         (when bookmark
           (put (jabber-jid-symbol (plist-get bookmark :jid)) 'name
                (plist-get bookmark :name))
           (jabber-muc-join jc (plist-get bookmark :jid)
                                  (or (plist-get bookmark :nick)
                                      (plist-get (fsm-get-state-data jc) :username)))))))

(with-eval-after-load "jabber-core"
  (add-hook 'jabber-post-connect-hooks 'my-join-hipchat-rooms))

Hacks for jabber.el + Slack

Join a Slack room

Also posted on Emacs Stack Exchange.

(defun jabber-join-slack-room (jc group nickname &optional popup)
   (let ((account (jabber-read-account))
         (group (jabber-read-jid-completing "group: ")))
     (list account group (jabber-muc-read-my-nickname account group) t)))
  ;; The Slack server does not return a proper disco result:
  ;; 1. The disco response has no 'from' attribute.  It should be
  ;; copied from the 'to' attribute of the request, so that the client
  ;; can correlate the request and the response.
  ;; 2. The response doesn't contain an identity of "conference",
  ;; which jabber.el looks for to confirm that this is in fact a
  ;; conference room.  (It would be confusing to try to "join" one of
  ;; your contacts.)
  ;; 3. The disco response doesn't contain the feature
  ;; "muc_passwordprotected", so jabber.el doesn't know that it needs
  ;; to provide a password.
  ;; Therefore, let's seed the correct information into the disco
  ;; cache before joining the room.
   jc `(iq ((type . "result")
             (from . ,group)
             (id . "emacs-iq-21272.27175.175195")
             (xmlns . "jabber:client")
             (to . ,(jabber-connection-jid jc)))
            (query ((xmlns . ""))
                   (identity ((category . "conference") (type . "text")))
                   (feature ((var . "")))
                   ;; XXX: is this necessary?
                   ;; (feature ((var . "muc_passwordprotected")))
   (list nil))
  (jabber-muc-join jc group nickname popup))

Automatically join Slack rooms on login

In response to a disco items request, the Slack conference server returns only the rooms that you have explicitly “joined” from the web interface. Let’s use that to our advantage, since Slack doesn’t present the interesting rooms as bookmarks.

(defun jabber-slack-join-all-rooms (jc)
  (interactive (list (jabber-read-account)))
  (let* ((server (jabber-jid-server (jabber-connection-jid jc)))
         (conference-server (concat "conference." server)))
    ;; Only do this when connecting to Slack.
    (when (string-suffix-p "" server)
       jc conference-server nil
       (lambda (jc _ result)
         (if (eq (car result) 'error)
             (warn "Error when requesting Slack rooms: %S" result)
           (dolist (item result)
             (let ((jid (elt item 1))
                   (nickname (jabber-jid-username (jabber-connection-jid jc))))
               ;; TODO: password
               (jabber-join-slack-room jc jid nickname)))))

(with-eval-after-load "jabber-core"
  (add-hook 'jabber-post-connect-hooks 'jabber-slack-join-all-rooms))


Added on [2015-03-11 Wed 15:38].

(defun relax ()
  ;; Text strings stolen from |
  ;; Subject to:
  ;; The MIT License (MIT)
  ;; Copyright (c) 2014 Marlena Compton
  ;; Permission is hereby granted, free of charge, to any person obtaining a copy
  ;; of this software and associated documentation files (the "Software"), to deal
  ;; in the Software without restriction, including without limitation the rights
  ;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  ;; copies of the Software, and to permit persons to whom the Software is
  ;; furnished to do so, subject to the following conditions:
  ;; The above copyright notice and this permission notice shall be included in all
  ;; copies or substantial portions of the Software.
  (let ((strings
         ["Feelings come and go like clouds in a windy sky."
          "Open your heart's eyes."
          "Take a deep breath."
          "It will be ok."
          "Take a look around and notice what is really happening, right now, in this moment."
          "Give yourself a break."
          "May you be healthy."
          "May you be safe."
          "Impermanence and change is a powerful teacher and teaching."
          "Who is really in pain when we hold on to resentments and grudges?"
          "May you be at peace."
          "Live life one inhalation and one exhalation at a time."
          "Bring love into your heart, into your breath and into your being."
          "Reflect on the fragility and preciousness of life."
          "Stop and focus on whatever is being carried within you and let be."
          "Briefly notice any emotions, thoughts or sensations that may be driving fear and anxiety and let them be."
          "This discomfort will pass."
          "Slow down and ask yourself what is really happening."
          "Feelings of panic are uncomfortable, but they will not harm you."
          "Open your heart's eyes."
          "Stop and take a slow breath."
          "Inhale slowly and exhale slowly."
          "Exhale and let the muscles in your shoulders drop and relax."
          "Anxiety and panic will pass."
          "Panic is your body revving up temporarily, but it will slow down."
          "Let the muscles in your neck and shoulders relax."
          "You can do this."
          "You can get through this."
          "You can do what you set out to do; yes, you can."
          "Watch each breath appear and disappear, just breathing."
          "Hear the internal and external sounds around you rise and fall."
          "Open your heart to love as boundless as the sun, the moon, the stars."
          "Open your heart to change, forgiveness and lovingkindness."
          "Just acknowledge what's there and let be."
          "Let go of the need to analyze and let be."
          "Love is the first seed of the soul."
          "Empty your mind; be formless, shapeless like water."
          "Picture yourself releasing the burden you feel from sorrow, regret or resentment."]))
    (message "%s" (elt strings (random (length strings))))))

(global-set-key (kbd "s-5") 'relax)
;; Also f6, in case the window manager steals super-5
(global-set-key [f6] 'relax)


Added on [2015-04-13 Mon 17:48].

List all buffers, including invisible ones (whose names start with a space).

From this answer by Trey Jackson.

(defun list-all-buffers (&optional files-only)
  "Display a list of names of existing buffers.
The list is displayed in a buffer named `*Buffer List*'.
Non-null optional arg FILES-ONLY means mention only file buffers.

For more information, see the function `buffer-menu'."
  (interactive "P")
  (display-buffer (list-buffers-noselect files-only (buffer-list))))

s-w to copy path of current file

Added on [2015-06-02 Tue 14:53].

(defun my-copy-file-name ()
  (if buffer-file-name
        (kill-new buffer-file-name)
        (message "Copied file name to kill ring"))
    (user-error "Current buffer not associated with a file")))
(global-set-key (kbd "s-w") 'my-copy-file-name)

Minor mode lighters

Added on [2015-08-21 Fri 12:47].

(dolist (x '(
             ("golden-ratio" golden-ratio-mode "黄金比")
             ("org-capture" org-capture-mode "")
             ("view" view-mode "")
             ("minimap" minimap-mode "小図")
             ("compile" compilation-in-progress "変換")
             ("color-identifiers-mode" color-identifiers-mode "")
  (pcase-let ((`(,module ,mode ,new-lighter) x))
    (eval-after-load module
      `(setf (cadr (assq ',mode minor-mode-alist))
             (concat (propertize "" 'face 'variable-pitch)

F5 is jabber-activity-switch-to

Added on [2015-09-09 Wed 10:33].

(global-set-key [f5] 'jabber-activity-switch-to)

Display EMMS status in mode line

Added on [2015-09-11 Fri 17:06].

Use fancy Unicode symbols to indicate if EMMS is playing, paused or stopped.

;; Using lists of the form (SYMBOL THEN ELSE).
;; If SYMBOL's value is non-nil, use THEN, otherwise ELSE.
(defvar my-emms-mode-line-string
  '(emms-player-playing-p (emms-player-paused-p "" "") ""))

;; Display if EMMS is loaded, in which case emms-player-list
;; should be set.
 '(emms-player-list my-emms-mode-line-string))

.md files use gfm-mode

Added on [2015-10-11 Sun 23:55].

Files with extension .md are usually using Github-Flavoured Markdown. Let’s treat them as such.

(with-eval-after-load "markdown-mode"
  (setf (cdr (assoc "\\.md\\'" auto-mode-alist)) 'gfm-mode))

Set show-trailing-whitespace in programming modes

Added on [2016-04-06 Wed 15:00].

show-trailing-whitespace is nice, but setting it globally marks things where I can’t do anything about it, e.g. VC Git log mode. Let’s turn it on in programming mode buffers only:

(add-hook 'prog-mode-hook
          (lambda ()
            (setq-local show-trailing-whitespace t)))

Let ispell fix last word

Added on [2016-05-18 Wed 13:11].

If I notice that I misspelt a word, I hit M-$ to ask ispell to fix it, and more often than not the 0th suggestion is the correct one. Let’s make that quicker, by binding C-$ to accepting the 0th suggestion.

(fset 'my-ispell-fix-word
   (lambda (&optional arg) "Keyboard macro." (interactive "p") (kmacro-exec-ring-item (quote ("\2440" 0 "%d")) arg)))
(global-set-key (kbd "C-$") 'my-ispell-fix-word)

Save compilation output for later perusal

Added on [2016-06-28 Tue 13:47].

;; On some systems, /tmp is automatically cleaned up periodically.
;; For the others - we compress the output, so maybe it's not so bad?
(defvar my-compilation-archive-dir "/tmp/compilations")

(defvar my-compilation-archive-compression-suffix ".xz")

;; for string-trim-right
(require 'subr-x)

(defun my-compilation-save-output (buffer status)
  (make-directory my-compilation-archive-dir t)
  (let ((output-file (expand-file-name
                      (concat (format-time-string "%F-%T")
    (condition-case e
        (with-current-buffer buffer
          (write-region (point-min) (point-max) output-file nil :silent)
          (message "Compilation %s, output saved in %s" (string-trim-right status) output-file))
       (message "Compilation %s, failed to save output in %s: %s"
                (string-trim-right status) output-file (error-message-string e))))))

(with-eval-after-load "compile"
  (add-hook 'compilation-finish-functions 'my-compilation-save-output))

Pretty-print XML in region in a new buffer

Added on [2016-07-08 Fri 13:24].

If you have an XML element printed on one single line, mark it and type C-c x to display it with line breaks and indentation in a fresh buffer.

(defun my-xml-pretty-print-region (beg end)
  (interactive "r")
  (let ((buffer (get-buffer-create "*display-xml*"))
        (text (buffer-substring beg end)))
    (with-current-buffer buffer
      (insert text)
      (shell-command-on-region (point-min) (point-max) "xmllint --format -" nil t)
      (display-buffer buffer))))

(global-set-key (kbd "C-c x") 'my-xml-pretty-print-region)

Forward browse-url through SSH tunnel

Added on [2017-01-12 Thu 12:08].

If you’re running Emacs on a remote machine over SSH, but want browse-url and friends to open web pages in the local (presumably graphical) browser, use this little thing.

The idea is that on the local machine, you’re running Emacs, listening on port 12345 on the loopback interface, and in your SSH session, you forward port 12345 from the remote machine back to the local machine.

The remote machine just has to connect and send the URL:

(defun my-browse-url-remotely (url &optional _new-window)
  (let ((s (open-network-stream "connect-url" nil "localhost" 12345)))
    (process-send-string s (concat "browse " url "\n"))
    (delete-process s)))

Add this to .emacs to set browse-url to use it:

(with-eval-after-load "browse-url"
  (setq browse-url-browser-function 'my-browse-url-remotely))

Also allow copying the region to the local clipboard:

(defun my-copy-remotely (beg end)
  (interactive "r")
  (let ((s (open-network-stream "connect-url" nil "localhost" 12345)))
     (concat "copy "
             ;; encode as base64, so we can keep newline as delimiter
              (encode-coding-string (buffer-substring beg end) 'utf-8)
    (delete-process s)
    (setq deactivate-mark t)
(global-set-key (kbd "C-c M-w") 'my-copy-remotely)

On the local machine, here is the listener:

(defvar my-wait-for-url-socket nil)

(defun my-wait-for-url ()
  "Listen on port 12345 (loopback only) for URLs to open.
To make this thing open a URL, open a TCP connection, and send
the URL followed by a newline."
  (when my-wait-for-url-socket
    (delete-process my-wait-for-url-socket)
    (setq my-wait-for-url-socket nil))
  (setq my-wait-for-url-socket
         :name "my-wait-for-url"
         :service 12345
         :host 'local
         :coding 'utf-8
         :noquery t
         :server 5
         ;; :sentinel 'my-wait-for-url-sentinel
         :filter 'my-wait-for-url-filter)))

(defun my-wait-for-url-filter (p data)
  (let ((acc (or (process-get p :acc) "")))
    (setq acc (concat acc data))
    (process-put p :acc acc)
    (when (string-suffix-p "\n" acc)
      (setq acc (substring acc 0 -1))
       ((string-prefix-p "browse " acc)
        ;; `browse-url' uses the value of `browse-url-browser-function'
        ;; to decide what to do.  However, in the *GNU Emacs* "splash"
        ;; buffer, that variable has an unconditional buffer-local
        ;; value of `eww-browse-url'!  Let's use a temporary buffer here,
        ;; so that we get the default value, as set through Customize.
          (browse-url (substring acc (length "browse ")))))
       ((string-prefix-p "copy " acc)
        (kill-new (decode-coding-string
                   (base64-decode-string (substring acc (length "copy ")))
      (delete-process p))))

Add this to .emacs on the local machine to start it:


This will “forward” browse-url calls from the remote machine to the local machine. Customize browse-url-browser-function on the local machine if it doesn’t use the web browser you expect.

Disable edts-mode when there is no file name

Added on [2017-09-27 Wed 17:41].

When opening an Erlang source block in org-mode, edts-mode fails to start because buffer-file-name returns nil. Let’s check for that:

(with-eval-after-load "edts-mode"
  (advice-add 'edts-mode :before-while 'buffer-file-name))

Require gnus-icalendar

Added on [2017-11-06 Mon 14:39].

Make sure that calendar invites show up in a readable form, not raw Icalendar format.

(with-eval-after-load "gnus-art"
  (require 'gnus-icalendar)

Invoke gdb on core file

Added on [2018-03-16 Fri 14:12].

It’s harder than it should be to start M-x gdb with a core dump file. You have to specify where the executable is, even though that information is present in the core dump file, and then you have to specify an absolute path to the core dump, since M-x gdb moves to the directory where the executable is. Let’s create a function that simplifies that:

(defun my-gdb-core (filename)
  (interactive "fCore file: ")
  ;; Need absolute path, since M-x gdb moves to the directory where the executable is.
  (setq filename (expand-file-name filename))
  ;; file returns something like:
  ;; core.47509: ELF 64-bit LSB core file x86-64, version 1 (SYSV), SVR4-style, from '/foo/bar/baz -v'
  ;; We want to extract "/foo/bar/baz" from that.  Let's assume it doesn't contain spaces...
  (let ((file-output (with-output-to-string
                       (call-process "file" nil standard-output nil filename))))
    (unless (string-match ", from '\\([^ ]+\\)" file-output)
      (error "Failed to find executable name in `file' output: %s" file-output))
    (let ((executable (match-string 1 file-output)))
       (format "gdb -i=mi %s %s" executable filename)))))