From dfd4317d2df3c0d11cb644b40eec6437f32a504c Mon Sep 17 00:00:00 2001 From: Ralf Zerres Date: Wed, 3 Jun 2020 22:24:55 +0200 Subject: [PATCH] emacs.d: initial config version - starting init.el just basics (package, use-package, path-handlin) - include my-site-start.el that includes site-start.d directory and imports all *.el files in lexical order - functionality is imported via use-package inside the *.el file (first run: internet connection is needed to MELPA) --- init.el | 59 ++ my-site-start.el | 255 +++++ site-lisp/avy.el | 1447 +++++++++++++++++++++++++++++ site-lisp/bind-key.el | 416 +++++++++ site-lisp/boxquote.el | 585 ++++++++++++ site-lisp/company-clang.el | 333 +++++++ site-lisp/company-template.el | 214 +++++ site-lisp/key-chord.el | 372 ++++++++ site-lisp/meson-mode.el | 764 +++++++++++++++ site-lisp/org-tree-slide.el | 873 +++++++++++++++++ site-lisp/smerge.el | 48 + site-lisp/use-package.el | 1205 ++++++++++++++++++++++++ site-start.d/00-my-setup.el | 76 ++ site-start.d/02-load-path.el | 11 + site-start.d/101-async.el | 19 + site-start.d/102-hydra.el | 29 + site-start.d/103-ivy-councel.el | 71 ++ site-start.d/104-avy.el | 35 + site-start.d/105-flycheck.el | 22 + site-start.d/106-parentheses.el | 71 ++ site-start.d/201-counsel-gtags.el | 19 + site-start.d/201-hs-minor-mode.el | 32 + site-start.d/401-rust.el | 74 ++ site-start.d/50-ansi-color.el | 10 + site-start.d/50-boxquote.el | 26 + site-start.d/501-git.el | 68 ++ site-start.d/502-meson-mode.el | 13 + 27 files changed, 7147 insertions(+) create mode 100644 init.el create mode 100644 my-site-start.el create mode 100644 site-lisp/avy.el create mode 100644 site-lisp/bind-key.el create mode 100644 site-lisp/boxquote.el create mode 100644 site-lisp/company-clang.el create mode 100644 site-lisp/company-template.el create mode 100644 site-lisp/key-chord.el create mode 100644 site-lisp/meson-mode.el create mode 100644 site-lisp/org-tree-slide.el create mode 100644 site-lisp/smerge.el create mode 100644 site-lisp/use-package.el create mode 100644 site-start.d/00-my-setup.el create mode 100644 site-start.d/02-load-path.el create mode 100644 site-start.d/101-async.el create mode 100644 site-start.d/102-hydra.el create mode 100644 site-start.d/103-ivy-councel.el create mode 100644 site-start.d/104-avy.el create mode 100644 site-start.d/105-flycheck.el create mode 100644 site-start.d/106-parentheses.el create mode 100644 site-start.d/201-counsel-gtags.el create mode 100644 site-start.d/201-hs-minor-mode.el create mode 100644 site-start.d/401-rust.el create mode 100644 site-start.d/50-ansi-color.el create mode 100644 site-start.d/50-boxquote.el create mode 100644 site-start.d/501-git.el create mode 100644 site-start.d/502-meson-mode.el diff --git a/init.el b/init.el new file mode 100644 index 0000000..feaaca3 --- /dev/null +++ b/init.el @@ -0,0 +1,59 @@ +;;; init.el --- user init file -*- no-byte-compile: t -*- + +;;; Commentary: +;; this emacs initilization file is inspired by +;; https://github.com/mwfogleman/.emacs.d/blob/master/michael.org + +;;; Code: +;; When using auto-compile +;; take care, that the init packages are not influenced +(setq load-prefer-newer t) + +;; Added by Package.el. This must come before configurations of +;; installed packages. Don't delete this line. If you don't want it, +;; just comment it out by adding a semicolon to the start of the line. +;; You may delete these explanatory comments. +(require 'package) +(package-initialize) + +(setq package-archives + '(("gnu" . "https://elpa.gnu.org/packages/") + ("melpa" . "https://melpa.org/packages/"))) + +;; from now on, we make use of use-package +;; this will make sure a package is downloaded, efficiently configured +;; (e.g. after load, or as needed), keys will be bind in a concise way, and more +(unless (package-installed-p 'use-package) + (package-refresh-contents) + (package-install 'use-package)) +(require 'use-package) +(setq use-package-always-ensure t) + +;; use my-site-start package +(autoload 'my-site-start "~/.emacs.d/my-site-start" nil t) +(my-site-start "~/.emacs.d/site-start.d/") + +(custom-set-variables + ;; custom-set-variables was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + '(font-use-system-font t) + '(magit-commit-arguments + (quote + ("--signoff" "--gpg-sign=1EC4BE4FF2A6C9F4DDDF30F33C5F485DBD250D66"))) + '(magit-log-arguments (quote ("--graph" "--decorate" "--show-signature" "-n256"))) + '(package-selected-packages + (quote + (flycheck lsp-ui rustic forge pcmpl-git git-link git-timemachine magit use-package))) + '(paradox-github-token t) + '(php-mode-coding-style (quote wordpress)) + '(show-paren-mode t) + '(visible-bell t)) +(custom-set-faces + ;; custom-set-faces was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + ) + diff --git a/my-site-start.el b/my-site-start.el new file mode 100644 index 0000000..8ec2857 --- /dev/null +++ b/my-site-start.el @@ -0,0 +1,255 @@ +;;; my-site-start.el --- set up personal .emacs.d/site-start.d/ +;; +;; Copyright (C) era eriksson 2008-2015 +;; License: GPL v2 +;; Version: see `my-site-start-version' below +;; +;;; Commentary: +;; +;; The purpose of my-site-start is to simplify maintenance of user libraries. +;; Instead of indefinitely tweaking your .emacs, just create a site-start.d +;; directory and add symlinks to the libraries you want to load into Emacs. +;; +;; See README.md for a more detailed introduction, and the customization +;; variables below for the rest. +;; +;; +;; Github repository / download: +;; +;;; History: +;; +;; 2015-02-25 Version 0.003 -- moved to Github; update documentation and links +;; 2009-02-09 Version 0.002 -- various tweaks and updated documentation +;; 2009-02-05 Version 0.001 -- first public beta. +;; +;; See changelog and version control history for details. +;; +;;; Code: + +(defconst my-site-start-version "0.003" + "Version numer for `my-site-start' library.") + + +;;;;;;;; FIXME: defcustom + + +(defvar my-site-start-inhibit-p nil "\ +*Set to non-nil to inhibit the running of `my-site-start' when loading.") + +(defvar my-site-start-file-name-regex + "\\(\\`\\|/\\)[0-9][0-9][-A-Za-z0-9_+.#$%@]+\.elc?$" + "*Regular expression to select which files to `load' from `my-site-start'. + +If you change this setting, you might also need to change other settings. +The assumption that all selected files will have one or more numbers at the +beginning of the file name is present in several other parts of `my-site-start' +and so you will need to change at least `my-site-start-load-order-function' +if this is not true.") + +(defvar my-site-start-avoid-dir-regex + (mapconcat + #'regexp-quote + '( + "RCS" + "CVS" + ".git" + ".svn" + ;;;;;;;; TODO: hg, monotone, svk, arch, bzr, others ...? + ) + "\\|") + "*Regular expression of directory names to avoid in `my-site-start' +when recursing into a directory tree. + +The regular expression is applied in a context where the match is +anchored to the beginning and end of the bare directory name, without +a full path.") + +(defvar my-site-start-load-order-function #'my-site-start-sort-load-order + "*Function accepting a list of strings specifying file names to be loaded, +and returning the list in sorted order. Used in `my-site-start' to decide +the order in which to load files.") + +(defvar my-site-start-defer-file-p-function #'my-site-start-defer-file-p + "*Function to determine whether loading of a file name should be deferred. + +See `my-site-start-do-deferred-loads'.") + +(defvar my-site-start--deferred-load-files nil + "List of files to load from `my-site-start-do-deferred-loads'. +\(Internal use only.\)") + + +(defun my-site-start (dir &optional no-recursion) "\ +Add DIR to `load-path' and load files matching `my-site-start-file-name-regex'. + +The optional second argument NO-RECURSION says to not traverse any directories. +Those other directories will also be prepended to `load-path'. + +Files will be sorted according to the function pointed to by the variable +`my-site-start-load-order-function'. + +See also `my-site-start-defer-file-p-function' for controlling deferred +loading of files. The documentation for `my-site-start-do-deferred-loads' +contains further information about this feature. If a file is determined to +belong in the deferred set, it will be loaded only later, from within the +`my-site-start-interactive-setup-hook' hook. + +If the value of the variable `my-site-start-inhibit-p' is non-nil, +`my-site-start' will only report which files would have been loaded. +Changes to the `load-path' will also not be made, only reported." + (mapc #'my-site-start-load + (my-site-start-split-deferred + (funcall my-site-start-load-order-function + (my-site-start-files (expand-file-name dir) no-recursion) ) + 'my-site-start--deferred-load-files) ) ) + +(defun my-site-start-split-deferred (list variable) + "Move deferred file names from LIST to VARIABLE, and return the rest. + +Whether a file is to be deferred or not is determined by the function +pointed to by the variable `my-site-start-defer-file-p-function'." + (let (l f d v) + (while list + (setq f (car list) + list (cdr list) ) + (setq v (if (funcall my-site-start-defer-file-p-function f) 'd 'l)) + (set v (cons f (symbol-value v))) ) + (set variable (append (symbol-value variable) (reverse d))) + (reverse l) )) + +(defun my-site-start-load (file) + "Load FILE, unless `my-site-start' loading is inhibited. + +If `my-site-start-inhibit-p' is non-nil, just print diagnostics indicating +what would have been done." + (message (if my-site-start-inhibit-p "Would load %s" "Loading %s") file) + (or my-site-start-inhibit-p (load-file file)) ) + +(defun my-site-start-files (dir no-recursion) + "Return files in DIR which are eligible for loading, obeying NO-RECURSION +i.e. only scanning the current directory if non-nil, otherwise descending +into subdirectories. + +DIR is also added to the front of `load-path' unless it is already on the +path \(or `my-site-start-inhibit-p' is non-nil, in which case only log +whether the path would have been added\). If recursing, all traversed +directories will also be added to the path, under the same conditions. + +DIR should be an absolute path name. + +See `my-site-start-file-name-regex' for determining which files should be +loaded. + +If both an `.el' and and `.elc' version of a file exists, only the newer +of the two is returned." + + (message (if my-site-start-inhibit-p + (if (member dir load-path) "%s is already on load-path" + "Would add %s to load-path") + "Adding %s to load-path") dir) + (add-to-list 'load-path dir) + + (let ((files (directory-files dir 'full-path nil ; no regex to filter on + 'dont-sort)) + (avoid-re + (concat "\\(\\`\\|/\\)" + "\\(" + "\\.\\.?" + "\\|" + my-site-start-avoid-dir-regex + "\\)\\'") ) + list file elc) + (save-match-data + (while files + (setq file (car files) + files (cdr files)) + (cond + ((file-directory-p file) + (or no-recursion + (string-match avoid-re file) + (setq list (append list (my-site-start-files file nil))) ) ) + ((string-match my-site-start-file-name-regex file) + (if (string-match "\\`\\(.*\\.el\\)c?\\'" file) + (setq file (match-string 1 file) + elc (concat file "c") ) + (error "%s is neither .el nor .elc" file) ) + (and (file-exists-p file) + (file-exists-p elc) + (file-newer-than-file-p elc file) + (setq file elc) ) + (add-to-list 'list file) ) ) ) ) + list) ) + +(defsubst my-site-start-split-filename (filename) + (if (string-match "\\(\\`\\|/\\)\\(\\([0-9][0-9]\\).*\\)\\.elc?\\'" filename) + (cons (string-to-number (match-string 3 filename)) + (match-string 2 filename) ) + (error "\"%s\" does not look like a valid .el/.elc file name" filename) ) ) +(defun my-site-start-sort-load-order (list) + "Return the file names in LIST sorted numerically by basename. + +This function assumes file names adhere to the convention of having a leading +numeric prefix to decide the load order, and will fail if this is not the +case." + (sort list + (function + (lambda (aa bb) + (save-match-data + (let ((a (my-site-start-split-filename aa)) + (b (my-site-start-split-filename bb))) + (if (= (car a) (car b)) + (string-lessp (cdr a) (cdr b)) + (< (car a) (car b)) ) ) ))) ) ) + + +(defun my-site-start-do-deferred-loads () + "Load all files whose loading was deferred from `my-site-start'. + +Load all files from the list `my-site-start--deferred-load-files'. +The value of `my-site-stat--deferred-load-files' is then set to nil. + +The default `my-site-start-interactive-setup-hook' calls this function. + +By convention, features which are only useful for interactive use should +be deferred, which in practice means they will only be loaded when Emacs +is started for interactive use \(and not, for example, from within a script, +say, to batch compile some Lisp files\). + +Furthermore, the default `my-site-start-defer-file-p' function encodes the +convention that file names with a numeric prefix larger than 99 will be +deferred. See furthermore `my-site-start-defer-file-p-function' if you +wish to override this behavior." + (mapc #'my-site-start-load my-site-start--deferred-load-files) + (setq my-site-start--deferred-load-files nil) ) + +(defun my-site-start-defer-file-p (file) + "Return non-nil if FILE has a numeric prefix strictly bigger than 99. + +This function is used as `my-site-start-defer-file-p-function' by default, +and implements the simple policy that a file name with a numeric prefix +larger than 99 names a file whose loading should be deferred." + (save-match-data + (string-match "\\`\\(.*/\\)?0*[1-9][0-9][0-9][^/]*\\'" file) ) ) + + +(defvar my-site-start-interactive-setup-hook + (list (function my-site-start-do-deferred-loads)) +"Hook run at the end of loading user's startup files, if running on a terminal. + +This provides a facility for deferring loading of features which are only +useful in interactive use, but not e.g. when batch-compiling Elisp files. + +By default, the hook runs `my-site-start-do-deferred-loads'. + +Technically, this hook is run from `term-setup-hook' in turn.") + +(add-hook 'term-setup-hook + '(lambda nil (run-hooks 'my-site-start-interactive-setup-hook)) ) + + + +;; This isn't really meant to be `require'd, but what the hey + +(provide 'my-site-start) + +;;; my-site-start.el ends here diff --git a/site-lisp/avy.el b/site-lisp/avy.el new file mode 100644 index 0000000..da51488 --- /dev/null +++ b/site-lisp/avy.el @@ -0,0 +1,1447 @@ +;;; avy.el --- tree-based completion -*- lexical-binding: t -*- + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Oleh Krehel +;; URL: https://github.com/abo-abo/avy +;; Version: 0.4.0 +;; Package-Requires: ((emacs "24.1") (cl-lib "0.5")) +;; Keywords: point, location + +;; This file is part of GNU 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, 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. + +;; For a full copy of the GNU General Public License +;; see . + +;;; Commentary: +;; +;; This package provides a generic completion method based on building +;; a balanced decision tree with each candidate being a leaf. To +;; traverse the tree from the root to a desired leaf, typically a +;; sequence of `read-key' can be used. +;; +;; In order for `read-key' to make sense, the tree needs to be +;; visualized appropriately, with a character at each branch node. So +;; this completion method works only for things that you can see on +;; your screen, all at once: +;; +;; * character positions +;; * word or subword start positions +;; * line beginning positions +;; * link positions +;; * window positions +;; +;; If you're familiar with the popular `ace-jump-mode' package, this +;; package does all that and more, without the implementation +;; headache. + +;;; Code: +(require 'cl-lib) +(require 'ring) + +;;* Customization +(defgroup avy nil + "Jump to things tree-style." + :group 'convenience + :prefix "avy-") + +(defcustom avy-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l) + "Default keys for jumping. +Any key is either a character representing a self-inserting +key (letters, digits, punctuation, etc.) or a symbol denoting a +non-printing key like an arrow key (left, right, up, down). For +non-printing keys, a corresponding entry in +`avy-key-to-char-alist' must exist in order to visualize the key +in the avy overlays." + :type '(repeat :tag "Keys" (choice + (character :tag "char") + (symbol :tag "non-printing key")))) + +(defcustom avy-keys-alist nil + "Alist of avy-jump commands to `avy-keys' overriding the default `avy-keys'." + :type '(alist + :key-type (choice :tag "Command" + (const avy-goto-char) + (const avy-goto-char-2) + (const avy-isearch) + (const avy-goto-line) + (const avy-goto-subword-0) + (const avy-goto-subword-1) + (const avy-goto-word-0) + (const avy-goto-word-1) + (const avy-copy-line) + (const avy-copy-region) + (const avy-move-line) + (const avy-move-region) + (function :tag "Other command")) + :value-type (repeat :tag "Keys" character))) + +(defcustom avy-style 'at-full + "The default method of displaying the overlays. +Use `avy-styles-alist' to customize this per-command." + :type '(choice + (const :tag "Pre" pre) + (const :tag "At" at) + (const :tag "At Full" at-full) + (const :tag "Post" post) + (const :tag "De Bruijn" de-bruijn))) + +(defcustom avy-styles-alist nil + "Alist of avy-jump commands to the style for each command. +If the commands isn't on the list, `avy-style' is used." + :type '(alist + :key-type (choice :tag "Command" + (const avy-goto-char) + (const avy-goto-char-2) + (const avy-isearch) + (const avy-goto-line) + (const avy-goto-subword-0) + (const avy-goto-subword-1) + (const avy-goto-word-0) + (const avy-goto-word-1) + (const avy-copy-line) + (const avy-copy-region) + (const avy-move-line) + (const avy-move-region) + (function :tag "Other command")) + :value-type (choice + (const :tag "Pre" pre) + (const :tag "At" at) + (const :tag "At Full" at-full) + (const :tag "Post" post) + (const :tag "De Bruijn" de-bruijn)))) + +(defcustom avy-dispatch-alist + '((?x . avy-action-kill-move) + (?X . avy-action-kill-stay) + (?m . avy-action-mark) + (?n . avy-action-copy) + (?i . avy-action-ispell)) + "List of actions for `avy-handler-default'. + +Each item is (KEY . ACTION). When KEY not on `avy-keys' is +pressed during the dispatch, ACTION is set to replace the default +`avy-action-goto' once a candidate is finally selected." + :type + '(alist + :key-type (choice (character :tag "Char")) + :value-type (choice + (const :tag "Mark" avy-action-mark) + (const :tag "Copy" avy-action-copy) + (const :tag "Kill and move point" avy-action-kill-move) + (const :tag "Kill" avy-action-kill-stay)))) + +(defcustom avy-background nil + "When non-nil, a gray background will be added during the selection." + :type 'boolean) + +(defcustom avy-all-windows t + "Determine the list of windows to consider in search of candidates." + :type + '(choice + (const :tag "All Frames" all-frames) + (const :tag "This Frame" t) + (const :tag "This Window" nil))) + +(defcustom avy-case-fold-search t + "Non-nil if searches should ignore case." + :type 'boolean) + +(defcustom avy-word-punc-regexp "[!-/:-@[-`{-~]" + "Regexp of punctuation chars that count as word starts for `avy-goto-word-1. +When nil, punctuation chars will not be matched. + +\"[!-/:-@[-`{-~]\" will match all printable punctuation chars." + :type 'regexp) + +(defcustom avy-goto-word-0-regexp "\\b\\sw" + "Regexp that determines positions for `avy-goto-word-0'." + :type '(choice + (const :tag "Default" "\\b\\sw") + (const :tag "Not whitespace" "[^ \r\n\t]+") + (regexp :tag "Regex"))) + +(defcustom avy-ignored-modes '(image-mode doc-view-mode pdf-view-mode) + "List of modes to ignore when searching for candidates. +Typically, these modes don't use the text representation." + :type 'list) + +(defvar avy-ring (make-ring 20) + "Hold the window and point history.") + +(defvar avy-translate-char-function #'identity + "Function to translate user input key into another key. +For example, to make SPC do the same as ?a, use +\(lambda (c) (if (= c 32) ?a c)).") + +(defface avy-lead-face-0 + '((t (:foreground "white" :background "#4f57f9"))) + "Face used for first non-terminating leading chars.") + +(defface avy-lead-face-1 + '((t (:foreground "white" :background "gray"))) + "Face used for matched leading chars.") + +(defface avy-lead-face-2 + '((t (:foreground "white" :background "#f86bf3"))) + "Face used for leading chars.") + +(defface avy-lead-face + '((t (:foreground "white" :background "#e52b50"))) + "Face used for the leading chars.") + +(defface avy-background-face + '((t (:foreground "gray40"))) + "Face for whole window background during selection.") + +(defface avy-goto-char-timer-face + '((t (:inherit highlight))) + "Face for matches during reading chars using `avy-goto-char-timer'.") + +(defconst avy-lead-faces '(avy-lead-face + avy-lead-face-0 + avy-lead-face-2 + avy-lead-face + avy-lead-face-0 + avy-lead-face-2) + "Face sequence for `avy--overlay-at-full'.") + +(defvar avy-key-to-char-alist '((left . ?◀) + (right . ?▶) + (up . ?▲) + (down . ?▼) + (prior . ?△) + (next . ?▽)) + "An alist from non-character keys to printable chars used in avy overlays. +This alist must contain all keys used in `avy-keys' which are not +self-inserting keys and thus aren't read as characters.") + +;;* Internals +;;** Tree +(defmacro avy-multipop (lst n) + "Remove LST's first N elements and return them." + `(if (<= (length ,lst) ,n) + (prog1 ,lst + (setq ,lst nil)) + (prog1 ,lst + (setcdr + (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst)))) + nil)))) + +(defun avy--de-bruijn (keys n) + "De Bruijn sequence for alphabet KEYS and subsequences of length N." + (let* ((k (length keys)) + (a (make-list (* n k) 0)) + sequence) + (cl-labels ((db (T p) + (if (> T n) + (if (eq (% n p) 0) + (setq sequence + (append sequence + (cl-subseq a 1 (1+ p))))) + (setf (nth T a) (nth (- T p) a)) + (db (1+ T) p) + (cl-loop for j from (1+ (nth (- T p) a)) to (1- k) do + (setf (nth T a) j) + (db (1+ T) T))))) + (db 1 1) + (mapcar (lambda (n) + (nth n keys)) + sequence)))) + +(defun avy--path-alist-1 (lst seq-len keys) + "Build a De Bruin sequence from LST. +SEQ-LEN is how many elements of KEYS it takes to identify a match." + (let ((db-seq (avy--de-bruijn keys seq-len)) + prev-pos prev-seq prev-win path-alist) + ;; The De Bruijn seq is cyclic, so append the seq-len - 1 first chars to + ;; the end. + (setq db-seq (nconc db-seq (cl-subseq db-seq 0 (1- seq-len)))) + (cl-labels ((subseq-and-pop () + (when (nth (1- seq-len) db-seq) + (prog1 (cl-subseq db-seq 0 seq-len) + (pop db-seq))))) + (while lst + (let* ((cur (car lst)) + (pos (cond + ;; ace-window has matches of the form (pos . wnd) + ((integerp (car cur)) (car cur)) + ;; avy-jump have form ((start . end) . wnd) + ((consp (car cur)) (caar cur)) + (t (error "Unexpected match representation: %s" cur)))) + (win (cdr cur)) + (path (if prev-pos + (let ((diff (if (eq win prev-win) + (- pos prev-pos) + 0))) + (when (and (> diff 0) (< diff seq-len)) + (while (and (nth (1- seq-len) db-seq) + (not + (eq 0 + (cl-search + (cl-subseq prev-seq diff) + (cl-subseq db-seq 0 seq-len))))) + (pop db-seq))) + (subseq-and-pop)) + (subseq-and-pop)))) + (if (not path) + (setq lst nil + path-alist nil) + (push (cons path (car lst)) path-alist) + (setq prev-pos pos + prev-seq path + prev-win win + lst (cdr lst)))))) + (nreverse path-alist))) + +(defun avy-tree (lst keys) + "Coerce LST into a balanced tree. +The degree of the tree is the length of KEYS. +KEYS are placed appropriately on internal nodes." + (let ((len (length keys))) + (cl-labels + ((rd (ls) + (let ((ln (length ls))) + (if (< ln len) + (cl-pairlis keys + (mapcar (lambda (x) (cons 'leaf x)) ls)) + (let ((ks (copy-sequence keys)) + res) + (dolist (s (avy-subdiv ln len)) + (push (cons (pop ks) + (if (eq s 1) + (cons 'leaf (pop ls)) + (rd (avy-multipop ls s)))) + res)) + (nreverse res)))))) + (rd lst)))) + +(defun avy-subdiv (n b) + "Distribute N in B terms in a balanced way." + (let* ((p (1- (floor (+ (log n b) 1e-6)))) + (x1 (expt b p)) + (x2 (* b x1)) + (delta (- n x2)) + (n2 (/ delta (- x2 x1))) + (n1 (- b n2 1))) + (append + (make-list n1 x1) + (list + (- n (* n1 x1) (* n2 x2))) + (make-list n2 x2)))) + +(defun avy-traverse (tree walker &optional recur-key) + "Traverse TREE generated by `avy-tree'. +WALKER is a function that takes KEYS and LEAF. + +RECUR-KEY is used in recursion. + +LEAF is a member of LST argument of `avy-tree'. + +KEYS is the path from the root of `avy-tree' to LEAF." + (dolist (br tree) + (let ((key (cons (car br) recur-key))) + (if (eq (cadr br) 'leaf) + (funcall walker key (cddr br)) + (avy-traverse (cdr br) walker key))))) + +(defvar avy-action nil + "Function to call at the end of select.") + +(defun avy-handler-default (char) + "The default handler for a bad CHAR." + (let (dispatch) + (cond ((setq dispatch (assoc char avy-dispatch-alist)) + (setq avy-action (cdr dispatch)) + (throw 'done 'restart)) + ((memq char '(27 ?\C-g)) + ;; exit silently + (throw 'done 'exit)) + (t + (signal 'user-error (list "No such candidate" char)) + (throw 'done nil))))) + +(defvar avy-handler-function 'avy-handler-default + "A function to call for a bad `read-key' in `avy-read'.") + +(defvar avy-current-path "" + "Store the current incomplete path during `avy-read'.") + +(defun avy-read (tree display-fn cleanup-fn) + "Select a leaf from TREE using consecutive `read-char'. + +DISPLAY-FN should take CHAR and LEAF and signify that LEAFs +associated with CHAR will be selected if CHAR is pressed. This is +commonly done by adding a CHAR overlay at LEAF position. + +CLEANUP-FN should take no arguments and remove the effects of +multiple DISPLAY-FN invokations." + (catch 'done + (setq avy-current-path "") + (while tree + (let ((avy--leafs nil)) + (avy-traverse tree + (lambda (path leaf) + (push (cons path leaf) avy--leafs))) + (dolist (x avy--leafs) + (funcall display-fn (car x) (cdr x)))) + (let ((char (funcall avy-translate-char-function (read-key))) + branch) + (funcall cleanup-fn) + (if (setq branch (assoc char tree)) + (if (eq (car (setq tree (cdr branch))) 'leaf) + (throw 'done (cdr tree)) + (setq avy-current-path + (concat avy-current-path (string (avy--key-to-char char))))) + (funcall avy-handler-function char)))))) + +(defun avy-read-de-bruijn (lst keys) + "Select from LST dispatching on KEYS." + ;; In theory, the De Bruijn sequence B(k,n) has k^n subsequences of length n + ;; (the path length) usable as paths, thus that's the lower bound. Due to + ;; partially overlapping matches, not all subsequences may be usable, so it's + ;; possible that the path-len must be incremented, e.g., if we're matching + ;; for x and a buffer contains xaxbxcx only every second subsequence is + ;; usable for the four matches. + (catch 'done + (let* ((path-len (ceiling (log (length lst) (length keys)))) + (alist (avy--path-alist-1 lst path-len keys))) + (while (not alist) + (cl-incf path-len) + (setq alist (avy--path-alist-1 lst path-len keys))) + (let* ((len (length (caar alist))) + (i 0)) + (setq avy-current-path "") + (while (< i len) + (dolist (x (reverse alist)) + (avy--overlay-at-full (reverse (car x)) (cdr x))) + (let ((char (funcall avy-translate-char-function (read-key)))) + (avy--remove-leading-chars) + (setq alist + (delq nil + (mapcar (lambda (x) + (when (eq (caar x) char) + (cons (cdr (car x)) (cdr x)))) + alist))) + (setq avy-current-path + (concat avy-current-path (string (avy--key-to-char char)))) + (cl-incf i) + (unless alist + (funcall avy-handler-function char)))) + (cdar alist))))) + +;;** Rest +(defun avy-window-list () + "Return a list of windows depending on `avy-all-windows'." + (cond ((eq avy-all-windows 'all-frames) + (cl-mapcan #'window-list (frame-list))) + + ((eq avy-all-windows t) + (window-list)) + + ((null avy-all-windows) + (list (selected-window))) + + (t + (error "Unrecognized option: %S" avy-all-windows)))) + +(defcustom avy-all-windows-alt nil + "The alternative `avy-all-windows' for use with \\[universal-argument]." + :type '(choice + (const :tag "Current window" nil) + (const :tag "All windows on the current frame" t) + (const :tag "All windows on all frames" all-frames))) + +(defmacro avy-dowindows (flip &rest body) + "Depending on FLIP and `avy-all-windows' run BODY in each or selected window." + (declare (indent 1) + (debug (form body))) + `(let ((avy-all-windows (if ,flip + avy-all-windows-alt + avy-all-windows))) + (dolist (wnd (avy-window-list)) + (with-selected-window wnd + (unless (memq major-mode avy-ignored-modes) + ,@body))))) + +(defmacro avy-with (command &rest body) + "Set `avy-keys' according to COMMAND and execute BODY. +Set `avy-style' according to COMMMAND as well." + (declare (indent 1) + (debug (form body))) + `(let ((avy-keys (or (cdr (assq ',command avy-keys-alist)) + avy-keys)) + (avy-style (or (cdr (assq ',command avy-styles-alist)) + avy-style))) + (setq avy-action nil) + ,@body)) + +(defun avy-action-goto (pt) + "Goto PT." + (goto-char pt)) + +(defun avy-action-mark (pt) + "Mark sexp at PT." + (goto-char pt) + (set-mark (point)) + (forward-sexp)) + +(defun avy-action-copy (pt) + "Copy sexp starting on PT." + (save-excursion + (let (str) + (goto-char pt) + (forward-sexp) + (setq str (buffer-substring pt (point))) + (kill-new str) + (message "Copied: %s" str))) + (let ((dat (ring-ref avy-ring 0))) + (select-frame-set-input-focus + (window-frame (cdr dat))) + (select-window (cdr dat)) + (goto-char (car dat)))) + +(defun avy-action-kill-move (pt) + "Kill sexp at PT and move there." + (goto-char pt) + (forward-sexp) + (kill-region pt (point)) + (message "Killed: %s" (current-kill 0))) + +(defun avy-action-kill-stay (pt) + "Kill sexp at PT." + (save-excursion + (goto-char pt) + (forward-sexp) + (kill-region pt (point)) + (just-one-space)) + (message "Killed: %s" (current-kill 0))) + +(defun avy-action-ispell (pt) + "Auto correct word at PT." + (save-excursion + (goto-char pt) + (if (looking-at-p "\\b") + (ispell-word) + (progn + (backward-word) + (when (looking-at-p "\\b") + (ispell-word)))))) + +(defun avy--process (candidates overlay-fn) + "Select one of CANDIDATES using `avy-read'. +Use OVERLAY-FN to visualize the decision overlay." + (unless (and (consp (car candidates)) + (windowp (cdar candidates))) + (setq candidates + (mapcar (lambda (x) (cons x (selected-window))) + candidates))) + (let ((len (length candidates)) + (cands (copy-sequence candidates)) + res) + (if (= len 0) + (message "zero candidates") + (if (= len 1) + (setq res (car candidates)) + (unwind-protect + (progn + (avy--make-backgrounds + (avy-window-list)) + (setq res (if (eq avy-style 'de-bruijn) + (avy-read-de-bruijn + candidates avy-keys) + (avy-read (avy-tree candidates avy-keys) + overlay-fn + #'avy--remove-leading-chars)))) + (avy--done))) + (cond ((eq res 'restart) + (avy--process cands overlay-fn)) + ;; ignore exit from `avy-handler-function' + ((eq res 'exit)) + (t + (avy-push-mark) + (when (and (consp res) + (windowp (cdr res))) + (let* ((window (cdr res)) + (frame (window-frame window))) + (unless (equal frame (selected-frame)) + (select-frame-set-input-focus frame)) + (select-window window)) + (setq res (car res))) + + (funcall (or avy-action 'avy-action-goto) + (if (consp res) + (car res) + res))))))) + +(defvar avy--overlays-back nil + "Hold overlays for when `avy-background' is t.") + +(defun avy--make-backgrounds (wnd-list) + "Create a dim background overlay for each window on WND-LIST." + (when avy-background + (setq avy--overlays-back + (mapcar (lambda (w) + (let ((ol (make-overlay + (window-start w) + (window-end w) + (window-buffer w)))) + (overlay-put ol 'face 'avy-background-face) + (overlay-put ol 'window w) + ol)) + wnd-list)))) + +(defun avy--done () + "Clean up overlays." + (mapc #'delete-overlay avy--overlays-back) + (setq avy--overlays-back nil) + (avy--remove-leading-chars)) + +(defun avy--next-visible-point () + "Return the next closest point without 'invisible property." + (let ((s (point))) + (while (and (not (= (point-max) (setq s (next-overlay-change s)))) + (get-char-property s 'invisible))) + s)) + +(defun avy--next-invisible-point () + "Return the next closest point with 'invisible property." + (let ((s (point))) + (while (and (not (= (point-max) (setq s (next-overlay-change s)))) + (not (get-char-property s 'invisible)))) + s)) + +(defun avy--find-visible-regions (rbeg rend) + "Return a list of all visible regions between RBEG and REND." + (setq rbeg (max rbeg (point-min))) + (setq rend (min rend (point-max))) + (when (< rbeg rend) + (let (visibles beg) + (save-excursion + (save-restriction + (narrow-to-region rbeg rend) + (setq beg (goto-char (point-min))) + (while (not (= (point) (point-max))) + (goto-char (avy--next-invisible-point)) + (push (cons beg (point)) visibles) + (setq beg (goto-char (avy--next-visible-point)))) + (nreverse visibles)))))) + +(defun avy--regex-candidates (regex &optional beg end pred group) + "Return all elements that match REGEX. +Each element of the list is ((BEG . END) . WND) +When PRED is non-nil, it's a filter for matching point positions. +When GROUP is non-nil, (BEG . END) should delimit that regex group." + (setq group (or group 0)) + (let ((case-fold-search (or avy-case-fold-search + (string= regex (downcase regex)))) + candidates) + (avy-dowindows current-prefix-arg + (dolist (pair (avy--find-visible-regions + (or beg (window-start)) + (or end (window-end (selected-window) t)))) + (save-excursion + (goto-char (car pair)) + (while (re-search-forward regex (cdr pair) t) + (unless (get-char-property (1- (point)) 'invisible) + (when (or (null pred) + (funcall pred)) + (push (cons (cons (match-beginning group) + (match-end group)) + wnd) candidates))))))) + (nreverse candidates))) + +(defvar avy--overlay-offset 0 + "The offset to apply in `avy--overlay'.") + +(defvar avy--overlays-lead nil + "Hold overlays for leading chars.") + +(defun avy--remove-leading-chars () + "Remove leading char overlays." + (mapc #'delete-overlay avy--overlays-lead) + (setq avy--overlays-lead nil)) + +(defun avy--old-str (pt wnd) + "Return a one-char string at PT in WND." + (let ((old-str (with-selected-window wnd + (buffer-substring pt (1+ pt))))) + (if avy-background + (propertize old-str 'face 'avy-background-face) + old-str))) + +(defun avy--overlay (str beg end wnd &optional compose-fn) + "Create an overlay with STR from BEG to END in WND. +COMPOSE-FN is a lambda that concatenates the old string at BEG with STR." + (let ((eob (with-selected-window wnd (point-max)))) + (when (<= beg eob) + (let* ((beg (+ beg avy--overlay-offset)) + (ol (make-overlay beg (or end (1+ beg)) (window-buffer wnd))) + (old-str (if (eq beg eob) "" (avy--old-str beg wnd))) + (os-line-prefix (get-text-property 0 'line-prefix old-str)) + (os-wrap-prefix (get-text-property 0 'wrap-prefix old-str)) + other-ol) + (when os-line-prefix + (add-text-properties 0 1 `(line-prefix ,os-line-prefix) str)) + (when os-wrap-prefix + (add-text-properties 0 1 `(wrap-prefix ,os-wrap-prefix) str)) + (when (setq other-ol (cl-find-if + (lambda (o) (overlay-get o 'goto-address)) + (overlays-at beg))) + (add-text-properties + 0 (length old-str) + `(face ,(overlay-get other-ol 'face)) old-str)) + (overlay-put ol 'window wnd) + (overlay-put ol 'category 'avy) + (overlay-put ol (if (eq beg eob) + 'after-string + 'display) + (funcall + (or compose-fn #'concat) + str old-str)) + (push ol avy--overlays-lead))))) + +(defcustom avy-highlight-first nil + "When non-nil highlight the first decision char with `avy-lead-face-0'. +Do this even when the char is terminating." + :type 'boolean) + +(defun avy--key-to-char (c) + "If C is no character, translate it using `avy-key-to-char-alist'." + (if (characterp c) + c + (or (cdr (assoc c avy-key-to-char-alist)) + (error "Unknown key %s" c)))) + +(defun avy-candidate-beg (leaf) + "Return the start position for LEAF." + (cond ((numberp leaf) + leaf) + ((consp (car leaf)) + (caar leaf)) + (t + (car leaf)))) + +(defun avy-candidate-end (leaf) + "Return the end position for LEAF." + (cond ((numberp leaf) + leaf) + ((consp (car leaf)) + (cdar leaf)) + (t + (car leaf)))) + +(defun avy-candidate-wnd (leaf) + "Return the window for LEAF." + (if (consp leaf) + (cdr leaf) + (selected-window))) + +(defun avy--overlay-pre (path leaf) + "Create an overlay with PATH at LEAF. +PATH is a list of keys from tree root to LEAF. +LEAF is normally ((BEG . END) . WND)." + (let* ((path (mapcar #'avy--key-to-char path)) + (str (propertize (apply #'string (reverse path)) + 'face 'avy-lead-face))) + (when (or avy-highlight-first (> (length str) 1)) + (set-text-properties 0 1 '(face avy-lead-face-0) str)) + (setq str (concat + (propertize avy-current-path + 'face 'avy-lead-face-1) + str)) + (avy--overlay + str + (avy-candidate-beg leaf) nil + (avy-candidate-wnd leaf)))) + +(defun avy--overlay-at (path leaf) + "Create an overlay with PATH at LEAF. +PATH is a list of keys from tree root to LEAF. +LEAF is normally ((BEG . END) . WND)." + (let* ((path (mapcar #'avy--key-to-char path)) + (str (propertize + (string (car (last path))) + 'face 'avy-lead-face))) + (avy--overlay + str + (avy-candidate-beg leaf) nil + (avy-candidate-wnd leaf) + (lambda (str old-str) + (cond ((string= old-str "\n") + (concat str "\n")) + ;; add padding for wide-width character + ((eq (string-width old-str) 2) + (concat str " ")) + (t + str)))))) + +(defun avy--overlay-at-full (path leaf) + "Create an overlay with PATH at LEAF. +PATH is a list of keys from tree root to LEAF. +LEAF is normally ((BEG . END) . WND)." + (let* ((path (mapcar #'avy--key-to-char path)) + (str (propertize + (apply #'string (reverse path)) + 'face 'avy-lead-face)) + (len (length path)) + (beg (avy-candidate-beg leaf)) + (wnd (cdr leaf)) + end) + (dotimes (i len) + (set-text-properties (- len i 1) (- len i) + `(face ,(nth i avy-lead-faces)) + str)) + (when (eq avy-style 'de-bruijn) + (setq str (concat + (propertize avy-current-path + 'face 'avy-lead-face-1) + str)) + (setq len (length str))) + (with-selected-window wnd + (save-excursion + (goto-char beg) + (let* ((lep (if (bound-and-true-p visual-line-mode) + (save-excursion + (end-of-visual-line) + (point)) + (line-end-position))) + (len-and-str (avy--update-offset-and-str len str lep))) + (setq len (car len-and-str)) + (setq str (cdr len-and-str)) + (setq end (if (= beg lep) + (1+ beg) + (min (+ beg + (if (eq (char-after) ?\t) + 1 + len)) + lep))) + (when (and (bound-and-true-p visual-line-mode) + (> len (- end beg)) + (not (eq lep beg))) + (setq len (- end beg)) + (let ((old-str (apply #'string (reverse path)))) + (setq str + (substring + (propertize + old-str + 'face + (if (= (length old-str) 1) + 'avy-lead-face + 'avy-lead-face-0)) + 0 len))))))) + (avy--overlay + str beg end wnd + (lambda (str old-str) + (cond ((string= old-str "\n") + (concat str "\n")) + ((string= old-str "\t") + (concat str (make-string (max (- tab-width len) 0) ?\ ))) + (t + ;; add padding for wide-width character + (if (eq (string-width old-str) 2) + (concat str " ") + str))))))) + +(defun avy--overlay-post (path leaf) + "Create an overlay with PATH at LEAF. +PATH is a list of keys from tree root to LEAF. +LEAF is normally ((BEG . END) . WND)." + (let* ((path (mapcar #'avy--key-to-char path)) + (str (propertize (apply #'string (reverse path)) + 'face 'avy-lead-face))) + (when (or avy-highlight-first (> (length str) 1)) + (set-text-properties 0 1 '(face avy-lead-face-0) str)) + (setq str (concat + (propertize avy-current-path + 'face 'avy-lead-face-1) + str)) + (avy--overlay + str + (avy-candidate-end leaf) nil + (avy-candidate-wnd leaf)))) + +(defun avy--update-offset-and-str (offset str lep) + "Recalculate the length of the new overlay at point. + +OFFSET is the previous overlay length. +STR is the overlay string that we wish to add. +LEP is the line end position. + +We want to add an overlay between point and END=point+OFFSET. +When other overlays already exist between point and END, set +OFFSET to be the difference between the start of the first +overlay and point. This is equivalent to truncating our new +overlay, so that it doesn't intersect with overlays that already +exist." + (let* ((wnd (selected-window)) + (beg (point)) + (oov (delq nil + (mapcar + (lambda (o) + (and (eq (overlay-get o 'category) 'avy) + (eq (overlay-get o 'window) wnd) + (overlay-start o))) + (overlays-in beg (min (+ beg offset) lep)))))) + (when oov + (setq offset (- (apply #'min oov) beg)) + (setq str (substring str 0 offset))) + (let ((other-ov (cl-find-if + (lambda (o) + (and (eq (overlay-get o 'category) 'avy) + (eq (overlay-start o) beg) + (not (eq (overlay-get o 'window) wnd)))) + (overlays-in (point) (min (+ (point) offset) lep))))) + (when (and other-ov + (> (overlay-end other-ov) + (+ beg offset))) + (setq str (concat str (buffer-substring + (+ beg offset) + (overlay-end other-ov)))) + (setq offset (- (overlay-end other-ov) + beg)))) + (cons offset str))) + +(defun avy--style-fn (style) + "Transform STYLE symbol to a style function." + (cl-case style + (pre #'avy--overlay-pre) + (at #'avy--overlay-at) + (at-full 'avy--overlay-at-full) + (post #'avy--overlay-post) + (de-bruijn #'avy--overlay-at-full) + (t (error "Unexpected style %S" style)))) + +(defun avy--generic-jump (regex window-flip style &optional beg end) + "Jump to REGEX. +When WINDOW-FLIP is non-nil, do the opposite of `avy-all-windows'. +STYLE determines the leading char overlay style. +BEG and END delimit the area where candidates are searched." + (let ((avy-all-windows + (if window-flip + (not avy-all-windows) + avy-all-windows))) + (avy--process + (avy--regex-candidates regex beg end) + (avy--style-fn style)))) + +;;* Commands +;;;###autoload +(defun avy-goto-char (char &optional arg) + "Jump to the currently visible CHAR. +The window scope is determined by `avy-all-windows' (ARG negates it)." + (interactive (list (read-char "char: " t) + current-prefix-arg)) + (avy-with avy-goto-char + (avy--generic-jump + (if (= 13 char) + "\n" + (regexp-quote (string char))) + arg + avy-style))) + +;;;###autoload +(defun avy-goto-char-in-line (char) + "Jump to the currently visible CHAR in the current line." + (interactive (list (read-char "char: " t))) + (avy-with avy-goto-char + (avy--generic-jump + (regexp-quote (string char)) + avy-all-windows + avy-style + (line-beginning-position) + (line-end-position)))) + +;;;###autoload +(defun avy-goto-char-2 (char1 char2 &optional arg beg end) + "Jump to the currently visible CHAR1 followed by CHAR2. +The window scope is determined by `avy-all-windows' (ARG negates it)." + (interactive (list (read-char "char 1: " t) + (read-char "char 2: " t) + current-prefix-arg + nil nil)) + (when (eq char1 ? ) + (setq char1 ?\n)) + (when (eq char2 ? ) + (setq char2 ?\n)) + (avy-with avy-goto-char-2 + (avy--generic-jump + (regexp-quote (string char1 char2)) + arg + avy-style + beg end))) + +;;;###autoload +(defun avy-goto-char-2-above (char1 char2 &optional arg) + "Jump to the currently visible CHAR1 followed by CHAR2. +This is a scoped version of `avy-goto-char-2', where the scope is +the visible part of the current buffer up to point." + (interactive (list (read-char "char 1: " t) + (read-char "char 2: " t) + current-prefix-arg)) + (avy-with avy-goto-char-2-above + (avy-goto-char-2 + char1 char2 arg + (window-start) (point)))) + +;;;###autoload +(defun avy-goto-char-2-below (char1 char2 &optional arg) + "Jump to the currently visible CHAR1 followed by CHAR2. +This is a scoped version of `avy-goto-char-2', where the scope is +the visible part of the current buffer following point." + (interactive (list (read-char "char 1: " t) + (read-char "char 2: " t) + current-prefix-arg)) + (avy-with avy-goto-char-2-below + (avy-goto-char-2 + char1 char2 arg + (point) (window-end (selected-window) t)))) + +;;;###autoload +(defun avy-isearch () + "Jump to one of the current isearch candidates." + (interactive) + (avy-with avy-isearch + (let ((avy-background nil)) + (avy--process + (avy--regex-candidates (if isearch-regexp + isearch-string + (regexp-quote isearch-string))) + (avy--style-fn avy-style)) + (isearch-done)))) + +;;;###autoload +(defun avy-goto-word-0 (arg) + "Jump to a word start. +The window scope is determined by `avy-all-windows' (ARG negates it)." + (interactive "P") + (avy-with avy-goto-word-0 + (avy--generic-jump avy-goto-word-0-regexp arg avy-style))) + +;;;###autoload +(defun avy-goto-word-1 (char &optional arg beg end) + "Jump to the currently visible CHAR at a word start. +The window scope is determined by `avy-all-windows' (ARG negates it)." + (interactive (list (read-char "char: " t) + current-prefix-arg)) + (avy-with avy-goto-word-1 + (let* ((str (string char)) + (regex (cond ((string= str ".") + "\\.") + ((and avy-word-punc-regexp + (string-match avy-word-punc-regexp str)) + (regexp-quote str)) + (t + (concat + "\\b" + str))))) + (avy--generic-jump regex arg avy-style beg end)))) + +;;;###autoload +(defun avy-goto-word-1-above (char &optional arg) + "Jump to the currently visible CHAR at a word start. +This is a scoped version of `avy-goto-word-1', where the scope is +the visible part of the current buffer up to point. " + (interactive (list (read-char "char: " t) + current-prefix-arg)) + (avy-with avy-goto-word-1 + (avy-goto-word-1 char arg (window-start) (point)))) + +;;;###autoload +(defun avy-goto-word-1-below (char &optional arg) + "Jump to the currently visible CHAR at a word start. +This is a scoped version of `avy-goto-word-1', where the scope is +the visible part of the current buffer following point. " + (interactive (list (read-char "char: " t) + current-prefix-arg)) + (avy-with avy-goto-word-1 + (avy-goto-word-1 char arg (point) (window-end (selected-window) t)))) + +(declare-function subword-backward "subword") +(defvar subword-backward-regexp) + +(defcustom avy-subword-extra-word-chars '(?{ ?= ?} ?* ?: ?> ?<) + "A list of characters that should temporarily match \"\\w\". +This variable is used by `avy-goto-subword-0' and `avy-goto-subword-1'." + :type '(repeat character)) + +;;;###autoload +(defun avy-goto-subword-0 (&optional arg predicate) + "Jump to a word or subword start. + +The window scope is determined by `avy-all-windows' (ARG negates it). + +When PREDICATE is non-nil it's a function of zero parameters that +should return true." + (interactive "P") + (require 'subword) + (avy-with avy-goto-subword-0 + (let ((case-fold-search nil) + (subword-backward-regexp + "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([!-/:@`~[:upper:]]+\\W*\\)\\|\\W\\w+\\)") + candidates) + (avy-dowindows arg + (let ((syn-tbl (copy-syntax-table))) + (dolist (char avy-subword-extra-word-chars) + (modify-syntax-entry char "w" syn-tbl)) + (with-syntax-table syn-tbl + (let ((ws (window-start)) + window-cands) + (save-excursion + (goto-char (window-end (selected-window) t)) + (subword-backward) + (while (> (point) ws) + (when (or (null predicate) + (and predicate (funcall predicate))) + (unless (get-char-property (point) 'invisible) + (push (cons (point) (selected-window)) window-cands))) + (subword-backward)) + (and (= (point) ws) + (or (null predicate) + (and predicate (funcall predicate))) + (not (get-char-property (point) 'invisible)) + (push (cons (point) (selected-window)) window-cands))) + (setq candidates (nconc candidates window-cands)))))) + (avy--process candidates (avy--style-fn avy-style))))) + +;;;###autoload +(defun avy-goto-subword-1 (char &optional arg) + "Jump to the currently visible CHAR at a subword start. +The window scope is determined by `avy-all-windows' (ARG negates it). +The case of CHAR is ignored." + (interactive (list (read-char "char: " t) + current-prefix-arg)) + (avy-with avy-goto-subword-1 + (let ((char (downcase char))) + (avy-goto-subword-0 + arg (lambda () (eq (downcase (char-after)) char)))))) + +;;;###autoload +(defun avy-goto-word-or-subword-1 () + "Forward to `avy-goto-subword-1' or `avy-goto-word-1'. +Which one depends on variable `subword-mode'." + (interactive) + (if (bound-and-true-p subword-mode) + (call-interactively #'avy-goto-subword-1) + (call-interactively #'avy-goto-word-1))) + +(defvar visual-line-mode) + +(defun avy--line (&optional arg beg end) + "Select a line. +The window scope is determined by `avy-all-windows' (ARG negates it). +Narrow the scope to BEG END." + (let (candidates) + (avy-dowindows arg + (let ((ws (or beg (window-start)))) + (save-excursion + (save-restriction + (narrow-to-region ws (or end (window-end (selected-window) t))) + (goto-char (point-min)) + (while (< (point) (point-max)) + (unless (get-char-property + (max (1- (point)) ws) 'invisible) + (push (cons + (if (eq avy-style 'post) + (line-end-position) + (point)) + (selected-window)) candidates)) + (if visual-line-mode + (progn + (setq temporary-goal-column 0) + (line-move-visual 1 t)) + (forward-line 1))))))) + (let ((avy-action #'identity)) + (avy--process (nreverse candidates) (avy--style-fn avy-style))))) + +;;;###autoload +(defun avy-goto-line (&optional arg) + "Jump to a line start in current buffer. + +When ARG is 1, jump to lines currently visible, with the option +to cancel to `goto-line' by entering a number. + +When ARG is 4, negate the window scope determined by +`avy-all-windows'. + +Otherwise, forward to `goto-line' with ARG." + (interactive "p") + (setq arg (or arg 1)) + (if (not (memq arg '(1 4))) + (progn + (goto-char (point-min)) + (forward-line (1- arg))) + (avy-with avy-goto-line + (let* ((avy-handler-old avy-handler-function) + (avy-handler-function + (lambda (char) + (if (or (< char ?0) + (> char ?9)) + (funcall avy-handler-old char) + (let ((line (read-from-minibuffer + "Goto line: " (string char)))) + (when line + (avy-push-mark) + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- (string-to-number line)))) + (throw 'done 'exit)))))) + (r (avy--line (eq arg 4)))) + (unless (eq r t) + (avy-action-goto r)))))) + +;;;###autoload +(defun avy-goto-line-above () + "Goto visible line above the cursor." + (interactive) + (let* ((avy-all-windows nil) + (r (avy--line nil (window-start) + (line-beginning-position)))) + (unless (eq r t) + (avy-action-goto r)))) + +;;;###autoload +(defun avy-goto-line-below () + "Goto visible line below the cursor." + (interactive) + (let* ((avy-all-windows nil) + (r (avy--line + nil (line-beginning-position 2) + (window-end (selected-window) t)))) + (unless (eq r t) + (avy-action-goto r)))) + +(defcustom avy-line-insert-style 'above + "How to insert the newly copied/cut line." + :type '(choice + (const :tag "Above" above) + (const :tag "Below" below))) + +;;;###autoload +(defun avy-copy-line (arg) + "Copy a selected line above the current line. +ARG lines can be used." + (interactive "p") + (let ((initial-window (selected-window))) + (avy-with avy-copy-line + (let* ((start (avy--line)) + (str (buffer-substring-no-properties + start + (save-excursion + (goto-char start) + (move-end-of-line arg) + (point))))) + (select-window initial-window) + (cond ((eq avy-line-insert-style 'above) + (beginning-of-line) + (save-excursion + (insert str "\n"))) + ((eq avy-line-insert-style 'below) + (end-of-line) + (insert "\n" str) + (beginning-of-line)) + (t + (user-error "Unexpected `avy-line-insert-style'"))))))) + +;;;###autoload +(defun avy-move-line (arg) + "Move a selected line above the current line. +ARG lines can be used." + (interactive "p") + (let ((initial-window (selected-window))) + (avy-with avy-move-line + (let ((start (avy--line))) + (save-excursion + (goto-char start) + (kill-whole-line arg)) + (select-window initial-window) + (cond ((eq avy-line-insert-style 'above) + (beginning-of-line) + (save-excursion + (insert + (current-kill 0)))) + ((eq avy-line-insert-style 'below) + (end-of-line) + (newline) + (save-excursion + (insert (substring (current-kill 0) 0 -1)))) + (t + (user-error "Unexpected `avy-line-insert-style'"))))))) + +;;;###autoload +(defun avy-copy-region (arg) + "Select two lines and copy the text between them to point. + +The window scope is determined by `avy-all-windows' or +`avy-all-windows-alt' when ARG is non-nil." + (interactive "P") + (let ((initial-window (selected-window))) + (avy-with avy-copy-region + (let* ((beg (save-selected-window + (avy--line arg))) + (end (avy--line arg)) + (str (buffer-substring-no-properties + beg + (save-excursion + (goto-char end) + (line-end-position))))) + (select-window initial-window) + (cond ((eq avy-line-insert-style 'above) + (beginning-of-line) + (save-excursion + (insert str "\n"))) + ((eq avy-line-insert-style 'below) + (end-of-line) + (newline) + (save-excursion + (insert str))) + (t + (user-error "Unexpected `avy-line-insert-style'"))))))) + +;;;###autoload +(defun avy-move-region () + "Select two lines and move the text between them here." + (interactive) + (avy-with avy-move-region + (let* ((beg (avy--line)) + (end (save-excursion + (goto-char (avy--line)) + (forward-line) + (point))) + (text (buffer-substring beg end)) + (pad (if (bolp) "" "\n"))) + (move-beginning-of-line nil) + (delete-region beg end) + (insert text pad)))) + +;;;###autoload +(defun avy-setup-default () + "Setup the default shortcuts." + (eval-after-load "isearch" + '(define-key isearch-mode-map (kbd "C-'") 'avy-isearch))) + +(defcustom avy-timeout-seconds 0.5 + "How many seconds to wait for the second char." + :type 'float) + +(defun avy--read-candidates () + "Read as many chars as possible and return their occurences. +At least one char must be read, and then repeatedly one next char +may be read if it is entered before `avy-timeout-seconds'. `DEL' +deletes the last char entered, and `RET' exits with the currently +read string immediately instead of waiting for another char for +`avy-timeout-seconds'. +The format of the result is the same as that of `avy--regex-candidates'. +This function obeys `avy-all-windows' setting." + (let ((str "") char break overlays regex) + (unwind-protect + (progn + (while (and (not break) + (setq char + (read-char (format "char%s: " + (if (string= str "") + str + (format " (%s)" str))) + t + (and (not (string= str "")) + avy-timeout-seconds)))) + ;; Unhighlight + (dolist (ov overlays) + (delete-overlay ov)) + (setq overlays nil) + (cond + ;; Handle RET + ((= char 13) + (setq break t)) + ;; Handle DEL + ((= char 127) + (let ((l (length str))) + (when (>= l 1) + (setq str (substring str 0 (1- l)))))) + (t + (setq str (concat str (list char))))) + ;; Highlight + (when (>= (length str) 1) + (let ((case-fold-search + (or avy-case-fold-search (string= str (downcase str)))) + found) + (avy-dowindows current-prefix-arg + (dolist (pair (avy--find-visible-regions + (window-start) + (window-end (selected-window) t))) + (save-excursion + (goto-char (car pair)) + (setq regex (regexp-quote str)) + (while (re-search-forward regex (cdr pair) t) + (unless (get-char-property (1- (point)) 'invisible) + (let ((ov (make-overlay + (match-beginning 0) + (match-end 0)))) + (setq found t) + (push ov overlays) + (overlay-put + ov 'window (selected-window)) + (overlay-put + ov 'face 'avy-goto-char-timer-face))))))) + ;; No matches at all, so there's surely a typo in the input. + (unless found (beep))))) + (nreverse (mapcar (lambda (ov) + (cons (cons (overlay-start ov) + (overlay-end ov)) + (overlay-get ov 'window))) + overlays))) + (dolist (ov overlays) + (delete-overlay ov))))) + +;;;###autoload +(defun avy-goto-char-timer (&optional arg) + "Read one or many consecutive chars and jump to the first one. +The window scope is determined by `avy-all-windows' (ARG negates it)." + (interactive "P") + (let ((avy-all-windows (if arg + (not avy-all-windows) + avy-all-windows))) + (avy-with avy-goto-char-timer + (avy--process + (avy--read-candidates) + (avy--style-fn avy-style))))) + +(defun avy-push-mark () + "Store the current point and window." + (ring-insert avy-ring + (cons (point) (selected-window))) + (unless (region-active-p) + (push-mark))) + +(defun avy-pop-mark () + "Jump back to the last location of `avy-push-mark'." + (interactive) + (let (res) + (condition-case nil + (progn + (while (not (window-live-p + (cdr (setq res (ring-remove avy-ring 0)))))) + (let* ((window (cdr res)) + (frame (window-frame window))) + (when (and (frame-live-p frame) + (not (eq frame (selected-frame)))) + (select-frame-set-input-focus frame)) + (select-window window) + (goto-char (car res)))) + (error + (set-mark-command 4))))) + +(provide 'avy) + +;;; avy.el ends here diff --git a/site-lisp/bind-key.el b/site-lisp/bind-key.el new file mode 100644 index 0000000..d907798 --- /dev/null +++ b/site-lisp/bind-key.el @@ -0,0 +1,416 @@ +;;; bind-key.el --- A simple way to manage personal keybindings + +;; Copyright (c) 2012-2015 john wiegley + +;; Author: John Wiegley +;; Maintainer: John Wiegley +;; Created: 16 Jun 2012 +;; Version: 1.0 +;; Keywords: keys keybinding config dotemacs +;; URL: https://github.com/jwiegley/use-package + +;; 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 2, 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; see the file copying. if not, write to the +;; free software foundation, inc., 59 temple place - suite 330, +;; boston, ma 02111-1307, usa. + +;;; Commentary: + +;; If you have lots of keybindings set in your .emacs file, it can be hard to +;; know which ones you haven't set yet, and which may now be overriding some +;; new default in a new emacs version. This module aims to solve that +;; problem. +;; +;; Bind keys as follows in your .emacs: +;; +;; (require 'bind-key) +;; +;; (bind-key "C-c x" 'my-ctrl-c-x-command) +;; +;; If you want the keybinding to override all minor modes that may also bind +;; the same key, use the `bind-key*' form: +;; +;; (bind-key* "" 'other-window) +;; +;; If you want to rebind a key only in a particular keymap, use: +;; +;; (bind-key "C-c x" 'my-ctrl-c-x-command some-other-mode-map) +;; +;; To unbind a key within a keymap (for example, to stop your favorite major +;; mode from changing a binding that you don't want to override everywhere), +;; use `unbind-key': +;; +;; (unbind-key "C-c x" some-other-mode-map) +;; +;; To bind multiple keys at once, or set up a prefix map, a `bind-keys' macro +;; is provided. It accepts keyword arguments, please see its documentation +;; for a detailed description. +;; +;; To add keys into a specific map, use :map argument +;; +;; (bind-keys :map dired-mode-map +;; ("o" . dired-omit-mode) +;; ("a" . some-custom-dired-function)) +;; +;; To set up a prefix map, use `:prefix-map' and `:prefix' arguments (both are +;; required) +;; +;; (bind-keys :prefix-map my-customize-prefix-map +;; :prefix "C-c c" +;; ("f" . customize-face) +;; ("v" . customize-variable)) +;; +;; You can combine all the keywords together. Additionally, +;; `:prefix-docstring' can be specified to set documentation of created +;; `:prefix-map' variable. +;; +;; To bind multiple keys in a `bind-key*' way (to be sure that your bindings +;; will not be overridden by other modes), you may use `bind-keys*' macro: +;; +;; (bind-keys* +;; ("C-o" . other-window) +;; ("C-M-n" . forward-page) +;; ("C-M-p" . backward-page)) +;; +;; After Emacs loads, you can see a summary of all your personal keybindings +;; currently in effect with this command: +;; +;; M-x describe-personal-keybindings +;; +;; This display will tell you if you've overriden a default keybinding, and +;; what the default was. Also, it will tell you if the key was rebound after +;; your binding it with `bind-key', and what it was rebound it to. + +;;; Code: + +(require 'cl-lib) +(require 'easy-mmode) + +(defgroup bind-key nil + "A simple way to manage personal keybindings" + :group 'emacs) + +(defcustom bind-key-column-widths '(18 . 40) + "Width of columns in `describe-personal-keybindings'." + :type '(cons integer integer) + :group 'bind-key) + +(defcustom bind-key-segregation-regexp + "\\`\\(\\(C-[chx] \\|M-[gso] \\)\\([CM]-\\)?\\|.+-\\)" + "Regular expression used to divide key sets in the output from +\\[describe-personal-keybindings]." + :type 'regexp + :group 'bind-key) + +(defcustom bind-key-describe-special-forms nil + "If non-nil, extract docstrings from lambdas, closures and keymaps if possible." + :type 'boolean + :group 'bind-key) + +;; Create override-global-mode to force key remappings + +(defvar override-global-map (make-keymap) + "override-global-mode keymap") + +(define-minor-mode override-global-mode + "A minor mode so that keymap settings override other modes." + t "") + +;; the keymaps in `emulation-mode-map-alists' take precedence over +;; `minor-mode-map-alist' +(add-to-list 'emulation-mode-map-alists + `((override-global-mode . ,override-global-map))) + +(defvar personal-keybindings nil + "List of bindings performed by `bind-key'. + +Elements have the form ((KEY . [MAP]) CMD ORIGINAL-CMD)") + +;;;###autoload +(defmacro bind-key (key-name command &optional keymap predicate) + "Bind KEY-NAME to COMMAND in KEYMAP (`global-map' if not passed). + +KEY-NAME may be a vector, in which case it is passed straight to +`define-key'. Or it may be a string to be interpreted as +spelled-out keystrokes, e.g., \"C-c C-z\". See documentation of +`edmacro-mode' for details. + +If PREDICATE is non-nil, it is a form evaluated to determine when +a key should be bound. It must return non-nil in such cases. +Emacs can evaluate this form at any time that it does redisplay +or operates on menu data structures, so you should write it so it +can safely be called at any time." + (let ((namevar (make-symbol "name")) + (keyvar (make-symbol "key")) + (kdescvar (make-symbol "kdesc")) + (bindingvar (make-symbol "binding"))) + `(let* ((,namevar ,key-name) + (,keyvar (if (vectorp ,namevar) ,namevar + (read-kbd-macro ,namevar))) + (,kdescvar (cons (if (stringp ,namevar) ,namevar + (key-description ,namevar)) + (quote ,keymap))) + (,bindingvar (lookup-key (or ,keymap global-map) ,keyvar))) + (add-to-list 'personal-keybindings + (list ,kdescvar ,command + (unless (numberp ,bindingvar) ,bindingvar))) + ,(if predicate + `(define-key (or ,keymap global-map) ,keyvar + '(menu-item "" nil :filter (lambda (&optional _) + (when ,predicate + ,command)))) + `(define-key (or ,keymap global-map) ,keyvar ,command))))) + +;;;###autoload +(defmacro unbind-key (key-name &optional keymap) + "Unbind the given KEY-NAME, within the KEYMAP (if specified). +See `bind-key' for more details." + `(progn + (bind-key ,key-name nil ,keymap) + (setq personal-keybindings + (cl-delete-if #'(lambda (k) + ,(if keymap + `(and (consp (car k)) + (string= (caar k) ,key-name) + (eq (cdar k) ',keymap)) + `(and (stringp (car k)) + (string= (car k) ,key-name)))) + personal-keybindings)))) + +;;;###autoload +(defmacro bind-key* (key-name command &optional predicate) + "Similar to `bind-key', but overrides any mode-specific bindings." + `(bind-key ,key-name ,command override-global-map ,predicate)) + +(defun bind-keys-form (args) + "Bind multiple keys at once. + +Accepts keyword arguments: +:map MAP - a keymap into which the keybindings should be + added +:prefix KEY - prefix key for these bindings +:prefix-map MAP - name of the prefix map that should be created + for these bindings +:prefix-docstring STR - docstring for the prefix-map variable +:menu-name NAME - optional menu string for prefix map +:filter FORM - optional form to determine when bindings apply + +The rest of the arguments are conses of keybinding string and a +function symbol (unquoted)." + ;; jww (2016-02-26): This is a hack; this whole function needs to be + ;; rewritten to normalize arguments the way that use-package.el does. + (if (and (eq (car args) :package) + (not (eq (car (cdr (cdr args))) :map))) + (setq args (cons :map (cons 'global-map args)))) + (let* ((map (plist-get args :map)) + (doc (plist-get args :prefix-docstring)) + (prefix-map (plist-get args :prefix-map)) + (prefix (plist-get args :prefix)) + (filter (plist-get args :filter)) + (menu-name (plist-get args :menu-name)) + (pkg (plist-get args :package)) + (key-bindings (progn + (while (keywordp (car args)) + (pop args) + (pop args)) + args))) + (when (or (and prefix-map (not prefix)) + (and prefix (not prefix-map))) + (error "Both :prefix-map and :prefix must be supplied")) + (when (and menu-name (not prefix)) + (error "If :menu-name is supplied, :prefix must be too")) + (let ((args key-bindings) + saw-map first next) + (while args + (if (keywordp (car args)) + (progn + (setq next args) + (setq args nil)) + (if first + (nconc first (list (car args))) + (setq first (list (car args)))) + (setq args (cdr args)))) + (cl-flet + ((wrap (map bindings) + (if (and map pkg (not (eq map 'global-map))) + `((if (boundp ',map) + (progn ,@bindings) + (eval-after-load + ,(if (symbolp pkg) `',pkg pkg) + '(progn ,@bindings)))) + bindings))) + (append + (when prefix-map + `((defvar ,prefix-map) + ,@(when doc `((put ',prefix-map 'variable-documentation ,doc))) + ,@(if menu-name + `((define-prefix-command ',prefix-map nil ,menu-name)) + `((define-prefix-command ',prefix-map))) + ,@(if (and map (not (eq map 'global-map))) + (wrap map `((bind-key ,prefix ',prefix-map ,map ,filter))) + `((bind-key ,prefix ',prefix-map nil ,filter))))) + (wrap map + (cl-mapcan + (lambda (form) + (if prefix-map + `((bind-key ,(car form) ',(cdr form) ,prefix-map ,filter)) + (if (and map (not (eq map 'global-map))) + `((bind-key ,(car form) ',(cdr form) ,map ,filter)) + `((bind-key ,(car form) ',(cdr form) nil ,filter))))) + first)) + (when next + (bind-keys-form + (if pkg + (cons :package (cons pkg next)) + next)))))))) + +;;;###autoload +(defmacro bind-keys (&rest args) + "Bind multiple keys at once. + +Accepts keyword arguments: +:map MAP - a keymap into which the keybindings should be + added +:prefix KEY - prefix key for these bindings +:prefix-map MAP - name of the prefix map that should be created + for these bindings +:prefix-docstring STR - docstring for the prefix-map variable +:menu-name NAME - optional menu string for prefix map +:filter FORM - optional form to determine when bindings apply + +The rest of the arguments are conses of keybinding string and a +function symbol (unquoted)." + (macroexp-progn (bind-keys-form args))) + +;;;###autoload +(defmacro bind-keys* (&rest args) + (macroexp-progn + (bind-keys-form `(:map override-global-map ,@args)))) + +(defun get-binding-description (elem) + (cond + ((listp elem) + (cond + ((eq 'lambda (car elem)) + (if (and bind-key-describe-special-forms + (stringp (nth 2 elem))) + (nth 2 elem) + "#")) + ((eq 'closure (car elem)) + (if (and bind-key-describe-special-forms + (stringp (nth 3 elem))) + (nth 3 elem) + "#")) + ((eq 'keymap (car elem)) + "#") + (t + elem))) + ;; must be a symbol, non-symbol keymap case covered above + ((and bind-key-describe-special-forms (keymapp elem)) + (let ((doc (get elem 'variable-documentation))) + (if (stringp doc) doc elem))) + ((symbolp elem) + elem) + (t + "#"))) + +(defun compare-keybindings (l r) + (let* ((regex bind-key-segregation-regexp) + (lgroup (and (string-match regex (caar l)) + (match-string 0 (caar l)))) + (rgroup (and (string-match regex (caar r)) + (match-string 0 (caar r)))) + (lkeymap (cdar l)) + (rkeymap (cdar r))) + (cond + ((and (null lkeymap) rkeymap) + (cons t t)) + ((and lkeymap (null rkeymap)) + (cons nil t)) + ((and lkeymap rkeymap + (not (string= (symbol-name lkeymap) (symbol-name rkeymap)))) + (cons (string< (symbol-name lkeymap) (symbol-name rkeymap)) t)) + ((and (null lgroup) rgroup) + (cons t t)) + ((and lgroup (null rgroup)) + (cons nil t)) + ((and lgroup rgroup) + (if (string= lgroup rgroup) + (cons (string< (caar l) (caar r)) nil) + (cons (string< lgroup rgroup) t))) + (t + (cons (string< (caar l) (caar r)) nil))))) + +;;;###autoload +(defun describe-personal-keybindings () + "Display all the personal keybindings defined by `bind-key'." + (interactive) + (with-output-to-temp-buffer "*Personal Keybindings*" + (princ (format (concat "Key name%s Command%s Comments\n%s %s " + "---------------------\n") + (make-string (- (car bind-key-column-widths) 9) ? ) + (make-string (- (cdr bind-key-column-widths) 8) ? ) + (make-string (1- (car bind-key-column-widths)) ?-) + (make-string (1- (cdr bind-key-column-widths)) ?-))) + (let (last-binding) + (dolist (binding + (setq personal-keybindings + (sort personal-keybindings + (lambda (l r) + (car (compare-keybindings l r)))))) + + (if (not (eq (cdar last-binding) (cdar binding))) + (princ (format "\n\n%s\n%s\n\n" + (cdar binding) + (make-string (+ 21 (car bind-key-column-widths) + (cdr bind-key-column-widths)) ?-))) + (if (and last-binding + (cdr (compare-keybindings last-binding binding))) + (princ "\n"))) + + (let* ((key-name (caar binding)) + (at-present (lookup-key (or (symbol-value (cdar binding)) + (current-global-map)) + (read-kbd-macro key-name))) + (command (nth 1 binding)) + (was-command (nth 2 binding)) + (command-desc (get-binding-description command)) + (was-command-desc (and was-command + (get-binding-description was-command))) + (at-present-desc (get-binding-description at-present)) + ) + (let ((line + (format + (format "%%-%ds%%-%ds%%s\n" (car bind-key-column-widths) + (cdr bind-key-column-widths)) + key-name (format "`%s\'" command-desc) + (if (string= command-desc at-present-desc) + (if (or (null was-command) + (string= command-desc was-command-desc)) + "" + (format "was `%s\'" was-command-desc)) + (format "[now: `%s\']" at-present))))) + (princ (if (string-match "[ \t]+\n" line) + (replace-match "\n" t t line) + line)))) + + (setq last-binding binding))))) + +(provide 'bind-key) + +;; Local Variables: +;; outline-regexp: ";;;\\(;* [^\s\t\n]\\|###autoload\\)\\|(" +;; indent-tabs-mode: nil +;; End: + +;;; bind-key.el ends here diff --git a/site-lisp/boxquote.el b/site-lisp/boxquote.el new file mode 100644 index 0000000..31c4cf0 --- /dev/null +++ b/site-lisp/boxquote.el @@ -0,0 +1,585 @@ +;;; boxquote.el --- Quote text with a semi-box. +;; Copyright 1999-2009 by Dave Pearson +;; $Revision: 1.23 $ + +;; boxquote.el is free software distributed under the terms of the GNU +;; General Public Licence, version 2 or (at your option) any later version. +;; For details see the file COPYING. + +;;; Commentary: + +;; boxquote provides a set of functions for using a text quoting style that +;; partially boxes in the left hand side of an area of text, such a marking +;; style might be used to show externally included text or example code. +;; +;; ,---- +;; | The default style looks like this. +;; `---- +;; +;; A number of functions are provided for quoting a region, a buffer, a +;; paragraph and a defun. There are also functions for quoting text while +;; pulling it in, either by inserting the contents of another file or by +;; yanking text into the current buffer. +;; +;; The latest version of boxquote.el can be found at: +;; +;; + +;;; Thanks: + +;; Kai Grossjohann for inspiring the idea of boxquote. I wrote this code to +;; mimic the "inclusion quoting" style in his Usenet posts. I could have +;; hassled him for his code but it was far more fun to write it myself. +;; +;; Mark Milhollan for providing a patch that helped me get the help quoting +;; functions working with XEmacs. +;; +;; Oliver Much for suggesting the idea of having a `boxquote-kill-ring-save' +;; function. +;; +;; Reiner Steib for suggesting `boxquote-where-is' and the idea of letting +;; `boxquote-describe-key' describe key bindings from other buffers. Also +;; thanks go to Reiner for suggesting `boxquote-insert-buffer'. + +;;; Code: + +;; Things we need: + +(eval-when-compile + (require 'cl)) +(require 'rect) + +;; Attempt to handle older/other emacs. +(eval-and-compile + + ;; If customize isn't available just use defvar instead. + (unless (fboundp 'defgroup) + (defmacro defgroup (&rest rest) nil) + (defmacro defcustom (symbol init docstring &rest rest) + `(defvar ,symbol ,init ,docstring))) + + ;; If `line-beginning-position' isn't available provide one. + (unless (fboundp 'line-beginning-position) + (defun line-beginning-position (&optional n) + "Return the `point' of the beginning of the current line." + (save-excursion + (beginning-of-line n) + (point)))) + + ;; If `line-end-position' isn't available provide one. + (unless (fboundp 'line-end-position) + (defun line-end-position (&optional n) + "Return the `point' of the end of the current line." + (save-excursion + (end-of-line n) + (point))))) + +;; Customize options. + +(defgroup boxquote nil + "Mark regions of text with a half-box." + :group 'editing + :prefix "boxquote-") + +(defcustom boxquote-top-and-tail "----" + "*Text that will be used at the top and tail of the box." + :type 'string + :group 'boxquote) + +(defcustom boxquote-top-corner "," + "*Text used for the top corner of the box." + :type 'string + :group 'boxquote) + +(defcustom boxquote-bottom-corner "`" + "*Text used for the bottom corner of the box." + :type 'string + :group 'boxquote) + +(defcustom boxquote-side "| " + "*Text used for the side of the box." + :type 'string + :group 'boxquote) + +(defcustom boxquote-title-format "[ %s ]" + "*Format string to use when creating a box title." + :type 'string + :group 'boxquote) + +(defcustom boxquote-title-files t + "*Should a `boxquote-insert-file' title the box with the file name?" + :type '(choice + (const :tag "Title the box with the file name" t) + (const :tag "Don't title the box with the file name" nil)) + :group 'boxquote) + +(defcustom boxquote-file-title-function #'file-name-nondirectory + "*Function to apply to a file's name when using it to title a box." + :type 'function + :group 'boxquote) + +(defcustom boxquote-title-buffers t + "*Should a `boxquote-insert-buffer' title the box with the buffer name?" + :type '(choice + (const :tag "Title the box with the buffer name" t) + (const :tag "Don't title the box with the buffer name" nil)) + :group 'boxquote) + +(defcustom boxquote-buffer-title-function #'identity + "*Function to apply to a buffer's name when using it to title a box." + :type 'function + :group 'boxquote) + +(defcustom boxquote-region-hook nil + "*Hooks to perform when on a region prior to boxquoting. + +Note that all forms of boxquoting use `boxquote-region' to create the +boxquote. Because of this any hook you place here will be invoked by any of +the boxquoting functions." + :type 'hook + :group 'boxquote) + +(defcustom boxquote-yank-hook nil + "*Hooks to perform on the yanked text prior to boxquoting." + :type 'hook + :group 'boxquote) + +(defcustom boxquote-insert-file-hook nil + "*Hooks to perform on the text from an inserted file prior to boxquoting." + :type 'hook + :group 'boxquote) + +(defcustom boxquote-kill-ring-save-title #'buffer-name + "*Function for working out the title for a `boxquote-kill-ring-save'. + +The string returned from this function will be used as the title for a +boxquote when the saved text is yanked into a buffer with \\[boxquote-yank]. + +An example of a non-trivial value for this variable might be: + + (lambda () + (if (string= mode-name \"Article\") + (aref gnus-current-headers 4) + (buffer-name))) + +In this case, if you are a `gnus' user, \\[boxquote-kill-ring-save] could be +used to copy text from an article buffer and, when it is yanked into another +buffer using \\[boxquote-yank], the title of the boxquote would be the ID of +the article you'd copied the text from." + :type 'function + :group 'boxquote) + +(defcustom boxquote-describe-function-title-format "C-h f %s RET" + "*Format string to use when formatting a function description box title" + :type 'string + :group 'boxquote) + +(defcustom boxquote-describe-variable-title-format "C-h v %s RET" + "*Format string to use when formatting a variable description box title" + :type 'string + :group 'boxquote) + +(defcustom boxquote-describe-key-title-format "C-h k %s" + "*Format string to use when formatting a key description box title" + :type 'string + :group 'boxquote) + +(defcustom boxquote-where-is-title-format "C-h w %s RET" + "*Format string to use when formatting a `where-is' description box title" + :type 'string + :group 'boxquote) + +(defcustom boxquote-where-is-body-format "%s is on %s" + "*Format string to use when formatting a `where-is' description." + :type 'string + :group 'boxquote) + +;; Main code: + +(defun boxquote-xemacs-p () + "Are we running in XEmacs?" + (and (boundp 'running-xemacs) (symbol-value 'running-xemacs))) + +(defun boxquote-points () + "Find the start and end points of a boxquote. + +If `point' is inside a boxquote then a cons is returned, the `car' is the +start `point' and the `cdr' is the end `point'. NIL is returned if no +boxquote is found." + (save-excursion + (beginning-of-line) + (let* ((re-top (concat "^" (regexp-quote boxquote-top-corner) + (regexp-quote boxquote-top-and-tail))) + (re-left (concat "^" (regexp-quote boxquote-side))) + (re-bottom (concat "^" (regexp-quote boxquote-bottom-corner) + (regexp-quote boxquote-top-and-tail))) + (points + (cl-flet ((find-box-end (re &optional back) + (save-excursion + (when (if back + (search-backward-regexp re nil t) + (search-forward-regexp re nil t)) + (point))))) + (cond ((looking-at re-top) + (cons (point) (find-box-end re-bottom))) + ((looking-at re-left) + (cons (find-box-end re-top t) (find-box-end re-bottom))) + ((looking-at re-bottom) + (cons (find-box-end re-top t) (line-end-position))))))) + (when (and (car points) (cdr points)) + points)))) + +(defun boxquote-quoted-p () + "Is `point' inside a boxquote?" + (not (null (boxquote-points)))) + +(defun boxquote-points-with-check () + "Get the `boxquote-points' and flag an error of no box was found." + (or (boxquote-points) (error "I can't see a box here"))) + +(defun boxquote-title-format-as-regexp () + "Return a regular expression to match the title." + (with-temp-buffer + (insert (regexp-quote boxquote-title-format)) + (setf (point) (point-min)) + (when (search-forward "%s" nil t) + (replace-match ".*" nil t)) + (buffer-string))) + +(defun boxquote-get-title () + "Get the title for the current boxquote." + (multiple-value-bind (prefix-len suffix-len) + (with-temp-buffer + (let ((look-for "%s")) + (insert boxquote-title-format) + (setf (point) (point-min)) + (search-forward look-for) + (list (- (point) (length look-for) 1) (- (point-max) (point))))) + (save-excursion + (save-restriction + (boxquote-narrow-to-boxquote) + (setf (point) (+ (point-min) + (length (concat boxquote-top-corner + boxquote-top-and-tail)))) + (if (looking-at (boxquote-title-format-as-regexp)) + (buffer-substring-no-properties (+ (point) prefix-len) + (- (line-end-position) suffix-len)) + ""))))) + +;;;###autoload +(defun boxquote-title (title) + "Set the title of the current boxquote to TITLE. + +If TITLE is an empty string the title is removed. Note that the title will +be formatted using `boxquote-title-format'." + (interactive (list (read-from-minibuffer "Title: " (boxquote-get-title)))) + (save-excursion + (save-restriction + (boxquote-narrow-to-boxquote) + (setf (point) (+ (point-min) + (length (concat boxquote-top-corner + boxquote-top-and-tail)))) + (unless (eolp) + (kill-line)) + (unless (zerop (length title)) + (insert (format boxquote-title-format title)))))) + +;;;###autoload +(defun boxquote-region (start end) + "Draw a box around the left hand side of a region bounding START and END." + (interactive "r") + (save-excursion + (save-restriction + (cl-flet ((bol-at-p (n) + (setf (point) n) + (bolp)) + (insert-corner (corner pre-break) + (insert (concat (if pre-break "\n" "") + corner boxquote-top-and-tail "\n")))) + (let ((break-start (not (bol-at-p start))) + (break-end (not (bol-at-p end)))) + (narrow-to-region start end) + (run-hooks 'boxquote-region-hook) + (setf (point) (point-min)) + (insert-corner boxquote-top-corner break-start) + (let ((start-point (line-beginning-position))) + (setf (point) (point-max)) + (insert-corner boxquote-bottom-corner break-end) + (string-rectangle start-point + (progn + (setf (point) (point-max)) + (forward-line -2) + (line-beginning-position)) + boxquote-side))))))) + +;;;###autoload +(defun boxquote-buffer () + "Apply `boxquote-region' to a whole buffer." + (interactive) + (boxquote-region (point-min) (point-max))) + +;;;###autoload +(defun boxquote-insert-file (filename) + "Insert the contents of a file, boxed with `boxquote-region'. + +If `boxquote-title-files' is non-nil the boxquote will be given a title that +is the result of applying `boxquote-file-title-function' to FILENAME." + (interactive "fInsert file: ") + (insert (with-temp-buffer + (insert-file-contents filename nil) + (run-hooks 'boxquote-insert-file-hook) + (boxquote-buffer) + (when boxquote-title-files + (boxquote-title (funcall boxquote-file-title-function filename))) + (buffer-string)))) + +;;;###autoload +(defun boxquote-insert-buffer (buffer) + "Insert the contents of a buffer, boxes with `boxquote-region'. + +If `boxquote-title-buffers' is non-nil the boxquote will be given a title that +is the result of applying `boxquote-buffer-title-function' to BUFFER." + (interactive "bInsert Buffer: ") + (boxquote-text + (with-current-buffer buffer + (buffer-substring-no-properties (point-min) (point-max)))) + (when boxquote-title-buffers + (boxquote-title (funcall boxquote-buffer-title-function buffer)))) + +;;;###autoload +(defun boxquote-kill-ring-save () + "Like `kill-ring-save' but remembers a title if possible. + +The title is acquired by calling `boxquote-kill-ring-save-title'. The title +will be used by `boxquote-yank'." + (interactive) + (call-interactively #'kill-ring-save) + (setf (car kill-ring-yank-pointer) + (format "%S" (list + 'boxquote-yank-marker + (funcall boxquote-kill-ring-save-title) + (car kill-ring-yank-pointer))))) + +;;;###autoload +(defun boxquote-yank () + "Do a `yank' and box it in with `boxquote-region'. + +If the yanked entry was placed on the kill ring with +`boxquote-kill-ring-save' the resulting boxquote will be titled with +whatever `boxquote-kill-ring-save-title' returned at the time." + (interactive) + (save-excursion + (insert (with-temp-buffer + (yank) + (setf (point) (point-min)) + (let ((title + (let ((yanked (condition-case nil + (read (current-buffer)) + (error nil)))) + (when (listp yanked) + (when (eq (car yanked) 'boxquote-yank-marker) + (setf (buffer-string) (nth 2 yanked)) + (nth 1 yanked)))))) + (run-hooks 'boxquote-yank-hook) + (boxquote-buffer) + (when title + (boxquote-title title)) + (buffer-string)))))) + +;;;###autoload +(defun boxquote-defun () + "Apply `boxquote-region' the current defun." + (interactive) + (mark-defun) + (boxquote-region (region-beginning) (region-end))) + +;;;###autoload +(defun boxquote-paragraph () + "Apply `boxquote-region' to the current paragraph." + (interactive) + (mark-paragraph) + (boxquote-region (region-beginning) (region-end))) + +;;;###autoload +(defun boxquote-boxquote () + "Apply `boxquote-region' to the current boxquote." + (interactive) + (let ((box (boxquote-points-with-check))) + (boxquote-region (car box) (1+ (cdr box))))) + +(defun boxquote-help-buffer-name (item) + "Return the name of the help buffer associated with ITEM." + (if (boxquote-xemacs-p) + (loop for buffer in (symbol-value 'help-buffer-list) + when (string-match (concat "^*Help:.*`" item "'") buffer) + return buffer) + "*Help*")) + +(defun boxquote-quote-help-buffer (help-call title-format item) + "Perform a help command and boxquote the output. + +HELP-CALL is a function that calls the help command. + +TITLE-FORMAT is the `format' string to use to product the boxquote title. + +ITEM is a function for retrieving the item to get help on." + (let ((one-window-p (one-window-p))) + (boxquote-text + (save-window-excursion + (funcall help-call) + (with-current-buffer (boxquote-help-buffer-name (funcall item)) + (buffer-substring-no-properties (point-min) (point-max))))) + (boxquote-title (format title-format (funcall item))) + (when one-window-p + (delete-other-windows)))) + +;;;###autoload +(defun boxquote-describe-function () + "Call `describe-function' and boxquote the output into the current buffer." + (interactive) + (boxquote-quote-help-buffer + #'(lambda () + (call-interactively #'describe-function)) + boxquote-describe-function-title-format + #'(lambda () + (car (if (boxquote-xemacs-p) + (symbol-value 'function-history) + minibuffer-history))))) + +;;;###autoload +(defun boxquote-describe-variable () + "Call `describe-variable' and boxquote the output into the current buffer." + (interactive) + (boxquote-quote-help-buffer + #'(lambda () + (call-interactively #'describe-variable)) + boxquote-describe-variable-title-format + #'(lambda () + (car (if (boxquote-xemacs-p) + (symbol-value 'variable-history) + minibuffer-history))))) + +;;;###autoload +(defun boxquote-describe-key (key) + "Call `describe-key' and boxquote the output into the current buffer. + +If the call to this command is prefixed with \\[universal-argument] you will also be +prompted for a buffer. The key defintion used will be taken from that buffer." + (interactive "kDescribe key: ") + (let ((from-buffer (if current-prefix-arg + (read-buffer "Buffer: " (current-buffer) t) + (current-buffer)))) + (let ((binding + (with-current-buffer from-buffer + (key-binding key)))) + (if (or (null binding) (integerp binding)) + (message "%s is undefined" (with-current-buffer from-buffer + (key-description key))) + (boxquote-quote-help-buffer + #'(lambda () + (with-current-buffer from-buffer + (describe-key key))) + boxquote-describe-key-title-format + #'(lambda () + (with-current-buffer from-buffer + (key-description key)))))))) + +;;;###autoload +(defun boxquote-shell-command (command) + "Call `shell-command' with COMMAND and boxquote the output." + (interactive (list (read-from-minibuffer "Shell command: " nil nil nil 'shell-command-history))) + (boxquote-text (with-temp-buffer + (shell-command command t) + (buffer-string))) + (boxquote-title command)) + +;;;###autoload +(defun boxquote-where-is (definition) + "Call `where-is' with DEFINITION and boxquote the result." + (interactive "CCommand: ") + (boxquote-text (with-temp-buffer + (where-is definition t) + (format boxquote-where-is-body-format definition (buffer-string)))) + (boxquote-title (format boxquote-where-is-title-format definition))) + +;;;###autoload +(defun boxquote-text (text) + "Insert TEXT, boxquoted." + (interactive "sText: ") + (save-excursion + (unless (bolp) + (insert "\n")) + (insert + (with-temp-buffer + (insert text) + (boxquote-buffer) + (buffer-string))))) + +;;;###autoload +(defun boxquote-narrow-to-boxquote () + "Narrow the buffer to the current boxquote." + (interactive) + (let ((box (boxquote-points-with-check))) + (narrow-to-region (car box) (cdr box)))) + +;;;###autoload +(defun boxquote-narrow-to-boxquote-content () + "Narrow the buffer to the content of the current boxquote." + (interactive) + (let ((box (boxquote-points-with-check))) + (narrow-to-region (save-excursion + (setf (point) (car box)) + (forward-line 1) + (point)) + (save-excursion + (setf (point) (cdr box)) + (line-beginning-position))))) + +;;;###autoload +(defun boxquote-kill () + "Kill the boxquote and its contents." + (interactive) + (let ((box (boxquote-points-with-check))) + (kill-region (car box) (1+ (cdr box))))) + +;;;###autoload +(defun boxquote-fill-paragraph (arg) + "Perform a `fill-paragraph' inside a boxquote." + (interactive "P") + (if (boxquote-quoted-p) + (save-restriction + (boxquote-narrow-to-boxquote-content) + (let ((fill-prefix boxquote-side)) + (fill-paragraph arg))) + (fill-paragraph arg))) + +;;;###autoload +(defun boxquote-unbox-region (start end) + "Remove a box created with `boxquote-region'." + (interactive "r") + (save-excursion + (save-restriction + (narrow-to-region start end) + (setf (point) (point-min)) + (if (looking-at (concat "^" (regexp-quote boxquote-top-corner) + (regexp-quote boxquote-top-and-tail))) + (let ((ends (concat "^[" (regexp-quote boxquote-top-corner) + (regexp-quote boxquote-bottom-corner) + "]" boxquote-top-and-tail)) + (lines (concat "^" (regexp-quote boxquote-side)))) + (loop while (< (point) (point-max)) + if (looking-at ends) do (kill-line t) + if (looking-at lines) do (delete-char 2) + do (forward-line))) + (error "I can't see a box here"))))) + +;;;###autoload +(defun boxquote-unbox () + "Remove the boxquote that contains `point'." + (interactive) + (let ((box (boxquote-points-with-check))) + (boxquote-unbox-region (car box) (1+ (cdr box))))) + +(provide 'boxquote) + +;;; boxquote.el ends here. diff --git a/site-lisp/company-clang.el b/site-lisp/company-clang.el new file mode 100644 index 0000000..599491d --- /dev/null +++ b/site-lisp/company-clang.el @@ -0,0 +1,333 @@ +;;; company-clang.el --- company-mode completion backend for Clang -*- lexical-binding: t -*- + +;; Copyright (C) 2009, 2011, 2013-2016 Free Software Foundation, Inc. + +;; Author: Nikolaj Schumacher + +;; 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: +;; + +;;; Code: + +(require 'company) +(require 'company-template) +(require 'cl-lib) + +(defgroup company-clang nil + "Completion backend for Clang." + :group 'company) + +(defcustom company-clang-executable + (executable-find "clang") + "Location of clang executable." + :type 'file) + +(defcustom company-clang-begin-after-member-access t + "When non-nil, automatic completion will start whenever the current +symbol is preceded by \".\", \"->\" or \"::\", ignoring +`company-minimum-prefix-length'. + +If `company-begin-commands' is a list, it should include `c-electric-lt-gt' +and `c-electric-colon', for automatic completion right after \">\" and +\":\".") + +(defcustom company-clang-arguments nil + "Additional arguments to pass to clang when completing. +Prefix files (-include ...) can be selected with `company-clang-set-prefix' +or automatically through a custom `company-clang-prefix-guesser'." + :type '(repeat (string :tag "Argument"))) + +(defcustom company-clang-prefix-guesser 'company-clang-guess-prefix + "A function to determine the prefix file for the current buffer." + :type '(function :tag "Guesser function" nil)) + +(defvar company-clang-modes '(c-mode c++-mode objc-mode) + "Major modes which clang may complete.") + +(defcustom company-clang-insert-arguments t + "When non-nil, insert function arguments as a template after completion." + :type 'boolean + :package-version '(company . "0.8.0")) + +;; prefix ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar company-clang--prefix nil) + +(defsubst company-clang--guess-pch-file (file) + (let ((dir (directory-file-name (file-name-directory file)))) + (when (equal (file-name-nondirectory dir) "Classes") + (setq dir (file-name-directory dir))) + (car (directory-files dir t "\\([^.]h\\|[^h]\\).pch\\'" t)))) + +(defsubst company-clang--file-substring (file beg end) + (with-temp-buffer + (insert-file-contents-literally file nil beg end) + (buffer-string))) + +(defun company-clang-guess-prefix () + "Try to guess the prefix file for the current buffer." + ;; Prefixes seem to be called .pch. Pre-compiled headers do, too. + ;; So we look at the magic number to rule them out. + (let* ((file (company-clang--guess-pch-file buffer-file-name)) + (magic-number (and file (company-clang--file-substring file 0 4)))) + (unless (member magic-number '("CPCH" "gpch")) + file))) + +(defun company-clang-set-prefix (&optional prefix) + "Use PREFIX as a prefix (-include ...) file for clang completion." + (interactive (let ((def (funcall company-clang-prefix-guesser))) + (unless (stringp def) + (setq def default-directory)) + (list (read-file-name "Prefix file: " + (when def (file-name-directory def)) + def t (when def (file-name-nondirectory def)))))) + ;; TODO: pre-compile? + (setq company-clang--prefix (and (stringp prefix) + (file-regular-p prefix) + prefix))) + +;; Clean-up on exit. +(add-hook 'kill-emacs-hook 'company-clang-set-prefix) + +;; parsing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Handle Pattern (syntactic hints would be neat). +;; Do we ever see OVERLOAD (or OVERRIDE)? +(defconst company-clang--completion-pattern + "^COMPLETION: \\_<\\(%s[a-zA-Z0-9_:]*\\)\\(?: : \\(.*\\)$\\)?$") + +(defconst company-clang--error-buffer-name "*clang-error*") + +(defun company-clang--lang-option () + (if (eq major-mode 'objc-mode) + (if (string= "m" (file-name-extension buffer-file-name)) + "objective-c" "objective-c++") + (substring (symbol-name major-mode) 0 -5))) + +(defun company-clang--parse-output (prefix _objc) + (goto-char (point-min)) + (let ((pattern (format company-clang--completion-pattern + (regexp-quote prefix))) + (case-fold-search nil) + lines match) + (while (re-search-forward pattern nil t) + (setq match (match-string-no-properties 1)) + (unless (equal match "Pattern") + (save-match-data + (when (string-match ":" match) + (setq match (substring match 0 (match-beginning 0))))) + (let ((meta (match-string-no-properties 2))) + (when (and meta (not (string= match meta))) + (put-text-property 0 1 'meta + (company-clang--strip-formatting meta) + match))) + (push match lines))) + lines)) + +(defun company-clang--meta (candidate) + (get-text-property 0 'meta candidate)) + +(defun company-clang--annotation (candidate) + (let ((ann (company-clang--annotation-1 candidate))) + (if (not (and ann (string-prefix-p "(*)" ann))) + ann + (with-temp-buffer + (insert ann) + (search-backward ")") + (let ((pt (1+ (point)))) + (re-search-forward ".\\_>" nil t) + (delete-region pt (point))) + (buffer-string))))) + +(defun company-clang--annotation-1 (candidate) + (let ((meta (company-clang--meta candidate))) + (cond + ((null meta) nil) + ((string-match "[^:]:[^:]" meta) + (substring meta (1+ (match-beginning 0)))) + ((string-match "(anonymous)" meta) nil) + ((string-match "\\((.*)[ a-z]*\\'\\)" meta) + (let ((paren (match-beginning 1))) + (if (not (eq (aref meta (1- paren)) ?>)) + (match-string 1 meta) + (with-temp-buffer + (insert meta) + (goto-char paren) + (substring meta (1- (search-backward "<")))))))))) + +(defun company-clang--strip-formatting (text) + (replace-regexp-in-string + "#]" " " + (replace-regexp-in-string "[<{[]#\\|#[>}]" "" text t) + t)) + +(defun company-clang--handle-error (res args) + (goto-char (point-min)) + (let* ((buf (get-buffer-create company-clang--error-buffer-name)) + (cmd (concat company-clang-executable " " (mapconcat 'identity args " "))) + (pattern (format company-clang--completion-pattern "")) + (err (if (re-search-forward pattern nil t) + (buffer-substring-no-properties (point-min) + (1- (match-beginning 0))) + ;; Warn the user more aggressively if no match was found. + (message "clang failed with error %d:\n%s" res cmd) + (buffer-string)))) + + (with-current-buffer buf + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (current-time-string) + (format "\nclang failed with error %d:\n" res) + cmd "\n\n") + (insert err) + (setq buffer-read-only t) + (goto-char (point-min)))))) + +(defun company-clang--start-process (prefix callback &rest args) + (let ((objc (derived-mode-p 'objc-mode)) + (buf (get-buffer-create "*clang-output*")) + ;; Looks unnecessary in Emacs 25.1 and later. + (process-adaptive-read-buffering nil)) + (if (get-buffer-process buf) + (funcall callback nil) + (with-current-buffer buf + (erase-buffer) + (setq buffer-undo-list t)) + (let* ((process-connection-type nil) + (process (apply #'start-file-process "company-clang" buf + company-clang-executable args))) + (set-process-sentinel + process + (lambda (proc status) + (unless (string-match-p "hangup" status) + (funcall + callback + (let ((res (process-exit-status proc))) + (with-current-buffer buf + (unless (eq 0 res) + (company-clang--handle-error res args)) + ;; Still try to get any useful input. + (company-clang--parse-output prefix objc))))))) + (unless (company-clang--auto-save-p) + (send-region process (point-min) (point-max)) + (send-string process "\n") + (process-send-eof process)))))) + +(defsubst company-clang--build-location (pos) + (save-excursion + (goto-char pos) + (format "%s:%d:%d" + (if (company-clang--auto-save-p) buffer-file-name "-") + (line-number-at-pos) + (1+ (length + (encode-coding-region + (line-beginning-position) + (point) + 'utf-8 + t)))))) + +(defsubst company-clang--build-complete-args (pos) + (append '("-fsyntax-only" "-Xclang" "-code-completion-macros") + (unless (company-clang--auto-save-p) + (list "-x" (company-clang--lang-option))) + company-clang-arguments + (when (stringp company-clang--prefix) + (list "-include" (expand-file-name company-clang--prefix))) + (list "-Xclang" (format "-code-completion-at=%s" + (company-clang--build-location pos))) + (list (if (company-clang--auto-save-p) buffer-file-name "-")))) + +(defun company-clang--candidates (prefix callback) + (and (company-clang--auto-save-p) + (buffer-modified-p) + (basic-save-buffer)) + (when (null company-clang--prefix) + (company-clang-set-prefix (or (funcall company-clang-prefix-guesser) + 'none))) + (apply 'company-clang--start-process + prefix + callback + (company-clang--build-complete-args (- (point) (length prefix))))) + +(defun company-clang--prefix () + (if company-clang-begin-after-member-access + (company-grab-symbol-cons "\\.\\|->\\|::" 2) + (company-grab-symbol))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst company-clang-required-version 1.1) + +(defvar company-clang--version nil) + +(defun company-clang--auto-save-p () + (< company-clang--version 2.9)) + +(defsubst company-clang-version () + "Return the version of `company-clang-executable'." + (with-temp-buffer + (call-process company-clang-executable nil t nil "--version") + (goto-char (point-min)) + (if (re-search-forward "clang\\(?: version \\|-\\)\\([0-9.]+\\)" nil t) + (let ((ver (string-to-number (match-string-no-properties 1)))) + (if (> ver 100) + (/ ver 100) + ver)) + 0))) + +(defun company-clang (command &optional arg &rest ignored) + "`company-mode' completion backend for Clang. +Clang is a parser for C and ObjC. Clang version 1.1 or newer is required. + +Additional command line arguments can be specified in +`company-clang-arguments'. Prefix files (-include ...) can be selected +with `company-clang-set-prefix' or automatically through a custom +`company-clang-prefix-guesser'. + +With Clang versions before 2.9, we have to save the buffer before +performing completion. With Clang 2.9 and later, buffer contents are +passed via standard input." + (interactive (list 'interactive)) + (cl-case command + (interactive (company-begin-backend 'company-clang)) + (init (when (memq major-mode company-clang-modes) + (unless company-clang-executable + (error "Company found no clang executable")) + (setq company-clang--version (company-clang-version)) + (when (< company-clang--version company-clang-required-version) + (error "Company requires clang version 1.1")))) + (prefix (and (memq major-mode company-clang-modes) + buffer-file-name + company-clang-executable + (not (company-in-string-or-comment)) + (or (company-clang--prefix) 'stop))) + (candidates (cons :async + (lambda (cb) (company-clang--candidates arg cb)))) + (meta (company-clang--meta arg)) + (annotation (company-clang--annotation arg)) + (post-completion (let ((anno (company-clang--annotation arg))) + (when (and company-clang-insert-arguments anno) + (insert anno) + (if (string-match "\\`:[^:]" anno) + (company-template-objc-templatify anno) + (company-template-c-like-templatify + (concat arg anno)))))))) + +(provide 'company-clang) +;;; company-clang.el ends here diff --git a/site-lisp/company-template.el b/site-lisp/company-template.el new file mode 100644 index 0000000..053429d --- /dev/null +++ b/site-lisp/company-template.el @@ -0,0 +1,214 @@ +;;; company-template.el --- utility library for template expansion + +;; Copyright (C) 2009, 2010, 2014-2016 Free Software Foundation, Inc. + +;; Author: Nikolaj Schumacher + +;; 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 . + +;;; Code: + +(require 'cl-lib) + +(defface company-template-field + '((((background dark)) (:background "yellow" :foreground "black")) + (((background light)) (:background "orange" :foreground "black"))) + "Face used for editable text in template fields." + :group 'company) + +(defvar company-template-nav-map + (let ((keymap (make-sparse-keymap))) + (define-key keymap [tab] 'company-template-forward-field) + (define-key keymap (kbd "TAB") 'company-template-forward-field) + keymap)) + +(defvar-local company-template--buffer-templates nil) + +;; interactive ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun company-template-templates-at (pos) + (let (os) + (dolist (o (overlays-at pos)) + ;; FIXME: Always return the whole list of templates? + ;; We remove templates not at point after every command. + (when (memq o company-template--buffer-templates) + (push o os))) + os)) + +(defun company-template-move-to-first (templ) + (interactive) + (goto-char (overlay-start templ)) + (company-template-forward-field)) + +(defun company-template-forward-field () + (interactive) + (let* ((start (point)) + (templates (company-template-templates-at (point))) + (minimum (apply 'max (mapcar 'overlay-end templates))) + (fields (cl-loop for templ in templates + append (overlay-get templ 'company-template-fields)))) + (dolist (pos (mapcar 'overlay-start fields)) + (and pos + (> pos (point)) + (< pos minimum) + (setq minimum pos))) + (push-mark) + (goto-char minimum) + (company-template-remove-field (company-template-field-at start)))) + +(defun company-template-field-at (&optional point) + (cl-loop for ovl in (overlays-at (or point (point))) + when (overlay-get ovl 'company-template-parent) + return ovl)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun company-template-declare-template (beg end) + (let ((ov (make-overlay beg end))) + ;; (overlay-put ov 'face 'highlight) + (overlay-put ov 'keymap company-template-nav-map) + (overlay-put ov 'priority 101) + (overlay-put ov 'evaporate t) + (push ov company-template--buffer-templates) + (add-hook 'post-command-hook 'company-template-post-command nil t) + ov)) + +(defun company-template-remove-template (templ) + (mapc 'company-template-remove-field + (overlay-get templ 'company-template-fields)) + (setq company-template--buffer-templates + (delq templ company-template--buffer-templates)) + (delete-overlay templ)) + +(defun company-template-add-field (templ beg end &optional display) + "Add new field to template TEMPL spanning from BEG to END. +When DISPLAY is non-nil, set the respective property on the overlay. +Leave point at the end of the field." + (cl-assert templ) + (when (> end (overlay-end templ)) + (move-overlay templ (overlay-start templ) end)) + (let ((ov (make-overlay beg end)) + (siblings (overlay-get templ 'company-template-fields))) + ;; (overlay-put ov 'evaporate t) + (overlay-put ov 'intangible t) + (overlay-put ov 'face 'company-template-field) + (when display + (overlay-put ov 'display display)) + (overlay-put ov 'company-template-parent templ) + (overlay-put ov 'insert-in-front-hooks '(company-template-insert-hook)) + (push ov siblings) + (overlay-put templ 'company-template-fields siblings))) + +(defun company-template-remove-field (ovl &optional clear) + (when (overlayp ovl) + (when (overlay-buffer ovl) + (when clear + (delete-region (overlay-start ovl) (overlay-end ovl))) + (delete-overlay ovl)) + (let* ((templ (overlay-get ovl 'company-template-parent)) + (siblings (overlay-get templ 'company-template-fields))) + (setq siblings (delq ovl siblings)) + (overlay-put templ 'company-template-fields siblings)))) + +(defun company-template-clean-up (&optional pos) + "Clean up all templates that don't contain POS." + (let ((local-ovs (overlays-at (or pos (point))))) + (dolist (templ company-template--buffer-templates) + (unless (memq templ local-ovs) + (company-template-remove-template templ))))) + +;; hooks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun company-template-insert-hook (ovl after-p &rest _ignore) + "Called when a snippet input prompt is modified." + (unless after-p + (company-template-remove-field ovl t))) + +(defun company-template-post-command () + (company-template-clean-up) + (unless company-template--buffer-templates + (remove-hook 'post-command-hook 'company-template-post-command t))) + +;; common ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun company-template-c-like-templatify (call) + (let* ((end (point-marker)) + (beg (- (point) (length call))) + (templ (company-template-declare-template beg end)) + paren-open paren-close) + (with-syntax-table (make-syntax-table (syntax-table)) + (modify-syntax-entry ?< "(") + (modify-syntax-entry ?> ")") + (when (search-backward ")" beg t) + (setq paren-close (point-marker)) + (forward-char 1) + (delete-region (point) end) + (backward-sexp) + (forward-char 1) + (setq paren-open (point-marker))) + (when (search-backward ">" beg t) + (let ((angle-close (point-marker))) + (forward-char 1) + (backward-sexp) + (forward-char) + (company-template--c-like-args templ angle-close))) + (when (looking-back "\\((\\*)\\)(" (line-beginning-position)) + (delete-region (match-beginning 1) (match-end 1))) + (when paren-open + (goto-char paren-open) + (company-template--c-like-args templ paren-close))) + (if (overlay-get templ 'company-template-fields) + (company-template-move-to-first templ) + (company-template-remove-template templ) + (goto-char end)))) + +(defun company-template--c-like-args (templ end) + (let ((last-pos (point))) + (while (re-search-forward "\\([^,]+\\),?" end 'move) + (when (zerop (car (parse-partial-sexp last-pos (point)))) + (company-template-add-field templ last-pos (match-end 1)) + (skip-chars-forward " ") + (setq last-pos (point)))))) + +;; objc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun company-template-objc-templatify (selector) + (let* ((end (point-marker)) + (beg (- (point) (length selector) 1)) + (templ (company-template-declare-template beg end)) + (cnt 0)) + (save-excursion + (goto-char beg) + (catch 'stop + (while (search-forward ":" end t) + (if (looking-at "\\(([^)]*)\\) ?") + (company-template-add-field templ (point) (match-end 1)) + ;; Not sure which conditions this case manifests under, but + ;; apparently it did before, when I wrote the first test for this + ;; function. FIXME: Revisit it. + (company-template-add-field templ (point) + (progn + (insert (format "arg%d" cnt)) + (point))) + (when (< (point) end) + (insert " ")) + (cl-incf cnt)) + (when (>= (point) end) + (throw 'stop t))))) + (company-template-move-to-first templ))) + +(provide 'company-template) +;;; company-template.el ends here diff --git a/site-lisp/key-chord.el b/site-lisp/key-chord.el new file mode 100644 index 0000000..ed3d15f --- /dev/null +++ b/site-lisp/key-chord.el @@ -0,0 +1,372 @@ +;;; key-chord.el --- map pairs of simultaneously pressed keys to commands +;;------------------------------------------------------------------- +;; +;; Copyright (C) 2003,2005,2008,2012 David Andersson +;; +;; 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 2 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, write to the Free +;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, +;; MA 02111-1307 USA +;; +;;------------------------------------------------------------------- + +;; Author: David Andersson +;; Created: 27 April 2003 +;; Version: 0.6 (2012-10-23) +;; Keywords: keyboard chord input + +;;; Commentary: + +;; ######## Compatibility ######################################## +;; +;; Works with Emacs-20.3, 20.6, 20.7, 21.2, 21.4, 22.1 and 23.1 +;; Does not work with Emacs-19.31 nor XEmacs-20.4 and 21.4. + +;; ######## Quick start ######################################## +;; +;; Add to your ~/.emacs +;; +;; (require 'key-chord) +;; (key-chord-mode 1) +;; +;; and some chords, for example +;; +;; (key-chord-define-global "hj" 'undo) +;; (key-chord-define-global ",." "<>\C-b") + +;; ######## Terminology ######################################## +;; +;; In this package, a "key chord" is two keys pressed simultaneously, +;; or a single key quickly pressed twice. +;; +;; (Sometimes pressing SHIFT and/or META plus another key is call a chord, +;; but not here. However SHIFT plus two normal keys can be a "key chord".) + +;; ######## Description ######################################## +;; +;; Key chord mode acts like a global minor mode controlled by the function +;; `key-chord-mode'. +;; +;; Key chord definitions are stored in ordinary key-maps. +;; The function `key-chord-define-global' defines a chord in the global +;; key-map and `key-chord-define' defines a chord in a specified key-map, +;; for example for a specific mode. +;; +;; A TWO-key chord is two distinct keys pressed simultaneously (within +;; one tenth of a second, or so). +;; +;; Examples: +;; +;; (key-chord-define-global ",." "<>\C-b") +;; (key-chord-define-global "hj" 'undo) +;; (key-chord-define-global [?h ?j] 'undo) ; the same +;; (key-chord-define-global "jk" 'dabbrev-expand) +;; (key-chord-define-global "cv" 'reindent-then-newline-and-indent) +;; (key-chord-define-global "4r" "$") +;; +;; Comma and dot pressed together insert a pair of angle brackets. +;; `h' and `j' pressed together invoke the undo command. +;; `j' and `k' pressed together invoke the dabbrev-expand command. +;; 'c' and 'v' pressed together insert a newline. +;; `4' and `r' pressed together insert a dollar sign. +;; +;; A ONE-key chord is a single key quickly pressed twice (within one third +;; of a second or so). +;; +;; Examples: +;; +;; (key-chord-define-global "''" "`'\C-b") +;; (key-chord-define-global ",," 'indent-for-comment) +;; (key-chord-define-global "qq" "the ") +;; (key-chord-define-global "QQ" "The ") +;; +;; Tick (') pressed twice inserts a back-tick and a tick (`'). +;; Comma (,) pressed twice indents for and/or inserts a comment. +;; `q' pressed twice inserts the word "the ". +;; +;; Examples: Mode specific chords +;; +;; (key-chord-define c++-mode-map ";;" "\C-e;") +;; (key-chord-define c++-mode-map "{}" "{\n\n}\C-p\t") +;; +;; The command `key-chord-describe' lists currently defined key chords. +;; The standard command `describe-bindings' (C-h b) will also show key chords. +;; +;; The standard command `describe-key' (C-h k) will accept a key chord and +;; show its definition. (Isn't that amazing. There is no explicit code to +;; carry out this functionality.) + +;; ######## Tips ######################################## +;; +;; Don't chord key combinations that exists in the languages you typically +;; write. Otherwise, if you are typing fast, two key intended to be separate +;; letters might instead trig a chord. +;; E.g. "uu" would be a good chord in spanish but not in finnish, and +;; "hj" would be a good chord in english but not in swedish. +;; +;; Don't rely solely on /usr/dict/words to find unusual combination. +;; For example "cv" or "fg" can be quite common in certain kinds of +;; programming. Grep your own texts to verify that a combination is unusual. +;; And don't forget to check both permutations: "fg" and "gf". +;; +;; Choose two keys that are close to each other on the keyboard, so they +;; can be quickly typed without effort. Chords involving two hands (as +;; opposed to two fingers on one hand) are harder to type (quickly). +;; The idea is that key chords are to replace function keys for functions +;; that are frequently performed while the hands are in writing position. +;; +;; Key chords might not work well over a slow network. + +;; ######## Limitations ######################################## +;; +;; When recording keyboard macros, the time between keyboard inputs are not +;; recorded. Thus, the key-chord-input-method cannot know for sure if two keys +;; in a macro was a chord or not. The current solution remembers the first key +;; of the chords typed during macro recording, and keys that match those (and +;; are defined as chords) are considered key-chords during macro execution. +;; This knowledge is not saved with `name-last-kbd-macro', so they may +;; execute wrong if they contain pair of keys that match defined chords. +;; +;; Emacs will not call input-method-function for keys that have non numeric +;; codes or whos code is outside the range 32..126. Thus you cannot define +;; key chords involving function keys, control keys, or even your non-english +;; letters (on national keyboards) that otherwise are well positioned for +;; chording on your keyboard. +;; (I think chording left and right arrow keys would be useful, but cannot do. +;; I consider this a bug in Emacs. Input methods could happily return +;; unmodified *any* key they don't know about.) +;; +;; Key chords longer that 2 keys are not supported. It could be done, but I +;; don't think it is worth the trubbel since most keyboards will not reliably +;; send all key codes when 3 or more keys are pressed simultaneously. +;; It might also be a bit trickier to maintain performance. +;; +;; Key chord mode uses input-method-function. And so do internationalisation +;; packages (mule, quail, etc). Do not expect them to work well together. +;; The last one that gets the input-method-function rules. + +;; ######## Implementation ######################################## +;; +;; Key chords piggy back in ordinary key maps, so they can be defined +;; per mode without having to add hooks to all modes. +;; +;; Key chord key codes are vectors beginning with the atom `key-chord'. +;; A two key chord, e.g. "hj", will add two entries in the key-map. +;; E.g. [key-chord ?h ?j] and [key-chord ?j ?h]. +;; +;; When key-chord-mode is enabled input-method-function is set to +;; key-chord-input-method. + +;; ######## To do ######################################## +;; +;; * Find a way to save key-chord info in keyboard macros. +;; +;; * Save previous value of input-method-function? And call it? +;; +;; * input-method-function is reset in *info* buffers! What to do? +;; +;; * How to enter interactively command OR string in key-chord-define-global? +;; +;; * Customize public vars (defcustom). + +;; ######## History ######################################## +;; +;; 0.6 (2012-10-23) l.david.andersson(at)sverige.nu +;; Add key-chord-define-local, key-chord-unset-local, key-chord-unset-global +;; 0.5 (2008-09-15) david(at)symsoft.se +;; Bugfix sit-for; Improved examples; New E-mail in comment +;; 0.4 (2005-05-07) david(at)symsoft.se +;; Slightly better macro heuristics; Added option key-chord-in-macros +;; 0.3 (2005-04-14) david(at)symsoft.se +;; Require advice; More examples +;; 0.2 (2003-09-13) david(at)symsoft.se +;; Quick and dirty fix for keyboard macros +;; 0.1 (2003-04-27) david(at)symsoft.se +;; First release + +;;; Code: + +(defvar key-chord-two-keys-delay 0.1 ; 0.05 or 0.1 + "Max time delay between two key press to be considered a key chord.") + +(defvar key-chord-one-key-delay 0.2 ; 0.2 or 0.3 to avoid first autorepeat + "Max time delay between two press of the same key to be considered a key chord. +This should normally be a little longer than `key-chord-two-keys-delay'.") + +(defvar key-chord-in-macros t + "If nil, don't expand key chords when executing keyboard macros. +If non-nil, expand chord sequenses in macros, but only if a similar chord was +entered during the last interactive macro recording. (This carries a bit of +guesswork. We can't know for sure when executing whether two keys were +typed quickly or slowly when recorded.)") + +;; Internal vars +(defvar key-chord-mode nil) + +;; Shortcut for key-chord-input-method: no need to test a key again if it +;; didn't matched a chord the last time. Improves feedback during autorepeat. +(defvar key-chord-last-unmatched nil) + +;; Macro heuristics: Keep track of which chords was used when the last macro +;; was defined. Or rather, only the first-char of the chords. Only expand +;; matching chords during macro execution. +(defvar key-chord-in-last-kbd-macro nil) +(defvar key-chord-defining-kbd-macro nil) + +;;;###autoload +(defun key-chord-mode (arg) + "Toggle key chord mode. +With positive ARG enable the mode. With zero or negative arg disable the mode. +A key chord is two keys that are pressed simultaneously, or one key quickly +pressed twice. +\nSee functions `key-chord-define-global', `key-chord-define-local', and +`key-chord-define' and variables `key-chord-two-keys-delay' and +`key-chord-one-key-delay'." + + (interactive "P") + (setq key-chord-mode (if arg + (> (prefix-numeric-value arg) 0) + (not key-chord-mode))) + (cond (key-chord-mode + (setq input-method-function 'key-chord-input-method) + (message "Key Chord mode on")) + (t + (setq input-method-function nil) + (message "Key Chord mode off")))) + +;;;###autoload +(defun key-chord-define-global (keys command) + "Define a key-chord of the two keys in KEYS starting a COMMAND. +\nKEYS can be a string or a vector of two elements. Currently only elements +that corresponds to ascii codes in the range 32 to 126 can be used. +\nCOMMAND can be an interactive function, a string, or nil. +If COMMAND is nil, the key-chord is removed. +\nNote that KEYS defined locally in the current buffer will have precedence." + (interactive "sSet key chord globally (2 keys): \nCSet chord \"%s\" to command: ") + (key-chord-define (current-global-map) keys command)) + +;;;###autoload +(defun key-chord-define-local (keys command) + "Locally define a key-chord of the two keys in KEYS starting a COMMAND. +\nKEYS can be a string or a vector of two elements. Currently only elements +that corresponds to ascii codes in the range 32 to 126 can be used. +\nCOMMAND can be an interactive function, a string, or nil. +If COMMAND is nil, the key-chord is removed. +\nThe binding goes in the current buffer's local map, +which in most cases is shared with all other buffers in the same major mode." + (interactive "sSet key chord locally (2 keys): \nCSet chord \"%s\" to command: ") + (key-chord-define (current-local-map) keys command)) + +(defun key-chord-unset-global (keys) + "Remove global key-chord of the two keys in KEYS." + (interactive "sUnset key chord globally (2 keys): ") + (key-chord-define (current-global-map) keys nil)) + +(defun key-chord-unset-local (keys) + "Remove local key-chord of the two keys in KEYS." + (interactive "sUnset key chord locally (2 keys): ") + (key-chord-define (current-local-map) keys nil)) + +;;;###autoload +(defun key-chord-define (keymap keys command) + "Define in KEYMAP, a key-chord of the two keys in KEYS starting a COMMAND. +\nKEYS can be a string or a vector of two elements. Currently only elements +that corresponds to ascii codes in the range 32 to 126 can be used. +\nCOMMAND can be an interactive function, a string, or nil. +If COMMAND is nil, the key-chord is removed." + (if (/= 2 (length keys)) + (error "Key-chord keys must have two elements")) + ;; Exotic chars in a string are >255 but define-key wants 128..255 for those + (let ((key1 (logand 255 (aref keys 0))) + (key2 (logand 255 (aref keys 1)))) + (if (eq key1 key2) + (define-key keymap (vector 'key-chord key1 key2) command) + ;; else + (define-key keymap (vector 'key-chord key1 key2) command) + (define-key keymap (vector 'key-chord key2 key1) command)))) + +(defun key-chord-lookup-key1 (keymap key) + "Like lookup-key but no third arg and no numeric return value." + (let ((res (lookup-key keymap key))) + (if (numberp res) + nil + ;; else + res))) + +(defun key-chord-lookup-key (key) + "Lookup KEY in all current key maps." + (let ((maps (current-minor-mode-maps)) + res) + (while (and maps (not res)) + (setq res (key-chord-lookup-key1 (car maps) key) + maps (cdr maps))) + (or res + (if (current-local-map) + (key-chord-lookup-key1 (current-local-map) key)) + (key-chord-lookup-key1 (current-global-map) key)))) + +(defun key-chord-describe () + "List key chord bindings in a help buffer. +\nTwo key chords will be listed twice and there will be Prefix Commands. +Please ignore that." + (interactive) + (describe-bindings [key-chord])) + +(defun key-chord-input-method (first-char) + "Input method controlled by key bindings with the prefix `key-chord'." + (if (and (not (eq first-char key-chord-last-unmatched)) + (key-chord-lookup-key (vector 'key-chord first-char))) + (let ((delay (if (key-chord-lookup-key (vector 'key-chord first-char first-char)) + key-chord-one-key-delay + ;; else + key-chord-two-keys-delay))) + (if (if executing-kbd-macro + (not (memq first-char key-chord-in-last-kbd-macro)) + (when (bound-and-true-p eldoc-mode) + (eldoc-pre-command-refresh-echo-area)) + + (sit-for delay 0 'no-redisplay)) + (progn + (setq key-chord-last-unmatched nil) + (list first-char)) + ;; else input-pending-p + (let* ((input-method-function nil) + (next-char (read-event)) + (res (vector 'key-chord first-char next-char))) + (if (key-chord-lookup-key res) + (progn + (setq key-chord-defining-kbd-macro + (cons first-char key-chord-defining-kbd-macro)) + (list 'key-chord first-char next-char)) + ;; else put back next-char and return first-char + (setq unread-command-events (cons next-char unread-command-events)) + (if (eq first-char next-char) + (setq key-chord-last-unmatched first-char)) + (list first-char))))) + ;; else no key-chord keymap + (setq key-chord-last-unmatched first-char) + (list first-char))) + +(require 'advice) + +(defadvice start-kbd-macro (after key-chord activate) + (setq key-chord-defining-kbd-macro nil)) + +(defadvice end-kbd-macro (after key-chord activate) + (setq key-chord-in-last-kbd-macro key-chord-defining-kbd-macro)) + +(provide 'key-chord) + +;;; key-chord.el ends here diff --git a/site-lisp/meson-mode.el b/site-lisp/meson-mode.el new file mode 100644 index 0000000..87f4dea --- /dev/null +++ b/site-lisp/meson-mode.el @@ -0,0 +1,764 @@ +;;; meson-mode.el --- Major mode for the Meson build system files -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 Michal Sojka + +;; Author: Michal Sojka +;; Version: 0.1 +;; Keywords: languages, tools +;; URL: https://github.com/wentasah/meson-mode +;; Package-Requires: ((emacs "24.3")) + +;; 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 Meson build system files. Syntax +;; highlighting works reliably. Indentation works too, but there are +;; probably cases, where it breaks. Simple completion is supported via +;; `completion-at-point'. To start completion, use either or +;; install completion frameworks such as `company'. To enable +;; `company' add the following to your .emacs: +;; +;; (add-hook 'meson-mode-hook 'company-mode) + + +;;; Code: + +(defvar meson-mode-syntax-table + (let ((table (make-syntax-table)) + (list (list ?\# "<" + ?\n ">#" + ?\' "\"'" ; See also meson-syntax-propertize-function + ?\" "." + ?\$ "." + ?\& "." + ?\* "." + ?\+ "." + ?\- "." + ?\< "." + ?\> "." + ?\= "." + ?\/ "." + ?\| "." + ))) + (while list + (modify-syntax-entry (pop list) (pop list) table)) + table) + "Syntax table used while in `meson-mode'.") + +(defun meson--max-length (&rest args) + (let ((lengths + (mapcar (lambda (x) (if (stringp x) (length x) x)) args))) + (apply 'max lengths))) + +(eval-and-compile + (defconst meson-keywords + '("true" "false" "if" "else" "elif" "endif" "and" "or" "not" "foreach" "endforeach"))) + +(defconst meson-keywords-regexp + (rx symbol-start (eval `(or ,@meson-keywords)) symbol-end)) + +(require 'cl-lib) + +(defconst meson-keywords-max-length + (cl-reduce 'meson--max-length meson-keywords)) + +(eval-and-compile + (defconst meson-builtin-functions + '("add_global_arguments" + "add_global_link_arguments" "add_languages" + "add_project_arguments" "add_project_link_arguments" + "add_test_setup" "benchmark" "build_target" + "configuration_data" "configure_file" "custom_target" + "declare_dependency" "dependency" "error" "environment" + "executable" "find_program" "find_library" "files" + "generator" "get_option" "get_variable" "import" + "include_directories" "install_data" "install_headers" + "install_man" "install_subdir" "is_variable" "jar" + "join_paths" "library" "message" "project" "run_command" + "run_target" "set_variable" "shared_library" + "shared_module" "static_library" "subdir" "subproject" + "test" "vcs_tag"))) + +(defconst meson-builtin-functions-regexp + (rx (or line-start (not (any "."))) + symbol-start + (group (eval `(or ,@meson-builtin-functions))) + symbol-end + (zero-or-more whitespace) + (or "(" line-end))) + +(eval-when-compile + (defconst meson-builtin-vars + '("meson" "build_machine" "host_machine" "target_machine"))) + +(defconst meson-builtin-vars-regexp + (rx symbol-start + (or (eval `(or ,@meson-builtin-vars))) + symbol-end)) + +(eval-and-compile + (defconst meson-literate-tokens + '( ;;"(" ")" "[" "]" ; Let syntactic parser handle these efficiently + "\"" "," "+=" "." "+" "-" "*" + "%" "/" ":" "==" "!=" "=" "<=" "<" ">=" ">" "?"))) + +(defconst meson-literate-tokens-max-length + (cl-reduce 'meson--max-length meson-literate-tokens)) + +(defconst meson-literate-tokens-regexp + (rx (eval `(or ,@meson-literate-tokens)))) + +(defconst meson-methods + `(("meson\\." + . ("get_compiler" + "is_cross_build" + "has_exe_wrapper" + "is_unity" + "is_subproject" + "current_source_dir" + "current_build_dir" + "source_root" + "build_root" + "add_install_script" + "add_postconf_script" + "install_dependency_manifest" + "project_version" + "version" + "project_name" + "get_cross_property" + "backend")) + (,(regexp-opt '("build_machine." + "host_machine." + "target_machine.")) + . ("system" + "cpu_family" + "cpu" + "endian")) + ("" + . ( ;; class TryRunResultHolder + "returncode" + "compiled" + "stdout" + "stderr" + + ;; class RunProcess + "returncode" + "stdout" + "stderr" + + ;; class EnvironmentVariablesHolder + "set" + "append" + "prepend" + + ;; class ConfigurationDataHolder + "set" + "set10" + "set_quoted" + "has" + "get" + + ;; class DependencyHolder + "found" + "type_name" + "version" + "get_pkgconfig_variable" + + ;; class InternalDependencyHolder + "found" + "version" + + ;; class ExternalProgramHolder + "found" + + ;; class ExternalLibraryHolder + "found" + + ;; class GeneratorHolder + "process" + + ;; class BuildMachine + "system" + "cpu_family" + "cpu" + "endian" + + ;; class CrossMachineInfo + "system" + "cpu" + "cpu_family" + "endian" + + ;; class BuildTargetHolder + "extract_objects" + "extract_all_objects" + "get_id" + "outdir" + "full_path" + "private_dir_include" + + ;; class CustomTargetHolder + "full_path" + + ;; class SubprojectHolder + "get_variable" + + ;; class CompilerHolder + "compiles" + "links" + "get_id" + "compute_int" + "sizeof" + "has_header" + "has_header_symbol" + "run" + "has_function" + "has_member" + "has_members" + "has_type" + "alignment" + "version" + "cmd_array" + "find_library" + "has_argument" + "has_multi_arguments" + "first_supported_argument" + "unittest_args" + "symbols_have_underscore_prefix" + + ;; string + "strip" + "format" + "to_upper" + "to_lower" + "underscorify" + "split" + "startswith" + "endswith" + "contains" + "to_int" + "join" + "version_compare" + + ;; number + "is_even" + "is_odd" + + ;; boolean + "to_string" + "to_int" + + ;; array + "length" + "contains" + "get" + + )))) + +(defconst meson-basic-kwargs + '("install" + "c_pch" + "cpp_pch" + "c_args" + "cpp_args" + "cs_args" + "vala_args" + "fortran_args" + "d_args" + "java_args" + "link_args" + "link_depends" + "link_with" + "include_directories" + "dependencies" + "install_dir" + "main_class" + "gui_app" + "extra_files" + "install_rpath" + "resources" + "sources" + "objects" + "native" + "build_by_default" + )) + +(defconst meson-kwargs + `(("executable" + . ,meson-basic-kwargs) + ("library" + . ,(append meson-basic-kwargs + '("version" ; Only for shared libs + "soversion" ; Only for shared libs + "name_prefix" + "name_suffix" + "vs_module_defs" ; Only for shared libs + "vala_header" + "vala_vapi" + "vala_gir" + "pic" ; Only for static libs + ))) + ("project" + . ("version" + "meson_version" + "default_options")) + ("run_target" + . ("command" + "depends")) + ("test" + . ("args" + "env" + "is_parallel" + "should_fail" + "valgring_args" + "timeout" + "workdir")) + ("vcs_tag" + . ("input" + "output" + "fallback")) + ("install_[[:alpha:]]+" + . ("install_dir")) + ("add_languages" + . ("required")) + ("add_test_setup" + . ("exe_wrapper" + "gdb" + "timeout_multiplier" + "env")) + ("benchmark" + . ("args" + "env" + "should_fail" + "valgring_args" + "timeout" + "workdir")) + ("configure_file" + . ("input" + "output" + "configuration" + "command" + "install_dir")) + ("custom_target" + . ("input" + "output" + "command" + "install" + "install_dir" + "build_always" + "capture" + "depends" + "depend_files" + "depfile" + "build_by_default")) + ("declare_dependency" + . ("include_directories" + "link_with" + "sources" + "dependencies" + "compile_args" + "link_args" + "version")) + ("dependency" + . ("modules" + "required" + "version" + "native" + "static" + "fallback" + "default_options")) + )) + + +(eval-and-compile + (defconst meson-multiline-string-regexp + (rx "'''" (minimal-match (zero-or-more anything)) "'''")) + (defconst meson-string-regexp + (rx "'" + (zero-or-more + (or (not (any "'" "\\")) + (seq "\\" nonl))) + "'"))) + +(defconst meson-string-regexp + (rx (or (eval `(regexp ,meson-multiline-string-regexp)) + (eval `(regexp ,meson-string-regexp))))) + +(defconst meson-token-spec + `(("ignore" . ,(rx (one-or-more (any " " "\t")))) + ("id" . ,(rx (any "_" "a-z" "A-Z") (zero-or-more (any "_" "a-z" "A-Z" "0-9")))) + ("number" . ,(rx (one-or-more (any digit)))) + ("eol_cont" . ,(rx "\\" "\n")) + ("eol" . "\n"))) + +(defvar meson-mode-font-lock-keywords + `((,meson-keywords-regexp . font-lock-keyword-face) + (,meson-builtin-functions-regexp . (1 font-lock-builtin-face)) + (,meson-builtin-vars-regexp . font-lock-variable-name-face))) + +(defconst meson-syntax-propertize-function + (syntax-propertize-rules + ((rx (or "'''" "'")) (0 (ignore (meson-syntax-stringify)))))) + +(defsubst meson-syntax-count-quotes (&optional point limit) + "Count number of quotes after point (max is 3). +POINT is the point where scan starts (defaults to current point), +and LIMIT is used to limit the scan." + (let ((i 0) + (p (or point (point)))) + (while (and (< i 3) + (or (not limit) (< (+ p i) limit)) + (eq (char-after (+ p i)) ?\')) + (setq i (1+ i))) + i)) + +(defun meson-syntax-stringify () + "Put `syntax-table' property correctly on single/triple apostrophes." + ;; Inspired by python-mode + (let* ((num-quotes (length (match-string-no-properties 0))) + (ppss (prog2 + (backward-char num-quotes) + (syntax-ppss) + (forward-char num-quotes))) + (in-comment (nth 4 ppss)) + (string-start (and (not in-comment) (nth 8 ppss))) + (quote-starting-pos (- (point) num-quotes)) + (quote-ending-pos (point)) + (num-closing-quotes + (and string-start + (meson-syntax-count-quotes + string-start quote-starting-pos)))) + (cond ((and string-start (= num-closing-quotes 0)) + ;; This set of quotes doesn't match the string starting + ;; kind. Do nothing. + nil) + ((not string-start) + ;; This set of quotes delimit the start of a string. + (put-text-property quote-starting-pos (1+ quote-starting-pos) + 'syntax-table (string-to-syntax "|"))) + ((= num-quotes num-closing-quotes) + ;; This set of quotes delimit the end of a string. + (put-text-property (1- quote-ending-pos) quote-ending-pos + 'syntax-table (string-to-syntax "|"))) + ((> num-quotes num-closing-quotes) + ;; This may only happen whenever a triple quote is closing + ;; a single quoted string. Add string delimiter syntax to + ;; all three quotes. + (put-text-property quote-starting-pos quote-ending-pos + 'syntax-table (string-to-syntax "|")))))) + +;;; Completion + +(defun meson-completion-at-point-function () + (save-excursion + (let* ((end (progn (skip-syntax-forward "w_") + (point))) + (start (progn (skip-syntax-backward "w_") + (point))) + (ppss (syntax-ppss))) + (cond + ((or (nth 3 ppss) ; inside string + (nth 4 ppss)) ; inside comment + nil) ; nothing to complete + + ;; kwargs + ((and (> (nth 0 ppss) 0) ; inside parentheses + (eq (char-after (nth 1 ppss)) ?\()) ; rounded parentheses + (save-excursion + (goto-char (nth 1 ppss)) + (let ((kwargs (cl-some (lambda (x) + (when (looking-back (concat (car x) (rx (zero-or-more (any " " "\t")))) + (line-beginning-position)) + (cdr x))) + meson-kwargs))) + ;; complete mathing kwargs as well as built-in + ;; variables/functions + (list start end (append kwargs meson-builtin-vars + meson-builtin-functions))))) + + ;; methods + ((eq (char-before) ?.) + (let ((methods (cl-some + (lambda (x) + (when (looking-back (car x) (line-beginning-position)) + (cdr x))) + meson-methods))) + (list start end methods))) + ;; global things + (t + (list start end (append meson-keywords meson-builtin-vars + meson-builtin-functions))))))) + + +;;; Indetation + +(require 'smie) + +(defun meson--comment-bolp (&optional ppss_) + "Return non-nil if point is at the beginning of line, ignoring +comments." + (save-excursion + (let ((ppss (or ppss_ + (syntax-ppss)))) + (when (nth 4 ppss) ; inside comment + (goto-char (nth 8 ppss))) ; go to its beginning + (smie-rule-bolp)))) + +(defun meson-smie-forward-token () + (let ((token 'unknown)) + (while (eq token 'unknown) + (let ((ppss (syntax-ppss))) + ;; When inside or at start of a comment, goto end of line so + ;; that we can still return "eol" token there. + (when (or (nth 4 ppss) + (and (not (nth 3 ppss)) ; not inside string + (looking-at "#"))) + (end-of-line) + (setq ppss (syntax-ppss))) ; update ppss after move + ;; Determine token but do not move behind it + (setq token + (cond + ;; Let syntactic parser handle parentheses (even inside + ;; strings - this ensures that parentheses are NOT + ;; indented inside strings according to meson + ;; indentation rules) + ((looking-at (rx (or (syntax open-parenthesis) + (syntax close-parenthesis)))) + "") + ;; After handling parentheses (inside strings), we can + ;; handle strings + ((or (when (nth 3 ppss) ; If inside string + (goto-char (nth 8 ppss)) ; goto beginning + nil) + (looking-at meson-string-regexp)) ; Match the whole string + "string") + ((looking-at meson-keywords-regexp) (match-string-no-properties 0)) + ((cl-some (lambda (spec) (when (looking-at (cdr spec)) (car spec))) + meson-token-spec)) + ((looking-at meson-literate-tokens-regexp) + (match-string-no-properties 0)))) + ;; Remember token end (except for parentheses) + (let ((after-token (when (< 0 (length token)) (match-end 0)))) + ;; Skip certain tokens + (when (or (equal token "ignore") + (equal token "eol_cont") + (and (equal token "eol") ; Skip EOL when: + (or (> (nth 0 ppss) 0) ; - inside parentheses + (and (looking-back ; - after operator but not inside comments + meson-literate-tokens-regexp + (- (point) meson-literate-tokens-max-length)) + (not (nth 4 ppss))) + (meson--comment-bolp ppss)))) ; - at empty line + (setq token 'unknown)) + (when after-token + (goto-char after-token))))) + token)) + +(defun meson-smie-backward-token () + (let ((token 'unknown)) + (while (eq token 'unknown) + (let ((eopl (max ;; end of previous line (to properly match "eol_cont" below it is actually a character before) + (1- (line-end-position 0)) + (point-min))) + (ppss (syntax-ppss))) + ;; Skip comments + (when (nth 4 ppss) ; We are in a comment + (goto-char (nth 8 ppss)) ; goto its beginning + (setq ppss (syntax-ppss))) ; update ppss after move + (setq token + ;; Determine token and move before it + (cond + ;; Let syntactic parser handle parentheses (even inside + ;; strings - this ensures that parentheses are NOT + ;; indented inside strings according to meson + ;; indentation rules) + ((looking-back (rx (or (syntax open-parenthesis) + (syntax close-parenthesis))) + (1- (point))) + "") + ;; Check for strings. Relying on syntactic parser allows us to + ;; find the beginning of multi-line strings efficiently. + ((nth 3 ppss) ; We're inside string or + (let ((string-start (nth 8 ppss))) + (when (not (equal (point) string-start)) + (goto-char string-start) + "string"))) + ((equal (char-before) ?\') ; We're just after a string + (let* ((ppss- (syntax-ppss (1- (point))))) + (goto-char (nth 8 ppss-)) + "string")) + ;; Regexp-based matching + (t (let ((tok + ;; Determine token but do not move before it + (cond + ((looking-back meson-keywords-regexp (- (point) meson-keywords-max-length) t) + (match-string-no-properties 0)) + ((looking-back meson-literate-tokens-regexp + (- (point) meson-literate-tokens-max-length) t) + (match-string-no-properties 0)) + ((cl-some (lambda (spec) (when (looking-back (cdr spec) eopl t) (car spec))) + meson-token-spec))))) + (when tok + (goto-char (match-beginning 0)) ; Go before token now + (setq ppss (syntax-ppss))) ; update ppss + tok)))) + (when (or (equal token "ignore") + (equal token "eol_cont") + (and (equal token "eol") ; Skip EOL when: + (or (> (nth 0 ppss) 0) ; - inside parentheses + (and (looking-back ; - after operator but not inside comments + meson-literate-tokens-regexp + (- (point) meson-literate-tokens-max-length)) + (not (nth 4 ppss))) + (meson--comment-bolp ppss)))) ;- at empty line + (setq token 'unknown)))) + token)) + +(defconst meson-smie-grammar + (smie-prec2->grammar + (smie-bnf->prec2 + '((id) + (codeblock (line) + (codeblock "eol" codeblock)) + (line (exp) + ("if" ifblock "endif") + ("if" ifblock "else" codeblock "endif") + ("foreach" foreachblock "endforeach")) + (foreachblock (id ":" exp "eol" codeblock)) + (ifblock (exp "eol" codeblock) + (exp "eol" codeblock "elif" ifblock) + ) + (exp (exp "," exp) + (id ":" exp) + (exp "+=" exp) + (exp "=" exp) +;; (exp "?" exp ":" exp) + (exp "or" exp) + (exp "and" exp) + (exp "==" exp) + (exp "!=" exp) + (exp "<" exp) + (exp "<=" exp) + (exp ">" exp) + (exp ">=" exp) + (exp "+" exp) + (exp "-" exp) + (exp "*" exp) + (exp "/" exp) + (exp "%" exp) +;; ("not" exp) +;; ("-" exp) +;; (exp "." methodcall) +;; (exp "." exp) +;; (exp "(" args ")") +;; (exp "(" args ")" indexcall) +;; ("[" array "]") +;; ("true") +;; ("false") + ) +;; (args (exp) + +;; (id ":" exp)) +;; (array (array "," array)) +;; (methodcall (exp "(" args ")" ) +;; ;; (exp "(" args ")" "." methodcall) +;; ) + ;; (indexcall ( "[" exp "]")) + ) + `((assoc "eol" "elif")) ; FIXME: Solving eol/elif conflict this + ; way may cause problems in indetation. + ; Revisit this if it is the case. + `((assoc "eol") + (assoc ",") + (assoc ":") + (assoc "+=" "=") + (assoc "or") + (assoc "and") + (assoc "==" "!=" "<" "<=" ">" ">=") + (assoc "+" "-") + (assoc "*" "/" "%") + (assoc ".") + ) + ))) + +(defgroup meson nil + "Meson build system mode for Emacs." + :group 'tools + :prefix "meson-") + +(defcustom meson-indent-basic 2 + "Indentation offset for meson.build files." + :type 'integer) + +(defun meson-smie-rules (kind token) + (pcase (cons kind token) + (`(:elem . basic) meson-indent-basic) + (`(:elem . args) (- (save-excursion (beginning-of-line-text) (point)) (point))) + (`(,_ . ",") (smie-rule-separator kind)) + (`(,(or :before :after) . "eol") (if (smie-rule-parent-p "if" "foreach" "elif" "else") + (smie-rule-parent meson-indent-basic) + (save-excursion + (smie-indent-forward-token) + (smie-backward-sexp 'halfsexp) + (cons 'column (current-column))))) + (`(:list-intro . ,(or "eol" ":" "")) t) ; "" is actually "[" because that's what lexer returns + (`(:after . ":") meson-indent-basic) + (`(:after . ,(or "=" "+=")) meson-indent-basic) + (`(:before . "[") (if (smie-rule-hanging-p) (smie-rule-parent))) + (`(:before . "(") (if (smie-rule-hanging-p) + (save-excursion + (smie-backward-sexp 'halfsexp) ; goto parent + (beginning-of-line-text) + (cons 'column (current-column))))) + (`(:after . ,(or "[" "(")) meson-indent-basic) + (`(:before . "elif") (smie-rule-parent)) + (_ nil))) + +;;; Mode definition + +;;;###autoload +(define-derived-mode meson-mode prog-mode "Meson" + "Major mode for editing Meson build system files." + :abbrev-table nil + (setq font-lock-defaults + '(meson-mode-font-lock-keywords + nil nil nil nil + )) + + (set (make-local-variable 'syntax-propertize-function) + meson-syntax-propertize-function) + + (set (make-local-variable 'comment-start) "# ") + (set (make-local-variable 'comment-end) "") + (add-hook 'completion-at-point-functions + #'meson-completion-at-point-function nil t) + (smie-setup meson-smie-grammar #'meson-smie-rules + :forward-token #'meson-smie-forward-token + :backward-token #'meson-smie-backward-token) + ) + +;;;###autoload +(progn + (add-to-list 'auto-mode-alist '("/meson\\(\\.build\\|_options\\.txt\\)\\'" . meson-mode)) + (eval-after-load 'compile + '(progn + (add-to-list 'compilation-error-regexp-alist 'meson) + (add-to-list 'compilation-error-regexp-alist-alist + '(meson "^Meson encountered an error in file \\(.*\\), line \\([0-9]+\\), column \\([0-9]+\\):" 1 2 3))))) + +(provide 'meson-mode) +;;; meson-mode.el ends here + +;;(progn (mapatoms (lambda (x) (when (string-prefix-p "meson" (symbol-name x)) (makunbound x)))) (eval-buffer)) diff --git a/site-lisp/org-tree-slide.el b/site-lisp/org-tree-slide.el new file mode 100644 index 0000000..6fb54cc --- /dev/null +++ b/site-lisp/org-tree-slide.el @@ -0,0 +1,873 @@ +;;; org-tree-slide.el --- A presentation tool for org-mode +;; +;; Copyright (C) 2011-2016 Takaaki ISHIKAWA +;; +;; Author: Takaaki ISHIKAWA +;; Version: 2.8.5 +;; Maintainer: Takaaki ISHIKAWA +;; Twitter: @takaxp +;; Repository: https://github.com/takaxp/org-tree-slide +;; Keywords: org-mode, presentation, narrowing +;; +;; Committers: Yuuki ARISAWA (@uk-ar) +;; Eric S Fraga +;; Eike Kettner +;; Stefano BENNATI +;; Matus Goljer +;; +;; 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;; + +;;; Commentary: + +;; Requirement: +;; org-mode 6.33x or higher version +;; The latest version of the org-mode is recommended. +;; (see http://orgmode.org/) +;; +;; Usage: +;; 1. Put this elisp into your load-path +;; 2. Add (require 'org-tree-slide) in your .emacs +;; 3. Open an org-mode file +;; 4. Toggle org-tree-slide-mode (M-x org-tree-slide-mode) +;; then Slideshow will start and you can find "TSlide" in mode line. +;; 5. / will move between slides +;; 6. `C-x s c' will show CONTENT of the org buffer +;; Select a heading and type , then Slideshow will start again. +;; 7. Toggle org-tree-slide-mode again to exit this minor mode +;; +;; Recommended minimum settings: +;; (global-set-key (kbd "") 'org-tree-slide-mode) +;; (global-set-key (kbd "S-") 'org-tree-slide-skip-done-toggle) +;; +;; and three useful profiles are available. +;; +;; 1. Simple use +;; M-x org-tree-slide-simple-profile +;; +;; 2. Presentation use +;; M-x org-tree-slide-presentation-profile +;; +;; 3. TODO Pursuit with narrowing +;; M-x org-tree-slide-narrowing-control-profile +;; +;; Type `C-h f org-tree-slide-mode', you can find more detail. +;; +;; Note: +;; - Make sure key maps below when you introduce this elisp. +;; - Customize variables, M-x customize-group ENT org-tree-slide ENT + +;;; Code: + +(require 'org) +(require 'org-timer) +;;(require 'org-clock) ; org-clock-in, -out, -clocking-p + +(defconst org-tree-slide "2.8.5" + "The version number of the org-tree-slide.el") + +(defgroup org-tree-slide nil + "User variables for org-tree-slide." + :group 'org-structure) + +(defcustom org-tree-slide-skip-outline-level 0 + "Skip slides if a heading level is higher than or equal to this variable. + `0': never skip at any heading + e.g. set `4', + *** heading A ; display as a slide + entry + **** heading B ; skip! do not display as the next slide + **** heading C ; skip! + *** heading D ; display as the next slide +" + :type 'integer + :group 'org-tree-slide) + +(defcustom org-tree-slide-fold-subtrees-skipped t + "If this flag is true, the subtrees in a slide will be displayed in fold. + When nil, the body of the subtrees will be revealed. +" + :type 'boolean + :group 'org-tree-slide) + +(defcustom org-tree-slide-header t + "The status of displaying the slide header" + :type 'boolean + :group 'org-tree-slide) + +(defcustom org-tree-slide-slide-in-effect t + "Using a visual effect of slide-in for displaying trees." + :type 'boolean + :group 'org-tree-slide) + +(defcustom org-tree-slide-cursor-init t + "Specify a cursor position when exit slideshow. + `t': the cursor will move automatically to the head of buffer. + nil: keep the same position." + :type 'boolean + :group 'org-tree-slide) + +(defcustom org-tree-slide-slide-in-blank-lines 10 + "Specify the number of blank lines, the slide will move from this line." + :type 'integer + :group 'org-tree-slide) + +(defcustom org-tree-slide-slide-in-waiting 0.02 + "Specify the duration waiting the next update of overlay." + :type 'float + :group 'org-tree-slide) + +(defcustom org-tree-slide-heading-emphasis nil + "Specify to use a custom face heading, or not" + :type 'boolean + :group 'org-tree-slide) + +(defcustom org-tree-slide-never-touch-face nil + "If t, do NOT touch any face setting." + :type 'boolean + :group 'org-tree-slide) + +(defcustom org-tree-slide-skip-done nil + "Specify to show TODO item only or not." + :type 'boolean + :group 'org-tree-slide) + +(defcustom org-tree-slide-skip-comments t + "Specify to skip COMMENT item or not." + :type 'boolean + :group 'org-tree-slide) + +(defcustom org-tree-slide-activate-message + "Hello! This is org-tree-slide :-)" + "Message in mini buffer when org-tree-slide is activated." + :type 'string + :group 'org-tree-slide) + +(defcustom org-tree-slide-deactivate-message + "Quit, Bye!" + "Message in mini buffer when org-tree-slide is deactivated." + :type 'string + :group 'org-tree-slide) + +(defcustom org-tree-slide-modeline-display 'outside + "Specify how to display the slide number in mode line. + 'lighter: shown in lighter (update info actively, then it's slow) + 'outside: update infomation when moving to the next/previous slide + nil: nothing to be shown" + :type 'symbol + :group 'org-tree-slide) + +(defvar org-tree-slide-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-x s c") 'org-tree-slide-content) + ;; (define-key map (kbd "C-x s r") 'org-tree-slide-resume) ;; TODO + (define-key map (kbd "C-<") 'org-tree-slide-move-previous-tree) + (define-key map (kbd "C->") 'org-tree-slide-move-next-tree) + map) + "The keymap for `org-tree-slide'.") + +(defface org-tree-slide-heading-level-2-init + '((t (:inherit outline-2))) + "Level 2." + :group 'org-tree-slide) + +(defface org-tree-slide-heading-level-3-init + '((t (:inherit outline-3))) + "Level 3." + :group 'org-tree-slide) + +(defface org-tree-slide-heading-level-2 + '((t (:inherit outline-2 :height 1.4 :bold t))) + "Level 2." + :group 'org-tree-slide) + +(defface org-tree-slide-heading-level-3 + '((t (:inherit outline-3 :height 1.3 :bold t))) + "Level 3." + :group 'org-tree-slide) + +(defvar org-tree-slide-mode nil) +;; These hooks was obsoleted, and will be deleted by Oct. 2015. +(defvar org-tree-slide-mode-play-hook nil + "[obsolete] A hook run when org-tree-slide--play is evaluated to start the slide show") +(defvar org-tree-slide-mode-stop-hook nil + "[obsolete] A hook run when org-tree-slide--stop is evaluated to stop the slide show") +(defvar org-tree-slide-mode-before-narrow-hook nil + "[obsolete] A hook run before evaluating org-tree-slide--display-tree-with-narrow") +(defvar org-tree-slide-mode-after-narrow-hook nil + "[obsolete] A hook run after evaluating org-tree-slide--display-tree-with-narrow") + +;; Updated hooks +(defvar org-tree-slide-play-hook nil + "A hook run when org-tree-slide--play is evaluated to start the slide show") +(defvar org-tree-slide-stop-hook nil + "A hook run when org-tree-slide--stop is evaluated to stop the slide show") +(defvar org-tree-slide-before-narrow-hook nil + "A hook run before evaluating org-tree-slide--display-tree-with-narrow") +(defvar org-tree-slide-after-narrow-hook nil + "A hook run after evaluating org-tree-slide--display-tree-with-narrow") +(defvar org-tree-slide-before-move-next-hook nil + "A hook run before moving to the next slide") +(defvar org-tree-slide-before-move-previous-hook nil + "A hook run before moving to the previous slide") + +;;;###autoload +(define-minor-mode org-tree-slide-mode + "A presentation tool for org-mode. + +Usage: + - Set minimal recommendation settings in .emacs + (global-set-key (kbd \"\") 'org-tree-slide-mode) + (global-set-key (kbd \"S-\") 'org-tree-slide-skip-done-toggle) + - Open an org file + - Type to start org-tree-slide-mode + - Type / to move between trees + - To exit this minor mode, just type again. + +Profiles: + + - [ Simple ] + => M-x `org-tree-slide-simple-profile' + + 1. No header display + 2. No slide-in effect + 3. The cursor will move to the head of buffer when exit + 4. No slide number display in mode line + 5. Display every type of tree + + - [ Presentation ] + => M-x `org-tree-slide-presentation-profile' + + 1. Display header + 2. Enable slide-in effect + 3. The cursor will move to the head of buffer when exit + 4. Display slide number in mode line + 5. Display every type of tree + + - [ TODO Pursuit with narrowing ] + => M-x `org-tree-slide-narrowing-control-profile' + + 1. No header display + 2. No slide-in effect + 3. The cursor will keep the same position when exit + 4. Display slide number in mode line + 5. Display TODO trees only +" + :init-value nil + :lighter (:eval (org-tree-slide--update-modeline)) + :keymap org-tree-slide-mode-map + :group 'org-tree-slide + :require 'org + (if org-tree-slide-mode + (org-tree-slide--setup) + (org-tree-slide--abort))) + +;;;###autoload +(defun org-tree-slide-play-with-timer () + "Start slideshow with setting a count down timer." + (interactive) + (org-timer-set-timer) + (unless (org-tree-slide--active-p) + (org-tree-slide-mode))) + +;;;###autoload +(defun org-tree-slide-without-init-play () + "Start slideshow without the init play. Just enter org-tree-slide-mode." + (interactive) + (org-tree-slide-mode) + (widen) + (org-overview) + (goto-char 1)) + +;;;###autoload +(defun org-tree-slide-content () + "Change the display for viewing content of the org file during + the slide view mode is active." + (interactive) + (when (org-tree-slide--active-p) + (org-tree-slide--hide-slide-header) + (org-tree-slide--move-to-the-first-heading) + (org-overview) + (org-content (if (> org-tree-slide-skip-outline-level 0) + (1- org-tree-slide-skip-outline-level))) + (message "<< CONTENT >>"))) + +;;;###autoload +(defun org-tree-slide-simple-profile () + "Set variables for simple use. + `org-tree-slide-header' => nil + `org-tree-slide-slide-in-effect' => nil + `org-tree-slide-heading-emphasis' => nil + `org-tree-slide-cursor-init' => t + `org-tree-slide-modeline-display' => nil + `org-tree-slide-skip-done' => nil + `org-tree-slide-skip-comments' => t +" + (interactive) + (setq org-tree-slide-header nil) + (setq org-tree-slide-slide-in-effect nil) + (setq org-tree-slide-heading-emphasis nil) + (setq org-tree-slide-cursor-init t) + (setq org-tree-slide-modeline-display nil) + (setq org-tree-slide-skip-done nil) + (setq org-tree-slide-skip-comments t) + (message "simple profile: ON")) + +;;;###autoload +(defun org-tree-slide-presentation-profile () + "Set variables for presentation use. + `org-tree-slide-header' => t + `org-tree-slide-slide-in-effect' => t + `org-tree-slide-heading-emphasis' => nil + `org-tree-slide-cursor-init' => t + `org-tree-slide-modeline-display' => 'outside + `org-tree-slide-skip-done' => nil + `org-tree-slide-skip-comments' => t +" + (interactive) + (setq org-tree-slide-header t) + (setq org-tree-slide-slide-in-effect t) + (setq org-tree-slide-heading-emphasis nil) + (setq org-tree-slide-cursor-init t) + (setq org-tree-slide-modeline-display 'outside) + (setq org-tree-slide-skip-done nil) + (setq org-tree-slide-skip-comments t) + (message "presentation profile: ON")) + +;;;###autoload +(defun org-tree-slide-narrowing-control-profile () + "Set variables for TODO pursuit with narrowing. + `org-tree-slide-header' => nil + `org-tree-slide-slide-in-effect' => nil + `org-tree-slide-heading-emphasis' => nil + `org-tree-slide-cursor-init' => nil + `org-tree-slide-modeline-display' => 'lighter + `org-tree-slide-skip-done' => t + `org-tree-slide-skip-comments' => t +" + (interactive) + (setq org-tree-slide-header nil) + (setq org-tree-slide-slide-in-effect nil) + (setq org-tree-slide-heading-emphasis nil) + (setq org-tree-slide-cursor-init nil) + (setq org-tree-slide-modeline-display 'lighter) + (setq org-tree-slide-skip-done t) + (setq org-tree-slide-skip-comments t) + (message "narrowing control profile: ON")) + +;;;###autoload +(defun org-tree-slide-display-header-toggle () + "Toggle displaying the slide header" + (interactive) + (setq org-tree-slide-header (not org-tree-slide-header)) + (unless org-tree-slide-header + (org-tree-slide--hide-slide-header)) + (org-tree-slide--display-tree-with-narrow)) + +;;;###autoload +(defun org-tree-slide-slide-in-effect-toggle () + "Toggle using slide-in effect" + (interactive) + (setq org-tree-slide-slide-in-effect (not org-tree-slide-slide-in-effect)) + (org-tree-slide--display-tree-with-narrow)) + +;;;###autoload +(defun org-tree-slide-heading-emphasis-toggle () + "Toggle applying emphasis to heading" + (interactive) + (setq org-tree-slide-heading-emphasis (not org-tree-slide-heading-emphasis)) + (org-tree-slide--apply-custom-heading-face org-tree-slide-heading-emphasis)) + +(defvar org-tree-slide--previous-line 0) +;;;###autoload +(defun org-tree-slide-skip-done-toggle () + "Toggle show TODO item only or not" + (interactive) + (setq org-tree-slide-skip-done (not org-tree-slide-skip-done)) + (setq org-tree-slide--previous-line -1) ; to update modeline intentionally + (when org-tree-slide-header + (org-tree-slide--show-slide-header)) + (if org-tree-slide-skip-done + (message "TODO Pursuit: ON") (message "TODO Pursuit: OFF"))) + +;;;###autoload +(defun org-tree-slide-skip-comments-toggle () + "Toggle show COMMENT item or not" + (interactive) + (setq org-tree-slide-skip-comments (not org-tree-slide-skip-comments)) + (if org-tree-slide-skip-comments + (message "COMMENT: HIDE") (message "COMMENT: SHOW"))) + +(defun org-tree-slide-move-next-tree () + "Display the next slide" + (interactive) + (when (org-tree-slide--active-p) + (unless (equal org-tree-slide-modeline-display 'outside) + (message " Next >>")) + (cond + ((and (org-tree-slide--narrowing-p) ;displaying a slide, not the contents + (org-tree-slide--last-tree-p (progn (beginning-of-line) (point)))) ;the last subtree + (org-tree-slide-content)) + ((or + (or (and (org-tree-slide--before-first-heading-p) + (not (org-at-heading-p))) + (and (= (point-at-bol) 1) (not (org-tree-slide--narrowing-p)))) + (or (org-tree-slide--first-heading-with-narrow-p) + (not (org-at-heading-p)))) + (run-hooks 'org-tree-slide-before-move-next-hook) + (widen) + (org-tree-slide--outline-next-heading) + (org-tree-slide--display-tree-with-narrow)) + ;; stay the same slide (for CONTENT MODE, on the subtrees) + (t nil (org-tree-slide--display-tree-with-narrow))) + ;; (when (and org-tree-slide-skip-done (looking-at (concat "^\\*+ " org-not-done-regexp))) (org-clock-in) ) + )) + +(defun org-tree-slide-move-previous-tree () + "Display the previous slide" + (interactive) + (when (org-tree-slide--active-p) + (unless (equal org-tree-slide-modeline-display 'outside) + (message "<< Previous")) + (org-tree-slide--hide-slide-header) ; for at the first heading + (run-hooks 'org-tree-slide-before-move-previous-hook) + (widen) + (cond + ((org-tree-slide--before-first-heading-p) + (message "before first heading (org-tree-slide)" )) + ((not (org-at-heading-p)) + (org-tree-slide--outline-previous-heading) + (org-tree-slide--outline-previous-heading)) + (t (org-tree-slide--outline-previous-heading))) + ;; (when (and org-tree-slide-skip-done (looking-at (concat "^\\*+ " org-not-done-regexp))) (org-clock-in) ) + (org-tree-slide--display-tree-with-narrow) + ;; To avoid error of missing header in Emacs24 + (if (= emacs-major-version 24) + (goto-char (point-min))))) + +;;; Internal functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar org-tree-slide--slide-number nil) +(make-variable-buffer-local 'org-tree-slide--slide-number) + +(defvar org-tree-slide--lighter " TSlide" + "Lighter for org-tree-slide. +This is displayed by default if `org-tree-slide-modeline-display' is `nil'.") + +(defun org-tree-slide--line-number-at-pos () + (save-excursion + (save-restriction + (widen) + (line-number-at-pos)))) + +(defun org-tree-slide--update-modeline () + (when (org-tree-slide--active-p) + (cond + ((equal org-tree-slide-modeline-display 'lighter) + (setq org-tree-slide--slide-number + (format " %s" (org-tree-slide--count-slide (point)))) + (setq org-tree-slide--previous-line (org-tree-slide--line-number-at-pos)) + org-tree-slide--slide-number) + ;; just return the current org-tree-slide--slide-number quickly. + ((equal org-tree-slide-modeline-display 'outside) + org-tree-slide--slide-number) + (t org-tree-slide--lighter)))) + +(defvar org-tree-slide--header-overlay nil + "Flag to check the status of overlay for a slide header.") + +(defun org-tree-slide--setup () + (when (org-tree-slide--active-p) + (org-tree-slide--play))) + +(defun org-tree-slide--abort () + (when (equal major-mode 'org-mode) + (org-tree-slide--stop))) + +(defun org-tree-slide--play () + "Start slide view with the first tree of the org-mode buffer." + (run-hooks 'org-tree-slide-mode-play-hook) + (run-hooks 'org-tree-slide-play-hook) + (org-tree-slide--apply-local-header-to-slide-header) + (when org-tree-slide-heading-emphasis + (org-tree-slide--apply-custom-heading-face t)) + (when (or org-tree-slide-cursor-init (org-tree-slide--before-first-heading-p)) + (org-tree-slide--move-to-the-first-heading)) + (org-tree-slide--beginning-of-tree) + (when (org-tree-slide--heading-skip-p) + (org-tree-slide--outline-next-heading)) + (org-tree-slide--display-tree-with-narrow) + (when org-tree-slide-activate-message + (message "%s" org-tree-slide-activate-message))) + +(defvar org-tree-slide-startup "overview" + "If you have `#+STARTUP:' line in your org buffer, the org buffer will + be shown with corresponding status (content, showall, overview:default).") + +(defun org-tree-slide--stop () + "Stop the slide view, and redraw the org-mode buffer with #+STARTUP:." + (widen) + (org-show-siblings) + (when (or org-tree-slide-cursor-init (org-tree-slide--before-first-heading-p)) + (goto-char (point-min)) + (org-overview) + (cond ((equal "content" org-tree-slide-startup) + (message "CONTENT: %s" org-tree-slide-startup) + (org-content)) + ((equal "showall" org-tree-slide-startup) + (message "SHOW ALL: %s" org-tree-slide-startup) + (org-cycle '(64))) + (t nil))) + (org-tree-slide--hide-slide-header) + (when org-timer-start-time + (org-timer-stop)) + (when org-tree-slide-heading-emphasis + (org-tree-slide--apply-custom-heading-face nil)) + ;; (when (and org-tree-slide-skip-done (looking-at (concat "^\\*+ " org-not-done-regexp))) (when (org-clocking-p) (org-clock-out) ) ) + (run-hooks 'org-tree-slide-mode-stop-hook) + (run-hooks 'org-tree-slide-stop-hook) + (when org-tree-slide-deactivate-message + (message "%s" org-tree-slide-deactivate-message))) + +(defun org-tree-slide--display-tree-with-narrow () + "Show a tree with narrowing and also set a header at the head of slide." + (run-hooks 'org-tree-slide-mode-before-narrow-hook) + (run-hooks 'org-tree-slide-before-narrow-hook) + (when (equal org-tree-slide-modeline-display 'outside) + (setq org-tree-slide--slide-number + (format " %s" (org-tree-slide--count-slide (point)))) + (setq org-tree-slide--previous-line (org-tree-slide--line-number-at-pos))) + (goto-char (point-at-bol)) + (unless (org-tree-slide--before-first-heading-p) + (hide-subtree) ; support CONTENT (subtrees are shown) + (org-show-entry) + ;; If this is the last level to be displayed, show the full content + (if (and (not org-tree-slide-fold-subtrees-skipped) + (org-tree-slide--heading-level-skip-p (1+ (org-outline-level)))) + (org-tree-slide--show-subtree) + (show-children)) + ;; (org-cycle-hide-drawers 'all) ; disabled due to performance reduction + (org-narrow-to-subtree)) + (when org-tree-slide-slide-in-effect + (org-tree-slide--slide-in org-tree-slide-slide-in-blank-lines)) + (when org-tree-slide-header + (org-tree-slide--show-slide-header)) + (run-hooks 'org-tree-slide-after-narrow-hook) + (run-hooks 'org-tree-slide-mode-after-narrow-hook)) + +(defun org-tree-slide--show-subtree () + "Show everything after this heading at deeper levels except COMMENT items." + (save-excursion + (outline-back-to-heading) + (outline-map-region + (lambda () + (if (org-tree-slide--heading-skip-comment-p) + (hide-subtree) + (show-subtree) + (org-cycle-hide-drawers 'all))) + (point) + (progn (outline-end-of-subtree) + (if (eobp) (point-max) (1+ (point))))))) + +(defun org-tree-slide--outline-next-heading () + (org-tree-slide--outline-select-method + (org-tree-slide--outline-skip-type + (if (outline-next-heading) t 'last) + (org-outline-level)) + 'next)) + +(defun org-tree-slide--outline-previous-heading () + (org-tree-slide--outline-select-method + (org-tree-slide--outline-skip-type + (if (outline-previous-heading) t 'first) + (org-outline-level)) + 'previous)) + +(defvar org-tree-slide--all-skipped t + "A flag to know if all trees are skipped") + +(defun org-tree-slide--outline-select-method (action direction) + (cond ((and (equal action 'last) (equal direction 'next)) + (unless org-tree-slide--all-skipped + (org-tree-slide--outline-previous-heading))) ; Return back. + ((and (equal action 'first) (equal direction 'previous)) + (unless org-tree-slide--all-skipped + (org-tree-slide--move-to-the-first-heading))) ; Stay first heading + ((and (equal action 'skip) (equal direction 'next)) + (org-tree-slide--outline-next-heading)) ; recursive call + ((and (equal action 'skip) (equal direction 'previous)) + (org-tree-slide--outline-previous-heading)) ; recursive call + (t + (setq org-tree-slide--all-skipped nil) + nil))) + +(defun org-tree-slide--heading-skip-p () + "This method assume the cursor exist at the heading. +** COMMENT ; t + hoge ; nil + hoge ; nil +*** hoge ; nil +" + (or (or (org-tree-slide--heading-done-skip-p) + (org-tree-slide--heading-level-skip-p)) + (org-tree-slide--heading-skip-comment-p))) + +(defun org-tree-slide--heading-level-skip-p (&optional level) + (and (> org-tree-slide-skip-outline-level 0) + (<= org-tree-slide-skip-outline-level (or level (org-outline-level))))) + +(defun org-tree-slide--heading-done-skip-p () + (and org-tree-slide-skip-done + (not + (looking-at + ;; 6.33x does NOT support org-outline-regexp-bol + (concat "^\\*+ " org-not-done-regexp))))) + +(defun org-tree-slide--heading-skip-comment-p () + (and org-tree-slide-skip-comments + (looking-at (concat "^\\*+ " org-comment-string)))) + +(defun org-tree-slide--outline-skip-type (has-target-outline current-level) + (cond ((equal has-target-outline 'last) 'last) + ((equal has-target-outline 'first) 'first) + ((org-tree-slide--heading-skip-p) 'skip) + (t nil))) + +(defun org-tree-slide--slide-in (blank-lines) + (let ((min-line -1)) + (when org-tree-slide-header + (setq min-line 2)) + (while (< min-line blank-lines) + (org-tree-slide--set-slide-header blank-lines) + (sit-for org-tree-slide-slide-in-waiting) + (setq blank-lines (1- blank-lines))))) + +(defvar org-tree-slide-title nil + "If you have `#+TITLE:' line in your org buffer, it wil be used as a title + of the slide. If the buffer has no `#+TITLE:' line, the name of + current buffer will be displayed.") + +(defvar org-tree-slide-email nil + "If you have `#+EMAIL:' line in your org buffer, it will be used as + an address of the slide.") + +(defvar org-tree-slide-author nil + "If you have `#+AUTHOR:' line in your org buffer, it will be used as + a name of the slide author.") + +(defcustom org-tree-slide-breadcrumbs " > " + "Display breadcrumbs in the slide header. + +If non-nil, it should be a string used as a delimiter used to +concat the headers." + :type '(choice (const :tag "Don't display breadcrumbs" nil) + (string :tag "Delimiter")) + :group 'org-tree-slide) + +(defcustom org-tree-slide-breadcrumbs-hide-todo-state t + "If non-nil, hide TODO states in the breadcrumbs." + :type 'boolean + :group 'org-tree-slide) + +(defun org-tree-slide--apply-local-header-to-slide-header () + (save-excursion + (org-tree-slide--move-to-the-first-heading) + (let ((limit (point))) + (org-tree-slide--set-header-var-by-regxep + 'org-tree-slide-title "#\\+TITLE:[ \t]*\\(.*\\)$" limit) + (org-tree-slide--set-header-var-by-regxep + 'org-tree-slide-author "#\\+AUTHOR:[ \t]*\\(.*\\)$" limit) + (org-tree-slide--set-header-var-by-regxep + 'org-tree-slide-email "#\\+EMAIL:[ \t]*\\(.*\\)$" limit) + (org-tree-slide--set-header-var-by-regxep + 'org-tree-slide-startup "#\\+STARTUP:[ \t]*\\(.*\\)$" limit)))) + +(defun org-tree-slide--set-header-var-by-regxep (header-variable regexp limit) + (goto-char 1) + (set header-variable + (if (re-search-forward regexp limit t) (match-string 1) nil))) + +(defface org-tree-slide-header-overlay-face + '((((class color) (background dark)) + (:bold t :foreground "white" :background "black")) + (((class color) (background light)) + (:bold t :foreground "black" :background "white")) + (t (:bold t :foreground "black" :background "white"))) + "Face for org-tree-slide--header-overlay") + +(defun org-tree-slide--get-parents (&optional delim) + "Get parent headlines and concat them with DELIM." + (setq delim (or delim " > ")) + (save-excursion + (save-restriction + (widen) + (let ((parents nil)) + (while (org-up-heading-safe) + (push (org-get-heading + 'no-tags + org-tree-slide-breadcrumbs-hide-todo-state) + parents)) + (mapconcat 'identity parents delim))))) + +(defun org-tree-slide--set-slide-header (blank-lines) + (org-tree-slide--hide-slide-header) + (setq org-tree-slide--header-overlay + (make-overlay (point-min) (+ 1 (point-min)))) + (overlay-put org-tree-slide--header-overlay 'after-string " ") + (overlay-put org-tree-slide--header-overlay + 'face + 'org-tree-slide-header-overlay-face) + (if org-tree-slide-header + (overlay-put org-tree-slide--header-overlay 'display + (concat (if org-tree-slide-title org-tree-slide-title + (buffer-name)) + "\n" + (format-time-string "%Y-%m-%d") " " + (when org-tree-slide-author + (concat org-tree-slide-author " ")) + (when org-tree-slide-email + (concat "<" org-tree-slide-email ">")) + (when org-tree-slide-breadcrumbs + (concat "\n" (org-tree-slide--get-parents + org-tree-slide-breadcrumbs))) + (org-tree-slide--get-blank-lines blank-lines))) + (overlay-put org-tree-slide--header-overlay 'display + (org-tree-slide--get-blank-lines blank-lines)))) + +(defun org-tree-slide--get-blank-lines (lines) + (let ((breaks "")) + (while (< 0 lines) + (setq lines (1- lines)) + (setq breaks (concat breaks "\n"))) + breaks)) + +(defun org-tree-slide--show-slide-header () + (org-tree-slide--set-slide-header 2)) + +(defun org-tree-slide--hide-slide-header () + (when org-tree-slide--header-overlay + (delete-overlay org-tree-slide--header-overlay))) + +(defun org-tree-slide--move-to-the-first-heading () + (setq org-tree-slide--all-skipped t) + (widen) + (goto-char 1) + (unless (looking-at "^\\*+ ") + (outline-next-heading)) + (when (org-tree-slide--heading-skip-p) + (setq org-tree-slide--all-skipped t) + (org-tree-slide--outline-next-heading))) + +(defun org-tree-slide--apply-custom-heading-face (status) + "Change status of heading face." + (unless org-tree-slide-never-touch-face + (cond (status + (custom-set-faces + '(org-level-2 ((t (:inherit org-tree-slide-heading-level-2)))) + '(org-level-3 ((t (:inherit org-tree-slide-heading-level-3)))))) + (t + (custom-set-faces + '(org-level-2 ((t (:inherit org-tree-slide-heading-level-2-init)))) + '(org-level-3 ((t (:inherit org-tree-slide-heading-level-3-init))))) + )))) + +(defun org-tree-slide--count-slide (&optional pos) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let ((count 0) + (current-slide 0) + (current-point (or pos (point)))) + (when (and (looking-at "^\\*+ ") (not (org-tree-slide--heading-skip-p))) + (setq count 1) + (setq current-slide 1)) + (while (outline-next-heading) + (when (not (org-tree-slide--heading-skip-p)) + (setq count (1+ count)) + (when (>= current-point (point)) + (setq current-slide (1+ current-slide))))) + (cond + ((= count 0) "[-/-]") ; no headings + ((= current-slide 0) (format "[-/%d]" count)) ; before first heading + (t + (format "[%d/%d]" current-slide count))))))) + +(defun org-tree-slide--active-p () + (and org-tree-slide-mode (equal major-mode 'org-mode))) + +(defun org-tree-slide--narrowing-p () + "Check the current status if narrowing or not" + (not (and (= (point-min) 1) (= (point-max) (1+ (buffer-size)))))) + +(defun org-tree-slide--before-first-heading-p () + "Extension of org-before-first-heading-p to support org 6.33x. +#+TITLE: title ; t +#+STARTUP: content ; t +* first ; t + hoge ; nil +** second ; nil +** third ; nil +" + (and (org-before-first-heading-p) (not (org-tree-slide--narrowing-p)))) + +(defun org-tree-slide--first-heading-with-narrow-p () + "Check the current point is on the first heading with narrowing. +** first ; t + hoge ; nil + hoge ; nil +*** second ; nil + hoge ; nil +*** third ; nil +" + (and (org-tree-slide--narrowing-p) (= (point-at-bol) (point-min)))) + +(defun org-tree-slide--last-tree-p (target) + "Check if the target point is in the last heading or it's body. +** n-1 ; nil +** n ; t + hoge ; t +" + (save-excursion + (save-restriction + (widen) + (goto-char target) + (if (org-tree-slide--beginning-of-tree) + (= (point) (org-tree-slide--last-heading-position)) + nil)))) + +(defun org-tree-slide--last-heading-position () + "Return the position of the last heading. + If the position does not exist in the buffer, then return nil." + (save-excursion + (save-restriction + (goto-char (buffer-size)) + (org-tree-slide--beginning-of-tree)))) + +(defun org-tree-slide--beginning-of-tree () + "Return beginning point of the line, or t. + If the position does not exist in the buffer, then return nil." + (beginning-of-line) + (if (and (not (org-tree-slide--heading-skip-p)) ;if the header has to be skipped + (org-at-heading-p)) + (point) + (progn + (outline-previous-heading) ;go to previous heading + (org-tree-slide--beginning-of-tree)) ;recursion until a visible heading is found + )) ; return position or nil. + +(provide 'org-tree-slide) + +;;; org-tree-slide.el ends here diff --git a/site-lisp/smerge.el b/site-lisp/smerge.el new file mode 100644 index 0000000..26bc711 --- /dev/null +++ b/site-lisp/smerge.el @@ -0,0 +1,48 @@ +;;; smerge-mode.el --- Minor mode for the Meson build system files -*- lexical-binding: t; -*- + +;; 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 minor mode to resolve via diff3. +;; Important keybindings: +;; smerge-next bound to smerge-command-prefixn to move to next conflict. +;; smerge-previous bound to smerge-command-prefixp to move to previous conflict. +;; smerge-keep-current bound to smerge-command-prefixRET to keep the version the cursor is on. +;; smerge-keep-mine bound to smerge-command-prefixm to keep your changes. +;; smerge-keep-other bound to smerge-command-prefixo to keep other changes. +;; smerge-ediff bound to smerge-command-prefixE to start an ediff session to merge the conflicts. This is same as vc-resolve-conflicts (thanks @phils and @Malabarba for pointing this out). + + +;;; Code: + +;; Default prefix +;; I find the default prefix for smerge-mode C-c^ cumbersome +;; next lines change it to to 'C-c v' +(setq smerge-command-prefix "\C-cv") + +;; Enabling smerge-mode automatically +(defun my-enable-smerge-maybe () + (when (and buffer-file-name (vc-backend buffer-file-name)) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward "^<<<<<<< " nil t) + (smerge-mode +1))))) + +(add-hook 'buffer-list-update-hook #'my-enable-smerge-maybe) + + +;;; smerge-mode.el ends here + +;;(progn (mapatoms (lambda (x) (when (string-prefix-p "smerge" (symbol-name x)) (makunbound x)))) (eval-buffer)) diff --git a/site-lisp/use-package.el b/site-lisp/use-package.el new file mode 100644 index 0000000..cfff545 --- /dev/null +++ b/site-lisp/use-package.el @@ -0,0 +1,1205 @@ +;;; use-package.el --- A use-package declaration for simplifying your .emacs + +;; Copyright (C) 2012 John Wiegley + +;; Author: John Wiegley +;; Maintainer: John Wiegley +;; Created: 17 Jun 2012 +;; Modified: 17 Oct 2016 +;; Version: 2.3 +;; Package-Requires: ((bind-key "1.0") (diminish "0.44")) +;; Keywords: dotemacs startup speed config package +;; URL: https://github.com/jwiegley/use-package + +;; 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 2, 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; The `use-package' declaration macro allows you to isolate package +;; configuration in your ".emacs" in a way that is performance-oriented and, +;; well, just tidy. I created it because I have over 80 packages that I use +;; in Emacs, and things were getting difficult to manage. Yet with this +;; utility my total load time is just under 1 second, with no loss of +;; functionality! +;; +;; Please see README.md from the same repository for documentation. + +;;; Code: + +(require 'bind-key) +(require 'bytecomp) +(require 'diminish nil t) +(require 'bytecomp) +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'regexp-opt)) + +(declare-function package-installed-p "package") +(declare-function package-read-all-archive-contents "package" ()) + +(defgroup use-package nil + "A use-package declaration for simplifying your `.emacs'." + :group 'startup) + +(defcustom use-package-verbose nil + "Whether to report about loading and configuration details. + +If you customize this, then you should require the `use-package' +feature in files that use `use-package', even if these files only +contain compiled expansions of the macros. If you don't do so, +then the expanded macros do their job silently." + :type '(choice (const :tag "Quiet" nil) (const :tag "Verbose" t) + (const :tag "Debug" debug)) + :group 'use-package) + +(defcustom use-package-debug nil + "Whether to display use-package expansions in a *use-package* buffer." + :type 'boolean + :group 'use-package) + +(defcustom use-package-check-before-init nil + "If non-nil, check that package exists before executing its `:init' block. +The check is performed by looking for the module using `locate-library'." + :type 'boolean + :group 'use-package) + +(defcustom use-package-always-defer nil + "If non-nil, assume `:defer t` unless `:demand t` is given." + :type 'boolean + :group 'use-package) + +(defcustom use-package-always-demand nil + "If non-nil, assume `:demand t` unless `:defer t` is given." + :type 'boolean + :group 'use-package) + +(defcustom use-package-always-ensure nil + "Treat every package as though it had specified `:ensure SEXP`." + :type 'sexp + :group 'use-package) + +(defcustom use-package-always-pin nil + "Treat every package as though it had specified `:pin SYM." + :type 'symbol + :group 'use-package) + +(defcustom use-package-minimum-reported-time 0.1 + "Minimal load time that will be reported. + +Note that `use-package-verbose' has to be set to t, for anything +to be reported at all. + +If you customize this, then you should require the `use-package' +feature in files that use `use-package', even if these files only +contain compiled expansions of the macros. If you don't do so, +then the expanded macros do their job silently." + :type 'number + :group 'use-package) + +(defcustom use-package-inject-hooks nil + "If non-nil, add hooks to the `:init' and `:config' sections. +In particular, for a given package `foo', the following hooks +become available: + + `use-package--foo--pre-init-hook' + `use-package--foo--post-init-hook' + `use-package--foo--pre-config-hook' + `use-package--foo--post-config-hook' + +This way, you can add to these hooks before evalaution of a +`use-package` declaration, and exercise some control over what +happens. + +Note that if either `pre-init' hooks returns a nil value, that +block's user-supplied configuration is not evaluated, so be +certain to return `t' if you only wish to add behavior to what +the user specified." + :type 'boolean + :group 'use-package) + +(defcustom use-package-keywords + '(:disabled + :preface + :pin + :ensure + :if + :when + :unless + :requires + :load-path + :no-require + :bind + :bind* + :bind-keymap + :bind-keymap* + :interpreter + :mode + :commands + :defines + :functions + :defer + :init + :after + :demand + :config + :diminish + :delight) + "Establish which keywords are valid, and the order they are processed in. + +Note that `:disabled' is special, in that it causes nothing at all to happen, +even if the rest of the use-package declaration is incorrect." + :type '(repeat symbol) + :group 'use-package) + +(defcustom use-package-expand-minimally nil + "If non-nil, make the expanded code as minimal as possible. +This disables: + - Printing to the *Messages* buffer of slowly-evaluating forms + - Capture of load errors (normally redisplayed as warnings) + - Conditional loading of packages (load failures become errors) +The only advantage is that, if you know your configuration works, +then your byte-compiled init file is as minimal as possible." + :type 'boolean + :group 'use-package) + +(defcustom use-package-enable-imenu-support nil + "If non-nil, adjust `lisp-imenu-generic-expression' to include +support for finding `use-package' and `require' forms. + +Must be set before loading use-package." + :type 'boolean + :group 'use-package) + +(when use-package-enable-imenu-support + ;; Not defined in Emacs 24 + (defvar lisp-mode-symbol-regexp + "\\(?:\\sw\\|\\s_\\|\\\\.\\)+") + (add-to-list + 'lisp-imenu-generic-expression + (list "Package" + (purecopy (concat "^\\s-*(" + (eval-when-compile + (regexp-opt + '("use-package" "require") + t)) + "\\s-+\\(" lisp-mode-symbol-regexp "\\)")) + 2))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Utility functions +;; + +(defun use-package-as-symbol (string-or-symbol) + "If STRING-OR-SYMBOL is already a symbol, return it. Otherwise +convert it to a symbol and return that." + (if (symbolp string-or-symbol) string-or-symbol + (intern string-or-symbol))) + +(defun use-package-as-string (string-or-symbol) + "If STRING-OR-SYMBOL is already a string, return it. Otherwise +convert it to a string and return that." + (if (stringp string-or-symbol) string-or-symbol + (symbol-name string-or-symbol))) + +(defun use-package-load-name (name &optional noerror) + "Return a form which will load or require NAME depending on +whether it's a string or symbol." + (if (stringp name) + `(load ,name ',noerror) + `(require ',name nil ',noerror))) + +(defun use-package-expand (name label form) + "FORM is a list of forms, so `((foo))' if only `foo' is being called." + (declare (indent 1)) + (when form + (if use-package-expand-minimally + form + (let ((err (make-symbol "err"))) + (list + `(condition-case-unless-debug ,err + ,(macroexp-progn form) + (error + (ignore + (display-warning 'use-package + (format "%s %s: %s" + ,name ,label (error-message-string ,err)) + :error))))))))) + +(put 'use-package-expand 'lisp-indent-function 'defun) + +(defun use-package-hook-injector (name-string keyword body) + "Wrap pre/post hook injections around a given keyword form. +ARGS is a list of forms, so `((foo))' if only `foo' is being called." + (if (not use-package-inject-hooks) + (use-package-expand name-string (format "%s" keyword) body) + (let ((keyword-name (substring (format "%s" keyword) 1))) + (when body + `((when ,(macroexp-progn + (use-package-expand name-string (format "pre-%s hook" keyword) + `((run-hook-with-args-until-failure + ',(intern (concat "use-package--" name-string + "--pre-" keyword-name "-hook")))))) + ,(macroexp-progn + (use-package-expand name-string (format "%s" keyword) body)) + ,(macroexp-progn + (use-package-expand name-string (format "post-%s hook" keyword) + `((run-hooks + ',(intern (concat "use-package--" name-string + "--post-" keyword-name "-hook")))))))))))) + +(defun use-package--with-elapsed-timer (text body) + "BODY is a list of forms, so `((foo))' if only `foo' is being called." + (declare (indent 1)) + (if use-package-expand-minimally + body + (let ((nowvar (make-symbol "now"))) + (if (bound-and-true-p use-package-verbose) + `((let ((,nowvar (current-time))) + (message "%s..." ,text) + (prog1 + ,(macroexp-progn body) + (let ((elapsed + (float-time (time-subtract (current-time) ,nowvar)))) + (if (> elapsed ,use-package-minimum-reported-time) + (message "%s...done (%.3fs)" ,text elapsed) + (message "%s...done" ,text)))))) + body)))) + +(put 'use-package--with-elapsed-timer 'lisp-indent-function 1) + +(defsubst use-package-error (msg) + "Report MSG as an error, so the user knows it came from this package." + (error "use-package: %s" msg)) + +(defsubst use-package-plist-maybe-put (plist property value) + "Add a VALUE for PROPERTY to PLIST, if it does not already exist." + (if (plist-member plist property) + plist + (plist-put plist property value))) + +(defsubst use-package-plist-cons (plist property value) + "Cons VALUE onto the head of the list at PROPERTY in PLIST." + (plist-put plist property (cons value (plist-get plist property)))) + +(defsubst use-package-plist-append (plist property value) + "Append VALUE onto the front of the list at PROPERTY in PLIST." + (plist-put plist property (append value (plist-get plist property)))) + +(defun use-package-plist-delete (plist property) + "Delete PROPERTY from PLIST. +This is in contrast to merely setting it to 0." + (let (p) + (while plist + (if (not (eq property (car plist))) + (setq p (plist-put p (car plist) (nth 1 plist)))) + (setq plist (cddr plist))) + p)) + +(defun use-package-split-list (pred xs) + (let ((ys (list nil)) (zs (list nil)) flip) + (dolist (x xs) + (if flip + (nconc zs (list x)) + (if (funcall pred x) + (progn + (setq flip t) + (nconc zs (list x))) + (nconc ys (list x))))) + (cons (cdr ys) (cdr zs)))) + +(defun use-package-keyword-index (keyword) + (loop named outer + with index = 0 + for k in use-package-keywords do + (if (eq k keyword) + (return-from outer index)) + (incf index))) + +(defun use-package-sort-keywords (plist) + (let (plist-grouped) + (while plist + (push (cons (car plist) (cadr plist)) + plist-grouped) + (setq plist (cddr plist))) + (let (result) + (dolist (x + (nreverse + (sort plist-grouped + #'(lambda (l r) (< (use-package-keyword-index (car l)) + (use-package-keyword-index (car r))))))) + (setq result (cons (car x) (cons (cdr x) result)))) + result))) + +(defsubst use-package-concat (&rest elems) + "Delete all empty lists from ELEMS (nil or (list nil)), and append them." + (apply #'nconc (delete nil (delete (list nil) elems)))) + +(defconst use-package-font-lock-keywords + '(("(\\(use-package\\)\\_>[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?" + (1 font-lock-keyword-face) + (2 font-lock-constant-face nil t)))) + +(font-lock-add-keywords 'emacs-lisp-mode use-package-font-lock-keywords) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Keyword processing +;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Normalization functions +;; + +(defun use-package-normalize-plist (name input) + "Given a pseudo-plist, normalize it to a regular plist." + (unless (null input) + (let* ((keyword (car input)) + (xs (use-package-split-list #'keywordp (cdr input))) + (args (car xs)) + (tail (cdr xs)) + (normalizer (intern (concat "use-package-normalize/" + (symbol-name keyword)))) + (arg + (cond + ((eq keyword :disabled) + (use-package-normalize-plist name tail)) + ((functionp normalizer) + (funcall normalizer name keyword args)) + ((= (length args) 1) + (car args)) + (t + args)))) + (if (memq keyword use-package-keywords) + (cons keyword + (cons arg (use-package-normalize-plist name tail))) + (use-package-error (format "Unrecognized keyword: %s" keyword)))))) + +(defun use-package-process-keywords (name plist &optional state) + "Process the next keyword in the free-form property list PLIST. +The values in the PLIST have each been normalized by the function +use-package-normalize/KEYWORD (minus the colon). + +STATE is a property list that the function may modify and/or +query. This is useful if a package defines multiple keywords and +wishes them to have some kind of stateful interaction. + +Unless the KEYWORD being processed intends to ignore remaining +keywords, it must call this function recursively, passing in the +plist with its keyword and argument removed, and passing in the +next value for the STATE." + (declare (indent 1)) + (unless (null plist) + (let* ((keyword (car plist)) + (arg (cadr plist)) + (rest (cddr plist))) + (unless (keywordp keyword) + (use-package-error (format "%s is not a keyword" keyword))) + (let* ((handler (concat "use-package-handler/" (symbol-name keyword))) + (handler-sym (intern handler))) + (if (functionp handler-sym) + (funcall handler-sym name keyword arg rest state) + (use-package-error + (format "Keyword handler not defined: %s" handler))))))) + +(put 'use-package-process-keywords 'lisp-indent-function 'defun) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :pin +;; + +(defun use-package-only-one (label args f) + "Call F on the first member of ARGS if it has exactly one element." + (declare (indent 1)) + (cond + ((and (listp args) (listp (cdr args)) + (= (length args) 1)) + (funcall f label (car args))) + (t + (use-package-error + (concat label " wants exactly one argument"))))) + +(put 'use-package-only-one 'lisp-indent-function 'defun) + +(defun use-package-normalize/:pin (name keyword args) + (use-package-only-one (symbol-name keyword) args + (lambda (label arg) + (cond + ((stringp arg) arg) + ((symbolp arg) (symbol-name arg)) + (t + (use-package-error + ":pin wants an archive name (a string)")))))) + +(eval-when-compile + (defvar package-pinned-packages) + (defvar package-archives)) + +(defun use-package--archive-exists-p (archive) + "Check if a given ARCHIVE is enabled. + +ARCHIVE can be a string or a symbol or 'manual to indicate a +manually updated package." + (if (member archive '(manual "manual")) + 't + (let ((valid nil)) + (dolist (pa package-archives) + (when (member archive (list (car pa) (intern (car pa)))) + (setq valid 't))) + valid))) + +(defun use-package-pin-package (package archive) + "Pin PACKAGE to ARCHIVE." + (unless (boundp 'package-pinned-packages) + (setq package-pinned-packages ())) + (let ((archive-symbol (if (symbolp archive) archive (intern archive))) + (archive-name (if (stringp archive) archive (symbol-name archive)))) + (if (use-package--archive-exists-p archive-symbol) + (add-to-list 'package-pinned-packages (cons package archive-name)) + (error "Archive '%s' requested for package '%s' is not available." + archive-name package)) + (unless (bound-and-true-p package--initialized) + (package-initialize t)))) + +(defun use-package-handler/:pin (name keyword archive-name rest state) + (let ((body (use-package-process-keywords name rest state)) + (pin-form (if archive-name + `(use-package-pin-package ',(use-package-as-symbol name) + ,archive-name)))) + ;; Pinning should occur just before ensuring + ;; See `use-package-handler/:ensure'. + (if (bound-and-true-p byte-compile-current-file) + (eval pin-form) ; Eval when byte-compiling, + (push pin-form body)) ; or else wait until runtime. + body)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :ensure +;; +(defvar package-archive-contents) +(defun use-package-normalize/:ensure (name keyword args) + (if (null args) + t + (use-package-only-one (symbol-name keyword) args + (lambda (label arg) + (if (symbolp arg) + arg + (use-package-error + (concat ":ensure wants an optional package name " + "(an unquoted symbol name)"))))))) + +(defun use-package-ensure-elpa (package &optional no-refresh) + (if (package-installed-p package) + t + (if (and (not no-refresh) + (assoc package (bound-and-true-p package-pinned-packages))) + (package-read-all-archive-contents)) + (if (or (assoc package package-archive-contents) no-refresh) + (package-install package) + (progn + (package-refresh-contents) + (use-package-ensure-elpa package t))))) + +(defun use-package-handler/:ensure (name keyword ensure rest state) + (let* ((body (use-package-process-keywords name rest state)) + (package-name (or (and (eq ensure t) (use-package-as-symbol name)) ensure)) + (ensure-form (if package-name + `(progn (require 'package) + (use-package-ensure-elpa ',package-name))))) + ;; We want to avoid installing packages when the `use-package' + ;; macro is being macro-expanded by elisp completion (see + ;; `lisp--local-variables'), but still do install packages when + ;; byte-compiling to avoid requiring `package' at runtime. + (if (bound-and-true-p byte-compile-current-file) + (eval ensure-form) ; Eval when byte-compiling, + (push ensure-form body)) ; or else wait until runtime. + body)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :if, :when and :unless +;; + +(defsubst use-package-normalize-value (label arg) + "Normalize a value." + (cond ((symbolp arg) + `(symbol-value ',arg)) + ((functionp arg) + `(funcall #',arg)) + (t arg))) + +(defun use-package-normalize-test (name keyword args) + (use-package-only-one (symbol-name keyword) args + #'use-package-normalize-value)) + +(defalias 'use-package-normalize/:if 'use-package-normalize-test) +(defalias 'use-package-normalize/:when 'use-package-normalize-test) +(defalias 'use-package-normalize/:unless 'use-package-normalize-test) + +(defun use-package-handler/:if (name keyword pred rest state) + (let ((body (use-package-process-keywords name rest state))) + `((when ,pred ,@body)))) + +(defalias 'use-package-handler/:when 'use-package-handler/:if) + +(defun use-package-handler/:unless (name keyword pred rest state) + (let ((body (use-package-process-keywords name rest state))) + `((unless ,pred ,@body)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :requires +;; + +(defun use-package-as-one (label args f) + "Call F on the first element of ARGS if it has one element, or all of ARGS." + (declare (indent 1)) + (if (and (listp args) (listp (cdr args))) + (if (= (length args) 1) + (funcall f label (car args)) + (funcall f label args)) + (use-package-error + (concat label " wants a list")))) + +(put 'use-package-as-one 'lisp-indent-function 'defun) + +(defun use-package-normalize-symbols (label arg &optional recursed) + "Normalize a list of symbols." + (cond + ((symbolp arg) + (list arg)) + ((and (not recursed) (listp arg) (listp (cdr arg))) + (mapcar #'(lambda (x) (car (use-package-normalize-symbols label x t))) arg)) + (t + (use-package-error + (concat label " wants a symbol, or list of symbols"))))) + +(defun use-package-normalize-symlist (name keyword args) + (use-package-as-one (symbol-name keyword) args + #'use-package-normalize-symbols)) + +(defalias 'use-package-normalize/:requires 'use-package-normalize-symlist) + +(defun use-package-handler/:requires (name keyword requires rest state) + (let ((body (use-package-process-keywords name rest state))) + (if (null requires) + body + `((when ,(if (listp requires) + `(not (member nil (mapcar #'featurep ',requires))) + `(featurep ',requires)) + ,@body))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :load-path +;; + +(defun use-package-normalize-paths (label arg &optional recursed) + "Normalize a list of filesystem paths." + (cond + ((and arg (or (symbolp arg) (functionp arg))) + (let ((value (use-package-normalize-value label arg))) + (use-package-normalize-paths label (eval value)))) + ((stringp arg) + (let ((path (if (file-name-absolute-p arg) + arg + (expand-file-name arg user-emacs-directory)))) + (list path))) + ((and (not recursed) (listp arg) (listp (cdr arg))) + (mapcar #'(lambda (x) + (car (use-package-normalize-paths label x t))) arg)) + (t + (use-package-error + (concat label " wants a directory path, or list of paths"))))) + +(defun use-package-normalize/:load-path (name keyword args) + (use-package-as-one (symbol-name keyword) args + #'use-package-normalize-paths)) + +(defun use-package-handler/:load-path (name keyword arg rest state) + (let ((body (use-package-process-keywords name rest state))) + (use-package-concat + (mapcar #'(lambda (path) + `(eval-and-compile (add-to-list 'load-path ,path))) arg) + body))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :no-require +;; + +(defun use-package-normalize-predicate (name keyword args) + (if (null args) + t + (use-package-only-one (symbol-name keyword) args + #'use-package-normalize-value))) + +(defalias 'use-package-normalize/:no-require 'use-package-normalize-predicate) + +(defun use-package-handler/:no-require (name keyword arg rest state) + ;; This keyword has no functional meaning. + (use-package-process-keywords name rest state)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :preface +;; + +(defun use-package-normalize-form (label args) + "Given a list of forms, return it wrapped in `progn'." + (unless (listp (car args)) + (use-package-error (concat label " wants a sexp or list of sexps"))) + (mapcar #'(lambda (form) + (if (and (consp form) + (eq (car form) 'use-package)) + (macroexpand form) + form)) args)) + +(defun use-package-normalize-forms (name keyword args) + (use-package-normalize-form (symbol-name keyword) args)) + +(defalias 'use-package-normalize/:preface 'use-package-normalize-forms) + +(defun use-package-handler/:preface (name keyword arg rest state) + (let ((body (use-package-process-keywords name rest state))) + (use-package-concat + (unless (null arg) + `((eval-and-compile ,@arg))) + body))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :bind, :bind* +;; + +(defsubst use-package-is-sympair (x &optional allow-vector) + "Return t if X has the type (STRING . SYMBOL)." + (and (consp x) + (or (stringp (car x)) + (and allow-vector (vectorp (car x)))) + (symbolp (cdr x)))) + +(defsubst use-package-is-string-pair (x) + "Return t if X has the type (STRING . STRING)." + (and (consp x) + (stringp (car x)) + (stringp (cdr x)))) + +(defun use-package-normalize-pairs + (name label arg &optional recursed allow-vector allow-string-cdrs) + "Normalize a list of string/symbol pairs. +If RECURSED is non-nil, recurse into sublists. +If ALLOW-VECTOR is non-nil, then the key to bind may specify a +vector of keys, as accepted by `define-key'. +If ALLOW-STRING-CDRS is non-nil, then the command name to bind to +may also be a string, as accepted by `define-key'." + (cond + ((or (stringp arg) (and allow-vector (vectorp arg))) + (list (cons arg (use-package-as-symbol name)))) + ((use-package-is-sympair arg allow-vector) + (list arg)) + ((and (not recursed) (listp arg) (listp (cdr arg))) + (mapcar #'(lambda (x) + (let ((ret (use-package-normalize-pairs + name label x t allow-vector allow-string-cdrs))) + (if (listp ret) + (car ret) + ret))) arg)) + ((and allow-string-cdrs (use-package-is-string-pair arg)) + (list arg)) + (t arg))) + +(defun use-package-normalize-binder (name keyword args) + (use-package-as-one (symbol-name keyword) args + (lambda (label arg) + (use-package-normalize-pairs name label arg nil t t)))) + +(defalias 'use-package-normalize/:bind 'use-package-normalize-binder) +(defalias 'use-package-normalize/:bind* 'use-package-normalize-binder) + +(defun use-package-handler/:bind + (name keyword arg rest state &optional bind-macro) + (let ((commands (remq nil (mapcar #'(lambda (arg) + (if (listp arg) + (cdr arg) + nil)) arg)))) + (use-package-concat + (use-package-process-keywords name + (use-package-sort-keywords + (use-package-plist-maybe-put rest :defer t)) + (use-package-plist-append state :commands commands)) + `((ignore + ,(macroexpand + `(,(if bind-macro bind-macro 'bind-keys) + :package ,name ,@arg))))))) + +(defun use-package-handler/:bind* (name keyword arg rest state) + (use-package-handler/:bind name keyword arg rest state 'bind-keys*)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :bind-keymap, :bind-keymap* +;; + +(defalias 'use-package-normalize/:bind-keymap 'use-package-normalize-binder) +(defalias 'use-package-normalize/:bind-keymap* 'use-package-normalize-binder) + +(defun use-package-autoload-keymap (keymap-symbol package override) + "Loads PACKAGE and then binds the key sequence used to invoke +this function to KEYMAP-SYMBOL. It then simulates pressing the +same key sequence a again, so that the next key pressed is routed +to the newly loaded keymap. + +This function supports use-package's :bind-keymap keyword. It +works by binding the given key sequence to an invocation of this +function for a particular keymap. The keymap is expected to be +defined by the package. In this way, loading the package is +deferred until the prefix key sequence is pressed." + (if (not (require package nil t)) + (use-package-error (format "Cannot load package.el: %s" package)) + (if (and (boundp keymap-symbol) + (keymapp (symbol-value keymap-symbol))) + (let* ((kv (this-command-keys-vector)) + (key (key-description kv)) + (keymap (symbol-value keymap-symbol))) + (if override + (bind-key* key keymap) + (bind-key key keymap)) + (setq unread-command-events + (listify-key-sequence kv))) + (use-package-error + (format "use-package: package.el %s failed to define keymap %s" + package keymap-symbol))))) + +(defun use-package-handler/:bind-keymap + (name keyword arg rest state &optional override) + (let ((form (mapcar + #'(lambda (binding) + `(,(if override + 'bind-key* + 'bind-key) + ,(car binding) + #'(lambda () + (interactive) + (use-package-autoload-keymap + ',(cdr binding) ',(use-package-as-symbol name) ,override)))) arg))) + (use-package-concat + (use-package-process-keywords name + (use-package-sort-keywords + (use-package-plist-maybe-put rest :defer t)) + state) + `((ignore ,@form))))) + +(defun use-package-handler/:bind-keymap* (name keyword arg rest state) + (use-package-handler/:bind-keymap name keyword arg rest state t)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :interpreter +;; + +(defun use-package-normalize-mode (name keyword args) + (use-package-as-one (symbol-name keyword) args + (apply-partially #'use-package-normalize-pairs name))) + +(defalias 'use-package-normalize/:interpreter 'use-package-normalize-mode) + +(defun use-package-handler/:interpreter (name keyword arg rest state) + (let* (commands + (form (mapcar #'(lambda (interpreter) + (push (cdr interpreter) commands) + `(add-to-list 'interpreter-mode-alist ',interpreter)) arg))) + (use-package-concat + (use-package-process-keywords name + (use-package-sort-keywords + (use-package-plist-maybe-put rest :defer t)) + (use-package-plist-append state :commands commands)) + `((ignore ,@form))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :mode +;; + +(defalias 'use-package-normalize/:mode 'use-package-normalize-mode) + +(defun use-package-handler/:mode (name keyword arg rest state) + (let* (commands + (form (mapcar #'(lambda (mode) + (push (cdr mode) commands) + `(add-to-list 'auto-mode-alist ',mode)) arg))) + (use-package-concat + (use-package-process-keywords name + (use-package-sort-keywords + (use-package-plist-maybe-put rest :defer t)) + (use-package-plist-append state :commands commands)) + `((ignore ,@form))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :commands +;; + +(defalias 'use-package-normalize/:commands 'use-package-normalize-symlist) + +(defun use-package-handler/:commands (name keyword arg rest state) + ;; The actual processing for commands is done in :defer + (use-package-process-keywords name + (use-package-sort-keywords + (use-package-plist-maybe-put rest :defer t)) + (use-package-plist-append state :commands arg))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :defines +;; + +(defalias 'use-package-normalize/:defines 'use-package-normalize-symlist) + +(defun use-package-handler/:defines (name keyword arg rest state) + (let ((body (use-package-process-keywords name rest state))) + body)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :functions +;; + +(defalias 'use-package-normalize/:functions 'use-package-normalize-symlist) + +(defun use-package-handler/:functions (name keyword arg rest state) + (let ((body (use-package-process-keywords name rest state))) + (if (not (bound-and-true-p byte-compile-current-file)) + body + (use-package-concat + (unless (null arg) + `((eval-when-compile + ,@(mapcar + #'(lambda (fn) + `(declare-function ,fn ,(use-package-as-string name))) arg)))) + body)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :defer +;; + +(defalias 'use-package-normalize/:defer 'use-package-normalize-predicate) + +(defun use-package-handler/:defer (name keyword arg rest state) + (let ((body (use-package-process-keywords name rest + (plist-put state :deferred t))) + (name-string (use-package-as-string name))) + (use-package-concat + ;; Load the package after a set amount of idle time, if the argument to + ;; `:defer' was a number. + (when (numberp arg) + `((run-with-idle-timer ,arg nil #'require ',(use-package-as-symbol name) nil t))) + + ;; Since we deferring load, establish any necessary autoloads, and also + ;; keep the byte-compiler happy. + (apply + #'nconc + (mapcar #'(lambda (command) + (when (not (stringp command)) + (append + `((unless (fboundp ',command) + (autoload #',command ,name-string nil t))) + (when (bound-and-true-p byte-compile-current-file) + `((eval-when-compile + (declare-function ,command ,name-string))))))) + (delete-dups (plist-get state :commands)))) + + body))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :after +;; + +(defalias 'use-package-normalize/:after 'use-package-normalize-symlist) + +(defun use-package-require-after-load (features name) + "Return form for after any of FEATURES require NAME." + `(progn + ,@(mapcar + (lambda (feat) + `(eval-after-load + (quote ,feat) + (quote (require (quote ,name) nil t)))) + features))) + +(defun use-package-handler/:after (name keyword arg rest state) + (let ((body (use-package-process-keywords name rest + (plist-put state :deferred t))) + (name-string (use-package-as-string name))) + (use-package-concat + (when arg + (list (use-package-require-after-load arg name))) + body))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :demand +;; + +(defalias 'use-package-normalize/:demand 'use-package-normalize-predicate) + +(defun use-package-handler/:demand (name keyword arg rest state) + (use-package-process-keywords name rest + (use-package-plist-delete state :deferred))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :init +;; + +(defalias 'use-package-normalize/:init 'use-package-normalize-forms) + +(defun use-package-handler/:init (name keyword arg rest state) + (let ((body (use-package-process-keywords name rest state))) + (use-package-concat + ;; The user's initializations + (let ((init-body + (use-package-hook-injector (use-package-as-string name) + :init arg))) + (if use-package-check-before-init + `((if (locate-library ,(use-package-as-string name)) + ,(macroexp-progn init-body))) + init-body)) + body))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :config +;; + +(defalias 'use-package-normalize/:config 'use-package-normalize-forms) + +(defun use-package-handler/:config (name keyword arg rest state) + (let* ((body (use-package-process-keywords name rest state)) + (name-symbol (use-package-as-symbol name)) + (config-body + (if (equal arg '(t)) + body + (use-package--with-elapsed-timer + (format "Configuring package %s" name-symbol) + (use-package-concat + (use-package-hook-injector (symbol-name name-symbol) + :config arg) + body + (list t)))))) + (if (plist-get state :deferred) + (unless (or (null config-body) (equal config-body '(t))) + `((eval-after-load ,(if (symbolp name) `',name name) + ',(macroexp-progn config-body)))) + (use-package--with-elapsed-timer + (format "Loading package %s" name) + (if use-package-expand-minimally + (use-package-concat + (list (use-package-load-name name)) + config-body) + `((if (not ,(use-package-load-name name t)) + (ignore + (message (format "Cannot load %s" ',name))) + ,@config-body))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :diminish +;; + +(defun use-package-normalize-diminish (name label arg &optional recursed) + "Normalize the arguments to diminish down to a list of one of two forms: + SYMBOL + (SYMBOL . STRING)" + (cond + ((symbolp arg) + (list arg)) + ((stringp arg) + (list (cons (intern (concat (use-package-as-string name) "-mode")) arg))) + ((and (consp arg) (stringp (cdr arg))) + (list arg)) + ((and (not recursed) (listp arg) (listp (cdr arg))) + (mapcar #'(lambda (x) (car (use-package-normalize-diminish + name label x t))) arg)) + (t + (use-package-error + (concat label " wants a string, symbol, " + "(symbol . string) or list of these"))))) + +(defun use-package-normalize/:diminish (name keyword args) + (use-package-as-one (symbol-name keyword) args + (apply-partially #'use-package-normalize-diminish name))) + +(defun use-package-handler/:diminish (name keyword arg rest state) + (let ((body (use-package-process-keywords name rest state))) + (use-package-concat + (mapcar #'(lambda (var) + `(if (fboundp 'diminish) + ,(if (consp var) + `(diminish ',(car var) ,(cdr var)) + `(diminish ',var)))) + arg) + body))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; :delight +;; + +(defun use-package-normalize/:delight (name keyword args) + "Normalize arguments to delight." + (cond + ((and (= (length args) 1) + (symbolp (car args))) + (list (car args) nil name)) + ((and (= (length args) 2) + (symbolp (car args))) + (list (car args) (cadr args) (use-package-as-symbol name))) + ((and (= (length args) 3) + (symbolp (car args))) + args) + (t + (use-package-error ":delight expects same args as delight function")))) + +(defun use-package-handler/:delight (name keyword args rest state) + (let ((body (use-package-process-keywords name rest state))) + (use-package-concat + body + `((delight (quote ,(nth 0 args)) ,(nth 1 args) (quote ,(nth 2 args))) t)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; The main macro +;; + +;;;###autoload +(defmacro use-package (name &rest args) + "Declare an Emacs package by specifying a group of configuration options. + +For full documentation, please see the README file that came with +this file. Usage: + + (use-package package-name + [:keyword [option]]...) + +:init Code to run before PACKAGE-NAME has been loaded. +:config Code to run after PACKAGE-NAME has been loaded. Note that if + loading is deferred for any reason, this code does not execute + until the lazy load has occurred. +:preface Code to be run before everything except `:disabled'; this can + be used to define functions for use in `:if', or that should be + seen by the byte-compiler. + +:mode Form to be added to `auto-mode-alist'. +:interpreter Form to be added to `interpreter-mode-alist'. + +:commands Define autoloads for commands that will be defined by the + package. This is useful if the package is being lazily loaded, + and you wish to conditionally call functions in your `:init' + block that are defined in the package. + +:bind Bind keys, and define autoloads for the bound commands. +:bind* Bind keys, and define autoloads for the bound commands, + *overriding all minor mode bindings*. +:bind-keymap Bind a key prefix to an auto-loaded keymap defined in the + package. This is like `:bind', but for keymaps. +:bind-keymap* Like `:bind-keymap', but overrides all minor mode bindings + +:defer Defer loading of a package -- this is implied when using + `:commands', `:bind', `:bind*', `:mode' or `:interpreter'. + This can be an integer, to force loading after N seconds of + idle time, if the package has not already been loaded. + +:after Defer loading of a package until after any of the named + features are loaded. + +:demand Prevent deferred loading in all cases. + +:if EXPR Initialize and load only if EXPR evaluates to a non-nil value. +:disabled The package is ignored completely if this keyword is present. +:defines Declare certain variables to silence the byte-compiler. +:functions Declare certain functions to silence the byte-compiler. +:load-path Add to the `load-path' before attempting to load the package. +:diminish Support for diminish.el (if installed). +:ensure Loads the package using package.el if necessary. +:pin Pin the package to an archive." + (declare (indent 1)) + (unless (member :disabled args) + (let* ((name-symbol (if (stringp name) (intern name) name)) + (args0 (use-package-plist-maybe-put + (use-package-normalize-plist name args) + :config '(t))) + (args* (use-package-sort-keywords + (if use-package-always-ensure + (use-package-plist-maybe-put + args0 :ensure use-package-always-ensure) + args0))) + (args* (use-package-sort-keywords + (if use-package-always-pin + (use-package-plist-maybe-put + args* :pin use-package-always-pin) + args*)))) + + ;; When byte-compiling, pre-load the package so all its symbols are in + ;; scope. + (if (bound-and-true-p byte-compile-current-file) + (setq args* + (use-package-plist-cons + args* :preface + `(eval-when-compile + ,@(mapcar #'(lambda (var) `(defvar ,var)) + (plist-get args* :defines)) + (with-demoted-errors + ,(format "Cannot load %s: %%S" name) + ,(if (eq use-package-verbose 'debug) + `(message "Compiling package %s" ',name-symbol)) + ,(unless (plist-get args* :no-require) + (use-package-load-name name))))))) + + (let ((body + (macroexp-progn + (use-package-process-keywords name + (if use-package-always-demand + (append args* '(:demand t)) + args*) + (and use-package-always-defer (list :deferred t)))))) + (if use-package-debug + (display-buffer + (save-current-buffer + (let ((buf (get-buffer-create "*use-package*"))) + (with-current-buffer buf + (delete-region (point-min) (point-max)) + (emacs-lisp-mode) + (insert (pp-to-string body))) + buf)))) + body)))) + + +(put 'use-package 'lisp-indent-function 'defun) + +(provide 'use-package) + +;; Local Variables: +;; outline-regexp: ";;;\\(;* [^\s\t\n]\\|###autoload\\)\\|(" +;; indent-tabs-mode: nil +;; End: + +;;; use-package.el ends here diff --git a/site-start.d/00-my-setup.el b/site-start.d/00-my-setup.el new file mode 100644 index 0000000..a613358 --- /dev/null +++ b/site-start.d/00-my-setup.el @@ -0,0 +1,76 @@ +;;; 00-my-setup.el --- basic personal definitions + +;;; Commentary: +;; to debug the startup, run Emacs with folloging flag +;; emacs --debug-init +;;; + +;;; Code: + +;; regular used custom function +(defun reload-init-file () + "Reload my init file." + (interactive) + (load-file user-init-file)) + +(bind-key "C-c M-l" 'reload-init-file) + +;; surpress bloat messages +(setq inhibit-startup-message t + initial-scratch-message "" + inhibit-startup-echo-area-message t + inhibit-splash-screen t) + +;; line wrapping +(setq new-line-add-newlines nil) +(setq-default truncate-lines t) +(setq truncate-partial-width-windows nil) + +;; symbol and cursor handling +(global-prettify-symbols-mode +1) +(setq x-stretch-cursor t) + +;; to window panes organized horizontally +;; (split-window-horizontally) + +;; python mode adaptions +(add-hook 'python-mode-hook + (lambda () + (setq indent-tabs-mode t) + (setq python-indent 8) + (setq tab-width 4))) + +;; enable 'linux' as default c-mode minor mode +(add-hook 'c-mode-common-hook + 'linux) + +;; auto enable modes +(semantic-mode 1) + +;; auto enable recent files +(recentf-mode 1) + +;; where are my encrypted auth keys +(setq auth-sources + '((:source "~/.emacs.d/secrets/.authinfo.gpg"))) + +;; automactic handling of whitespace cleanup +(add-hook 'before-save-hook 'whitespace-cleanup) + +;; font settings +(set-default-font "Source Code Pro" nil t) +(set-face-attribute 'default nil :height 110) + +;; prettify symbols +(global-prettify-symbols-mode +1) + +;; save Emacs backup files in one central directory, not cluttering the filesystem +(setq backup-directory-alist + `(("." . ,(expand-file-name + (concat user-emacs-directory "backups"))))) + +;; shorten yes or no dialog +(fset 'yes-or-no-p 'y-or-n-p) + +(provide '00-my-setup) +;;; 00-my-setup.el ends here diff --git a/site-start.d/02-load-path.el b/site-start.d/02-load-path.el new file mode 100644 index 0000000..dd9902c --- /dev/null +++ b/site-start.d/02-load-path.el @@ -0,0 +1,11 @@ +;;; 02-load-path.el --- customize loadpath + +;;; Commentary: +;; load-path will enable to autoload your custom lisp code +;; that is not handled via packages (like use-package) + +;;; Code: +(add-to-list 'load-path "~/.emacs.d/site-lisp") + +(provide '02-load-path) +;;; 401-rust.el ends here diff --git a/site-start.d/101-async.el b/site-start.d/101-async.el new file mode 100644 index 0000000..826a265 --- /dev/null +++ b/site-start.d/101-async.el @@ -0,0 +1,19 @@ +;;; 101-async.el --- asynchronous code execution + +;;; Commentary: +;; Async enables asynchronous processing in Emacs, as well as some basic implementations of asynchronous capabilities + +;;; Code: +(use-package async + :init + (autoload 'dired-async-mode "dired-async.el" nil t) + (dired-async-mode 1) + (async-bytecomp-package-mode 1) + (autoload 'dired-async-mode "dired-async.el" nil t) + (async-bytecomp-package-mode 1) + (dired-async-mode 1) + (require 'smtpmail-async) + (setq send-mail-function 'async-smtpmail-send-it)) + +(provide '101-async) +;;; 101-async.el ends here diff --git a/site-start.d/102-hydra.el b/site-start.d/102-hydra.el new file mode 100644 index 0000000..84adc8e --- /dev/null +++ b/site-start.d/102-hydra.el @@ -0,0 +1,29 @@ +;;; 102-hydra.el --- tie related commands into a family of short bindings + +;;; Commentary: +;; Hydra enables you to tie related commands into a family of short bindings +;; with a common prefix - a Hydra. +;; reference: https://github.com/abo-abo/hydra + +;;; Code: +(use-package hydra + :config + (setq hydra-lv nil)) + +;; Zooming +(defhydra hydra-zoom () + "zoom" + ("+" text-scale-increase "in") + ("=" text-scale-increase "in") + ("-" text-scale-decrease "out") + ("_" text-scale-decrease "out") + ("0" (text-scale-adjust 0) "reset") + ("q" nil "quit" :color blue)) + +(bind-keys ("C-x C-0" . hydra-zoom/body) + ("C-x C-=" . hydra-zoom/body) + ("C-x C--" . hydra-zoom/body) + ("C-x C-+" . hydra-zoom/body)) + +(provide '102-hydra) +;;; 102-hydra.el ends here diff --git a/site-start.d/103-ivy-councel.el b/site-start.d/103-ivy-councel.el new file mode 100644 index 0000000..c7c3e10 --- /dev/null +++ b/site-start.d/103-ivy-councel.el @@ -0,0 +1,71 @@ +;;; 102-ivy-councel.el --- Completion framework for Emacs + +;;; Commentary: +;; Ivy - a generic completion frontend for Emacs, +;; Swiper - isearch with an overview +;; Councel - it consumes Ivy and provides useful commands + +;; Reference: https://github.com/abo-abo/swiper +;; Presentation: https://writequit.org/denver-emacs/presentations/2017-04-11-ivy.html + +;;; Code: +(use-package counsel + :bind (("C-x C-f" . counsel-find-file) + ("C-x C-m" . counsel-M-x) + ("C-x C-f" . counsel-find-file) + ("C-h f" . counsel-describe-function) + ("C-h v" . counsel-describe-variable) + ("M-i" . counsel-imenu) + ("M-I" . counsel-imenu) + ("C-c i" . counsel-unicode-char) + :map read-expression-map + ("C-r" . counsel-expression-history))) + +(use-package swiper + :bind (("C-s" . swiper) + ("C-r" . swiper) + ("C-c C-r" . ivy-resume) + :map ivy-minibuffer-map + ("C-SPC" . ivy-restrict-to-matches)) + :init + (ivy-mode 1) + :config + (setq ivy-count-format "(%d/%d) " + ivy-display-style 'fancy + ivy-height 4 + ivy-use-virtual-buffers t + ivy-initial-inputs-alist () ;; http://irreal.org/blog/?p=6512 + enable-recursive-minibuffers t)) + +(use-package all-the-icons) + +(use-package ivy-rich + :after ivy + :config + ;; All the icon support to ivy-rich + (defun ivy-rich-switch-buffer-icon (candidate) + (with-current-buffer + (get-buffer candidate) + (all-the-icons-icon-for-mode major-mode))) + + (setq ivy-rich--display-transformers-list + '(ivy-switch-buffer + (:columns + ((ivy-rich-switch-buffer-icon (:width 2)) + (ivy-rich-candidate (:width 30)) + (ivy-rich-switch-buffer-size (:width 7)) + (ivy-rich-switch-buffer-indicators (:width 4 :face error :align right)) + (ivy-rich-switch-buffer-major-mode (:width 12 :face warning)) + (ivy-rich-switch-buffer-project (:width 15 :face success)) + (ivy-rich-switch-buffer-path (:width (lambda (x) (ivy-rich-switch-buffer-shorten-path x (ivy-rich-minibuffer-width 0.3)))))) + :predicate + (lambda (cand) (get-buffer cand))))) + + ;; Add custom icons for various modes that can break ivy-rich + (add-to-list 'all-the-icons-mode-icon-alist '(dashboard-mode all-the-icons-fileicon "elisp" :height 1.0 :v-adjust -0.2 :face all-the-icons-dsilver)) + (add-to-list 'all-the-icons-mode-icon-alist '(ess-mode all-the-icons-fileicon "R" :face all-the-icons-lblue)) + + (ivy-rich-mode 1)) + +(provide '102-ivy-councel) +;;; 102-ivy-councel.el ends here diff --git a/site-start.d/104-avy.el b/site-start.d/104-avy.el new file mode 100644 index 0000000..ff453f6 --- /dev/null +++ b/site-start.d/104-avy.el @@ -0,0 +1,35 @@ +;;; 104-avy-ace.el --- Quick jumping inside Emacs + +;;; Commentary: +;; Avy - Jump to Characters and Words +;; Ace - Jump to Windows + +;;; Code: +(use-package avy + :bind ("M-SPC" . avy-goto-char) + :config + (setq avy-background t + avy-keys '(?a ?o ?e ?u ?i ?d ?h ?t ?n ?s))) + +(use-package ace-window + :bind (("C-x o" . ace-window) + ("M-2" . ace-window)) + :init + (setq aw-background nil + aw-keys '(?a ?o ?e ?u ?i ?d ?h ?t ?n ?s))) + +(use-package ace-link + :init + (ace-link-setup-default)) + +(bind-keys :prefix-map avy-map + :prefix "C-c j" + ("c" . avy-goto-char) + ("l" . avy-goto-line) + ("w" . avy-goto-word-or-subword-1) + ("W" . ace-window) + ("z" . avy-zap-to-char) + ("Z" . avy-zap-up-to-char)) + +(provide '104-avy-ace) +;;; 104-avy-ace.el ends here diff --git a/site-start.d/105-flycheck.el b/site-start.d/105-flycheck.el new file mode 100644 index 0000000..5c50b3e --- /dev/null +++ b/site-start.d/105-flycheck.el @@ -0,0 +1,22 @@ +;;; 105-flycheck.el --- on-the-fly syntax checking + +;;; Commentary: +;; Flycheck is a modern on-the-fly syntax checking extension for GNU Emacs + +;;; Code: +(use-package flycheck + :ensure t + :init + ;; enables syntax checking for every supported language + (global-flycheck-mode)) + +;; Force flycheck to always use c++11 support. We use +;; the clang language backend so this is set to clang +;;(add-hook 'c++-mode-hook +;; (lambda () (setq flycheck-clang-language-standard "c++11"))) + +;; Use flycheck-pyflakes for python. Seems to work a little better. +;;(require 'flycheck-pyflakes) + +(provide '105-flycheck) +;;; 105-flycheck.el ends here diff --git a/site-start.d/106-parentheses.el b/site-start.d/106-parentheses.el new file mode 100644 index 0000000..9d272f6 --- /dev/null +++ b/site-start.d/106-parentheses.el @@ -0,0 +1,71 @@ +;;; 106-parentheses.el --- use smartparens + +;;; Commentary: +;; Ease completion aof the right parenthese + +;;; Code: +(use-package smartparens + :bind + (("C-M-f" . sp-forward-sexp) + ("C-M-b" . sp-backward-sexp) + ("C-M-d" . sp-down-sexp) + ("C-M-a" . sp-backward-down-sexp) + ("C-S-a" . sp-beginning-of-sexp) + ("C-S-d" . sp-end-of-sexp) + ("C-M-e" . sp-up-sexp) + ("C-M-u" . sp-backward-up-sexp) + ("C-M-t" . sp-transpose-sexp) + ("C-M-n" . sp-next-sexp) + ("C-M-p" . sp-previous-sexp) + ("C-M-k" . sp-kill-sexp) + ("C-M-w" . sp-copy-sexp) + ("M-" . sp-unwrap-sexp) + ("M-S-" . sp-backward-unwrap-sexp) + ("C-" . sp-forward-slurp-sexp) + ("C-" . sp-forward-barf-sexp) + ("C-M-" . sp-backward-slurp-sexp) + ("C-M-" . sp-backward-barf-sexp) + ("M-D" . sp-splice-sexp) + ("C-M-" . sp-splice-sexp-killing-forward) + ("C-M-" . sp-splice-sexp-killing-backward) + ("C-M-S-" . sp-splice-sexp-killing-around) + ("C-]" . sp-select-next-thing-exchange) + ("C-" . sp-select-previous-thing) + ("C-M-]" . sp-select-next-thing) + ("M-F" . sp-forward-symbol) + ("M-B" . sp-backward-symbol) + ("H-t" . sp-prefix-tag-object) + ("H-p" . sp-prefix-pair-object) + ("H-s c" . sp-convolute-sexp) + ("H-s a" . sp-absorb-sexp) + ("H-s e" . sp-emit-sexp) + ("H-s p" . sp-add-to-previous-sexp) + ("H-s n" . sp-add-to-next-sexp) + ("H-s j" . sp-join-sexp) + ("H-s s" . sp-split-sexp) + ("M-9" . sp-backward-sexp) + ("M-0" . sp-forward-sexp)) + :init + (smartparens-global-mode t) + (show-smartparens-global-mode t) + (use-package smartparens-config + :ensure f) + (bind-key "s" 'smartparens-mode toggle-map) + (when (is-mac-p) + (bind-keys ("" . sp-forward-slurp-sexp) + ("" . sp-forward-barf-sexp))) + (sp-with-modes '(markdown-mode gfm-mode) + (sp-local-pair "*" "*")) + (sp-with-modes '(org-mode) + (sp-local-pair "=" "=") + (sp-local-pair "*" "*") + (sp-local-pair "/" "/") + (sp-local-pair "_" "_") + (sp-local-pair "+" "+") + (sp-local-pair "<" ">") + (sp-local-pair "[" "]")) + (use-package rainbow-delimiters + :hook (prog-mode . rainbow-delimiters-mode))) + +(provide '106-parantheses) +;;; 106-parentheses.el ends here diff --git a/site-start.d/201-counsel-gtags.el b/site-start.d/201-counsel-gtags.el new file mode 100644 index 0000000..7d4609e --- /dev/null +++ b/site-start.d/201-counsel-gtags.el @@ -0,0 +1,19 @@ +;;; 20-counsel-gtags.el --- counsel-gtags adaptions + +;;; Commentary: +;; Online Documentation can be found at +;; https://github.com/syohex/emacs-counsel-gtags + +;;; Code: + +(add-hook 'c-mode-hook 'counsel-gtags-mode) +(add-hook 'c++-mode-hook 'counsel-gtags-mode) + +(with-eval-after-load 'counsel-gtags + (define-key counsel-gtags-mode-map (kbd "M-t") 'counsel-gtags-find-definition) + (define-key counsel-gtags-mode-map (kbd "M-r") 'counsel-gtags-find-reference) + (define-key counsel-gtags-mode-map (kbd "M-s") 'counsel-gtags-find-symbol) + (define-key counsel-gtags-mode-map (kbd "M-,") 'counsel-gtags-go-backward) +) + +;;; 20-counsel-gtags.el ends here diff --git a/site-start.d/201-hs-minor-mode.el b/site-start.d/201-hs-minor-mode.el new file mode 100644 index 0000000..fc8c0a9 --- /dev/null +++ b/site-start.d/201-hs-minor-mode.el @@ -0,0 +1,32 @@ +;;; 20-hs-minor-mode.el --- hide-show code folding + +;;; Commentary: +;; Online Documentation can be found at +;; https://www.emacswiki.org/emacs/HideShow + +;;; Code: + +(load-library "hideshow") +(global-set-key (kbd "C-+") 'toggle-hiding) +(global-set-key (kbd "C-\\") 'toggle-selective-display) + +;; activate on following major modes +(add-hook 'c-mode-common-hook 'hs-minor-mode) +(add-hook 'emacs-lisp-mode-hook 'hs-minor-mode) +(add-hook 'java-mode-hook 'hs-minor-mode) +(add-hook 'lisp-mode-hook 'hs-minor-mode) +(add-hook 'perl-mode-hook 'hs-minor-mode) +(add-hook 'sh-mode-hook 'hs-minor-mode) +(add-hook 'rust-mode-hook 'hs-minor-mode) + +;; Hide the comments too when you do a 'hs-hide-all' +(setq hs-hide-comments nil) + +;; Set whether isearch opens folded comments, code, or both +;; where x is code, comments, t (both), or nil (neither) +(setq hs-isearch-open 'code) + +;; enable hs-minor-mode globaly +;; (hs-minor-mode 1) + +;;; 20-hs-minor-mode.el ends here diff --git a/site-start.d/401-rust.el b/site-start.d/401-rust.el new file mode 100644 index 0000000..8308cc5 --- /dev/null +++ b/site-start.d/401-rust.el @@ -0,0 +1,74 @@ +;;; 401-rust.el --- handle rust code + +;;; Commentary: +;; using rust-mode with rust-analyzer via lsp + +;;; Code: +;; load rustic -> IDE like for rust +(use-package rustic + :ensure t + :init + (setq rustic-lsp-server 'rust-analyzer) + (setq rustic-format-on-save t)) + +;; use the lsp UI package +(use-package lsp-ui) + +;; use rust-analyzer via lsp +;; (setq lsp-rust-analyzer-server-command '("~/.cargo/bin/rust-analyzer")) +;; (add-hook 'before-save-hook (lambda () (when (eq 'rust-mode major-mode) +;; (lsp-format-buffer)))) + +;; load the language-server-protocol (lsp) +;; (use-package lsp-mode +;; :init +;; (add-hook 'prog-mode-hook 'lsp-mode) +;; :after rustic) + +;; ;; :config +;; ;; (use-package lsp-flycheck +;; ;; :ensure f ; comes with lsp-mode +;; ;; :after rustic)) + +;; (push 'rustic-clippy flycheck-checkers) + +;; Turn off flycheck. +;; (remove-hook 'rustic-mode-hook 'flycheck-mode) + + +;; ;; load rust-mode +;; (use-package rust-mode +;; :mode "\\.rs\\'" +;; :init +;; (setq rust-format-on-save t)) + + +;; ;; bind the lsp-rust mode +;; (use-package lsp-rust +;; :after lsp-mode) + +;; option: bind commands to keys: +;; - lsp-rust-analyzer-join-lines +;; - lsp-extend-selection +;; - lsp-rust-analyzer-expand-macro + + +;; (autoload 'rust-mode "rust-mode" +;; "Major mode for the rust programming language" t) + +;; (add-hook 'rust-mode-hook #'racer-mode) +;; (add-hook 'racer-mode-hook #'eldoc-mode) +;; (add-hook 'racer-mode-hook #'company-mode) +;; (add-hook 'rust-mode-hook 'cargo-minor-mode) +;; (add-hook 'flycheck-mode #'flycheck-rust) +;; (add-hook 'flycheck-mode-hook #'flycheck-rust-setup) + +;; ;; reccommended: use spaces instead of tabs +;; (add-hook 'rust-mode-hook +;; (lambda () (setq indent-tabs-mode nil))) + +;; ;; on save, run rustfmt if installed (C-c C-f) +;; (setq rust-format-on-save t) + +(provide '401-rust) +;;; 401-rust.el ends here diff --git a/site-start.d/50-ansi-color.el b/site-start.d/50-ansi-color.el new file mode 100644 index 0000000..c35a574 --- /dev/null +++ b/site-start.d/50-ansi-color.el @@ -0,0 +1,10 @@ +;; +;; support ansi colour shemes +;; + +(require 'ansi-color) +(defun colorize-compilation-buffer () + (toggle-read-only) + (ansi-color-apply-on-region compilation-filter-start (point)) + (toggle-read-only)) +(add-hook 'compilation-filter-hook 'colorize-compilation-buffer) diff --git a/site-start.d/50-boxquote.el b/site-start.d/50-boxquote.el new file mode 100644 index 0000000..8e578ce --- /dev/null +++ b/site-start.d/50-boxquote.el @@ -0,0 +1,26 @@ +;;; 400-boxquote.el --- showing an inline arguments hints + +;;; Commentary: +;; provides a set of functions for using a text quoting style that partially boxes +;; in the left hand side of an area of text. +;; such a marking style might be used to show externally included text or example code + +;;; Code: +(require 'boxquote) + +(global-set-key (kbd "C-c b y") 'boxquote-yank) +(global-set-key (kbd "C-c b r") 'boxquote-region) +(global-set-key (kbd "C-c b u") 'boxquote-unbox-region) +(global-set-key (kbd "C-c b t") 'boxquote-title) +(global-set-key (kbd "C-c b i") 'boxquote-insert-file) +(global-set-key (kbd "C-c b k") 'boxquote-kill) +(global-set-key (kbd "C-c b s") 'boxquote-shell-command) + +(global-set-key (kbd "C-c b b") 'boxquote-buffer) +(global-set-key (kbd "C-c b p") 'boxquote-paragraph) +(global-set-key (kbd "C-c b n") 'boxquote-narrow-to-boxquote) + +(global-set-key (kbd "C-c b w") 'boxquote-where-is) +(global-set-key (kbd "C-c b d f") 'boxquote-describe-function) +(global-set-key (kbd "C-c b d k") 'boxquote-describe-key) +(global-set-key (kbd "C-c b d v") 'boxquote-describe-variable) diff --git a/site-start.d/501-git.el b/site-start.d/501-git.el new file mode 100644 index 0000000..42cee0d --- /dev/null +++ b/site-start.d/501-git.el @@ -0,0 +1,68 @@ +;;; 501-git.el --- git user adaptions + +;;; Commentary: + +;;; Code: + +;; loading standard git.el +;;(require 'git) + +;; load magit for git handling +(use-package magit + :ensure t + :bind (("C-x g" . magit-status) + ("C-c g" . magit-status) + :map magit-status-mode-map + ("TAB" . magit-section-toggle) + ("" . magit-section-cycle) + :map magit-branch-section-map + ("RET" . magit-checkout)) + :config + (add-hook 'after-save-hook 'magit-after-save-refresh-status) + (setq magit-use-overlays nil + magit-section-visibility-indicator nil + magit-completing-read-function 'ivy-completing-read + magit-push-always-verify nil + magit-repository-directories '("~/src/")) + (use-package git-timemachine + :bind (("C-x v t" . git-timemachine))) + (use-package git-link + :bind (("C-x v L" . git-link)) + :init + (setq git-link-open-in-browser t)) + (use-package pcmpl-git) + (defun visit-pull-request-url () + "Visit the current branch's PR on Github." + (interactive) + (browse-url + (format "https://github.com/%s/pull/new/%s" + (replace-regexp-in-string + "\\`.+github\\.com:\\(.+\\)\\.git\\'" "\\1" + (magit-get "remote" + (magit-get-remote) + "url")) + (cdr (magit-get-remote-branch))))) + + (bind-key "v" 'visit-pull-request-url magit-mode-map) + + ;; Do Not Show Recent Commits in status window + ;; https://github.com/magit/magit/issues/3230#issuecomment-339900039 + (magit-add-section-hook 'magit-status-sections-hook + 'magit-insert-unpushed-to-upstream + 'magit-insert-unpushed-to-upstream-or-recent + 'replace)) + +;; load forge to handle github, gitlab, etc +;;(require 'forge) +(use-package forge + :after magit) + +(defvar my/magit-default-options + `( + (pulling "--rebase") + )) + +;;(advice-add 'magit-key-mode :filter-args #'magit-key-mode--add-default-options) + +(provide '501-git) +;;; 501-git.el ends here diff --git a/site-start.d/502-meson-mode.el b/site-start.d/502-meson-mode.el new file mode 100644 index 0000000..89a007c --- /dev/null +++ b/site-start.d/502-meson-mode.el @@ -0,0 +1,13 @@ +;;; 500-meson-mode.el --- meson build system + +;;; Commentary: +; GNU Emacs major mode to support meson build system + +;;; Code: + +(autoload 'meson-mode "meson-mode" + "Major mode for the Meson build system files" t) + +(add-hook 'meson-mode-hook 'company-mode) + +;;; 500-meson-mode.el ends here