sbr

Vincent Demeester’s .emacs.d

Overview

What is this

The present document, referred to in the source code version as emacs.org, contains the bulk of my configurations for GNU Emacs. It is designed using principles of “literate programming”: a combination of ordinary language and inline code blocks. Emacs knows how to parse this file properly so as to evaluate only the elisp (“Emacs Lisp”) included herein. The rest is for humans to make sense of my additions and their underlying rationale.

Literate programming allows us to be more expressive and deliberate. Not only we can use typography to its maximum potential, but can also employ techniques such as internal links between sections. This makes the end product much better for end users, than a terse script.

I switched back and forth on using org-mode and literate programming, so why re-using it. First, I think I went for it the wrong way the first time. I copied part of the configuration from elsewhere, sometimes without really needing what I was copying. for some reason I think this is a common pattern when configuring Emacs. You start by using a distribution (Doom Emacs, Spacemacs, …) or by copying configuration from all over the place. Slowly but surely you realize this was a mistake as you didn’t learn anything, so you reboot your configuration.

I’m taking Protesilaos Stavrou approach on writing and configuring this file (see his dotemacs), although I am not loading it directly. I prefer using the tangle feature of org-mode instead of loading it using org-babel function. This allows me to document my configuration and generating final(s) .el files. Those files can then load and/or pre-compile, without the need to load org first. It also means that I can add code pieces in there that won’t be tangle, like usage example ; and I also can use this to generate any additional file I need, whatever the programming language they are written in. Protesilaos Stavrou is not my only source, here are some others:

And also:

Why using GNU/Emacs ?

This is a question I thought I needed to answer, or at least, document why I am choosing GNU/Emacs as my primary editor. Protesilaos Stavrou has a video about it, really interesting.

There is a lot of reasons but for me, the following are the main ones:

  • Open Source: this is a “of course”, but my editor has to be open-sourced. This seems to be the norm these days anyway (and for a long time, with vim).
  • Lightweight: the editor should be relatively lightweight. I don’t want a full browser loaded to edit files, and I want to be able to run it in a terminal, on a server. vim can do that (and sometimes, vim or vi is enough 👼).
  • Extensible: to be honest, this is the most important reason. I want to be able to extend my editor as much as possible.

GNU/Emacs checks all the boxes for me. Even though GNU/Emacs is probably not as lightweight as vim, it is definitely lightweight compared to all the Electron-based editors (vscode, …). It is of course open-source, and since ages (almost as old as I am 😅). And best of all, GNU/Emacs is extensible as you couldn’t dream of. Emacs is a lisp interpreter, and it is designed to be extended in order to meet the user’s needs. Extensibility is the quintessential Emacs quality. You can modify any piece of elisp in real time.

I’m also a huge fan of text-based software, a.k.a. do whatever you can using text : reading mails, news, organizing notes and todos, all can be done in text. And GNU/Emacs shines at this. For emails and news, you’ve got Gnus built-in, for notes and todos, the wonderful org-mode is the best thing on earth (seriously, this is the one mode that made me switch from vim).

Assumptions

I’ll make a few assumption in the following document (that may or may not be true):

  • nix is available, either from NixOS or via an install of nix. I’ll try my best to support non-nix environment, but it’s definitely not my current focus.
    • As I am making the assumption that nix is available, I am also making the assumption that all the library required are already present (in my home, there is a file called emacs.nix that encapsulate those dependencies). This is why, by default use-package doesn’t use the ensure option in 99% of the configuration.
  • Any function I wrote is going to be prefixed by vde/ so that it doesn’t conflicts with function that would have been defined elsewhere.

TODO Keybinding

As it is detailed in each part of this configuration, I am trying to setup keybinding in a mnemonics way so it’s easy to remember (and use). This is what spacemacs does with evil keybindings (aka vim-like keybindings). I am staying with the standard emacs keybinding as much as possible (as there is already some mnemonics in there).

There are countless jokes and comics on Emacs’s seemingly ridiculous keybindings. Good laughs indeed, but at the end of day, it’s not incomprehensible. It has well-defined conventions listed at Emacs Key Bindings Convention. In summary, the general rules are:

  • C-x reserved for Emacs native essential keybindings: buffer, window, frame, file, directory, etc…
  • C-c reserved for user and major mode:
    • C-c letter reserved for user. <F5>-<F9> reserved for user.
    • C-c C-letter reserved for major mode.
  • Don’t rebind C-g, C-h and ESC.

To give a small example, most of my personal org-mode keybinding will start with C-c o, as it is reserved for user, and o is for org-mode. For version control, it’s gonna be C-c v, for projects it’s gonna be C-c p, etc…

prefix “mode”
<F1>  
<F2>  
<F3> built-in Register macro(s)
<F4> built-in Plays macro(s)
<F5> revert-buffer
<F6>  
<F7>  
<F8>  
<F9>  
<F10>  
<F11>  
<F12>  
C-c b Bookmarks (bookmark-plus)
C-c h Help (helpful, …)
C-c n Navigation (avy, …)
C-c o Org mode
C-c p Projects (projectile, …)
C-c v Version control (vc, magit, …)
C-c w Window management (ace-window, …)
C-x p Bookmarks (bookmark-plus, …)

See also:

COPYING

Copyright (c) 2013-2020 Vincent Demeester <vincent@sbr.pm>

This file is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.

This file is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with this file. If not, see http://www.gnu.org/licenses/.

Base settings

This section contains configurations that are needed prior to the setup of everything else. Anything that needs to be configured first should be in there, this includes the init.el and early-init.el files content.

Initiazing emacs

Starting with Emacs 27, an early-init.el file can be used to do early configuration and optimization.

Emacs can now be configured using an early init file. The file is called early-init.el, in user-emacs-directory. It is loaded very early in the startup process: before graphical elements such as the tool bar are initialized, and before the package manager is initialized. The primary purpose is to allow customizing how the package system is initialized given that initialization now happens before loading the regular init file (see below).

We recommend against putting any customizations in this file that don’t need to be set up before initializing installed add-on packages, because the early init file is read too early into the startup process, and some important parts of the Emacs session, such as ’window-system’ and other GUI features, are not yet set up, which could make some customization fail to work.

