diff --git a/.emacs.d/init.el b/.emacs.d/init.el index 6b90738..a438c07 100755 --- a/.emacs.d/init.el +++ b/.emacs.d/init.el @@ -8,6 +8,9 @@ (let ((default-directory "~/.emacs.d/lisp/")) (normal-top-level-add-subdirs-to-load-path)) +(require 'yaml-mode) +(add-to-list 'auto-mode-alist '("\\.yml\\'" . yaml-mode)) +(require 'dockerfile-mode) (require 'go-mode) (add-to-list 'auto-mode-alist '("\\.go\\'" . go-mode)) (require 'jai-mode) @@ -20,20 +23,23 @@ (require 's) (require 'dash) (require 'popup) +;; ctags for xref, with dumb-jump as fallback (require 'dumb-jump) (setq dumb-jump-force-searcher 'grep) -(add-hook 'xref-backend-functions #'dumb-jump-xref-activate) (setq xref-show-definitions-function #'xref-show-definitions-completing-read) +(add-hook 'xref-backend-functions #'dumb-jump-xref-activate 100) -;; undo-tree for persistent undo/redo -(require 'queue) -(require 'undo-tree) -(global-undo-tree-mode) -(setq undo-tree-history-directory-alist '(("." . "~/.emacs.d/undo-tree-history/"))) -(setq undo-tree-auto-save-history t) +;; vundo for visual undo tree +(require 'vundo) (ivy-mode 1) (setq ivy-use-virtual-buffers t) (setq ivy-count-format "(%d/%d) ") +(setq ivy-wrap t) + +;; dired: mouse click opens in same window +(add-hook 'dired-mode-hook + (lambda () + (define-key dired-mode-map [mouse-2] 'dired-find-file))) ;; default indentation settings (setq-default indent-tabs-mode t) @@ -73,10 +79,10 @@ (setq-default inhibit-startup-screen t) ;; bottom panel settings (compilation, xref, etc.) -(setq compilation-scroll-output t) +(setq compilation-scroll-output -1) ;; bottom panel buffer patterns -(defvar my-bottom-panel-buffers '("\\*compilation\\*" "\\*xref\\*" "\\*terminal") +(defvar my-bottom-panel-buffers '("\\*compilation\\*" "\\*xref\\*") "List of buffer name patterns for bottom panel.") (defun my-bottom-panel-buffer-p (buf) @@ -112,53 +118,6 @@ (add-to-list 'display-buffer-alist '("\\*xref\\*" (my-display-in-bottom-panel) (window-height . 0.25))) -;; tab line for bottom panel -(defun my-bottom-panel-tab-line () - "Return tab line tabs for bottom panel buffers." - (seq-filter #'my-bottom-panel-buffer-p (buffer-list))) - -(defun my-enable-bottom-panel-tabs () - "Enable tab-line-mode for bottom panel buffers." - (setq-local tab-line-tabs-function #'my-bottom-panel-tab-line) - (tab-line-mode 1)) - -(add-hook 'compilation-mode-hook #'my-enable-bottom-panel-tabs) -(add-hook 'xref--xref-buffer-mode-hook #'my-enable-bottom-panel-tabs) -(add-hook 'term-mode-hook #'my-enable-bottom-panel-tabs) - -(defvar my-terminal-counter 0 "Counter for terminal instances.") - -(defun my-get-shell () - "Get the shell program for the current platform." - (cond ((eq system-type 'darwin) "/bin/zsh") - ((eq system-type 'gnu/linux) "/bin/bash") - ((eq system-type 'windows-nt) "powershell") - (t "/bin/sh"))) - -(defun my-open-terminal () - "Open first terminal in bottom panel, or create one if none exist." - (interactive) - (let ((existing (seq-find (lambda (buf) - (string-match-p "\\*terminal" (buffer-name buf))) - (buffer-list)))) - (if existing - (let ((win (my-display-in-bottom-panel existing '((window-height . 0.25))))) - (when win (select-window win))) - (my-open-terminal-new)))) - -(defun my-open-terminal-new () - "Open a new terminal instance in bottom panel." - (interactive) - (let* ((default-directory (or (and (project-current) - (project-root (project-current))) - default-directory)) - (name (format "terminal-%d" (setq my-terminal-counter (1+ my-terminal-counter)))) - (buf (make-term name (my-get-shell)))) - (with-current-buffer buf - (term-mode) - (term-char-mode)) - (let ((win (my-display-in-bottom-panel buf '((window-height . 0.25))))) - (when win (select-window win))))) (defun my-bottom-panel-toggle () "Toggle the bottom panel. Close if visible, open if hidden." @@ -172,28 +131,9 @@ my-bottom-panel-buffers)) (buffer-list)))) (if matching-buffers - (let ((win (my-display-in-bottom-panel (car matching-buffers) '((window-height . 0.25))))) - (when (and win (string-match-p "\\*terminal" (buffer-name (car matching-buffers)))) - (select-window win))) + (my-display-in-bottom-panel (car matching-buffers) '((window-height . 0.25))) (message "No bottom panel buffers open.")))))) -(defun my-bottom-panel-next () - "Cycle to next bottom panel buffer in bottom window." - (interactive) - (let* ((matching-buffers (seq-filter - (lambda (buf) - (seq-some (lambda (pat) (string-match-p pat (buffer-name buf))) - my-bottom-panel-buffers)) - (buffer-list))) - (bottom-window (seq-find (lambda (w) (window-at-side-p w 'bottom)) (window-list))) - (current (and bottom-window (window-buffer bottom-window))) - (idx (and current (seq-position matching-buffers current)))) - (if (and matching-buffers bottom-window) - (let ((next-buf (if idx - (nth (mod (1+ idx) (length matching-buffers)) matching-buffers) - (car matching-buffers)))) - (set-window-buffer bottom-window next-buf)) - (message "No bottom panel buffers open.")))) (add-to-list 'default-frame-alist '(fullscreen . maximized)) (show-paren-mode 1) (delete-selection-mode 1) @@ -203,6 +143,11 @@ (menu-bar-mode -1) (scroll-bar-mode -1) (tool-bar-mode -1) +(context-menu-mode -1) +(global-set-key [mouse-3] 'ignore) +(global-set-key [down-mouse-3] 'ignore) +(global-set-key [C-down-mouse-1] 'ignore) +(global-set-key [C-down-mouse-3] 'ignore) (global-auto-revert-mode t) (electric-pair-mode -1) (setq ns-pop-up-frames nil) @@ -258,7 +203,7 @@ (let ((pid (process-id proc))) (when pid (my-kill-process-tree pid))) - (set-process-query-on-exit-flag proc nil) + (set-process-query-on-exit-flag proc t) (ignore-errors (delete-process proc)))))) ;; Keybindings / Keybinds @@ -269,18 +214,14 @@ (global-set-key (kbd "") 'my-compile-last) (global-set-key (kbd "") 'my-compile-custom) (global-set-key (kbd "") 'my-bottom-panel-toggle) -(global-set-key (kbd "") 'my-bottom-panel-next) -(global-set-key (kbd "C-`") 'my-open-terminal) -(global-set-key (kbd "C-~") 'my-open-terminal-new) (global-set-key (kbd "") 'my-file-manager-command) (global-set-key (kbd "") 'project-switch-project) (global-set-key (kbd "") 'my-terminal-emulator-command) (global-set-key [f8] 'goto-line) -(global-set-key (kbd "C-\\") 'delete-other-windows) -(global-set-key (kbd "C-|") 'kill-all-buffers) +(global-set-key (kbd "C-\\") 'split-window-below) +(global-set-key (kbd "C-|") 'split-window-right) (global-unset-key (kbd "C-x C-SPC")) (global-set-key (kbd "C-x C-SPC") 'rectangle-mark-mode) -(global-set-key [C-return] 'save-buffer) (global-set-key [?\C-z] 'undo) (global-set-key (kbd "C-*") 'search-current-word) (global-set-key (kbd "C-/") 'comment-line) @@ -297,36 +238,6 @@ (setq mac-command-modifier 'control) (setq mac-control-modifier 'command) -;; Restore normal cmd/ctrl in terminal buffers on macOS -(when (eq system-type 'darwin) - (add-hook 'term-mode-hook - (lambda () - (setq-local mac-command-modifier 'super) - (setq-local mac-control-modifier 'control)))) - -;; Enable paste in terminal (Cmd-v on macOS, C-S-v elsewhere) -(add-hook 'term-mode-hook - (lambda () - (if (eq system-type 'darwin) - (define-key term-raw-map (kbd "s-v") 'term-paste) - (define-key term-raw-map (kbd "C-S-v") 'term-paste)))) - -;; F5 in terminal: Ctrl-C, rebuild, enter, r, enter, c, enter -(defun my-term-rebuild () - "Send rebuild sequence to terminal." - (interactive) - (term-send-raw-string "\C-c") - (sit-for 0.1) - (term-send-raw-string "rebuild\r") - (sit-for 0.1) - (term-send-raw-string "r\r") - (sit-for 0.1) - (term-send-raw-string "c\r")) - -(add-hook 'term-mode-hook - (lambda () - (define-key term-raw-map (kbd "") 'my-term-rebuild))) - ;; Kill terminal buffer when process exits (defun my-term-handle-exit (&optional process-name msg) "Kill terminal buffer when process exits." @@ -354,13 +265,11 @@ (define-key isearch-mode-map (kbd "S-") 'isearch-repeat-backward) (define-key isearch-mode-map (kbd "") 'isearch-del-char) (define-key isearch-mode-map (kbd "") 'isearch-exit) +(define-key isearch-mode-map (kbd "C-g") 'isearch-exit) (setq isearch-wrap-pause 'no) ;; multiple cursors (vscode-style) (setq mc/always-run-for-all t) -(global-set-key (kbd "C-d") 'mc/mark-next-like-this-word) -(global-set-key (kbd "C-S-d") 'mc/mark-previous-like-this-word) -(global-set-key (kbd "C-S-a") 'mc/mark-all-like-this) (global-set-key (kbd "C-S-") 'mc/add-cursor-on-click) (global-set-key (kbd "C-M-") (lambda () (interactive) (mc/mark-previous-lines 1))) (global-set-key (kbd "C-M-") (lambda () (interactive) (mc/mark-next-lines 1))) @@ -407,6 +316,10 @@ (define-key map (kbd "C-3") 'switch-to-buffer) (define-key map (kbd "C-4") 'find-file) (define-key map (kbd "C-j") 'dabbrev-expand) + ;; multiple cursors (override major modes) + (define-key map (kbd "C-d") 'mc/mark-next-like-this-word) + (define-key map (kbd "C-S-d") 'mc/mark-previous-like-this-word) + (define-key map (kbd "C-S-a") 'mc/mark-all-like-this) map) "my-keys-minor-mode keymap.") @@ -437,7 +350,9 @@ (defun my-project-find-text () "Search for literal text in project." (interactive) - (let ((text (read-string "Search in project: "))) + (let* ((initial (when (use-region-p) + (buffer-substring-no-properties (region-beginning) (region-end)))) + (text (read-string "Search in project: " initial))) (project-find-regexp (regexp-quote text)))) (defun my-project-find-word-at-point () @@ -499,6 +414,46 @@ (compile cmd) (my-compile-custom)))) +;; ctags (persisted per-project) +(defun my-tags-get-saved () + "Get saved TAGS file path for current project." + (when (project-current) + (let ((file (my-project-data-file "tags-file"))) + (when (file-exists-p file) + (with-temp-buffer + (insert-file-contents file) + (string-trim (buffer-string))))))) + +(defun my-tags-save (tags-path) + "Save TAGS file path for current project." + (when (project-current) + (let ((file (my-project-data-file "tags-file"))) + (with-temp-file file + (insert tags-path))))) + +(defun my-tags-load () + "Load saved TAGS file for current project." + (let ((saved (my-tags-get-saved))) + (when (and saved (file-exists-p saved)) + (visit-tags-table saved t)))) + +(add-hook 'find-file-hook #'my-tags-load) + +(defun ctags-generate () + "Generate TAGS file using ctags in project root or current directory." + (interactive) + (let* ((default-directory (or (and (project-current) + (project-root (project-current))) + default-directory)) + (tags-path (expand-file-name "TAGS" default-directory))) + (message "Generating TAGS in %s..." default-directory) + (shell-command "ctags -e -R --exclude=.git --exclude=log *") + (my-tags-save tags-path) + (visit-tags-table tags-path) + (message "TAGS generated and saved: %s" tags-path))) + +(global-set-key (kbd "M-") 'xref-find-references) + ;; find and replace with modes (defun my-find-replace () "Find and replace with mode selection: project, file, or selection." @@ -564,7 +519,7 @@ ;; theme selection (add-to-list 'custom-theme-load-path "~/.emacs.d/themes/") -(defvar my-current-theme 'bedroom "Currently active theme.") +(defvar my-current-theme 'jbeans "Currently active theme.") (defun my-select-theme () "Select and load a theme from all available themes." @@ -601,6 +556,18 @@ (global-set-key (kbd "C-") 'ignore) (global-set-key (kbd "C-") 'ignore) +;; reload emacs config +(defun reload-emacs-config () + "Reload the Emacs configuration file." + (interactive) + (load-file "~/.emacs.d/init.el") + (message "Emacs config reloaded.")) + +(defun edit-emacs-config () + "Open the Emacs configuration file for editing." + (interactive) + (find-file "~/.emacs.d/init.el")) + ;; test function (defun my-test () (interactive) @@ -630,14 +597,22 @@ (next-line arg)) ;; kill all buffers except current and close other panes -(defun kill-all-buffers () +(defun kill-other-buffers () "Kill all buffers except the current one and close other panes." (interactive) (let ((current (current-buffer))) - (mapc (lambda (buf) - (unless (eq buf current) - (kill-buffer buf))) - (buffer-list))) + (dolist (buf (buffer-list)) + (unless (eq buf current) + (let ((proc (get-buffer-process buf))) + (when proc + (let ((pid (process-id proc))) + (when pid + (my-kill-process-tree pid))) + (set-process-query-on-exit-flag proc t)) + (with-current-buffer buf + (set-buffer-modified-p nil)) + (kill-buffer buf))))) + (setq recentf-list nil) (delete-other-windows)) ;; delete word without copying to kill ring @@ -657,6 +632,7 @@ Does not copy to kill ring." (global-set-key (kbd "M-") 'my-backward-delete-word) (global-set-key (kbd "M-d") 'my-delete-word) +(global-set-key (kbd "M-") 'my-delete-word) (global-set-key (kbd "C-") 'my-backward-delete-word) ;; copy current path with line number @@ -669,25 +645,6 @@ Does not copy to kill ring." (message "Copied: %s" path-with-line)) (message "Buffer has no file."))) -;; scratch buffer with recent projects -(defvar my-dashboard-image "~/.emacs.d/logo.jpg" - "Path to dashboard image.") - -(defun my-setup-scratch-buffer () - "Setup scratch buffer." - (with-current-buffer (get-buffer-create "*scratch*") - (let ((inhibit-read-only t)) - (erase-buffer) - (insert "\n") - ;; Image - (when (and (display-graphic-p) - (file-exists-p (expand-file-name my-dashboard-image))) - (insert-image (create-image (expand-file-name my-dashboard-image) nil nil :height 150)) - (insert "\n\n")) - ;; Message - (insert "Agartha needs your help! You must write a new operating system from scratch to restore Agartha's defences!\n\nYou will need some food, water, and a funny hat to complete this mission!\n") - (goto-char (point-min))))) - ;; select rectangle with shift+mouse (defun my-mouse-start-rectangle (start-event) (interactive "e") @@ -780,7 +737,4 @@ Use in `isearch-mode-end-hook'." ;; (set-face-attribute 'default nil :font "Consolas-15") (global-font-lock-mode 1) -(load-theme 'bedroom t) - -;; setup scratch buffer with recent projects on startup -(add-hook 'emacs-startup-hook 'my-setup-scratch-buffer) +(load-theme 'jbeans t) diff --git a/.emacs.d/lisp/dockerfile-mode.el b/.emacs.d/lisp/dockerfile-mode.el new file mode 100644 index 0000000..fc62da3 --- /dev/null +++ b/.emacs.d/lisp/dockerfile-mode.el @@ -0,0 +1,309 @@ +;;; dockerfile-mode.el --- Major mode for editing Docker's Dockerfiles -*- lexical-binding: t -*- + +;; Copyright (c) 2013 Spotify AB +;; Package-Requires: ((emacs "24")) +;; Homepage: https://github.com/spotify/dockerfile-mode +;; URL: https://github.com/spotify/dockerfile-mode +;; Version: 1.9 +;; Keywords: docker languages processes tools +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); you may not +;; use this file except in compliance with the License. You may obtain a copy of +;; the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT +;; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the +;; License for the specific language governing permissions and limitations under +;; the License. + +;;; Commentary: + +;; Provides a major mode `dockerfile-mode' for use with the standard +;; `Dockerfile' file format. Additional convenience functions allow +;; images to be built easily. + +;;; Code: + +(require 'sh-script) +(require 'rx) + + +(declare-function cygwin-convert-file-name-to-windows "cygw32.c" (file &optional absolute-p)) + +(defgroup dockerfile nil + "Dockerfile editing commands for Emacs." + :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) + :prefix "dockerfile-" + :group 'languages) + +(defcustom dockerfile-mode-command "docker" + "Which binary to use to build images." + :group 'dockerfile + :type 'string) + +(defcustom dockerfile-use-sudo nil + "Runs docker builder command with sudo." + :type 'boolean + :group 'dockerfile) + +(defcustom dockerfile-build-force-rm nil + "Runs docker builder command with --force-rm switch." + :type 'boolean + :group 'dockerfile) + +(defcustom dockerfile-build-pull nil + "Runs docker builder command with --pull switch." + :type 'boolean + :group 'dockerfile) + +(defcustom dockerfile-build-args nil + "List of --build-arg to pass to docker build. + +Each element of the list will be passed as a separate + --build-arg to the docker build command." + :type '(repeat string) + :group 'dockerfile) + +(defcustom dockerfile-build-progress "auto" + "Type of --progress output (auto, plain, tty) of docker build." + :group 'dockerfile + :type 'string) + +(defcustom dockerfile-build-extra-options nil + "Extra command-line options to send to docker build. + +Use this variable to add custom command-line switches not covered by +existing dockerfile-build-* variables. + +Example: +(setq-default dockerfile-build-extra-options \"--network host\")" + :group 'dockerfile + :type 'string) + +(defcustom dockerfile-use-buildkit nil + "Use Docker buildkit for building images? + +This is the new buildsystem for docker, and in time it will replace the old one +but for now it has to be explicitly enabled to work. +It is supported from docker 18.09" + :type 'boolean) + +(defcustom dockerfile-enable-auto-indent t + "Toggles the auto indentation functionality." + :type 'boolean) + +(defcustom dockerfile-indent-offset (or standard-indent 2) + "Dockerfile number of columns for margin-changing functions to indent." + :type 'integer + :safe #'integerp + :group 'dockerfile) + +(defface dockerfile-image-name + '((t (:inherit (font-lock-type-face bold)))) + "Face to highlight the base image name after FROM instruction.") + +(defface dockerfile-image-alias + '((t (:inherit (font-lock-constant-face bold)))) + "Face to highlight the base image alias inf FROM ... AS construct.") + +(defconst dockerfile--from-regex + (rx line-start (* blank) "from" (+ blank) + (? "--platform=" (+ (not (any blank "\n"))) (+ blank)) + (group (+ (not (any blank "\n")))) + (* blank) + (? "as" (+ blank) (group (+ (not (any blank "\n"))))) + (* blank) + (? "#" (* nonl)) + line-end)) + +(defvar dockerfile-font-lock-keywords + `(,(cons (rx (or line-start "onbuild ") + (group (or "from" "maintainer" "run" "cmd" "expose" "env" "arg" + "add" "copy" "entrypoint" "volume" "user" "workdir" "onbuild" + "label" "stopsignal" "shell" "healthcheck")) + word-boundary) + 'font-lock-keyword-face) + (,dockerfile--from-regex + (1 'dockerfile-image-name) + (2 'dockerfile-image-alias nil t)) + ,@(sh-font-lock-keywords) + ,@(sh-font-lock-keywords-2) + ,@(sh-font-lock-keywords-1)) + "Default `font-lock-keywords' for `dockerfile mode'.") + +(defvar dockerfile-mode-map + (let ((map (make-sparse-keymap)) + (menu-map (make-sparse-keymap))) + (define-key map "\C-c\C-b" #'dockerfile-build-buffer) + (define-key map "\C-c\M-b" #'dockerfile-build-no-cache-buffer) + (define-key map "\C-c\C-c" #'comment-region) + (define-key map [menu-bar dockerfile-mode] (cons "Dockerfile" menu-map)) + (define-key menu-map [dfc] + '(menu-item "Comment Region" comment-region + :help "Comment Region")) + (define-key-after menu-map [dfb] + '(menu-item "Build" dockerfile-build-buffer + :help "Send the Dockerfile to docker build")) + (define-key-after menu-map [dfbnc] + '(menu-item "Build without cache" dockerfile-build-no-cache-buffer + :help "Send the Dockerfile to docker build without cache")) + map)) + +(defvar dockerfile-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?# "<" table) + (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?' "\"" table) + (modify-syntax-entry ?= "." table) + table) + "Syntax table for `dockerfile-mode'.") + +(define-abbrev-table 'dockerfile-mode-abbrev-table nil + "Abbrev table used while in `dockerfile-mode'.") + +(unless dockerfile-mode-abbrev-table + (define-abbrev-table 'dockerfile-mode-abbrev-table ())) + +(defun dockerfile-indent-line-function () + "Indent lines in a Dockerfile. + +Lines beginning with a keyword are ignored, and any others are +indented by one `dockerfile-indent-offset'. Functionality toggled +by `dockerfile-enable-auto-indent'." + (when dockerfile-enable-auto-indent + (unless (member (get-text-property (line-beginning-position) 'face) + '(font-lock-comment-delimiter-face font-lock-keyword-face)) + (save-excursion + (beginning-of-line) + (unless (looking-at-p "\\s-*$") ; Ignore empty lines. + (indent-line-to dockerfile-indent-offset)))))) + +(defun dockerfile-build-arg-string () + "Create a --build-arg string for each element in `dockerfile-build-args'." + (mapconcat (lambda (arg) (concat "--build-arg=" (replace-regexp-in-string "\\\\=" "=" (shell-quote-argument arg)))) + dockerfile-build-args " ")) + +(defun dockerfile-standard-filename (file) + "Convert the FILE name to OS standard. +If in Cygwin environment, uses Cygwin specific function to convert the +file name. Otherwise, uses Emacs' standard conversion function." + (if (fboundp 'cygwin-convert-file-name-to-windows) + (replace-regexp-in-string + (rx "\\") "\\\\" (cygwin-convert-file-name-to-windows file) t t) + (convert-standard-filename file))) + +(defun dockerfile-tag-string (image-name) + "Return a --tag shell-quoted IMAGE-NAME string. + +Returns an empty string if IMAGE-NAME is blank." + (if (string= image-name "") "" (format "--tag %s " (shell-quote-argument image-name)))) + +(define-obsolete-variable-alias 'docker-image-name 'dockerfile-image-name "2017-10-22") + +(defvar dockerfile-image-name nil + "Name of the dockerfile currently being used. +This can be set in file or directory-local variables.") + +(defvar dockerfile-image-name-history nil + "History of image names read by `dockerfile-read-image-name'.") + +(defun dockerfile-read-image-name () + "Read a docker image name." + (read-string "Image name: " dockerfile-image-name 'dockerfile-image-name-history)) + + +;;;###autoload +(defun dockerfile-build-buffer (image-name &optional no-cache) + "Build an image called IMAGE-NAME based upon the buffer. + +If the prefix arg NO-CACHE is set, don't cache the image. + +The shell command used to build the image is: + + sudo docker build \\ + --no-cache \\ + --force-rm \\ + --pull \\ + --tag IMAGE-NAME \\ + --build-args args \\ + --progress type \\ + -f filename \\ + directory" + + (interactive (list (dockerfile-read-image-name) prefix-arg)) + (save-buffer) + (compilation-start + (format + "%s%s%s build %s %s %s %s %s --progress %s %s -f %s %s" + (if dockerfile-use-buildkit "DOCKER_BUILDKIT=1 " "") + (if dockerfile-use-sudo "sudo " "") + dockerfile-mode-command + (if no-cache "--no-cache" "") + (if dockerfile-build-force-rm "--force-rm " "") + (if dockerfile-build-pull "--pull " "") + (dockerfile-tag-string image-name) + (dockerfile-build-arg-string) + dockerfile-build-progress + (or dockerfile-build-extra-options "") + (shell-quote-argument (dockerfile-standard-filename + (or (file-remote-p (buffer-file-name) 'localname) + (buffer-file-name)))) + (shell-quote-argument (dockerfile-standard-filename + (or (file-remote-p default-directory 'localname) + default-directory)))) + nil + (lambda (_) (format "*docker-build-output: %s *" image-name)))) + +;;;###autoload +(defun dockerfile-build-no-cache-buffer (image-name) + "Build an image called IMAGE-NAME based upon the buffer without cache." + (interactive (list (dockerfile-read-image-name))) + (dockerfile-build-buffer image-name t)) + +(defun dockerfile--imenu-function () + "Find the previous headline from point. + +Search for a FROM instruction. If an alias is used this is +returned, otherwise the base image name is used." + (when (re-search-backward dockerfile--from-regex nil t) + (let ((data (match-data))) + (when (match-string 2) + ;; we drop the first match group because + ;; imenu-generic-expression can only use one offset, so we + ;; normalize to `1'. + (set-match-data (list (nth 0 data) (nth 1 data) (nth 4 data) (nth 5 data)))) + t))) + +;;;###autoload +(define-derived-mode dockerfile-mode prog-mode "Dockerfile" + "A major mode to edit Dockerfiles. +\\{dockerfile-mode-map}" + (set-syntax-table dockerfile-mode-syntax-table) + (set (make-local-variable 'imenu-generic-expression) + `(("Stage" dockerfile--imenu-function 1))) + (set (make-local-variable 'require-final-newline) mode-require-final-newline) + (set (make-local-variable 'comment-start) "#") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-start-skip) "#+ *") + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'font-lock-defaults) + '(dockerfile-font-lock-keywords nil t)) + (setq local-abbrev-table dockerfile-mode-abbrev-table) + (set (make-local-variable 'indent-line-function) #'dockerfile-indent-line-function)) + +;;;###autoload +(add-to-list 'auto-mode-alist + (cons (concat "[/\\]" + "\\(?:Containerfile\\|Dockerfile\\)" + "\\(?:\\.[^/\\]*\\)?\\'") + 'dockerfile-mode)) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.dockerfile\\'" . dockerfile-mode)) + +(provide 'dockerfile-mode) + +;;; dockerfile-mode.el ends here diff --git a/.emacs.d/lisp/queue.el b/.emacs.d/lisp/queue.el deleted file mode 100644 index 4e173b3..0000000 --- a/.emacs.d/lisp/queue.el +++ /dev/null @@ -1,165 +0,0 @@ -;;; queue.el --- Queue data structure -*- lexical-binding: t; -*- - -;; Copyright (C) 1991-1995, 2008-2009, 2012, 2017 Free Software Foundation, Inc - -;; Author: Inge Wallin -;; Toby Cubitt -;; Maintainer: Toby Cubitt -;; Version: 0.2 -;; Keywords: extensions, data structures, queue -;; URL: http://www.dr-qubit.org/emacs.php -;; Repository: http://www.dr-qubit.org/git/predictive.git - -;; This file is part of Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify it under -;; the terms of the GNU General Public License as published by the Free -;; Software Foundation, either version 3 of the License, or (at your option) -;; any later version. -;; -;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT -;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for -;; more details. -;; -;; You should have received a copy of the GNU General Public License along -;; with GNU Emacs. If not, see . - - -;;; Commentary: -;; -;; These queues can be used both as a first-in last-out (FILO) and as a -;; first-in first-out (FIFO) stack, i.e. elements can be added to the front or -;; back of the queue, and can be removed from the front. (This type of data -;; structure is sometimes called an "output-restricted deque".) -;; -;; You create a queue using `make-queue', add an element to the end of the -;; queue using `queue-enqueue', and push an element onto the front of the -;; queue using `queue-prepend'. To remove the first element from a queue, use -;; `queue-dequeue'. A number of other queue convenience functions are also -;; provided, all starting with the prefix `queue-'. Functions with prefix -;; `queue--' are for internal use only, and should never be used outside this -;; package. - - -;;; Code: - -(eval-when-compile (require 'cl)) - -(defmacro queue--when-generators (then) - "Evaluate THEN if `generator' library is available." - (declare (debug t)) - (if (require 'generator nil 'noerror) then)) - - -(defstruct (queue - ;; A tagged list is the pre-defstruct representation. - ;; (:type list) - :named - (:constructor nil) - (:constructor queue-create ()) - (:copier nil)) - head tail) - - -;;;###autoload -(defalias 'make-queue 'queue-create - "Create an empty queue data structure.") - - -(defun queue-enqueue (queue element) - "Append an ELEMENT to the end of the QUEUE." - (if (queue-head queue) - (setcdr (queue-tail queue) - (setf (queue-tail queue) (cons element nil))) - (setf (queue-head queue) - (setf (queue-tail queue) (cons element nil))))) - -(defalias 'queue-append 'queue-enqueue) - - -(defun queue-prepend (queue element) - "Prepend an ELEMENT to the front of the QUEUE." - (if (queue-head queue) - (push element (queue-head queue)) - (setf (queue-head queue) - (setf (queue-tail queue) (cons element nil))))) - - -(defun queue-dequeue (queue) - "Remove the first element of QUEUE and return it. -Returns nil if the queue is empty." - (unless (cdr (queue-head queue)) (setf (queue-tail queue) nil)) - (pop (queue-head queue))) - - -(defun queue-empty (queue) - "Return t if QUEUE is empty, otherwise return nil." - (null (queue-head queue))) - - -(defun queue-first (queue) - "Return the first element of QUEUE or nil if it is empty, -without removing it from the QUEUE." - (car (queue-head queue))) - - -(defun queue-nth (queue n) - "Return the nth element of a queue, without removing it. -If the length of the queue is less than N, return nil. The first -element in the queue has index 0." - (nth n (queue-head queue))) - - -(defun queue-last (queue) - "Return the last element of QUEUE, without removing it. -Returns nil if the QUEUE is empty." - (car (queue-tail queue))) - - -(defun queue-all (queue) - "Return a list of all elements of QUEUE or nil if it is empty. -The oldest element in the queue is the first in the list." - (queue-head queue)) - - -(defun queue-copy (queue) - "Return a copy of QUEUE. -The new queue contains the elements of QUEUE in the same -order. The elements themselves are *not* copied." - (let ((q (queue-create)) - (list (queue-head queue))) - (when (queue-head queue) - (setf (queue-head q) (cons (car (queue-head queue)) nil) - (queue-tail q) (queue-head q)) - (while (setq list (cdr list)) - (setf (queue-tail q) - (setcdr (queue-tail q) (cons (car list) nil))))) - q)) - - -(defun queue-length (queue) - "Return the number of elements in QUEUE." - (length (queue-head queue))) - - -(defun queue-clear (queue) - "Remove all elements from QUEUE." - (setf (queue-head queue) nil - (queue-tail queue) nil)) - - -(queue--when-generators - (iter-defun queue-iter (queue) - "Return a queue iterator object. - -Calling `iter-next' on this object will retrieve the next element -from the queue. The queue itself is not modified." - (let ((list (queue-head queue))) - (while list (iter-yield (pop list)))))) - - -(provide 'queue) - - -;;; queue.el ends here diff --git a/.emacs.d/lisp/undo-tree.el b/.emacs.d/lisp/undo-tree.el deleted file mode 100644 index e345d4c..0000000 --- a/.emacs.d/lisp/undo-tree.el +++ /dev/null @@ -1,4767 +0,0 @@ -;;; undo-tree.el --- Treat undo history as a tree -*- lexical-binding: t; -*- - -;; Copyright (C) 2009-2021 Free Software Foundation, Inc - -;; Author: Toby Cubitt -;; Maintainer: Toby Cubitt -;; Version: 0.8.2 -;; Keywords: convenience, files, undo, redo, history, tree -;; Package-Requires: ((queue "0.2")) -;; URL: https://www.dr-qubit.org/undo-tree.html -;; Repository: https://gitlab.com/tsc25/undo-tree - -;; This file is part of Emacs. -;; -;; This file is free software: you can redistribute it and/or modify it under -;; the terms of the GNU General Public License as published by the Free -;; Software Foundation, either version 3 of the License, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, but WITHOUT -;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for -;; more details. -;; -;; You should have received a copy of the GNU General Public License along -;; with GNU Emacs. If not, see . - - -;;; Commentary: -;; -;; Emacs has a powerful undo system. Unlike the standard undo/redo system in -;; most software, it allows you to recover *any* past state of a buffer -;; (whereas the standard undo/redo system can lose past states as soon as you -;; redo). However, this power comes at a price: many people find Emacs' undo -;; system confusing and difficult to use, spawning a number of packages that -;; replace it with the less powerful but more intuitive undo/redo system. -;; -;; Both the loss of data with standard undo/redo, and the confusion of Emacs' -;; undo, stem from trying to treat undo history as a linear sequence of -;; changes. It's not. The `undo-tree-mode' provided by this package replaces -;; Emacs' undo system with a system that treats undo history as what it is: a -;; branching tree of changes. This simple idea allows the more intuitive -;; behaviour of the standard undo/redo system to be combined with the power of -;; never losing any history. An added side bonus is that undo history can in -;; some cases be stored more efficiently, allowing more changes to accumulate -;; before Emacs starts discarding history. -;; -;; The only downside to this more advanced yet simpler undo system is that it -;; was inspired by Vim. But, after all, most successful religions steal the -;; best ideas from their competitors! -;; -;; -;; Installation -;; ============ -;; -;; This package has only been tested with Emacs versions 24 and CVS. It should -;; work in Emacs versions 22 and 23 too, but will not work without -;; modifications in earlier versions of Emacs. -;; -;; To install `undo-tree-mode', make sure this file is saved in a directory in -;; your `load-path', and add the line: -;; -;; (require 'undo-tree) -;; -;; to your .emacs file. Byte-compiling undo-tree.el is recommended (e.g. using -;; "M-x byte-compile-file" from within emacs). -;; -;; If you want to replace the standard Emacs' undo system with the -;; `undo-tree-mode' system in all buffers, you can enable it globally by -;; adding: -;; -;; (global-undo-tree-mode) -;; -;; to your .emacs file. -;; -;; -;; Quick-Start -;; =========== -;; -;; If you're the kind of person who likes to jump in the car and drive, -;; without bothering to first figure out whether the button on the left dips -;; the headlights or operates the ejector seat (after all, you'll soon figure -;; it out when you push it), then here's the minimum you need to know: -;; -;; `undo-tree-mode' and `global-undo-tree-mode' -;; Enable undo-tree mode (either in the current buffer or globally). -;; -;; C-_ C-/ (`undo-tree-undo') -;; Undo changes. -;; -;; M-_ C-? (`undo-tree-redo') -;; Redo changes. -;; -;; `undo-tree-switch-branch' -;; Switch undo-tree branch. -;; (What does this mean? Better press the button and see!) -;; -;; C-x u (`undo-tree-visualize') -;; Visualize the undo tree. -;; (Better try pressing this button too!) -;; -;; C-x r u (`undo-tree-save-state-to-register') -;; Save current buffer state to register. -;; -;; C-x r U (`undo-tree-restore-state-from-register') -;; Restore buffer state from register. -;; -;; -;; -;; In the undo-tree visualizer: -;; -;; p C-p (`undo-tree-visualize-undo') -;; Undo changes. -;; -;; n C-n (`undo-tree-visualize-redo') -;; Redo changes. -;; -;; b C-b (`undo-tree-visualize-switch-branch-left') -;; Switch to previous undo-tree branch. -;; -;; f C-f (`undo-tree-visualize-switch-branch-right') -;; Switch to next undo-tree branch. -;; -;; C- M-{ (`undo-tree-visualize-undo-to-x') -;; Undo changes up to last branch point. -;; -;; C- M-} (`undo-tree-visualize-redo-to-x') -;; Redo changes down to next branch point. -;; -;; n C-n (`undo-tree-visualize-redo') -;; Redo changes. -;; -;; (`undo-tree-visualizer-mouse-set') -;; Set state to node at mouse click. -;; -;; t (`undo-tree-visualizer-toggle-timestamps') -;; Toggle display of time-stamps. -;; -;; d (`undo-tree-visualizer-toggle-diff') -;; Toggle diff display. -;; -;; s (`undo-tree-visualizer-selection-mode') -;; Toggle keyboard selection mode. -;; -;; q (`undo-tree-visualizer-quit') -;; Quit undo-tree-visualizer. -;; -;; C-q (`undo-tree-visualizer-abort') -;; Abort undo-tree-visualizer. -;; -;; , < -;; Scroll left. -;; -;; . > -;; Scroll right. -;; -;; M-v -;; Scroll up. -;; -;; C-v -;; Scroll down. -;; -;; -;; -;; In visualizer selection mode: -;; -;; p C-p (`undo-tree-visualizer-select-previous') -;; Select previous node. -;; -;; n C-n (`undo-tree-visualizer-select-next') -;; Select next node. -;; -;; b C-b (`undo-tree-visualizer-select-left') -;; Select left sibling node. -;; -;; f C-f (`undo-tree-visualizer-select-right') -;; Select right sibling node. -;; -;; M-v -;; Select node 10 above. -;; -;; C-v -;; Select node 10 below. -;; -;; (`undo-tree-visualizer-set') -;; Set state to selected node and exit selection mode. -;; -;; s (`undo-tree-visualizer-mode') -;; Exit selection mode. -;; -;; t (`undo-tree-visualizer-toggle-timestamps') -;; Toggle display of time-stamps. -;; -;; d (`undo-tree-visualizer-toggle-diff') -;; Toggle diff display. -;; -;; q (`undo-tree-visualizer-quit') -;; Quit undo-tree-visualizer. -;; -;; C-q (`undo-tree-visualizer-abort') -;; Abort undo-tree-visualizer. -;; -;; , < -;; Scroll left. -;; -;; . > -;; Scroll right. -;; -;; -;; -;; Persistent undo history: -;; -;; Note: Requires Emacs version 24.3 or higher. -;; -;; `undo-tree-auto-save-history' (variable) -;; automatically save and restore undo-tree history along with buffer -;; (disabled by default) -;; -;; `undo-tree-save-history' (command) -;; manually save undo history to file -;; -;; `undo-tree-load-history' (command) -;; manually load undo history from file -;; -;; -;; -;; Compressing undo history: -;; -;; Undo history files cannot grow beyond the maximum undo tree size, which -;; is limited by `undo-limit', `undo-strong-limit' and -;; `undo-outer-limit'. Nevertheless, undo history files can grow quite -;; large. If you want to automatically compress undo history, add the -;; following advice to your .emacs file (replacing ".gz" with the filename -;; extension of your favourite compression algorithm): -;; -;; (defadvice undo-tree-make-history-save-file-name -;; (after undo-tree activate) -;; (setq ad-return-value (concat ad-return-value ".gz"))) -;; -;; -;; -;; -;; Undo Systems -;; ============ -;; -;; To understand the different undo systems, it's easiest to consider an -;; example. Imagine you make a few edits in a buffer. As you edit, you -;; accumulate a history of changes, which we might visualize as a string of -;; past buffer states, growing downwards: -;; -;; o (initial buffer state) -;; | -;; | -;; o (first edit) -;; | -;; | -;; o (second edit) -;; | -;; | -;; x (current buffer state) -;; -;; -;; Now imagine that you undo the last two changes. We can visualize this as -;; rewinding the current state back two steps: -;; -;; o (initial buffer state) -;; | -;; | -;; x (current buffer state) -;; | -;; | -;; o -;; | -;; | -;; o -;; -;; -;; However, this isn't a good representation of what Emacs' undo system -;; does. Instead, it treats the undos as *new* changes to the buffer, and adds -;; them to the history: -;; -;; o (initial buffer state) -;; | -;; | -;; o (first edit) -;; | -;; | -;; o (second edit) -;; | -;; | -;; x (buffer state before undo) -;; | -;; | -;; o (first undo) -;; | -;; | -;; x (second undo) -;; -;; -;; Actually, since the buffer returns to a previous state after an undo, -;; perhaps a better way to visualize it is to imagine the string of changes -;; turning back on itself: -;; -;; (initial buffer state) o -;; | -;; | -;; (first edit) o x (second undo) -;; | | -;; | | -;; (second edit) o o (first undo) -;; | / -;; |/ -;; o (buffer state before undo) -;; -;; Treating undos as new changes might seem a strange thing to do. But the -;; advantage becomes clear as soon as we imagine what happens when you edit -;; the buffer again. Since you've undone a couple of changes, new edits will -;; branch off from the buffer state that you've rewound to. Conceptually, it -;; looks like this: -;; -;; o (initial buffer state) -;; | -;; | -;; o -;; |\ -;; | \ -;; o x (new edit) -;; | -;; | -;; o -;; -;; The standard undo/redo system only lets you go backwards and forwards -;; linearly. So as soon as you make that new edit, it discards the old -;; branch. Emacs' undo just keeps adding changes to the end of the string. So -;; the undo history in the two systems now looks like this: -;; -;; Undo/Redo: Emacs' undo -;; -;; o o -;; | | -;; | | -;; o o o -;; .\ | |\ -;; . \ | | \ -;; . x (new edit) o o | -;; (discarded . | / | -;; branch) . |/ | -;; . o | -;; | -;; | -;; x (new edit) -;; -;; Now, what if you change your mind about those undos, and decide you did -;; like those other changes you'd made after all? With the standard undo/redo -;; system, you're lost. There's no way to recover them, because that branch -;; was discarded when you made the new edit. -;; -;; However, in Emacs' undo system, those old buffer states are still there in -;; the undo history. You just have to rewind back through the new edit, and -;; back through the changes made by the undos, until you reach them. Of -;; course, since Emacs treats undos (even undos of undos!) as new changes, -;; you're really weaving backwards and forwards through the history, all the -;; time adding new changes to the end of the string as you go: -;; -;; o -;; | -;; | -;; o o o (undo new edit) -;; | |\ |\ -;; | | \ | \ -;; o o | | o (undo the undo) -;; | / | | | -;; |/ | | | -;; (trying to get o | | x (undo the undo) -;; to this state) | / -;; |/ -;; o -;; -;; So far, this is still reasonably intuitive to use. It doesn't behave so -;; differently to standard undo/redo, except that by going back far enough you -;; can access changes that would be lost in standard undo/redo. -;; -;; However, imagine that after undoing as just described, you decide you -;; actually want to rewind right back to the initial state. If you're lucky, -;; and haven't invoked any command since the last undo, you can just keep on -;; undoing until you get back to the start: -;; -;; (trying to get o x (got there!) -;; to this state) | | -;; | | -;; o o o o (keep undoing) -;; | |\ |\ | -;; | | \ | \ | -;; o o | | o o (keep undoing) -;; | / | | | / -;; |/ | | |/ -;; (already undid o | | o (got this far) -;; to this state) | / -;; |/ -;; o -;; -;; But if you're unlucky, and you happen to have moved the point (say) after -;; getting to the state labelled "got this far", then you've "broken the undo -;; chain". Hold on to something solid, because things are about to get -;; hairy. If you try to undo now, Emacs thinks you're trying to undo the -;; undos! So to get back to the initial state you now have to rewind through -;; *all* the changes, including the undos you just did: -;; -;; (trying to get o x (finally got there!) -;; to this state) | | -;; | | -;; o o o o o o -;; | |\ |\ |\ |\ | -;; | | \ | \ | \ | \ | -;; o o | | o o | | o o -;; | / | | | / | | | / -;; |/ | | |/ | | |/ -;; (already undid o | | o<. | | o -;; to this state) | / : | / -;; |/ : |/ -;; o : o -;; : -;; (got this far, but -;; broke the undo chain) -;; -;; Confused? -;; -;; In practice you can just hold down the undo key until you reach the buffer -;; state that you want. But whatever you do, don't move around in the buffer -;; to *check* that you've got back to where you want! Because you'll break the -;; undo chain, and then you'll have to traverse the entire string of undos -;; again, just to get back to the point at which you broke the -;; chain. Undo-in-region and commands such as `undo-only' help to make using -;; Emacs' undo a little easier, but nonetheless it remains confusing for many -;; people. -;; -;; -;; So what does `undo-tree-mode' do? Remember the diagram we drew to represent -;; the history we've been discussing (make a few edits, undo a couple of them, -;; and edit again)? The diagram that conceptually represented our undo -;; history, before we started discussing specific undo systems? It looked like -;; this: -;; -;; o (initial buffer state) -;; | -;; | -;; o -;; |\ -;; | \ -;; o x (current state) -;; | -;; | -;; o -;; -;; Well, that's *exactly* what the undo history looks like to -;; `undo-tree-mode'. It doesn't discard the old branch (as standard undo/redo -;; does), nor does it treat undos as new changes to be added to the end of a -;; linear string of buffer states (as Emacs' undo does). It just keeps track -;; of the tree of branching changes that make up the entire undo history. -;; -;; If you undo from this point, you'll rewind back up the tree to the previous -;; state: -;; -;; o -;; | -;; | -;; x (undo) -;; |\ -;; | \ -;; o o -;; | -;; | -;; o -;; -;; If you were to undo again, you'd rewind back to the initial state. If on -;; the other hand you redo the change, you'll end up back at the bottom of the -;; most recent branch: -;; -;; o (undo takes you here) -;; | -;; | -;; o (start here) -;; |\ -;; | \ -;; o x (redo takes you here) -;; | -;; | -;; o -;; -;; So far, this is just like the standard undo/redo system. But what if you -;; want to return to a buffer state located on a previous branch of the -;; history? Since `undo-tree-mode' keeps the entire history, you simply need -;; to tell it to switch to a different branch, and then redo the changes you -;; want: -;; -;; o -;; | -;; | -;; o (start here, but switch -;; |\ to the other branch) -;; | \ -;; (redo) o o -;; | -;; | -;; (redo) x -;; -;; Now you're on the other branch, if you undo and redo changes you'll stay on -;; that branch, moving up and down through the buffer states located on that -;; branch. Until you decide to switch branches again, of course. -;; -;; Real undo trees might have multiple branches and sub-branches: -;; -;; o -;; ____|______ -;; / \ -;; o o -;; ____|__ __| -;; / | \ / \ -;; o o o o x -;; | | -;; / \ / \ -;; o o o o -;; -;; Trying to imagine what Emacs' undo would do as you move about such a tree -;; will likely frazzle your brain circuits! But in `undo-tree-mode', you're -;; just moving around this undo history tree. Most of the time, you'll -;; probably only need to stay on the most recent branch, in which case it -;; behaves like standard undo/redo, and is just as simple to understand. But -;; if you ever need to recover a buffer state on a different branch, the -;; possibility of switching between branches and accessing the full undo -;; history is still there. -;; -;; -;; -;; The Undo-Tree Visualizer -;; ======================== -;; -;; Actually, it gets better. You don't have to imagine all these tree -;; diagrams, because `undo-tree-mode' includes an undo-tree visualizer which -;; draws them for you! In fact, it draws even better diagrams: it highlights -;; the node representing the current buffer state, it highlights the current -;; branch, and you can toggle the display of time-stamps (by hitting "t") and -;; a diff of the undo changes (by hitting "d"). (There's one other tiny -;; difference: the visualizer puts the most recent branch on the left rather -;; than the right.) -;; -;; Bring up the undo tree visualizer whenever you want by hitting "C-x u". -;; -;; In the visualizer, the usual keys for moving up and down a buffer instead -;; move up and down the undo history tree (e.g. the up and down arrow keys, or -;; "C-n" and "C-p"). The state of the "parent" buffer (the buffer whose undo -;; history you are visualizing) is updated as you move around the undo tree in -;; the visualizer. If you reach a branch point in the visualizer, the usual -;; keys for moving forward and backward in a buffer instead switch branch -;; (e.g. the left and right arrow keys, or "C-f" and "C-b"). -;; -;; Clicking with the mouse on any node in the visualizer will take you -;; directly to that node, resetting the state of the parent buffer to the -;; state represented by that node. -;; -;; You can also select nodes directly using the keyboard, by hitting "s" to -;; toggle selection mode. The usual motion keys now allow you to move around -;; the tree without changing the parent buffer. Hitting will reset the -;; state of the parent buffer to the state represented by the currently -;; selected node. -;; -;; It can be useful to see how long ago the parent buffer was in the state -;; represented by a particular node in the visualizer. Hitting "t" in the -;; visualizer toggles the display of time-stamps for all the nodes. (Note -;; that, because of the way `undo-tree-mode' works, these time-stamps may be -;; somewhat later than the true times, especially if it's been a long time -;; since you last undid any changes.) -;; -;; To get some idea of what changes are represented by a given node in the -;; tree, it can be useful to see a diff of the changes. Hit "d" in the -;; visualizer to toggle a diff display. This normally displays a diff between -;; the current state and the previous one, i.e. it shows you the changes that -;; will be applied if you undo (move up the tree). However, the diff display -;; really comes into its own in the visualizer's selection mode (see above), -;; where it instead shows a diff between the current state and the currently -;; selected state, i.e. it shows you the changes that will be applied if you -;; reset to the selected state. -;; -;; (Note that the diff is generated by the Emacs `diff' command, and is -;; displayed using `diff-mode'. See the corresponding customization groups if -;; you want to customize the diff display.) -;; -;; Finally, hitting "q" will quit the visualizer, leaving the parent buffer in -;; whatever state you ended at. Hitting "C-q" will abort the visualizer, -;; returning the parent buffer to whatever state it was originally in when the -;; visualizer was invoked. -;; -;; -;; -;; Undo-in-Region -;; ============== -;; -;; Emacs allows a very useful and powerful method of undoing only selected -;; changes: when a region is active, only changes that affect the text within -;; that region will be undone. With the standard Emacs undo system, changes -;; produced by undoing-in-region naturally get added onto the end of the -;; linear undo history: -;; -;; o -;; | -;; | x (second undo-in-region) -;; o | -;; | | -;; | o (first undo-in-region) -;; o | -;; | / -;; |/ -;; o -;; -;; You can of course redo these undos-in-region as usual, by undoing the -;; undos: -;; -;; o -;; | -;; | o_ -;; o | \ -;; | | | -;; | o o (undo the undo-in-region) -;; o | | -;; | / | -;; |/ | -;; o x (undo the undo-in-region) -;; -;; -;; In `undo-tree-mode', undo-in-region works much the same way: when there's -;; an active region, undoing only undoes changes that affect that region. In -;; `undo-tree-mode', redoing when there's an active region similarly only -;; redoes changes that affect that region. -;; -;; However, the way these undo- and redo-in-region changes are recorded in the -;; undo history is quite different. The good news is, you don't need to -;; understand this to use undo- and redo-in-region in `undo-tree-mode' - just -;; go ahead and use them! They'll probably work as you expect. But if you're -;; masochistic enough to want to understand conceptually what's happening to -;; the undo tree as you undo- and redo-in-region, then read on... -;; -;; -;; Undo-in-region creates a new branch in the undo history. The new branch -;; consists of an undo step that undoes some of the changes that affect the -;; current region, and another step that undoes the remaining changes needed -;; to rejoin the previous undo history. -;; -;; Previous undo history Undo-in-region -;; -;; o o -;; | | -;; | | -;; | | -;; o o -;; | | -;; | | -;; | | -;; o o_ -;; | | \ -;; | | x (undo-in-region) -;; | | | -;; x o o -;; -;; As long as you don't change the active region after undoing-in-region, -;; continuing to undo-in-region extends the new branch, pulling more changes -;; that affect the current region into an undo step immediately above your -;; current location in the undo tree, and pushing the point at which the new -;; branch is attached further up the tree: -;; -;; First undo-in-region Second undo-in-region -;; -;; o o -;; | | -;; | | -;; | | -;; o o_ -;; | | \ -;; | | x (undo-in-region) -;; | | | -;; o_ o | -;; | \ | | -;; | x | o -;; | | | | -;; o o o o -;; -;; Redoing takes you back down the undo tree, as usual (as long as you haven't -;; changed the active region after undoing-in-region, it doesn't matter if it -;; is still active): -;; -;; o -;; | -;; | -;; | -;; o_ -;; | \ -;; | o -;; | | -;; o | -;; | | -;; | o (redo) -;; | | -;; o x (redo) -;; -;; -;; What about redo-in-region? Obviously, redo-in-region only makes sense if -;; you have already undone some changes, so that there are some changes to -;; redo! Redoing-in-region splits off a new branch of the undo history below -;; your current location in the undo tree. This time, the new branch consists -;; of a first redo step that redoes some of the redo changes that affect the -;; current region, followed by *all* the remaining redo changes. -;; -;; Previous undo history Redo-in-region -;; -;; o o -;; | | -;; | | -;; | | -;; x o_ -;; | | \ -;; | | x (redo-in-region) -;; | | | -;; o o | -;; | | | -;; | | | -;; | | | -;; o o o -;; -;; As long as you don't change the active region after redoing-in-region, -;; continuing to redo-in-region extends the new branch, pulling more redo -;; changes into a redo step immediately below your current location in the -;; undo tree. -;; -;; First redo-in-region Second redo-in-region -;; -;; o o -;; | | -;; | | -;; | | -;; o_ o_ -;; | \ | \ -;; | x | o -;; | | | | -;; o | o | -;; | | | | -;; | | | x (redo-in-region) -;; | | | | -;; o o o o -;; -;; Note that undo-in-region and redo-in-region only ever add new changes to -;; the undo tree, they *never* modify existing undo history. So you can always -;; return to previous buffer states by switching to a previous branch of the -;; tree. - - - -;;; Code: - -(require 'cl-lib) -(require 'queue) -(require 'diff) -(require 'gv) - - - -;;; ===================================================================== -;;; Compatibility hacks for older Emacsen - -;; `characterp' isn't defined in Emacs versions < 23 -(unless (fboundp 'characterp) - (defalias 'characterp 'char-valid-p)) - -;; `region-active-p' isn't defined in Emacs versions < 23 -(unless (fboundp 'region-active-p) - (defun region-active-p () (and transient-mark-mode mark-active))) - - -;; `registerv' defstruct isn't defined in Emacs versions < 24 -(unless (fboundp 'registerv-make) - (defmacro registerv-make (data &rest _dummy) data)) - -(unless (fboundp 'registerv-data) - (defmacro registerv-data (data) data)) - - -;; `diff-no-select' and `diff-file-local-copy' aren't defined in Emacs -;; versions < 24 (copied and adapted from Emacs 24) -(unless (fboundp 'diff-no-select) - (defun diff-no-select (old new &optional switches no-async buf) - ;; Noninteractive helper for creating and reverting diff buffers - (unless (bufferp new) (setq new (expand-file-name new))) - (unless (bufferp old) (setq old (expand-file-name old))) - (or switches (setq switches diff-switches)) ; If not specified, use default. - (unless (listp switches) (setq switches (list switches))) - (or buf (setq buf (get-buffer-create "*Diff*"))) - (let* ((old-alt (diff-file-local-copy old)) - (new-alt (diff-file-local-copy new)) - (command - (mapconcat 'identity - `(,diff-command - ;; Use explicitly specified switches - ,@switches - ,@(mapcar #'shell-quote-argument - (nconc - (when (or old-alt new-alt) - (list "-L" (if (stringp old) - old (prin1-to-string old)) - "-L" (if (stringp new) - new (prin1-to-string new)))) - (list (or old-alt old) - (or new-alt new))))) - " ")) - (thisdir default-directory)) - (with-current-buffer buf - (setq buffer-read-only t) - (buffer-disable-undo (current-buffer)) - (let ((inhibit-read-only t)) - (erase-buffer)) - (buffer-enable-undo (current-buffer)) - (diff-mode) - (set (make-local-variable 'revert-buffer-function) - (lambda (_ignore-auto _noconfirm) - (diff-no-select old new switches no-async (current-buffer)))) - (setq default-directory thisdir) - (let ((inhibit-read-only t)) - (insert command "\n")) - (if (and (not no-async) (fboundp 'start-process)) - (let ((proc (start-process "Diff" buf shell-file-name - shell-command-switch command))) - (set-process-filter proc 'diff-process-filter) - (set-process-sentinel - proc (lambda (proc _msg) - (with-current-buffer (process-buffer proc) - (diff-sentinel (process-exit-status proc)) - (if old-alt (delete-file old-alt)) - (if new-alt (delete-file new-alt)))))) - ;; Async processes aren't available. - (let ((inhibit-read-only t)) - (diff-sentinel - (call-process shell-file-name nil buf nil - shell-command-switch command)) - (if old-alt (delete-file old-alt)) - (if new-alt (delete-file new-alt))))) - buf))) - -(unless (fboundp 'diff-file-local-copy) - (defun diff-file-local-copy (file-or-buf) - (if (bufferp file-or-buf) - (with-current-buffer file-or-buf - (let ((tempfile (make-temp-file "buffer-content-"))) - (write-region nil nil tempfile nil 'nomessage) - tempfile)) - (file-local-copy file-or-buf)))) - - -;; `user-error' isn't defined in Emacs < 24.3 -(unless (fboundp 'user-error) - (defalias 'user-error 'error) - ;; prevent debugger being called on user errors - (add-to-list 'debug-ignored-errors "^No further undo information") - (add-to-list 'debug-ignored-errors "^No further redo information") - (add-to-list 'debug-ignored-errors "^No further redo information for region")) - - - - - -;;; ===================================================================== -;;; Global variables and customization options - -(defvar buffer-undo-tree nil - "Tree of undo entries in current buffer.") -(put 'buffer-undo-tree 'permanent-local t) -(make-variable-buffer-local 'buffer-undo-tree) - - -(defgroup undo-tree nil - "Tree undo/redo." - :group 'undo) - - -(defcustom undo-tree-limit 80000000 - "Value of `undo-limit' used in `undo-tree-mode'. - -If `undo-limit' is larger than `undo-tree-limit', the larger of -the two values will be used. - -See also `undo-tree-strong-limit' and `undo-tree-outer-limit'. - -Setting this to nil prevents `undo-tree-mode' ever discarding -undo history. (As far as possible. In principle, it is still -possible for Emacs to discard undo history behind -`undo-tree-mode's back.) USE THIS SETTING AT YOUR OWN RISK! Emacs -may crash if undo history exceeds Emacs' available memory. This -is particularly risky if `undo-tree-auto-save-history' is -enabled, as in that case undo history is preserved even between -Emacs sessions." - :group 'undo-tree - :type '(choice integer (const nil))) - - -(defcustom undo-tree-strong-limit 120000000 - "Value of `undo-strong-limit' used in `undo-tree-mode'. - -If `undo-strong-limit' is larger than `undo-tree-strong-limit' -the larger of the two values will be used." - :group 'undo-tree - :type 'integer) - - -(defcustom undo-tree-outer-limit 360000000 - "Value of `undo-outer-limit' used in `undo-tree-mode'. - -If `undo-outer-limit' is larger than `undo-tree-outer-limit' the -larger of the two values will be used." - :group 'undo-tree - :type 'integer) - - -(defcustom undo-tree-mode-lighter " Undo-Tree" - "Lighter displayed in mode line -when `undo-tree-mode' is enabled." - :group 'undo-tree - :type 'string) - - -(defcustom undo-tree-incompatible-major-modes '(term-mode) - "List of major-modes in which `undo-tree-mode' should not be enabled. -\(See `turn-on-undo-tree-mode'.\)" - :group 'undo-tree - :type '(repeat symbol)) - - -(defcustom undo-tree-enable-undo-in-region nil - "When non-nil, enable undo-in-region. - -When undo-in-region is enabled, undoing or redoing when the -region is active (in `transient-mark-mode') or with a prefix -argument (not in `transient-mark-mode') only undoes changes -within the current region." - :group 'undo-tree - :type 'boolean) - - -(defcustom undo-tree-auto-save-history t - "When non-nil, `undo-tree-mode' will save undo history to file -when a buffer is saved to file. - -It will automatically load undo history when a buffer is loaded -from file, if an undo save file exists. - -By default, undo-tree history is saved to a file called -\"..~undo-tree~\" in the same directory as the -file itself. To save under a different directory, customize -`undo-tree-history-directory-alist' (see the documentation for -that variable for details). - -WARNING! `undo-tree-auto-save-history' will not work properly in -Emacs versions prior to 24.3, so it cannot be enabled via -the customization interface in versions earlier than that one. To -ignore this warning and enable it regardless, set -`undo-tree-auto-save-history' to a non-nil value outside of -customize." - :group 'undo-tree - :type (if (version-list-< (version-to-list emacs-version) '(24 3)) - '(choice (const :tag "" nil)) - 'boolean)) - - -(defcustom undo-tree-history-directory-alist nil - "Alist of filename patterns and undo history directory names. -Each element looks like (REGEXP . DIRECTORY). Undo history for -files with names matching REGEXP will be saved in DIRECTORY. -DIRECTORY may be relative or absolute. If it is absolute, so -that all matching files are backed up into the same directory, -the file names in this directory will be the full name of the -file backed up with all directory separators changed to `!' to -prevent clashes. This will not work correctly if your filesystem -truncates the resulting name. - -For the common case of all backups going into one directory, the -alist should contain a single element pairing \".\" with the -appropriate directory name. - -If this variable is nil, or it fails to match a filename, the -backup is made in the original file's directory. - -On MS-DOS filesystems without long names this variable is always -ignored." - :group 'undo-tree - :type '(repeat (cons (regexp :tag "Regexp matching filename") - (directory :tag "Undo history directory name")))) - - - -(defcustom undo-tree-visualizer-relative-timestamps t - "When non-nil, display times relative to current time -when displaying time stamps in visualizer. - -Otherwise, display absolute times." - :group 'undo-tree - :type 'boolean) - - -(defcustom undo-tree-visualizer-timestamps nil - "When non-nil, display time-stamps by default -in undo-tree visualizer. - -\\You can always toggle time-stamps on and off \ -using \\[undo-tree-visualizer-toggle-timestamps], regardless of the -setting of this variable." - :group 'undo-tree - :type 'boolean) - - -(defcustom undo-tree-visualizer-diff nil - "When non-nil, display diff by default in undo-tree visualizer. - -\\You can always toggle the diff display \ -using \\[undo-tree-visualizer-toggle-diff], regardless of the -setting of this variable." - :group 'undo-tree - :type 'boolean) - - -(defcustom undo-tree-visualizer-lazy-drawing 100 - "When non-nil, use lazy undo-tree drawing in visualizer. - -Setting this to a number causes the visualizer to switch to lazy -drawing when the number of nodes in the tree is larger than this -value. - -Lazy drawing means that only the visible portion of the tree will -be drawn initially, and the tree will be extended later as -needed. For the most part, the only visible effect of this is to -significantly speed up displaying the visualizer for very large -trees. - -There is one potential negative effect of lazy drawing. Other -branches of the tree will only be drawn once the node from which -they branch off becomes visible. So it can happen that certain -portions of the tree that would be shown with lazy drawing -disabled, will not be drawn immediately when it is -enabled. However, this effect is quite rare in practice." - :group 'undo-tree - :type '(choice (const :tag "never" nil) - (const :tag "always" t) - (integer :tag "> size"))) - - -(defvar undo-tree-pre-save-element-functions '() - "Special hook to modify undo-tree elements prior to saving. -Each function on this hook is called in turn on each undo element -in the tree by `undo-tree-save-history' prior to writing the undo -history to file. It should return either nil, which removes that -undo element from the saved history, or a replacement element to -use instead (which should be identical to the original element if -that element should be saved unchanged).") - - -(defvar undo-tree-post-load-element-functions '() - "Special hook to modify undo-tree undo elements after loading. -Each function on this hook is called in turn on each undo element -in the tree by `undo-tree-load-history' after loading the undo -history from file. It should return either nil, which removes that -undo element from the loaded history, or a replacement element to -use instead (which should be identical to the original element if -that element should be loaded unchanged).") - - -(defface undo-tree-visualizer-default-face - '((((class color)) :foreground "gray")) - "Face used to draw undo-tree in visualizer." - :group 'undo-tree) - -(defface undo-tree-visualizer-current-face - '((((class color)) :foreground "red")) - "Face used to highlight current undo-tree node in visualizer." - :group 'undo-tree) - -(defface undo-tree-visualizer-active-branch-face - '((((class color) (background dark)) - (:foreground "white" :weight bold)) - (((class color) (background light)) - (:foreground "black" :weight bold))) - "Face used to highlight active undo-tree branch in visualizer." - :group 'undo-tree) - -(defface undo-tree-visualizer-register-face - '((((class color)) :foreground "yellow")) - "Face used to highlight undo-tree nodes saved to a register -in visualizer." - :group 'undo-tree) - -(defface undo-tree-visualizer-unmodified-face - '((((class color)) :foreground "cyan")) - "Face used to highlight nodes corresponding to unmodified buffers -in visualizer." - :group 'undo-tree) - - -(defvar undo-tree-visualizer-parent-buffer nil - "Parent buffer in visualizer.") -(put 'undo-tree-visualizer-parent-buffer 'permanent-local t) -(make-variable-buffer-local 'undo-tree-visualizer-parent-buffer) - -;; stores modification time of parent buffer's file, if any -(defvar undo-tree-visualizer-parent-mtime nil) -(put 'undo-tree-visualizer-parent-mtime 'permanent-local t) -(make-variable-buffer-local 'undo-tree-visualizer-parent-mtime) - -;; stores current horizontal spacing needed for drawing undo-tree -(defvar undo-tree-visualizer-spacing nil) -(put 'undo-tree-visualizer-spacing 'permanent-local t) -(make-variable-buffer-local 'undo-tree-visualizer-spacing) - -;; calculate horizontal spacing required for drawing tree with current -;; settings -(defsubst undo-tree-visualizer-calculate-spacing () - (if undo-tree-visualizer-timestamps - (if undo-tree-visualizer-relative-timestamps 9 13) - 3)) - -;; holds node that was current when visualizer was invoked -(defvar undo-tree-visualizer-initial-node nil) -(put 'undo-tree-visualizer-initial-node 'permanent-local t) -(make-variable-buffer-local 'undo-tree-visualizer-initial-node) - -;; holds currently selected node in visualizer selection mode -(defvar undo-tree-visualizer-selected-node nil) -(put 'undo-tree-visualizer-selected-node 'permanent-local t) -(make-variable-buffer-local 'undo-tree-visualizer-selected) - -;; used to store nodes at edge of currently drawn portion of tree -(defvar undo-tree-visualizer-needs-extending-down nil) -(put 'undo-tree-visualizer-needs-extending-down 'permanent-local t) -(make-variable-buffer-local 'undo-tree-visualizer-needs-extending-down) -(defvar undo-tree-visualizer-needs-extending-up nil) -(put 'undo-tree-visualizer-needs-extending-up 'permanent-local t) -(make-variable-buffer-local 'undo-tree-visualizer-needs-extending-up) - -;; dynamically bound to t when undoing from visualizer, to inhibit -;; `undo-tree-kill-visualizer' hook function in parent buffer -(defvar undo-tree-inhibit-kill-visualizer nil) - -;; can be let-bound to a face name, used in drawing functions -(defvar undo-tree-insert-face nil) - -;; visualizer buffer names -(defconst undo-tree-visualizer-buffer-name " *undo-tree*") -(defconst undo-tree-diff-buffer-name "*undo-tree Diff*") - - - - -;;; ================================================================= -;;; Default keymaps - -(defvar undo-tree-map nil - "Keymap used in undo-tree-mode.") - -(unless undo-tree-map - (let ((map (make-sparse-keymap))) - ;; remap `undo' and `undo-only' to `undo-tree-undo' - (define-key map [remap undo] 'undo-tree-undo) - (define-key map [remap undo-only] 'undo-tree-undo) - ;; bind standard undo bindings (since these match redo counterparts) - (define-key map (kbd "C-/") 'undo-tree-undo) - (define-key map "\C-_" 'undo-tree-undo) - ;; redo doesn't exist normally, so define our own keybindings - (define-key map (kbd "C-?") 'undo-tree-redo) - (define-key map (kbd "M-_") 'undo-tree-redo) - ;; just in case something has defined `redo'... - (define-key map [remap redo] 'undo-tree-redo) - ;; we use "C-x u" for the undo-tree visualizer - (define-key map (kbd "\C-x u") 'undo-tree-visualize) - ;; bind register commands - (define-key map (kbd "C-x r u") 'undo-tree-save-state-to-register) - (define-key map (kbd "C-x r U") 'undo-tree-restore-state-from-register) - ;; set keymap - (setq undo-tree-map map))) - - -(defvar undo-tree-visualizer-mode-map nil - "Keymap used in undo-tree visualizer.") - -(unless undo-tree-visualizer-mode-map - (let ((map (make-sparse-keymap))) - ;; vertical motion keys undo/redo - (define-key map [remap previous-line] 'undo-tree-visualize-undo) - (define-key map [remap next-line] 'undo-tree-visualize-redo) - (define-key map [up] 'undo-tree-visualize-undo) - (define-key map "p" 'undo-tree-visualize-undo) - (define-key map "\C-p" 'undo-tree-visualize-undo) - (define-key map [down] 'undo-tree-visualize-redo) - (define-key map "n" 'undo-tree-visualize-redo) - (define-key map "\C-n" 'undo-tree-visualize-redo) - ;; horizontal motion keys switch branch - (define-key map [remap forward-char] - 'undo-tree-visualize-switch-branch-right) - (define-key map [remap backward-char] - 'undo-tree-visualize-switch-branch-left) - (define-key map [right] 'undo-tree-visualize-switch-branch-right) - (define-key map "f" 'undo-tree-visualize-switch-branch-right) - (define-key map "\C-f" 'undo-tree-visualize-switch-branch-right) - (define-key map [left] 'undo-tree-visualize-switch-branch-left) - (define-key map "b" 'undo-tree-visualize-switch-branch-left) - (define-key map "\C-b" 'undo-tree-visualize-switch-branch-left) - ;; paragraph motion keys undo/redo to significant points in tree - (define-key map [remap backward-paragraph] 'undo-tree-visualize-undo-to-x) - (define-key map [remap forward-paragraph] 'undo-tree-visualize-redo-to-x) - (define-key map "\M-{" 'undo-tree-visualize-undo-to-x) - (define-key map "\M-}" 'undo-tree-visualize-redo-to-x) - (define-key map [C-up] 'undo-tree-visualize-undo-to-x) - (define-key map [C-down] 'undo-tree-visualize-redo-to-x) - ;; mouse sets buffer state to node at click - (define-key map [mouse-1] 'undo-tree-visualizer-mouse-set) - ;; toggle timestamps - (define-key map "t" 'undo-tree-visualizer-toggle-timestamps) - ;; toggle diff - (define-key map "d" 'undo-tree-visualizer-toggle-diff) - ;; toggle selection mode - (define-key map "s" 'undo-tree-visualizer-selection-mode) - ;; horizontal scrolling may be needed if the tree is very wide - (define-key map "," 'undo-tree-visualizer-scroll-left) - (define-key map "." 'undo-tree-visualizer-scroll-right) - (define-key map "<" 'undo-tree-visualizer-scroll-left) - (define-key map ">" 'undo-tree-visualizer-scroll-right) - ;; vertical scrolling may be needed if the tree is very tall - (define-key map [next] 'undo-tree-visualizer-scroll-up) - (define-key map [prior] 'undo-tree-visualizer-scroll-down) - ;; quit/abort visualizer - (define-key map "q" 'undo-tree-visualizer-quit) - (define-key map "\C-q" 'undo-tree-visualizer-abort) - ;; set keymap - (setq undo-tree-visualizer-mode-map map))) - - -(defvar undo-tree-visualizer-selection-mode-map nil - "Keymap used in undo-tree visualizer selection mode.") - -(unless undo-tree-visualizer-selection-mode-map - (let ((map (make-sparse-keymap))) - ;; vertical motion keys move up and down tree - (define-key map [remap previous-line] - 'undo-tree-visualizer-select-previous) - (define-key map [remap next-line] - 'undo-tree-visualizer-select-next) - (define-key map [up] 'undo-tree-visualizer-select-previous) - (define-key map "p" 'undo-tree-visualizer-select-previous) - (define-key map "\C-p" 'undo-tree-visualizer-select-previous) - (define-key map [down] 'undo-tree-visualizer-select-next) - (define-key map "n" 'undo-tree-visualizer-select-next) - (define-key map "\C-n" 'undo-tree-visualizer-select-next) - ;; vertical scroll keys move up and down quickly - (define-key map [next] - (lambda () (interactive) (undo-tree-visualizer-select-next 10))) - (define-key map [prior] - (lambda () (interactive) (undo-tree-visualizer-select-previous 10))) - ;; horizontal motion keys move to left and right siblings - (define-key map [remap forward-char] 'undo-tree-visualizer-select-right) - (define-key map [remap backward-char] 'undo-tree-visualizer-select-left) - (define-key map [right] 'undo-tree-visualizer-select-right) - (define-key map "f" 'undo-tree-visualizer-select-right) - (define-key map "\C-f" 'undo-tree-visualizer-select-right) - (define-key map [left] 'undo-tree-visualizer-select-left) - (define-key map "b" 'undo-tree-visualizer-select-left) - (define-key map "\C-b" 'undo-tree-visualizer-select-left) - ;; horizontal scroll keys move left or right quickly - (define-key map "," - (lambda () (interactive) (undo-tree-visualizer-select-left 10))) - (define-key map "." - (lambda () (interactive) (undo-tree-visualizer-select-right 10))) - (define-key map "<" - (lambda () (interactive) (undo-tree-visualizer-select-left 10))) - (define-key map ">" - (lambda () (interactive) (undo-tree-visualizer-select-right 10))) - ;; sets buffer state to node at point - (define-key map "\r" 'undo-tree-visualizer-set) - ;; mouse selects node at click - (define-key map [mouse-1] 'undo-tree-visualizer-mouse-select) - ;; toggle diff - (define-key map "d" 'undo-tree-visualizer-selection-toggle-diff) - ;; set keymap - (setq undo-tree-visualizer-selection-mode-map map))) - - - - -;;; ===================================================================== -;;; Undo-tree data structure - -(cl-defstruct - (undo-tree - :named - (:constructor nil) - (:constructor make-undo-tree - (&aux - (root (undo-tree-make-node nil nil)) - (current root) - (size 0) - (count 0) - (object-pool (make-hash-table :test 'eq :weakness 'value)))) - (:copier nil)) - root current size count object-pool) - -(defun undo-tree-copy (tree) - ;; Return a copy of undo-tree TREE. - (unwind-protect - (let ((new (make-undo-tree))) - (undo-tree-decircle tree) - (let ((max-lisp-eval-depth (* 100 (undo-tree-count tree))) - (max-specpdl-size (* 100 (undo-tree-count tree)))) - (setf (undo-tree-root new) - (undo-tree-node-copy (undo-tree-root tree) - new (undo-tree-current tree)))) - (setf (undo-tree-size new) - (undo-tree-size tree)) - (setf (undo-tree-count new) - (undo-tree-count tree)) - (setf (undo-tree-object-pool new) - (copy-hash-table (undo-tree-object-pool tree))) - (undo-tree-recircle new) - new) - (undo-tree-recircle tree))) - - -(cl-defstruct - (undo-tree-node - (:type vector) ; create unnamed struct - (:constructor nil) - (:constructor undo-tree-make-node - (previous undo - &optional redo - &aux - (timestamp (current-time)) - (branch 0))) - (:constructor undo-tree-make-node-backwards - (next-node undo - &optional redo - &aux - (next (list next-node)) - (timestamp (current-time)) - (branch 0))) - (:constructor undo-tree-make-empty-node ()) - (:constructor undo-tree-copy-node-save-data - (node - &aux - (undo (let ((changeset (undo-tree-node-undo node))) - (run-hook-wrapped - 'undo-tree-pre-save-element-functions - (lambda (fun) - (setq changeset (delq nil (mapcar fun changeset))) - nil)) - changeset)) - (redo (let ((changeset (undo-tree-node-redo node))) - (run-hook-wrapped - 'undo-tree-pre-save-element-functions - (lambda (fun) - (setq changeset (delq nil (mapcar fun changeset))) - nil)) - changeset)) - (timestamp (undo-tree-node-timestamp node)) - (branch (undo-tree-node-branch node)) - (meta-data (undo-tree-node-meta-data node)))) - (:copier nil)) - previous next undo redo timestamp branch meta-data) - - -(defmacro undo-tree-node-p (n) - (let ((len (length (undo-tree-make-node nil nil)))) - `(and (vectorp ,n) (= (length ,n) ,len)))) - -(defun undo-tree-node-copy (node &optional tree current) - ;; Return a deep copy of undo-tree NODE, sans previous link or meta-data. - ;; If TREE and CURRENT are supplied, set (undo-tree-current TREE) to the - ;; copy of CURRENT node, if found. - (let* ((new (undo-tree-make-empty-node)) - (stack (list (cons node new))) - n) - (while (setq n (pop stack)) - (setf (undo-tree-node-undo (cdr n)) - (copy-tree (undo-tree-node-undo (car n)) 'copy-vectors)) - (setf (undo-tree-node-redo (cdr n)) - (copy-tree (undo-tree-node-redo (car n)) 'copy-vectors)) - (setf (undo-tree-node-timestamp (cdr n)) - (copy-sequence (undo-tree-node-timestamp (car n)))) - (setf (undo-tree-node-branch (cdr n)) - (undo-tree-node-branch (car n))) - (setf (undo-tree-node-next (cdr n)) - (mapcar (lambda (_) (undo-tree-make-empty-node)) - (make-list (length (undo-tree-node-next (car n))) nil))) - ;; set (undo-tree-current TREE) to copy if we've found CURRENT - (when (and tree (eq (car n) current)) - (setf (undo-tree-current tree) (cdr n))) - ;; recursively copy next nodes - (let ((next0 (undo-tree-node-next (car n))) - (next1 (undo-tree-node-next (cdr n)))) - (while (and next0 next1) - (push (cons (pop next0) (pop next1)) stack)))) - new)) - - -(cl-defstruct - (undo-tree-region-data - (:type vector) ; create unnamed struct - (:constructor nil) - (:constructor undo-tree-make-region-data - (&optional undo-beginning undo-end - redo-beginning redo-end)) - (:constructor undo-tree-make-undo-region-data - (undo-beginning undo-end)) - (:constructor undo-tree-make-redo-region-data - (redo-beginning redo-end)) - (:copier nil)) - undo-beginning undo-end redo-beginning redo-end) - - -(defmacro undo-tree-region-data-p (r) - (let ((len (length (undo-tree-make-region-data)))) - `(and (vectorp ,r) (= (length ,r) ,len)))) - -(defmacro undo-tree-node-clear-region-data (node) - `(setf (undo-tree-node-meta-data ,node) - (delq nil - (delq :region - (plist-put (undo-tree-node-meta-data ,node) - :region nil))))) - - -(defmacro undo-tree-node-undo-beginning (node) - `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) - (when (undo-tree-region-data-p r) - (undo-tree-region-data-undo-beginning r)))) - -(defmacro undo-tree-node-undo-end (node) - `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) - (when (undo-tree-region-data-p r) - (undo-tree-region-data-undo-end r)))) - -(defmacro undo-tree-node-redo-beginning (node) - `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) - (when (undo-tree-region-data-p r) - (undo-tree-region-data-redo-beginning r)))) - -(defmacro undo-tree-node-redo-end (node) - `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) - (when (undo-tree-region-data-p r) - (undo-tree-region-data-redo-end r)))) - - -(gv-define-setter undo-tree-node-undo-beginning (val node) - `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) - (unless (undo-tree-region-data-p r) - (setf (undo-tree-node-meta-data ,node) - (plist-put (undo-tree-node-meta-data ,node) :region - (setq r (undo-tree-make-region-data))))) - (setf (undo-tree-region-data-undo-beginning r) ,val))) - -(gv-define-setter undo-tree-node-undo-end (val node) - `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) - (unless (undo-tree-region-data-p r) - (setf (undo-tree-node-meta-data ,node) - (plist-put (undo-tree-node-meta-data ,node) :region - (setq r (undo-tree-make-region-data))))) - (setf (undo-tree-region-data-undo-end r) ,val))) - -(gv-define-setter undo-tree-node-redo-beginning (val node) - `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) - (unless (undo-tree-region-data-p r) - (setf (undo-tree-node-meta-data ,node) - (plist-put (undo-tree-node-meta-data ,node) :region - (setq r (undo-tree-make-region-data))))) - (setf (undo-tree-region-data-redo-beginning r) ,val))) - -(gv-define-setter undo-tree-node-redo-end (val node) - `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region))) - (unless (undo-tree-region-data-p r) - (setf (undo-tree-node-meta-data ,node) - (plist-put (undo-tree-node-meta-data ,node) :region - (setq r (undo-tree-make-region-data))))) - (setf (undo-tree-region-data-redo-end r) ,val))) - - - -(cl-defstruct - (undo-tree-visualizer-data - (:type vector) ; create unnamed struct - (:constructor nil) - (:constructor undo-tree-make-visualizer-data - (&optional lwidth cwidth rwidth marker)) - (:copier nil)) - lwidth cwidth rwidth marker) - - -(defmacro undo-tree-visualizer-data-p (v) - (let ((len (length (undo-tree-make-visualizer-data)))) - `(and (vectorp ,v) (= (length ,v) ,len)))) - -(defun undo-tree-node-clear-visualizer-data (node) - (let ((plist (undo-tree-node-meta-data node))) - (if (eq (car plist) :visualizer) - (setf (undo-tree-node-meta-data node) (nthcdr 2 plist)) - (while (and plist (not (eq (cadr plist) :visualizer))) - (setq plist (cdr plist))) - (if plist (setcdr plist (nthcdr 3 plist)))))) - -(defmacro undo-tree-node-lwidth (node) - `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) - (when (undo-tree-visualizer-data-p v) - (undo-tree-visualizer-data-lwidth v)))) - -(defmacro undo-tree-node-cwidth (node) - `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) - (when (undo-tree-visualizer-data-p v) - (undo-tree-visualizer-data-cwidth v)))) - -(defmacro undo-tree-node-rwidth (node) - `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) - (when (undo-tree-visualizer-data-p v) - (undo-tree-visualizer-data-rwidth v)))) - -(defmacro undo-tree-node-marker (node) - `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) - (when (undo-tree-visualizer-data-p v) - (undo-tree-visualizer-data-marker v)))) - - -(gv-define-setter undo-tree-node-lwidth (val node) - `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) - (unless (undo-tree-visualizer-data-p v) - (setf (undo-tree-node-meta-data ,node) - (plist-put (undo-tree-node-meta-data ,node) :visualizer - (setq v (undo-tree-make-visualizer-data))))) - (setf (undo-tree-visualizer-data-lwidth v) ,val))) - -(gv-define-setter undo-tree-node-cwidth (val node) - `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) - (unless (undo-tree-visualizer-data-p v) - (setf (undo-tree-node-meta-data ,node) - (plist-put (undo-tree-node-meta-data ,node) :visualizer - (setq v (undo-tree-make-visualizer-data))))) - (setf (undo-tree-visualizer-data-cwidth v) ,val))) - -(gv-define-setter undo-tree-node-rwidth (val node) - `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) - (unless (undo-tree-visualizer-data-p v) - (setf (undo-tree-node-meta-data ,node) - (plist-put (undo-tree-node-meta-data ,node) :visualizer - (setq v (undo-tree-make-visualizer-data))))) - (setf (undo-tree-visualizer-data-rwidth v) ,val))) - -(gv-define-setter undo-tree-node-marker (val node) - `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer))) - (unless (undo-tree-visualizer-data-p v) - (setf (undo-tree-node-meta-data ,node) - (plist-put (undo-tree-node-meta-data ,node) :visualizer - (setq v (undo-tree-make-visualizer-data))))) - (setf (undo-tree-visualizer-data-marker v) ,val))) - - - -(cl-defstruct - (undo-tree-register-data - (:type vector) - (:constructor nil) - (:constructor undo-tree-make-register-data (buffer node))) - buffer node) - -(defun undo-tree-register-data-p (data) - (and (vectorp data) - (= (length data) 2) - (undo-tree-node-p (undo-tree-register-data-node data)))) - -(defun undo-tree-register-data-print-func (data) - (princ (format "an undo-tree state for buffer %s" - (undo-tree-register-data-buffer data)))) - -(defmacro undo-tree-node-register (node) - `(plist-get (undo-tree-node-meta-data ,node) :register)) - -(gv-define-setter undo-tree-node-register (val node) - `(setf (undo-tree-node-meta-data ,node) - (plist-put (undo-tree-node-meta-data ,node) :register ,val))) - - - - -;;; ===================================================================== -;;; Basic undo-tree data structure functions - -(defun undo-tree-grow (undo) - "Add an UNDO node to current branch of `buffer-undo-tree'." - (let* ((current (undo-tree-current buffer-undo-tree)) - (new (undo-tree-make-node current undo))) - (push new (undo-tree-node-next current)) - (setf (undo-tree-current buffer-undo-tree) new))) - - -(defun undo-tree-grow-backwards (node undo &optional redo) - "Add new node *above* undo-tree NODE, and return new node. -Note that this will overwrite NODE's \"previous\" link, so should -only be used on a detached NODE, never on nodes that are already -part of `buffer-undo-tree'." - (let ((new (undo-tree-make-node-backwards node undo redo))) - (setf (undo-tree-node-previous node) new) - new)) - - -(defun undo-tree-splice-node (node splice) - "Splice NODE into undo tree, below node SPLICE. -Note that this will overwrite NODE's \"next\" and \"previous\" -links, so should only be used on a detached NODE, never on nodes -that are already part of `buffer-undo-tree'." - (setf (undo-tree-node-next node) (undo-tree-node-next splice) - (undo-tree-node-branch node) (undo-tree-node-branch splice) - (undo-tree-node-previous node) splice - (undo-tree-node-next splice) (list node) - (undo-tree-node-branch splice) 0) - (dolist (n (undo-tree-node-next node)) - (setf (undo-tree-node-previous n) node))) - - -(defun undo-tree-snip-node (node) - "Snip NODE out of undo tree." - (let* ((parent (undo-tree-node-previous node)) - position p) - ;; if NODE is only child, replace parent's next links with NODE's - (if (= (length (undo-tree-node-next parent)) 0) - (setf (undo-tree-node-next parent) (undo-tree-node-next node) - (undo-tree-node-branch parent) (undo-tree-node-branch node)) - ;; otherwise... - (setq position (undo-tree-position node (undo-tree-node-next parent))) - (cond - ;; if active branch used do go via NODE, set parent's branch to active - ;; branch of NODE - ((= (undo-tree-node-branch parent) position) - (setf (undo-tree-node-branch parent) - (+ position (undo-tree-node-branch node)))) - ;; if active branch didn't go via NODE, update parent's branch to point - ;; to same node as before - ((> (undo-tree-node-branch parent) position) - (cl-incf (undo-tree-node-branch parent) - (1- (length (undo-tree-node-next node)))))) - ;; replace NODE in parent's next list with NODE's entire next list - (if (= position 0) - (setf (undo-tree-node-next parent) - (nconc (undo-tree-node-next node) - (cdr (undo-tree-node-next parent)))) - (setq p (nthcdr (1- position) (undo-tree-node-next parent))) - (setcdr p (nconc (undo-tree-node-next node) (cddr p))))) - ;; update previous links of NODE's children - (dolist (n (undo-tree-node-next node)) - (setf (undo-tree-node-previous n) parent)))) - - -(defun undo-tree-mapc (--undo-tree-mapc-function-- node) - ;; Apply FUNCTION to NODE and to each node below it. - (let ((stack (list node)) - n) - (while (setq n (pop stack)) - (funcall --undo-tree-mapc-function-- n) - (setq stack (append (undo-tree-node-next n) stack))))) - - -(defmacro undo-tree-num-branches () - "Return number of branches at current undo tree node." - '(length (undo-tree-node-next (undo-tree-current buffer-undo-tree)))) - - -(defun undo-tree-position (node list) - "Find the first occurrence of NODE in LIST. -Return the index of the matching item, or nil of not found. -Comparison is done with `eq'." - (let ((i 0)) - (catch 'found - (while (progn - (when (eq node (car list)) (throw 'found i)) - (cl-incf i) - (setq list (cdr list)))) - nil))) - - -(defvar *undo-tree-id-counter* 0) -(make-variable-buffer-local '*undo-tree-id-counter*) - -(defmacro undo-tree-generate-id () - ;; Generate a new, unique id (uninterned symbol). - ;; The name is made by appending a number to "undo-tree-id". - ;; (Copied from CL package `gensym'.) - `(let ((num (prog1 *undo-tree-id-counter* - (cl-incf *undo-tree-id-counter*)))) - (make-symbol (format "undo-tree-id%d" num)))) - - -(defun undo-tree-decircle (undo-tree) - ;; Nullify PREVIOUS links of UNDO-TREE nodes, to make UNDO-TREE data - ;; structure non-circular. - (undo-tree-mapc - (lambda (node) - (dolist (n (undo-tree-node-next node)) - (setf (undo-tree-node-previous n) nil))) - (undo-tree-root undo-tree))) - - -(defun undo-tree-recircle (undo-tree) - ;; Recreate PREVIOUS links of UNDO-TREE nodes, to restore circular UNDO-TREE - ;; data structure. - (undo-tree-mapc - (lambda (node) - (dolist (n (undo-tree-node-next node)) - (setf (undo-tree-node-previous n) node))) - (undo-tree-root undo-tree))) - - - - -;;; ===================================================================== -;;; Undo list and undo changeset utility functions - -(defmacro undo-list-marker-elt-p (elt) - `(markerp (car-safe ,elt))) - -(defmacro undo-list-GCd-marker-elt-p (elt) - ;; Return t if ELT is a marker element whose marker has been moved to the - ;; object-pool, so may potentially have been garbage-collected. - ;; Note: Valid marker undo elements should be uniquely identified as cons - ;; cells with a symbol in the car (replacing the marker), and a number in - ;; the cdr. However, to guard against future changes to undo element - ;; formats, we perform an additional redundant check on the symbol name. - `(and (car-safe ,elt) - (symbolp (car ,elt)) - (let ((str (symbol-name (car ,elt)))) - (and (> (length str) 12) - (string= (substring str 0 12) "undo-tree-id"))) - (numberp (cdr-safe ,elt)))) - - -(defun undo-tree-move-GC-elts-to-pool (elt) - ;; Move elements that can be garbage-collected into `buffer-undo-tree' - ;; object pool, substituting a unique id that can be used to retrieve them - ;; later. (Only markers require this treatment currently.) - (when (undo-list-marker-elt-p elt) - (let ((id (undo-tree-generate-id))) - (puthash id (car elt) (undo-tree-object-pool buffer-undo-tree)) - (setcar elt id)))) - - -(defun undo-tree-restore-GC-elts-from-pool (elt) - ;; Replace object id's in ELT with corresponding objects from - ;; `buffer-undo-tree' object pool and return modified ELT, or return nil if - ;; any object in ELT has been garbage-collected. - (if (undo-list-GCd-marker-elt-p elt) - (when (setcar elt (gethash (car elt) - (undo-tree-object-pool buffer-undo-tree))) - elt) - elt)) - - -(defun undo-list-clean-GCd-elts (undo-list) - ;; Remove object id's from UNDO-LIST that refer to elements that have been - ;; garbage-collected. UNDO-LIST is modified by side-effect. - (while (undo-list-GCd-marker-elt-p (car undo-list)) - (unless (gethash (caar undo-list) - (undo-tree-object-pool buffer-undo-tree)) - (setq undo-list (cdr undo-list)))) - (let ((p undo-list)) - (while (cdr p) - (when (and (undo-list-GCd-marker-elt-p (cadr p)) - (null (gethash (car (cadr p)) - (undo-tree-object-pool buffer-undo-tree)))) - (setcdr p (cddr p))) - (setq p (cdr p)))) - undo-list) - - -(defun undo-list-found-canary-p (undo-list) - (or (eq (car undo-list) 'undo-tree-canary) - (and (null (car undo-list)) - (eq (cadr undo-list) 'undo-tree-canary)))) - - -(defmacro undo-list-pop-changeset (undo-list &optional discard-pos) - ;; Pop changeset from `undo-list'. If DISCARD-POS is non-nil, discard - ;; any position entries from changeset. - `(when (and ,undo-list (not (undo-list-found-canary-p ,undo-list))) - (let (changeset) - ;; discard initial undo boundary(ies) - (while (null (car ,undo-list)) (setq ,undo-list (cdr ,undo-list))) - ;; pop elements up to next undo boundary, discarding position entries - ;; if DISCARD-POS is non-nil - (while (null changeset) - (while (and ,undo-list (car ,undo-list) - (not (undo-list-found-canary-p ,undo-list))) - (if (and ,discard-pos (integerp (car ,undo-list))) - (setq ,undo-list (cdr ,undo-list)) - (push (pop ,undo-list) changeset) - (undo-tree-move-GC-elts-to-pool (car changeset))))) - (nreverse changeset)))) - - -(defun undo-tree-copy-list (undo-list) - ;; Return a deep copy of first changeset in `undo-list'. Object id's are - ;; replaced by corresponding objects from `buffer-undo-tree' object-pool. - (let (copy p) - ;; if first element contains an object id, replace it with object from - ;; pool, discarding element entirely if it's been GC'd - (while (and undo-list (null copy)) - (setq copy - (undo-tree-restore-GC-elts-from-pool (pop undo-list)))) - (when copy - (setq copy (list copy) - p copy) - ;; copy remaining elements, replacing object id's with objects from - ;; pool, or discarding them entirely if they've been GC'd - (while undo-list - (when (setcdr p (undo-tree-restore-GC-elts-from-pool - (undo-copy-list-1 (pop undo-list)))) - (setcdr p (list (cdr p))) - (setq p (cdr p)))) - copy))) - - -(defvar undo-tree-gc-flag nil) - -(defun undo-tree-post-gc () - (setq undo-tree-gc-flag t)) - - -(defun undo-list-transfer-to-tree () - ;; Transfer entries accumulated in `undo-list' to `buffer-undo-tree'. - - ;; `undo-list-transfer-to-tree' should never be called when undo is disabled - ;; (i.e. `buffer-undo-tree' is t) - (cl-assert (not (eq buffer-undo-tree t))) - - ;; if `buffer-undo-tree' is empty, create initial undo-tree - (when (null buffer-undo-tree) (setq buffer-undo-tree (make-undo-tree))) - - ;; garbage-collect then repeatedly try to deep-copy `buffer-undo-list' until - ;; we succeed without GC running, in an attempt to mitigate race conditions - ;; with garbage collector corrupting undo history (is this even a thing?!) - (unless (or (null buffer-undo-list) - (undo-list-found-canary-p buffer-undo-list)) - (garbage-collect)) - (let (undo-list changeset) - (setq undo-tree-gc-flag t) - (while undo-tree-gc-flag - (setq undo-tree-gc-flag nil - undo-list (copy-tree buffer-undo-list))) - (setq buffer-undo-list (list nil 'undo-tree-canary)) - - ;; create new node from first changeset in `undo-list', save old - ;; `buffer-undo-tree' current node, and make new node the current node - (when (setq changeset (undo-list-pop-changeset undo-list)) - (let* ((node (undo-tree-make-node nil changeset)) - (splice (undo-tree-current buffer-undo-tree)) - (size (undo-list-byte-size (undo-tree-node-undo node))) - (count 1)) - (setf (undo-tree-current buffer-undo-tree) node) - ;; grow tree fragment backwards using `undo-list' changesets - (while (setq changeset (undo-list-pop-changeset undo-list)) - (setq node (undo-tree-grow-backwards node changeset)) - (cl-incf size (undo-list-byte-size (undo-tree-node-undo node))) - (cl-incf count)) - - ;; if no undo history has been discarded from `undo-list' since last - ;; transfer, splice new tree fragment onto end of old - ;; `buffer-undo-tree' current node - (if (undo-list-found-canary-p undo-list) - (progn - (setf (undo-tree-node-previous node) splice) - (push node (undo-tree-node-next splice)) - (setf (undo-tree-node-branch splice) 0) - (cl-incf (undo-tree-size buffer-undo-tree) size) - (cl-incf (undo-tree-count buffer-undo-tree) count)) - - ;; if undo history has been discarded, replace entire - ;; `buffer-undo-tree' with new tree fragment - (unless (= (undo-tree-size buffer-undo-tree) 0) - (message "Undo history discarded by Emacs (see `undo-limit') - rebuilding undo-tree")) - (setq node (undo-tree-grow-backwards node nil)) - (setf (undo-tree-root buffer-undo-tree) node) - (setf (undo-tree-size buffer-undo-tree) size) - (setf (undo-tree-count buffer-undo-tree) count))))) - - ;; discard undo history if necessary - (undo-tree-discard-history)) - - -(defun undo-list-byte-size (undo-list) - ;; Return size (in bytes) of UNDO-LIST - (let ((size 0)) - (dolist (elt undo-list) - (cl-incf size 8) ; cons cells use up 8 bytes - (when (stringp (car-safe elt)) - (cl-incf size (string-bytes (car elt))))) - size)) - - - -(defun undo-list-rebuild-from-tree () - "Rebuild `buffer-undo-list' from information in `buffer-undo-tree'." - (unless (eq buffer-undo-list t) - (undo-list-transfer-to-tree) - (setq buffer-undo-list nil) - (when buffer-undo-tree - (let ((stack (list (list (undo-tree-root buffer-undo-tree))))) - (push (sort (mapcar 'identity (undo-tree-node-next (caar stack))) - (lambda (a b) - (time-less-p (undo-tree-node-timestamp a) - (undo-tree-node-timestamp b)))) - stack) - ;; Traverse tree in depth-and-oldest-first order, but add undo records - ;; on the way down, and redo records on the way up. - (while (or (car stack) - (not (eq (car (nth 1 stack)) - (undo-tree-current buffer-undo-tree)))) - (if (car stack) - (progn - (setq buffer-undo-list - (append (undo-tree-node-undo (caar stack)) - buffer-undo-list)) - (undo-boundary) - (push (sort (mapcar 'identity - (undo-tree-node-next (caar stack))) - (lambda (a b) - (time-less-p (undo-tree-node-timestamp a) - (undo-tree-node-timestamp b)))) - stack)) - (pop stack) - (setq buffer-undo-list - (append (undo-tree-node-redo (caar stack)) - buffer-undo-list)) - (undo-boundary) - (pop (car stack)))))))) - - - - -;;; ===================================================================== -;;; History discarding utility functions - -(defun undo-tree-oldest-leaf (node) - ;; Return oldest leaf node below NODE. - (while (undo-tree-node-next node) - (setq node - (car (sort (mapcar 'identity (undo-tree-node-next node)) - (lambda (a b) - (time-less-p (undo-tree-node-timestamp a) - (undo-tree-node-timestamp b))))))) - node) - - -(defun undo-tree-discard-node (node) - ;; Discard NODE from `buffer-undo-tree', and return next in line for - ;; discarding. - - ;; don't discard current node - (unless (eq node (undo-tree-current buffer-undo-tree)) - - ;; discarding root node... - (if (eq node (undo-tree-root buffer-undo-tree)) - (cond - ;; should always discard branches before root - ((> (length (undo-tree-node-next node)) 1) - (error "Trying to discard undo-tree root which still\ - has multiple branches")) - ;; don't discard root if current node is only child - ((eq (car (undo-tree-node-next node)) - (undo-tree-current buffer-undo-tree)) - nil) - ;; discard root - (t - ;; clear any register referring to root - (let ((r (undo-tree-node-register node))) - (when (and r (eq (get-register r) node)) - (set-register r nil))) - ;; make child of root into new root - (setq node (setf (undo-tree-root buffer-undo-tree) - (car (undo-tree-node-next node)))) - ;; update undo-tree size - (cl-decf (undo-tree-size buffer-undo-tree) - (+ (undo-list-byte-size (undo-tree-node-undo node)) - (undo-list-byte-size (undo-tree-node-redo node)))) - (cl-decf (undo-tree-count buffer-undo-tree)) - ;; discard new root's undo data and PREVIOUS link - (setf (undo-tree-node-undo node) nil - (undo-tree-node-redo node) nil - (undo-tree-node-previous node) nil) - ;; if new root has branches, or new root is current node, next node - ;; to discard is oldest leaf, otherwise it's new root - (if (or (> (length (undo-tree-node-next node)) 1) - (eq (car (undo-tree-node-next node)) - (undo-tree-current buffer-undo-tree))) - (undo-tree-oldest-leaf node) - node))) - - ;; discarding leaf node... - (let* ((parent (undo-tree-node-previous node)) - (current (nth (undo-tree-node-branch parent) - (undo-tree-node-next parent)))) - ;; clear any register referring to the discarded node - (let ((r (undo-tree-node-register node))) - (when (and r (eq (get-register r) node)) - (set-register r nil))) - ;; update undo-tree size - (cl-decf (undo-tree-size buffer-undo-tree) - (+ (undo-list-byte-size (undo-tree-node-undo node)) - (undo-list-byte-size (undo-tree-node-redo node)))) - (cl-decf (undo-tree-count buffer-undo-tree)) - ;; discard leaf - (setf (undo-tree-node-next parent) - (delq node (undo-tree-node-next parent)) - (undo-tree-node-branch parent) - (undo-tree-position current (undo-tree-node-next parent))) - ;; if parent has branches, or parent is current node, next node to - ;; discard is oldest leaf, otherwise it's the parent itself - (if (or (eq parent (undo-tree-current buffer-undo-tree)) - (and (undo-tree-node-next parent) - (or (not (eq parent (undo-tree-root buffer-undo-tree))) - (> (length (undo-tree-node-next parent)) 1)))) - (undo-tree-oldest-leaf parent) - parent))))) - - - -(defun undo-tree-discard-history () - "Discard undo history until we're within memory usage limits -set by `undo-limit', `undo-strong-limit' and `undo-outer-limit'." - - (when (> (undo-tree-size buffer-undo-tree) undo-limit) - ;; if there are no branches off root, first node to discard is root; - ;; otherwise it's leaf node at botom of oldest branch - (let ((node (if (> (length (undo-tree-node-next - (undo-tree-root buffer-undo-tree))) 1) - (undo-tree-oldest-leaf (undo-tree-root buffer-undo-tree)) - (undo-tree-root buffer-undo-tree))) - discarded) - - ;; discard nodes until memory use is within `undo-strong-limit' - (while (and node - (> (undo-tree-size buffer-undo-tree) undo-strong-limit)) - (setq node (undo-tree-discard-node node) - discarded t)) - - ;; discard nodes until next node to discard would bring memory use - ;; within `undo-limit' - (while (and node - ;; check first if last discard has brought us within - ;; `undo-limit', in case we can avoid more expensive - ;; `undo-strong-limit' calculation - ;; Note: this assumes undo-strong-limit > undo-limit; - ;; if not, effectively undo-strong-limit = undo-limit - (> (undo-tree-size buffer-undo-tree) undo-limit) - (> (- (undo-tree-size buffer-undo-tree) - ;; if next node to discard is root, the memory we - ;; free-up comes from discarding changesets from its - ;; only child... - (if (eq node (undo-tree-root buffer-undo-tree)) - (+ (undo-list-byte-size - (undo-tree-node-undo - (car (undo-tree-node-next node)))) - (undo-list-byte-size - (undo-tree-node-redo - (car (undo-tree-node-next node))))) - ;; ...otherwise, it comes from discarding changesets - ;; from along with the node itself - (+ (undo-list-byte-size (undo-tree-node-undo node)) - (undo-list-byte-size (undo-tree-node-redo node))) - )) - undo-limit)) - (setq node (undo-tree-discard-node node) - discarded t)) - - (when discarded - (message "Undo history discarded by undo-tree (see `undo-tree-limit')")) - - ;; if we're still over the `undo-outer-limit', discard entire history - (when (and undo-outer-limit - (> (undo-tree-size buffer-undo-tree) undo-outer-limit)) - ;; query first if `undo-ask-before-discard' is set - (if undo-ask-before-discard - (when (yes-or-no-p - (format - "Buffer `%s' undo info is %d bytes long; discard it? " - (buffer-name) (undo-tree-size buffer-undo-tree))) - (setq buffer-undo-tree nil)) - ;; otherwise, discard and display warning - (display-warning - '(undo discard-info) - (concat - (format "Buffer `%s' undo info was %d bytes long.\n" - (buffer-name) (undo-tree-size buffer-undo-tree)) - "The undo info was discarded because it exceeded\ - `undo-outer-limit'. - -This is normal if you executed a command that made a huge change -to the buffer. In that case, to prevent similar problems in the -future, set `undo-outer-limit' to a value that is large enough to -cover the maximum size of normal changes you expect a single -command to make, but not so large that it might exceed the -maximum memory allotted to Emacs. - -If you did not execute any such command, the situation is -probably due to a bug and you should report it. - -You can disable the popping up of this buffer by adding the entry -\(undo discard-info) to the user option `warning-suppress-types', -which is defined in the `warnings' library.\n") - :warning) - (setq buffer-undo-tree nil))) - - ;; if currently displaying the visualizer, redraw it - (when (and buffer-undo-tree - discarded - (or (eq major-mode 'undo-tree-visualizer-mode) - undo-tree-visualizer-parent-buffer - (get-buffer undo-tree-visualizer-buffer-name))) - (let ((undo-tree buffer-undo-tree)) - (with-current-buffer undo-tree-visualizer-buffer-name - (undo-tree-draw-tree undo-tree) - (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff))))) - ))) - - - - -;;; ===================================================================== -;;; Visualizer utility functions - -(defun undo-tree-compute-widths (node) - "Recursively compute widths for nodes below NODE." - (let ((stack (list node)) - res) - (while stack - ;; try to compute widths for node at top of stack - (if (undo-tree-node-p - (setq res (undo-tree-node-compute-widths (car stack)))) - ;; if computation fails, it returns a node whose widths still need - ;; computing, which we push onto the stack - (push res stack) - ;; otherwise, store widths and remove it from stack - (setf (undo-tree-node-lwidth (car stack)) (aref res 0) - (undo-tree-node-cwidth (car stack)) (aref res 1) - (undo-tree-node-rwidth (car stack)) (aref res 2)) - (pop stack))))) - - -(defun undo-tree-node-compute-widths (node) - ;; Compute NODE's left-, centre-, and right-subtree widths. Returns widths - ;; (in a vector) if successful. Otherwise, returns a node whose widths need - ;; calculating before NODE's can be calculated. - (let ((num-children (length (undo-tree-node-next node))) - (lwidth 0) (cwidth 0) (rwidth 0) p) - (catch 'need-widths - (cond - ;; leaf nodes have 0 width - ((= 0 num-children) - (setf cwidth 1 - (undo-tree-node-lwidth node) 0 - (undo-tree-node-cwidth node) 1 - (undo-tree-node-rwidth node) 0)) - - ;; odd number of children - ((= (mod num-children 2) 1) - (setq p (undo-tree-node-next node)) - ;; compute left-width - (dotimes (_ (/ num-children 2)) - (if (undo-tree-node-lwidth (car p)) - (cl-incf lwidth (+ (undo-tree-node-lwidth (car p)) - (undo-tree-node-cwidth (car p)) - (undo-tree-node-rwidth (car p)))) - ;; if child's widths haven't been computed, return that child - (throw 'need-widths (car p))) - (setq p (cdr p))) - (if (undo-tree-node-lwidth (car p)) - (cl-incf lwidth (undo-tree-node-lwidth (car p))) - (throw 'need-widths (car p))) - ;; centre-width is inherited from middle child - (setf cwidth (undo-tree-node-cwidth (car p))) - ;; compute right-width - (cl-incf rwidth (undo-tree-node-rwidth (car p))) - (setq p (cdr p)) - (dotimes (_ (/ num-children 2)) - (if (undo-tree-node-lwidth (car p)) - (cl-incf rwidth (+ (undo-tree-node-lwidth (car p)) - (undo-tree-node-cwidth (car p)) - (undo-tree-node-rwidth (car p)))) - (throw 'need-widths (car p))) - (setq p (cdr p)))) - - ;; even number of children - (t - (setq p (undo-tree-node-next node)) - ;; compute left-width - (dotimes (_ (/ num-children 2)) - (if (undo-tree-node-lwidth (car p)) - (cl-incf lwidth (+ (undo-tree-node-lwidth (car p)) - (undo-tree-node-cwidth (car p)) - (undo-tree-node-rwidth (car p)))) - (throw 'need-widths (car p))) - (setq p (cdr p))) - ;; centre-width is 0 when number of children is even - (setq cwidth 0) - ;; compute right-width - (dotimes (_ (/ num-children 2)) - (if (undo-tree-node-lwidth (car p)) - (cl-incf rwidth (+ (undo-tree-node-lwidth (car p)) - (undo-tree-node-cwidth (car p)) - (undo-tree-node-rwidth (car p)))) - (throw 'need-widths (car p))) - (setq p (cdr p))))) - - ;; return left-, centre- and right-widths - (vector lwidth cwidth rwidth)))) - - -(defun undo-tree-clear-visualizer-data (tree) - ;; Clear visualizer data below NODE. - (undo-tree-mapc - (lambda (n) (undo-tree-node-clear-visualizer-data n)) - (undo-tree-root tree))) - - -(defun undo-tree-node-unmodified-p (node &optional mtime) - ;; Return non-nil if NODE corresponds to a buffer state that once upon a - ;; time was unmodified. If a file modification time MTIME is specified, - ;; return non-nil if the corresponding buffer state really is unmodified. - (let* ((changeset - (or (undo-tree-node-redo node) - (and (setq changeset (car (undo-tree-node-next node))) - (undo-tree-node-undo changeset)))) - (ntime - (let ((elt (car (last changeset)))) - (and (consp elt) (eq (car elt) t) (consp (cdr elt)) - (cdr elt))))) - (and ntime - (or (null mtime) - ;; high-precision timestamps - (if (listp (cdr ntime)) - (equal ntime mtime) - ;; old-style timestamps - (and (= (car ntime) (car mtime)) - (= (cdr ntime) (cadr mtime)))))))) - - - - -;;; ===================================================================== -;;; Undo-in-region utility functions - -;; `undo-elt-in-region' uses this as a dynamically-scoped variable -(defvar undo-adjusted-markers nil) - - -(defun undo-tree-pull-undo-in-region-branch (start end) - ;; Pull out entries from undo changesets to create a new undo-in-region - ;; branch, which undoes changeset entries lying between START and END first, - ;; followed by remaining entries from the changesets, before rejoining the - ;; existing undo tree history. Repeated calls will, if appropriate, extend - ;; the current undo-in-region branch rather than creating a new one. - - ;; if we're just reverting the last redo-in-region, we don't need to - ;; manipulate the undo tree at all - (if (undo-tree-reverting-redo-in-region-p start end) - t ; return t to indicate success - - ;; We build the `region-changeset' and `delta-list' lists forwards, using - ;; pointers `r' and `d' to the penultimate element of the list. So that we - ;; don't have to treat the first element differently, we prepend a dummy - ;; leading nil to the lists, and have the pointers point to that - ;; initially. - ;; Note: using '(nil) instead of (list nil) in the `let*' results in - ;; errors when the code is byte-compiled, presumably because the - ;; Lisp reader generates a single cons, and that same cons gets used - ;; each call. - (let* ((region-changeset (list nil)) - (r region-changeset) - (delta-list (list nil)) - (d delta-list) - (node (undo-tree-current buffer-undo-tree)) - (repeated-undo-in-region - (undo-tree-repeated-undo-in-region-p start end)) - undo-adjusted-markers ; `undo-elt-in-region' expects this - fragment splice original-fragment original-splice original-current - got-visible-elt undo-list elt) - - ;; --- initialisation --- - (cond - ;; if this is a repeated undo in the same region, start pulling changes - ;; from NODE at which undo-in-region branch is attached, and detatch - ;; the branch, using it as initial FRAGMENT of branch being constructed - (repeated-undo-in-region - (setq original-current node - fragment (car (undo-tree-node-next node)) - splice node) - ;; undo up to node at which undo-in-region branch is attached - ;; (recognizable as first node with more than one branch) - (let ((mark-active nil)) - (while (= (length (undo-tree-node-next node)) 1) - (undo-tree-undo-1) - (setq fragment node - node (undo-tree-current buffer-undo-tree)))) - (when (eq splice node) (setq splice nil)) - ;; detatch undo-in-region branch - (setf (undo-tree-node-next node) - (delq fragment (undo-tree-node-next node)) - (undo-tree-node-previous fragment) nil - original-fragment fragment - original-splice node)) - - ;; if this is a new undo-in-region, initial FRAGMENT is a copy of all - ;; nodes below the current one in the active branch - ((undo-tree-node-next node) - (setq fragment (undo-tree-make-node nil nil) - splice fragment) - (while (setq node (nth (undo-tree-node-branch node) - (undo-tree-node-next node))) - (push (undo-tree-make-node - splice - (undo-copy-list (undo-tree-node-undo node)) - (undo-copy-list (undo-tree-node-redo node))) - (undo-tree-node-next splice)) - (setq splice (car (undo-tree-node-next splice)))) - (setq fragment (car (undo-tree-node-next fragment)) - splice nil - node (undo-tree-current buffer-undo-tree)))) - - - ;; --- pull undo-in-region elements into branch --- - ;; work backwards up tree, pulling out undo elements within region until - ;; we've got one that undoes a visible change (insertion or deletion) - (catch 'abort - (while (and (not got-visible-elt) node (undo-tree-node-undo node)) - ;; we cons a dummy nil element on the front of the changeset so that - ;; we can conveniently remove the first (real) element from the - ;; changeset if we need to; the leading nil is removed once we're - ;; done with this changeset - (setq undo-list (cons nil (undo-copy-list (undo-tree-node-undo node))) - elt (cadr undo-list)) - (if fragment - (progn - (setq fragment (undo-tree-grow-backwards fragment undo-list)) - (unless splice (setq splice fragment))) - (setq fragment (undo-tree-make-node nil undo-list)) - (setq splice fragment)) - - (while elt - (cond - ;; keep elements within region - ((undo-elt-in-region elt start end) - ;; set flag if kept element is visible (insertion or deletion) - (when (and (consp elt) - (or (stringp (car elt)) (integerp (car elt)))) - (setq got-visible-elt t)) - ;; adjust buffer positions in elements previously undone before - ;; kept element, as kept element will now be undone first - (undo-tree-adjust-elements-to-elt splice elt) - ;; move kept element to undo-in-region changeset, adjusting its - ;; buffer position as it will now be undone first - (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list)))) - (setq r (cdr r)) - (setcdr undo-list (cddr undo-list))) - - ;; discard "was unmodified" elements - ;; FIXME: deal properly with these - ((and (consp elt) (eq (car elt) t)) - (setcdr undo-list (cddr undo-list))) - - ;; if element crosses region, we can't pull any more elements - ((undo-elt-crosses-region elt start end) - ;; if we've found a visible element, it must be earlier in - ;; current node's changeset; stop pulling elements (null - ;; `undo-list' and non-nil `got-visible-elt' cause loop to exit) - (if got-visible-elt - (setq undo-list nil) - ;; if we haven't found a visible element yet, pulling - ;; undo-in-region branch has failed - (setq region-changeset nil) - (throw 'abort t))) - - ;; if rejecting element, add its delta (if any) to the list - (t - (let ((delta (undo-delta elt))) - (when (/= 0 (cdr delta)) - (setcdr d (list delta)) - (setq d (cdr d)))) - (setq undo-list (cdr undo-list)))) - - ;; process next element of current changeset - (setq elt (cadr undo-list))) - - ;; if there are remaining elements in changeset, remove dummy nil - ;; from front - (if (cadr (undo-tree-node-undo fragment)) - (pop (undo-tree-node-undo fragment)) - ;; otherwise, if we've kept all elements in changeset, discard - ;; empty changeset - (when (eq splice fragment) (setq splice nil)) - (setq fragment (car (undo-tree-node-next fragment)))) - ;; process changeset from next node up the tree - (setq node (undo-tree-node-previous node)))) - - ;; pop dummy nil from front of `region-changeset' - (setq region-changeset (cdr region-changeset)) - - - ;; --- integrate branch into tree --- - ;; if no undo-in-region elements were found, restore undo tree - (if (null region-changeset) - (when original-current - (push original-fragment (undo-tree-node-next original-splice)) - (setf (undo-tree-node-branch original-splice) 0 - (undo-tree-node-previous original-fragment) original-splice) - (let ((mark-active nil)) - (while (not (eq (undo-tree-current buffer-undo-tree) - original-current)) - (undo-tree-redo-1))) - nil) ; return nil to indicate failure - - ;; otherwise... - ;; need to undo up to node where new branch will be attached, to - ;; ensure redo entries are populated, and then redo back to where we - ;; started - (let ((mark-active nil) - (current (undo-tree-current buffer-undo-tree))) - (while (not (eq (undo-tree-current buffer-undo-tree) node)) - (undo-tree-undo-1)) - (while (not (eq (undo-tree-current buffer-undo-tree) current)) - (undo-tree-redo-1))) - - (cond - ;; if there's no remaining fragment, just create undo-in-region node - ;; and attach it to parent of last node from which elements were - ;; pulled - ((null fragment) - (setq fragment (undo-tree-make-node node region-changeset)) - (push fragment (undo-tree-node-next node)) - (setf (undo-tree-node-branch node) 0) - ;; set current node to undo-in-region node - (setf (undo-tree-current buffer-undo-tree) fragment)) - - ;; if no splice point has been set, add undo-in-region node to top of - ;; fragment and attach it to parent of last node from which elements - ;; were pulled - ((null splice) - (setq fragment (undo-tree-grow-backwards fragment region-changeset)) - (push fragment (undo-tree-node-next node)) - (setf (undo-tree-node-branch node) 0 - (undo-tree-node-previous fragment) node) - ;; set current node to undo-in-region node - (setf (undo-tree-current buffer-undo-tree) fragment)) - - ;; if fragment contains nodes, attach fragment to parent of last node - ;; from which elements were pulled, and splice in undo-in-region node - (t - (setf (undo-tree-node-previous fragment) node) - (push fragment (undo-tree-node-next node)) - (setf (undo-tree-node-branch node) 0) - ;; if this is a repeated undo-in-region, then we've left the current - ;; node at the original splice-point; we need to set the current - ;; node to the equivalent node on the undo-in-region branch and redo - ;; back to where we started - (when repeated-undo-in-region - (setf (undo-tree-current buffer-undo-tree) - (undo-tree-node-previous original-fragment)) - (let ((mark-active nil)) - (while (not (eq (undo-tree-current buffer-undo-tree) splice)) - (undo-tree-redo-1 nil 'preserve-undo)))) - ;; splice new undo-in-region node into fragment - (setq node (undo-tree-make-node nil region-changeset)) - (undo-tree-splice-node node splice) - ;; set current node to undo-in-region node - (setf (undo-tree-current buffer-undo-tree) node))) - - ;; update undo-tree size - (setq node (undo-tree-node-previous fragment)) - (while (progn - (and (setq node (car (undo-tree-node-next node))) - (not (eq node original-fragment)) - (cl-incf (undo-tree-count buffer-undo-tree)) - (cl-incf (undo-tree-size buffer-undo-tree) - (+ (undo-list-byte-size (undo-tree-node-undo node)) - (undo-list-byte-size (undo-tree-node-redo node))))))) - t) ; indicate undo-in-region branch was successfully pulled - ))) - - - -(defun undo-tree-pull-redo-in-region-branch (start end) - ;; Pull out entries from redo changesets to create a new redo-in-region - ;; branch, which redoes changeset entries lying between START and END first, - ;; followed by remaining entries from the changesets. Repeated calls will, - ;; if appropriate, extend the current redo-in-region branch rather than - ;; creating a new one. - - ;; if we're just reverting the last undo-in-region, we don't need to - ;; manipulate the undo tree at all - (if (undo-tree-reverting-undo-in-region-p start end) - t ; return t to indicate success - - ;; We build the `region-changeset' and `delta-list' lists forwards, using - ;; pointers `r' and `d' to the penultimate element of the list. So that we - ;; don't have to treat the first element differently, we prepend a dummy - ;; leading nil to the lists, and have the pointers point to that - ;; initially. - ;; Note: using '(nil) instead of (list nil) in the `let*' causes bizarre - ;; errors when the code is byte-compiled, where parts of the lists - ;; appear to survive across different calls to this function. An - ;; obscure byte-compiler bug, perhaps? - (let* ((region-changeset (list nil)) - (r region-changeset) - (delta-list (list nil)) - (d delta-list) - (node (undo-tree-current buffer-undo-tree)) - (repeated-redo-in-region - (undo-tree-repeated-redo-in-region-p start end)) - undo-adjusted-markers ; `undo-elt-in-region' expects this - fragment splice got-visible-elt redo-list elt) - - ;; --- inisitalisation --- - (cond - ;; if this is a repeated redo-in-region, detach fragment below current - ;; node - (repeated-redo-in-region - (when (setq fragment (car (undo-tree-node-next node))) - (setf (undo-tree-node-previous fragment) nil - (undo-tree-node-next node) - (delq fragment (undo-tree-node-next node))))) - ;; if this is a new redo-in-region, initial fragment is a copy of all - ;; nodes below the current one in the active branch - ((undo-tree-node-next node) - (setq fragment (undo-tree-make-node nil nil) - splice fragment) - (while (setq node (nth (undo-tree-node-branch node) - (undo-tree-node-next node))) - (push (undo-tree-make-node - splice nil - (undo-copy-list (undo-tree-node-redo node))) - (undo-tree-node-next splice)) - (setq splice (car (undo-tree-node-next splice)))) - (setq fragment (car (undo-tree-node-next fragment))))) - - - ;; --- pull redo-in-region elements into branch --- - ;; work down fragment, pulling out redo elements within region until - ;; we've got one that redoes a visible change (insertion or deletion) - (setq node fragment) - (catch 'abort - (while (and (not got-visible-elt) node (undo-tree-node-redo node)) - ;; we cons a dummy nil element on the front of the changeset so that - ;; we can conveniently remove the first (real) element from the - ;; changeset if we need to; the leading nil is removed once we're - ;; done with this changeset - (setq redo-list (push nil (undo-tree-node-redo node)) - elt (cadr redo-list)) - (while elt - (cond - ;; keep elements within region - ((undo-elt-in-region elt start end) - ;; set flag if kept element is visible (insertion or deletion) - (when (and (consp elt) - (or (stringp (car elt)) (integerp (car elt)))) - (setq got-visible-elt t)) - ;; adjust buffer positions in elements previously redone before - ;; kept element, as kept element will now be redone first - (undo-tree-adjust-elements-to-elt fragment elt t) - ;; move kept element to redo-in-region changeset, adjusting its - ;; buffer position as it will now be redone first - (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list) -1))) - (setq r (cdr r)) - (setcdr redo-list (cddr redo-list))) - - ;; discard "was unmodified" elements - ;; FIXME: deal properly with these - ((and (consp elt) (eq (car elt) t)) - (setcdr redo-list (cddr redo-list))) - - ;; if element crosses region, we can't pull any more elements - ((undo-elt-crosses-region elt start end) - ;; if we've found a visible element, it must be earlier in - ;; current node's changeset; stop pulling elements (null - ;; `redo-list' and non-nil `got-visible-elt' cause loop to exit) - (if got-visible-elt - (setq redo-list nil) - ;; if we haven't found a visible element yet, pulling - ;; redo-in-region branch has failed - (setq region-changeset nil) - (throw 'abort t))) - - ;; if rejecting element, add its delta (if any) to the list - (t - (let ((delta (undo-delta elt))) - (when (/= 0 (cdr delta)) - (setcdr d (list delta)) - (setq d (cdr d)))) - (setq redo-list (cdr redo-list)))) - - ;; process next element of current changeset - (setq elt (cadr redo-list))) - - ;; if there are remaining elements in changeset, remove dummy nil - ;; from front - (if (cadr (undo-tree-node-redo node)) - (pop (undo-tree-node-undo node)) - ;; otherwise, if we've kept all elements in changeset, discard - ;; empty changeset - (if (eq fragment node) - (setq fragment (car (undo-tree-node-next fragment))) - (undo-tree-snip-node node))) - ;; process changeset from next node in fragment - (setq node (car (undo-tree-node-next node))))) - - ;; pop dummy nil from front of `region-changeset' - (setq region-changeset (cdr region-changeset)) - - - ;; --- integrate branch into tree --- - (setq node (undo-tree-current buffer-undo-tree)) - ;; if no redo-in-region elements were found, restore undo tree - (if (null (car region-changeset)) - (when (and repeated-redo-in-region fragment) - (push fragment (undo-tree-node-next node)) - (setf (undo-tree-node-branch node) 0 - (undo-tree-node-previous fragment) node) - nil) ; return nil to indicate failure - - ;; otherwise, add redo-in-region node to top of fragment, and attach - ;; it below current node - (setq fragment - (if fragment - (undo-tree-grow-backwards fragment nil region-changeset) - (undo-tree-make-node nil nil region-changeset))) - (push fragment (undo-tree-node-next node)) - (setf (undo-tree-node-branch node) 0 - (undo-tree-node-previous fragment) node) - ;; update undo-tree size - (unless repeated-redo-in-region - (setq node fragment) - (while (and (setq node (car (undo-tree-node-next node))) - (cl-incf (undo-tree-count buffer-undo-tree)) - (cl-incf (undo-tree-size buffer-undo-tree) - (undo-list-byte-size - (undo-tree-node-redo node)))))) - (cl-incf (undo-tree-size buffer-undo-tree) - (undo-list-byte-size (undo-tree-node-redo fragment))) - t) ; indicate redo-in-region branch was successfully pulled - ))) - - - -(defun undo-tree-adjust-elements-to-elt (node undo-elt &optional below) - "Adjust buffer positions of undo elements, starting at NODE's -and going up the tree (or down the active branch if BELOW is -non-nil) and through the nodes' undo elements until we reach -UNDO-ELT. UNDO-ELT must appear somewhere in the undo changeset -of either NODE itself or some node above it in the tree." - (let ((delta (list (undo-delta undo-elt))) - (undo-list (undo-tree-node-undo node))) - ;; adjust elements until we reach UNDO-ELT - (while (and (car undo-list) - (not (eq (car undo-list) undo-elt))) - (setcar undo-list - (undo-tree-apply-deltas (car undo-list) delta -1)) - ;; move to next undo element in list, or to next node if we've run out - ;; of elements - (unless (car (setq undo-list (cdr undo-list))) - (if below - (setq node (nth (undo-tree-node-branch node) - (undo-tree-node-next node))) - (setq node (undo-tree-node-previous node))) - (setq undo-list (undo-tree-node-undo node)))))) - - - -(defun undo-tree-apply-deltas (undo-elt deltas &optional sgn) - ;; Apply DELTAS in order to UNDO-ELT, multiplying deltas by SGN - ;; (only useful value for SGN is -1). - (let (position offset) - (dolist (delta deltas) - (setq position (car delta) - offset (* (cdr delta) (or sgn 1))) - (cond - ;; POSITION - ((integerp undo-elt) - (when (>= undo-elt position) - (setq undo-elt (- undo-elt offset)))) - ;; nil (or any other atom) - ((atom undo-elt)) - ;; (TEXT . POSITION) - ((stringp (car undo-elt)) - (let ((text-pos (abs (cdr undo-elt))) - (point-at-end (< (cdr undo-elt) 0))) - (if (>= text-pos position) - (setcdr undo-elt (* (if point-at-end -1 1) - (- text-pos offset)))))) - ;; (BEGIN . END) - ((integerp (car undo-elt)) - (when (>= (car undo-elt) position) - (setcar undo-elt (- (car undo-elt) offset)) - (setcdr undo-elt (- (cdr undo-elt) offset)))) - ;; (nil PROPERTY VALUE BEG . END) - ((null (car undo-elt)) - (let ((tail (nthcdr 3 undo-elt))) - (when (>= (car tail) position) - (setcar tail (- (car tail) offset)) - (setcdr tail (- (cdr tail) offset))))) - )) - undo-elt)) - - - -(defun undo-tree-repeated-undo-in-region-p (start end) - ;; Return non-nil if undo-in-region between START and END is a repeated - ;; undo-in-region - (let ((node (undo-tree-current buffer-undo-tree))) - (and (setq node - (nth (undo-tree-node-branch node) (undo-tree-node-next node))) - (eq (undo-tree-node-undo-beginning node) start) - (eq (undo-tree-node-undo-end node) end)))) - - -(defun undo-tree-repeated-redo-in-region-p (start end) - ;; Return non-nil if undo-in-region between START and END is a repeated - ;; undo-in-region - (let ((node (undo-tree-current buffer-undo-tree))) - (and (eq (undo-tree-node-redo-beginning node) start) - (eq (undo-tree-node-redo-end node) end)))) - - -;; Return non-nil if undo-in-region between START and END is simply -;; reverting the last redo-in-region -(defalias 'undo-tree-reverting-undo-in-region-p - 'undo-tree-repeated-undo-in-region-p) - - -;; Return non-nil if redo-in-region between START and END is simply -;; reverting the last undo-in-region -(defalias 'undo-tree-reverting-redo-in-region-p - 'undo-tree-repeated-redo-in-region-p) - - - - -;;; ===================================================================== -;;; Undo-tree commands - -(defvar undo-tree-timer nil) - -;;;###autoload -(define-minor-mode undo-tree-mode - "Toggle undo-tree mode. -With no argument, this command toggles the mode. -A positive prefix argument turns the mode on. -A negative prefix argument turns it off. - -Undo-tree-mode replaces Emacs' standard undo feature with a more -powerful yet easier to use version, that treats the undo history -as what it is: a tree. - -The following keys are available in `undo-tree-mode': - - \\{undo-tree-map} - -Within the undo-tree visualizer, the following keys are available: - - \\{undo-tree-visualizer-mode-map}" - - nil ; init value - undo-tree-mode-lighter ; lighter - undo-tree-map ; keymap - - (cond - (undo-tree-mode ; enabling `undo-tree-mode' - (set (make-local-variable 'undo-limit) - (if undo-tree-limit - (max undo-limit undo-tree-limit) - most-positive-fixnum)) - (set (make-local-variable 'undo-strong-limit) - (if undo-tree-limit - (max undo-strong-limit undo-tree-strong-limit) - most-positive-fixnum)) - (set (make-local-variable 'undo-outer-limit) ; null `undo-outer-limit' means no limit - (when (and undo-tree-limit undo-outer-limit undo-outer-limit) - (max undo-outer-limit undo-tree-outer-limit))) - (when (null undo-tree-limit) - (setq undo-tree-timer - (run-with-idle-timer 5 'repeat #'undo-list-transfer-to-tree))) - (add-hook 'post-gc-hook #'undo-tree-post-gc nil)) - - (t ; disabling `undo-tree-mode' - ;; rebuild `buffer-undo-list' from tree so Emacs undo can work - (undo-list-rebuild-from-tree) - (setq buffer-undo-tree nil) - (remove-hook 'post-gc-hook #'undo-tree-post-gc 'local) - (when (timerp undo-tree-timer) (cancel-timer undo-tree-timer)) - (kill-local-variable 'undo-limit) - (kill-local-variable 'undo-strong-limit) - (kill-local-variable 'undo-outer-limit)))) - - -(defun turn-on-undo-tree-mode (&optional print-message) - "Enable `undo-tree-mode' in the current buffer, when appropriate. -Some major modes implement their own undo system, which should -not normally be overridden by `undo-tree-mode'. This command does -not enable `undo-tree-mode' in such buffers. If you want to force -`undo-tree-mode' to be enabled regardless, use (undo-tree-mode 1) -instead. - -The heuristic used to detect major modes in which -`undo-tree-mode' should not be used is to check whether either -the `undo' command has been remapped, or the default undo -keybindings (C-/ and C-_) have been overridden somewhere other -than in the global map. In addition, `undo-tree-mode' will not be -enabled if the buffer's `major-mode' appears in -`undo-tree-incompatible-major-modes'." - (interactive "p") - (if (or (key-binding [remap undo]) - (undo-tree-overridden-undo-bindings-p) - (memq major-mode undo-tree-incompatible-major-modes)) - (when print-message - (message "Buffer does not support undo-tree-mode;\ - undo-tree-mode NOT enabled")) - (undo-tree-mode 1))) - - -(defun undo-tree-overridden-undo-bindings-p () - "Returns t if default undo bindings are overridden, nil otherwise. -Checks if either of the default undo key bindings (\"C-/\" or -\"C-_\") are overridden in the current buffer by any keymap other -than the global one. (So global redefinitions of the default undo -key bindings do not count.)" - (let ((binding1 (lookup-key (current-global-map) [?\C-/])) - (binding2 (lookup-key (current-global-map) [?\C-_]))) - (global-set-key [?\C-/] 'undo) - (global-set-key [?\C-_] 'undo) - (unwind-protect - (or (and (key-binding [?\C-/]) - (not (eq (key-binding [?\C-/]) 'undo))) - (and (key-binding [?\C-_]) - (not (eq (key-binding [?\C-_]) 'undo)))) - (global-set-key [?\C-/] binding1) - (global-set-key [?\C-_] binding2)))) - - -;;;###autoload -(define-globalized-minor-mode global-undo-tree-mode - undo-tree-mode turn-on-undo-tree-mode) - - - -(defun undo-tree-undo (&optional arg) - "Undo changes. -Repeat this command to undo more changes. -A numeric ARG serves as a repeat count. - -In Transient Mark mode when the mark is active, only undo changes -within the current region. Similarly, when not in Transient Mark -mode, just \\[universal-argument] as an argument limits undo to -changes within the current region." - (interactive "*P") - (unless undo-tree-mode - (user-error "Undo-tree mode not enabled in buffer")) - ;; throw error if undo is disabled in buffer - (when (eq buffer-undo-list t) - (user-error "No undo information in this buffer")) - (undo-tree-undo-1 arg) - ;; inform user if at branch point - (when (> (undo-tree-num-branches) 1) (message "Undo branch point!"))) - - -(defun undo-tree-undo-1 (&optional arg preserve-redo preserve-timestamps) - ;; Internal undo function. An active mark in `transient-mark-mode', or - ;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-REDO - ;; causes the existing redo record to be preserved, rather than replacing it - ;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS - ;; disables updating of timestamps in visited undo-tree nodes. (This latter - ;; should *only* be used when temporarily visiting another undo state and - ;; immediately returning to the original state afterwards. Otherwise, it - ;; could cause history-discarding errors.) - (let ((undo-in-progress t) - (undo-in-region (and undo-tree-enable-undo-in-region - (or (region-active-p) - (and arg (not (numberp arg)))))) - pos current) - ;; transfer entries accumulated in `buffer-undo-list' to - ;; `buffer-undo-tree' - (undo-list-transfer-to-tree) - - (dotimes (_ (or (and (numberp arg) (prefix-numeric-value arg)) 1)) - ;; check if at top of undo tree - (unless (undo-tree-node-previous (undo-tree-current buffer-undo-tree)) - (user-error "No further undo information")) - - ;; if region is active, or a non-numeric prefix argument was supplied, - ;; try to pull out a new branch of changes affecting the region - (when (and undo-in-region - (not (undo-tree-pull-undo-in-region-branch - (region-beginning) (region-end)))) - (user-error "No further undo information for region")) - - ;; remove any GC'd elements from node's undo list - (setq current (undo-tree-current buffer-undo-tree)) - (cl-decf (undo-tree-size buffer-undo-tree) - (undo-list-byte-size (undo-tree-node-undo current))) - (setf (undo-tree-node-undo current) - (undo-list-clean-GCd-elts (undo-tree-node-undo current))) - (cl-incf (undo-tree-size buffer-undo-tree) - (undo-list-byte-size (undo-tree-node-undo current))) - ;; undo one record from undo tree - (when undo-in-region - (setq pos (set-marker (make-marker) (point))) - (set-marker-insertion-type pos t)) - (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-undo current))) - (undo-boundary) - - ;; if preserving old redo record, discard new redo entries that - ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd - ;; elements from node's redo list - (if preserve-redo - (progn - (undo-list-pop-changeset buffer-undo-list) - (cl-decf (undo-tree-size buffer-undo-tree) - (undo-list-byte-size (undo-tree-node-redo current))) - (setf (undo-tree-node-redo current) - (undo-list-clean-GCd-elts (undo-tree-node-redo current))) - (cl-incf (undo-tree-size buffer-undo-tree) - (undo-list-byte-size (undo-tree-node-redo current)))) - ;; otherwise, record redo entries that `primitive-undo' has added to - ;; `buffer-undo-list' in current node's redo record, replacing - ;; existing entry if one already exists - (cl-decf (undo-tree-size buffer-undo-tree) - (undo-list-byte-size (undo-tree-node-redo current))) - (setf (undo-tree-node-redo current) - (undo-list-pop-changeset buffer-undo-list 'discard-pos)) - (cl-incf (undo-tree-size buffer-undo-tree) - (undo-list-byte-size (undo-tree-node-redo current)))) - - ;; rewind current node and update timestamp - (setf (undo-tree-current buffer-undo-tree) - (undo-tree-node-previous (undo-tree-current buffer-undo-tree))) - (unless preserve-timestamps - (setf (undo-tree-node-timestamp (undo-tree-current buffer-undo-tree)) - (current-time))) - - ;; if undoing-in-region, record current node, region and direction so we - ;; can tell if undo-in-region is repeated, and re-activate mark if in - ;; `transient-mark-mode'; if not, erase any leftover data - (if (not undo-in-region) - (undo-tree-node-clear-region-data current) - (goto-char pos) - ;; note: we deliberately want to store the region information in the - ;; node *below* the now current one - (setf (undo-tree-node-undo-beginning current) (region-beginning) - (undo-tree-node-undo-end current) (region-end)) - (set-marker pos nil))) - - ;; undo deactivates mark unless undoing-in-region - (setq deactivate-mark (not undo-in-region)))) - - - -(defun undo-tree-redo (&optional arg) - "Redo changes. A numeric ARG serves as a repeat count. - -In Transient Mark mode when the mark is active, only redo changes -within the current region. Similarly, when not in Transient Mark -mode, just \\[universal-argument] as an argument limits redo to -changes within the current region." - (interactive "*P") - (unless undo-tree-mode - (user-error "Undo-tree mode not enabled in buffer")) - ;; throw error if undo is disabled in buffer - (when (eq buffer-undo-list t) - (user-error "No undo information in this buffer")) - (undo-tree-redo-1 arg) - ;; inform user if at branch point - (when (> (undo-tree-num-branches) 1) (message "Undo branch point!"))) - - -(defun undo-tree-redo-1 (&optional arg preserve-undo preserve-timestamps) - ;; Internal redo function. An active mark in `transient-mark-mode', or - ;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-UNDO - ;; causes the existing redo record to be preserved, rather than replacing it - ;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS - ;; disables updating of timestamps in visited undo-tree nodes. (This latter - ;; should *only* be used when temporarily visiting another undo state and - ;; immediately returning to the original state afterwards. Otherwise, it - ;; could cause history-discarding errors.) - (let ((undo-in-progress t) - (redo-in-region (and undo-tree-enable-undo-in-region - (or (region-active-p) - (and arg (not (numberp arg)))))) - pos current) - ;; transfer entries accumulated in `buffer-undo-list' to - ;; `buffer-undo-tree' - (undo-list-transfer-to-tree) - - (dotimes (_ (or (and (numberp arg) (prefix-numeric-value arg)) 1)) - ;; check if at bottom of undo tree - (when (null (undo-tree-node-next (undo-tree-current buffer-undo-tree))) - (user-error "No further redo information")) - - ;; if region is active, or a non-numeric prefix argument was supplied, - ;; try to pull out a new branch of changes affecting the region - (when (and redo-in-region - (not (undo-tree-pull-redo-in-region-branch - (region-beginning) (region-end)))) - (user-error "No further redo information for region")) - - ;; get next node (but DON'T advance current node in tree yet, in case - ;; redoing fails) - (setq current (undo-tree-current buffer-undo-tree) - current (nth (undo-tree-node-branch current) - (undo-tree-node-next current))) - ;; remove any GC'd elements from node's redo list - (cl-decf (undo-tree-size buffer-undo-tree) - (undo-list-byte-size (undo-tree-node-redo current))) - (setf (undo-tree-node-redo current) - (undo-list-clean-GCd-elts (undo-tree-node-redo current))) - (cl-incf (undo-tree-size buffer-undo-tree) - (undo-list-byte-size (undo-tree-node-redo current))) - ;; redo one record from undo tree - (when redo-in-region - (setq pos (set-marker (make-marker) (point))) - (set-marker-insertion-type pos t)) - (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-redo current))) - (undo-boundary) - ;; advance current node in tree - (setf (undo-tree-current buffer-undo-tree) current) - - ;; if preserving old undo record, discard new undo entries that - ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd - ;; elements from node's redo list - (if preserve-undo - (progn - (undo-list-pop-changeset buffer-undo-list) - (cl-decf (undo-tree-size buffer-undo-tree) - (undo-list-byte-size (undo-tree-node-undo current))) - (setf (undo-tree-node-undo current) - (undo-list-clean-GCd-elts (undo-tree-node-undo current))) - (cl-incf (undo-tree-size buffer-undo-tree) - (undo-list-byte-size (undo-tree-node-undo current)))) - ;; otherwise, record undo entries that `primitive-undo' has added to - ;; `buffer-undo-list' in current node's undo record, replacing - ;; existing entry if one already exists - (cl-decf (undo-tree-size buffer-undo-tree) - (undo-list-byte-size (undo-tree-node-undo current))) - (setf (undo-tree-node-undo current) - (undo-list-pop-changeset buffer-undo-list 'discard-pos)) - (cl-incf (undo-tree-size buffer-undo-tree) - (undo-list-byte-size (undo-tree-node-undo current)))) - - ;; update timestamp - (unless preserve-timestamps - (setf (undo-tree-node-timestamp current) (current-time))) - - ;; if redoing-in-region, record current node, region and direction so we - ;; can tell if redo-in-region is repeated, and re-activate mark if in - ;; `transient-mark-mode' - (if (not redo-in-region) - (undo-tree-node-clear-region-data current) - (goto-char pos) - (setf (undo-tree-node-redo-beginning current) (region-beginning) - (undo-tree-node-redo-end current) (region-end)) - (set-marker pos nil))) - - ;; redo deactivates the mark unless redoing-in-region - (setq deactivate-mark (not redo-in-region)))) - - - -(defun undo-tree-switch-branch (branch) - "Switch to a different BRANCH of the undo tree. -This will affect which branch to descend when *redoing* changes -using `undo-tree-redo'." - (interactive (list (or (and prefix-arg (prefix-numeric-value prefix-arg)) - (and (not (eq buffer-undo-list t)) - (undo-list-transfer-to-tree) - (let ((b (undo-tree-node-branch - (undo-tree-current - buffer-undo-tree)))) - (cond - ;; switch to other branch if only 2 - ((= (undo-tree-num-branches) 2) (- 1 b)) - ;; prompt if more than 2 - ((> (undo-tree-num-branches) 2) - (read-number - (format "Branch (0-%d, on %d): " - (1- (undo-tree-num-branches)) b))) - )))))) - (unless undo-tree-mode - (user-error "Undo-tree mode not enabled in buffer")) - ;; throw error if undo is disabled in buffer - (when (eq buffer-undo-list t) - (user-error "No undo information in this buffer")) - ;; sanity check branch number - (when (<= (undo-tree-num-branches) 1) - (user-error "Not at undo branch point")) - (when (or (< branch 0) (> branch (1- (undo-tree-num-branches)))) - (user-error "Invalid branch number")) - ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree' - (undo-list-transfer-to-tree) - ;; switch branch - (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree)) - branch) - (message "Switched to branch %d" branch)) - - -(defun undo-tree-set (node &optional preserve-timestamps) - ;; Set buffer to state corresponding to NODE. Returns intersection point - ;; between path back from current node and path back from selected NODE. - ;; Non-nil PRESERVE-TIMESTAMPS disables updating of timestamps in visited - ;; undo-tree nodes. (This should *only* be used when temporarily visiting - ;; another undo state and immediately returning to the original state - ;; afterwards. Otherwise, it could cause history-discarding errors.) - (let ((path (make-hash-table :test 'eq)) - (n node)) - (puthash (undo-tree-root buffer-undo-tree) t path) - ;; build list of nodes leading back from selected node to root, updating - ;; branches as we go to point down to selected node - (while (progn - (puthash n t path) - (when (undo-tree-node-previous n) - (setf (undo-tree-node-branch (undo-tree-node-previous n)) - (undo-tree-position - n (undo-tree-node-next (undo-tree-node-previous n)))) - (setq n (undo-tree-node-previous n))))) - ;; work backwards from current node until we intersect path back from - ;; selected node - (setq n (undo-tree-current buffer-undo-tree)) - (while (not (gethash n path)) - (setq n (undo-tree-node-previous n))) - ;; ascend tree until intersection node - (while (not (eq (undo-tree-current buffer-undo-tree) n)) - (undo-tree-undo-1 nil nil preserve-timestamps)) - ;; descend tree until selected node - (while (not (eq (undo-tree-current buffer-undo-tree) node)) - (undo-tree-redo-1 nil nil preserve-timestamps)) - n)) ; return intersection node - - - -(defun undo-tree-save-state-to-register (register) - "Store current undo-tree state to REGISTER. -The saved state can be restored using -`undo-tree-restore-state-from-register'. -Argument is a character, naming the register." - (interactive "cUndo-tree state to register: ") - (unless undo-tree-mode - (user-error "Undo-tree mode not enabled in buffer")) - ;; throw error if undo is disabled in buffer - (when (eq buffer-undo-list t) - (user-error "No undo information in this buffer")) - ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree' - (undo-list-transfer-to-tree) - ;; save current node to REGISTER - (set-register - register (registerv-make - (undo-tree-make-register-data - (current-buffer) (undo-tree-current buffer-undo-tree)) - :print-func 'undo-tree-register-data-print-func)) - ;; record REGISTER in current node, for visualizer - (setf (undo-tree-node-register (undo-tree-current buffer-undo-tree)) - register)) - - - -(defun undo-tree-restore-state-from-register (register) - "Restore undo-tree state from REGISTER. -The state must be saved using `undo-tree-save-state-to-register'. -Argument is a character, naming the register." - (interactive "*cRestore undo-tree state from register: ") - (unless undo-tree-mode - (user-error "Undo-tree mode not enabled in buffer")) - ;; throw error if undo is disabled in buffer, or if register doesn't contain - ;; an undo-tree node - (let ((data (registerv-data (get-register register)))) - (cond - ((eq buffer-undo-list t) - (user-error "No undo information in this buffer")) - ((not (undo-tree-register-data-p data)) - (user-error "Register doesn't contain undo-tree state")) - ((not (eq (current-buffer) (undo-tree-register-data-buffer data))) - (user-error "Register contains undo-tree state for a different buffer"))) - ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree' - (undo-list-transfer-to-tree) - ;; restore buffer state corresponding to saved node - (undo-tree-set (undo-tree-register-data-node data)))) - - - - -;;; ===================================================================== -;;; Undo-tree menu bar - -(defvar undo-tree-old-undo-menu-item nil) - -(defun undo-tree-update-menu-bar () - "Update `undo-tree-mode' Edit menu items." - (if undo-tree-mode - (progn - ;; save old undo menu item, and install undo/redo menu items - (setq undo-tree-old-undo-menu-item - (cdr (assq 'undo (lookup-key global-map [menu-bar edit])))) - (define-key (lookup-key global-map [menu-bar edit]) - [undo] '(menu-item "Undo" undo-tree-undo - :enable (and undo-tree-mode - (not buffer-read-only) - (not (eq t buffer-undo-list)) - (not (eq nil buffer-undo-tree)) - (undo-tree-node-previous - (undo-tree-current buffer-undo-tree))) - :help "Undo last operation")) - (define-key-after (lookup-key global-map [menu-bar edit]) - [redo] '(menu-item "Redo" undo-tree-redo - :enable (and undo-tree-mode - (not buffer-read-only) - (not (eq t buffer-undo-list)) - (not (eq nil buffer-undo-tree)) - (undo-tree-node-next - (undo-tree-current buffer-undo-tree))) - :help "Redo last operation") - 'undo)) - ;; uninstall undo/redo menu items - (define-key (lookup-key global-map [menu-bar edit]) - [undo] undo-tree-old-undo-menu-item) - (define-key (lookup-key global-map [menu-bar edit]) - [redo] nil))) - -(add-hook 'menu-bar-update-hook 'undo-tree-update-menu-bar) - - - - -;;; ===================================================================== -;;; Persistent storage commands - -(defvar undo-tree-save-format-version 1 - "Undo-tree history file format version.") - - -(defun undo-tree-make-history-save-file-name (file) - "Create the undo history file name for FILE. -Normally this is the file's name with \".\" prepended and -\".~undo-tree~\" appended. - -A match for FILE is sought in `undo-tree-history-directory-alist' -\(see the documentation of that variable for details\). If the -directory for the backup doesn't exist, it is created." - (let* ((backup-directory-alist undo-tree-history-directory-alist) - (name (make-backup-file-name-1 file))) - (concat (file-name-directory name) "." (file-name-nondirectory name) - ".~undo-tree~"))) - - -(defun undo-tree-serialize (tree) - "Serialise undo-tree TREE to current buffer." - ;; write root - (let ((data (undo-tree-copy-node-save-data (undo-tree-root tree)))) - (when (eq (undo-tree-root tree) (undo-tree-current tree)) - (setf (undo-tree-node-next data) 'current)) - (prin1 data (current-buffer))) - (terpri (current-buffer)) - ;; Note: We serialise in breadth-first order, as undo-trees are typically - ;; much deeper than they are wide, so this is more memory-efficient. - (let ((queue (make-queue))) - (queue-enqueue queue (undo-tree-root tree)) - (while (not (queue-empty queue)) - (prin1 (mapcar - (lambda (n) - (queue-enqueue queue n) - (let ((data (undo-tree-copy-node-save-data n))) - ;; use empty next field to mark current node - (when (eq n (undo-tree-current tree)) - (setf (undo-tree-node-next data) 'current)) - data)) - (undo-tree-node-next (queue-dequeue queue))) - (current-buffer)) - (terpri (current-buffer))))) - - -(defun undo-tree-deserialize () - "Deserialize and return undo-tree from current buffer." - (let ((tree (make-undo-tree)) - (queue (make-queue)) - node) - ;; read root - (setf (undo-tree-root tree) (read (current-buffer))) - (queue-enqueue queue (undo-tree-root tree)) - ;; reconstruct tree in breadth-first order - (while (not (queue-empty queue)) - (setq node (queue-dequeue queue)) - (when (eq (undo-tree-node-next node) 'current) - (setf (undo-tree-current tree) node)) - (setf (undo-tree-node-next node) (read (current-buffer))) - (mapc (lambda (n) (queue-enqueue queue n)) - (undo-tree-node-next node))) - ;; restore parent links - (undo-tree-recircle tree) - tree)) - - -(defun undo-tree-serialize-old-format (tree) - ;; make tmp copy of TREE - (setq tree (undo-tree-copy tree)) - ;; decircle and discard object pool before saving - (undo-tree-decircle tree) - (setf (undo-tree-object-pool tree) nil) - ;; run pre-save transformer functions - (when undo-tree-pre-save-element-functions - (undo-tree-mapc - (lambda (node) - (let ((changeset (undo-tree-node-undo node))) - (run-hook-wrapped - 'undo-tree-pre-save-element-functions - (lambda (fun) - (setq changeset (delq nil (mapcar fun changeset))) - nil)) - (setf (undo-tree-node-undo node) changeset)) - (let ((changeset (undo-tree-node-redo node))) - (run-hook-wrapped - 'undo-tree-pre-save-element-functions - (lambda (fun) - (setq changeset (delq nil (mapcar fun changeset))) - nil)) - (setf (undo-tree-node-redo node) changeset))) - (undo-tree-root tree))) - ;; write tree - (let ((print-circle t)) (prin1 tree (current-buffer)))) - - -(defun undo-tree-deserialize-old-format () - ;; read tree - (let ((tree (read (current-buffer)))) - ;; run post-load transformer functions - (when undo-tree-post-load-element-functions - (undo-tree-mapc - (lambda (node) - (let ((changeset (undo-tree-node-undo node))) - (run-hook-wrapped - 'undo-tree-post-load-element-functions - (lambda (fun) - (setq changeset (delq nil (mapcar fun changeset))))) - (setf (undo-tree-node-undo node) changeset)) - (let ((changeset (undo-tree-node-redo node))) - (run-hook-wrapped - 'undo-tree-post-load-element-functions - (lambda (fun) - (setq changeset (delq nil (mapcar fun changeset))))) - (setf (undo-tree-node-redo node) changeset))) - (undo-tree-root tree))) - ;; initialise empty undo-tree object pool - (setf (undo-tree-object-pool tree) - (make-hash-table :test 'eq :weakness 'value)) - ;; restore parent links - (undo-tree-recircle tree) - tree)) - - - -(defun undo-tree-save-history (&optional filename overwrite) - "Store undo-tree history to file. - -If optional argument FILENAME is omitted, default save file is -\"..~undo-tree\" if buffer is visiting a file. -Otherwise, prompt for one. - -If OVERWRITE is non-nil, any existing file will be overwritten -without asking for confirmation." - (interactive) - (unless undo-tree-mode - (user-error "Undo-tree mode not enabled in buffer")) - (when (eq buffer-undo-list t) - (user-error "No undo information in this buffer")) - (undo-list-transfer-to-tree) - (when (and buffer-undo-tree (not (eq buffer-undo-tree t))) - ;; (undo-tree-kill-visualizer) - ;; ;; should be cleared already by killing the visualizer, but writes - ;; ;; unreasable data if not for some reason, so just in case... - ;; (undo-tree-clear-visualizer-data buffer-undo-tree) - (let ((buff (current-buffer)) - (tree buffer-undo-tree)) - ;; get filename - (unless filename - (setq filename - (if buffer-file-name - (undo-tree-make-history-save-file-name buffer-file-name) - (expand-file-name (read-file-name "File to save in: ") nil)))) - (when (or (not (file-exists-p filename)) - overwrite - (yes-or-no-p (format "Overwrite \"%s\"? " filename))) - - ;; print undo-tree to file - ;; Note: We use `with-temp-buffer' instead of `with-temp-file' to - ;; allow `auto-compression-mode' to take effect, in case user - ;; has overridden or advised the default - ;; `undo-tree-make-history-save-file-name' to add a compressed - ;; file extension. - (with-temp-buffer - ;; write version number; (original save file format (version 0) has no version string) - (unless (= undo-tree-save-format-version 0) - (prin1 (cons 'undo-tree-save-format-version undo-tree-save-format-version) - (current-buffer)) - (terpri (current-buffer))) - ;; write hash - (prin1 (sha1 buff) (current-buffer)) - (terpri (current-buffer)) - ;; write tree - (cl-case undo-tree-save-format-version - (0 (undo-tree-serialize-old-format tree)) - (1 (undo-tree-serialize tree)) - (t (error "Unknown `undo-tree-save-format-version'; undo-tree history *not* saved"))) - ;; write file - (with-auto-compression-mode - (write-region nil nil filename))))))) - - -(defmacro undo-tree--catch-load-history-error (error-fmt &rest body) - `(condition-case nil - (progn ,@body) - (error - (kill-buffer nil) - (funcall (if noerror #'message #'user-error) ,error-fmt filename) - (throw 'load-error nil)))) - - -(defun undo-tree-load-history (&optional filename noerror) - "Load undo-tree history from file, for the current buffer. - -If optional argument FILENAME is null, default load file is -\"..~undo-tree\" if buffer is visiting a file. -Otherwise, prompt for one. - -If optional argument NOERROR is non-nil, return nil instead of -signaling an error if file is not found. - -Note this will overwrite any existing undo history." - (interactive) - (unless undo-tree-mode - (user-error "Undo-tree mode not enabled in buffer")) - ;; get filename - (unless filename - (setq filename - (if buffer-file-name - (undo-tree-make-history-save-file-name buffer-file-name) - (expand-file-name (read-file-name "File to load from: ") nil)))) - - ;; attempt to read undo-tree - (catch 'load-error - (unless (file-exists-p filename) - (if noerror - (throw 'load-error nil) - (user-error "File \"%s\" does not exist; could not load undo-tree history" - filename))) - - ;; read file contents - (let ((buff (current-buffer)) - version hash tree) - (with-temp-buffer - (with-auto-compression-mode (insert-file-contents filename)) - (goto-char (point-min)) - - (undo-tree--catch-load-history-error - "Error reading undo-tree history from \"%s\"" - ;; read version number - (setq version (read (current-buffer))) - ;; read hash - (cond - ((eq (car-safe version) 'undo-tree-save-format-version) - (setq version (cdr version)) - (setq hash (read (current-buffer)))) - ;; original save file format (version 0) has no version string - ((stringp version) - (setq hash version - version 0)) - (t (error "Error")))) - - ;; check hash - (undo-tree--catch-load-history-error - "Buffer has been modified since undo-tree history was saved to - \"%s\"; could not load undo-tree history" - (unless (string= (sha1 buff) hash) (error "Error"))) - - ;; read tree - (undo-tree--catch-load-history-error - "Error reading undo-tree history from \"%s\"" - (setq tree - (cl-case version - (0 (undo-tree-deserialize-old-format)) - (1 (undo-tree-deserialize)) - (t (error "Error"))))) - (kill-buffer nil)) - - (setq buffer-undo-tree tree - buffer-undo-list (list nil 'undo-tree-canary))))) - - - -;; Versions of save/load functions for use in hooks -(defun undo-tree-save-history-from-hook () - (when (and undo-tree-mode undo-tree-auto-save-history - (not (eq buffer-undo-list t)) - buffer-file-name - (file-writable-p - (undo-tree-make-history-save-file-name buffer-file-name))) - (undo-tree-save-history nil 'overwrite) nil)) - -(define-obsolete-function-alias - 'undo-tree-save-history-hook 'undo-tree-save-history-from-hook - "`undo-tree-save-history-hook' is obsolete since undo-tree - version 0.6.6. Use `undo-tree-save-history-from-hook' instead.") - - -(defun undo-tree-load-history-from-hook () - (when (and undo-tree-mode undo-tree-auto-save-history - (not (eq buffer-undo-list t)) - (not revert-buffer-in-progress-p)) - (undo-tree-load-history nil 'noerror))) - -(define-obsolete-function-alias - 'undo-tree-load-history-hook 'undo-tree-load-history-from-hook - "`undo-tree-load-history-hook' is obsolete since undo-tree - version 0.6.6. Use `undo-tree-load-history-from-hook' instead.") - - -;; install history-auto-save hooks -(add-hook 'write-file-functions #'undo-tree-save-history-from-hook) -(add-hook 'kill-buffer-hook #'undo-tree-save-history-from-hook) -(add-hook 'find-file-hook #'undo-tree-load-history-from-hook) - - - - -;;; ===================================================================== -;;; Visualizer drawing functions - -(defun undo-tree-visualize () - "Visualize the current buffer's undo tree." - (interactive "*") - (unless undo-tree-mode - (user-error "Undo-tree mode not enabled in buffer")) - (deactivate-mark) - ;; throw error if undo is disabled in buffer - (when (eq buffer-undo-list t) - (user-error "No undo information in this buffer")) - ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree' - (undo-list-transfer-to-tree) - ;; add hook to kill visualizer buffer if original buffer is changed - (add-hook 'before-change-functions 'undo-tree-kill-visualizer nil t) - ;; prepare *undo-tree* buffer, then draw tree in it - (let ((undo-tree buffer-undo-tree) - (buff (current-buffer)) - (display-buffer-mark-dedicated 'soft)) - (switch-to-buffer-other-window - (get-buffer-create undo-tree-visualizer-buffer-name)) - (setq undo-tree-visualizer-parent-buffer buff) - (setq undo-tree-visualizer-parent-mtime - (and (buffer-file-name buff) - (nth 5 (file-attributes (buffer-file-name buff))))) - (setq undo-tree-visualizer-initial-node (undo-tree-current undo-tree)) - (setq undo-tree-visualizer-spacing - (undo-tree-visualizer-calculate-spacing)) - (setq buffer-undo-tree undo-tree) - (undo-tree-visualizer-mode) - (setq buffer-undo-tree undo-tree) - (set (make-local-variable 'undo-tree-visualizer-lazy-drawing) - (or (eq undo-tree-visualizer-lazy-drawing t) - (and (numberp undo-tree-visualizer-lazy-drawing) - (>= (undo-tree-count undo-tree) - undo-tree-visualizer-lazy-drawing)))) - (when undo-tree-visualizer-diff (undo-tree-visualizer-show-diff)) - (let ((inhibit-read-only t)) (undo-tree-draw-tree undo-tree)))) - - -(defun undo-tree-kill-visualizer (&rest _dummy) - ;; Kill visualizer. Added to `before-change-functions' hook of original - ;; buffer when visualizer is invoked. - (unless (or undo-tree-inhibit-kill-visualizer - (null (get-buffer undo-tree-visualizer-buffer-name))) - (with-current-buffer undo-tree-visualizer-buffer-name - (undo-tree-visualizer-quit)))) - - - -(defun undo-tree-draw-tree (undo-tree) - ;; Draw undo-tree in current buffer starting from NODE (or root if nil). - (let ((inhibit-read-only t) - (node (if undo-tree-visualizer-lazy-drawing - (undo-tree-current undo-tree) - (undo-tree-root undo-tree)))) - (erase-buffer) - (setq undo-tree-visualizer-needs-extending-down nil - undo-tree-visualizer-needs-extending-up nil) - (undo-tree-clear-visualizer-data undo-tree) - (undo-tree-compute-widths node) - ;; lazy drawing starts vertically centred and displaced horizontally to - ;; the left (window-width/4), since trees will typically grow right - (if undo-tree-visualizer-lazy-drawing - (progn - (undo-tree-move-down (/ (window-height) 2)) - (undo-tree-move-forward (max 2 (/ (window-width) 4)))) ; left margin - ;; non-lazy drawing starts in centre at top of buffer - (undo-tree-move-down 1) ; top margin - (undo-tree-move-forward - (max (/ (window-width) 2) - (+ (undo-tree-node-char-lwidth node) - ;; add space for left part of left-most time-stamp - (if undo-tree-visualizer-timestamps - (/ (- undo-tree-visualizer-spacing 4) 2) - 0) - 2)))) ; left margin - ;; link starting node to its representation in visualizer - (setf (undo-tree-node-marker node) (make-marker)) - (set-marker-insertion-type (undo-tree-node-marker node) nil) - (move-marker (undo-tree-node-marker node) (point)) - ;; draw undo-tree - (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face) - node-list) - (if (not undo-tree-visualizer-lazy-drawing) - (undo-tree-extend-down node t) - (undo-tree-extend-down node) - (undo-tree-extend-up node) - (setq node-list undo-tree-visualizer-needs-extending-down - undo-tree-visualizer-needs-extending-down nil) - (while node-list (undo-tree-extend-down (pop node-list))))) - ;; highlight active branch - (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)) - (undo-tree-highlight-active-branch - (or undo-tree-visualizer-needs-extending-up - (undo-tree-root undo-tree)))) - ;; highlight current node - (undo-tree-draw-node (undo-tree-current undo-tree) 'current))) - - -(defun undo-tree-extend-down (node &optional bottom) - ;; Extend tree downwards starting from NODE and point. If BOTTOM is t, - ;; extend all the way down to the leaves. If BOTTOM is a node, extend down - ;; as far as that node. If BOTTOM is an integer, extend down as far as that - ;; line. Otherwise, only extend visible portion of tree. NODE is assumed to - ;; already have a node marker. Returns non-nil if anything was actually - ;; extended. - (let ((extended nil) - (cur-stack (list node)) - next-stack) - ;; don't bother extending if BOTTOM specifies an already-drawn node - (unless (and (undo-tree-node-p bottom) (undo-tree-node-marker bottom)) - ;; draw nodes layer by layer - (while (or cur-stack - (prog1 (setq cur-stack next-stack) - (setq next-stack nil))) - (setq node (pop cur-stack)) - ;; if node is within range being drawn... - (if (or (eq bottom t) - (and (undo-tree-node-p bottom) - (not (eq (undo-tree-node-previous node) bottom))) - (and (integerp bottom) - (>= bottom (line-number-at-pos - (undo-tree-node-marker node)))) - (and (null bottom) - (pos-visible-in-window-p (undo-tree-node-marker node) - nil t))) - ;; ...draw one layer of node's subtree (if not already drawn) - (progn - (unless (and (undo-tree-node-next node) - (undo-tree-node-marker - (nth (undo-tree-node-branch node) - (undo-tree-node-next node)))) - (goto-char (undo-tree-node-marker node)) - (undo-tree-draw-subtree node) - (setq extended t)) - (setq next-stack - (append (undo-tree-node-next node) next-stack))) - ;; ...otherwise, postpone drawing until later - (push node undo-tree-visualizer-needs-extending-down)))) - extended)) - - -(defun undo-tree-extend-up (node &optional top) - ;; Extend tree upwards starting from NODE. If TOP is t, extend all the way - ;; to root. If TOP is a node, extend up as far as that node. If TOP is an - ;; integer, extend up as far as that line. Otherwise, only extend visible - ;; portion of tree. NODE is assumed to already have a node marker. Returns - ;; non-nil if anything was actually extended. - (let ((extended nil) parent) - ;; don't bother extending if TOP specifies an already-drawn node - (unless (and (undo-tree-node-p top) (undo-tree-node-marker top)) - (while node - (setq parent (undo-tree-node-previous node)) - ;; if we haven't reached root... - (if parent - ;; ...and node is within range being drawn... - (if (or (eq top t) - (and (undo-tree-node-p top) (not (eq node top))) - (and (integerp top) - (< top (line-number-at-pos - (undo-tree-node-marker node)))) - (and (null top) - ;; NOTE: we check point in case window-start is outdated - (< (min (line-number-at-pos (point)) - (line-number-at-pos (window-start))) - (line-number-at-pos - (undo-tree-node-marker node))))) - ;; ...and it hasn't already been drawn - (when (not (undo-tree-node-marker parent)) - ;; link parent node to its representation in visualizer - (undo-tree-compute-widths parent) - (undo-tree-move-to-parent node) - (setf (undo-tree-node-marker parent) (make-marker)) - (set-marker-insertion-type - (undo-tree-node-marker parent) nil) - (move-marker (undo-tree-node-marker parent) (point)) - ;; draw subtree beneath parent - (setq undo-tree-visualizer-needs-extending-down - (nconc (delq node (undo-tree-draw-subtree parent)) - undo-tree-visualizer-needs-extending-down)) - (setq extended t)) - ;; ...otherwise, postpone drawing for later and exit - (setq undo-tree-visualizer-needs-extending-up (when parent node) - parent nil)) - - ;; if we've reached root, stop extending and add top margin - (setq undo-tree-visualizer-needs-extending-up nil) - (goto-char (undo-tree-node-marker node)) - (undo-tree-move-up 1) ; top margin - (delete-region (point-min) (line-beginning-position))) - ;; next iteration - (setq node parent))) - extended)) - - -(defun undo-tree-expand-down (from &optional to) - ;; Expand tree downwards. FROM is the node to start expanding from. Stop - ;; expanding at TO if specified. Otherwise, just expand visible portion of - ;; tree and highlight active branch from FROM. - (when undo-tree-visualizer-needs-extending-down - (let ((inhibit-read-only t) - node-list extended) - ;; extend down as far as TO node - (when to - (setq extended (undo-tree-extend-down from to)) - (goto-char (undo-tree-node-marker to)) - (redisplay t)) ; force redisplay to scroll buffer if necessary - ;; extend visible portion of tree downwards - (setq node-list undo-tree-visualizer-needs-extending-down - undo-tree-visualizer-needs-extending-down nil) - (when node-list - (dolist (n node-list) - (when (undo-tree-extend-down n) (setq extended t))) - ;; highlight active branch in newly-extended-down portion, if any - (when extended - (let ((undo-tree-insert-face - 'undo-tree-visualizer-active-branch-face)) - (undo-tree-highlight-active-branch from))))))) - - -(defun undo-tree-expand-up (from &optional to) - ;; Expand tree upwards. FROM is the node to start expanding from, TO is the - ;; node to stop expanding at. If TO node isn't specified, just expand visible - ;; portion of tree and highlight active branch down to FROM. - (when undo-tree-visualizer-needs-extending-up - (let ((inhibit-read-only t) - extended node-list) - ;; extend up as far as TO node - (when to - (setq extended (undo-tree-extend-up from to)) - (goto-char (undo-tree-node-marker to)) - ;; simulate auto-scrolling if close to top of buffer - (when (<= (line-number-at-pos (point)) scroll-margin) - (undo-tree-move-up (if (= scroll-conservatively 0) - (/ (window-height) 2) 3)) - (when (undo-tree-extend-up to) (setq extended t)) - (goto-char (undo-tree-node-marker to)) - (unless (= scroll-conservatively 0) (recenter scroll-margin)))) - ;; extend visible portion of tree upwards - (and undo-tree-visualizer-needs-extending-up - (undo-tree-extend-up undo-tree-visualizer-needs-extending-up) - (setq extended t)) - ;; extend visible portion of tree downwards - (setq node-list undo-tree-visualizer-needs-extending-down - undo-tree-visualizer-needs-extending-down nil) - (dolist (n node-list) (undo-tree-extend-down n)) - ;; highlight active branch in newly-extended-up portion, if any - (when extended - (let ((undo-tree-insert-face - 'undo-tree-visualizer-active-branch-face)) - (undo-tree-highlight-active-branch - (or undo-tree-visualizer-needs-extending-up - (undo-tree-root buffer-undo-tree)) - from)))))) - - - -(defun undo-tree-highlight-active-branch (node &optional end) - ;; Draw highlighted active branch below NODE in current buffer. Stop - ;; highlighting at END node if specified. - (let ((stack (list node))) - ;; draw active branch - (while stack - (setq node (pop stack)) - (unless (or (eq node end) - (memq node undo-tree-visualizer-needs-extending-down)) - (goto-char (undo-tree-node-marker node)) - (setq node (undo-tree-draw-subtree node 'active) - stack (nconc stack node)))))) - - -(defun undo-tree-draw-node (node &optional current) - ;; Draw symbol representing NODE in visualizer. If CURRENT is non-nil, node - ;; is current node. - (goto-char (undo-tree-node-marker node)) - (when undo-tree-visualizer-timestamps - (undo-tree-move-backward (/ undo-tree-visualizer-spacing 2))) - - (let* ((undo-tree-insert-face (and undo-tree-insert-face - (or (and (consp undo-tree-insert-face) - undo-tree-insert-face) - (list undo-tree-insert-face)))) - (register (undo-tree-node-register node)) - (unmodified (if undo-tree-visualizer-parent-mtime - (undo-tree-node-unmodified-p - node undo-tree-visualizer-parent-mtime) - (undo-tree-node-unmodified-p node))) - node-string) - ;; check node's register (if any) still stores appropriate undo-tree state - (unless (and register - (undo-tree-register-data-p - (registerv-data (get-register register))) - (eq node (undo-tree-register-data-node - (registerv-data (get-register register))))) - (setq register nil)) - ;; represent node by different symbols, depending on whether it's the - ;; current node, is saved in a register, or corresponds to an unmodified - ;; buffer - (setq node-string - (cond - (undo-tree-visualizer-timestamps - (undo-tree-timestamp-to-string - (undo-tree-node-timestamp node) - undo-tree-visualizer-relative-timestamps - current register)) - (register (char-to-string register)) - (unmodified "s") - (current "x") - (t "o")) - undo-tree-insert-face - (nconc - (cond - (current (list 'undo-tree-visualizer-current-face)) - (unmodified (list 'undo-tree-visualizer-unmodified-face)) - (register (list 'undo-tree-visualizer-register-face))) - undo-tree-insert-face)) - ;; draw node and link it to its representation in visualizer - (undo-tree-insert node-string) - (undo-tree-move-backward (if undo-tree-visualizer-timestamps - (1+ (/ undo-tree-visualizer-spacing 2)) - 1)) - (move-marker (undo-tree-node-marker node) (point)) - (put-text-property (point) (1+ (point)) 'undo-tree-node node))) - - -(defun undo-tree-draw-subtree (node &optional active-branch) - ;; Draw subtree rooted at NODE. The subtree will start from point. - ;; If ACTIVE-BRANCH is non-nil, just draw active branch below NODE. Returns - ;; list of nodes below NODE. - (let ((num-children (length (undo-tree-node-next node))) - node-list pos trunk-pos n) - ;; draw node itself - (undo-tree-draw-node node) - - (cond - ;; if we're at a leaf node, we're done - ((= num-children 0)) - - ;; if node has only one child, draw it (not strictly necessary to deal - ;; with this case separately, but as it's by far the most common case - ;; this makes the code clearer and more efficient) - ((= num-children 1) - (undo-tree-move-down 1) - (undo-tree-insert ?|) - (undo-tree-move-backward 1) - (undo-tree-move-down 1) - (undo-tree-insert ?|) - (undo-tree-move-backward 1) - (undo-tree-move-down 1) - (setq n (car (undo-tree-node-next node))) - ;; link next node to its representation in visualizer - (unless (markerp (undo-tree-node-marker n)) - (setf (undo-tree-node-marker n) (make-marker)) - (set-marker-insertion-type (undo-tree-node-marker n) nil)) - (move-marker (undo-tree-node-marker n) (point)) - ;; add next node to list of nodes to draw next - (push n node-list)) - - ;; if node has multiple children, draw branches - (t - (undo-tree-move-down 1) - (undo-tree-insert ?|) - (undo-tree-move-backward 1) - (move-marker (setq trunk-pos (make-marker)) (point)) - ;; left subtrees - (undo-tree-move-backward - (- (undo-tree-node-char-lwidth node) - (undo-tree-node-char-lwidth - (car (undo-tree-node-next node))))) - (move-marker (setq pos (make-marker)) (point)) - (setq n (cons nil (undo-tree-node-next node))) - (dotimes (_ (/ num-children 2)) - (setq n (cdr n)) - (when (or (null active-branch) - (eq (car n) - (nth (undo-tree-node-branch node) - (undo-tree-node-next node)))) - (undo-tree-move-forward 2) - (undo-tree-insert ?_ (- trunk-pos pos 2)) - (goto-char pos) - (undo-tree-move-forward 1) - (undo-tree-move-down 1) - (undo-tree-insert ?/) - (undo-tree-move-backward 2) - (undo-tree-move-down 1) - ;; link node to its representation in visualizer - (unless (markerp (undo-tree-node-marker (car n))) - (setf (undo-tree-node-marker (car n)) (make-marker)) - (set-marker-insertion-type (undo-tree-node-marker (car n)) nil)) - (move-marker (undo-tree-node-marker (car n)) (point)) - ;; add node to list of nodes to draw next - (push (car n) node-list)) - (goto-char pos) - (undo-tree-move-forward - (+ (undo-tree-node-char-rwidth (car n)) - (undo-tree-node-char-lwidth (cadr n)) - undo-tree-visualizer-spacing 1)) - (move-marker pos (point))) - ;; middle subtree (only when number of children is odd) - (when (= (mod num-children 2) 1) - (setq n (cdr n)) - (when (or (null active-branch) - (eq (car n) - (nth (undo-tree-node-branch node) - (undo-tree-node-next node)))) - (undo-tree-move-down 1) - (undo-tree-insert ?|) - (undo-tree-move-backward 1) - (undo-tree-move-down 1) - ;; link node to its representation in visualizer - (unless (markerp (undo-tree-node-marker (car n))) - (setf (undo-tree-node-marker (car n)) (make-marker)) - (set-marker-insertion-type (undo-tree-node-marker (car n)) nil)) - (move-marker (undo-tree-node-marker (car n)) (point)) - ;; add node to list of nodes to draw next - (push (car n) node-list)) - (goto-char pos) - (undo-tree-move-forward - (+ (undo-tree-node-char-rwidth (car n)) - (if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0) - undo-tree-visualizer-spacing 1)) - (move-marker pos (point))) - ;; right subtrees - (move-marker trunk-pos (1+ trunk-pos)) - (dotimes (_ (/ num-children 2)) - (setq n (cdr n)) - (when (or (null active-branch) - (eq (car n) - (nth (undo-tree-node-branch node) - (undo-tree-node-next node)))) - (goto-char trunk-pos) - (undo-tree-insert ?_ (- pos trunk-pos 1)) - (goto-char pos) - (undo-tree-move-backward 1) - (undo-tree-move-down 1) - (undo-tree-insert ?\\) - (undo-tree-move-down 1) - ;; link node to its representation in visualizer - (unless (markerp (undo-tree-node-marker (car n))) - (setf (undo-tree-node-marker (car n)) (make-marker)) - (set-marker-insertion-type (undo-tree-node-marker (car n)) nil)) - (move-marker (undo-tree-node-marker (car n)) (point)) - ;; add node to list of nodes to draw next - (push (car n) node-list)) - (when (cdr n) - (goto-char pos) - (undo-tree-move-forward - (+ (undo-tree-node-char-rwidth (car n)) - (if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0) - undo-tree-visualizer-spacing 1)) - (move-marker pos (point)))) - )) - ;; return list of nodes to draw next - (nreverse node-list))) - - -(defun undo-tree-node-char-lwidth (node) - ;; Return left-width of NODE measured in characters. - (if (= (length (undo-tree-node-next node)) 0) 0 - (- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-lwidth node)) - (if (= (undo-tree-node-cwidth node) 0) - (1+ (/ undo-tree-visualizer-spacing 2)) 0)))) - - -(defun undo-tree-node-char-rwidth (node) - ;; Return right-width of NODE measured in characters. - (if (= (length (undo-tree-node-next node)) 0) 0 - (- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-rwidth node)) - (if (= (undo-tree-node-cwidth node) 0) - (1+ (/ undo-tree-visualizer-spacing 2)) 0)))) - - -(defun undo-tree-insert (str &optional arg) - ;; Insert character or string STR ARG times, overwriting, and using - ;; `undo-tree-insert-face'. - (unless arg (setq arg 1)) - (when (characterp str) - (setq str (make-string arg str)) - (setq arg 1)) - (dotimes (_ arg) (insert str)) - (setq arg (* arg (length str))) - (undo-tree-move-forward arg) - ;; make sure mark isn't active, otherwise `backward-delete-char' might - ;; delete region instead of single char if transient-mark-mode is enabled - (setq mark-active nil) - (backward-delete-char arg) - (when undo-tree-insert-face - (put-text-property (- (point) arg) (point) 'face undo-tree-insert-face))) - - -(defun undo-tree-move-down (&optional arg) - ;; Move down, extending buffer if necessary. - (let ((row (line-number-at-pos)) - (col (current-column)) - line) - (unless arg (setq arg 1)) - (forward-line arg) - (setq line (line-number-at-pos)) - ;; if buffer doesn't have enough lines, add some - (when (/= line (+ row arg)) - (cond - ((< arg 0) - (insert (make-string (- line row arg) ?\n)) - (forward-line (+ arg (- row line)))) - (t (insert (make-string (- arg (- line row)) ?\n))))) - (undo-tree-move-forward col))) - - -(defun undo-tree-move-up (&optional arg) - ;; Move up, extending buffer if necessary. - (unless arg (setq arg 1)) - (undo-tree-move-down (- arg))) - - -(defun undo-tree-move-forward (&optional arg) - ;; Move forward, extending buffer if necessary. - (unless arg (setq arg 1)) - (let (n) - (cond - ((>= arg 0) - (setq n (- (line-end-position) (point))) - (if (> n arg) - (forward-char arg) - (end-of-line) - (insert (make-string (- arg n) ? )))) - ((< arg 0) - (setq arg (- arg)) - (setq n (- (point) (line-beginning-position))) - (when (< (- n 2) arg) ; -2 to create left-margin - ;; no space left - shift entire buffer contents right! - (let ((pos (move-marker (make-marker) (point)))) - (set-marker-insertion-type pos t) - (goto-char (point-min)) - (while (not (eobp)) - (insert-before-markers (make-string (- arg -2 n) ? )) - (forward-line 1)) - (goto-char pos))) - (backward-char arg))))) - - -(defun undo-tree-move-backward (&optional arg) - ;; Move backward, extending buffer if necessary. - (unless arg (setq arg 1)) - (undo-tree-move-forward (- arg))) - - -(defun undo-tree-move-to-parent (node) - ;; Move to position of parent of NODE, extending buffer if necessary. - (let* ((parent (undo-tree-node-previous node)) - (n (undo-tree-node-next parent)) - (l (length n)) p) - (goto-char (undo-tree-node-marker node)) - (unless (= l 1) - ;; move horizontally - (setq p (undo-tree-position node n)) - (cond - ;; node in centre subtree: no horizontal movement - ((and (= (mod l 2) 1) (= p (/ l 2)))) - ;; node in left subtree: move right - ((< p (/ l 2)) - (setq n (nthcdr p n)) - (undo-tree-move-forward - (+ (undo-tree-node-char-rwidth (car n)) - (/ undo-tree-visualizer-spacing 2) 1)) - (dotimes (_ (- (/ l 2) p 1)) - (setq n (cdr n)) - (undo-tree-move-forward - (+ (undo-tree-node-char-lwidth (car n)) - (undo-tree-node-char-rwidth (car n)) - undo-tree-visualizer-spacing 1))) - (when (= (mod l 2) 1) - (setq n (cdr n)) - (undo-tree-move-forward - (+ (undo-tree-node-char-lwidth (car n)) - (/ undo-tree-visualizer-spacing 2) 1)))) - (t ;; node in right subtree: move left - (setq n (nthcdr (/ l 2) n)) - (when (= (mod l 2) 1) - (undo-tree-move-backward - (+ (undo-tree-node-char-rwidth (car n)) - (/ undo-tree-visualizer-spacing 2) 1)) - (setq n (cdr n))) - (dotimes (_ (- p (/ l 2) (mod l 2))) - (undo-tree-move-backward - (+ (undo-tree-node-char-lwidth (car n)) - (undo-tree-node-char-rwidth (car n)) - undo-tree-visualizer-spacing 1)) - (setq n (cdr n))) - (undo-tree-move-backward - (+ (undo-tree-node-char-lwidth (car n)) - (/ undo-tree-visualizer-spacing 2) 1))))) - ;; move vertically - (undo-tree-move-up 3))) - - -(defun undo-tree-timestamp-to-string - (timestamp &optional relative current register) - ;; Convert TIMESTAMP to string (either absolute or RELATVE time), indicating - ;; if it's the CURRENT node and/or has an associated REGISTER. - (if relative - ;; relative time - (let ((time (floor (float-time - (time-subtract (current-time) timestamp)))) - n) - (setq time - ;; years - (if (> (setq n (/ time 315360000)) 0) - (if (> n 999) "-ages" (format "-%dy" n)) - (setq time (% time 315360000)) - ;; days - (if (> (setq n (/ time 86400)) 0) - (format "-%dd" n) - (setq time (% time 86400)) - ;; hours - (if (> (setq n (/ time 3600)) 0) - (format "-%dh" n) - (setq time (% time 3600)) - ;; mins - (if (> (setq n (/ time 60)) 0) - (format "-%dm" n) - ;; secs - (format "-%ds" (% time 60))))))) - (setq time (concat - (if current "*" " ") - time - (if register (concat "[" (char-to-string register) "]") - " "))) - (setq n (length time)) - (if (< n 9) - (concat (make-string (- 9 n) ? ) time) - time)) - ;; absolute time - (concat (if current " *" " ") - (format-time-string "%H:%M:%S" timestamp) - (if register - (concat "[" (char-to-string register) "]") - " ")))) - - - - -;;; ===================================================================== -;;; Visualizer modes - -(define-derived-mode - undo-tree-visualizer-mode special-mode "undo-tree-visualizer" - "Major mode used in undo-tree visualizer. - -The undo-tree visualizer can only be invoked from a buffer in -which `undo-tree-mode' is enabled. The visualizer displays the -undo history tree graphically, and allows you to browse around -the undo history, undoing or redoing the corresponding changes in -the parent buffer. - -Within the undo-tree visualizer, the following keys are available: - - \\{undo-tree-visualizer-mode-map}" - :syntax-table nil - :abbrev-table nil - (setq truncate-lines t) - (setq cursor-type nil) - (setq undo-tree-visualizer-selected-node nil) - (make-local-variable 'undo-tree-visualizer-timestamps) - (make-local-variable 'undo-tree-visualizer-diff)) - - -(define-minor-mode undo-tree-visualizer-selection-mode - "Toggle mode to select nodes in undo-tree visualizer." - :lighter "Select" - :keymap undo-tree-visualizer-selection-mode-map - :group undo-tree - (cond - ;; enable selection mode - (undo-tree-visualizer-selection-mode - (setq cursor-type 'box) - (setq undo-tree-visualizer-selected-node - (undo-tree-current buffer-undo-tree)) - ;; erase diff (if any), as initially selected node is identical to current - (when undo-tree-visualizer-diff - (let ((buff (get-buffer undo-tree-diff-buffer-name)) - (inhibit-read-only t)) - (when buff (with-current-buffer buff (erase-buffer)))))) - (t ;; disable selection mode - (setq cursor-type nil) - (setq undo-tree-visualizer-selected-node nil) - (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree))) - (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff))) - )) - - - - -;;; ===================================================================== -;;; Visualizer commands - -(defun undo-tree-visualize-undo (&optional arg) - "Undo changes. A numeric ARG serves as a repeat count." - (interactive "p") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (let ((old (undo-tree-current buffer-undo-tree)) - current) - ;; undo in parent buffer - (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer) - (deactivate-mark) - (unwind-protect - (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-undo-1 arg)) - (setq current (undo-tree-current buffer-undo-tree)) - (switch-to-buffer-other-window undo-tree-visualizer-buffer-name) - ;; unhighlight old current node - (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face) - (inhibit-read-only t)) - (undo-tree-draw-node old)) - ;; when using lazy drawing, extend tree upwards as required - (when undo-tree-visualizer-lazy-drawing - (undo-tree-expand-up old current)) - ;; highlight new current node - (let ((inhibit-read-only t)) (undo-tree-draw-node current 'current)) - ;; update diff display, if any - (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff))))) - - -(defun undo-tree-visualize-redo (&optional arg) - "Redo changes. A numeric ARG serves as a repeat count." - (interactive "p") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (let ((old (undo-tree-current buffer-undo-tree)) - current) - ;; redo in parent buffer - (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer) - (deactivate-mark) - (unwind-protect - (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-redo-1 arg)) - (setq current (undo-tree-current buffer-undo-tree)) - (switch-to-buffer-other-window undo-tree-visualizer-buffer-name) - ;; unhighlight old current node - (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face) - (inhibit-read-only t)) - (undo-tree-draw-node old)) - ;; when using lazy drawing, extend tree downwards as required - (when undo-tree-visualizer-lazy-drawing - (undo-tree-expand-down old current)) - ;; highlight new current node - (let ((inhibit-read-only t)) (undo-tree-draw-node current 'current)) - ;; update diff display, if any - (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff))))) - - -(defun undo-tree-visualize-switch-branch-right (arg) - "Switch to next branch of the undo tree. -This will affect which branch to descend when *redoing* changes -using `undo-tree-redo' or `undo-tree-visualizer-redo'." - (interactive "p") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - ;; un-highlight old active branch below current node - (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree))) - (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face) - (inhibit-read-only t)) - (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree))) - ;; increment branch - (let ((branch (undo-tree-node-branch (undo-tree-current buffer-undo-tree)))) - (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree)) - (cond - ((>= (+ branch arg) (undo-tree-num-branches)) - (1- (undo-tree-num-branches))) - ((<= (+ branch arg) 0) 0) - (t (+ branch arg)))) - (let ((inhibit-read-only t)) - ;; highlight new active branch below current node - (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree))) - (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)) - (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree))) - ;; re-highlight current node - (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current)))) - - -(defun undo-tree-visualize-switch-branch-left (arg) - "Switch to previous branch of the undo tree. -This will affect which branch to descend when *redoing* changes -using `undo-tree-redo' or `undo-tree-visualizer-redo'." - (interactive "p") - (undo-tree-visualize-switch-branch-right (- arg))) - - -(defun undo-tree-visualizer-quit () - "Quit the undo-tree visualizer." - (interactive) - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (undo-tree-clear-visualizer-data buffer-undo-tree) - ;; remove kill visualizer hook from parent buffer - (unwind-protect - (with-current-buffer undo-tree-visualizer-parent-buffer - (remove-hook 'before-change-functions 'undo-tree-kill-visualizer t)) - ;; kill diff buffer, if any - (when undo-tree-visualizer-diff (undo-tree-visualizer-hide-diff)) - (let ((parent undo-tree-visualizer-parent-buffer) - window) - ;; kill visualizer buffer - (kill-buffer nil) - ;; switch back to parent buffer - (unwind-protect - (if (setq window (get-buffer-window parent)) - (select-window window) - (switch-to-buffer parent)))))) - - -(defun undo-tree-visualizer-abort () - "Quit the undo-tree visualizer and return buffer to original state." - (interactive) - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (let ((node undo-tree-visualizer-initial-node)) - (undo-tree-visualizer-quit) - (undo-tree-set node))) - - -(defun undo-tree-visualizer-set (&optional pos) - "Set buffer to state corresponding to undo tree node -at POS, or point if POS is nil." - (interactive) - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (unless pos (setq pos (point))) - (let ((node (get-text-property pos 'undo-tree-node))) - (when node - ;; set parent buffer to state corresponding to node at POS - (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer) - (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-set node)) - (switch-to-buffer-other-window undo-tree-visualizer-buffer-name) - ;; re-draw undo tree - (let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree)) - (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff))))) - - -(defun undo-tree-visualizer-mouse-set (pos) - "Set buffer to state corresponding to undo tree node -at mouse event POS." - (interactive "@e") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (undo-tree-visualizer-set (event-start (nth 1 pos)))) - - -(defun undo-tree-visualize-undo-to-x (&optional x) - "Undo to last branch point, register, or saved state. -If X is the symbol `branch', undo to last branch point. If X is -the symbol `register', undo to last register. If X is the symbol -`saved', undo to last saved state. If X is null, undo to first of -these that's encountered. - -Interactively, a single \\[universal-argument] specifies -`branch', a double \\[universal-argument] \\[universal-argument] -specifies `saved', and a negative prefix argument specifies -`register'." - (interactive "P") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (when (and (called-interactively-p 'any) x) - (setq x (prefix-numeric-value x) - x (cond - ((< x 0) 'register) - ((<= x 4) 'branch) - (t 'saved)))) - (let ((current (if undo-tree-visualizer-selection-mode - undo-tree-visualizer-selected-node - (undo-tree-current buffer-undo-tree))) - (diff undo-tree-visualizer-diff) - r) - (undo-tree-visualizer-hide-diff) - (while (and (undo-tree-node-previous current) - (or (if undo-tree-visualizer-selection-mode - (progn - (undo-tree-visualizer-select-previous) - (setq current undo-tree-visualizer-selected-node)) - (undo-tree-visualize-undo) - (setq current (undo-tree-current buffer-undo-tree))) - t) - ;; branch point - (not (or (and (or (null x) (eq x 'branch)) - (> (undo-tree-num-branches) 1)) - ;; register - (and (or (null x) (eq x 'register)) - (setq r (undo-tree-node-register current)) - (undo-tree-register-data-p - (setq r (registerv-data (get-register r)))) - (eq current (undo-tree-register-data-node r))) - ;; saved state - (and (or (null x) (eq x 'saved)) - (undo-tree-node-unmodified-p current)) - )))) - ;; update diff display, if any - (when diff - (undo-tree-visualizer-show-diff - (when undo-tree-visualizer-selection-mode - undo-tree-visualizer-selected-node))))) - - -(defun undo-tree-visualize-redo-to-x (&optional x) - "Redo to last branch point, register, or saved state. -If X is the symbol `branch', redo to last branch point. If X is -the symbol `register', redo to last register. If X is the sumbol -`saved', redo to last saved state. If X is null, redo to first of -these that's encountered. - -Interactively, a single \\[universal-argument] specifies -`branch', a double \\[universal-argument] \\[universal-argument] -specifies `saved', and a negative prefix argument specifies -`register'." - (interactive "P") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (when (and (called-interactively-p 'any) x) - (setq x (prefix-numeric-value x) - x (cond - ((< x 0) 'register) - ((<= x 4) 'branch) - (t 'saved)))) - (let ((current (if undo-tree-visualizer-selection-mode - undo-tree-visualizer-selected-node - (undo-tree-current buffer-undo-tree))) - (diff undo-tree-visualizer-diff) - r) - (undo-tree-visualizer-hide-diff) - (while (and (undo-tree-node-next current) - (or (if undo-tree-visualizer-selection-mode - (progn - (undo-tree-visualizer-select-next) - (setq current undo-tree-visualizer-selected-node)) - (undo-tree-visualize-redo) - (setq current (undo-tree-current buffer-undo-tree))) - t) - ;; branch point - (not (or (and (or (null x) (eq x 'branch)) - (> (undo-tree-num-branches) 1)) - ;; register - (and (or (null x) (eq x 'register)) - (setq r (undo-tree-node-register current)) - (undo-tree-register-data-p - (setq r (registerv-data (get-register r)))) - (eq current (undo-tree-register-data-node r))) - ;; saved state - (and (or (null x) (eq x 'saved)) - (undo-tree-node-unmodified-p current)) - )))) - ;; update diff display, if any - (when diff - (undo-tree-visualizer-show-diff - (when undo-tree-visualizer-selection-mode - undo-tree-visualizer-selected-node))))) - - -(defun undo-tree-visualizer-toggle-timestamps () - "Toggle display of time-stamps." - (interactive) - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (setq undo-tree-visualizer-timestamps (not undo-tree-visualizer-timestamps)) - (setq undo-tree-visualizer-spacing (undo-tree-visualizer-calculate-spacing)) - ;; redraw tree - (let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree))) - - -(defun undo-tree-visualizer-scroll-left (&optional arg) - (interactive "p") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (scroll-left (or arg 1) t)) - - -(defun undo-tree-visualizer-scroll-right (&optional arg) - (interactive "p") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (scroll-right (or arg 1) t)) - - -(defun undo-tree-visualizer-scroll-up (&optional arg) - (interactive "P") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (if (or (and (numberp arg) (< arg 0)) (eq arg '-)) - (undo-tree-visualizer-scroll-down arg) - ;; scroll up and expand newly-visible portion of tree - (unwind-protect - (scroll-up-command arg) - (undo-tree-expand-down - (nth (undo-tree-node-branch (undo-tree-current buffer-undo-tree)) - (undo-tree-node-next (undo-tree-current buffer-undo-tree))))) - ;; signal error if at eob - (when (and (not undo-tree-visualizer-needs-extending-down) (eobp)) - (scroll-up)))) - - -(defun undo-tree-visualizer-scroll-down (&optional arg) - (interactive "P") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (if (or (and (numberp arg) (< arg 0)) (eq arg '-)) - (undo-tree-visualizer-scroll-up arg) - ;; ensure there's enough room at top of buffer to scroll - (let ((scroll-lines - (or arg (- (window-height) next-screen-context-lines))) - (window-line (1- (line-number-at-pos (window-start))))) - (when (and undo-tree-visualizer-needs-extending-up - (< window-line scroll-lines)) - (let ((inhibit-read-only t)) - (goto-char (point-min)) - (undo-tree-move-up (- scroll-lines window-line))))) - ;; scroll down and expand newly-visible portion of tree - (unwind-protect - (scroll-down-command arg) - (undo-tree-expand-up - (undo-tree-node-previous (undo-tree-current buffer-undo-tree)))) - ;; signal error if at bob - (when (and (not undo-tree-visualizer-needs-extending-down) (bobp)) - (scroll-down)))) - - - - -;;; ===================================================================== -;;; Visualizer selection mode commands - -(defun undo-tree-visualizer-select-previous (&optional arg) - "Move to previous node." - (interactive "p") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (let ((node undo-tree-visualizer-selected-node)) - (catch 'top - (dotimes (_ (or arg 1)) - (unless (undo-tree-node-previous node) (throw 'top t)) - (setq node (undo-tree-node-previous node)))) - ;; when using lazy drawing, extend tree upwards as required - (when undo-tree-visualizer-lazy-drawing - (undo-tree-expand-up undo-tree-visualizer-selected-node node)) - ;; update diff display, if any - (when (and undo-tree-visualizer-diff - (not (eq node undo-tree-visualizer-selected-node))) - (undo-tree-visualizer-update-diff node)) - ;; move to selected node - (goto-char (undo-tree-node-marker node)) - (setq undo-tree-visualizer-selected-node node))) - - -(defun undo-tree-visualizer-select-next (&optional arg) - "Move to next node." - (interactive "p") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (let ((node undo-tree-visualizer-selected-node)) - (catch 'bottom - (dotimes (_ (or arg 1)) - (unless (nth (undo-tree-node-branch node) (undo-tree-node-next node)) - (throw 'bottom t)) - (setq node - (nth (undo-tree-node-branch node) (undo-tree-node-next node))))) - ;; when using lazy drawing, extend tree downwards as required - (when undo-tree-visualizer-lazy-drawing - (undo-tree-expand-down undo-tree-visualizer-selected-node node)) - ;; update diff display, if any - (when (and undo-tree-visualizer-diff - (not (eq node undo-tree-visualizer-selected-node))) - (undo-tree-visualizer-update-diff node)) - ;; move to selected node - (goto-char (undo-tree-node-marker node)) - (setq undo-tree-visualizer-selected-node node))) - - -(defun undo-tree-visualizer-select-right (&optional arg) - "Move right to a sibling node." - (interactive "p") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (let ((node undo-tree-visualizer-selected-node) - end) - (goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node)) - (setq end (line-end-position)) - (catch 'end - (dotimes (_ arg) - (while (or (null node) (eq node undo-tree-visualizer-selected-node)) - (forward-char) - (setq node (get-text-property (point) 'undo-tree-node)) - (when (= (point) end) (throw 'end t))))) - (goto-char (undo-tree-node-marker - (or node undo-tree-visualizer-selected-node))) - (when (and undo-tree-visualizer-diff node - (not (eq node undo-tree-visualizer-selected-node))) - (undo-tree-visualizer-update-diff node)) - (when node (setq undo-tree-visualizer-selected-node node)))) - - -(defun undo-tree-visualizer-select-left (&optional arg) - "Move left to a sibling node." - (interactive "p") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (let ((node (get-text-property (point) 'undo-tree-node)) - beg) - (goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node)) - (setq beg (line-beginning-position)) - (catch 'beg - (dotimes (_ arg) - (while (or (null node) (eq node undo-tree-visualizer-selected-node)) - (backward-char) - (setq node (get-text-property (point) 'undo-tree-node)) - (when (= (point) beg) (throw 'beg t))))) - (goto-char (undo-tree-node-marker - (or node undo-tree-visualizer-selected-node))) - (when (and undo-tree-visualizer-diff node - (not (eq node undo-tree-visualizer-selected-node))) - (undo-tree-visualizer-update-diff node)) - (when node (setq undo-tree-visualizer-selected-node node)))) - - -(defun undo-tree-visualizer-select (pos) - (let ((node (get-text-property pos 'undo-tree-node))) - (when node - ;; select node at POS - (goto-char (undo-tree-node-marker node)) - ;; when using lazy drawing, extend tree up and down as required - (when undo-tree-visualizer-lazy-drawing - (undo-tree-expand-up undo-tree-visualizer-selected-node node) - (undo-tree-expand-down undo-tree-visualizer-selected-node node)) - ;; update diff display, if any - (when (and undo-tree-visualizer-diff - (not (eq node undo-tree-visualizer-selected-node))) - (undo-tree-visualizer-update-diff node)) - ;; update selected node - (setq undo-tree-visualizer-selected-node node) - ))) - - -(defun undo-tree-visualizer-mouse-select (pos) - "Select undo tree node at mouse event POS." - (interactive "@e") - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (undo-tree-visualizer-select (event-start (nth 1 pos)))) - - - - -;;; ===================================================================== -;;; Visualizer diff display - -(defun undo-tree-visualizer-toggle-diff () - "Toggle diff display in undo-tree visualizer." - (interactive) - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (if undo-tree-visualizer-diff - (undo-tree-visualizer-hide-diff) - (undo-tree-visualizer-show-diff))) - - -(defun undo-tree-visualizer-selection-toggle-diff () - "Toggle diff display in undo-tree visualizer selection mode." - (interactive) - (unless (eq major-mode 'undo-tree-visualizer-mode) - (user-error "Undo-tree mode not enabled in buffer")) - (if undo-tree-visualizer-diff - (undo-tree-visualizer-hide-diff) - (let ((node (get-text-property (point) 'undo-tree-node))) - (when node (undo-tree-visualizer-show-diff node))))) - - -(defun undo-tree-visualizer-show-diff (&optional node) - ;; show visualizer diff display - (setq undo-tree-visualizer-diff t) - (let ((buff (with-current-buffer undo-tree-visualizer-parent-buffer - (undo-tree-diff node))) - (display-buffer-mark-dedicated 'soft) - win) - (setq win (split-window)) - (set-window-buffer win buff) - (shrink-window-if-larger-than-buffer win))) - - -(defun undo-tree-visualizer-hide-diff () - ;; hide visualizer diff display - (setq undo-tree-visualizer-diff nil) - (let ((win (get-buffer-window undo-tree-diff-buffer-name))) - (when win (with-selected-window win (kill-buffer-and-window))))) - - -(defun undo-tree-diff (&optional node) - ;; Create diff between NODE and current state (or previous state and current - ;; state, if NODE is null). Returns buffer containing diff. - (let (tmpfile buff) - ;; generate diff - (let ((undo-tree-inhibit-kill-visualizer t) - (current (undo-tree-current buffer-undo-tree))) - (undo-tree-set (or node (undo-tree-node-previous current) current) - 'preserve-timestamps) - (setq tmpfile (diff-file-local-copy (current-buffer))) - (undo-tree-set current 'preserve-timestamps)) - (setq buff (diff-no-select - tmpfile (current-buffer) nil 'noasync - (get-buffer-create undo-tree-diff-buffer-name))) - ;; delete process messages and useless headers from diff buffer - (let ((inhibit-read-only t)) - (with-current-buffer buff - (goto-char (point-min)) - (delete-region (point) (1+ (line-end-position 3))) - (goto-char (point-max)) - (forward-line -2) - (delete-region (point) (point-max)) - (setq cursor-type nil) - (setq buffer-read-only t))) - buff)) - - -(defun undo-tree-visualizer-update-diff (&optional node) - ;; update visualizer diff display to show diff between current state and - ;; NODE (or previous state, if NODE is null) - (with-current-buffer undo-tree-visualizer-parent-buffer - (undo-tree-diff node)) - (let ((win (get-buffer-window undo-tree-diff-buffer-name))) - (when win - (balance-windows) - (shrink-window-if-larger-than-buffer win)))) - - - -(provide 'undo-tree) - -;;; undo-tree.el ends here diff --git a/.emacs.d/lisp/vundo.el b/.emacs.d/lisp/vundo.el new file mode 100644 index 0000000..8b95192 --- /dev/null +++ b/.emacs.d/lisp/vundo.el @@ -0,0 +1,1484 @@ +;;; vundo.el --- Visual undo tree -*- lexical-binding: t; -*- + +;; Copyright (C) 2019-2023 Free Software Foundation, Inc. +;; +;; Author: Yuan Fu +;; Maintainer: Yuan Fu +;; URL: https://github.com/casouri/vundo +;; Version: 2.4.0 +;; Keywords: undo, text, editing +;; Package-Requires: ((emacs "28.1")) +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; Vundo (visual undo) displays the undo history as a tree and lets you +;; move in the tree to go back to previous buffer states. To use vundo, +;; type M-x vundo RET in the buffer you want to undo. An undo tree buffer +;; should pop up. To move around, type: +;; +;; f to go forward +;; b to go backward +;; +;; n to go to the node below when you at a branching point +;; p to go to the node above +;; +;; a to go back to the last branching point +;; w to go to the beginning of the next stem/branch +;; e to go forward to the end/tip of the branch +;; l to go to the last saved node +;; r to go to the next saved node +;; +;; m to mark the current node for diff +;; u to unmark the marked node +;; d to show a diff between the marked (or parent) and current nodes +;; +;; q to quit, you can also type C-g +;; +;; n/p may need some more explanation. In the following tree, n/p can +;; move between A and B because they share a parent (thus at a branching +;; point), but not C and D. +;; +;; A C +;; ──○──○──○──○──○ +;; │ ↕ +;; └──○──○──○ +;; B D +;; +;; By default, you need to press RET to “commit” your change and if you +;; quit with q or C-g, the changes made by vundo are rolled back. You can +;; set `vundo-roll-back-on-quit' to nil to disable rolling back. +;; +;; Note: vundo.el requires Emacs 28. +;; +;; Customizable faces: +;; +;; - vundo-default +;; - vundo-node +;; - vundo-stem +;; - vundo-highlight +;; +;; If you want to use prettier Unicode characters to draw the tree like +;; this: +;; +;; ○──○──○ +;; │ └──● +;; ├──○ +;; └──○ +;; +;; set vundo-glyph-alist by +;; +;; (setq vundo-glyph-alist vundo-unicode-symbols) +;; +;; Your default font needs to contain these Unicode characters, otherwise +;; they look terrible and don’t align. You can find a font that covers +;; these characters (eg, Symbola, Unifont), and set `vundo-default' face +;; to use that font: +;; +;; (set-face-attribute 'vundo-default nil :family "Symbola") +;; +;; Comparing to undo-tree: +;; +;; Vundo doesn’t need to be turned on all the time nor replace the undo +;; commands like undo-tree does. Vundo displays the tree horizontally, +;; whereas undo-tree displays a tree vertically. + +;;; Developer: +;; +;; In the comments, when I say node, modification, mod, buffer state, +;; they all mean one thing: `vundo-m'. Ie, `vundo-m' represents +;; multiple things at once: it represents an modification recorded in +;; `buffer-undo-list', it represents the state of the buffer after +;; that modification took place, and it represents the node in the +;; undo tree in the vundo buffer representing that buffer state. +;; +;; The basic flow of the program: +;; +;; `vundo' calls `vundo--refresh-buffer' to setup the tree structure +;; and draw it in the buffer. We have two data structures: +;; `vundo--prev-mod-list' which stores a vector of `vundo-m'. This vector +;; is generated from `buffer-undo-list' by `vundo--mod-list-from'. We +;; also have a hash table `vundo--prev-mod-hash' generated by +;; `vundo--update-mapping', which maps undo-lists back to the +;; `vundo-m' object corresponding to it. Once we have the mod-list and +;; hash table, we connect the nodes in mod-list to form a tree in +;; `vundo--build-tree'. We build the tree by a simple observation: +;; only non-undo modifications creates new unique buffer states and +;; need to be drawn in the tree. For undo modifications, they +;; associate equivalent nodes. +;; +;; Once we have generated the data structure and drawn the tree, vundo +;; commands can move around in that tree by calling +;; `vundo--move-to-node'. It will construct the correct undo-list and +;; feed it to `primitive-undo'. `vundo--trim-undo-list' can trim the +;; undo list when possible. +;; +;; Finally, to avoid generating everything from scratch every time we +;; move on the tree, `vundo--refresh-buffer' can incrementally update +;; the data structures (`vundo--prev-mod-list' and +;; `vundo--prev-mod-hash'). If the undo list expands, we only process +;; the new entries, if the undo list shrinks (trimmed), we remove +;; modifications accordingly. +;; +;; For a high-level explanation of how this package works, see +;; https://archive.casouri.cat/note/2021/visual-undo-tree. +;; +;; Position-only records +;; +;; We know how undo works: when undoing, `primitive-undo' looks at +;; each record in `pending-undo-list' and modifies the buffer +;; accordingly, and that modification itself pushes new undo records +;; into `buffer-undo-list'. However, not all undo records introduce +;; modification, if the record is an integer, `primitive-undo' simply +;; `goto' that position, which introduces no modification to the +;; buffer and pushes no undo record to `buffer-undo-list'. Normally +;; position records accompany other buffer-modifying records, but if a +;; particular record consists of only position records, we have +;; trouble: after an undo step, `buffer-undo-list' didn’t grow, as far +;; as vundo tree-folding algorithm is concerned, we didn’t move. +;; Assertions expecting to see new undo records in `buffer-undo-list' +;; are also violated. To avoid all these complications, we ignore +;; position-only records when generating mod-list in +;; `vundo--mod-list-from'. These records are not removed, but they +;; can’t harm us now. + +;;; Code: + +(require 'pcase) +(require 'cl-lib) +(require 'seq) +(require 'subr-x) + +;;; Customization + +(defgroup vundo nil + "Visual undo tree." + :group 'undo) + +(defface vundo-default '((t . (:inherit default))) + "Default face used in vundo buffer.") + +(defface vundo-node '((t . (:inherit vundo-default))) + "Face for nodes in the undo tree.") + +(defface vundo-stem '((t . (:inherit vundo-default))) + "Face for stems between nodes in the undo tree.") + +(defface vundo-branch-stem + '((t (:inherit vundo-stem :weight bold))) + "Face for branching stems in the undo tree.") + +(defface vundo-highlight + '((((background light)) . + (:inherit vundo-node :weight bold :foreground "red")) + (((background dark)) . + (:inherit vundo-node :weight bold :foreground "yellow"))) + "Face for the highlighted node in the undo tree.") + +(defface vundo-saved + '((((background light)) . + (:inherit vundo-node :foreground "dark green")) + (((background dark)) . + (:inherit vundo-node :foreground "light green"))) + "Face for saved nodes in the undo tree.") + +(defface vundo-last-saved + '((t (:inherit vundo-saved :weight bold))) + "Face for the last saved node in the undo tree.") + +(defcustom vundo-roll-back-on-quit t + "If non-nil, vundo will roll back the change when it quits." + :type 'boolean) + +(defcustom vundo-highlight-saved-nodes t + "If non-nil, vundo will highlight nodes which have been saved and then modified. +The face `vundo-saved' is used for saved nodes, except for the +most recent such node, which receives the face `vundo-last-saved'." + :type 'boolean) + +(defcustom vundo-window-max-height 3 + "The maximum height of the vundo window." + :type 'integer) + +(defcustom vundo-window-side 'bottom + "The vundo window pops up on this side." + :type '(choice (const :tag "Bottom" bottom) + (const :tag "Top" top))) + +;;;###autoload +(defconst vundo-ascii-symbols + '((selected-node . ?x) + (node . ?o) + (horizontal-stem . ?-) + (vertical-stem . ?|) + (branch . ?|) + (last-branch . ?`)) + "ASCII symbols to draw vundo tree.") + +;;;###autoload +(defconst vundo-unicode-symbols + '((selected-node . ?●) + (node . ?○) + (horizontal-stem . ?─) + (vertical-stem . ?│) + (branch . ?├) + (last-branch . ?└)) + "Unicode symbols to draw vundo tree.") + +(defcustom vundo-compact-display nil + "Show a more compact tree display if non-nil. +Basically we display + + ○─○─○ instead of ○──○──○ + │ └─● │ └──● + ├─○ ├──○ + └─○ └──○" + :type 'boolean) + +(defcustom vundo-glyph-alist vundo-ascii-symbols + "Alist mapping tree parts to characters used to draw a tree. +Keys are names for different parts of a tree, values are +characters for that part. Possible keys include + +node which represents ○ +selected-node which represents ● +horizontal-stem which represents ─ +vertical-stem which represents │ +branch which represents ├ +last-branch which represents └ + +in a tree like + + ○──○──○ + │ └──● + ├──○ + └──○ + +By default, the tree is drawn with ASCII characters like this: + + o--o--o + | \\=`--x + |--o + \\=`--o + +Set this variable to `vundo-unicode-symbols' to use Unicode +characters." + :type `(alist :tag "Translation alist" + :key-type (symbol :tag "Part of tree") + :value-type (character :tag "Draw using") + :options ,(mapcar #'car vundo-unicode-symbols))) + +(defcustom vundo-pre-enter-hook nil + "List of functions to call when entering vundo. +This hook runs immediately after ‘vundo’ is called, in the buffer +the user invoked ‘vundo’, before every setup ‘vundo’ does." + :type 'hook) + +(defcustom vundo-post-exit-hook nil + "List of functions to call when exiting vundo. +This hook runs in the original buffer the user invoked ‘vundo’, +after all the clean up the exiting function does. Ie, it is the +very last thing that happens when vundo exits." + :type 'hook) + +(defcustom vundo-diff-setup-hook nil + "List of functions to call after creating a diff buffer. +This hook runs in the ‘vundo-diff’ buffer immediately after it's setup, +both for new or existing buffers. This may be used to +manipulate the diff or transform its contents." + :type 'hook) + +;;; Undo list to mod list + +(cl-defstruct vundo-m + "A modification in undo history. +This object serves two purpose: it represents a modification in +undo history, and it also represents the buffer state after the +modification." + (idx + nil + :type integer + :documentation "The index of this modification in history.") + (children + nil + :type proper-list + :documentation "Children in tree.") + (parent + nil + :type vundo-m + :documentation "Parent in tree.") + (prev-eqv + nil + :type vundo-m + :documentation "The previous equivalent state.") + (next-eqv + nil + :type vundo-m + :documentation "The next equivalent state.") + (undo-list + nil + :type cons + :documentation "The undo-list at this modification.") + (point + nil + :type integer + :documentation "Marks the text node in the vundo buffer if drawn.") + (timestamp + nil + :type timestamp + :documentation + "Timestamp at which this mod altered a saved buffer state. +If this field is non-nil, the mod contains a timestamp entry in +the undo list, meaning the previous state was saved to file. This +field records that timestamp.")) + +(defun vundo--position-only-p (undo-list) + "Check if the records at the start of UNDO-LIST are position-only. +Position-only means all records until to the next undo +boundary are position records. Position record is just an +integer (see `buffer-undo-list'). Assumes the first element +of UNDO-LIST is not nil." + (let ((pos-only t)) + (while (car undo-list) + (when (not (integerp (pop undo-list))) + (setq pos-only nil) + (setq undo-list nil))) + pos-only)) + +(defun vundo--mod-list-from (undo-list &optional n mod-list) + "Generate and return a modification list from UNDO-LIST. +If N non-nil, only look at the first N entries in UNDO-LIST. +If MOD-LIST non-nil, extend on MOD-LIST." + (let ((uidx 0) + (mod-list (or mod-list (vector (make-vundo-m)))) + new-mlist) + (while (and undo-list (or (null n) (< uidx n))) + ;; Skip leading nils. + (while (and undo-list (null (car undo-list))) + (setq undo-list (cdr undo-list)) + (cl-incf uidx)) + ;; It's possible the index was exceeded stepping over nil. + (when (or (null n) (< uidx n)) + ;; Add modification. + (let ((pos-only (vundo--position-only-p undo-list)) + (mod-timestamp nil)) + (unless pos-only + ;; If this record is position-only, we skip it and don’t + ;; add a mod for it. Effectively taking it out of the undo + ;; tree. Read ‘Position-only records’ section in + ;; Commentary for more explanation. + (cl-assert (not (null (car undo-list)))) + (push (make-vundo-m :undo-list undo-list) + new-mlist)) + ;; Skip through the content of this modification. + (while (car undo-list) + ;; Is this entry a timestamp? + (when (and (consp (car undo-list)) (eq (caar undo-list) t)) + (setq mod-timestamp (cdar undo-list))) + (setq undo-list (cdr undo-list)) + (cl-incf uidx)) + ;; If this modification contains a timestamp, the previous + ;; state is saved to file. + (when (and mod-timestamp (not pos-only)) + (setf (vundo-m-timestamp (car new-mlist)) mod-timestamp))))) + ;; Convert to vector. + (vconcat mod-list new-mlist))) + +(defun vundo--update-mapping (mod-list &optional hash-table n) + "Update each modification in MOD-LIST. +Add :idx for each modification, map :undo-list back to each +modification in HASH-TABLE. If N non-nil, start from the Nth +modification in MOD-LIST. Return HASH-TABLE." + (let ((hash-table (or hash-table + (make-hash-table :test #'eq :weakness t)))) + (cl-loop for midx from (or n 0) to (1- (length mod-list)) + for mod = (aref mod-list midx) + do (cl-assert (null (vundo-m-idx mod))) + do (cl-assert (null (gethash (vundo-m-undo-list mod) + hash-table))) + do (setf (vundo-m-idx mod) midx) + do (puthash (vundo-m-undo-list mod) mod hash-table)) + hash-table)) + +;;; Mod list to tree +;; +;; If node a, b, c are in the same equivalent list, they represents +;; identical buffer states. For example, in the figure below, node 3 +;; and 5 are in the same equivalent list: +;; +;; | +;; 3 5 +;; | / +;; |/ +;; 4 +;; +;; We know 3 and 5 are in the same equivalent list because 5 maps to 3 +;; in `undo-equiv-table' (basically). + +(defun vundo--master-eqv-mod-of (mod) + "Return the master mod in the eqv-list of MOD. +Master mod is the mod with the smallest index in the eqv-list. +This function is equivalent to (car (vundo--eqv-list-of mod))." + (while (vundo-m-prev-eqv mod) + (cl-assert (not (eq mod (vundo-m-prev-eqv mod)))) + (setq mod (vundo-m-prev-eqv mod))) + mod) + +(defun vundo--eqv-list-of (mod) + "Return all the modifications equivalent to MOD." + (while (vundo-m-next-eqv mod) + (cl-assert (not (eq mod (vundo-m-next-eqv mod)))) + (setq mod (vundo-m-next-eqv mod))) + ;; Start at the last mod in the equiv chain, walk back to the first. + (let ((eqv-list (list mod))) + (while (vundo-m-prev-eqv mod) + (cl-assert (not (eq mod (vundo-m-prev-eqv mod)))) + (setq mod (vundo-m-prev-eqv mod)) + (push mod eqv-list)) + eqv-list)) + +(defun vundo--eqv-merge (mlist) + "Connect modifications in MLIST to be in the same equivalence list. +Order is preserved." + ;; Basically, for MLIST = (A B C), set + ;; A.prev = nil A.next = B + ;; B.prev = A B.next = C + ;; C.prev = B C.next = nil + (cl-loop for this-tail = mlist then (cdr this-tail) + for next-tail = (cdr mlist) then (cdr next-tail) + for prev-tail = (cons nil mlist) then (cdr prev-tail) + while this-tail + do (setf (vundo-m-prev-eqv (car this-tail)) (car prev-tail)) + do (setf (vundo-m-next-eqv (car this-tail)) (car next-tail)))) + +(defun vundo--sort-mod (mlist &optional reverse) + "Return sorted modifications in MLIST by their idx... +...in ascending order. If REVERSE non-nil, sort in descending +order." + (seq-sort (if reverse + (lambda (m1 m2) + (> (vundo-m-idx m1) (vundo-m-idx m2))) + (lambda (m1 m2) + (< (vundo-m-idx m1) (vundo-m-idx m2)))) + mlist)) + +(defun vundo--eqv-merge-mod (m1 m2) + "Put M1 and M2 into the same equivalence list." + (let ((l1 (vundo--eqv-list-of m1)) + (l2 (vundo--eqv-list-of m2))) + (vundo--eqv-merge (vundo--sort-mod (cl-union l1 l2))))) + +(defun vundo--build-tree (mod-list mod-hash &optional from) + "Connect equivalent modifications and build the tree in MOD-LIST. +MOD-HASH maps undo-lists to modifications. +If FROM non-nil, build from FROM-th modification in MOD-LIST." + (cl-loop + for m from (or from 0) to (1- (length mod-list)) + for mod = (aref mod-list m) + ;; If MOD is an undo, the buffer state it represents is equivalent + ;; to a previous one. + do (let ((prev-undo (undo--last-change-was-undo-p + (vundo-m-undo-list mod)))) + (pcase prev-undo + ;; This is an undo. Merge it with its equivalent nodes. + ((and (pred consp) + ;; It is possible for us to not find the PREV-UNDO in + ;; our mod-list: if Emacs garbage collected prev-m, + ;; then it will not end up in mod-list. NOTE: Is it + ;; also possible that unable to find PREV-M is an + ;; error? Maybe, but I think that's highly unlikely. + (guard (gethash prev-undo mod-hash))) + (let ((prev-m (gethash prev-undo mod-hash))) + (vundo--eqv-merge-mod prev-m mod))) + ;; This undo undoes to root, merge with the root node. + ('t (vundo--eqv-merge-mod (aref mod-list 0) mod)) + ;; This modification either is a region-undo, nil undo, or + ;; not an undo. We treat them the same. + ((or 'undo-in-region 'empty _) + ;; If MOD isn't an undo, it represents a new buffer state, + ;; we connect M-1 with M, where M-1 is the parent and M is + ;; the child. + (unless (eq m 0) + (let* ((m-1 (aref mod-list (1- m))) + (min-eqv-mod (vundo--master-eqv-mod-of m-1))) + (setf (vundo-m-parent mod) min-eqv-mod) + (let ((children (vundo-m-children min-eqv-mod))) + ;; If everything goes right, we should never encounter + ;; this. + (cl-assert (not (memq mod children))) + (setf (vundo-m-children min-eqv-mod) + ;; We sort in reverse order, i.e. later mod + ;; comes first. Later in `vundo--build-tree' we + ;; draw the tree depth-first. + (vundo--sort-mod (cons mod children) + 'reverse)))))))))) + +;;; Timestamps + +;; buffer-undo-list contains "timestamp entries" within a record like +;; (t . TIMESTAMP). These capture the file modification time of the +;; saved file which that undo changed (i.e. the TIMESTAMP applies to +;; the prior state). While reading the undo list, we collect these, +;; sort them, and during tree draw, indicate nodes which had been +;; saved specially. Note that the buffer associated with the current +;; node can be saved, but not yet modified by an undo/redo; this is +;; handled specially. + +(defvar-local vundo--timestamps nil + "An alist mapping mods to modification times. + +When there are multiple mods corresponding to the same node in +the undo tree, use the master equivalent mod as the +key (‘vundo--master-eqv-mod-of’). + +Sorted by time, with latest saved mods first. Only undo-based +modification times are included; see `vundo--node-timestamp'.") + +(defun vundo--record-timestamps (mod-list) + "Return an alist mapping mods in MOD-LIST to timestamps. +The alist is sorted by time, with latest saved mods first." + (let ((timestamps ())) + (cl-loop for idx from 1 below (length mod-list) + for ts = (vundo-m-timestamp (aref mod-list idx)) + if ts do + (let* ((mod-node (aref mod-list (1- idx))) + (master (vundo--master-eqv-mod-of mod-node)) + (entry (assq master timestamps)) + (old-ts (cdr entry))) + (when (and old-ts (time-less-p ts old-ts)) + ;; Equivalent node modified again? take the newer time. + (setq ts old-ts)) + (if entry (setcdr entry ts) + (push (cons master ts) timestamps)))) + (sort timestamps ; Sort latest first. + (lambda (a b) (time-less-p (cdr b) (cdr a)))))) + +(defun vundo--find-last-saved (node &optional arg) + "Return the last saved node prior to NODE. +ARG (default 1) specifies the number of saved nodes to move +backwards in history. ARG<0 indicates moving that many saved +nodes forward in history. Returns nil if no such saved node +exists." + (let* ((arg (or arg 1)) + (past (>= arg 0)) + (cnt (abs arg)) + (master (vundo--master-eqv-mod-of node)) + (midx (vundo-m-idx master)) + last-node) + (if (assq master vundo--timestamps) + (setq last-node master) + ;; No timestamp here, find closest master idx on saved list in + ;; the direction indicated by ARG. + (cl-loop with val = (if past -1 most-positive-fixnum) + with between = (if past #'< #'>) + for (n . _) in vundo--timestamps + for idx = (vundo-m-idx n) + if (funcall between val idx midx) + do (setq val idx last-node n)) + ;; Use up one count when getting started. + (when last-node (setq cnt (1- cnt)))) + + ;; Found one, but more to go. + (if (and last-node (> cnt 0)) + (let ((vt (if past vundo--timestamps + (reverse vundo--timestamps)))) + (while (and vt (not (eq (caar vt) last-node))) + (setq vt (cdr vt))) + (caar (nthcdr cnt vt))) + last-node))) + +(defvar vundo--orig-buffer) +(defun vundo--node-timestamp (mod-list node &optional no-buffer) + "Return a timestamp from MOD-LIST for NODE, if any. +In addition to undo-based timestamps, this includes the modtime +of the current buffer (if it has an associated file which is +unmodified), unless NO-BUFFER is non-nil." + (when-let ((master (vundo--master-eqv-mod-of node))) + (or (alist-get master vundo--timestamps nil nil #'eq) + (and (eq node (vundo--current-node mod-list)) + (with-current-buffer vundo--orig-buffer + (and (not no-buffer) (buffer-file-name) + (not (buffer-modified-p)) + (visited-file-modtime))))))) + +;;; Draw tree + +(defun vundo--put-node-at-point (node) + "Store the corresponding NODE as text property at point." + (put-text-property (1- (point)) (point) + 'vundo-node + node)) + +(defun vundo--get-node-at-point () + "Retrieve the corresponding NODE as text property at point." + (plist-get (text-properties-at (1- (point))) + 'vundo-node)) + +(defun vundo--next-line-at-column (col) + "Move point to next line column COL." + (unless (and (eq 0 (forward-line)) + (not (eobp))) + (goto-char (point-max)) + (insert "\n")) + (move-to-column col) + (unless (eq (current-column) col) + (let ((indent-tabs-mode nil)) + (indent-to-column col)))) + +(defun vundo--translate (text) + "Translate each character in TEXT and return translated TEXT. +Translate according to `vundo-glyph-alist'." + (seq-mapcat (lambda (ch) + (char-to-string + (alist-get + (pcase ch + (?○ 'node) + (?● 'selected-node) + (?─ 'horizontal-stem) + (?│ 'vertical-stem) + (?├ 'branch) + (?└ 'last-branch)) + vundo-glyph-alist))) + text 'string)) + +(defun vundo--draw-tree (mod-list) + "Draw the tree in MOD-LIST in current buffer." + (let* ((root (aref mod-list 0)) + (node-queue (list root)) + (inhibit-read-only t) + (inhibit-modification-hooks t)) + (erase-buffer) + (while node-queue + (let* ((node (pop node-queue)) + (children (vundo-m-children node)) + (parent (vundo-m-parent node)) + (siblings (and parent (vundo-m-children parent))) + (only-child-p (and parent (eq (length siblings) 1))) + (node-last-child-p (and parent (eq node (car (last siblings))))) + (mod-ts (vundo--node-timestamp mod-list node 'no-buffer)) + (node-face (if (and vundo-highlight-saved-nodes mod-ts) + 'vundo-saved 'vundo-node)) + (stem-face (if only-child-p 'vundo-stem 'vundo-branch-stem))) + ;; Go to parent. + (if parent (goto-char (vundo-m-point parent))) + (let ((room-for-another-rx + (rx-to-string + `(or (>= ,(if vundo-compact-display 3 4) ?\s) eol)))) + (if (null parent) + (insert (propertize (vundo--translate "○") + 'face node-face)) + (let ((planned-point (point))) + ;; If a node is blocking, try next line. + ;; Example: 1--2--3 Here we want to add a + ;; | child to 1 but is blocked + ;; +--4 by that plus sign. + (while (not (looking-at room-for-another-rx)) + (vundo--next-line-at-column (max 0 (1- (current-column)))) + ;; When we go down, we could encounter space, EOL, │, + ;; ├, or └. Space and EOL should be replaced by │, ├ + ;; and └ should be replaced by ├. + (let ((replace-char + (if (looking-at + (rx-to-string + `(or ,(vundo--translate "├") + ,(vundo--translate "└")))) + (vundo--translate "├") + (vundo--translate "│")))) + (unless (eolp) (delete-char 1)) + (insert (propertize replace-char 'face stem-face)))) + ;; Make room for inserting the new node. + (unless (looking-at "$") + (delete-char (if vundo-compact-display 2 3))) + ;; Insert the new node. + (if (eq (point) planned-point) + (insert (propertize + (vundo--translate + (if vundo-compact-display "─" "──")) + 'face stem-face) + (propertize (vundo--translate "○") + 'face node-face)) + ;; We must break the line. Delete the previously + ;; inserted char. + (delete-char -1) + (insert (propertize + (vundo--translate + (if node-last-child-p + (if vundo-compact-display "└─" "└──") + (if vundo-compact-display "├─" "├──"))) + 'face stem-face)) + (insert (propertize (vundo--translate "○") + 'face node-face)))))) + ;; Store point so we can later come back to this node. + (setf (vundo-m-point node) (point)) + ;; Associate the text node in buffer with the node object. + (vundo--put-node-at-point node) + ;; Depth-first search. + (setq node-queue (append children node-queue)))))) + +;;; Vundo buffer and invocation + +(defun vundo--buffer () + "Return the vundo buffer." + (get-buffer-create " *vundo tree*")) + +(defun vundo--kill-buffer-if-point-left (window) + "Kill the vundo buffer if point left WINDOW. +WINDOW is the window that was/is displaying the vundo buffer." + (if (and (eq (window-buffer window) (vundo--buffer)) + (not (eq window (selected-window)))) + (with-selected-window window + (kill-buffer-and-window)))) + +(declare-function vundo-diff "vundo-diff") +(declare-function vundo-diff-mark "vundo-diff") +(declare-function vundo-diff-unmark "vundo-diff") +(defvar vundo-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "f") #'vundo-forward) + (define-key map (kbd "") #'vundo-forward) + (define-key map (kbd "b") #'vundo-backward) + (define-key map (kbd "") #'vundo-backward) + (define-key map (kbd "n") #'vundo-next) + (define-key map (kbd "") #'vundo-next) + (define-key map (kbd "p") #'vundo-previous) + (define-key map (kbd "") #'vundo-previous) + (define-key map (kbd "a") #'vundo-stem-root) + (define-key map (kbd "w") #'vundo-next-root) + (define-key map (kbd "e") #'vundo-stem-end) + (define-key map (kbd "l") #'vundo-goto-last-saved) + (define-key map (kbd "r") #'vundo-goto-next-saved) + (define-key map (kbd "q") #'vundo-quit) + (define-key map (kbd "C-g") #'vundo-quit) + (define-key map (kbd "RET") #'vundo-confirm) + (define-key map (kbd "m") #'vundo-diff-mark) + (define-key map (kbd "u") #'vundo-diff-unmark) + (define-key map (kbd "d") #'vundo-diff) + (define-key map (kbd "i") #'vundo--inspect) + (define-key map (kbd "D") #'vundo--debug) + + (define-key map [remap save-buffer] #'vundo-save) + map) + "Keymap for `vundo-mode'.") + +(define-derived-mode vundo-mode special-mode + "Vundo" "Mode for displaying the undo tree." + (setq mode-line-format nil + truncate-lines t + cursor-type nil) + (jit-lock-mode nil) + (face-remap-add-relative 'default 'vundo-default) + + ;; Disable evil-mode, as normal-mode + ;; key bindings override the ones set by vundo. + (when (and (boundp 'evil-emacs-state-modes) + (not (memq 'vundo-mode evil-emacs-state-modes))) + (push 'vundo-mode evil-emacs-state-modes))) + +(defvar-local vundo--first-undo nil + "The ‘undo-list’ field of the first ever ‘vundo-m’ for this buffer. + +This is used to detect truncated undo list by gc.") + +(defvar-local vundo--prev-mod-list nil + "Modification list generated by `vundo--mod-list-from'.") +(defvar-local vundo--prev-mod-hash nil + "Modification hash table generated by `vundo--update-mapping'.") +(defvar-local vundo--prev-undo-list nil + "Original buffer's `buffer-undo-list'.") +(defvar-local vundo--orig-buffer nil + "Vundo buffer displays the undo tree for this buffer.") +(defvar-local vundo--message nil + "If non-nil, print information when moving between nodes.") +(defvar-local vundo--roll-back-to-this nil + "Vundo will roll back to this node.") +(defvar-local vundo--highlight-overlay nil + "Overlay used to highlight the selected node.") +(defvar-local vundo--highlight-last-saved-overlay nil + "Overlay used to highlight the last saved node.") + +(defun vundo--mod-list-trim (mod-list n) + "Remove MODS from MOD-LIST. +Keep the first N modifications." + (cl-loop for midx from (1+ n) to (1- (length mod-list)) + for mod = (aref mod-list midx) + do (let ((parent (vundo-m-parent mod)) + (eqv-list (vundo--eqv-list-of mod))) + (when parent + (setf (vundo-m-children parent) + (remove mod (vundo-m-children parent)))) + (when eqv-list + (vundo--eqv-merge (remove mod eqv-list))))) + (seq-subseq mod-list 0 (1+ n))) + +(defun vundo--refresh-buffer + (orig-buffer vundo-buffer &optional incremental) + "Refresh VUNDO-BUFFER with the undo history of ORIG-BUFFER. +If INCREMENTAL non-nil, reuse existing mod-list and mod-hash. +INCREMENTAL is only applicable when entries are either added or +removed from undo-list. On the other hand, if some entries are +removed and some added, do not use INCREMENTAL. + +This function modifies `vundo--prev-mod-list', +`vundo--prev-mod-hash', `vundo--prev-undo-list', +`vundo--orig-buffer'." + (with-current-buffer vundo-buffer + ;; 1. Setting these to nil makes `vundo--mod-list-from', + ;; `vundo--update-mapping' and `vundo--build-tree' starts from + ;; scratch. + (when (not incremental) + (setq vundo--prev-undo-list nil + vundo--prev-mod-list nil + vundo--prev-mod-hash nil) + ;; Give the garbage collector a chance to release + ;; `buffer-undo-list': GC cannot release cons cells when all + ;; these stuff are referring to it. + (garbage-collect)) + (let ((undo-list (buffer-local-value + 'buffer-undo-list orig-buffer)) + mod-list + mod-hash + (latest-state (and vundo--prev-mod-list + (vundo--latest-buffer-state + vundo--prev-mod-list))) + (inhibit-read-only t)) + ;; 2. Here we consider two cases, adding more nodes (or starting + ;; from scratch) or removing nodes. In both cases, we update and + ;; set MOD-LIST and MOD-HASH. We don't need to worry about the + ;; garbage collector trimming the end of `buffer-undo-list': if + ;; we are generating MOD-LIST from scratch, it will work as + ;; normal, if we are generating incrementally, + ;; `vundo--prev-undo-list' holds the untrimmed undo list. + (if-let ((new-tail (and vundo--prev-mod-hash + (gethash (vundo--sans-nil undo-list) + vundo--prev-mod-hash)))) + ;; a) Removing. + (setq mod-list (vundo--mod-list-trim vundo--prev-mod-list + (vundo-m-idx new-tail)) + mod-hash vundo--prev-mod-hash) + ;; b) Adding. + (let ((diff (- (length undo-list) + (length vundo--prev-undo-list)))) + (cl-assert (eq vundo--prev-undo-list (nthcdr diff undo-list))) + (setq mod-list (vundo--mod-list-from + undo-list diff vundo--prev-mod-list) + mod-hash (vundo--update-mapping + mod-list vundo--prev-mod-hash + (length vundo--prev-mod-list))) + ;; Build tree. + (vundo--build-tree mod-list mod-hash + (length vundo--prev-mod-list)))) + + ;; Update cache. + (setq vundo--prev-mod-list mod-list + vundo--prev-mod-hash mod-hash + vundo--prev-undo-list undo-list + vundo--orig-buffer orig-buffer) + + ;; Record timestamps + (setq vundo--timestamps (vundo--record-timestamps mod-list)) + + ;; 3. Render buffer. We don't need to redraw the tree if there + ;; is no change to the nodes. + (unless (eq (vundo--latest-buffer-state mod-list) latest-state) + (vundo--draw-tree mod-list)) + + ;; Highlight current node. + (vundo--highlight-node (vundo--current-node mod-list)) + (goto-char (vundo-m-point (vundo--current-node mod-list))) + + ;; Highlight the last saved node extra specially + (when vundo-highlight-saved-nodes + (vundo--highlight-last-saved-node mod-list vundo--timestamps)) + + ;; Call out truncated undo tree. + (let ((first-undo (buffer-local-value + 'vundo--first-undo orig-buffer)) + (current-first-undo + ;; We actually use the second vundo-m, because the + ;; ‘undo-list’ of the first vundo-m is always nil. + (vundo-m-undo-list (aref mod-list 1)))) + (when (and first-undo (not (eq first-undo current-first-undo))) + (message "⚠️ The undo-list of this buffer is truncated by garbage collection, to prevent this from happening again, consider increasing ‘undo-limit’")) + (when (or (not first-undo) + (and first-undo (not (eq first-undo + current-first-undo)))) + (with-current-buffer orig-buffer + (setq vundo--first-undo + (vundo-m-undo-list (aref mod-list 1))))))))) + +(defun vundo--current-node (mod-list) + "Return the currently highlighted node in MOD-LIST." + (vundo--master-eqv-mod-of (aref mod-list (1- (length mod-list))))) + +(defun vundo--highlight-node (node) + "Highlight NODE as current node." + (unless vundo--highlight-overlay + (setq vundo--highlight-overlay + (make-overlay (1- (vundo-m-point node)) (vundo-m-point node))) + (overlay-put vundo--highlight-overlay + 'display (vundo--translate "●")) + (overlay-put vundo--highlight-overlay + 'face 'vundo-highlight) + ;; Make current node’s highlight override last saved node’s + ;; highlight, should they collide. + (overlay-put vundo--highlight-overlay 'priority 2)) + (move-overlay vundo--highlight-overlay + (1- (vundo-m-point node)) + (vundo-m-point node))) + +(defun vundo--highlight-last-saved-node (mod-list timestamps) + "Highlight the last (latest) saved node on MOD-LIST. +Consults the alist of TIMESTAMPS. This moves the overlay +`vundo--highlight-last-saved-overlay'." + (let* ((last-saved (car timestamps)) + (cur (vundo--current-node mod-list)) + (cur-ts (vundo--node-timestamp mod-list cur)) + (node (cond ((and last-saved cur-ts) + (if (time-less-p (cdr last-saved) cur-ts) + cur (car last-saved))) + (last-saved (car last-saved)) + (cur-ts cur) + (t nil))) + (node-pt (and node (vundo-m-point node)))) + (when node-pt + (unless vundo--highlight-last-saved-overlay + (setq vundo--highlight-last-saved-overlay + (make-overlay (1- node-pt) node-pt)) + (overlay-put vundo--highlight-last-saved-overlay + 'face 'vundo-last-saved)) + (move-overlay vundo--highlight-last-saved-overlay + (1- node-pt) node-pt)))) + +;;;###autoload +(defun vundo () + "Display visual undo for the current buffer." + (interactive) + (when (not (consp buffer-undo-list)) + (user-error "There is no undo history")) + (when buffer-read-only + (user-error "Buffer is read-only")) + (run-hooks 'vundo-pre-enter-hook) + (let ((vundo-buf (vundo-1 (current-buffer)))) + (select-window + (display-buffer + vundo-buf + `(display-buffer-in-side-window + (side . ,vundo-window-side) + (window-height . 3)))) + (set-window-dedicated-p nil t) + (let ((window-min-height 3)) + (fit-window-to-buffer nil vundo-window-max-height)) + (goto-char + (vundo-m-point + (vundo--current-node vundo--prev-mod-list))) + (setq vundo--roll-back-to-this + (vundo--current-node vundo--prev-mod-list)))) + +(defun vundo-1 (buffer) + "Return a vundo buffer for BUFFER. +BUFFER must have a valid `buffer-undo-list'." + (with-current-buffer buffer + (let ((vundo-buf (vundo--buffer)) + (orig-buf (current-buffer))) + (with-current-buffer vundo-buf + ;; Enable major mode before refreshing the buffer. + ;; Because major modes kill local variables. + (unless (derived-mode-p 'vundo-mode) + (vundo-mode)) + (vundo--refresh-buffer orig-buf vundo-buf) + vundo-buf)))) + +(defmacro vundo--check-for-command (&rest body) + "Sanity check before running interactive commands. +Do sanity check, then evaluate BODY." + (declare (debug (&rest form))) + `(progn + (when (not (derived-mode-p 'vundo-mode)) + (user-error "Not in vundo buffer")) + (when (not (buffer-live-p vundo--orig-buffer)) + (when (y-or-n-p "Original buffer is gone, kill vundo buffer? ") + (kill-buffer-and-window)) + ;; Non-local exit. + (user-error "")) + ;; If ORIG-BUFFER changed since we last synced the vundo buffer + ;; (eg, user left vundo buffer and did some edit in ORIG-BUFFER + ;; then comes back), refresh to catch up. + (let ((undo-list (buffer-local-value + 'buffer-undo-list vundo--orig-buffer))) + ;; 1. Refresh if the beginning is not the same. + (cond ((not (eq (vundo--sans-nil undo-list) + (vundo--sans-nil vundo--prev-undo-list))) + (vundo--refresh-buffer vundo--orig-buffer (current-buffer)) + (message "Refresh")) + ;; 2. It is possible that GC trimmed the end of undo + ;; list, but that doesn't affect us: + ;; `vundo--prev-mod-list' and `vundo--prev-undo-list' are + ;; still perfectly fine. Run the command normally. Of + ;; course, the next time the user invokes `vundo', the + ;; new tree will reflect the trimmed undo list. + (t ,@body))))) + +(defun vundo-quit () + "Quit buffer and window. +Roll back changes if `vundo-roll-back-on-quit' is non-nil." + (interactive) + (vundo--check-for-command + (when (and vundo-roll-back-on-quit vundo--roll-back-to-this + (not (eq vundo--roll-back-to-this + (vundo--current-node vundo--prev-mod-list)))) + (vundo--move-to-node + (vundo--current-node vundo--prev-mod-list) + vundo--roll-back-to-this + vundo--orig-buffer vundo--prev-mod-list)) + (with-current-buffer vundo--orig-buffer + (setq-local buffer-read-only nil)) + (let* ((orig-buffer vundo--orig-buffer) + (orig-window (get-buffer-window orig-buffer))) + (kill-buffer-and-window) + (when (window-live-p orig-window) + (select-window orig-window)) + (with-current-buffer orig-buffer + (run-hooks 'vundo-post-exit-hook))))) + +(defun vundo-confirm () + "Confirm change and close vundo window." + (interactive) + (with-current-buffer vundo--orig-buffer + (setq-local buffer-read-only nil)) + (let* ((orig-buffer vundo--orig-buffer) + (orig-window (get-buffer-window orig-buffer))) + (kill-buffer-and-window) + (when (window-live-p orig-window) + (select-window orig-window)) + (with-current-buffer orig-buffer + (run-hooks 'vundo-post-exit-hook)))) + +;;; Traverse undo tree + +(defun vundo--calculate-shortest-route (from to) + "Calculate the shortest route from FROM to TO node. +Return (SOURCE STOP1 STOP2 ... DEST), meaning you should undo the +modifications from DEST to SOURCE. Each STOP is an intermediate +stop. Eg, (6 5 4 3). Return nil if there’s no valid route." + (let (route-list) + ;; Find all valid routes. + (dolist (source (vundo--eqv-list-of from)) + (dolist (dest (vundo--eqv-list-of to)) + ;; We only allow route in this direction. + (if (> (vundo-m-idx source) (vundo-m-idx dest)) + (push (cons (vundo-m-idx source) + (vundo-m-idx dest)) + route-list)))) + ;; Find the shortest route. + (setq route-list + (seq-sort + (lambda (r1 r2) + ;; Ie, distance between SOURCE and DEST in R1 compare + ;; against distance in R2. + (< (- (car r1) (cdr r1)) (- (car r2) (cdr r2)))) + route-list)) + (if-let* ((route (car route-list)) + (source (car route)) + (dest (cdr route))) + (number-sequence source dest -1)))) + +(defun vundo--list-subtract (l1 l2) + "Return L1 - L2. + +\(vundo--list-subtract \='(4 3 2 1) \='(2 1)) +=> (4 3)" + (let ((len1 (length l1)) + (len2 (length l2))) + (cl-assert (> len1 len2)) + (seq-subseq l1 0 (- len1 len2)))) + +(defun vundo--sans-nil (undo-list) + "Return UNDO-LIST sans leading nils. +If UNDO-LIST is nil, return nil." + (while (and (consp undo-list) (null (car undo-list))) + (setq undo-list (cdr undo-list))) + undo-list) + +(defun vundo--latest-buffer-state (mod-list) + "Return the node representing the latest buffer state. +Basically, return the latest non-undo modification in MOD-LIST." + (let ((max-node (aref mod-list 0))) + (cl-loop for midx from 1 to (1- (length mod-list)) + for mod = (aref mod-list midx) + do (if (and (null (vundo-m-prev-eqv mod)) + (> (vundo-m-idx mod) + (vundo-m-idx max-node))) + (setq max-node mod))) + max-node)) + +(defun vundo--move-to-node (current dest orig-buffer mod-list) + "Move from CURRENT node to DEST node by undoing in ORIG-BUFFER. +ORIG-BUFFER must be at CURRENT state. MOD-LIST is the list you +get from `vundo--mod-list-from'. You should refresh vundo buffer +after calling this function. (You can call this function +repeatedly before refreshing, but moving back-and-forth might not +work, see docstring of ‘vundo--trim-undo-list’.) + +This function modifies the content of ORIG-BUFFER." + (cl-assert (not (eq current dest))) + ;; 1. Find the route we want to take. + (if-let* ((route (vundo--calculate-shortest-route current dest))) + (let* ((source-idx (car route)) + (dest-idx (car (last route))) + ;; The complete undo-list that stops at SOURCE. + (undo-list-at-source + (vundo-m-undo-list (aref mod-list source-idx))) + ;; The complete undo-list that stops at DEST. + (undo-list-at-dest + (vundo-m-undo-list (aref mod-list dest-idx))) + ;; We will undo these modifications. + (planned-undo (vundo--list-subtract + undo-list-at-source undo-list-at-dest)) + ;; We don’t want to quit in the middle of this function. + (inhibit-quit t)) + (with-current-buffer orig-buffer + (setq-local buffer-read-only t) + ;; 2. Undo. This will undo modifications in PLANNED-UNDO and + ;; add new entries to `buffer-undo-list'. + (let ((undo-in-progress t)) + (cl-loop + for step = (- source-idx dest-idx) + then (1- step) + while (and (> step 0) + ;; If there is a quit signal, we break the + ;; loop, continue to step 3 and 4, then quits + ;; when we go out of the let-form. + (not quit-flag)) + for stop = (1- source-idx) then (1- stop) + do + (progn + ;; Stop at each intermediate stop along the route to + ;; create trim points for future undo. + (setq planned-undo (primitive-undo 1 planned-undo)) + (cl-assert (not (and (consp buffer-undo-list) + (null (car buffer-undo-list))))) + (let ((undo-list-at-stop + (vundo-m-undo-list (aref mod-list stop)))) + (puthash buffer-undo-list (or undo-list-at-stop t) + undo-equiv-table)) + (push nil buffer-undo-list)))) + ;; 3. Some misc work. + (when vundo--message + (message "%s -> %s Steps: %s Undo-list len: %s" + (mapcar #'vundo-m-idx (vundo--eqv-list-of + (aref mod-list source-idx))) + (mapcar #'vundo-m-idx (vundo--eqv-list-of + (aref mod-list dest-idx))) + (length planned-undo) + (length buffer-undo-list))) + (when-let ((win (get-buffer-window))) + (set-window-point win (point))))) + (error "No possible route"))) + +(defun vundo--trim-undo-list (buffer current mod-list) + "Trim `buffer-undo-list' in BUFFER according to CURRENT and MOD-LIST. +CURRENT is the current mod, MOD-LIST is the current mod-list. + +This function modifies `buffer-undo-list' of BUFFER. + +IMPORTANT Relationship between `vundo--move-to-node', +`vundo--refresh-buffer', `vundo--trim-undo-list': + +Each vundo command cycle roughly works like this: +1. `vundo--refresh-buffer': `buffer-undo-list' -> mod-list +2. `vundo--move-to-node': read mod-list, modify `buffer-undo-list' +3. `vundo--trim-undo-list': trim `buffer-undo-list' +1. `vundo--refresh-buffer': `buffer-undo-list' -> mod-list +... + +We can call `vundo--move-to-node' multiple times between two +`vundo--refresh-buffer'. But we should only call +`vundo--trim-undo-list' once between two `vundo--refresh-buffer'. +Because if we only trim once, `buffer-undo-list' either shrinks +or expands. But if we trim multiple times after multiple +movements, it could happen that the undo-list first +shrinks (trimmed) then expands. In that situation we cannot use +the INCREMENTAL option in `vundo--refresh-buffer' anymore. + +Also, if you move back-end-forth with ‘vundo--move-to-node’, it +might not work: Suppose undo list is [1 2 3], mod-list is [1 2 +3], now we move back to 2, undo list becomes [1 2 3 2’], but +before we refresh vundo buffer, mod-list will remain [1 2 3], so +there’s no route from 2 to 3 (you can only move back). Once +we refresh the buffer and mod-list is updated to [1 2 3 2’], we +have a route from 3 to 2 (2’->3)." + (let ((latest-buffer-state-idx + ;; Among all the MODs that represents a unique buffer + ;; state, we find the latest one. Because any node + ;; beyond that one is dispensable. + (vundo-m-idx + (vundo--latest-buffer-state mod-list)))) + ;; Find a trim point between latest buffer state and + ;; current node. + (when-let ((possible-trim-point + (cl-loop for node in (vundo--eqv-list-of current) + if (>= (vundo-m-idx node) + latest-buffer-state-idx) + return node + finally return nil))) + (with-current-buffer buffer + (setq buffer-undo-list + (vundo-m-undo-list possible-trim-point))) + (when vundo--message + (message "Trimmed to: %s" + (vundo-m-idx possible-trim-point)))))) + +(defvar vundo-after-undo-functions nil + "Special hook that runs after `vundo' motions. +Functions assigned to this hook are called with one argument: the +original buffer `vundo' operates on.") + +(defun vundo-forward (arg) + "Move forward ARG nodes in the undo tree. +If ARG < 0, move backward." + (interactive "p") + (vundo--check-for-command + (let ((step (abs arg))) + (let* ((source (vundo--current-node vundo--prev-mod-list)) + dest + (this source) + (next (if (> arg 0) + (car (vundo-m-children this)) + (vundo-m-parent this)))) + ;; Move to the dest node step-by-step, stop when no further + ;; node to go to. + (while (and next (> step 0)) + (setq this next + next (if (> arg 0) + (car (vundo-m-children this)) + (vundo-m-parent this))) + (cl-decf step)) + (setq dest this) + (unless (eq source dest) + (vundo--move-to-node + source dest vundo--orig-buffer vundo--prev-mod-list) + (vundo--trim-undo-list + vundo--orig-buffer dest vundo--prev-mod-list) + ;; Refresh display. + (vundo--refresh-buffer + vundo--orig-buffer (current-buffer) 'incremental)))) + (run-hook-with-args 'vundo-after-undo-functions vundo--orig-buffer))) + +(defun vundo-backward (arg) + "Move back ARG nodes in the undo tree. +If ARG < 0, move forward." + (interactive "p") + (vundo-forward (- arg))) + +(defun vundo-next (arg) + "Move to node below the current one. Move ARG steps." + (interactive "p") + (vundo--check-for-command + (let* ((source (vundo--current-node vundo--prev-mod-list)) + (parent (vundo-m-parent source))) + ;; Move to next/previous sibling. + (when parent + (let* ((siblings (vundo-m-children parent)) + (idx (seq-position siblings source)) + ;; If ARG is larger than the number of siblings, + ;; move as far as possible (to the end). + (new-idx (max 0 (min (+ idx arg) + (1- (length siblings))))) + (dest (nth new-idx siblings))) + (when (not (eq source dest)) + (vundo--move-to-node + source dest vundo--orig-buffer vundo--prev-mod-list) + (vundo--trim-undo-list + vundo--orig-buffer dest vundo--prev-mod-list) + (vundo--refresh-buffer + vundo--orig-buffer (current-buffer) + 'incremental))))) + (run-hook-with-args 'vundo-after-undo-functions vundo--orig-buffer))) + +(defun vundo-previous (arg) + "Move to node above the current one. Move ARG steps." + (interactive "p") + (vundo-next (- arg))) + +(defun vundo--stem-root-p (node) + "Return non-nil if NODE is the root of a stem." + ;; Ie, parent has more than one child. + (> (length (vundo-m-children (vundo-m-parent node))) 1)) + +(defun vundo--stem-end-p (node) + "Return non-nil if NODE is the end of a stem." + ;; No children, or more than one child. + (let ((len (length (vundo-m-children node)))) + (or (> len 1) (eq len 0)))) + +(defun vundo-stem-root () + "Move to the beginning of the current stem." + (interactive) + (vundo--check-for-command + (when-let* ((this (vundo--current-node vundo--prev-mod-list)) + (next (vundo-m-parent this))) + ;; If NEXT is nil, i.e. this node doesn’t have a parent, + ;; do nothing. + (vundo--move-to-node + this next vundo--orig-buffer vundo--prev-mod-list) + (setq this next + next (vundo-m-parent this)) + (while (and next (not (vundo--stem-root-p this))) + (vundo--move-to-node + this next vundo--orig-buffer vundo--prev-mod-list) + (setq this next + next (vundo-m-parent this))) + (vundo--trim-undo-list + vundo--orig-buffer this vundo--prev-mod-list) + (vundo--refresh-buffer + vundo--orig-buffer (current-buffer) + 'incremental)))) + +(defun vundo-next-root () + "Move to the beginning of the next stem." + (interactive) + (vundo--check-for-command + (when-let* ((this (vundo--current-node vundo--prev-mod-list)) + ;; If NEXT is nil, i.e. this node doesn’t have a child, + ;; do nothing. + (next (car (vundo-m-children this)))) + (vundo--move-to-node + this next vundo--orig-buffer vundo--prev-mod-list) + (setq this next + next (car (vundo-m-children this))) + (while (and next (not (vundo--stem-root-p this))) + (vundo--move-to-node + this next vundo--orig-buffer vundo--prev-mod-list) + (setq this next + next (car (vundo-m-children this)))) + (vundo--trim-undo-list + vundo--orig-buffer this vundo--prev-mod-list) + (vundo--refresh-buffer + vundo--orig-buffer (current-buffer) + 'incremental)))) + +(defun vundo-stem-end () + "Move to the end of the current stem." + (interactive) + (vundo--check-for-command + (when-let* ((this (vundo--current-node vundo--prev-mod-list)) + (next (car (vundo-m-children this)))) + ;; If NEXT is nil, i.e. this node doesn’t have a child, + ;; do nothing. + (vundo--move-to-node + this next vundo--orig-buffer vundo--prev-mod-list) + (setq this next + next (car (vundo-m-children this))) + (while (and next (not (vundo--stem-end-p this))) + (vundo--move-to-node + this next vundo--orig-buffer vundo--prev-mod-list) + (setq this next + next (car (vundo-m-children this)))) + (vundo--trim-undo-list + vundo--orig-buffer this vundo--prev-mod-list) + (vundo--refresh-buffer + vundo--orig-buffer (current-buffer) + 'incremental)))) + +(defun vundo-goto-last-saved (arg) + "Go back to the first saved node prior to the current node, if any. +With numeric prefix ARG, move that many saved nodes back (ARG<0 +moves forward in history)." + (interactive "p") + (vundo--check-for-command + (if-let* ((cur (vundo--current-node vundo--prev-mod-list)) + (dest (vundo--find-last-saved cur arg))) + (progn + (unless (eq cur dest) + (vundo--move-to-node + cur dest vundo--orig-buffer vundo--prev-mod-list) + (vundo--trim-undo-list + vundo--orig-buffer dest vundo--prev-mod-list) + (vundo--refresh-buffer + vundo--orig-buffer (current-buffer) 'incremental)) + (message "Node saved %s" + (format-time-string + "%F %r" + (vundo--node-timestamp vundo--prev-mod-list dest)))) + (message "No such saved node")))) + +(defun vundo-goto-next-saved (arg) + "Go to the ARGth saved node after the current node (default 1). +For ARG<0, go to the last saved node prior to the current node." + (interactive "p") + (vundo-goto-last-saved (- arg))) + +(defun vundo-save (arg) + "Run `save-buffer' with the current buffer Vundo is operating on. +Accepts the same interactive argument ARG as ‘save-buffer’." + (interactive "p") + (vundo--check-for-command + (with-current-buffer vundo--orig-buffer + (save-buffer arg))) + (when vundo-highlight-saved-nodes + (vundo--highlight-last-saved-node + vundo--prev-mod-list vundo--timestamps))) + +;;; Debug + +(defun vundo--setup-test-buffer () + "Setup and pop a testing buffer." + (interactive) + (let ((buf (get-buffer "*vundo-test*"))) + (if buf (kill-buffer buf)) + (setq buf (get-buffer-create "*vundo-test*")) + (pop-to-buffer buf))) + +(defun vundo--inspect () + "Print some useful info about the node at point." + (interactive) + (let ((node (vundo--get-node-at-point))) + (message "Parent: %s States: %s Children: %s%s" + (and (vundo-m-parent node) + (vundo-m-idx (vundo-m-parent node))) + (mapcar #'vundo-m-idx (vundo--eqv-list-of node)) + (and (vundo-m-children node) + (mapcar #'vundo-m-idx (vundo-m-children node))) + (if-let* ((ts (vundo--node-timestamp vundo--prev-mod-list node)) + ((consp ts))) + (format " Saved: %s" (format-time-string "%F %r" ts)) + "")))) + +(defun vundo--debug () + "Make cursor visible and show debug information on movement." + (interactive) + (setq cursor-type t + vundo--message t)) + +(defvar vundo--monitor nil + "Timer for catching bugs.") +(defun vundo--start-monitor () + "Run `vundo-1' in idle timer to try to catch bugs." + (interactive) + (setq vundo--monitor + (run-with-idle-timer 3 t (lambda () + (unless (eq t buffer-undo-list) + (vundo-1 (current-buffer)) + (message "SUCCESS")))))) + +(provide 'vundo) + +;;; vundo.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/.emacs.d/lisp/yaml-mode.el b/.emacs.d/lisp/yaml-mode.el new file mode 100644 index 0000000..c748b6c --- /dev/null +++ b/.emacs.d/lisp/yaml-mode.el @@ -0,0 +1,491 @@ +;;; yaml-mode.el --- Major mode for editing YAML files -*- lexical-binding: t -*- + +;; Copyright (C) 2010-2014 Yoshiki Kurihara + +;; Author: Yoshiki Kurihara +;; Marshall T. Vandegrift +;; Maintainer: Vasilij Schneidermann +;; URL: https://github.com/yoshiki/yaml-mode +;; Package-Requires: ((emacs "24.1")) +;; Keywords: data yaml +;; Version: 0.0.16 + +;; This file is not part of Emacs + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This is a major mode for editing files in the YAML data +;; serialization format. It was initially developed by Yoshiki +;; Kurihara and many features were added by Marshall Vandegrift. As +;; YAML and Python share the fact that indentation determines +;; structure, this mode provides indentation and indentation command +;; behavior very similar to that of python-mode. + +;;; Installation: + +;; To install, just drop this file into a directory in your +;; `load-path' and (optionally) byte-compile it. To automatically +;; handle files ending in '.yml', add something like: +;; +;; (require 'yaml-mode) +;; (add-to-list 'auto-mode-alist '("\\.yml\\'" . yaml-mode)) +;; +;; to your .emacs file. +;; +;; Unlike python-mode, this mode follows the Emacs convention of not +;; binding the ENTER key to `newline-and-indent'. To get this +;; behavior, add the key definition to `yaml-mode-hook': +;; +;; (add-hook 'yaml-mode-hook +;; '(lambda () +;; (define-key yaml-mode-map "\C-m" 'newline-and-indent))) + +;;; Known Bugs: + +;; YAML is easy to write but complex to parse, and this mode doesn't +;; even really try. Indentation and highlighting will break on +;; abnormally complicated structures. + +;;; Code: + + +;; User definable variables + +;;;###autoload +(defgroup yaml nil + "Support for the YAML serialization format" + :group 'languages + :prefix "yaml-") + +(defcustom yaml-mode-hook nil + "*Hook run by `yaml-mode'." + :type 'hook + :group 'yaml) + +(defcustom yaml-indent-offset 2 + "*Amount of offset per level of indentation." + :type 'integer + :safe 'natnump + :group 'yaml) + +(defcustom yaml-backspace-function 'backward-delete-char-untabify + "*Function called by `yaml-electric-backspace' when deleting backwards. +It will receive one argument, the numeric prefix value." + :type 'function + :group 'yaml) + +(defcustom yaml-block-literal-search-lines 100 + "*Maximum number of lines to search for start of block literals." + :type 'integer + :group 'yaml) + +(defcustom yaml-block-literal-electric-alist + '((?| . "") (?> . "-")) + "*Characters for which to provide electric behavior. +The association list key should be a key code and the associated value +should be a string containing additional characters to insert when +that key is pressed to begin a block literal." + :type 'alist + :group 'yaml) + +(defface yaml-tab-face + '((((class color)) (:background "red" :foreground "red" :bold t)) + (t (:inverse-video t))) + "Face to use for highlighting tabs in YAML files." + :group 'faces + :group 'yaml) + +(defcustom yaml-imenu-generic-expression + '((nil "^\\(:?[a-zA-Z_-]+\\):" 1)) + "The imenu regex to parse an outline of the yaml file." + :type 'string + :group 'yaml) + + +;; Constants + +(defconst yaml-mode-version "0.0.15" "Version of `yaml-mode'.") + +(defconst yaml-blank-line-re "^ *$" + "Regexp matching a line containing only (valid) whitespace.") + +(defconst yaml-directive-re "^\\(?:--- \\)? *%\\(\\w+\\)" + "Regexp matching a line containing a YAML directive.") + +(defconst yaml-document-delimiter-re "^\\(?:---\\|[.][.][.]\\)" + "Rexexp matching a YAML document delimiter line.") + +(defconst yaml-node-anchor-alias-re "[&*][a-zA-Z0-9_-]+" + "Regexp matching a YAML node anchor or alias.") + +(defconst yaml-tag-re "!!?[^ \n]+" + "Rexexp matching a YAML tag.") + +(defconst yaml-bare-scalar-re + "\\(?:[^-:,#!\n{\\[ ]\\|[^#!\n{\\[ ]\\S-\\)[^#\n]*?" + "Rexexp matching a YAML bare scalar.") + +(defconst yaml-hash-key-re + (concat "\\(?:^\\(?:--- \\)?\\|{\\|\\(?:[-,] +\\)+\\) *" + "\\(?:" yaml-tag-re " +\\)?" + "\\(" yaml-bare-scalar-re "\\) *:" + "\\(?: +\\|$\\)") + "Regexp matching a single YAML hash key.") + +(defconst yaml-scalar-context-re + (concat "\\(?:^\\(?:--- \\)?\\|{\\|\\(?: *[-,] +\\)+\\) *" + "\\(?:" yaml-bare-scalar-re " *: \\)?") + "Regexp indicating the beginning of a scalar context.") + +(defconst yaml-nested-map-re + (concat "[^#\n]*: *\\(?:&.*\\|{ *\\|" yaml-tag-re " *\\)?$") + "Regexp matching a line beginning a YAML nested structure.") + +(defconst yaml-block-literal-base-re " *[>|][-+0-9]* *\\(?:\n\\|\\'\\)" + "Regexp matching the substring start of a block literal.") + +(defconst yaml-block-literal-re + (concat yaml-scalar-context-re + "\\(?:" yaml-tag-re "\\)?" + yaml-block-literal-base-re) + "Regexp matching a line beginning a YAML block literal.") + +(defconst yaml-nested-sequence-re + (concat "^\\(?:\\(?: *- +\\)+\\|\\(:? *-$\\)\\)" + "\\(?:" yaml-bare-scalar-re " *:\\(?: +.*\\)?\\)?$") + "Regexp matching a line containing one or more nested YAML sequences.") + +(defconst yaml-constant-scalars-re + (concat "\\(?:^\\|\\(?::\\|-\\|,\\|{\\|\\[\\) +\\) *" + (regexp-opt + '("~" "null" "Null" "NULL" + ".nan" ".NaN" ".NAN" + ".inf" ".Inf" ".INF" + "-.inf" "-.Inf" "-.INF" + "y" "Y" "yes" "Yes" "YES" "n" "N" "no" "No" "NO" + "true" "True" "TRUE" "false" "False" "FALSE" + "on" "On" "ON" "off" "Off" "OFF") t) + "\\_>") + "Regexp matching certain scalar constants in scalar context.") + + +;; Mode setup + +(defvar yaml-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "|" 'yaml-electric-bar-and-angle) + (define-key map ">" 'yaml-electric-bar-and-angle) + (define-key map "-" 'yaml-electric-dash-and-dot) + (define-key map "." 'yaml-electric-dash-and-dot) + (define-key map (kbd "DEL") 'yaml-electric-backspace) + map) + "Keymap used in `yaml-mode' buffers.") + +(defvar yaml-mode-syntax-table + (let ((syntax-table (make-syntax-table))) + (modify-syntax-entry ?\' "\"" syntax-table) + (modify-syntax-entry ?\" "\"" syntax-table) + (modify-syntax-entry ?# "<" syntax-table) + (modify-syntax-entry ?\n ">" syntax-table) + (modify-syntax-entry ?\\ "\\" syntax-table) + (modify-syntax-entry ?- "_" syntax-table) + (modify-syntax-entry ?_ "_" syntax-table) + (modify-syntax-entry ?& "." syntax-table) + (modify-syntax-entry ?* "." syntax-table) + (modify-syntax-entry ?\( "." syntax-table) + (modify-syntax-entry ?\) "." syntax-table) + (modify-syntax-entry ?\{ "(}" syntax-table) + (modify-syntax-entry ?\} "){" syntax-table) + (modify-syntax-entry ?\[ "(]" syntax-table) + (modify-syntax-entry ?\] ")[" syntax-table) + syntax-table) + "Syntax table in use in `yaml-mode' buffers.") + +;;;###autoload +(define-derived-mode yaml-mode text-mode "YAML" + "Simple mode to edit YAML. + +\\{yaml-mode-map}" + :syntax-table yaml-mode-syntax-table + (set (make-local-variable 'comment-start) "# ") + (set (make-local-variable 'comment-start-skip) "#+ *") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'indent-line-function) 'yaml-indent-line) + (set (make-local-variable 'indent-tabs-mode) nil) + (set (make-local-variable 'fill-paragraph-function) 'yaml-fill-paragraph) + (set (make-local-variable 'page-delimiter) "^---\\([ \t].*\\)*\n") + + (set (make-local-variable 'syntax-propertize-function) + 'yaml-mode-syntax-propertize-function) + (setq font-lock-defaults '(yaml-font-lock-keywords))) + + +;; Font-lock support + +(defvar yaml-font-lock-keywords + `((yaml-font-lock-block-literals 0 font-lock-string-face) + (,yaml-constant-scalars-re . (1 font-lock-constant-face)) + (,yaml-tag-re . (0 font-lock-type-face)) + (,yaml-node-anchor-alias-re . (0 font-lock-function-name-face)) + (,yaml-hash-key-re . (1 font-lock-variable-name-face)) + (,yaml-document-delimiter-re . (0 font-lock-comment-face)) + (,yaml-directive-re . (1 font-lock-builtin-face)) + ("^[\t]+" 0 'yaml-tab-face t)) + "Additional expressions to highlight in YAML mode.") + +(defun yaml-mode-syntax-propertize-function (beg end) + "Override buffer's syntax table for special syntactic constructs." + ;; Unhighlight foo#bar tokens between BEG and END. + (save-excursion + (goto-char beg) + (while (search-forward "#" end t) + (save-excursion + (forward-char -1) + ;; both ^# and [ \t]# are comments + (when (and (not (bolp)) + (not (memq (preceding-char) '(?\s ?\t)))) + (put-text-property (point) (1+ (point)) + 'syntax-table (string-to-syntax "_")))))) + + (save-excursion + (goto-char beg) + (while (and + (> end (point)) + (re-search-forward "['\"]" end t)) + (when (get-text-property (point) 'yaml-block-literal) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "w"))) + (let* ((pt (point)) + (sps (save-excursion (syntax-ppss (1- pt))))) + (when (not (nth 8 sps)) + (cond + ((and (char-equal ?' (char-before (1- pt))) + (char-equal ?' (char-before pt))) + (put-text-property (- pt 2) pt + 'syntax-table (string-to-syntax "w")) + ;; Workaround for https://debbugs.gnu.org/41195. + (let ((syntax-propertize--done syntax-propertize--done)) + ;; Carefully invalidate the last cached ppss. + (syntax-ppss-flush-cache (- pt 2)))) + ;; If quote is detected as a syntactic string start but appeared + ;; after a non-whitespace character, then mark it as syntactic word. + ((and (char-before (1- pt)) + (char-equal ?w (char-syntax (char-before (1- pt))))) + (put-text-property (1- pt) pt + 'syntax-table (string-to-syntax "w"))) + (t + ;; We're right after a quote that opens a string literal. + ;; Skip over it (big speedup for long JSON strings). + (goto-char (1- pt)) + (condition-case nil + (forward-sexp) + (scan-error + (goto-char end)))))))))) + +(defun yaml-font-lock-block-literals (bound) + "Find lines within block literals. +Find the next line of the first (if any) block literal after point and +prior to BOUND. Returns the beginning and end of the block literal +line in the match data, as consumed by `font-lock-keywords' matcher +functions. The function begins by searching backwards to determine +whether or not the current line is within a block literal. This could +be time-consuming in large buffers, so the number of lines searched is +artificially limited to the value of +`yaml-block-literal-search-lines'." + (if (eolp) (goto-char (1+ (point)))) + (unless (or (eobp) (>= (point) bound)) + (let ((begin (point)) + (end (min (1+ (line-end-position)) bound))) + (goto-char (line-beginning-position)) + (while (and (looking-at yaml-blank-line-re) + (not (bobp))) + (forward-line -1)) + (let ((nlines yaml-block-literal-search-lines) + (min-level (current-indentation))) + (forward-line -1) + (while (and (/= nlines 0) + (/= min-level 0) + (not (looking-at yaml-block-literal-re)) + (not (bobp))) + (setq nlines (1- nlines)) + (unless (looking-at yaml-blank-line-re) + (setq min-level (min min-level (current-indentation)))) + (forward-line -1)) + (when (looking-at-p " *- ") + (setq min-level (- min-level 2))) + (cond + ((and (< (current-indentation) min-level) + (looking-at yaml-block-literal-re)) + (goto-char end) + (put-text-property begin end 'yaml-block-literal t) + (set-match-data (list begin end)) + t) + ((progn + (goto-char begin) + (re-search-forward (concat yaml-block-literal-re + " *\\(.*\\)\n") + bound t)) + (let ((range (nthcdr 2 (match-data)))) + (put-text-property (car range) (cadr range) 'yaml-block-literal t) + (set-match-data range)) + t)))))) + + +;; Indentation and electric keys + +(defun yaml-compute-indentation () + "Calculate the maximum sensible indentation for the current line." + (save-excursion + (beginning-of-line) + (if (looking-at yaml-document-delimiter-re) 0 + (forward-line -1) + (while (and (looking-at yaml-blank-line-re) + (> (point) (point-min))) + (forward-line -1)) + (+ (current-indentation) + (if (looking-at yaml-nested-map-re) yaml-indent-offset 0) + (if (looking-at yaml-nested-sequence-re) yaml-indent-offset 0) + (if (looking-at yaml-block-literal-re) yaml-indent-offset 0))))) + +(defun yaml-indent-line () + "Indent the current line. +The first time this command is used, the line will be indented to the +maximum sensible indentation. Each immediately subsequent usage will +back-dent the line by `yaml-indent-offset' spaces. On reaching column +0, it will cycle back to the maximum sensible indentation." + (interactive "*") + (let ((ci (current-indentation)) + (need (yaml-compute-indentation))) + (save-excursion + (if (and (equal last-command this-command) (/= ci 0)) + (indent-line-to (* (/ (- ci 1) yaml-indent-offset) yaml-indent-offset)) + (indent-line-to need))) + (if (< (current-column) (current-indentation)) + (forward-to-indentation 0)))) + +(defun yaml-electric-backspace (arg) + "Delete characters or back-dent the current line. +If invoked following only whitespace on a line, will back-dent to the +immediately previous multiple of `yaml-indent-offset' spaces." + (interactive "*p") + (if (or (/= (current-indentation) (current-column)) (bolp)) + (funcall yaml-backspace-function arg) + (let ((ci (current-column))) + (beginning-of-line) + (delete-horizontal-space) + (indent-to (* (/ (- ci (* arg yaml-indent-offset)) + yaml-indent-offset) + yaml-indent-offset))))) + +(defun yaml-electric-bar-and-angle (arg) + "Insert the bound key and possibly begin a block literal. +Inserts the bound key. If inserting the bound key causes the current +line to match the initial line of a block literal, then inserts the +matching string from `yaml-block-literal-electric-alist', a newline, +and indents appropriately." + (interactive "*P") + (self-insert-command (prefix-numeric-value arg)) + (let ((extra-chars + (assoc last-command-event + yaml-block-literal-electric-alist))) + (cond + ((and extra-chars (not arg) (eolp) + (save-excursion + (beginning-of-line) + (looking-at yaml-block-literal-re))) + (insert (cdr extra-chars)) + (newline-and-indent))))) + +(defun yaml-electric-dash-and-dot (arg) + "Insert the bound key and possibly de-dent line. +Inserts the bound key. If inserting the bound key causes the current +line to match a document delimiter, de-dent the line to the left +margin." + (interactive "*P") + (self-insert-command (prefix-numeric-value arg)) + (save-excursion + (beginning-of-line) + (when (and (not arg) (looking-at yaml-document-delimiter-re)) + (delete-horizontal-space)))) + +(defun yaml-narrow-to-block-literal () + "Narrow the buffer to block literal if the point is in it, +otherwise do nothing." + (interactive) + (save-excursion + (goto-char (line-beginning-position)) + (while (and (looking-at-p yaml-blank-line-re) (not (bobp))) + (forward-line -1)) + (let ((nlines yaml-block-literal-search-lines) + (min-level (current-indentation)) + beg) + (forward-line -1) + (while (and (/= nlines 0) + (/= min-level 0) + (not (looking-at-p yaml-block-literal-re)) + (not (bobp))) + (setq nlines (1- nlines)) + (unless (looking-at-p yaml-blank-line-re) + (setq min-level (min min-level (current-indentation)))) + (forward-line -1)) + (when (and (< (current-indentation) min-level) + (looking-at-p yaml-block-literal-re)) + (setq min-level (current-indentation)) + (forward-line) + (setq beg (point)) + (while (and (not (eobp)) + (or (looking-at-p yaml-blank-line-re) + (> (current-indentation) min-level))) + (forward-line)) + (narrow-to-region beg (point)))))) + +(defun yaml-fill-paragraph (&optional justify region) + "Fill paragraph. +Outside of comments, this behaves as `fill-paragraph' except that +filling does not cross boundaries of block literals. Inside comments, +this will do usual adaptive fill behaviors." + (interactive "*P") + (save-restriction + (yaml-narrow-to-block-literal) + (let ((fill-paragraph-function nil)) + (or (fill-comment-paragraph justify) + (fill-paragraph justify region))))) + +(defun yaml-set-imenu-generic-expression () + (make-local-variable 'imenu-generic-expression) + (make-local-variable 'imenu-create-index-function) + (setq imenu-create-index-function 'imenu-default-create-index-function) + (setq imenu-generic-expression yaml-imenu-generic-expression)) + +(add-hook 'yaml-mode-hook 'yaml-set-imenu-generic-expression) + + +(defun yaml-mode-version () + "Display version of `yaml-mode'." + (interactive) + (message "yaml-mode %s" yaml-mode-version) + yaml-mode-version) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.\\(e?ya?\\|ra\\)ml\\'" . yaml-mode)) + +;;;###autoload +(add-to-list 'magic-mode-alist + '("^%YAML\\s-+[0-9]+\\.[0-9]+\\(\\s-+#\\|\\s-*$\\)" . yaml-mode)) + +(provide 'yaml-mode) + +;;; yaml-mode.el ends here diff --git a/.emacs.d/logo.jpg b/.emacs.d/logo.jpg deleted file mode 100644 index 35bfa97..0000000 Binary files a/.emacs.d/logo.jpg and /dev/null differ diff --git a/.emacs.d/themes/bedroom-theme.el b/.emacs.d/themes/bedroom-theme.el index 20f3656..3389dc2 100644 --- a/.emacs.d/themes/bedroom-theme.el +++ b/.emacs.d/themes/bedroom-theme.el @@ -12,12 +12,17 @@ 'bedroom ;; Basic faces '(default ((t (:foreground "#DADEE5" :background "#141B2B")))) - '(cursor ((t (:background "#FF69B4")))) + '(cursor ((t (:background "lightgreen")))) '(region ((t (:background "#15285A")))) '(hl-line ((t (:background "#000000")))) '(highlight ((t (:background "#15285A")))) - '(mode-line ((t (:background "#d3b58d" :foreground "#141B2B")))) - '(mode-line-inactive ((t (:inverse-video t)))) + '(mode-line ((t (:background "#505050" :foreground "#DADEE5")))) + '(mode-line-inactive ((t (:background "#2A2A2A" :foreground "#888888")))) + '(vertical-border ((t (:foreground "#505050")))) + '(tab-line ((t (:background "#505050" :foreground "#DADEE5")))) + '(tab-line-tab ((t (:background "#505050" :foreground "#DADEE5")))) + '(tab-line-tab-current ((t (:background "#505050" :foreground "#DADEE5")))) + '(tab-line-tab-inactive ((t (:background "#383838" :foreground "#888888")))) ;; Font lock faces '(font-lock-builtin-face ((t (:foreground "#DADEE5")))) diff --git a/.emacs.d/themes/jbeans-theme.el b/.emacs.d/themes/jbeans-theme.el new file mode 100644 index 0000000..56a7b89 --- /dev/null +++ b/.emacs.d/themes/jbeans-theme.el @@ -0,0 +1,442 @@ +;;; jbeans-theme.el --- Jbeans theme for GNU Emacs 24 (deftheme) + +;; Author: Adam Olsen +;; URL: +;; Version: 1.3 +;; Package-Requires: ((emacs "24")) +;; Based On: ujelly by Mark Tran +;; Package-Version: 20151208.2136 +;; "What do you mean, no one calls you JBeans?! I call you JBeans!" +;; -- Wilbur + +;; Based on ujelly by Mark Tran +;; Orig-URL: http://github.com/marktran/color-theme-ujelly +;; Inspired by jellybeans: http://www.vim.org/scripts/script.php?script_id=2555. + + +;; Copyright (c) 2017 Adam Olsen +;; +;; Permission is hereby granted, free of charge, to any person obtaining a copy +;; of this software and associated documentation files (the "Software"), to deal +;; in the Software without restriction, including without limitation the rights +;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +;; copies of the Software, and to permit persons to whom the Software is +;; furnished to do so, subject to the following conditions: +;; +;; The above copyright notice and this permission notice shall be included in all +;; copies or substantial portions of the Software. +;; +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +;; SOFTWARE. + +(deftheme jbeans "The jbeans color theme") + +(let ((class '((class color) (min-colors 89))) + ;; GUI TER + (jbeans-fg (if (display-graphic-p) "#cccccc" "#cccccc")) + (jbeans-bg (if (display-graphic-p) "#151515" "#151515")) + (jbeans-grey-0 (if (display-graphic-p) "#151515" "#151515")) + (jbeans-grey-1 (if (display-graphic-p) "#112433" "#112433")) + (jbeans-grey-2 (if (display-graphic-p) "#222222" "#222222")) + (jbeans-grey-3 (if (display-graphic-p) "#333344" "#444455")) + (jbeans-grey-4 (if (display-graphic-p) "#363636" "#363636")) + (jbeans-grey-5 (if (display-graphic-p) "#444444" "#444444")) + (jbeans-grey-6 (if (display-graphic-p) "#7f7f7f" "#7f7f7f")) + (jbeans-grey-7 (if (display-graphic-p) "#888888" "#888888")) + (jbeans-purple-0 (if (display-graphic-p) "#ff73fd" "#ff73fd")) + (jbeans-purple-1 (if (display-graphic-p) "#cd00cd" "#cd00cd")) + (jbeans-purple-2 (if (display-graphic-p) "#a40073" "#a40073")) + (jbeans-purple-3 (if (display-graphic-p) "#540063" "#540063")) + (jbeans-purple-4 (if (display-graphic-p) "#474e90" "#474e90")) + (jbeans-purple-5 (if (display-graphic-p) "#202025" "#202025")) + (jbeans-blue-0 (if (display-graphic-p) "#8197bf" "#8197bf")) + (jbeans-blue-1 (if (display-graphic-p) "#8fbfdc" "#8fbfdc")) + (jbeans-blue-2 (if (display-graphic-p) "#b2e2fe" "#b2e2fe")) + (jbeans-blue-3 (if (display-graphic-p) "#447799" "#447799")) + (jbeans-blue-4 (if (display-graphic-p) "#0b24fb" "#0b24fb")) + (jbeans-blue-5 (if (display-graphic-p) "#2dfffe" "#2dfffe")) + (jbeans-green-0 (if (display-graphic-p) "#ddffdd" "#ddffdd")) + (jbeans-green-1 (if (display-graphic-p) "#b6edb6" "#b6edb6")) + (jbeans-green-2 (if (display-graphic-p) "#448844" "#448844")) + (jbeans-green-3 (if (display-graphic-p) "#556a32" "#556a32")) + (jbeans-green-4 (if (display-graphic-p) "#335533" "#335533")) + (jbeans-green-5 (if (display-graphic-p) "#99ad6a" "#99ad6a")) + (jbeans-green-6 (if (display-graphic-p) "#a8ff60" "#a8ff60")) + (jbeans-green-7 (if (display-graphic-p) "#29fd2f" "#29fd2f")) + (jbeans-yellow-0 (if (display-graphic-p) "#ffffcc" "#ffffcc")) + (jbeans-yellow-1 (if (display-graphic-p) "#ffff00" "#ffff00")) + (jbeans-yellow-2 (if (display-graphic-p) "#eddb87" "#eddb87")) + (jbeans-yellow-3 (if (display-graphic-p) "#fad07a" "#fad07a")) + (jbeans-orange-0 (if (display-graphic-p) "#ffb964" "#ffb964")) + (jbeans-orange-1 (if (display-graphic-p) "#ff8c00" "#ebbd87")) + (jbeans-orange-2 (if (display-graphic-p) "#b78521" "#b78521")) + (jbeans-red-0 (if (display-graphic-p) "#cb8165" "#cb8165")) + (jbeans-red-1 (if (display-graphic-p) "#cf6a4c" "#cf6a4c")) + (jbeans-red-2 (if (display-graphic-p) "#de5577" "#de5577")) + (jbeans-red-3 (if (display-graphic-p) "#fc644d" "#fc644d")) + (jbeans-red-4 (if (display-graphic-p) "#dd0093" "#dd0093")) + (jbeans-red-5 (if (display-graphic-p) "#aa4444" "#aa4444")) + (jbeans-red-6 (if (display-graphic-p) "#8a3b3c" "#8a3b3c")) + (jbeans-red-7 (if (display-graphic-p) "#663333" "#663333")) + (jbeans-red-8 (if (display-graphic-p) "#fc0d1b" "#fc0d1b")) + (jbeans-red-9 (if (display-graphic-p) "#ffdddd" "#ffdddd")) + ) + + (custom-theme-set-variables + 'jbeans + `(linum-format " %3i ")) + + (custom-theme-set-faces + 'jbeans + `(default ((,class (:foreground ,jbeans-fg :background ,jbeans-bg)))) +;;;;; ACE/Avy + `(aw-leading-char-face ((,class (:foreground ,jbeans-red-3 :height 1.2)))) +;;;;; Alchemist + `(alchemist-test--failed-face ((,class (:foreground ,jbeans-red-1)))) + `(alchemist-test--success-face ((,class (:foreground ,jbeans-green-5)))) +;;;;; Company + `(company-preview-common ((,class (:foreground nil :background ,jbeans-purple-4)))) + `(company-scrollbar-bg ((,class (:background ,jbeans-grey-0)))) + `(company-scrollbar-fg ((,class (:background ,jbeans-grey-7)))) + `(company-tooltip ((,class (:background ,jbeans-grey-0 :foreground ,jbeans-fg :weight bold)))) + `(company-tooltip-annotation ((,class (:inherit company-tooltip :foreground ,jbeans-blue-0)))) + `(company-tooltip-common ((,class (:inherit company-tooltip :weight bold :underline nil)))) + `(company-tooltip-common-selection ((,class (:inherit company-tooltip-selection :foreground ,jbeans-fg :underline nil :weight bold)))) + `(company-tooltip-selection ((,class (:background ,jbeans-purple-4)))) +;;;;; Compilation + `(compilation-error ((,class (:foreground ,jbeans-red-1)))) + `(compilation-info ((,class (:foreground ,jbeans-yellow-3)))) + `(compilation-line-number ((,class (:foreground ,jbeans-grey-7)))) + `(compilation-mode-line-exit ((,class (:foreground ,jbeans-green-5)))) + `(compilation-mode-line-fail ((,class (:foreground ,jbeans-red-1)))) + `(compilation-mode-line-run ((,class (:foreground ,jbeans-yellow-3)))) +;;;;; Dired + `(diredp-compressed-file-name ((,class (:foreground ,jbeans-red-7)))) + `(diredp-compressed-file-suffix ((,class (:foreground ,jbeans-fg)))) + `(diredp-date-time ((,class (:foreground ,jbeans-green-5)))) + `(diredp-deletion ((,class (:foreground ,jbeans-red-1 :background ,jbeans-bg)))) + `(diredp-dir-heading ((,class (:foreground ,jbeans-yellow-3 :background ,jbeans-bg)))) + `(diredp-dir-priv ((,class (:foreground ,jbeans-purple-2 :background ,jbeans-bg)))) + `(diredp-exec-priv ((,class (:foreground ,jbeans-orange-2 :background ,jbeans-bg)))) + `(diredp-file-name ((,class (:foreground ,jbeans-green-0)))) + `(diredp-file-suffix ((,class (:foreground ,jbeans-fg)))) + `(diredp-flag-mark ((,class (:foreground ,jbeans-blue-0 :weight bold)))) + `(diredp-flag-mark-line ((,class (:foreground ,jbeans-purple-4 :weight bold)))) + `(diredp-link-priv ((,class (:foreground ,jbeans-fg)))) + `(diredp-number ((,class (:foreground ,jbeans-grey-6)))) + `(diredp-no-priv ((,class (:foreground ,jbeans-fg :background ,jbeans-bg)))) + `(diredp-rare-priv ((,class (:foreground ,jbeans-red-1 :background ,jbeans-bg)))) + `(diredp-read-priv ((,class (:foreground ,jbeans-yellow-3 :background ,jbeans-bg)))) + `(diredp-symlink ((,class (:foreground ,jbeans-blue-0)))) + `(diredp-dir-name ((,class (:foreground ,jbeans-blue-2)))) + `(diredp-write-priv ((,class (:foreground ,jbeans-blue-0 :background ,jbeans-bg)))) +;;;;; Emmet + `(emmet-preview-output ((,class (:background ,jbeans-purple-4)))) +;;;;; Elixir + `(elixir-atom-face ((,class (:foreground ,jbeans-blue-1)))) +;;;;; ERC + `(erc-notice-face ((,class (:foreground ,jbeans-yellow-3)))) + `(erc-prompt-face ((,class (:foreground ,jbeans-fg)))) + `(erc-timestamp-face ((,class (:foreground ,jbeans-blue-0)))) +;;;;;; EShell + `(eshell-prompt ((,class (:foreground ,jbeans-red-1)))) + `(eshell-ls-directory ((,class (:weight normal :foreground ,jbeans-green-6)))) + `(eshell-ls-executable ((,class (:weight normal :foreground ,jbeans-red-1)))) + `(eshell-ls-product ((,class (:foreground ,jbeans-fg)))) + `(eshell-ls-symlink ((,class (:weight normal :foreground ,jbeans-purple-1)))) +;;;;; Evil + `(evil-visual-mark-face ((,class (:weight ultra-bold :box ,jbeans-blue-0 :foreground ,jbeans-green-7)))) +;;;;; FCI Ruler + ;; As of now, this does nothing, because fci-rule-color is not a face yet. + `(fci-rule-color ((,class (:foreground ,jbeans-grey-4 :background ,jbeans-grey-4)))) + `(fill-column-indicator ((,class (:foreground ,jbeans-grey-3 :background ,jbeans-bg)))) +;;;;; Fonts + `(font-lock-builtin-face ((,class (:foreground ,jbeans-blue-1)))) + `(font-lock-comment-face ((,class (:slant italic :foreground ,jbeans-grey-7)))) + `(font-lock-constant-face ((,class (:foreground ,jbeans-blue-3)))) + `(font-lock-doc-face ((,class (:foreground ,jbeans-green-5)))) + `(font-lock-function-name-face ((,class (:foreground ,jbeans-yellow-3)))) + `(font-lock-keyword-face ((,class (:foreground ,jbeans-blue-0)))) + `(font-lock-preprocessor-face ((,class (:foreground ,jbeans-fg)))) + `(font-lock-string-face ((,class (:foreground ,jbeans-green-5)))) + `(font-lock-type-face ((,class (:foreground ,jbeans-orange-0)))) + `(font-lock-variable-name-face ((,class (:foreground ,jbeans-red-1)))) + `(font-lock-warning-face ((,class (:foreground ,jbeans-red-4)))) + `(font-lock-regexp-grouping-construct ((,class (:foreground ,jbeans-yellow-3 :bold t)))) + `(font-lock-regexp-grouping-backslash ((,class (:foreground ,jbeans-red-1 :bold t)))) +;;;;; Fringe + `(fringe ((,class (:foreground ,jbeans-fg :background ,jbeans-bg)))) +;;;;; Header + `(header-line ((,class (:foreground ,jbeans-fg)))) +;;;;; Helm + `(helm-visible-mark ((,class (:background ,jbeans-green-4 :foreground ,jbeans-bg)))) + `(helm-buffer-file ((,class (:foreground ,jbeans-fg)))) + `(helm-buffer-directory ((,class (:foreground ,jbeans-blue-0)))) + `(helm-buffer-process ((,class (:foreground ,jbeans-yellow-3)))) + `(helm-buffer-size ((,class (:foreground ,jbeans-fg)))) + `(helm-candidate-number ((,class (:foreground ,jbeans-fg :background ,jbeans-bg)))) + `(helm-grep-lineno ((,class (:foreground ,jbeans-fg)))) + `(helm-grep-finish ((,class (:foreground ,jbeans-blue-2)))) + `(helm-match ((,class (:foreground ,jbeans-red-4 :background ,jbeans-bg)))) + `(helm-moccur-buffer ((,class (:foreground ,jbeans-yellow-3)))) + `(helm-selection ((,class (:background ,jbeans-grey-3)))) + `(helm-source-header ((,class (:foreground ,jbeans-yellow-3 :background ,jbeans-grey-0)))) + `(helm-swoop-target-line-face ((,class (:foreground ,jbeans-fg :background ,jbeans-grey-4)))) + `(helm-swoop-target-word-face ((,class (:foreground ,jbeans-red-4)))) + `(helm-ff-file ((,class (:foreground ,jbeans-fg)))) + `(helm-ff-directory ((,class (:foreground ,jbeans-blue-2)))) + `(helm-ff-executable ((,class (:foreground ,jbeans-green-5)))) +;;;;; Highlight + `(highlight ((,class (:background ,jbeans-grey-3)))) + `(hl-line ((,class (:background ,jbeans-purple-5)))) +;;;;; iSearch + `(isearch ((,class (:foreground ,jbeans-fg :background ,jbeans-red-4)))) + `(isearch-fail ((,class (:background ,jbeans-red-4)))) +;;;;; Ido + `(ido-first-match ((,class (:foreground ,jbeans-yellow-3)))) + `(ido-only-match ((,class (:foreground ,jbeans-green-5)))) + `(ido-subdir ((,class (:foreground ,jbeans-fg)))) + `(ido-virtual ((,class (:foreground + ,jbeans-blue-0)))) +;;;;; Ivy + `(ivy-current-match ((,class (:background ,jbeans-grey-3)))) + `(ivy-minibuffer-match-face-1 ((,class (:foreground ,jbeans-yellow-3)))) + `(ivy-minibuffer-match-face-2 ((,class (:foreground ,jbeans-orange-0)))) + `(ivy-minibuffer-match-face-3 ((,class (:foreground ,jbeans-blue-1)))) + `(ivy-minibuffer-match-face-4 ((,class (:foreground ,jbeans-purple-1)))) + `(ivy-subdir ((,class (:foreground ,jbeans-green-4)))) + `(ivy-modified-buffer ((,class (:foreground ,jbeans-red-2)))) +;;;;; Jabber + `(jabber-activity-personal-face ((,class (:foreground ,jbeans-green-6 :weight bold)))) + `(jabber-activity-face ((,class (:foreground ,jbeans-red-3 :weight bold)))) + `(jabber-roster-user-online ((,class (:foreground ,jbeans-blue-0)))) + `(jabber-roster-user-dnd ((,class (:foreground ,jbeans-red-3)))) + `(jabber-chat-prompt-system ((,class (:foreground ,jbeans-green-6)))) + `(jabber-chat-prompt-local ((,class (:foreground ,jbeans-blue-0)))) + `(jabber-chat-prompt-foreign ((,class (:foreground ,jbeans-green-2)))) +;;;;; Lazy highlight + `(lazy-highlight ((,class (:foreground ,jbeans-red-4 :background nil)))) +;;;;; Linum + `(linum ((,class (:foreground ,jbeans-grey-5 :background ,jbeans-grey-2)))) +;;;;; Display line numbers + `(line-number ((,class (:foreground ,jbeans-grey-5 :background ,jbeans-grey-2)))) +;;;;; Ediff + `(ediff-even-diff-A ((,class (:background ,jbeans-grey-2 :foreground ,jbeans-fg)))) + `(ediff-even-diff-B ((,class (:background ,jbeans-grey-3 :foreground ,jbeans-fg)))) + `(ediff-even-diff-C ((,class (:background ,jbeans-grey-3 :foreground ,jbeans-fg)))) + `(ediff-odd-diff-A ((,class (:background ,jbeans-grey-2 :foreground ,jbeans-fg)))) + `(ediff-odd-diff-B ((,class (:background ,jbeans-grey-3 :foreground ,jbeans-fg)))) + `(ediff-odd-diff-C ((,class (:background ,jbeans-grey-5 :foreground ,jbeans-fg)))) + `(powerline-active1 ((,class (:inherit mode-line :background ,jbeans-bg)))) + `(powerline-active2 ((,class (:inherit mode-line :background ,jbeans-grey-3)))) + `(powerline-inactive1 ((,class (:inherit mode-line :background ,jbeans-bg)))) + `(powerline-inactive2 ((,class (:inherit mode-line :background ,jbeans-grey-2)))) +;;;;; flycheck + `(flycheck-error ((((supports :underline (:style wave))) + (:underline (:style wave :color ,jbeans-red-4) :inherit unspecified)) + (,class (:underline (:style line :color ,jbeans-red-4))))) + `(flycheck-warning ((((supports :underline (:style wave))) + (:underline (:style wave :color ,jbeans-yellow-3) :inherit unspecified)) + (,class (:underline (:style line :color ,jbeans-yellow-3))))) + `(flycheck-info ((((supports :underline (:style wave))) + (:underline (:style wave :color ,jbeans-blue-5) :inherit unspecified)) + (,class (:underline (:style line :color ,jbeans-blue-5))))) + `(flycheck-fringe-error ((,class (:foreground ,jbeans-red-4 :weight bold)))) + `(flycheck-fringe-warning ((,class (:foreground ,jbeans-yellow-3 :weight bold)))) + `(flycheck-fringe-info ((,class (:foreground ,jbeans-blue-5 :weight bold)))) +;;;;; flyspell + `(flyspell-duplicate ((((supports :underline (:style wave))) + (:underline (:style wave :color ,jbeans-orange-1) :inherit unspecified)) + (,class (:underline (:style line :color ,jbeans-orange-1))))) + `(flyspell-incorrect ((((supports :underline (:style wave))) + (:underline (:style wave :color ,jbeans-red-8) :inherit unspecified)) + (,class (:underline (:style line :color ,jbeans-red-8))))) +;;;;; Git + `(git-commit-comment-file ((,class (:background ,jbeans-bg :foreground ,jbeans-fg)))) + `(git-commit-summary ((,class (:background ,jbeans-bg :foreground ,jbeans-blue-0)))) + `(git-commit-comment-heading ((,class (:foreground ,jbeans-yellow-3)))) +;;;;; Git-gutter + `(git-gutter-fr+-modified ((,class (:foreground ,jbeans-blue-3 :background ,jbeans-bg)))) + `(git-gutter-fr+-added ((,class (:foreground ,jbeans-green-2 :background ,jbeans-bg)))) + `(git-gutter-fr+-deleted ((,class (:foreground + ,jbeans-red-5 :background ,jbeans-bg)))) +;;;;; Highlighting + `(hi-yellow ((,class (:box ,jbeans-yellow-1 :foreground ,jbeans-yellow-1 :background, jbeans-grey-4)))) +;;;;; Magit + `(magit-blame-heading ((,class (:background ,jbeans-grey-2 :box ,jbeans-purple-4 :weight bold :foreground ,jbeans-fg)))) + `(magit-blame-date ((,class (:background ,jbeans-grey-0 :box ,jbeans-green-3 :weight bold :foreground ,jbeans-green-5)))) + `(magit-blame-name ((,class (:background ,jbeans-grey-0 :box ,jbeans-green-3 :weight bold :foreground ,jbeans-red-0)))) + `(magit-blame-hash ((,class (:background ,jbeans-grey-0 :box ,jbeans-green-3 :weight bold :foreground ,jbeans-blue-3)))) + `(magit-bisect-bad ((,class (:foreground ,jbeans-red-6)))) + `(magit-bisect-good ((,class (:foreground ,jbeans-green-3)))) + `(magit-bisect-skip ((,class (:foreground ,jbeans-orange-2)))) + `(magit-blame-summary ((,class (:inherit magit-blame-heading)))) + `(magit-branch-current ((,class (:inherit magit-branch-local :box 1)))) + `(magit-branch-local ((,class (:foreground ,jbeans-blue-2)))) + `(magit-branch-remote ((,class (:foreground ,jbeans-green-5)))) + `(magit-cherry-equivalent ((,class (:foreground ,jbeans-purple-1)))) + `(magit-cherry-unmatched ((,class (:foreground ,jbeans-blue-5)))) + `(magit-diff-added ((,class (:background ,jbeans-green-4 :foreground ,jbeans-green-0)))) + `(magit-diff-added-highlight ((,class (:background ,jbeans-green-4 :foreground ,jbeans-green-0)))) + `(magit-diff-base ((,class (:background ,jbeans-green-3 :foreground ,jbeans-yellow-0)))) + `(magit-diff-base-highlight ((,class (:background ,jbeans-green-3 :foreground ,jbeans-yellow-0)))) + `(magit-diff-conflict-heading ((,class (:inherit magit-diff-hunk-heading)))) + `(magit-diff-context ((,class (:background ,jbeans-bg :foreground ,jbeans-fg)))) + `(magit-diff-context-highlight ((,class (:background ,jbeans-bg :foreground ,jbeans-fg)))) + `(magit-diff-file-heading ((,class (:foreground ,jbeans-blue-0 :weight bold)))) + `(magit-diff-file-heading-highlight ((,class (:foreground ,jbeans-blue-0 :weight normal)))) + `(magit-diff-file-heading-selection ((,class (:background ,jbeans-bg :foreground ,jbeans-fg)))) + `(magit-diff-hunk-heading ((,class (:background ,jbeans-grey-3 :box ,jbeans-grey-3 :foreground ,jbeans-fg :weight bold)))) + `(magit-diff-hunk-heading-highlight ((,class (:background ,jbeans-grey-3 :box ,jbeans-grey-7 :weight bold :foreground ,jbeans-fg)))) + `(magit-diff-hunk-heading-selection ((,class (:inherit magit-diff-hunk-heading-highlight :foreground ,jbeans-red-0)))) + `(magit-diff-lines-boundary ((,class (:inherit magit-diff-lines-heading)))) + `(magit-diff-lines-heading ((,class (:inherit magit-diff-hunk-heading-highlight :background ,jbeans-red-6 :foreground ,jbeans-fg)))) + `(magit-diff-our ((,class (:inherit magit-diff-removed)))) + `(magit-diff-our-highlight ((,class (:inherit magit-diff-removed-highlight)))) + `(magit-diff-removed ((,class (:background ,jbeans-red-7 :foreground ,jbeans-red-9)))) + `(magit-diff-removed-highlight ((,class (:background ,jbeans-red-7 :foreground ,jbeans-red-9)))) + `(magit-diff-their ((,class (:inherit magit-diff-added)))) + `(magit-diff-their-highlight ((,class (:inherit magit-diff-added-highlight)))) + `(magit-diff-whitespace-warning ((,class (:inherit trailing-whitespace)))) + `(magit-diffstat-added ((,class (:foreground ,jbeans-green-2)))) + `(magit-diffstat-removed ((,class (:foreground ,jbeans-red-5)))) + `(magit-dimmed ((,class (:background ,jbeans-bg :foreground ,jbeans-grey-6)))) + `(magit-filename ((,class (:foreground ,jbeans-orange-2 :weight normal)))) + `(magit-hash ((,class (:foreground ,jbeans-grey-5)))) + `(magit-head ((,class (:inherit magit-branch-local)))) + `(magit-header-line ((,class (:inherit magit-section-heading)))) + `(magit-log-author ((,class (:foreground ,jbeans-blue-0)))) + `(magit-log-date ((,class (:foreground ,jbeans-green-5)))) + `(magit-log-graph ((,class (:foreground ,jbeans-fg)))) + `(magit-popup-argument ((,class (:inherit font-lock-warning-face)))) + `(magit-popup-disabled-argument ((,class (:inherit shadow)))) + `(magit-popup-heading ((,class (:inherit font-lock-keyword-face)))) + `(magit-popup-key ((,class (:inherit font-lock-builtin-face)))) + `(magit-popup-option-value ((,class (:inherit font-lock-string-face)))) + `(magit-process-ng ((,class (:inherit magit-section-heading :foreground ,jbeans-red-8)))) + `(magit-process-ok ((,class (:inherit magit-section-heading :foreground ,jbeans-green-7)))) + `(magit-reflog-amend ((,class (:foreground ,jbeans-purple-1)))) + `(magit-reflog-checkout ((,class (:foreground ,jbeans-blue-5)))) + `(magit-reflog-cherry-pick ((,class (:foreground ,jbeans-green-7)))) + `(magit-reflog-commit ((,class (:foreground ,jbeans-green-7)))) + `(magit-reflog-merge ((,class (:foreground ,jbeans-green-7)))) + `(magit-reflog-other ((,class (:foreground ,jbeans-blue-5)))) + `(magit-reflog-rebase ((,class (:foreground ,jbeans-purple-1)))) + `(magit-reflog-remote ((,class (:foreground ,jbeans-blue-5)))) + `(magit-reflog-reset ((,class (:foreground ,jbeans-red-8)))) + `(magit-refname ((,class (:background ,jbeans-bg :foreground ,jbeans-fg)))) + `(magit-refname-stash ((,class (:inherit magit-refname)))) + `(magit-refname-wip ((,class (:inherit magit-refname)))) + `(magit-section-heading ((,class (:background ,jbeans-bg :foreground ,jbeans-yellow-3)))) + `(magit-section-highlight ((,class (:background ,jbeans-bg)))) + `(magit-section-secondary-heading ((,class (:background ,jbeans-bg :weight bold)))) + `(magit-sequence-done ((,class (:inherit magit-hash)))) + `(magit-sequence-drop ((,class (:foreground ,jbeans-red-5)))) + `(magit-sequence-head ((,class (:foreground ,jbeans-blue-2)))) + `(magit-sequence-onto ((,class (:inherit magit-sequence-done)))) + `(magit-sequence-part ((,class (:foreground ,jbeans-yellow-2)))) + `(magit-sequence-pick ((,class (:inherit default)))) + `(magit-sequence-stop ((,class (:foreground ,jbeans-green-1)))) + `(magit-signature-bad ((,class (:foreground ,jbeans-red-8)))) + `(magit-signature-good ((,class (:foreground ,jbeans-green-7)))) + `(magit-signature-untrusted ((,class (:foreground ,jbeans-blue-5)))) + `(magit-tag ((,class (:foreground ,jbeans-yellow-2)))) +;;;;; Match + `(match ((,class (:background ,jbeans-red-4)))) +;;;;; Minibuffer + `(minibuffer-prompt ((,class (:foreground ,jbeans-yellow-3)))) +;;;;; Modeline + `(mode-line ((,class (:foreground ,jbeans-fg :background ,jbeans-grey-3)))) + `(mode-line-inactive ((,class (:foreground ,jbeans-grey-6 :background ,jbeans-grey-2)))) +;;;;; NeoTree + `(neo-dir-link-face ((,class (:foreground ,jbeans-blue-0)))) + `(neo-file-link-face ((,class (:foreground ,jbeans-fg)))) +;;;;; Org + `(org-checkbox ((,class (:foreground ,jbeans-green-5)))) + `(org-date ((,class (:foreground ,jbeans-blue-0)))) + `(org-document-title ((,class (:foreground ,jbeans-red-9)))) + `(org-done ((,class (:foreground ,jbeans-green-2)))) + `(org-level-1 ((,class (:foreground ,jbeans-orange-0 :weight bold)))) + `(org-level-2 ((,class (:foreground ,jbeans-green-5 :weight bold)))) + `(org-level-3 ((,class (:foreground ,jbeans-red-0)))) + `(org-link ((,class (:foreground ,jbeans-blue-1)))) + `(org-special-keyword ((,class (:foreground ,jbeans-blue-0)))) + `(org-table ((,class (:foreground ,jbeans-orange-0)))) + `(org-todo ((,class (:foreground ,jbeans-red-1)))) +;;;;; Region + `(region ((,class (:background ,jbeans-grey-3)))) +;;;;; SHM + `(shm-current-face ((,class (:background ,jbeans-grey-4)))) + `(shm-quarantine-face ((,class (:background ,jbeans-red-4)))) +;;;;; Smerge + `(smerge-markers ((,class (:foreground ,jbeans-yellow-3 :background ,jbeans-grey-0)))) + `(smerge-refined-change ((,class (:foreground ,jbeans-green-5)))) +;;;;; SmartParens + `(sp-pair-overlay-face ((((class color) (min-colors 89)) (:background ,jbeans-grey-2)))) + `(sp-show-pair-match-face ((((class color) (min-colors 89)) (:background ,jbeans-grey-5)))) +;;;;; Spaceline + `(spaceline-evil-normal ((,class (:foreground ,jbeans-bg :background ,jbeans-orange-2)))) + `(spaceline-evil-motion ((,class (:foreground ,jbeans-bg :background ,jbeans-purple-2)))) + `(spaceline-evil-insert ((,class (:foreground ,jbeans-bg :background ,jbeans-green-2)))) + `(spaceline-evil-visual ((,class (:foreground ,jbeans-bg :background ,jbeans-grey-5)))) + `(spaceline-evil-replace ((,class (:foreground ,jbeans-bg :background ,jbeans-red-1)))) + `(spaceline-evil-emacs ((,class (:foreground ,jbeans-bg :background ,jbeans-blue-5)))) +;;;;; Spacemacs + `(spacemacs-normal-face ((,class (:foreground ,jbeans-bg :background ,jbeans-orange-2)))) + `(spacemacs-motion-face ((,class (:foreground ,jbeans-bg :background ,jbeans-purple-2)))) + `(spacemacs-insert-face ((,class (:foreground ,jbeans-bg :background ,jbeans-green-2)))) + `(spacemacs-visual-face ((,class (:foreground ,jbeans-bg :background ,jbeans-grey-5)))) + `(spacemacs-lisp-face ((,class (:foreground ,jbeans-bg :background ,jbeans-purple-1)))) + `(spacemacs-replace-face ((,class (:foreground ,jbeans-bg :background ,jbeans-red-1)))) + `(spacemacs-iedit-face ((,class (:foreground ,jbeans-bg :background ,jbeans-red-8)))) + `(spacemacs-iedit-insert-face ((,class (:foreground ,jbeans-bg :background ,jbeans-red-8)))) + `(spacemacs-evilified-face ((,class (:foreground ,jbeans-bg :background ,jbeans-green-3)))) + `(spacemacs-emacs-face ((,class (:foreground ,jbeans-bg :background ,jbeans-blue-5)))) +;;;;; TabBar + `(tabbar-default ((,class (:inherit variable-pitch :background ,jbeans-bg :foreground ,jbeans-fg :height 0.8)))) + `(tabbar-modified ((,class (:inherit tabbar-default :foreground ,jbeans-green-5 :box (:line-width 1 :color ,jbeans-grey-5 style: released-button))))) + `(tabbar-selected ((,class (:inherit tabbar-default :foreground ,jbeans-blue-0 :box (:line-width 1 :color ,jbeans-fg style: released-button))))) + `(tabbar-unselected ((,class (:inherit tabbar-default :box (:line-width 1 :color ,jbeans-grey-6 style: released-button))))) +;;;;; Term + `(term-color-black ((,class (:foreground ,jbeans-bg :background ,jbeans-bg)))) + `(term-color-red ((,class (:foreground ,jbeans-red-2 :background ,jbeans-red-3)))) + `(term-color-green ((,class (:foreground ,jbeans-green-2 :background ,jbeans-green-3)))) + `(term-color-yellow ((,class (:foreground ,jbeans-yellow-3 :background ,jbeans-yellow-2)))) + `(term-color-blue ((,class (:foreground ,jbeans-blue-0 :background ,jbeans-blue-1)))) + `(term-color-magenta ((,class (:foreground ,jbeans-purple-0 :background ,jbeans-purple-3)))) + `(term-color-white ((,class (:foreground ,jbeans-fg :background ,jbeans-fg)))) + `(term-default-fg-color ((,class (:inherit term-color-white)))) + `(term-default-bg-color ((,class (:inherit term-color-black)))) +;;;;; Whitespace + `(trailing-whitespace ((,class (:background ,jbeans-red-4)))) +;;;;; Vertical border + `(vertical-border ((,class (:foreground ,jbeans-grey-3)))) +;;;;; Web Mode + `(web-mode-builtin-face ((,class (:foreground ,jbeans-blue-1)))) + `(web-mode-html-attr-name-face ((,class (:foreground ,jbeans-blue-0)))) + `(web-mode-html-tag-face ((,class (:foreground ,jbeans-orange-0)))) + `(web-mode-symbol-face ((,class (:foreground ,jbeans-blue-3)))) + `(web-mode-function-name-face ((,class (:foreground ,jbeans-orange-0)))) + `(web-mode-block-control-face ((,class (:foreground ,jbeans-red-1)))) + `(web-mode-variable-name-face ((,class (:foreground ,jbeans-blue-2)))) +;;;;; More Whitespace + `(whitespace-trailing ((,class (:background ,jbeans-red-4)))))) + +;;;###autoload +(when load-file-name + (add-to-list 'custom-theme-load-path + (file-name-as-directory (file-name-directory load-file-name)))) + +(provide-theme 'jbeans) + +;; Local Variables: +;; no-byte-compile: t +;; indent-tabs-mode: nil +;; eval: (when (require 'rainbow-mode nil t) (rainbow-mode 1)) +;; End: +;;; jbeans-theme.el ends here