rzerres/emacs.d
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

emacs.d: initial config version

Browse Source 
- 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)
This commit is contained in:
Ralf Zerres
2020-06-03 22:24:55 +02:00
commit dfd4317d2d
27 changed files with 7147 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

59
init.el Normal file
View File

@@ -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.
)

255
my-site-start.el Normal file
View File

@@ -0,0 +1,255 @@
;;; my-site-start.el --- set up personal .emacs.d/site-start.d/
;;
;; Copyright (C) era eriksson <http://www.iki.fi/~era/> 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: <http://github.com/tripleee/my-site-start/>
;;
;;; 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

1447
site-lisp/avy.el Normal file
View File

File diff suppressed because it is too large Load Diff

416
site-lisp/bind-key.el Normal file
View File

@@ -0,0 +1,416 @@
;;; bind-key.el --- A simple way to manage personal keybindings
;; Copyright (c) 2012-2015 john wiegley
;; Author: John Wiegley <jwiegley@gmail.com>
;; Maintainer: John Wiegley <jwiegley@gmail.com>
;; 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* "<C-return>" '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)
"#<lambda>"))
((eq 'closure (car elem))
(if (and bind-key-describe-special-forms
(stringp (nth 3 elem)))
(nth 3 elem)
"#<closure>"))
((eq 'keymap (car elem))
"#<keymap>")
(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
"#<byte-compiled lambda>")))
(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

585
site-lisp/boxquote.el Normal file
View File

@@ -0,0 +1,585 @@
;;; boxquote.el --- Quote text with a semi-box.
;; Copyright 1999-2009 by Dave Pearson <davep@davep.org>
;; $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:
;;
;; <URL:http://www.davep.org/emacs/#boxquote.el>
;;; 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.

333
site-lisp/company-clang.el Normal file
View File

@@ -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 <http://www.gnu.org/licenses/>.
;;; 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

214
site-lisp/company-template.el Normal file
View File

@@ -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 <http://www.gnu.org/licenses/>.
;;; 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

372
site-lisp/key-chord.el Normal file
View File

@@ -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 <l.david.andersson(at)sverige.nu>
;; 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

764
site-lisp/meson-mode.el Normal file
View File

@@ -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 <sojkam1@fel.cvut.cz>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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 <C-M-i> 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))

873
site-lisp/org-tree-slide.el Normal file
View File

@@ -0,0 +1,873 @@
;;; org-tree-slide.el --- A presentation tool for org-mode
;;
;; Copyright (C) 2011-2016 Takaaki ISHIKAWA
;;
;; Author: Takaaki ISHIKAWA <takaxp at ieee dot org>
;; Version: 2.8.5
;; Maintainer: Takaaki ISHIKAWA <takaxp at ieee dot org>
;; 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. <left>/<right> will move between slides
;; 6. `C-x s c' will show CONTENT of the org buffer
;; Select a heading and type <right>, then Slideshow will start again.
;; 7. Toggle org-tree-slide-mode again to exit this minor mode
;;
;; Recommended minimum settings:
;; (global-set-key (kbd "<f8>") 'org-tree-slide-mode)
;; (global-set-key (kbd "S-<f8>") '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 \"<f8>\") 'org-tree-slide-mode)
(global-set-key (kbd \"S-<f8>\") 'org-tree-slide-skip-done-toggle)
- Open an org file
- Type <f8> to start org-tree-slide-mode
- Type <left>/<right> to move between trees
- To exit this minor mode, just type <f8> 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

48
site-lisp/smerge.el Normal file
View File

@@ -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 <http://www.gnu.org/licenses/>.
;;; 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))

1205
site-lisp/use-package.el Normal file
View File

File diff suppressed because it is too large Load Diff

76
site-start.d/00-my-setup.el Normal file
View File

@@ -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

11
site-start.d/02-load-path.el Normal file
View File

@@ -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

19
site-start.d/101-async.el Normal file
View File

@@ -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

29
site-start.d/102-hydra.el Normal file
View File

@@ -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

71
site-start.d/103-ivy-councel.el Normal file
View File

@@ -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

35
site-start.d/104-avy.el Normal file
View File

@@ -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

22
site-start.d/105-flycheck.el Normal file
View File

@@ -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

71
site-start.d/106-parentheses.el Normal file
View File

@@ -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-<delete>" . sp-unwrap-sexp)
("M-S-<backspace>" . sp-backward-unwrap-sexp)
("C-<right>" . sp-forward-slurp-sexp)
("C-<left>" . sp-forward-barf-sexp)
("C-M-<left>" . sp-backward-slurp-sexp)
("C-M-<right>" . sp-backward-barf-sexp)
("M-D" . sp-splice-sexp)
("C-M-<delete>" . sp-splice-sexp-killing-forward)
("C-M-<backspace>" . sp-splice-sexp-killing-backward)
("C-M-S-<backspace>" . sp-splice-sexp-killing-around)
("C-]" . sp-select-next-thing-exchange)
("C-<left_bracket>" . 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 ("<s-right>" . sp-forward-slurp-sexp)
("<s-left>" . 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

19
site-start.d/201-counsel-gtags.el Normal file
View File

@@ -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

32
site-start.d/201-hs-minor-mode.el Normal file
View File

@@ -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

74
site-start.d/401-rust.el Normal file
View File

@@ -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

10
site-start.d/50-ansi-color.el Normal file
View File

@@ -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)

26
site-start.d/50-boxquote.el Normal file
View File

@@ -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)

68
site-start.d/501-git.el Normal file
View File

@@ -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)
("<C-tab>" . 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

13
site-start.d/502-meson-mode.el Normal file
View File

@@ -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