This document is a literate configuration for GNU Emacs written in org format. It cannot be used directly and needs to be transformed to extract all the different code blocks into a single configuration file. This is done using the org-babel-tangle function that “extract the bodies of all source code blocks from the current file into their own source-specific files”. You can try by yourself by typing the sequence: C-c C-v t (org-babel-execute-subtree).
However, on my Emacs (28.1), there seems to be a bug that prevent a proper tangling. You’ll thus need to go to the Configuration section and execute it using C-c C-v s to fix this bug before tangling the file.
Each subsection may be tagged with:
:BINDING:The section defines some key binding:HOOK:The section installs some hook:ADVICE:The section installs some advice:FACE:The section modifies some face:MODE:The section activates a mode:DEFER:The content of the section is deferred (lazy load):PERSONAL:The content is personal and should be adapted:INACTIVE:The content of the section won’t be exported:BUGFIX:The section contains (temporary) bug fix code:OTHER:The section will be exported to a different file than default:TIMER:The section install a timer:OS:The section contains some system specific code
There is also a configuration mode defined in the section below to ease the writing.
When tangled, the process will create the file ~/.emacs.org/init.el ~/.emacs.org/early-init.el (from the Early init section). You can either copy these files to your emacs.d or you can use chemacs2 and add .emacs.org as an alternative profile.
Note also that the first time you will start emacs using this configuration, it will take a long time because a lof of packages will be dowloaded, installed and possibly compiled (if you use Emacs 28 and above). At next restart, the process should be very fast (650 ms on my machine using OSX).
(setq-default
ad-redefinition-action 'accept ; Silence warnings for redefinition
custom-unlispify-menu-entries nil ; Prefer kebab-case for titles
custom-unlispify-tag-names nil ; Prefer kebab-case for symbols
(put 'downcase-region 'disabled nil) ; Enable downcase-region
(put 'upcase-region 'disabled nil) ; Enable upcase-region
native-comp-async-report-warnings-errors 'silent ; Skip compilation error buffers
read-process-output-max (* 1024 1024) ; Increase read size per process
- [X] Tangle file when saving (org-auto-tangle)
- [X] Hitting `space` on top node should open the node (instead of folding)
- [X] Dim inactive entries in the sidebar
- [X] Shift-tab to toggle sidebar (all entries)
- [X] Filter sidebar (`f` key)
This will generate a header at the top of the tangled file to indicate it is generated and is not meant to be modified directly.
;; -*- lexical-binding: t -*-
;; This file has been generated from dotemacs.org file. DO NOT EDIT.
;; Sources are available from https://github.com/rougier/dotemacs
;; Copyright (C) 2022 Nicolas P. Rougier
;; 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, 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.
;; For a full copy of the GNU General Public License
;; see <https://www.gnu.org/licenses/>.
(defvar my/init-start-time (current-time) "Time when init.el was started")
(defvar my/section-start-time (current-time) "Time when section was started")
(defun my/report-time (section)
(message "%-36s %.2fs"
(concat section " " "section time: ")
(float-time (time-subtract (current-time) my/section-start-time))))
(message "---------------------------------------------------------------")
This code is meant to go to the early-init.el file.
(setq
site-run-file nil ; No site-wide run-time initializations.
inhibit-default-init t ; No site-wide default library
gc-cons-threshold most-positive-fixnum ; Very large threshold for garbage
; collector during init
package-enable-at-startup nil) ; We'll use straight.el
(setq native-comp-eln-load-path
(list (expand-file-name "eln-cache" user-emacs-directory)))
;; Reset garbage collector limit after init process has ended (8Mo)
(add-hook 'after-init-hook
#'(lambda () (setq gc-cons-threshold (* 8 1024 1024))))
Using straight.el for package management and disable checking (for speedup).
(setq straight-check-for-modifications nil)
(defvar bootstrap-version)
(let ((bootstrap-file
(expand-file-name "straight/repos/straight.el/bootstrap.el" user-emacs-directory))
(bootstrap-version 5))
(unless (file-exists-p bootstrap-file)
(with-current-buffer
(url-retrieve-synchronously
"https://raw.githubusercontent.com/raxod502/straight.el/develop/install.el"
'silent 'inhibit-cookies)
(goto-char (point-max))
(eval-print-last-sexp)))
(load bootstrap-file nil 'nomessage))
Library and theme load paths with a special case for mu4e (you may need to adapt this path).
(add-to-list 'load-path
(expand-file-name "lisp" user-emacs-directory))
(add-to-list 'custom-theme-load-path
(expand-file-name "theme" user-emacs-directory))
(add-to-list 'load-path
"/usr/local/Cellar/mu/1.6.10/share/emacs/site-lisp/mu/mu4e/mu4e.el")
Packages used in this specific configuration. You may want to adapt this list. The first time this sequence will be executed, it will take a long time. Then, at next restart, it should be very fast (less than 1 second because it won’t install anything basically).
(setq package-list
'(cape ; Completion At Point Extensions
orderless ; Completion style for matching regexps in any order
vertico ; VERTical Interactive COmpletion
marginalia ; Enrich existing commands with completion annotations
consult ; Consulting completing-read
corfu ; Completion Overlay Region FUnction
deft ; Quickly browse, filter, and edit plain text notes
elpher ; A friendly gopher and gemini client
elfeed ; Emacs Atom/RSS feed reader
elfeed-org ; Configure elfeed with one or more org-mode files
f ; Modern API for working with files and directories
citar ; Citation-related commands for org, latex, markdown
citeproc ; A CSL 1.0.2 Citation Processor
flyspell-correct-popup ; Correcting words with flyspell via popup interface
flyspell-popup ; Correcting words with Flyspell in popup menus
guess-language ; Robust automatic language detection
helpful ; A better help buffer
htmlize ; Convert buffer text and decorations to HTML
mini-frame ; Show minibuffer in child frame on read-from-minibuffer
imenu-list ; Show imenu entries in a separate buffer
magit ; A Git porcelain inside Emacs.
markdown-mode ; Major mode for Markdown-formatted text
multi-term ; Managing multiple terminal buffers in Emacs.
pinentry ; GnuPG Pinentry server implementation
use-package ; A configuration macro for simplifying your .emacs
vc-backup ; VC backend for versioned backups
yaml-mode ; YAML mode
consult-recoll ; Consult interface for recoll query
org-auto-tangle ; Tangle org file when it is saved
exec-path-from-shell; Get environment variables such as $PATH from the shell
which-key)) ; Display available keybindings in popup
;; Install packages that are not yet installed
(dolist (package package-list)
(straight-use-package package))
;; Special case for pdf-tools that has recently (2022) changed maintainer
(straight-use-package
'(pdf-tools :type git :host github :repo "vedang/pdf-tools"))
;; Denote not yet on ELPA (2022-06-19)
(straight-use-package
'(denote :type git :host github :repo "protesilaos/denote"))
My personal packages
;; Display org properties in the agenda buffer (modified version)
(straight-use-package
'(org-agenda-property :type git :host github :repo "Malabarba/org-agenda-property"
:fork (:host github :repo "rougier/org-agenda-property")))
;; NANO splash
(straight-use-package
'(nano-splash :type git :host github :repo "rougier/nano-splash"))
;; NANO theme
(straight-use-package
'(nano-theme :type git :host github :repo "rougier/nano-theme"))
;; NANO modeline
(straight-use-package
'(nano-modeline :type git :host github :repo "rougier/nano-modeline"))
;; NANO agenda
(straight-use-package
'(nano-agenda :type git :host github :repo "rougier/nano-agenda"))
;; NANO agenda
(straight-use-package
'(minibuffer-header :type git :host github :repo "rougier/minibuffer-header"))
;; SVG tags, progress bars & icons
(straight-use-package
'(svg-lib :type git :host github :repo "rougier/svg-lib"))
;; Replace keywords with SVG tags
(straight-use-package
'(svg-tag-mode :type git :host github :repo "rougier/svg-tag-mode"))
;; Dashboard for mu4e
(straight-use-package
'(mu4e-dashboard :type git :host github :repo "rougier/mu4e-dashboard"))
;; Folding mode for mu4e
(straight-use-package
'(mu4e-folding :type git :host github :repo "rougier/mu4e-folding"))
;; Relative date formatting
(straight-use-package
'(relative-date :type git :host github :repo "rougier/relative-date"))
;; org imenu
(straight-use-package
'(org-imenu :type git :host github :repo "rougier/org-imenu"))
;; pdf-drop-mode
(straight-use-package
'(pdf-drop-mode :type git :host github :repo "rougier/pdf-drop-mode"))
;; Bilbliography manager in org mode
(straight-use-package
'(org-bib :type git :host github :branch "org-imenu" :repo "rougier/org-bib-mode"))
Emacs does a lot of things at startup and here, we disable pretty much everything.
(setq-default
inhibit-startup-screen t ; Disable start-up screen
inhibit-startup-message t ; Disable startup message
inhibit-startup-echo-area-message t ; Disable initial echo message
initial-scratch-message "" ; Empty the initial *scratch* buffer
initial-buffer-choice t) ; Open *scratch* buffer at init
We’ll use the bind-key function (from use-package) for bindings. Then we can use describe-personal-keybindings to check for personal bindings.
;; (require 'bind-key)
We tell emacs to use UTF-8 encoding as much as possible.
(set-default-coding-systems 'utf-8) ; Default to utf-8 encoding
(prefer-coding-system 'utf-8) ; Add utf-8 at the front for automatic detection.
(set-terminal-coding-system 'utf-8) ; Set coding system of terminal output
(set-keyboard-coding-system 'utf-8) ; Set coding system for keyboard input on TERMINAL
(set-language-environment "English") ; Set up multilingual environment
Extending executable for recollq program
(setenv "PATH" (concat (getenv "PATH") ":" "/Users/rougier/Applications/recoll.app/Contents/MacOS"))
(setq exec-path (append exec-path '("/Users/rougier/Applications/recoll.app/Contents/MacOS")))
(setenv "PATH" (concat (getenv "PATH") ":" "/Users/rougier/bin"))
(setq exec-path (append exec-path '("/Users/rougier/bin")))If Emacs or the computer crashes, you can recover the files you were editing at the time of the crash from their auto-save files. To do this, start Emacs again and type the command M-x recover-session. Here, we parameterize how files are saved in the background.
(setq auto-save-list-file-prefix ; Prefix for generating auto-save-list-file-name
(expand-file-name ".auto-save-list/.saves-" user-emacs-directory)
auto-save-default t ; Auto-save every buffer that visits a file
auto-save-timeout 20 ; Number of seconds between auto-save
auto-save-interval 200) ; Number of keystrokes between auto-saves
Emacs carefully copies the old contents to another file, called the “backup” file, before actually saving. Emacs makes a backup for a file only the first time the file is saved from a buffer. No matter how many times you subsequently save the file, its backup remains unchanged. However, if you kill the buffer and then visit the file again, a new backup file will be made. Here, we activate backup and parameterize the number of backups to keep.
(setq backup-directory-alist ; File name patterns and backup directory names.
`(("." . ,(expand-file-name "backups" user-emacs-directory)))
make-backup-files t ; Backup of a file the first time it is saved.
vc-make-backup-files t ; No backup of files under version contr
backup-by-copying t ; Don't clobber symlinks
version-control t ; Version numbers for backup files
delete-old-versions t ; Delete excess backup files silently
kept-old-versions 6 ; Number of old versions to keep
kept-new-versions 9 ; Number of new versions to keep
delete-by-moving-to-trash t) ; Delete files to trash
;; Back
(require 'vc-backup)
(setq bookmark-default-file (expand-file-name "bookmark" user-emacs-directory))
50 Recents files with some exclusion (regex patterns).
(require 'recentf)
(setq recentf-max-menu-items 10
recentf-max-saved-items 100
recentf-exclude '("/Users/rougier/Documents/Mail.+"
"/Users/rougier/Documents/Notes.+"
))
(let (message-log-max)
(recentf-mode 1))
Remove text properties for kill ring entries (see https://emacs.stackexchange.com/questions/4187). This saves a lot of time when loading it.
(defun unpropertize-kill-ring ()
(setq kill-ring (mapcar 'substring-no-properties kill-ring)))
(add-hook 'kill-emacs-hook 'unpropertize-kill-ring)
We save every possible history we can think of.
(require 'savehist)
(setq kill-ring-max 50
history-length 50)
(setq savehist-additional-variables
'(kill-ring
command-history
set-variable-value-history
custom-variable-history
query-replace-history
read-expression-history
minibuffer-history
read-char-history
face-name-history
bookmark-history
file-name-history))
(put 'minibuffer-history 'history-length 50)
(put 'file-name-history 'history-length 50)
(put 'set-variable-value-history 'history-length 25)
(put 'custom-variable-history 'history-length 25)
(put 'query-replace-history 'history-length 25)
(put 'read-expression-history 'history-length 25)
(put 'read-char-history 'history-length 25)
(put 'face-name-history 'history-length 25)
(put 'bookmark-history 'history-length 25)
No duplicates in history
(setq history-delete-duplicates t)
Start history mode.
(let (message-log-max)
(savehist-mode))
Record cursor position from one session ot the other
(setq save-place-file (expand-file-name "saveplace" user-emacs-directory)
save-place-forget-unreadable-files t)
(save-place-mode 1)
Since init.el will be generated from this file, we save customization in a dedicated file.
(setq custom-file (concat user-emacs-directory "custom.el"))
(when (file-exists-p custom-file)
(load custom-file nil t))
Server start.
(require 'server)
(unless (server-running-p)
(server-start))
(my/report-time "Core")
(setq my/section-start-time (current-time))
Some functions that are used throughout this configuration.
A set of functions to join two strings such as to fit a given width. This will be used for displaying elfeed posts, privileging the right part (tag and feed).
(defun my/string-pad-right (len s)
"If S is shorter than LEN, pad it on the right,
if S is longer than LEN, truncate it on the right."
(if (> (length s) len)
(concat (substring s 0 (- len 1)) "…")
(concat s (make-string (max 0 (- len (length s))) ?\ ))))
(defun my/string-pad-left (len s)
"If S is shorter than LEN, pad it on the left,
if S is longer than LEN, truncate it on the left."
(if (> (length s) len)
(concat "…" (substring s (- (length s) len -1)))
(concat (make-string (max 0 (- len (length s))) ?\ ) s)))
(defun my/string-join (len left right &optional spacing)
"Join LEFT and RIGHT strings to fit LEN characters with at least SPACING characters
between them. If len is negative, it is retrieved from current window width."
(let* ((spacing (or spacing 3))
(len (or len (window-body-width)))
(len (if (< len 0)
(+ (window-body-width) len)
len)))
(cond ((> (length right) len)
(my/string-pad-left len right))
((> (length right) (- len spacing))
(my/string-pad-left len (concat (make-string spacing ?\ )
right)))
((> (length left) (- len spacing (length right)))
(concat (my/string-pad-right (- len spacing (length right)) left)
(concat (make-string spacing ?\ )
right)))
(t
(concat left
(make-string (- len (length right) (length left)) ?\ )
right)))))
A set of date related functions, mostly used for mail display.
(defun my/date-day (date)
"Return DATE day of month (1-31)."
(nth 3 (decode-time date)))
(defun my/date-month (date)
"Return DATE month number (1-12)."
(nth 4 (decode-time date)))
(defun my/date-year (date)
"Return DATE year."
(nth 5 (decode-time date)))
(defun my/date-equal (date1 date2)
"Check if DATE1 is equal to DATE2."
(and (eq (my/date-day date1)
(my/date-day date2))
(eq (my/date-month date1)
(my/date-month date2))
(eq (my/date-year date1)
(my/date-year date2))))
(defun my/date-inc (date &optional days months years)
"Return DATE + DAYS day & MONTH months & YEARS years"
(let ((days (or days 0))
(months (or months 0))
(years (or years 0))
(day (my/date-day date))
(month (my/date-month date))
(year (my/date-year date)))
(encode-time 0 0 0 (+ day days) (+ month months) (+ year years))))
(defun my/date-dec (date &optional days months years)
"Return DATE - DAYS day & MONTH months & YEARS years"
(let ((days (or days 0))
(months (or months 0))
(years (or years 0)))
(my/date-inc date (- days) (- months) (- years))))
(defun my/date-today ()
"Return today date."
(current-time))
(defun my/date-is-today (date)
"Check if DATE is today."
(my/date-equal (current-time) date))
(defun my/date-is-yesterday (date)
"Check if DATE is yesterday."
(my/date-equal (my/date-dec (my/date-today) 1) date))
(defun my/date-relative (date)
"Return a string with a relative date format."
(let* ((now (current-time))
(delta (float-time (time-subtract now date)))
(days (ceiling (/ (float-time (time-subtract now date)) (* 60 60 24)))))
(cond ((< delta (* 3 60)) "now")
((< delta (* 60 60)) (format "%d minutes ago" (/ delta 60)))
;; ((< delta (* 6 60 60)) (format "%d hours ago" (/ delta 3600)))
((my/date-is-today date) (format-time-string "%H:%M" date))
((my/date-is-yesterday date) (format "Yesterday"))
((< delta (* 4 24 60 60)) (format "%d days ago" (+ days 1)))
(t (format-time-string "%d %b %Y" date)))))
A set of functions to create a mini-frame over the header line.
(defun my/mini-frame (&optional height foreground background border)
"Create a child frame positionned over the header line whose
width corresponds to the width of the current selected window.
The HEIGHT in lines can be specified, as well as the BACKGROUND
color of the frame. BORDER width (pixels) and color (FOREGROUND)
can be also specified."
(interactive)
(let* ((foreground (or foreground
(face-foreground 'font-lock-comment-face nil t)))
(background (or background (face-background 'highlight nil t)))
(border (or border 1))
(height (round (* (or height 8) (window-font-height))))
(edges (window-pixel-edges))
(body-edges (window-body-pixel-edges))
(top (nth 1 edges))
(bottom (nth 3 body-edges))
(left (- (nth 0 edges) (or left-fringe-width 0)))
(right (+ (nth 2 edges) (or right-fringe-width 0)))
(width (- right left))
;; Window divider mode
(width (- width (if (and (bound-and-true-p window-divider-mode)
(or (eq window-divider-default-places 'right-only)
(eq window-divider-default-places t))
(window-in-direction 'right (selected-window)))
window-divider-default-right-width
0)))
(y (- top border))
(child-frame-border (face-attribute 'child-frame-border :background)))
(set-face-attribute 'child-frame-border t :background foreground)
(let ((frame (make-frame
`((parent-frame . ,(window-frame))
(delete-before . ,(window-frame))
(minibuffer . nil)
(modeline . nil)
(left . ,(- left border))
(top . ,y)
(width . (text-pixels . ,width))
(height . (text-pixels . ,height))
;; (height . ,height)
(child-frame-border-width . ,border)
(internal-border-width . ,border)
(background-color . ,background)
(horizontal-scroll-bars . nil)
(menu-bar-lines . 0)
(tool-bar-lines . 0)
(desktop-dont-save . t)
(unsplittable . nil)
(no-other-frame . t)
(undecorated . t)
(pixelwise . t)
(visibility . t)))))
(set-face-attribute 'child-frame-border t :background child-frame-border)
frame)))
(defun my/mini-frame-reset (frame)
"Reset FRAME size and position.
Move frame at the top of parent frame and resize it
horizontally to fit the width of current selected window."
(interactive)
(let* ((border (frame-parameter frame 'internal-border-width))
(height (frame-parameter frame 'height)))
(with-selected-frame (frame-parent frame)
(let* ((edges (window-pixel-edges))
(body-edges (window-body-pixel-edges))
(top (nth 1 edges))
(bottom (nth 3 body-edges))
(left (- (nth 0 edges) (or left-fringe-width 0)))
(right (+ (nth 2 edges) (or right-fringe-width 0)))
(width (- right left))
(y (- top border)))
(set-frame-width frame width nil t)
(set-frame-height frame height)
(set-frame-position frame (- left border) y)))))
(defun my/mini-frame-shrink (frame &optional delta)
"Make the FRAME DELTA lines smaller.
If no argument is given, make the frame one line smaller. If
DELTA is negative, enlarge frame by -DELTA lines."
(interactive)
(let ((delta (or delta -1)))
(when (and (framep frame)
(frame-live-p frame)
(frame-visible-p frame))
(set-frame-parameter frame 'height
(+ (frame-parameter frame 'height) delta)))))
A set of mail (mu4e) related functions.
(defun my/mu4e-get-account (msg)
"Get MSG related account."
(let* ((maildir (mu4e-message-field msg :maildir))
(maildir (substring maildir 1)))
(nth 0 (split-string maildir "/"))))
(defun my/mu4e-get-maildir (msg)
"Get MSG related maildir."
(let* ((maildir (mu4e-message-field msg :maildir))
(maildir (substring maildir 1)))
(nth 0 (reverse (split-string maildir "/")))))
(defun my/mu4e-get-mailbox (msg)
"Get MSG related mailbox as 'account - maildir' "
(format "%s - %s" (mu4e-get-account msg) (mu4e-get-maildir msg)))
(defun my/mu4e-get-sender (msg)
"Get MSG sender."
(let ((addr (cdr-safe (car-safe (mu4e-message-field msg :from)))))
(mu4e~headers-contact-str (mu4e-message-field msg :from))))
This section is meant to ease the writing of the configuration file using a dedicated minor mode (my/config-mode) with a few key bindings:
C-` : Toggle navigation sidebar
C-c C-p : Go to previous subsection
C-c C-n : Go to next subsection
C-c C-S-p : Go to previous section
C-c C-S-n : Go to next section
C-c t : Fold code blocks
C-c f : Filter block visibility (sidebar)
C-c C-v t : Export (tangle) code
C-c C-v s : Execute current subsection
Before being able to use it, you need to execute the whole subtree using org-babel-execute-subtree (generally bound to C-c C-v s).
This defines an org sidebar using imenu-list.
(require 'imenu)
(require 'imenu-list)
(defun my/org-tree-to-indirect-buffer ()
"Create indirect buffer, narrow it to current subtree and unfold blocks"
(org-tree-to-indirect-buffer)
(org-show-block-all)
(setq-local my/org-blocks-hidden nil))
(defun my/org-sidebar ()
"Open an imenu list on the left that allow navigation."
(interactive)
(setq imenu-list-after-jump-hook #'my/org-tree-to-indirect-buffer
imenu-list-position 'left
imenu-list-size 36
imenu-list-focus-after-activation t)
(let ((heading (substring-no-properties (or (org-get-heading t t t t) ""))))
(when (buffer-base-buffer)
(switch-to-buffer (buffer-base-buffer)))
(imenu-list-minor-mode)
(imenu-list-stop-timer)
(hl-line-mode)
(face-remap-add-relative 'hl-line :inherit 'nano-subtle)
(setq header-line-format
'(:eval
(nano-modeline-render nil
(buffer-name imenu-list--displayed-buffer)
"(outline)"
"")))
(setq-local cursor-type nil)
(when (> (length heading) 0)
(goto-char (point-min))
(search-forward heading)
(imenu-list-display-dwim))))
This toggles the org-sidebar.
(defun my/org-sidebar-toggle ()
"Toggle the org-sidebar"
(interactive)
(if (get-buffer-window "*Ilist*")
(progn
(quit-window nil (get-buffer-window "*Ilist*"))
(switch-to-buffer (buffer-base-buffer)))
(my/org-sidebar)))
Make sure tangle is applied to the base buffer and not the subtree.
(defun my/org-babel-tangle ()
"Write code blocks to source-specific files from the base buffer."
(interactive)
(with-current-buffer (or (buffer-base-buffer)
(current-buffer))
(org-babel-tangle)))
Toggle code blocks folding, starting folded.
(defvar my/org-blocks-hidden nil)
(defun my/org-toggle-blocks ()
"Toggle code blocks folding."
(interactive)
(if my/org-blocks-hidden
(org-show-block-all)
(org-hide-block-all))
(setq-local my/org-blocks-hidden (not my/org-blocks-hidden)))
(add-hook 'config-mode-hook #'my/org-toggle-blocks)
(defvar my/imenu-list-folding-status t
"Folding status of the imenu-list")
(defun my/imenu-list-toggle-folding ()
"Toggle top level nodes of the imenu-list buffer"
(interactive)
(with-current-buffer "*Ilist*"
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\+ " nil t)
(if my/imenu-list-folding-status
(hs-hide-block)
(hs-show-block)))
(setq my/imenu-list-folding-status (not my/imenu-list-folding-status)))))
(bind-key "S-<tab>" #'my/imenu-list-toggle-folding imenu-list-major-mode-map)
Some information for when a top node is closed
(defun my/display-code-line-counts (ov)
(when (eq 'code (overlay-get ov 'hs))
(overlay-put ov 'display
(propertize
(format " [%d sections] … "
(- (count-lines (overlay-start ov)
(overlay-end ov)) 1))
'face 'nano-faded))))
(setq hs-set-up-overlay #'my/display-code-line-counts)
(defun my/imenu-list-display-dwim ()
"Display or toggle the entry at `point'."
(interactive)
(save-selected-window
(save-excursion
(my/imenu-list-ret-dwim))))
(defun my/imenu-list-ret-dwim ()
"Jump to or toggle the entry at `point'."
(interactive)
(save-excursion
(let ((entry (imenu-list--find-entry)))
(when (imenu--subalist-p entry)
(setq entry (cons
(car entry)
(get-text-property 0 'marker (car entry)))))
(imenu-list--goto-entry entry))))
(bind-key "<SPC>" #'my/imenu-list-display-dwim imenu-list-major-mode-map)
(bind-key "<return>" #'my/imenu-list-ret-dwim imenu-list-major-mode-map)
This provide the my/org-imenu-filter that allow to filter sidebar entries using the specified expression (e.g. “+HOOK +DEFER”).
(bind-key "C-c f" #'my/org-imenu-filter)
(bind-key "f" #'my/org-imenu-filter imenu-list-major-mode-map)
(bind-key "U" #'imenu-list-refresh imenu-list-major-mode-map)
3 levels for org-imenu
(setq org-imenu-depth 3)
(require 'org)
(require 'svg-tag-mode)
(defvar my/org-imenu-filter-history
'("BINDING" "HOOK" "ADVICE" "FACE" "MODE" "DEFER"
"PERSONAL" "INACTIVE" "BUGFIX" "OTHER" "TIMER" "OS")
"Filter history list.")
(defvar my/org-imenu-filter-function
(cdr (org-make-tags-matcher "*"))
"Filter function to decide if a headline is kept")
(defun my/org-imenu-filter ()
"Define and apply a new filter"
(interactive)
(let* ((match (completing-read-multiple
"FILTER: "
my/org-imenu-filter-history
nil nil nil
'my/org-imenu-filter-history))
(match (mapconcat #'identity match " ")))
(when (string= "" match)
(setq match "*"))
(setq my/org-imenu-filter-function
(cdr (org-make-tags-matcher match)))
(imenu-list-refresh)))
(defun my/org-imenu-filter-tree (&optional bound parent-match)
"Build a imenu list using current filter function"
(let* ((headlines '()))
(save-excursion
(org-with-wide-buffer
(unless bound
(setq bound (point-max))
(goto-char (point-min)))
(while (re-search-forward org-heading-regexp bound t)
(let* ((element (org-element-at-point))
(begin (org-element-property :begin element))
(end (org-element-property :end element))
(marker (copy-marker begin))
(level (org-element-property :level element))
(tags (save-excursion
(goto-char begin)
(org-get-tags)))
(match (save-excursion
(goto-char begin)
(funcall my/org-imenu-filter-function
nil (org-get-tags) level)))
(title (org-element-property :raw-value element))
(title (org-link-display-format
(substring-no-properties title)))
(title (propertize title 'org-imenu-marker marker
'org-imenu t))
(title (if (member "INACTIVE" tags)
(propertize title 'face 'nano-faded)
title))
(svg-tags (mapconcat #'(lambda (tag)
(propertize tag 'display (svg-tag-make tag :face 'nano-faded)))
tags " "))
(title (if tags (format "%s %s" title svg-tags) title))
(title (propertize title 'marker marker))
(children (my/org-imenu-filter-tree end match)))
(goto-char end)
(cond ((> level org-imenu-depth)
nil)
((> (length children) 0)
(add-to-list 'headlines (append (list title) children) t))
((or match parent-match)
(add-to-list 'headlines (cons title marker) t)))))))
headlines))
(advice-add #'org-imenu-get-tree :override #'my/org-imenu-filter-tree)
This section defines the my/config-mode to ease navigating and interacting with the configuration file.
Navigation commands using the ilist menu.
(defun my/config-mode-prev-header ()
"Move to previous header"
(interactive)
(with-current-buffer "*Ilist*"
(search-backward-regexp "^ ")
(imenu-list-display-dwim)))
(defun my/config-mode-next-header ()
"Move to next header"
(interactive)
(with-current-buffer "*Ilist*"
(forward-line)
(search-forward-regexp "^ ")
(imenu-list-display-dwim)))
(defun my/config-mode-prev-section ()
"Move to previous section"
(interactive)
(with-current-buffer "*Ilist*"
(search-backward-regexp "\\+ " nil nil 2)
(forward-line)
(imenu-list-display-dwim)))
(defun my/config-mode-next-section ()
"Move to next section"
(interactive)
(with-current-buffer "*Ilist*"
(previous-line)
(search-forward-regexp "\\+ ")
(forward-line)
(imenu-list-display-dwim)))
A minor mode for configuration
(define-minor-mode my/config-mode
"Configuration mode"
:init-value nil
:global nil
:keymap (let* ((map (make-sparse-keymap)))
(bind-key "C-c C-p" #'my/config-mode-prev-header map)
(bind-key "C-c C-n" #'my/config-mode-next-header map)
(bind-key "C-c C-S-p" #'my/config-mode-prev-section map)
(bind-key "C-c C-S-n" #'my/config-mode-next-section map)
(bind-key "C-`" #'my/org-sidebar-toggle map)
(bind-key "C-c C-v t" #'my/org-babel-tangle map)
(bind-key "C-c t" #'my/org-toggle-blocks map)
map)
(require 'org)
(if my/config-mode
(my/org-sidebar)))
A shortcut to edit configuration
(defun my/config ()
"Create a new for editing configuration"
(interactive)
(select-frame (make-frame '((name . "my/config")
(width . 150)
(height . 45))))
(find-file "~/Documents/GitHub/dotemacs/dotemacs.org")
(my/config-mode))
An autoload function for my/config (that will load org mode).
(autoload 'my/config
(expand-file-name "init.el" user-emacs-directory)
"Autoloaded my/config command."
t)
Temporary bugfix for babel emacs-lisp that does not take into account prologue/epilogue. See https://list.orgmode.org/CA+G3_PNrdhx0Ejzw8UO7DgZ+ju1B7Ar_eTch5MMViEpKGwqq3w@mail.gmail.com/T/ (November 2020)
(defun my/org-babel-expand-body:emacs-lisp (orig-fun body params)
"Expand BODY according to PARAMS and call original function with new body"
(let* ((pro (or (cdr (assq :prologue params)) ""))
(epi (or (cdr (assq :epilogue params)) ""))
(body (concat pro body epi)))
(apply orig-fun `(,body ,params))))
(advice-add 'org-babel-expand-body:emacs-lisp
:around
#'my/org-babel-expand-body:emacs-lisp)
Automatically tangle org-mode files with the option #+auto_tangle: t
(add-hook 'org-mode-hook 'org-auto-tangle-mode)
(my/report-time "Personal library")
(setq my/section-start-time (current-time))
A make-frame rewrote that creates the frame and switch to the *scratch* buffer.
(defun my/make-frame ()
"Create a new frame and switch to *scratch* buffer."
(interactive)
(select-frame (make-frame))
(switch-to-buffer "*scratch*"))
A function that close the current frame and kill emacs if it was the last frame.
(defun my/kill-emacs ()
"Delete frame or kill Emacs if there is only one frame."
(interactive)
(condition-case nil
(delete-frame)
(error (save-buffers-kill-terminal))))
Default frame geometry (large margin: 24 pixels).
(require 'frame)
;; Default frame settings
(setq default-frame-alist '((min-height . 1) '(height . 45)
(min-width . 1) '(width . 81)
(vertical-scroll-bars . nil)
(internal-border-width . 24)
(left-fringe . 0)
(right-fringe . 0)
(tool-bar-lines . 0)
(menu-bar-lines . 1)))
;; Default frame settings
(setq initial-frame-alist default-frame-alist)
Frame related binding (self explanatory).
(bind-key "M-n" #'my/make-frame)
(bind-key "C-x C-c" #'my/kill-emacs)
(bind-key "M-`" #'other-frame)
(bind-key "C-z" nil)
(bind-key "<M-return>" #'toggle-frame-maximized)
For frame maximization, we have to make a specific case for org-mode.
(with-eval-after-load 'org
(bind-key "<M-return>" #'toggle-frame-maximized 'org-mode-map))
Margin and divider mode.
(setq-default window-divider-default-right-width 24
window-divider-default-places 'right-only
left-margin-width 0
right-margin-width 0
window-combination-resize nil) ; Do not resize windows proportionally
(window-divider-mode 1)
Toggle the dedicated flag on the current window
;; Make a window dedicated
(defun my/toggle-window-dedicated ()
"Toggle whether the current active window is dedicated or not"
(interactive)
(message
(if (let (window (get-buffer-window (current-buffer)))
(set-window-dedicated-p window (not (window-dedicated-p window))))
"Window '%s' is dedicated"
"Window '%s' is normal")
(current-buffer))
(force-window-update))
(bind-key "C-c d" #'my/toggle-window-dedicated)
Size of temporary buffers
(temp-buffer-resize-mode)
(setq temp-buffer-max-height 8)
Unique buffer names
(require 'uniquify)
(setq uniquify-buffer-name-style 'reverse
uniquify-separator " • "
uniquify-after-kill-buffer-p t
uniquify-ignore-buffers-re "^\\*")
No question after killing a buffer (kill-buffer asks you which buffer to switch to)
(bind-key "C-x k" #'kill-current-buffer)
Follow symlinks without prompt
(setq vc-follow-symlinks t)
Emacs can use a large number of dialogs and popups. Here we get rid of them.
(setq-default show-help-function nil ; No help text
use-file-dialog nil ; No file dialog
use-dialog-box nil ; No dialog box
pop-up-windows nil) ; No popup windows
(tooltip-mode -1) ; No tooltips
(scroll-bar-mode -1) ; No scroll bars
(tool-bar-mode -1) ; No toolbar
Specific case for OSX since menubar is desktop-wide (see emacs.stackexchange.com/questions/28121) and emacs-mac documentation.
Unlike the original Emacs, enabling or disabling Menu Bar mode (@pxref{Menu Bars}) does not affect the appearance of the mexnu bar on the Mac port because it does not make sense on OS X having the global menu bar. Instead, the value of the @code{menu-bar-lines} frame parameter affects the system-wide full screen behavior of the frame. In most cases, disabling the menu bar of a particular frame by default means that it is a utility frame used for a subsidiary purpose together with other frames, rather than an ordinary frame on its own. Examples include the speedbar (@pxref{Speedbar}) and Ediff Control Panel (@pxref{Top, Ediff, Ediff, ediff, The Ediff Manual}). Using this heuristics, the Mac port regards a frame having a menu bar as an ordinary frame that is eligible for full screen. Conversely, a frame without a menu bar is considered as a utility frame and it can coexist with a full screen ordinary frame and other utility frames in a same desktop (or Space) for full screen. Note that a utility frame doesn’t have the full screen button on the title bar. If you don’t see the full screen button while it is supposed to be there, then check the menu bar setting.
(menu-bar-mode 1)
The mode displays the key bindings following your currently entered incomplete command (a ;; prefix) in a popup.
(require 'which-key)
(which-key-mode)
We set the appearance of the cursor: horizontal line, 2 pixels thick, no blinking
(setq-default cursor-in-non-selected-windows nil ; Hide the cursor in inactive windows
cursor-type '(hbar . 2) ; Underline-shaped cursor
cursor-intangible-mode t ; Enforce cursor intangibility
x-stretch-cursor nil) ; Don't stretch cursor to the glyph width
(blink-cursor-mode 0) ; Still cursor
Pretty self-explanatory
(setq-default use-short-answers t ; Replace yes/no prompts with y/n
confirm-nonexistent-file-or-buffer nil) ; Ok to visit non existent files
Replace region when inserting text
(delete-selection-mode 1)
A smarter fill/unfill command
(defun my/fill-unfill ()
"Like `fill-paragraph', but unfill if used twice."
(interactive)
(let ((fill-column
(if (eq last-command #'my/fill-unfill)
(progn (setq this-command nil)
(point-max))
fill-column)))
(call-interactively #'fill-paragraph)))
(bind-key "M-q" #'my/fill-unfill)
;; (bind-key [remap fill-paragraph] #'my/fill-unfill)
Disable the bell (auditory or visual).
(setq-default visible-bell nil ; No visual bell
ring-bell-function 'ignore) ; No bell
Mouse behavior can be finely controlled using the mouse-avoidance-mode.
(setq-default mouse-yank-at-point t) ; Yank at point rather than pointer
(mouse-avoidance-mode 'exile) ; Avoid collision of mouse with point
Mouse active in tty mode.
(unless (display-graphic-p)
(xterm-mouse-mode 1)
(global-set-key (kbd "<mouse-4>") #'scroll-down-line)
(global-set-key (kbd "<mouse-5>") #'scroll-up-line))
Smoother scrolling.
(setq-default scroll-conservatively 101 ; Avoid recentering when scrolling far
scroll-margin 2 ; Add a margin when scrolling vertically
recenter-positions '(5 bottom)) ; Set re-centering positions
Allows system and Emacs clipboard to communicate smoothly (both ways)
(setq-default select-enable-clipboard t) ; Merge system's and Emacs' clipboard
Make sure clipboard works properly in tty mode on OSX.
(defun my/paste-from-osx ()
(shell-command-to-string "pbpaste"))
(defun my/copy-to-osx (text &optional push)
(let ((process-connection-type nil))
(let ((proc (start-process "pbcopy" "*Messages*" "pbcopy")))
(process-send-string proc text)
(process-send-eof proc))))
(when (and (not (display-graphic-p))
(eq system-type 'darwin))
(setq interprogram-cut-function #'my/copy-to-osx
interprogram-paste-function #'my/paste-from-osx))
Helpful is an alternative to the built-in Emacs help that provides much more contextual information. It is a bit slow to load so we do need load it explicitely.
(setq help-window-select t) ; Focus new help windows when opened
(bind-key "C-h f" #'helpful-callable) ; Look up callable
(bind-key "C-h v" #'helpful-variable) ; Look up variable
(bind-key "C-h k" #'helpful-key) ; Look up key
(bind-key "C-c C-d" #'helpful-at-point) ; Look up the current symbol at point
(bind-key "C-h F" #'helpful-function) ; Look up *F*unctions (excludes macros).
(bind-key "C-h C" #'helpful-command) ; Look up *C*ommands.
(my/report-time "Interface")
(setq my/section-start-time (current-time))
A consistent theme for GNU Emacs. The light theme is based on Material colors and the dark theme is based on Nord colors. The theme is based on a set of six faces (only).
(require 'nano-theme)
(setq nano-fonts-use t) ; Use theme font stack
(nano-light) ; Use theme light version
(nano-mode) ; Recommended settings
(defun my/set-face (face style)
"Reset FACE and make it inherit STYLE."
(set-face-attribute face nil
:foreground 'unspecified :background 'unspecified
:family 'unspecified :slant 'unspecified
:weight 'unspecified :height 'unspecified
:underline 'unspecified :overline 'unspecified
:box 'unspecified :inherit style))
(my/set-face 'italic 'nano-faded)
We still want the transient nano splash screen
(require 'nano-splash)
This is the font stack we install:
- Default font: Roboto Mono 14pt Light
- Italic font: Victor Mono 14pt Semilight
- Bold font: Roboto Mono 14pt Regular
- Unicode font: Inconsolata 16pt Light
- Icon font: Roboto Mono Nerd 12pt Light
Text excerpt using a gorgeous and true italic font (Victor Mono), chosen to really stand out from the default font (Roboto Mono). ┌───────────────────────────────────────────────┐ │ The quick brown fox jumps over the lazy dog │ │ The quick brown fox jumps over the lazy dog ┼─ Victor Mono Italic │ The quick brown fox jumps over the lazy dog ├─ Inconsolata └─┼───────────────────────────┼─────────────────┘ Roboto Mono Nerd Roboto Mono
Note that the Victor Mono needs to be hacked such as to have the same line height as Roboto Mono. To do that, you can use the font-line utility (github.com/source-foundry/font-line): copy all the italic faces from the Victor Mono ttf file into a directoy and type: font-line percent 10 *.ttf. This will create a new set of files that you can use to replace the Victor Mono italic faces on your system.
(set-face-attribute 'default nil
:family "Roboto Mono"
:weight 'light
:height 140)
(set-face-attribute 'bold nil
:family "Roboto Mono"
:weight 'regular)
(set-face-attribute 'italic nil
:family "Victor Mono"
:weight 'semilight
:slant 'italic)
(set-fontset-font t 'unicode
(font-spec :name "Inconsolata Light"
:size 16) nil)
(set-fontset-font t '(#xe000 . #xffdd)
(font-spec :name "RobotoMono Nerd Font"
:size 12) nil)
(setq-default fill-column 80 ; Default line width
sentence-end-double-space nil ; Use a single space after dots
bidi-paragraph-direction 'left-to-right ; Faster
truncate-string-ellipsis "…") ; Nicer ellipsis
Changing the symbol for truncation (…) and wrap (↩).
(require 'nano-theme)
;; Nicer glyphs for continuation and wrap
(set-display-table-slot standard-display-table
'truncation (make-glyph-code ?… 'nano-faded))
(defface wrap-symbol-face
'((t (:family "Fira Code"
:inherit nano-faded)))
"Specific face for wrap symbol")
(set-display-table-slot standard-display-table
'wrap (make-glyph-code ?↩ 'wrap-symbol-face))
Fix a bug on OSX in term mode & zsh (spurious “%” after each command)
(when (eq system-type 'darwin)
(add-hook 'term-mode-hook
(lambda ()
(setq buffer-display-table (make-display-table)))))
Make sure underline is positionned at the very bottom.
(setq x-underline-at-descent-line nil
x-use-underline-position-properties t
underline-minimum-offset 10)
(my/report-time "Visual")
(setq my/section-start-time (current-time))
Default & initial mode is text.
(setq-default initial-major-mode 'text-mode ; Initial mode is text
default-major-mode 'text-mode) ; Default mode is text
Visual line mode for prog and text modes
(add-hook 'text-mode-hook 'visual-line-mode)
(add-hook 'prog-mode-hook 'visual-line-mode)
No tabulation, ever.
(setq-default indent-tabs-mode nil ; Stop using tabs to indent
tab-always-indent 'complete ; Indent first then try completions
tab-width 4) ; Smaller width for tab characters
;; Let Emacs guess Python indent silently
(setq python-indent-guess-indent-offset t
python-indent-guess-indent-offset-verbose nil)
Paren mode for highlighting matcing paranthesis
(require 'paren)
;; (setq show-paren-style 'expression)
(setq show-paren-style 'parenthesis)
(setq show-paren-when-point-in-periphery t)
(setq show-paren-when-point-inside-paren nil)
(show-paren-mode)
Imenu setup
(require 'imenu-list)
(setq-default imenu-list-position 'left
imenu-max-item-length 1000)
Highlighting of the current line (native mode)
(require 'hl-line)
(global-hl-line-mode)
For retina display (OSX)
;; (require 'pdf-tools)
(add-hook 'doc-view-mode-hook 'pdf-tools-install)
(setq-default pdf-view-use-scaling t
pdf-view-use-imagemagick nil)
(my/report-time "Editing")
(setq my/section-start-time (current-time))
Corfu enhances completion at point with a small completion popup.
(require 'corfu)
(setq corfu-cycle t ; Enable cycling for `corfu-next/previous'
corfu-auto t ; Enable auto completion
corfu-auto-delay 60.0 ; Delay before auto-completion shows up
corfu-separator ?\s ; Orderless field separator
corfu-quit-at-boundary nil ; Never quit at completion boundary
corfu-quit-no-match t ; Quit when no match
corfu-preview-current nil ; Disable current candidate preview
corfu-preselect-first nil ; Disable candidate preselection
corfu-on-exact-match nil ; Configure handling of exact matches
corfu-echo-documentation nil ; Disable documentation in the echo area
corfu-scroll-margin 5) ; Use scroll margin
(global-corfu-mode)
A few more useful configurations…
;; TAB cycle if there are only few candidates
(setq completion-cycle-threshold 3)
;; Emacs 28: Hide commands in M-x which do not apply to the current mode.
;; Corfu commands are hidden, since they are not supposed to be used via M-x.
(setq read-extended-command-predicate
#'command-completion-default-include-p)
;; Enable indentation+completion using the TAB key.
;; completion-at-point is often bound to M-TAB.
(setq tab-always-indent 'complete)
;; Completion in source blocks
(require 'cape)
(add-to-list 'completion-at-point-functions 'cape-symbol)
Allow completion based on space-separated tokens, out of order.
(require 'orderless)
(setq completion-styles '(substring orderless basic)
orderless-component-separator 'orderless-escapable-split-on-space
read-file-name-completion-ignore-case t
read-buffer-completion-ignore-case t
completion-ignore-case t)
(my/report-time "Completion")
(setq my/section-start-time (current-time))
We replace some of emacs functions with their consult equivalent
(require 'consult)
(setq consult-preview-key nil) ; No live preview
(bind-key "C-x C-r" #'consult-recent-file)
(bind-key "C-x h" #'consult-outline)
(bind-key "C-x b" #'consult-buffer)
(bind-key "C-c h" #'consult-history)
;; (bind-key "M-:" #'consult-complex-command)
For the consult-goto-line and consult-line commands, we define our owns with live preview (independently of the consult-preview-key)
(defun my/consult-line ()
"Consult line with live preview"
(interactive)
(let ((consult-preview-key 'any)
(mini-frame-resize 'grow-only)) ;; !! Important
(consult-line)))
(bind-key "C-s" #'my/consult-line)
(defun my/consult-goto-line ()
"Consult goto line with live preview"
(interactive)
(let ((consult-preview-key 'any))
(consult-goto-line)))
(bind-key "M-g g" #'my/consult-goto-line)
(bind-key "M-g M-g" #'my/consult-goto-line)
Vertico provides a performant and minimalistic vertical completion UI based on the default completion system but aims to be highly flexible, extensible and modular.
(require 'vertico)
;; (setq completion-styles '(basic substring partial-completion flex))
(setq vertico-resize nil ; How to resize the Vertico minibuffer window.
vertico-count 8 ; Maximal number of candidates to show.
vertico-count-format nil) ; No prefix with number of entries
(vertico-mode)
Tweaking settings
(setq vertico-grid-separator
#(" | " 2 3 (display (space :width (1))
face (:background "#ECEFF1")))
vertico-group-format
(concat #(" " 0 1 (face vertico-group-title))
#(" " 0 1 (face vertico-group-separator))
#(" %s " 0 4 (face vertico-group-title))
#(" " 0 1 (face vertico-group-separator
display (space :align-to (- right (-1 . right-margin) (- +1)))))))
(set-face-attribute 'vertico-group-separator nil
:strike-through t)
(set-face-attribute 'vertico-current nil
:inherit '(nano-strong nano-subtle))
(set-face-attribute 'completions-first-difference nil
:inherit '(nano-default))
Bind shift-tab for completion
(bind-key "<backtab>" #'minibuffer-complete vertico-map)
Completion-at-point and completion-in-region (see https://github.com/minad/vertico#completion-at-point-and-completion-in-region)
(setq completion-in-region-function
(lambda (&rest args)
(apply (if vertico-mode
#'consult-completion-in-region
#'completion--in-region)
args)))
Prefix the current candidate (See https://github.com/minad/vertico/wiki#prefix-current-candidate-with-arrow)
(defun minibuffer-format-candidate (orig cand prefix suffix index _start)
(let ((prefix (if (= vertico--index index)
" "
" ")))
(funcall orig cand prefix suffix index _start)))
(advice-add #'vertico--format-candidate
:around #'minibuffer-format-candidate)
(defun vertico--prompt-selection ()
"Highlight the prompt"
(let ((inhibit-modification-hooks t))
(set-text-properties (minibuffer-prompt-end) (point-max)
'(face (nano-strong nano-salient)))))
(defun minibuffer-vertico-setup ()
(setq truncate-lines t)
(setq completion-in-region-function
(if vertico-mode
#'consult-completion-in-region
#'completion--in-region)))
(add-hook 'vertico-mode-hook #'minibuffer-vertico-setup)
(add-hook 'minibuffer-setup-hook #'minibuffer-vertico-setup)
Pretty straightforward.
(require 'marginalia)
(setq-default marginalia--ellipsis "…" ; Nicer ellipsis
marginalia-align 'right ; right alignment
marginalia-align-offset -1) ; one space on the right
(marginalia-mode)
We’re using nano-modeline and modify some settings here.
(require 'nano-theme)
(require 'nano-modeline)
(setq nano-modeline-prefix 'status)
(setq nano-modeline-prefix-padding 1)
(set-face-attribute 'header-line nil)
(set-face-attribute 'mode-line nil
:foreground (face-foreground 'nano-subtle-i)
:background (face-foreground 'nano-subtle-i)
:inherit nil
:box nil)
(set-face-attribute 'mode-line-inactive nil
:foreground (face-foreground 'nano-subtle-i)
:background (face-foreground 'nano-subtle-i)
:inherit nil
:box nil)
(set-face-attribute 'nano-modeline-active nil
:underline (face-foreground 'nano-default-i)
:background (face-background 'nano-subtle)
:inherit '(nano-default-)
:box nil)
(set-face-attribute 'nano-modeline-inactive nil
:foreground 'unspecified
:underline (face-foreground 'nano-default-i)
:background (face-background 'nano-subtle)
:box nil)
(set-face-attribute 'nano-modeline-active-name nil
:foreground "black"
:inherit '(nano-modeline-active nano-strong))
(set-face-attribute 'nano-modeline-active-primary nil
:inherit '(nano-modeline-active))
(set-face-attribute 'nano-modeline-active-secondary nil
:inherit '(nano-faded nano-modeline-active))
(set-face-attribute 'nano-modeline-active-status-RW nil
:inherit '(nano-faded-i nano-strong nano-modeline-active))
(set-face-attribute 'nano-modeline-active-status-** nil
:inherit '(nano-popout-i nano-strong nano-modeline-active))
(set-face-attribute 'nano-modeline-active-status-RO nil
:inherit '(nano-default-i nano-strong nano-modeline-active))
(set-face-attribute 'nano-modeline-inactive-name nil
:inherit '(nano-faded nano-strong
nano-modeline-inactive))
(set-face-attribute 'nano-modeline-inactive-primary nil
:inherit '(nano-faded nano-modeline-inactive))
(set-face-attribute 'nano-modeline-inactive-secondary nil
:inherit '(nano-faded nano-modeline-inactive))
(set-face-attribute 'nano-modeline-inactive-status-RW nil
:inherit '(nano-modeline-inactive-secondary))
(set-face-attribute 'nano-modeline-inactive-status-** nil
:inherit '(nano-modeline-inactive-secondary))
(set-face-attribute 'nano-modeline-inactive-status-RO nil
:inherit '(nano-modeline-inactive-secondary))
We set a thin modeline
(defun my/thin-modeline ()
"Transform the modeline in a thin faded line"
(nano-modeline-face-clear 'mode-line)
(nano-modeline-face-clear 'mode-line-inactive)
(setq mode-line-format (list ""))
(setq-default mode-line-format (list ""))
(set-face-attribute 'mode-line nil
:box nil
:inherit nil
:foreground (face-background 'nano-subtle)
:background (face-background 'nano-subtle)
:height 0.1)
(set-face-attribute 'mode-line-inactive nil
:box nil
:inherit nil
:foreground (face-background 'nano-subtle)
:background (face-background 'nano-subtle)
:height 0.1))
(add-hook 'nano-modeline-mode-hook #'my/thin-modeline)
We start the nano modeline.
(nano-modeline-mode 1)
Headerline (fake) for minibuffer
(require 'minibuffer-header)
(setq minibuffer-header-show-message t
minibuffer-header-hide-prompt t
minibuffer-header-default-message "")
(set-face-attribute 'minibuffer-header-face nil
:inherit 'nano-subtle
:extend t)
(set-face-attribute 'minibuffer-header-message-face nil
:inherit '(nano-subtle nano-faded)
:extend t)This should be an advice but it is simpler to rewrite the function
(defun my/minibuffer-header-format (prompt)
"Minibuffer header"
(let* ((prompt (replace-regexp-in-string "[: \t]*$" "" prompt))
(depth (minibuffer-depth))
(prompt (cond ((string= prompt "M-x") "Extended command")
((string= prompt "Function") "Help on function")
((string= prompt "Callable") "Help on function or macro")
((string= prompt "Variable") "Help on variable")
((string= prompt "Command") "Help on command")
((string= prompt "Eval") "Evaluate lisp expression")
(t prompt))))
(concat
(propertize (format " %d " depth)
'face `(:inherit (nano-salient-i nano-strong)
:extend t))
(propertize " "
'face 'nano-subtle 'display `(raise ,nano-modeline-space-top))
(propertize prompt
'face `(:inherit (nano-subtle nano-strong nano-salient)
:extend t))
(propertize " "
'face 'nano-subtle 'display `(raise ,nano-modeline-space-bottom))
(propertize "\n" 'face 'highlight)
(propertize " " 'face 'highlight
'display `(raise ,nano-modeline-space-top))
(propertize "︎︎" 'face '(:inherit (nano-salient nano-strong)))
(propertize " " 'face 'highlight
'display `(raise ,nano-modeline-space-bottom)))))
(setq minibuffer-header-format #'my/minibuffer-header-format)
Activate minibuffer header
(minibuffer-header-mode)
Some styling setting for the minibuffer
(defun my/minibuffer-setup ()
(set-window-margins nil 0 0)
(set-fringe-style '(0 . 0))
(cursor-intangible-mode t)
(face-remap-add-relative 'default :inherit 'highlight))
(add-hook 'minibuffer-setup-hook #'my/minibuffer-setup)
Showing key binding for the current command
;; Code from https://stackoverflow.com/questions/965263
(defun my/lookup-function (keymap func)
(let ((all-bindings (where-is-internal (if (symbolp func)
func
(cl-first func))
keymap))
keys key-bindings)
(dolist (binding all-bindings)
(when (and (vectorp binding)
(integerp (aref binding 0)))
(push binding key-bindings)))
(push (mapconcat #'key-description key-bindings " or ") keys)
(car keys)))
(defun my/minibuffer-show-last-command-setup ()
(setq minibuffer-header-default-message
(my/lookup-function (current-global-map) this-command)))
(add-hook 'minibuffer-setup-hook #'my/minibuffer-show-last-command-setup)
(defun my/minibuffer-show-last-command-exit ()
(setq minibuffer-header-default-message ""))
(add-hook 'minibuffer-exit-hook #'my/minibuffer-show-last-command-exit)
Vertico will disable truncate lines when point is too far on the right. Problem is that it’ll mess up with our fake headerline. We thus rewrite here the function to have truncate lines always on.
(defun my/vertico--resize-window (height)
"Resize active minibuffer window to HEIGHT."
;; (setq-local truncate-lines (< (point) (* 0.8 (vertico--window-width)))
(setq-local truncate-lines t
resize-mini-windows 'grow-only
max-mini-window-height 1.0)
(unless (frame-root-window-p (active-minibuffer-window))
(unless vertico-resize
(setq height (max height vertico-count)))
(let* ((window-resize-pixelwise t)
(dp (- (max (cdr (window-text-pixel-size))
(* (default-line-height) (1+ height)))
(window-pixel-height))))
(when (or (and (> dp 0) (/= height 0))
(and (< dp 0) (eq vertico-resize t)))
(window-resize nil dp nil nil 'pixelwise)))))
(advice-add #'vertico--resize-window :override #'my/vertico--resize-window)
No prompt editing and recursive minibuffer
(setq minibuffer-prompt-properties '(read-only t
cursor-intangible t
face minibuffer-prompt)
enable-recursive-minibuffers t)
(require 'mini-frame)
(defcustom my/minibuffer-position 'bottom
"Minibuffer position, one of 'top or 'bottom"
:type '(choice (const :tag "Top" top)
(const :tag "Bottom" bottom))
:group 'nano-minibuffer)
(defun my/minibuffer--frame-parameters ()
"Compute minibuffer frame size and position."
;; Quite precise computation to align the minibuffer and the
;; modeline when they are both at top position
(let* ((edges (window-pixel-edges)) ;; (left top right bottom)
(body-edges (window-body-pixel-edges)) ;; (left top right bottom)
(left (nth 0 edges)) ;; Take margins into account
(top (nth 1 edges)) ;; Drop header line
(right (nth 2 edges)) ;; Take margins into account
(bottom (nth 3 body-edges)) ;; Drop header line
(left (if (eq left-fringe-width 0)
left
(- left (frame-parameter nil 'left-fringe))))
(right (nth 2 edges))
(right (if (eq right-fringe-width 0)
right
(+ right (frame-parameter nil 'right-fringe))))
(border 1)
(width (- right left (* 1 border)))
;; Window divider mode
(width (- width (if (and (bound-and-true-p window-divider-mode)
(or (eq window-divider-default-places 'right-only)
(eq window-divider-default-places t))
(window-in-direction 'right (selected-window)))
window-divider-default-right-width
0)))
(y (- top border)))
(append `((left-fringe . 0)
(right-fringe . 0)
(user-position . t)
(foreground-color . ,(face-foreground 'highlight nil 'default))
(background-color . ,(face-background 'highlight nil 'default)))
(cond ((and (eq my/minibuffer-position 'bottom))
`((top . -1)
(left . 0)
(width . 1.0)
(child-frame-border-width . 0)
(internal-border-width . 0)))
(t
`((left . ,(- left border))
(top . ,y)
(width . (text-pixels . ,width))
(child-frame-border-width . ,border)
(internal-border-width . 0)))))))
(set-face-background 'child-frame-border (face-foreground 'nano-faded))
(setq mini-frame-default-height 3)
(setq mini-frame-create-lazy t)
(setq mini-frame-show-parameters 'my/minibuffer--frame-parameters)
(setq mini-frame-ignore-commands
'("edebug-eval-expression" debugger-eval-expression))
(setq mini-frame-internal-border-color (face-foreground 'nano-faded))
(setq mini-frame-resize-min-height 3)
(setq mini-frame-resize t)
;; (setq mini-frame-resize 'grow-only)
;; (setq mini-frame-default-height (+ 1 vertico-count))
;; (setq mini-frame-resize-height (+ 1 vertico-count))
;; (setq mini-frame-resize nil)
Mini-frame mode OFF
;; (mini-frame-mode 1)
More a hack than a fix but the code below improve the mini-frame resize by setting position explicity. CURRENTLY INACTIVE
(defun my/mini-frame--resize-mini-frame (frame)
"Resize FRAME vertically only.
This function used as value for `resize-mini-frames' variable."
(funcall mini-frame--fit-frame-function
frame
mini-frame-resize-max-height
(if (eq mini-frame-resize 'grow-only)
(max (frame-parameter frame 'height)
mini-frame-resize-min-height)
mini-frame-resize-min-height)
;; A max-width must be included to work around a bug in Emacs which
;; causes wrapping to not be taken into account in some situations
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=56102
(window-body-width)
nil
'vertically)
(if (eq my/minibuffer-position 'top)
(modify-frame-parameters mini-frame-completions-frame `((top . 0)))
(modify-frame-parameters mini-frame-completions-frame `((top . (- 1))))))
(my/report-time "Minibuffer/Modeline")
For OSX users, make sure to have a look at: https://macowners.club/posts/email-emacs-mu4e-macos/
(setq my/section-start-time (current-time))
Mu4e doesn’t come with an autoload function, we declare it here.
(autoload 'mu4e
"/usr/local/Cellar/mu/1.8.7/share/emacs/site-lisp/mu/mu4e/mu4e.el"
"Start mu4e daemon and show its main window." t)
Lots of options. Make sure to adapt paths to your system.
(setq mu4e-mu-binary "/usr/local/bin/mu"
mu4e-maildir "~/Documents/Mail"
mu4e-attachment-dir "~/Downloads"
mu4e-get-mail-command "/usr/local/bin/mbsync -a"
mu4e-update-interval 300 ; Update interval (seconds)
mu4e-index-cleanup t ; Cleanup after indexing
mu4e-index-update-error-warning t ; Warnings during update
mu4e-hide-index-messages t ; Hide indexing messages
mu4e-index-update-in-background t ; Background update
mu4e-change-filenames-when-moving t ; Needed for mbsync
mu4e-index-lazy-check nil ; Don't be lazy, index everything
mu4e-confirm-quit nil
mu4e-split-view 'single-window
mu4e-headers-auto-update nil
mu4e-headers-date-format "%d-%m"
mu4e-headers-time-format "%H:%M"
mu4e-headers-from-or-to-prefix '("" . "To ")
mu4e-headers-include-related t
mu4e-headers-skip-duplicates t)
How to handle various MIME data.
(require 'mailcap)
(push '((viewer . "open %s 2> /dev/null &")
(type . "application/pdf")
(test . window-system))
mailcap-user-mime-data)
(when (fboundp 'imagemagick-register-types)
(imagemagick-register-types))
Some bindings to avoid confirmation for execution (headers and message view)
(bind-key "x" (lambda() (interactive) (mu4e-mark-execute-all t)) mu4e-headers-mode-map)
(bind-key "x" (lambda() (interactive) (mu4e-mark-execute-all t)) mu4e-view-mode-map)
General information about me.
;; User name
(setq user-full-name "Nicolas P. Rougier")
;; Main user mail address
(setq user-mail-address "[email protected]")
;; Common signature for all accounts.
(setq mu4e-signature (concat
"Nicolas P. Rougier —— www.labri.fr/perso/nrougier\n"
"Institute of Neurodegenerative Diseases, Bordeaux"
;; "Nicolas P. Rougier — Institute of Neurodegenerative Diseases\n"
;; "University of Bordeaux — https://www.labri.fr/perso/nrougier\n"
;; "Nicolas P. Rougier —— Research Director\n"
;; "Institute of Neurodegenerative Diseases\n"
;; "Bordeaux —— www.labri.fr/perso/nrougier"
))
Because we’ll use mu4e-contexts, we reset single account settings.
(setq mu4e-contexts nil
mu4e-drafts-folder nil
mu4e-compose-reply-to-address nil
mu4e-compose-signature t
mu4e-compose-signature-auto-include t
mu4e-sent-folder nil
mu4e-trash-folder nil)
(setq mu4e-context-policy 'pick-first ; How to determine context when entering headers view
mu4e-compose-context-policy nil) ; Do not modify context when composing
Refile/archive depending on the context (via maildir)
(defun my/mu4e-refile-folder (msg)
"Contextual refile"
(let ((maildir (mu4e-message-field msg :maildir)))
(cond
((string-match "inria" maildir) "/inria/archive")
((string-match "gmail" maildir) "/gmail/archive")
((string-match "univ" maildir) "/univ/archive")
(t ""))))
(setq mu4e-refile-folder 'my/mu4e-refile-folder)
(add-to-list 'mu4e-contexts
(make-mu4e-context
:name "University"
:enter-func (lambda () (mu4e-message "Entering university context"))
:leave-func (lambda () (mu4e-message "Leaving university context"))
:match-func (lambda (msg)
(when msg (mu4e-message-contact-field-matches msg
:to "[email protected]")))
:vars `((user-mail-address . "[email protected]" )
(user-full-name . "Nicolas P. Rougier (university)" )
(mu4e-compose-signature . ,mu4e-signature)
(mu4e-sent-folder . "/univ/sent")
(mu4e-trash-folder . "/univ/trash")
(mu4e-drafts-folder . "/univ/drafts")
(mu4e-maildir-shortcuts . (("/univ/inbox" . ?i)
("/univ/archive" . ?a)
("/univ/sent" . ?s)))
(smtpmail-smtp-server . "smtpauth.u-bordeaux.fr")
(smtpmail-stream-type . starttls)
(smtpmail-smtp-service . 587))))
To store the password in OSX keychain:
security add-internet-password -l 'smtp.gmail.com -s 'smtp.gmail.com' -a '[email protected]' -P 587 -r smtp -T Emacs -U -w "password12345"
(add-to-list 'mu4e-contexts
(make-mu4e-context
:name "gmail"
:enter-func (lambda () (mu4e-message "Entering gmail context"))
:leave-func (lambda () (mu4e-message "Leaving gmail context"))
:match-func (lambda (msg)
(when msg (mu4e-message-contact-field-matches msg
:to "[email protected]")))
:vars `((user-mail-address . "[email protected]" )
(user-full-name . "Nicolas P. Rougier (gmail)" )
;; don't save messages to Sent Messages,
;; Gmail/IMAP takes care of this
;; (mu4e-sent-messages-behavior 'delete)
(mu4e-compose-signature . ,mu4e-signature)
(mu4e-sent-folder . "/gmail/sent")
(mu4e-trash-folder . "/gmail/trash")
(mu4e-drafts-folder . "/gmail/drafts")
(mu4e-maildir-shortcuts . (("/gmail/inbox" . ?i)
("/gmail/archive". ?a)
("/gmail/sent" . ?s)))
(smtpmail-smtp-server . "smtp.gmail.com")
(smtpmail-stream-type . starttls)
(smtpmail-smtp-service . 587))))
(add-to-list 'mu4e-contexts
(make-mu4e-context
:name "inria"
:enter-func (lambda () (mu4e-message "Entering inria context"))
:leave-func (lambda () (mu4e-message "Leaving inria context"))
:match-func (lambda (msg)
(when msg (mu4e-message-contact-field-matches msg
:to "[email protected]")))
:vars `((user-mail-address . "[email protected]")
(user-full-name . "Nicolas P. Rougier (inria)")
(mu4e-compose-signature . ,mu4e-signature)
(mu4e-sent-folder . "/inria/sent")
(mu4e-trash-folder . "/inria/trash")
(mu4e-drafts-folder . "/inria/drafts")
(mu4e-maildir-shortcuts . (("/inria/inbox" . ?i)
("/inria/archive" . ?a)
("/inria/sent" . ?s)))
(smtpmail-smtp-server . "smtp.inria.fr")
(smtpmail-stream-type . starttls)
(smtpmail-smtp-service . 587))))
See https://www.djcbsoftware.nl/code/mu/mu4e/Reading-messages.html
(require 'epg-config)
(setq epg-gpg-program "/usr/local/bin/gpg" ; What gpg program to use
epg-user-id "gpg_key_id" ; GnuPG ID of your default identity
mml2015-use 'epg ; The package used for PGP/MIME.
mml2015-encrypt-to-self t ; Add our own key ID to recipient list
mml2015-sign-with-sender t) ; Use message sender to find a key to sign with.
;;(setq epa-file-cache-passphrase-for-symmetric-encryption nil)
;;(require 'epa-file)
;;(epa-file-enable)
;;(setq epa-file-select-keys nil)
(setq epa-pinentry-mode 'loopback)
(pinentry-start)
Various settings
(setq mu4e-show-images t
mu4e-use-fancy-chars nil
mu4e-view-html-plaintext-ratio-heuristic most-positive-fixnum
mu4e-html2text-command 'mu4e-shr2text
shr-use-fonts nil ; Simple HTML Renderer / no font
shr-use-colors nil) ; Simple HTML Renderer / no color
n/p for nevigating unread mails
(bind-key "n" #'mu4e-headers-next-unread mu4e-headers-mode-map)
(bind-key "p" #'mu4e-headers-prev-unread mu4e-headers-mode-map)
Custom faces
(set-face-attribute 'mu4e-system-face nil :inherit 'nano-critical)
(set-face-attribute 'mu4e-header-marks-face nil :inherit 'nano-critical)
(set-face-attribute 'mu4e-header-highlight-face nil :inherit 'nano-salient-i)
See www.gnu.org/software/emacs/manual/html_node/message/Insertion-Variables.html
(setq message-send-mail-function 'smtpmail-send-it
message-cite-reply-position 'below
message-citation-line-format "%N [%Y-%m-%d at %R] wrote:"
message-citation-line-function 'message-insert-formatted-citation-line
message-yank-prefix "> "
message-yank-cited-prefix "> "
message-yank-empty-prefix "> "
message-indentation-spaces 1
message-kill-buffer-on-exit t
mu4e-compose-format-flowed t
mu4e-compose-complete-only-personal t
mu4e-compose-complete-only-after "2021-01-01" ; Limite address auto-completion
mu4e-compose-dont-reply-to-self t
mu4e-compose-crypto-reply-policy 'sign-and-encrypt)
Multi-language flyspell in compose mode
(require 'flyspell)
(require 'guess-language)
(require 'flyspell-correct-popup)
;; (bind-key "C-;" #'flyspell-popup-wrapper flyspell-mode-map)
(bind-key "C-;" #'flyspell-popup-correct flyspell-mode-map)
;; Automatically detect language for Flyspell
(with-eval-after-load 'guess-language
(add-hook 'text-mode-hook #'guess-language-mode)
(setq guess-language-langcodes '((en . ("en_GB" "English"))
(fr . ("fr_FR" "French")))
guess-language-languages '(en fr)
guess-language-min-paragraph-length 45))
(setq flyspell-generic-check-word-predicate 'mail-mode-flyspell-verify)
(defun my/mu4e-compose-hook ()
"Settings for message composition."
(auto-save-mode -1)
(turn-off-auto-fill)
(set-fill-column 79)
(setq flyspell-generic-check-word-predicate
'mail-mode-flyspell-verify)
(flyspell-mode))
(add-hook 'mu4e-compose-mode-hook #'my/mu4e-compose-hook)
(setq mu4e-bookmarks
'((:name "Unread"
:key ?u
:show-unread t
:query "flag:unread AND NOT flag:trashed")
(:name "Inbox"
:key ?i
:show-unread t
:query "m:/inria/inbox or m:/univ/inbox or m:/gmail/inbox")
(:name "Today"
:key ?t
:show-unread t
:query "date:today..now")
(:name "Yesterday"
:key ?y
:show-unread t
:query "date:2d..today and not date:today..now")
(:name "Last week"
:key ?w
:hide-unread t
:query "date:7d..now")
(:name "Flagged"
:key ?f
:show-unread t
:query "flag:flagged")
(:name "Sent"
:key ?s
:hide-unread t
:query "from:Nicolas.Rougier")
(:name "Drafts"
:key ?d
:hide-unread t
:query "flag:draft")))
This provides a tag action inside the mu4e headers view to quickly tag message. Tags are saved in the mu4e-tag-history variable that is also saved from one session to the other. We use the consult-completing-read-multiple function to read tags.
(defvar mu4e-tag-history '()
"Mu4e tag history list.")
(add-to-list 'savehist-additional-variables 'mu4e-tag-history)
(put 'mu4e-tag-history 'history-length 100)
Here is the actual tag action
(defun mu4e-tag-read (target msg)
"Ask for tags to be added and/or removed."
(let* ((tags nil)
(old-tags (mu4e-message-field msg :tags))
(new-tags (completing-read-multiple
"TAGS: "
mu4e-tag-history
nil
nil
(mapconcat #'identity old-tags ",")
'mu4e-tag-history)))
(dolist (tag old-tags)
(let ((tag (string-trim tag)))
(if (and (> (length tag) 0)
(not (member tag new-tags)))
(push (concat "-" tag) tags))))
(dolist (tag new-tags)
(let ((tag (string-trim tag)))
(if (and (> (length tag) 0)
(not (member tag old-tags)))
(push (concat "+" tag) tags))))
(mapconcat #'identity tags ",")))
;; Add the mark to mu4e. If the action does nothing, the header is marked anyway.
;; I Did not find a way to cancel the marks
(add-to-list 'mu4e-marks
'(tag
:char "g"
:prompt "gtag"
:dyn-target mu4e-tag-read
:action (lambda (docid msg target)
(when (> (length target) 0)
(mu4e-action-retag-message msg target)))))
;; Tell mu4e about the new mark
;; See https://www.djcbsoftware.nl/code/mu/mu4e/Adding-a-new-kind-of-mark.html
(mu4e~headers-defun-mark-for tag)
We bind the tagging with the “g” key in mu4e-headers-mode.
(bind-key "g" #'mu4e-headers-mark-for-tag mu4e-headers-mode-map)
Some face specification for folding.
(require 'mu4e-folding)
(set-face-attribute 'mu4e-folding-root-folded-face nil
:background (face-background 'default)
:extend t)
(set-face-attribute 'mu4e-folding-root-unfolded-face nil
:background (face-background 'default)
:extend t)
(set-face-attribute 'mu4e-folding-child-folded-face nil
:background (face-background 'default)
:extend t)
(set-face-attribute 'mu4e-folding-child-unfolded-face nil
:background (face-background 'default)
:extend t)
(setq mu4e-headers-fields
'((:my/date . 12)
(:my/flags . 1)
(:my/from . 28)
(:my/subject . nil)))
(setq mu4e-headers-thread-root-prefix '("" . "")
mu4e-headers-thread-first-child-prefix '("" . "")
mu4e-headers-thread-child-prefix '("" . "")
mu4e-headers-thread-last-child-prefix '("" . "")
mu4e-headers-thread-connection-prefix '("| " . "| ")
mu4e-headers-thread-blank-prefix '("" . "")
mu4e-headers-thread-orphan-prefix '("" . "")
mu4e-headers-thread-single-orphan-prefix '("" . "")
mu4e-headers-thread-duplicate-prefix '("=" . "="))
(plist-put (cdr (assq 'refile mu4e-marks)) :char "")
(plist-put (cdr (assq 'trash mu4e-marks)) :char "")
(plist-put (cdr (assq 'action mu4e-marks)) :char "")
(plist-put (cdr (assq 'untrash mu4e-marks)) :char "")
(plist-put (cdr (assq 'delete mu4e-marks)) :char "×")
(plist-put (cdr (assq 'flag mu4e-marks)) :char "")
(plist-put (cdr (assq 'unflag mu4e-marks)) :char "")
(plist-put (cdr (assq 'move mu4e-marks)) :char "")
(plist-put (cdr (assq 'tag mu4e-marks)) :char "")
(defun my/mu4e-headers-colorize (item msg)
"Colorize item depending on whe msg was received"
(let* ((recent (* 5 60)) ;; 5 minutes
(now (current-time))
(unread (mu4e-message-field msg :unread))
(date (mu4e-message-field msg :date))
(delta (float-time (time-subtract now date))))
(if (and (< delta recent) unread)
(propertize item 'face 'nano-salient)
item)))
(require 'relative-date)
(defun my/mu4e-headers-date (msg)
(let* ((date (mu4e-message-field msg :date)))
(my/mu4e-headers-colorize
(format "%12s" (relative-date date)) msg)))
(add-to-list 'mu4e-header-info-custom
'(:my/date . (:name "my/date"
:shortname "D"
:function my/mu4e-headers-date)))(defun my/mu4e-headers-from (msg)
(let* ((from (my/mu4e-get-sender msg))
(meta (when msg (mu4e-message-field msg :meta)))
(root (when meta (plist-get meta :root)))
(orphan (when meta (plist-get meta :orphan)))
(first-child (when meta (plist-get meta :first-child)))
(has-child (when meta (plist-get meta :has-child)))
(root (when meta (plist-get meta :root)))
(from (cond ((and root has-child) (concat " " from))
((and orphan first-child) (concat " " from))
((and root (not has-child)) (concat "" from))
(t (concat "│ " from)))))
(my/mu4e-headers-colorize from msg)))
(add-to-list 'mu4e-header-info-custom
'(:my/from . (:name "my/from"
:shortname "F"
:function my/mu4e-headers-from)))
(defun my/mu4e-headers-flags (msg)
(let* ((size (mu4e-message-field msg :size))
(flags (cond ((memq 'flagged (mu4e-message-field msg :flags)) "")
((and (> size 256000)
(memq 'attach (mu4e-message-field msg :flags))) "")
((memq 'replied (mu4e-message-field msg :flags)) "")
((memq 'draft (mu4e-message-field msg :flags)) "")
((memq 'trashed (mu4e-message-field msg :flags)) "")
((memq 'encrypted (mu4e-message-field msg :flags)) "")
(t ""))))
(my/mu4e-headers-colorize flags msg)))
(add-to-list 'mu4e-header-info-custom
'(:my/flags . (:name "my/flags"
:shortname "F"
:function my/mu4e-headers-flags)))
(defface mu4e-tag-face
'((t :inherit (nano-popout nano-strong)))
"Face for message tags"
:group 'mu4e-faces)
(defun my/mu4e-headers-tags (msg)
(let* ((tags (mu4e-message-field msg :tags)))
(if tags
(propertize (format "[%s]" (mapconcat #'identity tags ","))
'face 'mu4e-tag-face)
"")))
(add-to-list 'mu4e-header-info-custom
'(:my/tags . (:name "my/tags"
:shortname "T"
:function my/mu4e-headers-tags)))
This is an empty info field (4 non-breaking spaces) that will be overwritten by folding mode.
(defun my/mu4e-headers-thread-counter (msg)
" ") ;; NON-BREAKING spaces
(add-to-list 'mu4e-header-info-custom
'(:my/counter . (:name "my/counter"
:shortname "#"
:function my/mu4e-headers-thread-counter)))(defun my/mu4e-headers-subject (msg)
(let* ((thread (mu4e-message-field msg :meta))
(prefix (mu4e~headers-thread-prefix thread))
(subject (mu4e-message-field msg :subject))
(subject (concat prefix subject " " (my/mu4e-headers-tags msg))))
(my/mu4e-headers-colorize subject msg)))
(add-to-list 'mu4e-header-info-custom
'(:my/subject . (:name "my/subject"
:shortname "S"
:function my/mu4e-headers-subject)))
(require 'mu4e-folding)
;; (defun mu4e-folding--make-root-overlay (beg end)
;; "Create the root overlay."
;; (let* ((buffer-read-only)
;; (overlay (car (mu4e-folding--children-overlay)))
;; (count (if overlay
;; (overlay-get overlay 'mu4e-folding-children-count)
;; 0)))
;; (save-excursion
;; (goto-char beg)
;; (when (search-forward "" end t)
;; (put-text-property (- (point) 1) (point)
;; 'display (svg-lib-tag (format "%d" count) nil
;; :ascent 'center)))))
;; (save-excursion
;; (let* ((match (search-forward " " end t)))
;; (if match
;; (make-overlay (- match 2) end)
;; (make-overlay beg end)))))
;; (defun mu4e-folding--make-root-overlay (beg end)
;; "Create the root overlay."
;; (let* ((buffer-read-only)
;; (overlay (car (mu4e-folding--children-overlay)))
;; (count (if overlay
;; (overlay-get overlay 'mu4e-folding-children-count)
;; 0))
;; (tag (format "%d" count))
;; (tag (svg-lib-tag tag nil
;; :margin (- 4 (length tag))
;; :alignment 1.0
;; )))
;; (save-excursion
;; (goto-char beg)
;; (when (search-forward " " end t)
;; (set-text-properties (- (point) 4) (+ (point) 1)
;; `(display ,tag)))))
;; (let ((buffer-read-only)
;; (overlay (make-overlay beg end)))
;; overlay))
(defun my/mu4e-headers-is-root ()
"Check if message at point is the root of a thread"
(let* ((msg (get-text-property (point) 'msg))
(meta (when msg (mu4e-message-field msg :meta)))
(orphan (when meta (plist-get meta :orphan)))
(first-child (when meta (plist-get meta :first-child)))
(has-child (when meta (plist-get meta :has-child)))
(root (when meta (plist-get meta :root))))
(or root (and orphan first-child))))
;; my/mu4e-headers-is-root
(defun my/mu4e-headers-separate-root ()
(save-excursion
(let ((buffer-read-only))
(goto-char (point-min))
(while (not (eobp))
(when (my/mu4e-headers-is-root)
(goto-char (line-beginning-position))
(unless (or (eq (point) 1)
(and (> (point) (point-min))
(get-text-property (- (point) 1) 'mu4e-separator)))
(insert (propertize "\n"
'mu4e-separator t
'face '(:inherit nano-subtle-i
:strike-through t
:extend t)))))
(forward-line)))))
(add-hook 'mu4e-headers-found-hook #'my/mu4e-headers-separate-root)
A custom multiline headers view for mu4e.
(defun my/mu4e-headers-multiline (msg)
"A multiline headers mode."
(let* ((sender (my/mu4e-get-sender msg))
(date (mu4e-message-field msg :date))
(date (concat (propertize "" 'display " ")
(format "%16s" (my/date-relative date))))
(subject (mu4e-message-field msg :subject))
(subject (truncate-string-to-width subject (- (window-width) 16) nil nil "…"))
(flagged (memq 'flagged (mu4e-message-field msg :flags)))
(attach (memq 'attach (mu4e-message-field msg :flags)))
(unread (memq 'unread (mu4e-message-field msg :flags)))
(replied (memq 'replied (mu4e-message-field msg :flags)))
(encrypted (memq 'encrypted (mu4e-message-field msg :flags)))
(draft (memq 'draft (mu4e-message-field msg :flags)))
(thread (mu4e-message-field msg :meta))
(related (and thread (plist-get thread :related)))
(prefix (mu4e~headers-thread-prefix thread))
(root (plist-get thread :root))
(orphan (plist-get thread :orphan))
(first-child (plist-get thread :first-child))
(has-child (plist-get thread :has-child))
(level (plist-get thread :level))
(root (or root (and orphan (or first-child has-child))))
(child (and thread (not root)))
(tags (mu4e-message-field msg :tags))
(unread-mark (propertize (cond (unread (propertize " ●" 'face 'nano-salient))
((and root has-child) " ")
(t " "))))
(one-line (and child mu4e-headers-include-related))
(face-sender (cond (unread '(nano-salient nano-strong))
((and root related) '(nano-strong nano-faded))
(root '(nano-strong nano-default))
((and child related) '(:inherit nano-faded :height 140))
(child '(:inherit nano-default :height 140))
(t '(nano-default))))
(face-subject (cond (unread '(:inherit nano-salient))
(related '(:inherit nano-faded))
(t '(:inherit nano-default))))
(face-tags (cond (related '(:inherit (nano-faded) :height 120))
(t '(:inherit (nano-popout nano-strong) :height 120))))
(face-date (cond (t '(:inherit nano-faded :height 140))))
(icons (string-join
`(,@(if draft `( ,(propertize "" 'face 'nano-faded)))
,@(if attach `( ,(propertize "" 'face 'nano-faded)))
,@(if flagged `( ,(propertize "" 'face 'nano-salient)))
) " ")))
(concat
;; Separaction line between threads
(when root
(concat
(propertize " "
'mu4e-root t
'display `((margin left-margin) " "))
(propertize "-" 'display "\n"
'face '(:extend t
:strike-through t
:inherit nano-subtle-i))
" ")) ;; !! NON-BREAKING SPACE -> will be searched later
;; Children are always indented (relatively to root)
(when (and child one-line)
(concat
(propertize "│" 'face 'nano-faded)))
;; Unread mark appears in the left margin
(propertize " " 'face (if unread 'nano-default face-sender)
'display `((margin left-margin) ,unread-mark))
;; Sender
(cond (one-line (propertize (concat prefix sender)
'face face-sender))
((and root has-child) (propertize (concat " " sender)
'face face-sender))
(t (propertize sender 'face face-sender)))
" "
;; Replied
(when replied
(propertize " " 'face face-sender))
;; In one line mode (children), icons are displayed next to sender
(when one-line
(concat (propertize icons)
" "))
;; Tags next to sender
(when tags
(concat
(propertize " " 'face face-tags)
(mapconcat #'(lambda (tag)
(propertize tag 'face face-tags))
tags (propertize "," 'face face-tags))))
;; Spacing to have date aligned on the right
(propertize " " 'display `(space :align-to (- right 1 ,(* 1.0 (length date)))))
;; Date
(propertize date 'face face-date)
;; When not a child
(when (or root (not mu4e-headers-include-related))
(concat
;; Second line. We use a display property such that hl-line-mode works correctly.
(propertize " " 'display "\n") ;; NON-BREAKING space for later search (see below)
;; Blank spaces in the margin (for nice hl-line-mode)
(propertize " " 'face '(nano-strong nano-salient)
'display `((margin left-margin) " "))
;; Indentation (to compensate for the virtual "\n" we introduced before)
(propertize " ")
;; Align subject and sender when this is a child
(when (and one-line child)
(propertize " " 'face 'nano-faded))
;; Subject
(propertize subject 'face face-subject)
;; Spacing to have icons aligned on the right
(propertize " " 'display `(space :align-to (- right ,(length icons) 1)))
;; Icons on the right
(propertize icons))))))
Then, we redefine thread symbols (we’ll mostly manage ourselves).
(setq mu4e-headers-thread-root-prefix '("" . "")
mu4e-headers-thread-first-child-prefix '(" " . " ")
mu4e-headers-thread-child-prefix '(" " . " ")
mu4e-headers-thread-last-child-prefix '(" " . " ")
mu4e-headers-thread-connection-prefix '(" |" . " ")
mu4e-headers-thread-blank-prefix '("" . "")
mu4e-headers-thread-orphan-prefix '(" " . "")
mu4e-headers-thread-single-orphan-prefix '("" . "")
mu4e-headers-thread-duplicate-prefix '("=" . "="))
And we install the new header.
;; (add-to-list 'mu4e-header-info-custom
;; '(:multiline . (:name "multiline"
;; :shortname ""
;; :function my/mu4e-headers-multiline)))
;; (setq mu4e-headers-fields '((:multiline . nil)))
Because the multiline header view uses margin to show new mail, we have to make sure there are always margin in the headers view. We also make the hl-line more salient.
(defun my/mu4e-headers-mode-setup ()
(with-current-buffer "*mu4e-headers*"
(set-face-attribute 'mu4e-header-highlight-face nil
:inherit 'nano-salient-i)
(setq-local left-margin-width 2)
(setq-local cursor-type nil)
(set-window-buffer nil "*mu4e-headers*")))
(add-hook 'mu4e-headers-found-hook #'my/mu4e-headers-mode-setup)
(add-hook 'mu4e-headers-mode-hook #'my/mu4e-headers-mode-setup)
Since a header can now be displayed over several consecutive lines, we need to remap prev/next line such as to use mu4e prev/next functions (that works properly with multiline headers).
(bind-key [remap next-line] #'mu4e-headers-next mu4e-headers-mode-map)
(bind-key [remap previous-line] #'mu4e-headers-prev mu4e-headers-mode-map)
A special highlight function for root headers that takes the multiline root header into account.
(defun my/mu4e-hl-line-move ()
(save-excursion
(let* ((beg (line-beginning-position))
(end (min (line-beginning-position 2) (point-max)))
(match1 (search-forward " " end t))
(match2 (search-forward "│" end t)))
(goto-char beg)
(cond (match1 (cons (- match1 2) end))
(match2 (cons (+ match2 1) end))
(t (cons beg end))))))
We retrict the hack to mu4e-header-mode
(defun my/mu4e-headers-mode-hl-line-move ()
(setq-local hl-line-range-function #'my/mu4e-hl-line-move))
(add-hook 'mu4e-headers-mode-hook #'my/mu4e-headers-mode-hl-line-move)
A special overlay function for folding that takes the multiline root header into account & insert the number of children at the root level (replacing “” symbol)
(defun mu4e-folding--make-root-overlay (beg end)
"Create the root overlay."
(let* ((buffer-read-only)
(overlay (car (mu4e-folding--children-overlay)))
(count (if overlay
(overlay-get overlay 'mu4e-folding-children-count)
0)))
(save-excursion
(goto-char beg)
(when (search-forward "" end t)
(put-text-property (- (point) 1) (point)
'display (svg-lib-tag (format "%d" count) nil
:ascent 'center)))))
(save-excursion
(let* ((match (search-forward " " end t)))
(if match
(make-overlay (- match 2) end)
(make-overlay beg end)))))
(defun my/mu4e-move-mark-overlay ()
(interactive)
(let* ((beg (line-beginning-position))
(end (line-beginning-position 2))
(overlays (overlays-in beg end)))
(dolist (overlay overlays)
(when (overlay-get overlay 'mu4e-mark)
(move-overlay overlay
(overlay-start overlay)
(+ (overlay-start overlay) 2))))))
Provide a mu4e-dashboard command that opens the mu4e dashboard on the left side.
(require 'mu4e-dashboard)
(require 'svg-lib)
(setq mu4e-dashboard-propagate-keymap nil)
(defun mu4e-dashboard ()
"Open the mu4e dashboard on the left side."
(interactive)
(with-selected-window
(split-window (selected-window) -34 'left)
(find-file (expand-file-name "mu4e-dashboard.org" user-emacs-directory))
(mu4e-dashboard-mode)
(hl-line-mode)
(set-window-dedicated-p nil t)
(defvar svg-font-lock-keywords
`(("\\!\\([\\ 0-9]+\\)\\!"
(0 (list 'face nil 'display (svg-font-lock-tag (match-string 1)))))))
(defun svg-font-lock-tag (label)
(svg-lib-tag label nil
:stroke 0 :margin 1 :font-weight 'bold
:padding (max 0 (- 3 (length label)))
:foreground (face-foreground 'nano-popout-i)
:background (face-background 'nano-popout-i)))
(push 'display font-lock-extra-managed-props)
(font-lock-add-keywords nil svg-font-lock-keywords)
(font-lock-flush (point-min) (point-max))))
(my/report-time "Mail")
Settings for bibtex
(setq bibtex-autokey-titleword-length 0
bibtex-autokey-name-year-separator ":"
bibtex-autokey-name-case-convert-function 'capitalize
bibtex-autokey-year-length 4
bibtex-autokey-names 1
bibtex-autokey-titleword-separator ""
bibtex-autokey-year-title-separator ""
bibtex-autokey-edit-before-use nil
imenu-list-position 'left
imenu-list-size 100
org-imenu-depth 2
org-image-actual-width `( ,(truncate (* (frame-pixel-width) 0.85)))
org-startup-with-inline-images t)Dedicated header line for org-bib-mode
(defun my/org-bib-mode-hook ()
(with-current-buffer "*Ilist*"
(setq header-line-format
'(:eval
(nano-modeline-render nil
(buffer-name imenu-list--displayed-buffer)
(format "(view mode: %s, filter: %s)"
(if (eq org-bib--view-mode-current 'none)
"-"
org-bib--view-mode-current)
(if (eq org-imenu-filter-string "*")
"-"
org-imenu-filter-string))
"")))
(face-remap-add-relative 'hl-line :inherit 'nano-strong-i)))
(add-hook 'org-bib-mode-hook #'my/org-bib-mode-hook)
A shortcut to edit bibliography
(defun my/biblio ()
"Create a new frame for editing bibliography"
(interactive)
(require 'org-bib)
(setq imenu-list-position 'left
imenu-list-size 100
org-imenu-depth 2)
(select-frame (make-frame '((name . "my/biblio")
(width . 180)
(height . 45))))
(find-file "~/Documents/Papers/papers.org")
(org-bib-mode))
An autoload function for my/config (that will load org mode).
(autoload 'my/biblio
(expand-file-name "init.el" user-emacs-directory)
"Autoloaded my/config command."
t)
(setq my/section-start-time (current-time))
(setq-default org-directory "~/Documents/org"
org-ellipsis " …" ; Nicer ellipsis
org-tags-column 1 ; Tags next to header title
org-hide-emphasis-markers t ; Hide markers
org-cycle-separator-lines 2 ; Number of empty lines between sections
org-use-tag-inheritance nil ; Tags ARE NOT inherited
org-use-property-inheritance t ; Properties ARE inherited
org-indent-indentation-per-level 2 ; Indentation per level
org-link-use-indirect-buffer-for-internals t ; Indirect buffer for internal links
org-fontify-quote-and-verse-blocks t ; Specific face for quote and verse blocks
org-return-follows-link nil ; Follow links when hitting return
org-image-actual-width nil ; Resize image to window width
org-indirect-buffer-display 'other-window ; Tab on a task expand it in a new window
org-outline-path-complete-in-steps nil) ; No steps in path display
Better latex preview (see https://stackoverflow.com/questions/30151338)
(setq org-latex-create-formula-image-program 'dvisvgm)
We adapt fill functions according to the indent level.
(defun my/calc-offset-on-org-level ()
"Calculate offset (in chars) on current level in org mode file."
(* (or (org-current-level) 0) org-indent-indentation-per-level))
(defun my/org-fill-paragraph (&optional justify region)
"Calculate apt fill-column value and fill paragraph."
(let* ((fill-column (- fill-column (my/calc-offset-on-org-level))))
(org-fill-paragraph justify region)))
(defun my/org-auto-fill-function ()
"Calculate apt fill-column value and do auto-fill"
(let* ((fill-column (- fill-column (my/calc-offset-on-org-level))))
(org-auto-fill-function)))
(defun my/org-mode-hook ()
(setq fill-paragraph-function #'my/org-fill-paragraph
normal-auto-fill-function #'my/org-auto-fill-function))
(add-hook 'org-load-hook 'my/org-mode-hook)
(add-hook 'org-mode-hook 'my/org-mode-hook)
A shortcut for emacs-lisp source blocks. Type “<S” (in org-mode) then press tab.
(require 'org-tempo)
(add-to-list 'org-structure-template-alist
'("S" . "src emacs-lisp"))
(setq-default org-src-fontify-natively t ; Fontify code in code blocks.
org-adapt-indentation nil ; Adaptive indentation
org-src-tab-acts-natively t ; Tab acts as in source editing
org-confirm-babel-evaluate nil ; No confirmation before executing code
org-edit-src-content-indentation 0 ; No relative indentation for code blocks
org-fontify-whole-block-delimiter-line t) ; Fontify whole block
(my/report-time "Org")
(setq my/section-start-time (current-time))
Load libraries.
(require 'org-agenda)
(require 'org-agenda-property)
Open agenda(s)
(bind-key "C-c a" #'org-agenda)
Files
(setq org-agenda-files (list "~/Documents/org/agenda.org"
"~/Documents/org/students.org"
"~/Documents/org/todo.org"
"~/Documents/org/inbox.org")
org-agenda-diary-file (expand-file-name "diary" user-emacs-directory))
Settings
(setq org-agenda-window-setup 'current-window
org-agenda-restore-windows-after-quit t
org-agenda-show-all-dates nil
org-agenda-time-in-grid t
org-agenda-show-current-time-in-grid t
org-agenda-start-on-weekday 1
org-agenda-span 7
org-agenda-hide-tags-regexp "." ; No tags
; org-agenda-hide-tags-regexp nil) ; All tags
org-agenda-tags-column 0
; org-agenda-tags-column -79) ; Left aling
org-agenda-block-separator nil
org-agenda-category-icon-alist nil
org-agenda-skip-deadline-if-done t
org-agenda-skip-scheduled-if-done t
org-agenda-sticky t)
Prefix format
(setq org-agenda-prefix-format
'((agenda . "%i %?-12t%s")
(todo . "%i")
(tags . "%i")
(search . "%i")))
Sorting strategy
(setq org-agenda-sorting-strategy
'((agenda deadline-down scheduled-down todo-state-up time-up
habit-down priority-down category-keep)
(todo priority-down category-keep)
(tags timestamp-up priority-down category-keep)
(search category-keep)))
Minimal time grid
(setq org-agenda-time-grid
'((daily today require-timed)
()
"......" "----------------"))
(setq org-agenda-current-time-string " now")
A small function to cancel a meeting
(defun my/org-cancel-meeting ()
(interactive)
(org-entry-put (point) "CATEGORY" "cancelled")
(org-entry-put (point) "NOTE" "Cancelled")
(org-set-tags ":CANCELLED:"))
(require 'cal-iso)
(require 'holidays)
(defvar french-holidays nil
"French holidays")
(setq french-holidays
`((holiday-fixed 1 1 "New year's Day")
(holiday-fixed 5 1 "Labour Day")
(holiday-fixed 5 8 "Victory in Europe Day")
(holiday-fixed 7 14 "Bastille day")
(holiday-fixed 8 15 "Assumption of Mary")
(holiday-fixed 11 11 "Armistice 1918")
(holiday-fixed 11 1 "All Saints' Day")
(holiday-fixed 12 25 "Christmas Day")
(holiday-easter-etc 0 "Easter Sunday")
(holiday-easter-etc 1 "Easter Monday")
(holiday-easter-etc 39 "Ascension Day")
(holiday-easter-etc 50 "Whit Monday")
(holiday-sexp
'(if (equal
(holiday-easter-etc 49)
(holiday-float 5 0 -1 nil))
(car (car (holiday-float 6 0 1 nil)))
(car (car (holiday-float 5 0 -1 nil))))
"Mother's Day")))
(setq calendar-holidays french-holidays ; French holidays
calendar-week-start-day 1 ; Week starts on Monday
calendar-mark-diary-entries-flag nil) ; Do not show diary entries
; Mark today in calendar
(add-hook 'calendar-today-visible-hook #'calendar-mark-today)
Week day name with holidays
(defun my/org-agenda-format-date (date)
"Org agenda date format displaying holidays"
(let* ((dayname (calendar-day-name date))
(day (cadr date))
(month (car date))
(monthname (calendar-month-name month))
(year (nth 2 date))
(holidays (calendar-check-holidays date)))
(concat "\n"
dayname " "
(format "%d " day)
monthname " "
(format "%d" year)
(if holidays (format " (%s)" (nth 0 holidays)))
"\n")))
(setq org-agenda-format-date #'my/org-agenda-format-date)
The daily agenda
(add-to-list 'org-agenda-custom-commands
'("a" "Agenda"
((agenda "Agenda"
((org-agenda-todo-keyword-format "%s")
(org-agenda-skip-deadline-if-done nil)
(org-deadline-warning-days 3)
(org-agenda-overriding-header nil))))))
Some decorations for the agenda
(defun my/org-agenda-highlight-todo (x)
(let* ((done (string-match-p (regexp-quote ":DONE:") x))
(canceled (string-match-p (regexp-quote "~") x))
(x (replace-regexp-in-string ":TODO:" "" x))
(x (replace-regexp-in-string ":DONE:" "" x))
(x (replace-regexp-in-string "~" "" x))
(x (if (and (boundp 'org-agenda-dim) org-agenda-dim)
(propertize x 'face 'nano-faded) x))
(x (if done (propertize x 'face 'nano-faded) x))
(x (if canceled (propertize x 'face 'nano-faded) x)))
x))
(advice-add 'org-agenda-highlight-todo
:filter-return #'my/org-agenda-highlight-todo)
Timestamp tags for the agenda (bold means inverse video below):
now -> now 9:00 -> 9h00 9:30-10:00 -> 9h30 | 30mn -> ANYTIME
(require 'svg-lib)
(require 'svg-tag-mode)
(defun my/svg-tag-timestamp (&rest args)
"Create a timestamp SVG tag for the time at point."
(interactive)
(let ((inhibit-read-only t))
(goto-char (point-min))
(while (search-forward-regexp
"\\(\([0-9]/[0-9]\):\\)" nil t)
(set-text-properties (match-beginning 1) (match-end 1)
`(display ,(svg-tag-make "ANYTIME"
:face 'nano-faded
:inverse nil
:padding 3 :alignment 0))))
(goto-char (point-min))
(while (search-forward-regexp
"\\([0-9]+:[0-9]+\\)\\(\\.+\\)" nil t)
(set-text-properties (match-beginning 1) (match-end 2)
`(display ,(svg-tag-make (match-string 1)
:face 'nano-faded
:margin 4 :alignment 0))))
(goto-char (point-min))
(while (search-forward-regexp
"\\([0-9]+:[0-9]+\\)\\(\\.*\\)" nil t)
(set-text-properties (match-beginning 1) (match-end 2)
`(display ,(svg-tag-make (match-string 1)
:face 'nano-default
:inverse t
:margin 4 :alignment 0))))
(goto-char (point-min))
(while (search-forward-regexp
"\\([0-9]+:[0-9]+\\)\\(-[0-9]+:[0-9]+\\)" nil t)
(let* ((t1 (parse-time-string (match-string 1)))
(t2 (parse-time-string (substring (match-string 2) 1)))
(t1 (+ (* (nth 2 t1) 60) (nth 1 t1)))
(t2 (+ (* (nth 2 t2) 60) (nth 1 t2)))
(d (- t2 t1)))
(set-text-properties (match-beginning 1) (match-end 1)
`(display ,(svg-tag-make (match-string 1)
:face 'nano-faded
:crop-right t)))
;; 15m: ¼, 30m:½, 45m:¾
(if (< d 60)
(set-text-properties (match-beginning 2) (match-end 2)
`(display ,(svg-tag-make (format "%2dm" d)
:face 'nano-faded
:crop-left t :inverse t)))
(set-text-properties (match-beginning 2) (match-end 2)
`(display ,(svg-tag-make (format "%1dH" (/ d 60))
:face 'nano-faded
:crop-left t :inverse t
:padding 2 :alignment 0))))))))
(add-hook 'org-agenda-mode-hook #'my/svg-tag-timestamp)
(advice-add 'org-agenda-redo :after #'my/svg-tag-timestamp)
A custom date format function using svg tags (progress pies) for the task agenda.
(defun my/org-agenda-custom-date ()
(interactive)
(let* ((timestamp (org-entry-get nil "TIMESTAMP"))
(timestamp (or timestamp (org-entry-get nil "DEADLINE"))))
(if timestamp
(let* ((delta (- (org-time-string-to-absolute (org-read-date nil nil timestamp))
(org-time-string-to-absolute (org-read-date nil nil ""))))
(delta (/ (+ 1 delta) 30.0))
(face (cond ;; ((< delta 0.25) 'nano-popout)
;; ((< delta 0.50) 'nano-salient)
((< delta 1.00) 'nano-default)
(t 'nano-faded))))
(concat
(propertize " " 'face nil
'display (svg-lib-progress-pie
delta nil
:background (face-background face nil 'default)
:foreground (face-foreground face)
:margin 0 :stroke 2 :padding 1))
" "
(propertize
(format-time-string "%d/%m" (org-time-string-to-time timestamp))
'face 'nano-popout)))
" ")))
The task agenda
(add-to-list 'org-agenda-custom-commands
'("x" "Tasks"
((todo "TODO" ;; "PROJECT"
( (org-agenda-todo-keyword-format ":%s:")
(org-agenda-prefix-format '((todo . " ")))
(org-agenda-skip-function '(org-agenda-skip-entry-if 'timestamp))
(org-agenda-overriding-header (propertize " Todo \n" 'face 'nano-strong))))
(tags "+TALK+TIMESTAMP>=\"<now>\""
((org-agenda-span 90)
(org-agenda-max-tags 5)
(org-agenda-prefix-format '((tags . " %(my/org-agenda-custom-date) ")))
(org-agenda-overriding-header "\n Upcoming talks\n")))
(tags "TEACHING+TIMESTAMP>=\"<now>\""
((org-agenda-span 90)
(org-agenda-max-tags 5)
(org-agenda-prefix-format '((tags . " %(my/org-agenda-custom-date) ")))
(org-agenda-overriding-header "\n Upcoming lessons\n")))
(tags "TRAVEL+TIMESTAMP>=\"<now>\""
((org-agenda-span 90)
(org-agenda-max-tags 5)
(org-agenda-prefix-format '((tags . " %(my/org-agenda-custom-date) ")))
(org-agenda-overriding-header "\n Upcoming travels\n")))
(tags "DEADLINE>=\"<today>\""
((org-agenda-span 90)
(org-agenda-max-tags 5)
(org-agenda-prefix-format '((tags . " %(my/org-agenda-custom-date) ")))
(org-agenda-overriding-header "\n Upcoming deadlines\n"))))))
We install a time to refresh the daily agenda (a) at regular intervals such that the current time is up to date.
(defvar my/org-agenda-update-delay 60)
(defvar my/org-agenda-update-timer nil)
(defun my/org-agenda-update ()
"Refresh daily agenda view"
(when my/org-agenda-update-timer
(cancel-timer my/org-agenda-update-timer))
(let ((window (get-buffer-window "*Org Agenda(a)*" t)))
(when window
(with-selected-window window
(let ((inhibit-message t))
(org-agenda-redo)))))
(setq my/org-agenda-update-timer
(run-with-idle-timer
(time-add (current-idle-time) my/org-agenda-update-delay)
nil
'my/org-agenda-update)))
(run-with-idle-timer my/org-agenda-update-delay t 'my/org-agenda-update)
Set refile targets according to my setup
(setq org-outline-path-complete-in-steps nil)
(setq org-refile-use-outline-path nil)
(setq org-refile-targets
'(
("~/Documents/org/agenda.org" :maxlevel . 2)
("~/Documents/org/inbox.org" :maxlevel . 1)
;; ("~/Documents/org/organizer.org" :tag . "tasks")
;; ("~/Documents/org/organizer.org" :tag . "notes")
;; ("~/Documents/org/organizer.org" :tag . "mails")
;; ("~/Documents/org/organizer.org" :tag . "meetings")
;;("~/Documents/org/archives.org" :maxlevel . 1)
))
(setq org-capture-templates
'(("i" "Inbox" entry (file "inbox.org")
"* TODO %?Task :INBOX:\n")
("m" "Meeting" entry (file+headline "agenda.org" "Future")
"* %?Meeting <%<%Y-%m-%d %a 12:00-13:00>>"
:empty-lines-after 1)))
Assign key
(bind-key "C-c c" #'org-capture)
(defun my/org-capture-meeting ()
(interactive)
(org-capture nil "m"))
(bind-key "C-c m" #'my/org-capture-meeting)
(defun my/org-capture-inbox ()
(interactive)
(org-capture nil "i"))
(bind-key "C-c i" #'my/org-capture-inbox)
Here we orverwrite the org-capture-place-template to have the capture window below the current one. There must be a better way to do that but I did not find it yet. Since we are in org-agenda deferred mode, we need to cancel epiloque/prologue.
(with-eval-after-load 'org-capture
(defun org-capture-place-template (&optional inhibit-wconf-store)
"Insert the template at the target location, and display the buffer.
when `inhibit-wconf-store', don't store the window configuration, as it
may have been stored before."
(unless inhibit-wconf-store
(org-capture-put :return-to-wconf (current-window-configuration)))
;; (delete-other-windows)
;; (org-switch-to-buffer-other-window
;; (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
(select-window (split-window-below -6))
(switch-to-buffer
(org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
(widen)
(org-show-all)
(goto-char (org-capture-get :pos))
(setq-local outline-level 'org-outline-level)
(pcase (org-capture-get :type)
((or `nil `entry) (org-capture-place-entry))
(`table-line (org-capture-place-table-line))
(`plain (org-capture-place-plain-text))
(`item (org-capture-place-item))
(`checkitem (org-capture-place-item)))
(setq-local org-capture-current-plist org-capture-plist)
(org-capture-mode 1)))
(defun my/org-capture-frame (orig-fun &optional goto keys)
(if (not (org-capture-get :description))
(funcall orig-fun goto keys))
(progn
(select-frame (my/mini-frame 8))
(let ((split-width-threshold nil)
(split-height-threshold 0))
(funcall orig-fun goto keys))
(delete-other-windows)
(setq word-wrap nil)
(setq truncate-lines nil)
(nano-modeline--update-selected-window)
(let* ((left (concat (propertize " "
'face '(nano-subtle)
'display '(raise +0.20))
(propertize " Capture"
'face '(nano-strong nano-subtle))
(propertize " "
'face 'nano-subtle
'display '(raise -0.30))
(propertize (org-capture-get :description)
'face 'nano-default)))
(right (propertize "C-c C-c: capture, C-c C-k: abort "
'face '(:inherit (nano-faded nano-subtle)
:weight light)))
(spacer (propertize (make-string (- (window-width)
(length left)
(length right)
0) ?\ )
'face 'nano-subtle))
(header (concat left spacer right " ")))
(setq-local header-line-format header))
(set-window-dedicated-p nil t)
(set-frame-parameter (selected-frame) 'height 5)
(face-remap-add-relative 'mode-line :background (face-background 'highlight))
(save-excursion
(goto-char (point-min))
(let ((overlay (make-overlay
(line-beginning-position) (line-end-position))))
(overlay-put overlay 'display '(raise -0.5))))))
(defun my/org-capture (goto key)
(interactive)
(unwind-protect
(progn
(advice-add 'org-capture :around #'my/org-capture-frame)
(org-capture goto key))
(advice-remove 'org-capture #'my/org-capture-frame)))
(require 'org-capture)
;; (bind-key "C-c m" #'(lambda ()
;; (interactive)
;; (my/org-capture nil "m")))
;; (bind-key "C-c i" #'(lambda ()
;; (interactive)
;; (my/org-capture nil "i")))
;; (bind-key "C-g" #'org-capture-kill 'org-capture-mode-map)
The default org-agenda-goto, which is used when tab key is pressed or when follow mode (F) is active open a window at a non specific place. Here, we make sure the window is opened where we want. In this case, this is below the agenda window.
(defun my/org-agenda-goto (buffer args)
"Open a headline in a window below the current window"
(setq-local mode-line-format nil)
(select-window (or (window-in-direction 'below (selected-window))
(split-window nil -6 'below)))
(switch-to-buffer buffer)
(setq-local header-line-format
'((:eval
(let ((nano-modeline-prefix 'none)
(nano-modeline-prefix-padding 0)
(outline-path (org-with-point-at (org-get-at-bol'org-marker)
(org-display-outline-path nil nil " » " t))))
(nano-modeline-render
""
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer)))
(format "/ %s" (substring-no-properties outline-path))
"")))))
(selected-window))
Install the new function as an advice around org-agenda-goto and apply a narrow to subtree after
(define-advice org-agenda-goto (:around (orig-fn &rest args) "my/org-agenda-goto")
(let ((display-buffer-overriding-action '(my/org-agenda-goto)))
(apply orig-fn args)
(org-narrow-to-subtree)))
Finally, we disable org-agenda-show-outline-path since this is now redundant with the header line.
(setq org-agenda-show-outline-path nil)
(bind-key "C-c n" #'nano-agenda)
(my/report-time "Agenda")
(setq my/section-start-time (current-time))
Prevent magit from writing in the header line.
(advice-add 'magit-set-header-line-format :override #'ignore)
Add fringe on the left side of magit windows such that we can highlight region using the fringe.
(add-hook 'magit-mode-setup-hook
#'(lambda ()
(interactive)
(set-window-fringes nil (* 2 (window-font-width)) 0)))
(my/report-time "Versioning")
(setq my/section-start-time (current-time))
Alternative print entry function using svg-tag-mode.
(require 'elfeed)
(require 'svg-tag-mode)
(defun my/elfeed-search-print-entry (entry)
"Alternative printing of elfeed entries using SVG tags."
(let* ((date (elfeed-search-format-date (elfeed-entry-date entry)))
(title (or (elfeed-meta entry :title)
(elfeed-entry-title entry) ""))
(unread (member 'unread (elfeed-entry-tags entry)))
(feed (elfeed-entry-feed entry))
(feed-title (when feed
(or (elfeed-meta feed :title)
(elfeed-feed-title feed))))
(title-face (if unread 'nano-default 'nano-faded))
(date-face (if unread 'nano-salient 'nano-faded))
(feed-title-face (if unread 'nano-strong '(nano-strong nano-faded)))
(tag-face (if unread 'nano-popout 'nano-faded))
(tags (mapcar #'symbol-name (elfeed-entry-tags entry)))
(tags (delete "unread" tags))
(tags-svg (mapconcat
(lambda (s)
(propertize (concat (upcase s) " ")
'display (svg-tag-make (upcase s)
:margin 0
:padding 1
:inverse 1
:face tag-face)))
tags " "))
(left (concat
(when feed-title
(propertize feed-title 'face feed-title-face))
" " tags-svg " "
(propertize title 'face title-face 'kbd-help title)))
(right (propertize date 'face date-face)))
(insert (my/string-join -1 left right))))
Elfeed setup.
(setq elfeed-search-title-max-width 80 ; Maximum titles width
elfeed-search-title-min-width 40 ; Minimum titles width
elfeed-search-trailing-width 24 ; Space reserved for feed & tag
elfeed-search-filter ; Default filter
"@1-weeks-ago +unread"
elfeed-search-print-entry-function ; Alternative print function
#'my/elfeed-search-print-entry)
; Bind "U" to update feeds on main screen
(bind-key "U" #'elfeed-update elfeed-search-mode-map)
Hook on elfeed main screen (hl-line mode).
(defun my/elfeed-search-mode-hook ()
(hl-line-mode t)
(face-remap-add-relative 'hl-line :inherit 'nano-subtle)
(set-window-fringes nil 0 1) ; One pixel right fringe to avoid ellipsis
(setq cursor-type nil))
(add-hook 'elfeed-search-mode-hook #'my/elfeed-search-mode-hook)
Hook on elfeed post screen (visual mode).
(defun my/elfeed-show-mode-hook ()
(visual-line-mode)
;; (setq truncate-lines t)
(let ((inhibit-read-only t)
(inhibit-modification-hooks t))
(setq-local truncate-lines nil)
(setq-local shr-width 79)
(set-buffer-modified-p nil)))
(add-hook 'elfeed-show-mode-hook #'my/elfeed-show-mode-hook)
Setup bookmarlks (elfeed.org) using elfeed-org. It is important to load it after elfeed such as to not load org immediately.
(with-eval-after-load 'elfeed
(require 'elfeed-org)
(setq rmh-elfeed-org-files (list (expand-file-name "elfeed.org" user-emacs-directory)))
(elfeed-org))
(my/report-time "News")
(setq my/section-start-time (current-time))
Samplet configuration from https://protesilaos.com/emacs/denote
(require 'denote)
;; Remember to check the doc strings of those variables.
(setq denote-directory (expand-file-name "~/Documents/Denote/"))
(setq denote-known-keywords
'("emacs" "research" "visualization"))
(setq denote-infer-keywords t)
(setq denote-sort-keywords t)
(setq denote-file-type nil) ; Org is the default, set others here
;; We allow multi-word keywords by default. The author's personal
;; preference is for single-word keywords for a more rigid workflow.
(setq denote-allow-multi-word-keywords t)
(setq denote-front-matter-date-format nil) ; change this to `org-timestamp' or custom string
;; You will not need to `require' all those individually once the
;; package is available.
(require 'denote-retrieve)
(require 'denote-link)
(require 'denote-dired)
(setq denote-dired-rename-expert nil)
;; We use different ways to specify a path for demo purposes.
(setq denote-dired-directories
(list denote-directory
(thread-last denote-directory (expand-file-name "attachments"))
(expand-file-name "~/Documents/vlog")))
;; Generic:
;; (add-hook 'dired-mode-hook #'denote-dired-mode)
;;
;; OR better:
(add-hook 'dired-mode-hook #'denote-dired-mode-in-directories)
;; Here is a custom, user-level command from one of the examples we
;; showed in this manual. We define it here and add it to a key binding
;; below.
(defun my/denote-journal ()
"Create an entry tagged 'journal', while prompting for a title."
(interactive)
(denote
(denote--title-prompt)
"journal"))
;; Denote does not define any key bindings. This is for the user to
;; decide. For example:
(let ((map global-map))
(define-key map (kbd "C-c n j") #'my/denote-journal) ; our custom command
(define-key map (kbd "C-c n n") #'denote)
(define-key map (kbd "C-c n N") #'denote-type)
(define-key map (kbd "C-c n d") #'denote-date)
;; If you intend to use Denote with a variety of file types, it is
;; easier to bind the link-related commands to the `global-map', as
;; shown here. Otherwise follow the same pattern for `org-mode-map',
;; `markdown-mode-map', and/or `text-mode-map'.
(define-key map (kbd "C-c n i") #'denote-link) ; "insert" mnemonic
(define-key map (kbd "C-c n I") #'denote-link-add-links)
(define-key map (kbd "C-c n l") #'denote-link-find-file) ; "list" links
(define-key map (kbd "C-c n b") #'denote-link-backlinks)
;; Note that `denote-dired-rename-file' can work from any context, not
;; just Dired bufffers. That is why we bind it here to the
;; `global-map'.
(define-key map (kbd "C-c n r") #'denote-dired-rename-file))
(with-eval-after-load 'org-capture
(require 'denote-org-capture)
(setq denote-org-capture-specifiers "%l\n%i\n%?")
(add-to-list 'org-capture-templates
'("n" "New note (with denote.el)" plain
(file denote-last-path)
#'denote-org-capture
:no-save t
:immediate-finish nil
:kill-buffer t
:jump-to-captured t)))
(my/report-time "Notes")
(setq my/section-start-time (current-time))
Deft setup
(setq deft-default-extension "org"
deft-extensions '("org")
deft-recursive nil
deft-use-filename-as-title nil
deft-use-filter-string-for-filename t
deft-file-naming-rules '((noslash . "-")
(nospace . "-")
(case-fn . downcase))
deft-separator " "
deft-time-format " %d %b %Y")
Rewrite the deft-print-header function to get rid of “Deft\n”
(defun deft-print-header ()
(force-mode-line-update))
Bug fix (see jrblevin/deft#73)
(defun org-open-file-with-emacs (path)
(org-open-file path t))
A small bugfix for header that are too long by one character.
(defun deft-setup ()
(face-remap-add-relative 'hl-line :inherit 'nano-salient-i)
(set-window-fringes nil 0 1)
(set-default 'truncate-lines t))
(add-hook 'deft-mode-hook #'deft-setup)
(defun my/deft-parse-summary (orig-fun contents title)
"Filter deft summary in order to extract the first dot
terminated sentence and add tags if any."
(let ((summary (apply orig-fun (list contents title)))
(tags nil))
(when (and (stringp contents)
(string-match "#\\+TAGS:\\(.*\\)$" contents))
(setq tags (split-string (string-trim (match-string 1 contents))
"[ ,]")))
(if (and (stringp summary)
(string-match "\\(.*?\\)\\. " summary))
(concat
(when tags
(concat (propertize (car tags)
'display (svg-tag-make (car tags)
:face 'nano-popout
:inverse t))
" "))
(match-string 1 summary))
summary)))
(advice-add 'deft-parse-summary :around #'my/deft-parse-summary)
(defun deft-note-toggle-keywords ()
"Toggle visibility of all keywords."
(interactive)
(save-excursion
(goto-char (point-min))
(re-search-forward "^\\(#\\+.*\\)$" nil t)
(if (get-text-property (match-beginning 1) 'display)
(deft-note-show-keywords)
(deft-note-hide-keywords))))
(defun deft-note-hide-keywords ()
"Hide all keywords."
(interactive)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\(#\\+.*\\)$" nil t)
;; (message (format "Hiding keyword %s" (match-string 1)))
(put-text-property
(match-beginning 1) (+ (match-end 1) 1) 'display ""))))
(defun deft-note-show-keywords ()
"Show all keywords."
(interactive)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\(#\\+.*\\)$" nil t)
;; (message (format "Showing keyword %s" (match-string 1)))
(remove-text-properties
(match-beginning 1) (+ (match-end 1) 1) '(display)))))
(defun deft-note-get-keyword (keyword)
"Get the value of a KEYWORD"
(interactive)
(let ((case-fold-search t)
(re (format "^#\\+%s:[ \t]+\\([^\t\n]+\\)" keyword)))
(if (save-excursion (or (re-search-forward re nil t)
(re-search-backward re nil t)))
(substring-no-properties (match-string 1)))))
(defun deft-note-set-keyword (keyword value)
"Set the VALUE of KEYWORD, creates it if absent."
(interactive)
(save-excursion
(goto-char (point-min))
(if (deft-note-get-keyword keyword)
(replace-match value t nil nil 1)
(insert (format "#+%s: %s\n" keyword value)))))
Setup note modes and ask for a title if the file does not exist
(defun my/deft-open-file ()
"Setup note modes and ask for a title if the file does not exist."
(when (= (buffer-size (current-buffer)) 0)
(setq title (read-from-minibuffer "Note title: "))
(deft-note-set-keyword "DATE" (format-time-string "[%Y-%m-%d %a]"))
(deft-note-set-keyword "TITLE" (if (> (length title) 0)
title
"New note"))
(org-mode)
(org-indent-mode)
(visual-line-mode)))
(add-hook 'deft-open-file-hook 'my/deft-open-file)
(my/report-time "Notes")
(setq my/section-start-time (current-time))
Set default shell (zsh)
(setq-default shell-file-name "/bin/zsh"
explicit-shell-file-name "/bin/zsh")
Make sure our environment variables are set properly
;; (require 'exec-path-from-shell)
;; (exec-path-from-shell-copy-envs '("LANG" "LC_ALL" "LC_CTYPES"))
Kill term buffer when exiting.
(defun my/term-handle-exit (&optional proc msg)
"Kill term buffer (advice)."
(message "%s | %s" proc msg)
(kill-buffer (current-buffer)))
(advice-add 'term-handle-exit :after 'my/term-handle-exit)
Open an iterm (OSX) and go to the curent directory
(defun my/iterm-here ()
(interactive)
(shell-command "open -a iTerm $PWD" nil nil))
(my/report-time "System")
(let ((init-time (float-time (time-subtract (current-time) my/init-start-time)))
(total-time (string-to-number (emacs-init-time "%f"))))
(message "---------------------------------------------------------------")
(message "Initialization time: %.2fs (+ %.2f system time)"
init-time (- total-time init-time)))
(message "---------------------------------------------------------------")