We can use this to our advantage and optimize the initial loading of emacs.

  • Before Emacs 27, the init file was responsible for initializing the package manager by calling `package-initialize’. Emacs 27 changed the default behavior: It now calls `package-initialize’ before loading the init file.

    (setq package-enable-at-startup nil)
    
  • Let’s inhibit resizing the frame at early stage.

    (setq frame-inhibit-implied-resize t)
    
  • I never use the menu-bar, or the tool-bar or even the scroll-bar, so we can safely disable those very very early.

    (menu-bar-mode -1)
    (tool-bar-mode -1)
    (scroll-bar-mode -1)
    (horizontal-scroll-bar-mode -1)
    
  • Finally we can try to avoid garbage collection at startup. The garbage collector can easily double startup time, so we suppress it at startup by turning up gc-cons-threshold (and perhaps gc-cons-percentage) temporarily.

    (setq gc-cons-threshold 402653184
          gc-cons-percentage 0.6)
    
  • Another small optimization concerns on file-name-handler-alist : on every .el and .elc file loaded during start up, it has to runs those regexps against the filename ; setting it to nil and after initialization finished put the value back make the initialization process quicker.

    (defvar file-name-handler-alist-original file-name-handler-alist)
    (setq file-name-handler-alist nil)
    

    However, it is important to reset it eventually. Not doing so will cause garbage collection freezes during long-term interactive use. Conversely, a gc-cons-threshold that is too small will cause stuttering.

    (add-hook 'after-init-hook
              `(lambda ()
                 (setq gc-cons-threshold 67108864 ; 64mb
                       gc-cons-percentage 0.1
                       file-name-handler-alist file-name-handler-alist-original)
                 (garbage-collect)) t)
    

One thing though, I am currently not necessarily running Emacs 27, so I am going to need to have the same configuration in init.el for a little bit of time.

Note: the lowest emacs version I wanna support is 26 (as of today, might evolve)

(let ((minver 26))
  (unless (>= emacs-major-version minver)
    (error "Your Emacs is too old -- this configuration requires v%s or higher" minver)))

(defconst emacs-start-time (current-time))

;; load early-init.el before Emacs 27.0
(unless (>= emacs-major-version 27)
  (message "Early init: Emacs Version < 27.0")
  (load (expand-file-name "early-init.el" user-emacs-directory)))

We also want our configuration to be working the same on any computer, this means we want to define every option by ourselves, not relying on default files (default.el) that would be set by our distribution. This is where inhibit-default-init comes into play, setting it to non-nil inhibit loading the default library.

We also want to inhibit some initial default start messages and screen. The default screen will be as bare as possible.

(setq inhibit-default-init t)           ; Disable the site default settings

(setq inhibit-startup-message t
      inhibit-startup-screen t)

Let’s also use y or n instead of yes and no when exiting Emacs.

(setq confirm-kill-emacs #'y-or-n-p)

One last piece to the puzzle is the default mode. Setting it to fundamental-mode means we won’t load any heavy mode at startup (like org-mode). We also want this scratch buffer to be empty, so let’s set it as well

(setq initial-major-mode 'fundamental-mode
      initial-scratch-message nil)

Unicode all the way

By default, all my systems are configured and support utf-8, so let’s just make it a default in Emacs ; and handle special case on demand.

(prefer-coding-system 'utf-8)
(set-default-coding-systems 'utf-8)
(set-language-environment 'utf-8)
(set-selection-coding-system 'utf-8)
(set-terminal-coding-system 'utf-8)

Package management with use-package

use-package is a tool that streamlines the configuration of packages. It handles everything from assigning key bindings, setting the value of customisation options, writing hooks, declaring a package as a dependency for another, and so on.

The use-package macro allows you to isolate package configuration in your .emacs file in a way that is both performance-oriented and, well, tidy. I created it because I have over 80 packages that I use in Emacs, and things were getting difficult to manage. Yet with this utility my total load time is around 2 seconds, with no loss of functionality!

With use-package we can improve the start-up performance of Emacs in a few fairly simple ways. Whenever a command is bound to a key it is configured to be loaded only once invoked. Otherwise we can specify which functions should be autoloaded by means of the :commands keyword.

We need to setup the emacs package system and install use-package if not present already.

(require 'package)

(setq package-archives
      '(("melpa" . "http://melpa.org/packages/")
        ("org" . "https://orgmode.org/elpa/")
        ("gnu" . "https://elpa.gnu.org/packages/")))

(setq package-archive-priorities
      '(("melpa" .  3)
        ("org" . 2)
        ("gnu" . 1)))

(require 'tls)

;; From https://github.com/hlissner/doom-emacs/blob/5dacbb7cb1c6ac246a9ccd15e6c4290def67757c/core/core-packages.el#L102
(setq gnutls-verify-error (not (getenv "INSECURE")) ; you shouldn't use this
      tls-checktrust gnutls-verify-error
      tls-program (list "gnutls-cli --x509cafile %t -p %p %h"
                        ;; compatibility fallbacks
                        "gnutls-cli -p %p %h"
                        "openssl s_client -connect %h:%p -no_ssl2 -no_ssl3 -ign_eof"))

;; Initialise the packages, avoiding a re-initialisation.
(unless (bound-and-true-p package--initialized)
  (setq package-enable-at-startup nil)
  (package-initialize))

(setq load-prefer-newer t)              ; Always load newer compiled files
(setq ad-redefinition-action 'accept)   ; Silence advice redefinition warnings

;; Init `delight'
(unless (package-installed-p 'delight)
  (package-refresh-contents)
  (package-install 'delight))

;; Configure `use-package' prior to loading it.
(eval-and-compile
  (setq use-package-always-ensure nil)
  (setq use-package-always-defer nil)
  (setq use-package-always-demand nil)
  (setq use-package-expand-minimally nil)
  (setq use-package-enable-imenu-support t))

(unless (package-installed-p 'use-package)
  (package-refresh-contents)
  (package-install 'use-package))

(eval-when-compile
  (require 'use-package))

custom.el

When you install a package or use the various customisation interfaces to tweak things to your liking, Emacs will append a piece of elisp to your init file. I prefer to have that stored in a separate file.

(defconst vde/custom-file (locate-user-emacs-file "custom.el")
  "File used to store settings from Customization UI.")

(use-package cus-edit
  :config
  (setq
   custom-file vde/custom-file
   custom-buffer-done-kill nil          ; Kill when existing
   custom-buffer-verbose-help nil       ; Remove redundant help text
   custom-unlispify-tag-names nil       ; Show me the real variable name
   custom-unlispify-menu-entries nil)
  (unless (file-exists-p custom-file)
    (write-region "" nil custom-file))

  (load vde/custom-file 'no-error 'no-message))

Remove built-in org-mode

I want to make sure I am using the installed version of orgmode (from my org configuration) instead of the built-in one. To do that safely, let’s remove the built-in version out of the load path.

(require 'cl-seq)
(setq load-path
      (cl-remove-if
       (lambda (x)
         (string-match-p "org$" x))
       load-path))

Loading configuration files

This org-mode document tangles into several files in different folders :

  • config for my configuration
  • lisp for imported code or library I’ve written and not yet published

I used to load them by hand in the init.el file, which is very cumbersome, so let’s try to automatically load them. I want to first load the file in the lisp folder as they are potentially used by my configuration (in config).

Let’s define some functions that would do the job.

(defun vde/el-load-dir (dir)
  "Load el files from the given folder"
  (let ((files (directory-files dir nil "\.el$")))
    (while files
      (load-file (concat dir (pop files))))))

(defun vde/short-hostname ()
  "Return hostname in short (aka wakasu.local -> wakasu)"
  (string-match "[0-9A-Za-z-]+" system-name)
  (substring system-name (match-beginning 0) (match-end 0)))

Let’s define some constants early, based on the system, and the environment, to be able to use those later on to skip some package or change some configuration accordingly.

(defconst *sys/gui*
  (display-graphic-p)
  "Are we running on a GUI Emacs ?")
(defconst *sys/linux*
  (eq system-type 'gnu/linux)
  "Are we running on a GNU/Linux system?")
(defconst *sys/mac*
  (eq system-type 'darwin)
  "Are we running on a Mac system?")
(defconst *sys/root*
  (string-equal "root" (getenv "USER"))
  "Are you a ROOT user?")
(defconst *nix*
  (executable-find "nix")
  "Do we have nix? (aka are we running in NixOS or a system using nixpkgs)")
(defconst *rg*
  (executable-find "rg")
  "Do we have ripgrep?")
(defconst *gcc*
  (executable-find "gcc")
  "Do we have gcc?")
(defconst *git*
  (executable-find "git")
  "Do we have git?")

(defvar *sys/full*
  (member (vde/short-hostname) '("wakasu" "naruhodo")) ; "naruhodo" <- put naruhodo back in
  "Is it a full system ?")
(defvar *sys/light*
  (not *sys/full*)
  "Is it a light system ?")

Now, in order to load lisp and config files, it’s just a matter of calling this function with the right argument.

(add-to-list 'load-path (concat user-emacs-directory "lisp/"))
(add-to-list 'load-path (concat user-emacs-directory "lisp/modus-themes"))
(add-to-list 'load-path (concat user-emacs-directory "lisp/vorg"))
(require 'init-func)
(vde/el-load-dir (concat user-emacs-directory "/config/"))

Finally, I want to be able to load files for a specific machine, in case I need it (not entirely sure why yet but…)

(if (file-exists-p (downcase (concat user-emacs-directory "/hosts/" (vde/short-hostname) ".el")))
    (load-file (downcase (concat user-emacs-directory "/hosts/" (vde/short-hostname) ".el"))))

Counting the time of loading

(let ((elapsed (float-time (time-subtract (current-time)
                                          emacs-start-time))))
  (message "Loading %s...done (%.3fs)" load-file-name elapsed))

(add-hook 'after-init-hook
          `(lambda ()
             (let ((elapsed
                    (float-time
                     (time-subtract (current-time) emacs-start-time))))
               (message "Loading %s...done (%.3fs) [after-init]"
                        ,load-file-name elapsed))) t)

PATH’s customization

To make sure my emacs instance and my user environment setup is always similar, I use exec-path-from-shell.

Ever find that a command works in your shell, but not in Emacs?

This happens a lot on OS X, where an Emacs instance started from the GUI inherits a default set of environment variables.

This library solves this problem by copying important environment variables from the user’s shell: it works by asking your shell to print out the variables of interest, then copying them into the Emacs environment.

(use-package exec-path-from-shell       ; Set up environment variables
  :if (display-graphic-p)
  :unless (eq system-type 'windows-nt)
  :config
  (setq exec-path-from-shell-variables
        '("PATH"               ; Full path
          "INFOPATH"           ; Info directories
          "GOPATH"             ; Golang path
          ))
  (exec-path-from-shell-initialize))

(setenv "PAGER" "cat")
(setenv "TERM" "xterm-256color")

Keep emacs clean

I want to keep the ~/.emacs.d folder as clean as possible. The no-littering project helps wit that.

The default paths used to store configuration files and persistent data are not consistent across Emacs packages. This isn’t just a problem with third-party packages but even with built-in packages.

Some packages put these files directly in user-emacs-directory or $HOME or in a subdirectory of either of the two or elsewhere. Furthermore sometimes file names are used that don’t provide any insight into what package might have created them.

This package sets out to fix this by changing the values of path variables to put configuration files in no-littering-etc-directory (defaulting to ~/.emacs.d/etc/) and persistent data files in no-littering-var-directory (defaulting to ~/.emacs.d/var/), and by using descriptive file names and subdirectories when appropriate. This is similar to a color-theme; a “path-theme” if you will.

Let’s configure it and make sure we load it as soon as possible (hence the config/00-clean.el).

As I am loading recentf during this cleanup part, I need to setup recentf before 😅. In a gist:

  • I keep about 200 items.
  • I don’t want the auto-cleanup of recentf items to happen when the mode is loaded (a.k.a. at startup). It is configured to run after 360s of idle time.
  • I don’t really want to show the Nth number of the items.
  • I don’t want recentf to save remote, su and sudo items (ssh:, sudo:, …)
(use-package recentf
  :config
  (setq recentf-max-saved-items 200
        recentf-auto-cleanup 360
        recentf-show-file-shortcuts-flag nil)
  (recentf-mode 1)
  (add-to-list 'recentf-exclude "^/\\(?:ssh\\|su\\|sudo\\)?:")
  ;; Magic advice to rename entries in recentf when moving files in
  ;; dired.
  (defun rjs/recentf-rename-notify (oldname newname &rest args)
    (if (file-directory-p newname)
        (rjs/recentf-rename-directory oldname newname)
      (rjs/recentf-rename-file oldname newname)))

  (defun rjs/recentf-rename-file (oldname newname)
    (setq recentf-list
          (mapcar (lambda (name)
                    (if (string-equal name oldname)
                        newname
                      oldname))
                  recentf-list))
    recentf-cleanup)

  (defun rjs/recentf-rename-directory (oldname newname)
    ;; oldname, newname and all entries of recentf-list should already
    ;; be absolute and normalised so I think this can just test whether
    ;; oldname is a prefix of the element.
    (setq recentf-list
          (mapcar (lambda (name)
                    (if (string-prefix-p oldname name)
                        (concat newname (substring name (length oldname)))
                      name))
                  recentf-list))
    recentf-cleanup)

  (advice-add 'dired-rename-file :after #'rjs/recentf-rename-notify))

(use-package no-littering               ; Keep .emacs.d clean
  :config
  (require 'recentf)
  (add-to-list 'recentf-exclude no-littering-var-directory)
  (add-to-list 'recentf-exclude no-littering-etc-directory)

  ;; Move this in its own thing
  (setq
   create-lockfiles nil
   delete-old-versions t
   kept-new-versions 6
   kept-old-versions 2
   version-control t)

  (setq
   backup-directory-alist
   `((".*" . ,(no-littering-expand-var-file-name "backup/")))
   auto-save-file-name-transforms
   `((".*" ,(no-littering-expand-var-file-name "auto-save/") t))))

Server mode

My current setup involves a emacs --daemon systemd service. We want to start the server if it’s not already running, so that emacsclient can connect to it.

(use-package server
  :disabled
  :config (or (server-running-p) (server-mode)))

Base typeface configurations

Let’s configure the font that Emacs will use. In the emacs world this is call face. I am a big fan of the Ubuntu fonts, so this is the set of font family I use, if available. If the Ubuntu font are not available on the system, I am just letting Emacs start with its default font.

(use-package emacs
  :defer 3
  :bind ("C-c f r" . mu-reset-fonts)
  :commands (mu-reset-fonts)
  :hook (after-init . mu-reset-fonts)
  :config

  (defun mu-reset-fonts ()
    "Reset fonts to my preferences."
    (interactive)
    (when (member "Ubuntu Mono" (font-family-list))
      (set-face-attribute 'default nil
                          :family "Ubuntu Mono"
                          :height font-height)
      (set-face-attribute 'fixed-pitch nil
                          :family "Ubuntu Mono"
                          :height font-height))
    (when (member "Ubuntu Sans" (font-family-list))
      (set-face-attribute 'variable-pitch nil
                          :family "Ubuntu Sans"
                          :height font-height
                          :weight 'regular))))

Typeface suitability test

Here is a simple test I have come up with to make an initial assessment of the overall quality of the font: can you discern the character at a quick glance? If yes, your choice of typeface is good prima facie, else search for something else.

()[]{}<>«»‹› 6bB8&0ODdo 1tiIlL| !ij 5$Ss 7Zz gqp nmMN uvvwWuuw x×X .,·°;:¡!¿? :; `’ ‘’ ’’“ ’ ” “” —-~≈=_.…

Sample character set Check for monospacing and Greek glyphs

ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz 1234567890#%* ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ αβγδεζηθικλμνξοπρστυφχψω

שלום, السّلام عليكم

ሠላም

TODO Selection candidates and search methods

TODO Completion framework and extras

One of the optimal way of using Emacs is through searching and narrowing selection candidates. Spend less time worrying about where things are on the screen and more on how fast you can bring them into focus. This is, of course, a matter of realigning priorities, as we still wish to control every aspect of the interface.

Since the day I started using Emacs, I used multiple completion framework, from the built-in ido-mode, to ivy (and counsel) passing through helm at some point. I never experimented with any sort of customisations to the generic minibuffer experience. Nor did I ever bother with the oldest built-in tool of the sort (icomplete) that is designed to complement the minibuffer’s internal mechanisms for matching items, until I’ve watched Protesilaos video on it.

It turns out that, despite appearances to the contrary, the defaults are very powerful, opening up a range of possibilities to those eager to learn and experiment (a common theme in Emacs).

In the following package declarations I am defining several functions that enhance the experience of icomplete. These are part of a learning process to (i) explore the internals of Emacs and study how various problems are solved with elisp, and (ii) determine how far one can go, in terms of efficient functionality, without deviating from the norms inherent to the tools that are shipped with Emacs.

TODO Minibuffer essentials and Icomplete (built-in completion)

The minibuffer is the locus of extended command interaction. Whether it is about offering input to a prompt, performing a search, executing a function by its name, the minibuffer remains at the epicentre. The default experience is far more powerful than it seems to be. It can get even better by tweaking the available customisation options and defining our own extensions.

TODO Directory, buffer and window management

Applications and utilities

This section includes configurations for programs like email clients, messages, knowledge database and other applications that runs in Emacs. Most of those should be the “killer apps” of the Emacs ecosystem.

Org-mode (personal information manager)

I am an heavy user of org-mode. This is most likely the one mode that made me switch back to GNU/Emacs years back.

Org mode is for keeping notes, maintaining TODO lists, planning projects, and authoring documents with a fast and effective plain-text system.

I’m going to quote Protesilaos Stavrou too as he describe it way better than I would do.

Org offers you the basic tools to organise your life in super-efficient ways using nothing but plain text.

In its purest form, Org is a markup language that is similar to Markdown: symbols are used to denote the meaning of a construct in its context, such as what may represent a headline element or a phrase that calls for emphasis.

What lends Org its super powers though is everything else built around it: a rich corpus of elisp functions that automate, link, combine, enhance, structure, or otherwise enrich the process of using this otherwise simple markup language. This very document is written in org-mode while its website version is produced by a function that exports Org notation into its HTML equivalent.

I am using org-mode for managing my tasks and partly my daily agenda, for journaling, knowledge database (taking notes on stuff) and publishing documents (right now mainly on sbr.pm). I have been using org-mode for a while now, I feel some of my configuration may be heavily tailored to my needs.

The base user keybinding for org-mode (and related modes) is C-c o (e.g. showing agenda is C-c o a, capture is C-c o c, …).

Base settings   ATTACH

First, let’s define some basic constants, mainly on how my main org folder is organized.

(defconst org-directory "~/desktop/org/" "org-mode directory, where most of the org-mode file lives")
(defconst org-default-projects-dir (concat org-directory "projects") "Primary tasks directory.")
(defconst org-default-technical-dir (concat org-directory "technical") "Directory of shareable, technical notes.")
(defconst org-default-personal-dir (concat org-directory "personal") "Directory of un-shareable, personal notes.")
(defconst org-default-completed-dir (concat org-directory "archive/projects") "Directory of completed project files.")
(defconst org-default-inbox-file (concat org-directory "projects/inbox.org") "New stuff collected in this file.")
(defconst org-default-next-file (concat org-directory "projects/next.org") "Todo *next* collected in this file.")
(defconst org-default-incubate-file (concat org-directory "projects/incubate.org") "Ideas simmering on back burner.")
(defconst org-default-notes-file (concat org-directory "personal/notes.org") "Non-actionable, personal notes.")
(defconst org-default-journal-file (concat org-directory "personal/journal.org") "Journaling stuff.")
(defconst org-default-meeting-notes-file (concat org-directory "projects/meetings.org") "Meeting notes stuff.")

In a nutshell, I am currently trying the following organization, with ~/desktop/org/ as the base of almost all org-mode things:

  • projects is the main TODO folder. It holds todos and current projects along with ideas.
    • inbox.org is my inbox, where most of my captured todo, ideas and link will be store, waiting for reviews.
    • incubate.org is where I store my ideas that could become projects at some point. It is also waiting for reviews (once a week more or less).
    • next.org is where simple todos are stored, quick one shot things that do not need a project to be created.
    • {project}.org are files that holds a project information and todos. It can be long-lived projects (like redhat.org or tekton.org) or, prefered, short-lived projects, like rework-infra.org or tekton-beta.org. Once a project is marked as done or completed, it either goes into the archive, or into technical ; if it can be published.
  • technical is the public / to-be-published documents and public knowledge base. It can holds todos, but its main purpose is to be publish, at sbr.pm. Thus, it’s organization is the same as the website.
  • personal is my private knowledge base. Those are private information or notes that I don’t want to publish and might be encrypted (using gnupg).
  • archive holds all archived files (projects, todos from projects files, …)

Additionnaly, I may have org-mode files and todos in other files, like in my ~/.emacs.d folder or my home configuration.

I want a way to quickly jump to certain org-mode files, like next.org or the inbox.org. For this, we can use the emacs registers and more accurately the file registers.

(set-register ?i `(file . ,org-default-inbox-file))
(set-register ?I `(file . ,org-default-incubate-file))
(set-register ?N `(file . ,org-default-next-file))
(set-register ?n `(file . ,org-default-notes-file))
(set-register ?j `(file . ,org-default-journal-file))

With this, I can jump to the inbox with C-x r j i, to the journal using C-x r j j, …

Let’s setup the base of org-mode, with the following things in mind:

Agenda
org-agenda-files contains ~/desktop/org/, ~/.emacs.d/ and ~/.config/nixpkgs/. The rest of the configuration will happen when configuring org-agenda.
Navigation and key bindings
  • As said before, C-c o is the prefix of my user specific keybindings
    • C-c o l is to store the link (default keybinding is C-c C-l)
    • C-c o r r is to refile a task from an org-mode buffer (default keybinding is C-c C-w, and there is a different keybinding when in an org-mode agenda buffer)
  • Activating speed commands, aka being able to use one keystroke to do some action (like changing the TODO state, …)
  • C-a, C-e and C-k should be org-mode aware. This is achieved by setting org-special-ctrl-a/e and org-special-ctrl-k to t.
To-do settings

My current setup of todo-keywords (a.k.a. org-todo-keywords) might be more complicated that it should be but I’ve been using it a while now. org-todo-keywords is a list of sequences, I have three:

  • TODONEXTSTARTEDDONE or CANCELED
  • WAITINGSOMEDAY → move to a TODO or CANCELED
  • IDEA → move to a TODO or CANCELED

I am leaning towards simplifying this, especially as NEXT is not really useful (I have next.org for this), and IDEA or WAITING are not really used either (IDEA goes into incubate.org and I don’t seem to use WAITING).

I need to update and document org-todo-state-tags-triggers too

Tags

I am using generic tags and some groups. Groups allow to define mutually exclusive tags, like #home and #work (can’t be both). This is achieve by using :startgroup and :endgroup in the org-tag-alist variable. It is also possible to define tag hierarchies but I didn’t look into it yet.

I also want to have tag inheritance, aka children entry inherits their parent’s tag — even though it may have a cost (search, …), it allows to reduce lots of duplications.

Refile

In the org-mode jargon, this means moving an entry from one heading (parent entry) to another. This move can be done across files. org-mode displays a list of choice, this list is controlled by the org-refile-targets variable.

The org-refile-targets is pretty powerful if you read the doc. You specify a list of file and some search options for org to build its list from. Those options can be the level of the entry, some tag, regular expression, … In my case, I want this list to be all the org file in the project folder and also the inbox.org file. For the inbox, I want to look only at level 0 (aka root), for the other, I want to look at level 1 (aka root and sub entries).

I also changed the default way to show the refile targets (level1/level2/level3) to include the file name. When refiling, you can either do the completion hierarchically (select the file, then the first level, …) or you can display all the choice at once. I tend to prefer having all the choice at once and let my completion framework (ivy as of now) to do the fuzzy selection.

Finally, I want to be able to create new node if I want, while refiling, so I’m setting org-refile-allow-creating-parent-nodes to confirm, to ask me if I am sure 👼.

User Interface
  • I want, by default, to display the effort and clock summary on org columns, so I am setting the org-columns-default-format to do that.

    2020-02-29-13-46-08.png
  • I want to fontify the whole header line (it tends to look better for some theme)
  • I want things pretty, hence the org-pretty-entities 😹
  • When a entry (or a drawer) is closed, I like having a visual cue that it is. I chose the character to show that. It can be set with org-ellipsis.
Logging

org-mode allows to write the time (or a note) on a entry state change, this is achieved by the org-log-* variables. On marking entries as DONE or when rescheduling them (or changing the deadline), I want to mark the time.

Additionally, when I log those state changes, I don’t want them to pollute the content of the to-do (aka description, …). Setting org-log-int-drawer will insert those logs in a LOGBOOK drawer (same as the property drawer).

Archiving
I don’t want to pollute my current folder with _archive files, so I am redefining org-archive-location to archive to my org-default-completed-dir, also using datetree to put archived items in a datetree.
Miscellaneous
  • I am setting up org-use-property-inheritance to make children node inherit their parent property. It has a cost on search but I feel, as for tag inheritance, it is worth the cost.
  • Still on properties, org-global-properties allows you to add values to properties that will show in the completion when setting those. For example, setting EFFORT_ALL to a list, will give you those options when you are trying to set the effort property.
  • I am setting org-enforce-todo-dependencies to make sure a parent entry cannot be mark as done if children are not in complete state (DONE, CANCELLED, …).
  • I want to add a new blank line whenever I create a new entry but I don’t want that extra new blank line when adding a new list item. org-blank-before-new-entry allow to customize that behaviour.
  • I don’t want to load inline image at startup ; it slows down for nothing.

The ensure org-plus-contrib is there to make sure I am loading the org module from my nix configuration and not the built-in org module (that might lag in terms of version)

(use-package s)
(use-package org
  :ensure org-plus-contrib ;; load from the package instead of internal
  :mode (("\\.org$" . org-mode)
         ("\\.org.draft$" . org-mode))
  :commands (org-agenda org-capture)
  :bind (("C-c o l" . org-store-link)
         ("C-c o r r" . org-refile)
         ("C-c o a" . org-agenda)
         ("<f12>" . org-agenda)
         ("C-c o c" . org-capture))
  :config
  (setq org-agenda-files `(,org-default-projects-dir
                           "~/src/home"
                           "~/src/home/docs"
                           "~/src/www/articles"
                           "~/src/www/posts")
        org-agenda-file-regexp "^[a-zA-Z0-9-_]+.org$"
        org-use-speed-commands t
        org-special-ctrl-a/e t
        org-special-ctrl-k t
        org-todo-keywords '((sequence "TODO(t)" "NEXT(n)" "STARTED(s)" "|" "DONE(d!)" "CANCELED(c@/!)")
                            (sequence "WAITING(w@/!)" "SOMEDAY(s)" "|" "CANCELED(c@/!)")
                            (sequence "IDEA(i)" "|" "CANCELED(c@/!)"))
        org-todo-state-tags-triggers '(("CANCELLED" ("CANCELLED" . t))
                                       ("WAITING" ("WAITING" . t))
                                       (done ("WAITING"))
                                       ("TODO" ("WAITING") ("CANCELLED"))
                                       ("NEXT" ("WAITING") ("CANCELLED"))
                                       ("DONE" ("WAITING") ("CANCELLED")))
        org-use-tag-inheritance t
        org-tag-alist '(("linux") ("nixos") ("emacs") ("org")
                        ("openshift") ("redhat") ("tektoncd") ("kubernetes") ("knative" ) ("docker")
                        ("docs") ("code") ("review")
                        (:startgroup . nil)
                        ("#home" . ?h) ("#work" . ?w) ("#errand" . ?e) ("#health" . ?l)
                        (:endgroup . nil)
                        (:startgroup . nil)
                        ("#link" . ?i) ("#read" . ?r) ("#project" . ?p)
                        (:endgroup . nil))
        org-log-done 'time
        org-log-redeadline 'time
        org-log-reschedule 'time
        org-log-into-drawer t
        org-enforce-todo-dependencies t
        org-refile-targets (append '((org-default-inbox-file :level . 0))
                                   (->>
                                    (directory-files org-default-projects-dir nil ".org")
                                    (--remove (s-starts-with? "." it))
                                    (--map (format "%s/%s" org-default-projects-dir it))
                                    (--map `(,it :level . 1))))
        org-refile-use-outline-path 'file
        org-refile-allow-creating-parent-nodes 'confirm
        org-outline-path-complete-in-steps nil
        org-columns-default-format "%80ITEM(Task) %TODO %3PRIORITY %10Effort(Effort){:} %10CLOCKSUM"
        org-fontify-whole-heading-line t
        org-pretty-entities t
        org-ellipsis " ⤵"
        org-archive-location (concat org-default-completed-dir "/%s::datetree/")
        org-use-property-inheritance t
        org-default-priority 67
        org-priority-faces '((?A . "#ff2600")
                             (?B . "#ff5900")
                             (?C . "#ff9200")
                             (?D . "#747474"))
        org-global-properties (quote (("EFFORT_ALL" . "0:15 0:30 0:45 1:00 2:00 3:00 4:00 5:00 6:00 0:00")
                                      ("STYLE_ALL" . "habit")))
        org-blank-before-new-entry '((heading . t)
                                     (plain-list-item . nil))
        org-insert-heading-respect-content t
        org-yank-adjusted-subtrees t
        org-image-actual-width nil
        org-startup-with-inline-images nil
        org-list-demote-modify-bullet '(("+" . "-") ("-" . "+"))
        org-catch-invisible-edits 'error)
  (setcar (nthcdr 4 org-emphasis-regexp-components) 10)
  :hook (org-mode . vde/org-mode-hook))

I’ve set-up an org-mode hook to add few modes to the default setup.

  • I am really annoyed by trailing white-space so I want them to be shown
  • If the major mod is not org-agenda-mode (a sub-mode of org-mode)
    • I set the fill-column to 90 (instead of the usual 80), and I enable auto-fill mode.
    • I turn on auto-revert-mode so that the buffer is always up-to-date.
    • I like to have header indented, so I’m enabling org-indent-mode.
(defun vde/org-mode-hook ()
  "Org-mode hook"
  (setq show-trailing-whitespace t)
  (when (not (eq major-mode 'org-agenda-mode))
    (setq fill-column 90)
    (auto-revert-mode)
    (auto-fill-mode)
    (org-indent-mode)
    (set (make-local-variable 'company-backends)
         '(company-emoji company-capf company-files company-dabbrev))
    (company-mode 1)
    (add-hook 'before-save-hook #'save-and-update-includes nil 'make-it-local)))

Let’s also use =org-id=…

(use-package org-id
  :after (org)
  :config
  (setq org-id-link-to-org-use-id 'create-if-interactive-and-no-custom-id)
  (defun eos/org-custom-id-get (&optional pom create prefix)
    "Get the CUSTOM_ID property of the entry at point-or-marker POM.
   If POM is nil, refer to the entry at point. If the entry does
   not have an CUSTOM_ID, the function returns nil. However, when
   CREATE is non nil, create a CUSTOM_ID if none is present
   already. PREFIX will be passed through to `org-id-new'. In any
   case, the CUSTOM_ID of the entry is returned."
    (interactive)
    (org-with-point-at pom
      (let ((id (org-entry-get nil "CUSTOM_ID")))
        (cond
         ((and id (stringp id) (string-match "\\S-" id))
          id)
         (create
          (setq id (org-id-new (concat prefix "h")))
          (org-entry-put pom "CUSTOM_ID" id)
          (org-id-add-location id (buffer-file-name (buffer-base-buffer)))
          id)))))

  (defun eos/org-add-ids-to-headlines-in-file ()
    "Add CUSTOM_ID properties to all headlines in the
   current file which do not already have one."
    (interactive)
    (org-map-entries (lambda ()
                       (eos/org-custom-id-get (point) 'create)))))

… and org-crypt (for encrypted org-mode files).

(use-package org-crypt
  :after (org)
  :config
  (org-crypt-use-before-save-magic)
  (setq org-tags-exclude-from-inheritance '("crypt")))

TODO Agenda

The org-mode agenda is the source of my day-to-day organization. This is how I know what I have to do that, what I can do. This is also where I log my work (see Clocking below).

Due to the way Org works, TODO items, time-stamped items, and tagged headlines can be scattered throughout a file or even a number of files. To get an overview of open action items, or of events that are important for a particular date, this information must be collected, sorted and displayed in an organized way.

Invoking org-agenda presents a list of possible options. There as a list of built-in agenda views, where a shows all the items that have date assigned to them (SCHEDULED or DEADLINE), t for listing to-dos, T for listing to-dos with a specific state and m for more advanced matching possibilities.

I am using org-super-agenda to supercharge the org-mode agenda 👼 to define my own agenda views. This allows to group things and overall set-up the agenda view I want. This agenda view uses the n key.

(use-package org-agenda
  :after org
  :commands (org-agenda)
  :bind (("C-c o a" . org-agenda)
         ("<f12>" . org-agenda)
         ("C-c o r a" . org-agenda-refile))
  :config
  (use-package org-super-agenda
    :config (org-super-agenda-mode))
  (setq org-agenda-span 'day
        org-agenda-start-on-weekday 1
        org-agenda-include-diary t
        org-agenda-window-setup 'current-window
        org-agenda-skip-scheduled-if-done nil
        org-agenda-compact-blocks t
        org-agenda-sticky t
        org-super-agenda-header-separator ""
        org-agenda-custom-commands
        `(("w" "Work agenda"
           ((agenda "")
            (tags-todo "#work-#home-goals+TODO=\"STARTED\""
                       ((org-agenda-overriding-header "Ongoing")))
            (tags-todo "#work-#home-goals+TODO=\"NEXT\""
                       ((org-agenda-overriding-header "Next")))
            (tags-todo "#work-#home-goals"
                       ((org-agenda-skip-function '(org-agenda-skip-if nil '(scheduled deadline)))
                        (org-agenda-overriding-header "Work"))))
           ((org-super-agenda-groups
             '((:name "Important" :priority "A")
               (:name "Done" :log closed)
               (:name "Scheduled" :time-grid t)
               (:name "Red Hat" :tag "redhat")
               (:name "Tekton" :tag "tektoncd")
               (:habit t))))
           (org-agenda-list))
          ("n" "Personal agenda"
           ((tags-todo "-#work-goals-incubate-inbox+TODO=\"STARTED\""
                       ((org-agenda-overriding-header "Ongoing")))
            (tags-todo "-#work-goals-incubate-inbox+TODO=\"NEXT\""
                       ((org-agenda-overriding-header "Next")))
            (tags-todo "-#work-goals-incubate-inbox"
                       ((org-agenda-skip-function '(org-agenda-skip-if nil '(scheduled deadline)))
                        (org-agenda-overriding-header "Home"))))
           ((org-super-agenda-groups
             '((:name "Important" :priority "A")
               (:name "Home" :tag "#home")
               (:name "Writing" :tag "#writing")
               (:habit t))))
           (org-agenda-list)))))

Let’s try to get my work calendar entries in my agenda too. It is a little bit tricky 👼.

(use-package org-gcal
  :after (org)
  :commands (org-gcal-fetch)
  :config
  (require 'netrc)
  (setq-default org-gcal-remove-cancelled-events t)
  (defun get-authinfo (host port)
    (let* ((netrc (netrc-parse (expand-file-name "~/.authinfo.gpg")))
           (hostentry (netrc-machine netrc host port port)))
      (when hostentry (netrc-get hostentry "password"))))

  (setq org-gcal-client-id "959564825992-kvc7ofe9640cpc8ibgjqqgpi15e89nkn.apps.googleusercontent.com"
        org-gcal-client-secret (get-authinfo "gcal.api" "9999")
        org-gcal-file-alist '(("vdemeest@redhat.com" . "~/desktop/org/projects/schedule.org"))))

Habits   ATTACH

Org has the ability to track the consistency of a special category of TODO, called habits.

What’s really useful about habits is that they are displayed along with a consistency graph, to show how consistent you’ve been at getting that task done in the past. This graph shows every day that the task was done over the past three weeks, with colors for each day. The colors used are:

Blue If the task was not to be done yet on that day. Green If the task could have been done on that day. Yellow If the task was going to be overdue the next day. Red If the task was overdue on that day.

This look as followed in the agenda.

2020-02-29-14-41-59.png
(use-package org-habit
  :after (org)
  :config
  (setq org-habit-show-habits-only-for-today nil
        org-habit-graph-column 80))

TODO Sources

(use-package org-src
  :after (org)
  :config
  (setq org-src-fontify-natively t
        org-src-tab-acts-natively t
        org-src-window-setup 'current-window
        org-edit-src-content-indentation 0))

TODO Capture

The org-capture tool is a powerful way to quickly produce some kind of structured information with little interruption of your workflow. With org-agenda, this is one of the most used feature of org-mode (at least for me).

Each template is accessed via a key. These are listed in a buffer when you call org-capture. Unique keys give direct access to their template, whereas templates that share a common initial key will produce a second selection list with the remaining options. This is very interesting when you want to group some capture template together (like templates related to work, …).

(use-package org-capture
  :after org
  :commands (org-capture)
  :config

Some of my capture template are big and hard to read if embedded in the emacs-lisp code. The good thing is that org-mode is able to load the template from files too 💃.

Here is a list of my templates:

Default

Store a link (mainly used with org-protocol) and take a random note

(add-to-list 'org-capture-templates
             `("l" "Link" entry
               (file ,org-default-inbox-file)
               "* %a\n%U\n%?\n%i"
               :empty-lines 1))
(add-to-list 'org-capture-templates
             '("n" "Thought or Note"  entry
               (file org-default-notes-file)
               "* %?\n\n  %i\n\n  See: %a" :empty-lines 1))
Tasks

work task, like reviewing a PR, or cleaning a folder.

(add-to-list 'org-capture-templates
             `("t" "Tasks"))
(add-to-list 'org-capture-templates
             `("tt" "New task" entry
               (file ,org-default-inbox-file)
               "* %?\n:PROPERTIES:\n:CREATED:%U\n:END:\n\n%i\n\nFrom: %a"
               :empty-lines 1))
(add-to-list 'org-capture-templates
             `("tr" "PR Review" entry
               (file ,org-default-inbox-file)
               "* TODO review gh:%^{issue} :review:\n:PROPERTIES:\n:CREATED:%U\n:END:\n\n%i\n%?\nFrom: %a"
               :empty-lines 1))
journaling

As I use org-mode for my journal too, I need capture entry for it. I currently have two types of journal entry :

(add-to-list 'org-capture-templates
             `("j" "Journal"))
  • standard: one title and some text

    * %^{title}
    %U
    
    %?
    %i
    
    From: %a
    
    (add-to-list 'org-capture-templates
                 `("j" "Journal entry"))
    (add-to-list 'org-capture-templates
                 `("jj" "Journal entry" entry
                   (file+datetree ,org-default-journal-file)
                   (file ,(concat user-emacs-directory "/etc/orgmode/journal.org"))
                   :empty-lines 1 :clock-in t :clock-resume t))
    
  • worklog: related to work, to be able to say what I did, what I wanted to do, problems, … during the daily

    * worklog                                                         :log:@work:
    %U
    
    %?
    
    (add-to-list 'org-capture-templates
                 `("jw" "Worklog (journal) entry" entry
                   (file+datetree ,org-default-journal-file)
                   (file ,(concat user-emacs-directory "/etc/orgmode/worklog.org"))
                   :unnarrowed t))
    
weekly review

each and every week, I am going through this item to make my review of the week.

* weekly review                                               :weekly:review:
%U

- [ ] review ~inbox.org~
  Clean the file by either
  - refiling it to ~incubate.org~
  - removing it / archiving it
- [ ] review ~incubate.org~
  - Is something worth becoming a project
  - Is something not worth thinking about anymore ?
- [ ] empty mail inbox (and create task if needed)
  - [ ] work
  - [ ] perso
- [ ] Review next week ~F12 n w f~
- [ ] review ~org-mode~ workflow
  - *what works, what doesn't ?*
  - *is there task / stuck projects ?*
  - *enhancement possible ?*
- [ ] export previous agenda (somewhere)
(add-to-list 'org-capture-templates
             `("je" "Weekly review" entry
               (file+datetree,org-default-journal-file)
               (file ,(concat user-emacs-directory "/etc/orgmode/weekly.org"))
               :clock-in t :clock-resume t :unnarrowed t))
blog posts
(add-to-list 'org-capture-templates
             `("w" "Writing"))
:bind (("C-c o c" . org-capture)))
(use-package org-protocol
  :after org)

Clocking

I am heavily using the clocking along with org-agenda. My usual workflow, related to clocking is :

  • I bring the Agenda up
  • I clock the task I am working on, using I in the agenda
  • When I stop working on the task
    • if the task is completed, I use t d to mark it as done, the clock should automatically stop.
    • if the task is not completed, I use O to stop the clock

In addition to that workflow, I want to switch the state of the task to STARTED when I am clocking-in, if it’s not already STARTED.

(use-package org-clock
  :after org
  :commands (org-clock-in org-clock-out org-clock-goto)
  :config
  ;; Setup hooks for clock persistance
  (org-clock-persistence-insinuate)
  (setq org-clock-clocked-in-display nil
        ;; Show lot of clocking history so it's easy to pick items off the C-F11 list
        org-clock-history-length 23
        ;; Change tasks to STARTED when clocking in
        org-clock-in-switch-to-state 'vde/clock-in-to-started
        ;; Clock out when moving task to a done state
        org-clock-out-when-done t
        ;; Save the running clock and all clock history when exiting Emacs, load it on startup
        org-clock-persist t)
  (use-package find-lisp)
  (defun vde/is-project-p ()
    "Any task with a todo keyword subtask"
    (save-restriction
      (widen)
      (let ((has-subtask)
            (subtree-end (save-excursion (org-end-of-subtree t)))
            (is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
        (save-excursion
          (forward-line 1)
          (while (and (not has-subtask)
                      (< (point) subtree-end)
                      (re-search-forward "^\*+ " subtree-end t))
            (when (member (org-get-todo-state) org-todo-keywords-1)
              (setq has-subtask t))))
        (and is-a-task has-subtask))))

  (defun vde/is-project-subtree-p ()
    "Any task with a todo keyword that is in a project subtree.
Callers of this function already widen the buffer view."
    (let ((task (save-excursion (org-back-to-heading 'invisible-ok)
                                (point))))
      (save-excursion
        (vde/find-project-task)
        (if (equal (point) task)
            nil
          t))))

  (defun vde/find-project-task ()
    "Move point to the parent (project) task if any"
    (save-restriction
      (widen)
      (let ((parent-task (save-excursion (org-back-to-heading 'invisible-ok) (point))))
        (while (org-up-heading-safe)
          (when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
            (setq parent-task (point))))
        (goto-char parent-task)
        parent-task)))

  (defun vde/is-task-p ()
    "Any task with a todo keyword and no subtask"
    (save-restriction
      (widen)
      (let ((has-subtask)
            (subtree-end (save-excursion (org-end-of-subtree t)))
            (is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
        (save-excursion
          (forward-line 1)
          (while (and (not has-subtask)
                      (< (point) subtree-end)
                      (re-search-forward "^\*+ " subtree-end t))
            (when (member (org-get-todo-state) org-todo-keywords-1)
              (setq has-subtask t))))
        (and is-a-task (not has-subtask)))))

  (defun vde/is-subproject-p ()
    "Any task which is a subtask of another project"
    (let ((is-subproject)
          (is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
      (save-excursion
        (while (and (not is-subproject) (org-up-heading-safe))
          (when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
            (setq is-subproject t))))
      (and is-a-task is-subproject)))

  (defun vde/clock-in-to-started (kw)
    "Switch a task from TODO to STARTED when clocking in.
Skips capture tasks, projects, and subprojects.
Switch projects and subprojects from STARTED back to TODO"
    (when (not (and (boundp 'org-capture-mode) org-capture-mode))
      (cond
       ((and (member (org-get-todo-state) (list "TODO"))
             (vde/is-task-p))
        "STARTED")
       ((and (member (org-get-todo-state) (list "STARTED"))
             (vde/is-project-p))
        "TODO"))))
  :bind (("<f11>" . org-clock-goto)))

TODO Links

(use-package org-attach
  :after org
  :config
  (setq org-link-abbrev-alist '(("att" . org-attach-expand-link))))
;; my personal
(use-package ol-github
  :after (org))
(use-package ol-gitlab
  :after (org))
(use-package ol-ripgrep
  :after (org))
(use-package ol-rg
  :disabled
  :after (org))
(use-package ol-grep
  :after (org))

;; built-in org-mode
(use-package ol-eshell
  :after (org))
(use-package ol-git-link
  :defer 2
  :after (org))
(use-package ol-gnus
  :defer 2
  :after (org))
(use-package ol-irc
  :defer 2
  :after (org))
(use-package ol-info
  :defer 2
  :after (org))
(use-package ol-man
  :defer 2
  :after (org))
(use-package ol-notmuch
  :defer 2
  :after (org))

TODO Litterate programming

(use-package ob-async
  :after org
  :commands (ob-async-org-babel-execute-src-block))
(use-package ob-css
  :after org
  :commands (org-babel-execute:css))
(use-package ob-dot
  :after org
  :commands (org-babel-execute:dot))
(use-package ob-ditaa
  :after org
  :commands (org-babel-execute:ditaa)
  :config
  (setq org-ditaa-jar-path "/home/vincent/.nix-profile/lib/ditaa.jar"))
(use-package ob-emacs-lisp
  :after org
  :commands (org-babel-execute:emacs-lisp org-babel-execute:elisp))
(use-package ob-go
  :after org
  :commands (org-babel-execute:go))
(use-package ob-gnuplot
  :after org
  :commands (org-babel-execute:gnuplot))
(use-package ob-http
  :after org
  :commands (org-babel-execute:http))
(use-package ob-js
  :after org
  :commands (org-babel-execute:js))
(use-package ob-latex
  :after org
  :commands (org-babel-execute:latex))
(use-package ob-python
  :after org
  :commands (org-babel-execute:python))
(use-package ob-shell
  :after org
  :commands (org-babel-execute:ash
             org-babel-execute:bash
             org-babel-execute:csh
             org-babel-execute:dash
             org-babel-execute:fish
             org-babel-execute:ksh
             org-babel-execute:mksh
             org-babel-execute:posh
             org-babel-execute:sh
             org-babel-execute:shell
             org-babel-execute:zsh))

TODO Exporting

(defconst site-directory "~/desktop/sites/" "Website folder that holds exported orgmode files and more.")
(defconst org-default-publish-technical (concat site-directory "sbr.pm/technical") "Publish directory for the technical orgmode files.")
(use-package ox-publish
  :after org
  :commands (org-publish org-publish-all org-publish-project org-publish-current-project org-publish-current-file)
  :config
  (setq org-html-coding-system 'utf-8-unix))

TODO Email and newsgroup

I have been back and forth on using email inside Emacs, from mu4e to notmuch. In the past I have used Thunderbird, and for a while now, I have been only using webmail UI for emails (and mobile apps of course). I recently re-discover Gnus as a mail reader, so my current setup is the following:

  • Gnus, the Emacs built-in newsreader and email client.
  • notmuch to be able to browse my mail backups (using isync, …), see here for the current setup.

One of the main reason to rely on Gnus instead of notmuch for the mails, is that I don’t need to worry about some complex mechanism for syncing, storing and indexing email. I still use notmuch with isync to backup my mails somewhere, with the possibility to search them.

Base email settings

Before configuring any email client, we need to establish some essentials: who we are, where our credentials are stored and whether encryption is supported.

(use-package auth-source
  :config
  (setq auth-sources '("~/.authinfo.gpg" "~/.authinfo"))
  (setq user-full-name "Vincent Demeester")
  (setq user-mail-address "vincent@sbr.pm"))

Gnus

The documentation describes Gnus as the “coffee-brewing, all singing, all dancing, kitchen sink newsreader”. It is massive, which means the learning curve is more or less similar to org-mode. You need to go slowly, starting simple and enhance your workflow and configuration along the way.

Now some basic information on the abstractions that Gnus relies on:

  1. The default Gnus buffer is called “Group”. It will present you with a list of all the news sources you have subscribed to. By default, Gnus only displays messages that have not been read. The same applies for groups. The “Group” buffer will be empty the very first time you log in because you have not subscribed to anything yet. Use g to fetch new messages from the sources. If you only want to refresh the group at point, do it with M-g.
  2. The “Server” buffer contains a list with all the sources you have specified for discovering news. In my case, these are my email accounts and a Usenet server where mailing lists are hosted. To access the “Server” buffer from inside the “Group” buffer, just hit the caret sign ^. To subscribe to an item, place the point over it and hit u. Do that for your email’s inbox and for whatever mailing lists you intend to follow.
  3. The “Summary” buffer contains all the messages of a group. Hitting the return key over a message will split the view in two, with the list above and the message below. Use n or p to move to the next or previous unread message (or N and P to just the next/prev). You access the “Summary” buffer both from the “Group” and the “Server” by entering a group.

As noted, Gnus will only show you a list of unread items. To view all your groups, hit L. Use the lower case version l to view only the unread ones. To produce a Summary buffer with read items, hit C-u RET over a group and specify the number of messages you want to list (the other option is C-u M-g from inside the Summary). Another useful trick for the Summary buffer is the use of the caret sign (^) to show you the previous message that the current item is a reply to.

Note: this is in a gnus/init.el file that is loaded when the gnus command is ran. This means it is only loaded whenever I need to use gnus and not before

  • Account settings

    Let’s first configure the essentials of Gnus.

    The gnus-select-method sets the default method for fetching news items. As I want to read mail from several accounts in addition to following Usenet sources, I choose to set it to nil.

    The gnus-secondary-select-methods is where my accounts are specified. Each nnimap list points to a specific line in my authinfo.gpg file. My emails all use the same server so this method allows me to specify the username (email) and password combination for each of them without making this information public. I am not sure whether the nnimap-stream and nnimap-authinfo-file are needed, but I keep them for the sake of completeness.

    (use-package gnus
      :config
      (setq nnml-directory "~/desktop/gnus/mail")
      (setq nnfolder-directory "~/desktop/gnus/archive")
      (setq nndraft-directory "~/desktop/gnus/drafts")
      (setq nnmh-directory "~/desktop/gnus/drafts")
      (setq gnus-article-save-directory "~/desktop/gnus/news")
      (setq gnus-home-directory "~/desktop/gnus")
      (setq gnus-kill-files-directory "~/desktop/gnus/news")
      (setq gnus-cache-directory "~/desktop/gnus/news/cache")
      (setq gnus-startup-file "~/desktop/gnus/newsrc")
      (setq mail-source-directory "~/desktop/gnus/mail")
      (setq gnus-registry-cache-file "~/desktop/gnus/gnus.registry.eld")
      (setq gnus-select-method '(nnnil))
      (setq nntp-authinfo-file "~/.authinfo.gpg")
      (setq gnus-use-bbdb t)
      (setq gnus-secondary-select-methods
            '((nntp "news.gwene.org")
              (nnimap "prv"
                      (nnimap-address "mail.gandi.net")
                      (nnimap-stream ssl)
                      (nnimap-authinfo-file "~/.authinfo.gpg"))
              (nnimap "redhat"
                      (nnimap-address "imap.gmail.com")
                      (nnimap-stream ssl)
                      (nnimap-authinfo-file "~/.authinfo.gpg"))
              (nnimap "vde"
                      (nnimap-address "imap.gmail.com")
                      (nnimap-stream ssl)
                      (nnimap-authinfo-file "~/.authinfo.gpg"))
              ))
      (setq gnus-parameters
            '(("prv"
               (posting-style
                (address "vincent@demeester.fr")
                (signature-file "~/desktop/documents/.prv.signature")
                (gcc "nnimap+prv:Sent")))
              ("redhat"
               (posting-style
                (address "vdemeest@redhat.com")
                (signature-file "~/desktop/documents/.redhat.signature")))
              ("nnimap+redhat:INBOX"
               (display . all))
              ("vde"
               (posting-style
                (address "vinc.demeester.fr")
                (signature-file "~/desktop/documents/.vde.signature")))
              ("nnimap+vde:INBOX"
               (display . all))))
      (setq gnus-agent t)
      (setq mail-user-agent 'gnus-user-agent) ; also works with `sendmail-user-agent'
      (setq gnus-check-new-newsgroups 'ask-server)
      (setq gnus-read-active-file 'some)
      (setq gnus-use-dribble-file t)
      (setq gnus-always-read-dribble-file t)
      (setq gnus-novice-user nil)
      (setq gnus-extra-headers
            '(To Newsgroups X-GM-LABELS)))
    

    Let’s also give to gnus my GnuPG key.

    (use-package mml-sec
      :config
      (setq mml-secure-openpgp-signers
            '("8C4E8DDA04C18C6B503BD2DBB7E7CF1C634256FA")))
    
  • Gnus agent

    Gnus has something call the “agent”, which represent the bridge between Gnus and the server it connects to. Gnus is said to be “plugged” when a connection is established, otherwise it is “unplugged”.

    Technicalities aside, we basically use this to save a local copy of the items we have already fetched from the server. We can also use the agent to configure the handling of local messages. For example, we can set an expiry date, after which the message is deleted, or we can create a queue of outgoing messages when Gnus is in an unplugged state.

    (use-package gnus-agent
      :after gnus
      :config
      (setq gnus-agent-article-alist-save-format 1)  ; uncompressed
      (setq gnus-agent-cache t)
      (setq gnus-agent-confirmation-function 'y-or-n-p)
      (setq gnus-agent-consider-all-articles nil)
      (setq gnus-agent-directory "~/desktop/gnus/agent/")
      (setq gnus-agent-enable-expiration 'ENABLE)
      (setq gnus-agent-expire-all nil)
      (setq gnus-agent-expire-days 30)
      (setq gnus-agent-mark-unread-after-downloaded t)
      (setq gnus-agent-queue-mail t)        ; queue if unplugged
      (setq gnus-agent-synchronize-flags nil))
    
  • Gnus asynchronous operations

    By default, Gnus performs all its actions in a synchronous fashion. This means that Emacs is blocked until Gnus has finished. By enabling this library, we can use certain functions in a non-blocking way. I do this for sending email.

    (use-package gnus-async
      :after gnus
      :config
      (setq gnus-asynchronous t)
      (setq gnus-use-article-prefetch 30))
    
  • Gnus group

    Let’s dig a bit more into groups :

    • A group can be assigned a level of importance. This is a grade whose highest score is 1 and the lowest is 6 (customisable though). Each level has a different colour. To assign a new value to the group at point, do it with S l and then give it a number. Once you have graded your groups, you can perform various actions on a per-level basis. For example, to refresh all levels from 1 up to 3 but not higher, pass a numeric argument to the standard g command. So C-3 g (this is the same as C-u 3 g).
    • Groups can be organised by topic. Create a new one with T n and give it a name. Move a group to a topic with T m. To toggle the view of topics use t (I have a hook that does this automatically at startup). The level of indentation tells us whether a topic is a sub-set of another. Use TAB or C-u TAB to adjust it accordingly. As with levels, you can operate on a per-topic basis. For example, to catch up on all the news of a given topic (mark all as read), you place the point over it, hit c and then confirm your choice.

    Note that gnus-group-sort-functions requires the most important function to be declared last.

    (use-package gnus-group
      :after gnus
      :config
      (setq gnus-level-subscribed 6)
      (setq gnus-level-unsubscribed 7)
      (setq gnus-level-zombie 8)
      (setq gnus-group-sort-function
            '((gnus-group-sort-by-unread)
              (gnus-group-sort-by-alphabet)
              (gnus-group-sort-by-rank)))
      (setq gnus-group-mode-line-format "Gnus: %%b")
      :hook
      (gnus-select-group-hook . gnus-group-set-timestamp)
      :bind (:map gnus-agent-group-mode-map
                  ("M-n" . gnus-topic-goto-next-topic)
                  ("M-p" . gnus-topic-goto-previous-topic)))
    
  • Gnus Summary

    Threads should not be hidden, while messages whose root has been removed should be grouped together in some meaningful way. Furthermore, when moving up or down in the list of messages using just n or p, I want to go to the next message, regardless of whether it has been read or not. I can otherwise rely on standard Emacs motions.

    The formatting of the threads using Unicode characters was taken from the relevant Emacs wiki entry plus some minor tweaks by me.

    The gnus-user-date-format-alist, this basically adapts the date to whether the message was within the day or the one before, else falls back to a default value. It is then called with %&user-date;.

    (use-package gnus-sum
      :after (gnus gnus-group)
      :demand
      :config
      (setq gnus-auto-select-first nil)
      (setq gnus-summary-ignore-duplicates t)
      (setq gnus-suppress-duplicates t)
      (setq gnus-summary-goto-unread nil)
      (setq gnus-summary-make-false-root 'adopt)
      (setq gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject)
      (setq gnus-thread-sort-functions
            '((not gnus-thread-sort-by-number)
              (not gnus-thread-sort-by-date)))
      (setq gnus-subthread-sort-functions
            'gnus-thread-sort-by-date)
      (setq gnus-thread-hide-subtree nil)
      (setq gnus-thread-ignore-subject t)
      (setq gnus-user-date-format-alist
            '(((gnus-seconds-today) . "Today at %R")
              ((+ 86400 (gnus-seconds-today)) . "Yesterday, %R")
              (t . "%Y-%m-%d %R")))
      (setq gnus-summary-line-format "%U%R%z %-16,16&user-date;  %4L:%-30,30f  %B%S\n")
      (setq gnus-summary-mode-line-format "Gnus: %p (%U)")
      (setq gnus-sum-thread-tree-false-root "")
      (setq gnus-sum-thread-tree-indent " ")
      (setq gnus-sum-thread-tree-leaf-with-other "├─➤ ")
      (setq gnus-sum-thread-tree-root "")
      (setq gnus-sum-thread-tree-single-leaf "└─➤ ")
      (setq gnus-sum-thread-tree-vertical "│")
      :hook
      (gnus-summary-exit-hook . gnus-topic-sort-groups-by-alphabet)
      (gnus-summary-exit-hook . gnus-group-sort-groups-by-rank)
      :bind (:map gnus-agent-summary-mode-map
                  ("<delete>" . gnus-summary-delete-article)
                  ("n" . gnus-summary-next-article)
                  ("p" . gnus-summary-prev-article)
                  ("N" . gnus-summary-next-unread-article)
                  ("P" . gnus-summary-prev-unread-article)
                  ("M-n" . gnus-summary-next-thread)
                  ("M-p" . gnus-summary-prev-thread)
                  ("C-M-n" . gnus-summary-next-group)
                  ("C-M-p" . gnus-summary-prev-group)
                  ("C-M-^" . gnus-summary-refer-thread)))
    

    Gnus summary displays a mark for each messages, those `O`, `!`, … Let’s first describe what are those marks (from the documentation) and which one make the more sense for me. Most of those marks can be set using the M prefix (or M M) from the Summary buffer.

    First there is two groups of marks : unread and read. Note they do not entirely map to what IMAP defines or what you would see in another mail UI (webmail, …).

    • unread: those will appear by default on a Summary buffer (almost 😜)
      • <SPC> are the standard unread, never read. Once a mail is read you can mark it back as unread with M M u u.
      • ! is for ticked. This is similar to the starred thread/message on GMail (or Thunderbird, … — in notmuch it appears as flagged). Those will always appear in the summary, so this is mainly for really important message to be remembered all the time.
      • ? is for dormant. This is similar to ticked but the article will only appear if there is a follow-up of the message. This would be a good use of “waiting for an answer so keep it”.
    • read: those will not appear by default on a Summary buffer
      • r and R are just read (like in the reading session) more or less
      • O is read in an older session
      • Y is for too low of a score, this means this message got automatically read because it had low score (more on that later).
      • E is for marked as expirable, so that Gnus can delete/expunge them (or do something else — more on that later).
      • M is for duplicated.
      • K, X are for killed, C is for catchup Q is for sparsely reffed article and G is for cancelled — not sure what this means yet…
  • Gnus intersection with Dired

    We can use the built-in directory editor (file manager) as a more convenient way of performing certain tasks that relate to emails, such as attaching all the marked items of the dired buffer to an email we are currently composing or wish to initiate the composition of.

    Run C-h m inside of a Dired buffer that has gnus-dired-mode enabled and search for “gnus” to see all the relevant key bindings and the functions they call. I only ever use C-c C-m C-a (C-m is the same as RET).

    (use-package gnus-dired
      :after (gnus dired)
      :hook (dired-mode . gnus-dired-mode))
    
  • TODO Searching mails
  • TODO Subscribing to RSS

TODO Sending mails

(use-package smtpmail
  ;;:commands (mail-mode mail-text)
  :config
  (setq message-send-mail-function 'message-send-mail-with-sendmail)
  (setq sendmail-program "msmtp")
  (setq message-sendmail-f-is-evil 't)
  (setq message-sendmail-extra-arguments '("--read-envelope-from")))

(use-package sendmail
  ;;:commands (mail-mode mail-text)
  :defines (send-mail-function)
  :config
  (setq-default send-mail-function 'sendmail-send-it
                sendmail-program "/home/vincent/bin/msmtp"))
(use-package message
  :commands (message-mode message-cite-original-without-signature)
  :hook ((message-mode . my-message-hook))
  :config
  (setq mail-user-agent 'message-user-agent
        message-wide-reply-confirm-recipients t
        message-default-charset 'utf-8
        message-default-mail-headers "Cc: \nBcc: \n"
        message-kill-buffer-on-exit t
        message-generate-headers-first t)
  (add-to-list 'mm-body-charset-encoding-alist '(utf-8 . base64))

  (defun my-message-hook ()
    "Message mode hook."
    (turn-on-auto-fill)
    (set (make-local-variable 'company-backends)
         '(company-emoji company-capf company-files company-dabbrev))
    (company-mode 1)))

TODO notmuch configuration

(if *sys/full*
    (progn
      (setenv "NOTMUCH_CONFIG" (expand-file-name ".config/notmuch/notmuchrc" (getenv "HOME")))
      (use-package notmuch
        :disabled
        :defer t
        :bind ("<f6>" . notmuch)
        :config
        (setq notmuch-search-oldest-first nil
              mail-user-agent 'message-user-agent
              notmuch-tree-show-out t)
        (setq notmuch-saved-searches
              '((:key "i" :name "inbox" :query "tag:Inbox")
                (:key "r" :name "redhat inbox folder" :query "folder:redhat/Inbox")
                (:key "p" :name "perso inbox folder" :query "folder:perso/Inbox")
                (:key "u" :name "unread" :query "tag:unread")
                (:key "F" :name "flagged" :query "tag:flagged")
                (:key "S" :name "sent" :query "tag:Sent Mail"))))))

User interface and interactions

Mouse

The value of mouse-wheel-scroll-amount means the following:

  • By default scroll by one line.
  • Hold down Shift to do so by five lines.
  • Hold down Meta to scroll half a screen.
  • Hold down Control to adjust the size of the text. This is added in Emacs 27.

By enabling mouse-drag-copy-region we automatically place the mouse selection to the kill ring. This is the same behaviour as terminal emulators that place the selection to the clipboard (or the primary selection).

The other options in short:

  • Hide mouse pointer while typing.
  • Enable mouse scroll.
  • Faster wheel movement means faster scroll.
(use-package mouse
  :config
  (setq mouse-wheel-scroll-amount
        '(1
          ((shift) . 5)
          ((meta) . 0.5)
          ((control) . text-scale)))
  (setq make-pointer-invisible t
        mouse-wheel-progressive-speed t
        mouse-wheel-follow-mouse t)
  :hook (after-init . mouse-wheel-mode))

Theme

My own theme   ATTACH

I navigate between themes, but the more I use Emacs (or any editor really), the more I lean towards writing my own. Those theme are base on emacs-constant-theme which is “A calm, almost monochrome color theme for Emacs with a dark and light variant”.

My main goal is to make a theme that, at least for syntax highlighting, differs from the usual color(ful) themes. The reason come from a bunch of articles and repositories that discuss how, maybe the way we see and use syntax highlighting today is not optimum. This is a touchy subject to see the least but it does make sense to me: I want to highlight comments (because they may be important to understand the code), and I don’t want to highlight the language keyword more than the actual code.

I wrote two version, a dark one and a light one. I currently mainly use the light theme (as this is when I do work 😅).

  • Light theme
    2020-03-03-21-57-41.png
    ;;; shortbrain-light-theme.el --- A calm, light, almost monochrome color theme based on emacs-shortbrain-theme.
    
    ;; Copyright (C) 2020 Vincent Demeester <vincent@sbr.pm>
    
    ;; Author: Vincent Demeester <vincent@sbr.pm>
    ;; Keywords: themes
    ;; URL: https://github.com/vdemeester/emacs-config
    ;; Version: 2020.03
    ;; Package-Requires: ((emacs "24.1"))
    
    ;; This program is free software; you can redistribute it and/or modify
    ;; it under the terms of the GNU General Public License as published by
    ;; the Free Software Foundation, either version 3 of the License, or
    ;; (at your option) any later version.
    
    ;; This program is distributed in the hope that it will be useful,
    ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
    ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    ;; GNU General Public License for more details.
    
    ;; You should have received a copy of the GNU General Public License
    ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    
    ;;; Commentary:
    
    ;; To use the shortbrain-light theme, add the following to your Emacs
    ;; configuration file:
    ;;
    ;;   (load-theme 'shortbrain-light)
    ;;
    ;; Requirements: Emacs 24.
    
    ;;; Code:
    
    
    (deftheme shortbrain-light "A calm, light, almost monochrome color theme")
    
    
    (defconst shortbrain-light-theme-colors
      '(;; Basics
        (white . "#ffffff")
    
        ;; Greys
        (default-grey . "#0f1619")
        (grey . "#0f1619")
        (grey-50 . "#fdfdfe")
        (grey-100 . "#f5f8fa")
        (grey-200 . "#d8dcde")
        (grey-300 . "#bcc0c2")
        (grey-400 . "#9fa3a6")
        (grey-500 . "#9fa3a6")
        (grey-600 . "#656b6e")
        (grey-700 . "#494f52")
        (grey-720 . "#474d50")
        (grey-800 . "#2c3236")
        (grey-820 . "#1e2428")
        (grey-850 . "#1d2226")
        (grey-900 . "#0f1619")
    
        ;; Primaries
        (default-primary . "#0be5e5")
        (primary . "#0be5e5")
        (primary-50 . "#f3fefe")
        (primary-100 . "#d4fafa")
        (primary-200 . "#91f3f3")
        (primary-300 . "#4eecec")
        (primary-400 . "#0be5e5")
        (primary-500 . "#09cccc")
        (primary-600 . "#07b3b3")
        (primary-700 . "#059999")
        (primary-800 . "#028080")
        (primary-900 . "#006666")
    
        ;; Greens
        (default-green . "#0be541")
        (green . "#0be441")
        (green-50 . "#e7feec")
        (green-100 . "#b6fcc7")
        (green-200 . "#85f9a2")
        (green-300 . "#3cf66b")
        (green-400 . "#0be441")
        (green-500 . "#0adb3f")
        (green-600 . "#09c338")
        (green-700 . "#08aa31")
        (green-800 . "#07922a")
        (green-900 . "#067a23")
    
        ;; Reds
        (default-red. "#f24965")
        (red . "#f24965")
        (danger . "#f24965")
        (red-50 . "#fff0f2")
        (red-100 . "#ffd9df")
        (red-200 . "#fba9b6")
        (red-300 . "#f6798e")
        (red-400 . "#f24965")
        (red-500 . "#d6455d")
        (red-600 . "#ba4054")
        (red-700 . "#9e3c4c")
        (red-800 . "#823743")
        (red-900 . "#66333b")
    
        ;; Purples
        (purple . "#b965e8")))
    
    
    (defun shortbrain-light-theme-color (name)
      "Return the shortbrain-light theme color with the given NAME."
      (cdr (assoc name shortbrain-light-theme-colors)))
    
    
    (let ((class                    '((class color) (min-colors 256)))
          (default-fg               (shortbrain-light-theme-color 'grey-900))
          (default-bg               (shortbrain-light-theme-color 'grey-50))
          (inactive-bg               (shortbrain-light-theme-color 'grey-200))
          (minor-fg                 (shortbrain-light-theme-color 'grey-200))
          (minor-bg                 (shortbrain-light-theme-color 'grey-50))
          (inactive-fg              (shortbrain-light-theme-color 'grey-600))
          (border-fg                (shortbrain-light-theme-color 'grey-200))
          (frame-fg                 (shortbrain-light-theme-color 'grey-500))
          (cursor-fg                (shortbrain-light-theme-color 'grey-900))
          (cursor-bg                (shortbrain-light-theme-color 'grey-300))
    
          ;; Scrollbars
          (scrollbar-fg             (shortbrain-light-theme-color 'grey-600))
          (scrollbar-bg             (shortbrain-light-theme-color 'grey-100))
    
          ;; Highlighting
          (highlight-fg             (shortbrain-light-theme-color 'white))
          (highlight-bg             (shortbrain-light-theme-color 'red))
    
          ;; Current line
          (hl-line-bg               (shortbrain-light-theme-color 'grey-100))
    
          ;; Search
          (search-fg                (shortbrain-light-theme-color 'white))
          (search-bg                (shortbrain-light-theme-color 'primary-600))
          (search-bg-0              (shortbrain-light-theme-color 'primary-500))
          (search-bg-1              (shortbrain-light-theme-color 'primary-400))
          (search-bg-2              (shortbrain-light-theme-color 'primary-300))
          (search-bg-3              (shortbrain-light-theme-color 'primary-100))
    
          ;; Selection
          (selection-bg             (shortbrain-light-theme-color 'grey-200))
    
          ;; Auto-completion
          (completion-fg            (shortbrain-light-theme-color 'grey-500))
          (completion-bg            (shortbrain-light-theme-color 'grey-800))
          (completion-match-fg      (shortbrain-light-theme-color 'red-500))
          (completion-mouse-fg      (shortbrain-light-theme-color 'white))
          (completion-selection-fg  (shortbrain-light-theme-color 'red-500))
          (completion-selection-bg  (shortbrain-light-theme-color 'grey-200))
          (completion-annotation-fg (shortbrain-light-theme-color 'red-400))
    
          ;; Warnings & errors
          (warning-fg               (shortbrain-light-theme-color 'white))
          (warning-bg               (shortbrain-light-theme-color 'red-600))
          (error-fg                 (shortbrain-light-theme-color 'white))
          (error-bg                 (shortbrain-light-theme-color 'red))
    
          ;; Org
          (org-color-1              (shortbrain-light-theme-color 'green-900))
          (org-color-2              (shortbrain-light-theme-color 'purple))
          (org-color-3              (shortbrain-light-theme-color 'primary-700))
          (org-color-4              (shortbrain-light-theme-color 'primary-500))
          (org-color-5              (shortbrain-light-theme-color 'primary-400))
          (org-meta-fg              (shortbrain-light-theme-color 'primary-900))
    
          ;; Language syntax highlighting
          (variable-fg              (shortbrain-light-theme-color 'black))
          (function-fg              (shortbrain-light-theme-color 'grey-900))
          (type-fg                  (shortbrain-light-theme-color 'grey-700))
          (constant-fg              (shortbrain-light-theme-color 'grey-600))
          (keyword-fg               (shortbrain-light-theme-color 'grey-500))
          (builtin-fg               (shortbrain-light-theme-color 'grey-400))
          (string-fg                (shortbrain-light-theme-color 'grey-600))
          (doc-fg                   (shortbrain-light-theme-color 'primary-600))
          (doc-bg                   (shortbrain-light-theme-color 'grey-50)))
      (custom-theme-set-faces
       'shortbrain-light
       ;; Regular
       `(cursor ((,class (:foreground ,cursor-fg :background ,cursor-bg))))
       `(default ((,class (:foreground ,default-fg :background ,default-bg))))
       `(default-italic ((,class (:italic t))))
    
       ;; Emacs UI
       `(fringe ((,class (:foreground ,error-fg :background ,default-bg))))
       `(header-line ((,class :background ,default-bg)))
       `(linum ((,class (:inherit shadow :background ,default-bg))))
       `(mode-line ((,class (:foreground ,frame-fg :background ,default-bg
                                         :box (:line-width -1 :color ,default-bg)))))
       `(mode-line-inactive ((,class (:foreground ,inactive-fg :background ,inactive-bg
                                                  :box (:line-width -1 :color ,inactive-bg)))))
       `(nlinum-relative-current-face ((,class (:foreground ,frame-fg :background ,default-bg))))
       `(vertical-border ((,class (:foreground ,border-fg :background ,default-bg))))
       `(tab-bar ((,class (:background ,default-bg))))
       `(tab-bar-tab ((,class (:background ,default-bg :inherit shadow :weight bold))))
       `(tab-bar-tab-inactive ((,class (:background ,inactive-bg :inherit shadow :weight normal))))
    
       ;; Highlighting
       `(highlight ((,class (:foreground ,highlight-fg :background ,highlight-bg))))
       `(hl-line ((,class (:background ,hl-line-bg))))
    
       ;; Search
       `(isearch ((,class (:foreground ,search-fg :background ,search-bg :weight bold))))
       `(lazy-highlight ((,class (:foreground ,highlight-fg :background ,highlight-bg) :weight normal)))
    
       ;; Selection
       `(region ((,class (:background ,selection-bg))))
    
       ;; Erroneous whitespace
       `(whitespace-line ((,class (:foreground ,error-fg :background ,error-bg))))
       `(whitespace-space ((,class (:foreground ,builtin-fg :background ,hl-line-bg))))
       `(whitespace-tab ((,class (:foreground ,builtin-fg :background ,hl-line-bg))))
    
       ;; Language syntax highlighting
       `(font-lock-builtin-face ((,class (:foreground ,builtin-fg))))
       `(font-lock-comment-face ((,class (:foreground ,doc-fg :background ,doc-bg))))
       `(font-lock-comment-delimiter-face ((,class (:foreground ,minor-fg, :background ,minor-bg))))
       `(font-lock-constant-face ((,class (:foreground ,constant-fg))))
       `(font-lock-doc-face ((,class (:foreground ,doc-fg))))
       `(font-lock-function-name-face ((,class (:foreground ,function-fg))))
       `(font-lock-keyword-face ((,class (:foreground ,keyword-fg))))
       `(font-lock-negation-char-face ((,class (:foreground ,error-fg))))
       `(font-lock-preprocessor-face ((,class (:foreground ,builtin-fg))))
       `(font-lock-string-face ((,class (:foreground ,string-fg))))
       `(font-lock-type-face ((,class (:foreground ,type-fg))))
       `(font-lock-variable-name-face ((,class (:foreground ,variable-fg))))
       `(font-lock-warning-face ((,class (:foreground ,warning-fg :background ,warning-bg))))
    
       ;; Org
       `(org-level-1 ((,class (:foreground ,org-color-1 :bold t :height 1.2))))
       `(org-level-2 ((,class (:foreground ,org-color-2 :bold t :height 1.1))))
       `(org-level-3 ((,class (:foreground ,org-color-3 :bold t :height 1.0))))
       `(org-level-4 ((,class (:foreground ,org-color-4 :bold t :height 1.0))))
       `(org-level-5 ((,class (:foreground ,org-color-5 :bold t :height 1.0))))
       `(org-level-6 ((,class (:foreground ,org-color-5 :bold t :height 1.0))))
       `(org-document-title ((,class (:bold t :foreground ,org-meta-fg :height 1.4))))
       `(org-meta-line ((,class (:foreground ,org-meta-fg :bold t))))
    
       ;; Avy
       `(avy-lead-face   ((,class (:background ,search-bg-0 :foreground ,search-fg))))
       `(avy-lead-face-0 ((,class (:background ,search-bg-1 :foreground ,search-fg))))
       `(avy-lead-face-1 ((,class (:background ,search-bg-2 :foreground ,search-fg))))
       `(avy-lead-face-2 ((,class (:background ,search-bg-3 :foreground ,search-fg))))
    
       ;; Company (auto-completion)
       `(company-preview ((,class (:background ,default-bg :foreground ,completion-match-fg))))
       `(company-preview-common ((,class (:background ,completion-bg :foreground ,completion-fg))))
       `(company-preview-search ((,class (:background ,completion-bg :foreground ,completion-fg))))
       `(company-scrollbar-bg ((,class (:background ,scrollbar-bg))))
       `(company-scrollbar-fg ((,class (:background ,scrollbar-fg))))
       `(company-tooltip ((,class (:background ,completion-bg :foreground ,completion-fg))))
       `(company-tooltip-annotation ((,class (:foreground ,completion-annotation-fg))))
       `(company-tooltip-common ((,class (:background nil :foreground ,completion-match-fg))))
       `(company-tooltip-common-selection ((,class (:foreground ,completion-selection-fg
                                                                :background ,completion-selection-bg))))
       `(company-tooltip-mouse ((,class (:background ,selection-bg :foreground ,completion-mouse-fg))))
       `(company-tooltip-search ((,class (:foreground ,completion-match-fg))))
       `(company-tooltip-selection ((,class (:background ,selection-bg :foreground nil))))))
    
    
    ;;;###autoload
    (when (and (boundp 'custom-theme-load-path)
               load-file-name)
      ;; add theme folder to `custom-theme-load-path' when installing over MELPA
      (add-to-list 'custom-theme-load-path
                   (file-name-as-directory (file-name-directory load-file-name))))
    
    
    (provide-theme 'shortbrain-light)
    (provide 'shortbrain-light-theme)
    
    
    ;;; shortbrain-light-theme.el ends here
    
  • Dark theme
    2020-03-03-21-59-22.png
    ;;; shortbrain-theme.el --- A calm, dark, almost monochrome color theme based on emacs-constant-theme
    
    ;; Copyright (C) 2020 Vincent Demeester <vincent@sbr.pm>
    
    ;; Author: Vincent Demeester <vincent@sbr.pm>
    ;; Keywords: themes
    ;; URL: https://github.com/vdemeester/emacs-config
    ;; Version: 2020:03
    ;; Package-Requires: ((emacs "24.1"))
    
    ;; This program is free software; you can redistribute it and/or modify
    ;; it under the terms of the GNU General Public License as published by
    ;; the Free Software Foundation, either version 3 of the License, or
    ;; (at your option) any later version.
    
    ;; This program is distributed in the hope that it will be useful,
    ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
    ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    ;; GNU General Public License for more details.
    
    ;; You should have received a copy of the GNU General Public License
    ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    
    ;;; Commentary:
    
    ;; To use the shortbrain theme, add the following to your Emacs
    ;; configuration file:
    ;;
    ;;   (load-theme 'shortbrain)
    ;;
    ;; Requirements: Emacs 24.
    
    ;;; Code:
    
    
    (deftheme shortbrain "A calm, dark, almost monochrome theme")
    
    (defconst shortbrain-theme-colors
      '(;; Basics
        (white . "#ffffff")
    
        ;; Shades of grey
        (default-grey . "#0f1619")
        (grey . "#0f1619")
        (grey-50 . "#fdfdfe")
        (grey-100 . "#f5f8fa")
        (grey-200 . "#d8dcde")
        (grey-300 . "#bcc0c2")
        (grey-400 . "#9fa3a6")
        (grey-500 . "#9fa3a6")
        (grey-600 . "#656b6e")
        (grey-700 . "#494f52")
        (grey-720 . "#474d50")
        (grey-800 . "#2c3236")
        (grey-820 . "#1e2428")
        (grey-850 . "#1d2226")
        (grey-900 . "#0f1619")
    
        ;; Priary color shades
        (default-primary . "#0be5e5")
        (primary . "#0be5e5")
        (primary-50 . "#f3fefe")
        (primary-100 . "#d4fafa")
        (primary-200 . "#91f3f3")
        (primary-300 . "#4eecec")
        (primary-400 . "#0be5e5")
        (primary-500 . "#09cccc")
        (primary-600 . "#07b3b3")
        (primary-700 . "#059999")
        (primary-800 . "#028080")
        (primary-900 . "#006666")
    
        ;; Reds
        (default-red. "#f24965")
        (red . "#f24965")
        (danger . "#f24965")
        (red-50 . "#fff0f2")
        (red-100 . "#ffd9df")
        (red-200 . "#fba9b6")
        (red-300 . "#f6798e")
        (red-400 . "#f24965")
        (red-500 . "#d6455d")
        (red-600 . "#ba4054")
        (red-700 . "#9e3c4c")
        (red-800 . "#823743")
        (red-900 . "#66333b")
    
        ;; Purples
        (purple . "#b965e8")))
    
    
    (defun shortbrain-theme-color (name)
      "Return the shortbrain theme color with the given NAME."
      (cdr (assoc name shortbrain-theme-colors)))
    
    
    (let ((class                    '((class color) (min-colors 256)))
          (default-fg               (shortbrain-theme-color 'grey-100))
          (default-bg               (shortbrain-theme-color 'grey-900))
          (minor-fg                 (shortbrain-theme-color 'grey-700))
          (inactive-fg              (shortbrain-theme-color 'grey-600))
          (inactive-bg              (shortbrain-theme-color 'grey-800))
          (border-fg                (shortbrain-theme-color 'grey-850))
          (frame-fg                 (shortbrain-theme-color 'grey-500))
          (cursor-fg                (shortbrain-theme-color 'grey-500))
          (cursor-bg                (shortbrain-theme-color 'grey-500))
    
          ;; Scrollbars
          (scrollbar-fg             (shortbrain-theme-color 'grey-800))
          (scrollbar-bg             (shortbrain-theme-color 'grey-600))
    
          ;; Highlighting
          (highlight-fg             (shortbrain-theme-color 'white))
          (highlight-bg             (shortbrain-theme-color 'red))
    
          ;; Current line
          (hl-line-bg               (shortbrain-theme-color 'grey-810))
    
          ;; Search
          (search-fg                (shortbrain-theme-color 'white))
          (search-bg                (shortbrain-theme-color 'primary-700))
          (search-bg-0              (shortbrain-theme-color 'primary-700))
          (search-bg-1              (shortbrain-theme-color 'primary-500))
          (search-bg-2              (shortbrain-theme-color 'primary-300))
          (search-bg-3              (shortbrain-theme-color 'primary-100))
    
          ;; Selection
          (selection-bg             (shortbrain-theme-color 'grey-800))
    
          ;; Auto-completion
          (completion-fg            (shortbrain-theme-color 'primary))
          (completion-bg            (shortbrain-theme-color 'grey-820))
          (completion-match-fg      (shortbrain-theme-color 'red-500))
          (completion-mouse-fg      (shortbrain-theme-color 'white))
          (completion-selection-fg  (shortbrain-theme-color 'white))
          (completion-annotation-fg (shortbrain-theme-color 'purple))
    
          ;; Warnings & errors
          (warning-fg               (shortbrain-theme-color 'white))
          (warning-bg               (shortbrain-theme-color 'red-600))
          (error-fg                 (shortbrain-theme-color 'white))
          (error-bg                 (shortbrain-theme-color 'red))
    
          ;; Language syntax highlighting
          (variable-fg              (shortbrain-theme-color 'white))
          (function-fg              (shortbrain-theme-color 'grey-200))
          (type-fg                  (shortbrain-theme-color 'grey-300))
          (constant-fg              (shortbrain-theme-color 'grey-500))
          (keyword-fg               (shortbrain-theme-color 'grey-600))
          (builtin-fg               (shortbrain-theme-color 'grey-700))
          (string-fg                (shortbrain-theme-color 'grey-500))
          (doc-fg                   (shortbrain-theme-color 'primary-600)))
      (custom-theme-set-faces
       'shortbrain
    
       ;; Regular
       `(cursor ((,class (:foreground ,cursor-fg :background ,cursor-bg))))
       `(default ((,class (:foreground ,default-fg :background ,default-bg))))
       `(default-italic ((,class (:italic t))))
    
       ;; Emacs UI
       `(fringe ((,class (:foreground ,error-fg :background ,default-bg))))
       `(header-line ((,class :background ,default-bg)))
       `(linum ((,class (:inherit shadow :background ,default-bg))))
       `(mode-line ((,class (:foreground ,frame-fg :background ,default-bg
                                         :box (:line-width -1 :color ,default-bg)))))
       `(mode-line-inactive ((,class (:foreground ,inactive-fg :background ,inactive-bg
                                                  :box (:line-width -1 :color ,default-bg)))))
       `(nlinum-relative-current-face ((,class (:foreground ,frame-fg :background ,default-bg))))
       `(vertical-border ((,class (:foreground ,border-fg :background ,default-bg))))
       `(tab-bar ((,class (:background ,default-bg))))
       `(tab-bar-tab ((,class (:background ,default-bg :inherit shadow :weight bold))))
       `(tab-bar-tab-inactive ((,class (:background ,inactive-bg :inherit shadow :weight normal))))
    
       ;; Highlighting
       `(highlight ((,class (:foreground ,highlight-fg :background ,highlight-bg))))
       `(hl-line ((,class (:background ,hl-line-bg))))
    
       ;; Search
       `(isearch ((,class (:foreground ,search-fg :background ,search-bg :weight bold))))
       `(lazy-highlight ((,class (:foreground ,highlight-fg :background ,highlight-bg) :weight normal)))
    
       ;; Selection
       `(region ((,class (:background ,selection-bg))))
    
       ;; Erroneous whitespace
       `(whitespace-line ((,class (:foreground ,error-fg :background ,error-bg))))
       `(whitespace-space ((,class (:foreground ,builtin-fg :background ,hl-line-bg))))
       `(whitespace-tab ((,class (:foreground ,builtin-fg :background ,hl-line-bg))))
    
       ;; Language syntax highlighting
       `(font-lock-builtin-face ((,class (:foreground ,builtin-fg))))
       `(font-lock-comment-face ((,class (:foreground ,doc-fg))))
       `(font-lock-comment-delimiter-face ((,class (:foreground ,minor-fg))))
       `(font-lock-constant-face ((,class (:foreground ,constant-fg))))
       `(font-lock-doc-face ((,class (:foreground ,doc-fg))))
       `(font-lock-function-name-face ((,class (:foreground ,function-fg))))
       `(font-lock-keyword-face ((,class (:foreground ,keyword-fg))))
       `(font-lock-negation-char-face ((,class (:foreground ,error-fg))))
       `(font-lock-preprocessor-face ((,class (:foreground ,builtin-fg))))
       `(font-lock-string-face ((,class (:foreground ,string-fg))))
       `(font-lock-type-face ((,class (:foreground ,type-fg))))
       `(font-lock-variable-name-face ((,class (:foreground ,variable-fg))))
       `(font-lock-warning-face ((,class (:foreground ,warning-fg :background ,warning-bg))))
    
       ;; Avy
       `(avy-lead-face   ((,class (:background ,search-bg-0 :foreground ,search-fg))))
       `(avy-lead-face-0 ((,class (:background ,search-bg-1 :foreground ,search-fg))))
       `(avy-lead-face-1 ((,class (:background ,search-bg-2 :foreground ,search-fg))))
       `(avy-lead-face-2 ((,class (:background ,search-bg-3 :foreground ,search-fg))))
    
       ;; Company (auto-completion)
       `(company-preview ((,class (:background ,default-bg :foreground ,completion-match-fg))))
       `(company-preview-common ((,class (:background ,completion-bg :foreground ,completion-fg))))
       `(company-preview-search ((,class (:background ,completion-bg :foreground ,completion-fg))))
       `(company-scrollbar-bg ((,class (:background ,scrollbar-bg))))
       `(company-scrollbar-fg ((,class (:background ,scrollbar-fg))))
       `(company-tooltip ((,class (:background ,completion-bg :foreground ,completion-fg))))
       `(company-tooltip-annotation ((,class (:foreground ,completion-annotation-fg))))
       `(company-tooltip-common ((,class (:background nil :foreground ,completion-match-fg))))
       `(company-tooltip-common-selection ((,class (:foreground ,completion-selection-fg))))
       `(company-tooltip-mouse ((,class (:background ,selection-bg :foreground ,completion-mouse-fg))))
       `(company-tooltip-search ((,class (:foreground ,completion-match-fg))))
       `(company-tooltip-selection ((,class (:background ,selection-bg :foreground nil))))))
    
    
    ;;;###autoload
    (when (and (boundp 'custom-theme-load-path)
               load-file-name)
      ;; add theme folder to `custom-theme-load-path' when installing over MELPA
      (add-to-list 'custom-theme-load-path
                   (file-name-as-directory (file-name-directory load-file-name))))
    
    
    (provide-theme 'shortbrain)
    (provide 'shortbrain-theme)
    
    
    ;;; shortbrain-theme.el ends here
    

TODO Programming

Nix-ies

This is where the magic happens, when using nix or NixOS with home-manager. In a gist we will create a set of nix files that tangle, get dependencies and generate the correct emacs package with the packages used inside the configuration. This means, if I add a (use-package magit) in my configuration, and I tangle / re-execute this script(s), I now have a new packaged installed as part of my Emacs package. This is heavily inspired by Matthew Bauer’s bauer emacs configuration.

Required lisp libraries

We need a way to list packages used in the configuration using use-package. This is coming straight from Matthew Bauer’s bauer.

;;; use-package-list.el --- List use-package declarations in config file

;; Copyright (C) 2017 Matthew Bauer

;; Author: Matthew Bauer <mjbauer95@gmail.com>

;; This file is NOT part of GNU Emacs.

;;; Commentary:

;; ensure’ packages at compile time.

;;; Code:

(require 'json)
(require 'use-package)
(require 'package)
(eval-when-compile
  (require 'cl))

(defun use-package-list (script)
  "Count use-package declarations listed in SCRIPT."

  (defvar use-package-list--is-running t)
  (lexical-let ((use-package-verbose t)
                (use-package-debug t)
                (use-package-always-ensure nil)
                (use-package-always-defer t)
                (use-package-list--packages nil)
                (use-package-ensure-function 'ignore))
    (advice-add 'use-package
                :before (lambda (name &rest args)
                          (unless (or (and (member :disabled args)
                                           (plist-get args :disabled))
                                      (and (member :ensure args)
                                           (not (plist-get args :ensure)))
                                      (and (not (member :ensure args))
                                           (package-built-in-p name)))
                            (when (and (member :ensure args)
                                       (not (eq (plist-get args :ensure) t))
                                       (symbolp (plist-get args :ensure)))
                              (setq name (plist-get args :ensure)))
                            (add-to-list 'use-package-list--packages name))))

    (advice-add 'use-package-handler/:defer
                :around (lambda (x name keyword arg rest state)
                          (let ((body (use-package-process-keywords name rest
                                        (plist-put state :deferred t)))
                                (name-string (use-package-as-string name)))
                            (dolist (command
                                     (delete-dups (plist-get state :commands)))
                              (fset command (lambda (&rest args))))
                            body)))

    (advice-add 'use-package-load-name :override #'ignore)

    (load script nil nil t)

    (princ (json-encode use-package-list--packages))

    use-package-list--packages))

(provide 'use-package-list)
;;; use-package-list.el ends here

The idea is to run some like the following.

emacs --batch --quick \
      -L /nix/store/acm9rskhx237xb16zdy7vx6r1m5n8q58-emacs-packages-deps/share/emacs/site-lisp/elpa/use-package-20191126.2034/use-package-* \
      -l /home/vincent/.emacs.d/lisp/use-package-list.el \
      --eval "(use-package-list \"/home/vincent/.emacs.d/init.el\")"

External libraries

gotest-ui.el

From antifuchs/gotest-ui-mode.

;;; gotest-ui.el --- Major mode for running go test -json

;; Copyright 2018 Andreas Fuchs
;; Authors: Andreas Fuchs <asf@boinkor.net>

;; URL: https://github.com/antifuchs/gotest-ui-mode
;; Created: Feb 18, 2018
;; Keywords: languages go
;; Version: 0.1.0
;; Package-Requires: ((emacs "25") (s "1.12.0") (gotest "0.14.0"))

;; This file is not a part of GNU Emacs.

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3.0, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;;  Provides support for running go tests with a nice user interface
;;  that allows folding away output, highlighting failing tests.

;;; Code:

(eval-when-compile
  (require 'cl))

(require 'subr-x)
(require 'ewoc)
(require 'json)
(require 'compile)

(defgroup gotest-ui nil
  "The go test runner."
  :group 'tools)

(defface gotest-ui-pass-face '((t :foreground "green"))
  "Face for displaying the status of a passing test."
  :group 'gotest-ui)

(defface gotest-ui-skip-face '((t :foreground "grey"))
  "Face for displaying the status of a skipped test."
  :group 'gotest-ui)

(defface gotest-ui-fail-face '((t :foreground "pink" :weight bold))
  "Face for displaying the status of a failed test."
  :group 'gotest-ui)

(defface gotest-ui-link-face '((t :foreground "white" :weight bold))
  "Face for displaying links to go source files."
  :group 'gotest-ui)

(defcustom gotest-ui-expand-test-statuses '(fail)
  "Statuses to expand test cases for.
Whenever a test enters this state, it is automatically expanded."
  :group 'gotest-ui)

(defcustom gotest-ui-test-binary '("go")
  "Command list used to invoke the `go' binary."
  :group 'gotest-ui)

(defcustom gotest-ui-test-args '("test" "-json")
  "Argument list used to run tests with JSON output."
  :group 'gotest-ui)

(defcustom gotest-ui-additional-test-args '()
  "Additional args to pass to `go test'."
  :group 'gotest-ui)

;;;; Data model:

(defstruct (gotest-ui-section :named
                              (:constructor gotest-ui-section-create)
                              (:type vector)
                              (:predicate gotest-ui-section-p))
  title tests node)

;;; `gotest-ui-thing' is a thing that can be under test: a
;;; package, or a single test.

(defstruct gotest-ui-thing
  (name)
  (node)
  (expanded-p)
  (status)
  (buffer)    ; the buffer containing this test's output
  (elapsed)   ; a floating-point amount of seconds
  )

;;; `gotest-ui-test' is a single test. It contains a status and
;;; output.
(defstruct (gotest-ui-test (:include gotest-ui-thing)
                           (:constructor gotest-ui--make-test-1))
  (package)
  (reason))

(defun gotest-ui-test->= (test1 test2)
  "Returns true if TEST1's name sorts greater than TEST2's."
  (let ((pkg1 (gotest-ui-test-package test1))
        (pkg2 (gotest-ui-test-package test2))
        (name1 (or (gotest-ui-thing-name test1) ""))
        (name2 (or (gotest-ui-thing-name test2) "")))
    (if (string= pkg1 pkg2)
        (string> name1 name2)
      (string> pkg1 pkg2))))

(defstruct (gotest-ui-status (:constructor gotest-ui--make-status-1))
  (state)
  (cmdline)
  (dir)
  (output)
  (node))

(cl-defun gotest-ui--make-status (ewoc cmdline dir)
  (let ((status (gotest-ui--make-status-1 :state 'run :cmdline (s-join " " cmdline) :dir dir)))
    (let ((node (ewoc-enter-first ewoc status)))
      (setf (gotest-ui-status-node status) node))
    status))

(cl-defun gotest-ui--make-test (ewoc &rest args &key status package name &allow-other-keys)
  (apply #'gotest-ui--make-test-1 :status (or status "run") args))

;;; Data manipulation routines:

(cl-defun gotest-ui-ensure-test (ewoc package-name base-name &key (status 'run))
  (let* ((test-name (format "%s.%s" package-name base-name))
         (test (gethash test-name gotest-ui--tests)))
    (if test
        test
      (setf (gethash test-name gotest-ui--tests)
            (gotest-ui--make-test ewoc :name base-name :package package-name :status status)))))

(defun gotest-ui-update-status (new-state)
  (setf (gotest-ui-status-state gotest-ui--status) new-state)
  (ewoc-invalidate gotest-ui--ewoc (gotest-ui-status-node gotest-ui--status)))

(defun gotest-ui-update-status-output (new-output)
  (setf (gotest-ui-status-output gotest-ui--status) new-output)
  (ewoc-invalidate gotest-ui--ewoc (gotest-ui-status-node gotest-ui--status)))

(defun gotest-ui-ensure-output-buffer (thing)
  (unless (gotest-ui-thing-buffer thing)
    (with-current-buffer
        (setf (gotest-ui-thing-buffer thing)
              (generate-new-buffer (format " *%s" (gotest-ui-thing-name thing))))
      (setq-local gotest-ui-parse-marker (point-min-marker))
      (setq-local gotest-ui-insertion-marker (point-min-marker))
      (set-marker-insertion-type gotest-ui-insertion-marker t)))
  (gotest-ui-thing-buffer thing))

(defun gotest-ui-mouse-open-file (event)
  "In gotest-ui mode, open the file/line reference in another window."
  (interactive "e")
  (let ((window (posn-window (event-end event)))
        (pos (posn-point (event-end event)))
        file line)
    (if (not (windowp window))
        (error "No file chosen"))
    (with-current-buffer (window-buffer window)
      (goto-char pos)
      (gotest-ui-open-file-at-point))))

(defun gotest-ui-open-file-at-point ()
  (interactive)
  (let ((file (gotest-ui-get-file-for-visit))
        (line (gotest-ui-get-line-for-visit)))
    (unless (file-exists-p file)
      (error "Could not open %s:%d" file line))
    (with-current-buffer (find-file-other-window file)
      (goto-char (point-min))
      (when line
        (forward-line (1- line))))))

(defun gotest-ui-get-file-for-visit ()
  (get-text-property (point) 'gotest-ui-file))

(defun gotest-ui-get-line-for-visit ()
  (string-to-number (get-text-property (point) 'gotest-ui-line)))

(defun gotest-ui-file-from-gopath (package file-basename)
  (if (or (file-name-absolute-p file-basename)
          (string-match-p "/" file-basename))
      file-basename
    (let ((gopath (or (getenv "GOPATH")
                      (expand-file-name "~/go"))))
      (expand-file-name (concat gopath "/src/" package "/" file-basename)))))

(defvar gotest-ui-click-map
  (let ((map (make-sparse-keymap)))
    (define-key map [mouse-2] 'gotest-ui-mouse-open-file)
    map))

(defun gotest-ui-ensure-parsed (thing)
  (save-excursion
    (goto-char gotest-ui-parse-marker)
    (while (re-search-forward "\\([^ \t]+\\.go\\):\\([0-9]+\\)" gotest-ui-insertion-marker t)
      (let* ((file-basename (match-string 1))
             (file (gotest-ui-file-from-gopath (gotest-ui-test-package thing) file-basename)))
        (set-text-properties (match-beginning 0) (match-end 0)
                             `(face gotest-ui-link-face
                                    gotest-ui-file ,file
                                    gotest-ui-line ,(match-string 2)
                                    keymap ,gotest-ui-click-map
                                    follow-link t
                                    ))))
    (set-marker gotest-ui-parse-marker gotest-ui-insertion-marker)))

(defun gotest-ui-update-thing-output (thing output)
  (with-current-buffer (gotest-ui-ensure-output-buffer thing)
    (goto-char gotest-ui-insertion-marker)
    (let ((overwrites (split-string output "\r")))
      (insert (car overwrites))
      (dolist (segment (cdr overwrites))
        (let ((delete-to (point)))
          (forward-line 0)
          (delete-region (point) delete-to))
        (insert segment)))
    (set-marker gotest-ui-insertion-marker (point))
    (gotest-ui-ensure-parsed thing)))

;; TODO: clean up buffers on kill

;;;; Mode definition

(defvar gotest-ui-mode-map
  (let ((m (make-sparse-keymap)))
    (suppress-keymap m)
    ;; key bindings go here
    (define-key m (kbd "TAB") 'gotest-ui-toggle-expanded)
    (define-key m (kbd "g") 'gotest-ui-rerun)
    (define-key m (kbd "RET") 'gotest-ui-open-file-at-point)
    m))

(define-derived-mode gotest-ui-mode special-mode "go test UI"
  "Major mode for running go test with JSON output."
  (setq truncate-lines t)
  (setq buffer-read-only t)
  (setq-local line-move-visual t)
  (setq show-trailing-whitespace nil)
  (setq list-buffers-directory default-directory)
  (make-local-variable 'text-property-default-nonsticky)
  (push (cons 'keymap t) text-property-default-nonsticky))


(defun gotest-ui--clear-buffer (buffer)
  (let ((dir default-directory))
    (with-current-buffer buffer
      (when (buffer-live-p gotest-ui--process-buffer)
        (kill-buffer gotest-ui--process-buffer))
      (kill-all-local-variables)
      (let  ((buffer-read-only nil))
        (erase-buffer))
      (buffer-disable-undo)
      (setq-local default-directory dir))))

(defun gotest-ui--setup-buffer (buffer name cmdline dir)
  (setq-local default-directory dir)
  (setq gotest-ui--cmdline cmdline
        gotest-ui--dir dir)
  (let ((ewoc (ewoc-create 'gotest-ui--pp-test nil nil t))
        (tests (make-hash-table :test #'equal)))
    (setq gotest-ui--tests tests)
    (setq gotest-ui--ewoc ewoc)
    ;; Drop in the first few ewoc nodes:
    (setq gotest-ui--status (gotest-ui--make-status ewoc cmdline dir))
    (gotest-ui-add-section gotest-ui--ewoc 'fail "Failed Tests:")
    (gotest-ui-add-section gotest-ui--ewoc 'run "Currently Running:")
    (gotest-ui-add-section gotest-ui--ewoc 'skip "Skipped:")
    (gotest-ui-add-section gotest-ui--ewoc 'pass "Passed Tests:"))
  ;; Set up the other buffers:
  (setq gotest-ui--stderr-process-buffer (generate-new-buffer (format " *%s (stderr)" name)))
  (with-current-buffer gotest-ui--stderr-process-buffer
    (setq gotest-ui--ui-buffer buffer))
  (setq gotest-ui--process-buffer (generate-new-buffer (format " *%s" name)))
  (with-current-buffer gotest-ui--process-buffer
    (setq gotest-ui--ui-buffer buffer)))

(defun gotest-ui-add-section (ewoc state name)
  (let ((section (gotest-ui-section-create :title name :tests (list nil))))
    (setf (gotest-ui-section-node section)
          (ewoc-enter-last ewoc section))
    (push (cons state section) gotest-ui--section-alist)))

(defun gotest-ui-sort-test-into-section (test previous-state)
  (let (invalidate-nodes)
    (when-let ((previous-section* (and previous-state
                                       (assoc previous-state gotest-ui--section-alist))))
      (let ((previous-section (cdr previous-section*)))
        (setf (gotest-ui-section-tests previous-section)
              (delete test (gotest-ui-section-tests previous-section)))
        (when (null (cdr (gotest-ui-section-tests previous-section)))
          (push (gotest-ui-section-node previous-section) invalidate-nodes))))
    ;; Drop the node from the buffer:
    (when-let (node (gotest-ui-thing-node test))
      (let ((buffer-read-only nil))
        (ewoc-delete gotest-ui--ewoc node))
      (setf (gotest-ui-thing-node test) nil))

    ;; Put it in the next secion:
    (when-let ((section* (assoc (gotest-ui-thing-status test)
                                gotest-ui--section-alist)))
      (let* ((section (cdr section*))
             (insertion-cons (gotest-ui-section-tests section)))
        (while (and (cdr insertion-cons)
                    (gotest-ui-test->= test (cadr insertion-cons)))
          (setq insertion-cons (cdr insertion-cons)))
        (rplacd insertion-cons (cons test (cdr insertion-cons)))
        (let ((insertion-node (if (car insertion-cons)
                                  (gotest-ui-thing-node (car insertion-cons))
                                (gotest-ui-section-node section))))
         (setf (gotest-ui-thing-node test)
               (ewoc-enter-after gotest-ui--ewoc insertion-node test)))
        (when (null (cddr (gotest-ui-section-tests section)))
          (push (gotest-ui-section-node section) invalidate-nodes))))
    (unless (null invalidate-nodes)
      (apply 'ewoc-invalidate gotest-ui--ewoc invalidate-nodes))
    (gotest-ui-thing-node test)))

;;;; Commands:

(defun gotest-ui-toggle-expanded ()
  "Toggle expandedness of a test/package node"
  (interactive)
  (let* ((node (ewoc-locate gotest-ui--ewoc (point)))
         (data (ewoc-data node)))
    (when (and data (gotest-ui-thing-p data))
      (setf (gotest-ui-thing-expanded-p data)
            (not (gotest-ui-thing-expanded-p data)))
      (ewoc-invalidate gotest-ui--ewoc node))))

(defun gotest-ui-rerun ()
  (interactive)
  (gotest-ui gotest-ui--cmdline :dir gotest-ui--dir))

;;;; Displaying the data:

(defvar-local gotest-ui--tests nil)
(defvar-local gotest-ui--section-alist nil)
(defvar-local gotest-ui--ewoc nil)
(defvar-local gotest-ui--status nil)
(defvar-local gotest-ui--process-buffer nil)
(defvar-local gotest-ui--stderr-process-buffer nil)
(defvar-local gotest-ui--ui-buffer nil)
(defvar-local gotest-ui--process nil)
(defvar-local gotest-ui--stderr-process nil)
(defvar-local gotest-ui--cmdline nil)
(defvar-local gotest-ui--dir nil)

(cl-defun gotest-ui (cmdline &key dir)
  (let* ((dir (or dir default-directory))
         (name (format "*go test: %s in %s" (s-join " " cmdline) dir))
         (buffer (get-buffer-create name)))
    (unless (eql buffer (current-buffer))
      (display-buffer buffer))
    (with-current-buffer buffer
      (let ((default-directory dir))
        (gotest-ui--clear-buffer buffer)
        (gotest-ui-mode)
        (gotest-ui--setup-buffer buffer name cmdline dir))
      (setq gotest-ui--stderr-process
            (make-pipe-process :name (s-concat name "(stderr)")
                               :buffer gotest-ui--stderr-process-buffer
                               :sentinel #'gotest-ui--stderr-process-sentinel
                               :filter #'gotest-ui-read-stderr))
      (setq gotest-ui--process
            (make-process :name name
                          :buffer gotest-ui--process-buffer
                          :sentinel #'gotest-ui--process-sentinel
                          :filter #'gotest-ui-read-stdout
                          :stderr gotest-ui--stderr-process
                          :command cmdline)))))

(defun gotest-ui-pp-status (status)
  (propertize (format "%s" status)
              'face
              (case status
                (fail 'gotest-ui-fail-face)
                (skip 'gotest-ui-skip-face)
                (pass 'gotest-ui-pass-face)
                (otherwise 'default))))

(defun gotest-ui--pp-test-output (test)
  (with-current-buffer (gotest-ui-ensure-output-buffer test)
    (propertize (buffer-substring (point-min) (point-max))
                'line-prefix "\t")))

(defun gotest-ui--pp-test (test)
  (cond
   ((gotest-ui-section-p test)
    (unless (null (cdr (gotest-ui-section-tests test)))
      (insert "\n" (gotest-ui-section-title test) "\n")))
   ((gotest-ui-status-p test)
    (insert (gotest-ui-pp-status (gotest-ui-status-state test)))
    (insert (format " %s in %s\n\n"
                    (gotest-ui-status-cmdline test)
                    (gotest-ui-status-dir test)))
    (unless (zerop (length (gotest-ui-status-output test)))
      (insert (format "\n\n%s" (gotest-ui-status-output test)))))
   ((gotest-ui-test-p test)
    (let ((status (gotest-ui-thing-status test))
          (package (gotest-ui-test-package test))
          (name (gotest-ui-thing-name test)))
      (insert (gotest-ui-pp-status status))
      (insert " ")
      (insert (if name
                  (format "%s.%s" package name)
                package))
      (when-let ((elapsed (gotest-ui-thing-elapsed test)))
        (insert (format " (%.3fs)" elapsed)))
      (when-let ((reason (gotest-ui-test-reason test)))
        (insert (format " [%s]" reason))))
    (when (and (gotest-ui-thing-expanded-p test)
               (> (length (gotest-ui--pp-test-output test)) 0))
      (insert "\n")
      (insert (gotest-ui--pp-test-output test)))
    (insert "\n"))))

;;;; Handling input:

(defun gotest-ui--process-sentinel (proc event)
  (let* ((process-buffer (process-buffer proc))
         (ui-buffer (with-current-buffer process-buffer gotest-ui--ui-buffer))
         (inhibit-quit t))
    (with-local-quit
      (with-current-buffer ui-buffer
        (cond
         ((string= event "finished\n")
          (gotest-ui-update-status 'pass))
         ((s-prefix-p "exited abnormally" event)
          (gotest-ui-update-status 'fail))
         (t
          (gotest-ui-update-status event)))))))

(defun gotest-ui--stderr-process-sentinel (proc event)
  ;; ignore all events
  nil)

(defun gotest-ui-read-stderr (proc input)
  (let* ((process-buffer (process-buffer proc))
         (ui-buffer (with-current-buffer process-buffer gotest-ui--ui-buffer))
         (inhibit-quit t))
    (with-local-quit
      (when (buffer-live-p process-buffer)
        (with-current-buffer process-buffer
          (gotest-ui-read-compiler-spew proc process-buffer ui-buffer input))))))

(defun gotest-ui-read-stdout (proc input)
  (let* ((process-buffer (process-buffer proc))
         (ui-buffer (with-current-buffer process-buffer gotest-ui--ui-buffer))
         (inhibit-quit t))
    (with-local-quit
      (when (buffer-live-p process-buffer)
        (gotest-ui-read-json process-buffer (process-mark proc) input)))))

(defun gotest-ui-read-json (process-buffer marker input)
  (with-current-buffer process-buffer
    (gotest-ui-read-json-1 process-buffer marker gotest-ui--ui-buffer input)))

(defvar-local gotest-ui--current-failing-test nil)

(defun gotest-ui-read-failing-package (ui-buffer)
  (when (looking-at "^# \\(.*\\)$")
    (let* ((package (match-string 1))
           test)
      (with-current-buffer ui-buffer
        (setq test (gotest-ui-ensure-test gotest-ui--ewoc package nil :status 'fail))
        (gotest-ui-maybe-expand test)
        (gotest-ui-sort-test-into-section test nil))
      (forward-line 1)
      test)))

(defun gotest-ui-read-compiler-spew (proc process-buffer ui-buffer input)
  (with-current-buffer process-buffer
    (save-excursion
      (goto-char (point-max))
      (insert input)
      (goto-char (process-mark proc))
      (while (and (/= (point-max) (line-end-position)) ; incomplete line
                  (/= (point-max) (point)))
        (cond
         (gotest-ui--current-failing-test
          (cond
           ((looking-at "^# \\(.*\\)$")
            (gotest-ui-read-failing-package ui-buffer))
           (t
            (let* ((line (buffer-substring (point) (line-end-position)))
                   (test gotest-ui--current-failing-test))
              (forward-line 1)
              (set-marker (process-mark proc) (point))
              (with-current-buffer ui-buffer
                (gotest-ui-update-thing-output test (concat line "\n"))
                (ewoc-invalidate gotest-ui--ewoc (gotest-ui-thing-node test)))))))
         (t
          (let ((test (gotest-ui-read-failing-package ui-buffer)))
            (setq gotest-ui--current-failing-test test)
            (set-marker (process-mark proc) (point))
            (with-current-buffer ui-buffer
              (ewoc-invalidate gotest-ui--ewoc (gotest-ui-thing-node test))))))))))

(defun gotest-ui-read-json-1 (process-buffer marker ui-buffer input)
  (with-current-buffer process-buffer
    (save-excursion
      ;; insert the chunk of output at the end
      (goto-char (point-max))
      (insert input)

      ;; try to read the next object (which is hopefully complete now):
      (let ((nodes
             (cl-loop
              for (node . continue) = (gotest-ui-read-test-event process-buffer marker ui-buffer)
              when node collect node into nodes
              while continue
              finally (return nodes))))
        (when nodes
          (with-current-buffer ui-buffer
            (apply #'ewoc-invalidate gotest-ui--ewoc
                   (cl-remove-if-not (lambda (node) (marker-buffer (ewoc-location node))) (cl-remove-duplicates nodes)))))))))

(defun gotest-ui-read-test-event (process-buffer marker ui-buffer)
  (goto-char marker)
  (when (= (point) (line-end-position))
    (forward-line 1))
  (case (char-after (point))
    (?\{
     ;; It's JSON:
     (condition-case err
         (let ((obj (json-read)))
           (set-marker marker (point))
           (with-current-buffer ui-buffer
             (cons (gotest-ui-update-test-status obj) t)))
       (json-error (cons nil nil))
       (wrong-type-argument
        (if (and (eql (cadr err) 'characterp)
                 (eql (caddr err) :json-eof))
            ;; This is peaceful & we can ignore it:
            (cons nil nil)
          (signal 'wrong-type-argument err)))))
    (?\F
     ;; It's a compiler error:
     (when (looking-at "^FAIL\t\\(.*\\)\s+\\[\\([^]]+\\)\\]\n")
       (let* ((package-name (match-string 1))
              (reason (match-string 2))
              test node)
         (with-current-buffer ui-buffer
           (setq test (gotest-ui-ensure-test gotest-ui--ewoc package-name nil :status 'fail)
                 node (gotest-ui-thing-node test))
           (setf (gotest-ui-test-reason test) reason)
           (gotest-ui-sort-test-into-section test nil)
           (gotest-ui-maybe-expand test))
         (forward-line 1)
         (set-marker marker (point))
         (cons node t))))
    (otherwise
     ;; We're done:
     (cons nil nil))))

(defun gotest-ui-maybe-expand (test)
  (when (memq (gotest-ui-test-status test) gotest-ui-expand-test-statuses)
    (setf (gotest-ui-test-expanded-p test) t)))

(defun gotest-ui-update-test-status (json)
  (let-alist json
    (let* ((action (intern .Action))
           (test (gotest-ui-ensure-test gotest-ui--ewoc .Package .Test))
           (previous-status (gotest-ui-thing-status test)))
      (case action
        (run
         (gotest-ui-sort-test-into-section test nil))
        (output (gotest-ui-update-thing-output test .Output))
        (pass
         (setf (gotest-ui-thing-status test) 'pass
               (gotest-ui-thing-elapsed test) .Elapsed)
         (gotest-ui-sort-test-into-section test previous-status)
         (gotest-ui-maybe-expand test))
        (fail
         (setf (gotest-ui-thing-status test) 'fail
               (gotest-ui-thing-elapsed test) .Elapsed)
         (gotest-ui-sort-test-into-section test previous-status)
         (gotest-ui-maybe-expand test))
        (skip
         (setf (gotest-ui-thing-status test) 'skip
               (gotest-ui-thing-elapsed test) .Elapsed)
         (gotest-ui-sort-test-into-section test previous-status)
         (gotest-ui-maybe-expand test))
        (otherwise
         (setq test nil)))
      (when test (gotest-ui-thing-node test)))))

;;;; Commands for go-mode:

(defun gotest-ui--command-line (&rest cmdline)
  (append gotest-ui-test-binary gotest-ui-test-args gotest-ui-additional-test-args
          cmdline))

;;;###autoload
(defun gotest-ui-current-test ()
  "Launch go test with the test that (point) is in."
  (interactive)
  (cl-destructuring-bind (test-suite test-name) (go-test--get-current-test-info)
    (let ((test-flag (if (> (length test-suite) 0) "-m" "-run")))
      (when test-name
        (gotest-ui (gotest-ui--command-line test-flag (s-concat test-name "$") "."))))))

;;;###autoload
(defun gotest-ui-current-file ()
  "Launch go test on the current buffer file."
  (interactive)
  (let* ((data (go-test--get-current-file-testing-data))
         (run-flag (s-concat "-run=" data "$")))
    (gotest-ui (gotest-ui--command-line run-flag "."))))

;;;###autoload
(defun gotest-ui-current-project ()
  "Launch go test on the current buffer's project."
  (interactive)
  (let ((default-directory (projectile-project-root)))
    (gotest-ui (gotest-ui--command-line "./..."))))

(provide 'gotest-ui)

;;; gotest-ui.el ends here

Org mode links

I am defining additonal org-mode links for my day to day usage.

  • ol-github.el: link to GitHub repositories, issues and pull-requests.

    ;;; ol-github.el --- Links to GitHub -*- lexical-binding: t; -*-
    
    ;; Copyright (C) 2020 Vincent Demeester
    
    ;; Author: Vincent Demeester <vincent@sbr.pm>
    ;; Keywords: org link github
    ;; Version: 0.1
    ;; URL: https://gitlab.com/vdemeester/vorg
    ;; Package-Requires: ((emacs "26.0") (org "9.0"))
    ;;
    ;; This file is not part of GNU Emacs.
    
    ;; This program is free software; you can redistribute it and/or
    ;; modify it under the terms of the GNU General Public License as
    ;; published by the Free Software Foundation; either version 3.0, or
    ;; (at your option) any later version.
    
    ;; This program is distributed in the hope that it will be useful,
    ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
    ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    ;; GNU General Public License for more details.
    
    ;; You should have received a copy of the GNU General Public License
    ;; along with this program; if not, write to the Free Software
    ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;
    ;;; Commentary:
    
    ;; This file implements links to GitHub from within Org mode.
    ;; gh:tektoncd/pipeline   : project
    ;; gh:tektoncd/pipeline#1 : issue or pr #1
    
    ;;; Code:
    
    (require 'ol)
    
    ;; Install the link type
    (org-link-set-parameters "gh"
                             :follow #'org-github-follow-link
                             :export #'org-github-export
                             :face '(:foreground "DimGrey" :underline t))
    
    
    (defun org-github-export (link description format)
      "Export a github page link from Org files."
      (let ((path (org-github-get-url link))
            (desc (or description link)))
        (cond
         ((eq format 'html) (format "<a hrefl=\"_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))))
    
    (defun org-github-follow-link (issue)
      "Browse github issue/pr specified."
      (browse-url (org-github-get-url issue)))
    
    (defun org-github-get-url (path)
      "Translate org-mode link `gh:foo/bar#1' to github url."
      (setq expressions (split-string path "#"))
      (setq project (nth 0 expressions))
      (setq issue (nth 1 expressions))
      (if issue
          (format "https://github.com/%s/issues/%s" project issue)
        (format "https://github.com/%s" project)))
    
    (provide 'ol-github)
    ;;; ol-github.el ends here
    
  • ol-gitlab.el: link to GitLab repositories, issues and merge-requests.

    ;;; ol-gitlab.el --- Links to Gitlab -*- lexical-binding: t; -*-
    
    ;; Copyright (C) 2020 Vincent Demeester
    
    ;; Author: Vincent Demeester <vincent@sbr.pm>
    ;; Keywords: org link gitlab
    ;; Version: 0.1
    ;; URL: https://gitlab.com/vdemeester/vorg
    ;; Package-Requires: ((emacs "26.0") (org "9.0"))
    ;;
    ;; This file is not part of GNU Emacs.
    
    ;; This program is free software; you can redistribute it and/or
    ;; modify it under the terms of the GNU General Public License as
    ;; published by the Free Software Foundation; either version 3.0, or
    ;; (at your option) any later version.
    
    ;; This program is distributed in the hope that it will be useful,
    ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
    ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    ;; GNU General Public License for more details.
    
    ;; You should have received a copy of the GNU General Public License
    ;; along with this program; if not, write to the Free Software
    ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;
    ;;; Commentary:
    
    ;; This file implements links to Gitlab from within Org mode.
    ;; gl:vdemeester/emacs-config    : project
    ;; gl:vdemeester/emacs-config#1  : issue #1
    ;; gl:vdemeester/emacs-config##1 : merge-request #1
    
    ;;; Code:
    
    (require 'ol)
    
    ;; Install the link type
    (org-link-set-parameters "gl"
                             :follow #'org-gitlab-follow-link
                             :export #'org-gitlab-export
                             :face '(:foreground "DimGrey" :underline t))
    
    
    (defun org-gitlab-export (link description format)
      "Export a gitlab page link from Org files."
      (let ((path (org-gitlab-get-url link))
            (desc (or description link)))
        (cond
         ((eq format 'html) (format "<a hrefl=\"_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))))
    
    (defun org-gitlab-follow-link (issue)
      "Browse gitlab issue/pr specified."
      (browse-url (org-gitlab-get-url issue)))
    
    (defun org-gitlab-get-url (path)
      "Translate org-mode link `gh:foo/bar#1' to gitlab url."
      (setq expressions (split-string path "#"))
      (setq project (nth 0 expressions))
      (setq issue (nth 1 expressions))
      (setq mr (nth 2 expressions))
      (message (format "issue: %s" issue))
      (message (format "mr: %s" mr))
      (if (not (empty-string-p mr))
          (format "https://gitlab.com/%s/-/merge_requests/%s" project mr)
        (if (not (empty-string-p issue))
            (format "https://gitlab.com/%s/-/issues/%s" project issue)
          (format "https://gitlab.com/%s" project))))
    
    (defun empty-string-p (string)
      "Return true if the STRING is empty or nil. Expects string type."
      (or (null string)
          (zerop (length (string-trim string)))))
    
    (provide 'ol-gitlab)
    ;;; ol-gitlab.el ends here
    
  • ol-rg.el: link to a rg search buffer.

    ;;; ol-rg.el --- Links to rg -*- lexical-binding: t; -*-
    
    ;; Copyright (C) 2020 Vincent Demeester
    
    ;; Author: Vincent Demeester <vincent@sbr.pm>
    ;; Keywords: org link ripgrep rg.el
    ;; Version: 0.1
    ;; URL: https://gitlab.com/vdemeester/vorg
    ;; Package-Requires: ((emacs "26.0") (org "9.0") (rg "1.8.0"))
    ;;
    ;; This file is not part of GNU Emacs.
    
    ;; This program is free software; you can redistribute it and/or
    ;; modify it under the terms of the GNU General Public License as
    ;; published by the Free Software Foundation; either version 3.0, or
    ;; (at your option) any later version.
    
    ;; This program is distributed in the hope that it will be useful,
    ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
    ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    ;; GNU General Public License for more details.
    
    ;; You should have received a copy of the GNU General Public License
    ;; along with this program; if not, write to the Free Software
    ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;
    ;;; Commentary:
    
    ;; This file implements links to Ripgrep from within Org mode.
    ;; rg:orgmode             : run ripgrep on current working dir with orgmode expression
    ;; rg:orgmode:config/     : run ripgrep on config/ dir with orgmode expression
    ;; rg:orgmode:config/#org : run ripgrep on config/ dir with orgmode expression
    
    ;;; Code:
    
    (require 'ol)
    
    ;; Install the link type
    (org-link-set-parameters "rg"
                             :follow #'org-rg-follow-link
                             :face '(:foreground "DarkGreen" :underline t))
    
    (defun org-rg-follow-link (regexp)
      "Run `rg` with REXEP as argument,
    like this : [[rg:REGEXP:FOLDER#FILTER]]"
      (setq expressions (split-string regexp ":"))
      (setq exp (nth 0 expressions))
      (setq folderpart (nth 1 expressions))
      (setq files (split-string folderpart "#"))
      (setq folder (nth 0 files))
      (setq filter (nth 1 files))
      (if folderpart
          (if filter
              (rg exp (concat "*." filter) folder)
            (rg exp "*" folder))
        (rg exp "*" "./")))
    
    (provide 'ol-rg)
    ;;; ol-rg.el ends here
    
  • ol-ripgrep.el: link to a ripgrep search buffer.

    ;;; ol-ripgrep.el --- Links to Ripgrep -*- lexical-binding: t; -*-
    
    ;; Copyright (C) 2020 Vincent Demeester
    
    ;; Author: Vincent Demeester <vincent@sbr.pm>
    ;; Keywords: org link ripgrep
    ;; Version: 0.1
    ;; URL: https://gitlab.com/vdemeester/vorg
    ;; Package-Requires: ((emacs "26.0") (org "9.0") (ripgrep "0.4.0"))
    ;;
    ;; This file is not part of GNU Emacs.
    
    ;; This program is free software; you can redistribute it and/or
    ;; modify it under the terms of the GNU General Public License as
    ;; published by the Free Software Foundation; either version 3.0, or
    ;; (at your option) any later version.
    
    ;; This program is distributed in the hope that it will be useful,
    ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
    ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    ;; GNU General Public License for more details.
    
    ;; You should have received a copy of the GNU General Public License
    ;; along with this program; if not, write to the Free Software
    ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;
    ;;; Commentary:
    
    ;; This file implements links to Ripgrep from within Org mode.
    ;; ripgrep:orgmode         : run ripgrep on current working dir with orgmode expression
    ;; ripgrep:orgmode:config/ : run ripgrep on config/ dir with orgmode expression
    
    ;;; Code:
    
    (require 'ol)
    
    ;; Install the link type
    (org-link-set-parameters "ripgrep"
                             :follow #'org-ripgrep-follow-link
                             :face '(:foreground "DarkGreen" :underline t))
    
    (defun org-ripgrep-follow-link (regexp)
      "Run `ripgrep-regexp` with REXEP and FOLDER as argument,
    like this : [[ripgrep:REGEXP:FOLDER]]"
      (setq expressions (split-string regexp ":"))
      (setq exp (nth 0 expressions))
      (if (= (length expressions) 1)
          (progn
            (ripgrep-regexp exp (expand-file-name "./")))
        (progn
          (setq folder (nth 1 expressions))
          (ripgrep-regexp exp (file-name-as-directory (expand-file-name folder))))))
    
    (provide 'ol-ripgrep)
    ;;; ol-ripgrep.el ends here
    
  • ol-grep.el: link to a grep search buffer.

    ;;; ol-grep.el --- Links to Grep -*- lexical-binding: t; -*-
    
    ;; Copyright (C) 2020 Vincent Demeester
    
    ;; Author: Vincent Demeester <vincent@sbr.pm>
    ;; Keywords: org link grep
    ;; Version: 0.1
    ;; URL: https://gitlab.com/vdemeester/vorg
    ;; Package-Requires: ((emacs "26.0") (org "9.0"))
    ;;
    ;; This file is not part of GNU Emacs.
    
    ;; This program is free software; you can redistribute it and/or
    ;; modify it under the terms of the GNU General Public License as
    ;; published by the Free Software Foundation; either version 3.0, or
    ;; (at your option) any later version.
    
    ;; This program is distributed in the hope that it will be useful,
    ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
    ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    ;; GNU General Public License for more details.
    
    ;; You should have received a copy of the GNU General Public License
    ;; along with this program; if not, write to the Free Software
    ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;
    ;;; Commentary:
    
    ;; This file implements links to Grep from within Org mode.
    ;; grep:orgmode         : run grep on current working dir with orgmode expression
    ;; grep:orgmode:config/ : run grep on config/ dir with orgmode expression
    
    ;;; Code:
    
    (require 'ol)
    
    ;; Install the link type
    (org-link-set-parameters "rg"
                             :follow #'org-grep-follow-link
                             :face '(:foreground "DarkRed" :underline t))
    
    (defun org-grep-follow-link (issue)
      "Run `rgrep' with REGEXP and FOLDER as argument,
    like this : [[grep:REGEXP:FOLDER]]."
      (setq expressions (split-string regexp ":"))
      (setq exp (nth 0 expressions))
      (grep-compute-defaults)
      (if (= (length expressions) 1)
          (progn
            (rgrep exp "*" (expand-file-name "./")))
        (progn
          (setq folder (nth 1 expressions))
          (rgrep exp "*" (expand-file-name folder)))))
    
    (provide 'ol-grep)
    ;;; ol-grep.el ends here
    

And that’s all folks 💃