Remove the elpa/ directory from version control
All my packages are now installed via `use-package`.
This commit is contained in:
Gergely Polonkai
2
.gitignore
vendored
2
.gitignore
vendored
@@ -15,6 +15,8 @@
|
||||
/url/
|
||||
/hgs-cache
|
||||
/smex-items
|
||||
# All hail use-package!
|
||||
/elpa/
|
||||
|
||||
# History-related files. It’s a real pain merging them together
|
||||
/history
|
||||
|
||||
@@ -1,68 +0,0 @@
|
||||
;;; ace-window-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "ace-window" "ace-window.el" (22535 7932 710222
|
||||
;;;;;; 652000))
|
||||
;;; Generated autoloads from ace-window.el
|
||||
|
||||
(autoload 'ace-select-window "ace-window" "\
|
||||
Ace select window.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'ace-delete-window "ace-window" "\
|
||||
Ace delete window.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'ace-swap-window "ace-window" "\
|
||||
Ace swap window.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'ace-maximize-window "ace-window" "\
|
||||
Ace maximize window.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'ace-window "ace-window" "\
|
||||
Select a window.
|
||||
Perform an action based on ARG described below.
|
||||
|
||||
By default, behaves like extended `other-window'.
|
||||
|
||||
Prefixed with one \\[universal-argument], does a swap between the
|
||||
selected window and the current window, so that the selected
|
||||
buffer moves to current window (and current buffer moves to
|
||||
selected window).
|
||||
|
||||
Prefixed with two \\[universal-argument]'s, deletes the selected
|
||||
window.
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(defvar ace-window-display-mode nil "\
|
||||
Non-nil if Ace-Window-Display mode is enabled.
|
||||
See the `ace-window-display-mode' command
|
||||
for a description of this minor mode.
|
||||
Setting this variable directly does not take effect;
|
||||
either customize it (see the info node `Easy Customization')
|
||||
or call the function `ace-window-display-mode'.")
|
||||
|
||||
(custom-autoload 'ace-window-display-mode "ace-window" nil)
|
||||
|
||||
(autoload 'ace-window-display-mode "ace-window" "\
|
||||
Minor mode for showing the ace window key in the mode line.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; ace-window-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "ace-window" "20161018.1624" "Quickly switch windows." '((avy "0.2.0")) :url "https://github.com/abo-abo/ace-window" :keywords '("window" "location"))
|
||||
@@ -1,563 +0,0 @@
|
||||
;;; ace-window.el --- Quickly switch windows. -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
|
||||
;; Maintainer: Oleh Krehel <ohwoeowho@gmail.com>
|
||||
;; URL: https://github.com/abo-abo/ace-window
|
||||
;; Package-Version: 20161018.1624
|
||||
;; Version: 0.9.0
|
||||
;; Package-Requires: ((avy "0.2.0"))
|
||||
;; Keywords: window, location
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; This file is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; For a full copy of the GNU General Public License
|
||||
;; see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; The main function, `ace-window' is meant to replace `other-window'.
|
||||
;; In fact, when there are only two windows present, `other-window' is
|
||||
;; called. If there are more, each window will have its first
|
||||
;; character highlighted. Pressing that character will switch to that
|
||||
;; window.
|
||||
;;
|
||||
;; To setup this package, just add to your .emacs:
|
||||
;;
|
||||
;; (global-set-key (kbd "M-p") 'ace-window)
|
||||
;;
|
||||
;; replacing "M-p" with an appropriate shortcut.
|
||||
;;
|
||||
;; Depending on your window usage patterns, you might want to set
|
||||
;;
|
||||
;; (setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l))
|
||||
;;
|
||||
;; This way they are all on the home row, although the intuitive
|
||||
;; ordering is lost.
|
||||
;;
|
||||
;; If you don't want the gray background that makes the red selection
|
||||
;; characters stand out more, set this:
|
||||
;;
|
||||
;; (setq aw-background nil)
|
||||
;;
|
||||
;; If you want to know the selection characters ahead of time, you can
|
||||
;; turn on `ace-window-display-mode'.
|
||||
;;
|
||||
;; When prefixed with one `universal-argument', instead of switching
|
||||
;; to selected window, the selected window is swapped with current one.
|
||||
;;
|
||||
;; When prefixed with two `universal-argument', the selected window is
|
||||
;; deleted instead.
|
||||
|
||||
;;; Code:
|
||||
(require 'avy)
|
||||
(require 'ring)
|
||||
|
||||
;;* Customization
|
||||
(defgroup ace-window nil
|
||||
"Quickly switch current window."
|
||||
:group 'convenience
|
||||
:prefix "aw-")
|
||||
|
||||
(defcustom aw-keys '(?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
|
||||
"Keys for selecting window.")
|
||||
|
||||
(defcustom aw-scope 'global
|
||||
"The scope used by `ace-window'."
|
||||
:type '(choice
|
||||
(const :tag "visible frames" visible)
|
||||
(const :tag "global" global)
|
||||
(const :tag "frame" frame)))
|
||||
|
||||
(defcustom aw-ignored-buffers '("*Calc Trail*" "*LV*")
|
||||
"List of buffers to ignore when selecting window."
|
||||
:type '(repeat string))
|
||||
|
||||
(defcustom aw-ignore-on t
|
||||
"When t, `ace-window' will ignore `aw-ignored-buffers'.
|
||||
Use M-0 `ace-window' to toggle this value."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom aw-ignore-current nil
|
||||
"When t, `ace-window' will ignore `selected-window'."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom aw-background t
|
||||
"When t, `ace-window' will dim out all buffers temporarily when used.'."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom aw-leading-char-style 'char
|
||||
"Style of the leading char overlay."
|
||||
:type '(choice
|
||||
(const :tag "single char" 'char)
|
||||
(const :tag "full path" 'path)))
|
||||
|
||||
(defcustom aw-dispatch-always nil
|
||||
"When non-nil, `ace-window' will issue a `read-char' even for one window.
|
||||
This will make `ace-window' act different from `other-window' for
|
||||
one or two windows."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom aw-reverse-frame-list nil
|
||||
"When non-nil `ace-window' will order frames for selection in
|
||||
the reverse of `frame-list'"
|
||||
:type 'boolean)
|
||||
|
||||
(defface aw-leading-char-face
|
||||
'((((class color)) (:foreground "red"))
|
||||
(((background dark)) (:foreground "gray100"))
|
||||
(((background light)) (:foreground "gray0"))
|
||||
(t (:foreground "gray100" :underline nil)))
|
||||
"Face for each window's leading char.")
|
||||
|
||||
(defface aw-background-face
|
||||
'((t (:foreground "gray40")))
|
||||
"Face for whole window background during selection.")
|
||||
|
||||
(defface aw-mode-line-face
|
||||
'((t (:inherit mode-line-buffer-id)))
|
||||
"Face used for displaying the ace window key in the mode-line.")
|
||||
|
||||
;;* Implementation
|
||||
(defun aw-ignored-p (window)
|
||||
"Return t if WINDOW should be ignored."
|
||||
(or (and aw-ignore-on
|
||||
(member (buffer-name (window-buffer window))
|
||||
aw-ignored-buffers))
|
||||
(and aw-ignore-current
|
||||
(equal window (selected-window)))))
|
||||
|
||||
(defun aw-window-list ()
|
||||
"Return the list of interesting windows."
|
||||
(sort
|
||||
(cl-remove-if
|
||||
(lambda (w)
|
||||
(let ((f (window-frame w)))
|
||||
(or (not (and (frame-live-p f)
|
||||
(frame-visible-p f)))
|
||||
(string= "initial_terminal" (terminal-name f))
|
||||
(aw-ignored-p w))))
|
||||
(cl-case aw-scope
|
||||
(visible
|
||||
(cl-mapcan #'window-list (visible-frame-list)))
|
||||
(global
|
||||
(cl-mapcan #'window-list (frame-list)))
|
||||
(frame
|
||||
(window-list))
|
||||
(t
|
||||
(error "Invalid `aw-scope': %S" aw-scope))))
|
||||
'aw-window<))
|
||||
|
||||
(defvar aw-overlays-back nil
|
||||
"Hold overlays for when `aw-background' is t.")
|
||||
|
||||
(defvar ace-window-mode nil
|
||||
"Minor mode during the selection process.")
|
||||
|
||||
;; register minor mode
|
||||
(or (assq 'ace-window-mode minor-mode-alist)
|
||||
(nconc minor-mode-alist
|
||||
(list '(ace-window-mode ace-window-mode))))
|
||||
|
||||
(defvar aw-empty-buffers-list nil
|
||||
"Store the read-only empty buffers which had to be modified.
|
||||
Modify them back eventually.")
|
||||
|
||||
(defun aw--done ()
|
||||
"Clean up mode line and overlays."
|
||||
;; mode line
|
||||
(aw-set-mode-line nil)
|
||||
;; background
|
||||
(mapc #'delete-overlay aw-overlays-back)
|
||||
(setq aw-overlays-back nil)
|
||||
(avy--remove-leading-chars)
|
||||
(dolist (b aw-empty-buffers-list)
|
||||
(with-current-buffer b
|
||||
(when (string= (buffer-string) " ")
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region (point-min) (point-max))))))
|
||||
(setq aw-empty-buffers-list nil))
|
||||
|
||||
(defun aw--lead-overlay (path leaf)
|
||||
"Create an overlay using PATH at LEAF.
|
||||
LEAF is (PT . WND)."
|
||||
(let ((wnd (cdr leaf)))
|
||||
(with-selected-window wnd
|
||||
(when (= 0 (buffer-size))
|
||||
(push (current-buffer) aw-empty-buffers-list)
|
||||
(let ((inhibit-read-only t))
|
||||
(insert " ")))
|
||||
(let* ((pt (car leaf))
|
||||
(ol (make-overlay pt (1+ pt) (window-buffer wnd)))
|
||||
(old-str (or
|
||||
(ignore-errors
|
||||
(with-selected-window wnd
|
||||
(buffer-substring pt (1+ pt))))
|
||||
""))
|
||||
(new-str
|
||||
(concat
|
||||
(cl-case aw-leading-char-style
|
||||
(char
|
||||
(string (avy--key-to-char (car (last path)))))
|
||||
(path
|
||||
(mapconcat
|
||||
(lambda (x) (string (avy--key-to-char x)))
|
||||
(reverse path)
|
||||
""))
|
||||
(t
|
||||
(error "Bad `aw-leading-char-style': %S"
|
||||
aw-leading-char-style)))
|
||||
(cond ((string-equal old-str "\t")
|
||||
(make-string (1- tab-width) ?\ ))
|
||||
((string-equal old-str "\n")
|
||||
"\n")
|
||||
(t
|
||||
(make-string
|
||||
(max 0 (1- (string-width old-str)))
|
||||
?\ ))))))
|
||||
(overlay-put ol 'face 'aw-leading-char-face)
|
||||
(overlay-put ol 'window wnd)
|
||||
(overlay-put ol 'display new-str)
|
||||
(push ol avy--overlays-lead)))))
|
||||
|
||||
(defun aw--make-backgrounds (wnd-list)
|
||||
"Create a dim background overlay for each window on WND-LIST."
|
||||
(when aw-background
|
||||
(setq aw-overlays-back
|
||||
(mapcar (lambda (w)
|
||||
(let ((ol (make-overlay
|
||||
(window-start w)
|
||||
(window-end w)
|
||||
(window-buffer w))))
|
||||
(overlay-put ol 'face 'aw-background-face)
|
||||
ol))
|
||||
wnd-list))))
|
||||
|
||||
(define-obsolete-variable-alias
|
||||
'aw-flip-keys 'aw--flip-keys "0.1.0"
|
||||
"Use `aw-dispatch-alist' instead.")
|
||||
|
||||
(defvar aw-dispatch-function 'aw-dispatch-default
|
||||
"Function to call when a character not in `aw-keys' is pressed.")
|
||||
|
||||
(defvar aw-action nil
|
||||
"Function to call at the end of `aw-select'.")
|
||||
|
||||
(defun aw-set-mode-line (str)
|
||||
"Set mode line indicator to STR."
|
||||
(setq ace-window-mode str)
|
||||
(force-mode-line-update))
|
||||
|
||||
(defvar aw-dispatch-alist
|
||||
'((?x aw-delete-window " Ace - Delete Window")
|
||||
(?m aw-swap-window " Ace - Swap Window")
|
||||
(?M aw-move-window " Ace - Move Window")
|
||||
(?n aw-flip-window)
|
||||
(?v aw-split-window-vert " Ace - Split Vert Window")
|
||||
(?b aw-split-window-horz " Ace - Split Horz Window")
|
||||
(?i delete-other-windows " Ace - Maximize Window")
|
||||
(?o delete-other-windows))
|
||||
"List of actions for `aw-dispatch-default'.")
|
||||
|
||||
(defun aw-dispatch-default (char)
|
||||
"Perform an action depending on CHAR."
|
||||
(let ((val (cdr (assoc char aw-dispatch-alist))))
|
||||
(if val
|
||||
(if (and (car val) (cadr val))
|
||||
(prog1 (setq aw-action (car val))
|
||||
(aw-set-mode-line (cadr val)))
|
||||
(funcall (car val))
|
||||
(throw 'done 'exit))
|
||||
(avy-handler-default char))))
|
||||
|
||||
(defun aw-select (mode-line &optional action)
|
||||
"Return a selected other window.
|
||||
Amend MODE-LINE to the mode line for the duration of the selection."
|
||||
(setq aw-action action)
|
||||
(let ((start-window (selected-window))
|
||||
(next-window-scope (cl-case aw-scope
|
||||
('visible 'visible)
|
||||
('global 'visible)
|
||||
('frame 'frame)))
|
||||
(wnd-list (aw-window-list))
|
||||
window)
|
||||
(setq window
|
||||
(cond ((<= (length wnd-list) 1)
|
||||
(when aw-dispatch-always
|
||||
(setq aw-action
|
||||
(unwind-protect
|
||||
(catch 'done
|
||||
(funcall aw-dispatch-function (read-char)))
|
||||
(aw--done)))
|
||||
(when (eq aw-action 'exit)
|
||||
(setq aw-action nil)))
|
||||
(or (car wnd-list) start-window))
|
||||
((and (= (length wnd-list) 2)
|
||||
(not aw-dispatch-always)
|
||||
(not aw-ignore-current))
|
||||
(let ((wnd (next-window nil nil next-window-scope)))
|
||||
(while (and (or (not (memq wnd wnd-list))
|
||||
(aw-ignored-p wnd))
|
||||
(not (equal wnd start-window)))
|
||||
(setq wnd (next-window wnd nil next-window-scope)))
|
||||
wnd))
|
||||
(t
|
||||
(let ((candidate-list
|
||||
(mapcar (lambda (wnd)
|
||||
(cons (aw-offset wnd) wnd))
|
||||
wnd-list)))
|
||||
(aw--make-backgrounds wnd-list)
|
||||
(aw-set-mode-line mode-line)
|
||||
;; turn off helm transient map
|
||||
(remove-hook 'post-command-hook 'helm--maybe-update-keymap)
|
||||
(unwind-protect
|
||||
(let* ((avy-handler-function aw-dispatch-function)
|
||||
(avy-translate-char-function #'identity)
|
||||
(res (avy-read (avy-tree candidate-list aw-keys)
|
||||
#'aw--lead-overlay
|
||||
#'avy--remove-leading-chars)))
|
||||
(if (eq res 'exit)
|
||||
(setq aw-action nil)
|
||||
(or (cdr res)
|
||||
start-window)))
|
||||
(aw--done))))))
|
||||
(if aw-action
|
||||
(funcall aw-action window)
|
||||
window)))
|
||||
|
||||
;;* Interactive
|
||||
;;;###autoload
|
||||
(defun ace-select-window ()
|
||||
"Ace select window."
|
||||
(interactive)
|
||||
(aw-select " Ace - Window"
|
||||
#'aw-switch-to-window))
|
||||
|
||||
;;;###autoload
|
||||
(defun ace-delete-window ()
|
||||
"Ace delete window."
|
||||
(interactive)
|
||||
(aw-select " Ace - Delete Window"
|
||||
#'aw-delete-window))
|
||||
|
||||
;;;###autoload
|
||||
(defun ace-swap-window ()
|
||||
"Ace swap window."
|
||||
(interactive)
|
||||
(aw-select " Ace - Swap Window"
|
||||
#'aw-swap-window))
|
||||
|
||||
;;;###autoload
|
||||
(defun ace-maximize-window ()
|
||||
"Ace maximize window."
|
||||
(interactive)
|
||||
(aw-select " Ace - Maximize Window"
|
||||
#'delete-other-windows))
|
||||
|
||||
;;;###autoload
|
||||
(defun ace-window (arg)
|
||||
"Select a window.
|
||||
Perform an action based on ARG described below.
|
||||
|
||||
By default, behaves like extended `other-window'.
|
||||
|
||||
Prefixed with one \\[universal-argument], does a swap between the
|
||||
selected window and the current window, so that the selected
|
||||
buffer moves to current window (and current buffer moves to
|
||||
selected window).
|
||||
|
||||
Prefixed with two \\[universal-argument]'s, deletes the selected
|
||||
window."
|
||||
(interactive "p")
|
||||
(cl-case arg
|
||||
(0
|
||||
(setq aw-ignore-on
|
||||
(not aw-ignore-on))
|
||||
(ace-select-window))
|
||||
(4 (ace-swap-window))
|
||||
(16 (ace-delete-window))
|
||||
(t (ace-select-window))))
|
||||
|
||||
;;* Utility
|
||||
(defun aw-window< (wnd1 wnd2)
|
||||
"Return true if WND1 is less than WND2.
|
||||
This is determined by their respective window coordinates.
|
||||
Windows are numbered top down, left to right."
|
||||
(let ((f1 (window-frame wnd1))
|
||||
(f2 (window-frame wnd2))
|
||||
(e1 (window-edges wnd1))
|
||||
(e2 (window-edges wnd2)))
|
||||
(cond ((string< (frame-parameter f1 'window-id)
|
||||
(frame-parameter f2 'window-id))
|
||||
aw-reverse-frame-list)
|
||||
((< (car e1) (car e2))
|
||||
t)
|
||||
((> (car e1) (car e2))
|
||||
nil)
|
||||
((< (cadr e1) (cadr e2))
|
||||
t))))
|
||||
|
||||
(defvar aw--window-ring (make-ring 10)
|
||||
"Hold the window switching history.")
|
||||
|
||||
(defun aw--push-window (window)
|
||||
"Store WINDOW to `aw--window-ring'."
|
||||
(when (or (zerop (ring-length aw--window-ring))
|
||||
(not (equal
|
||||
(ring-ref aw--window-ring 0)
|
||||
window)))
|
||||
(ring-insert aw--window-ring (selected-window))))
|
||||
|
||||
(defun aw--pop-window ()
|
||||
"Return the removed top of `aw--window-ring'."
|
||||
(let (res)
|
||||
(condition-case nil
|
||||
(while (or (not (window-live-p
|
||||
(setq res (ring-remove aw--window-ring 0))))
|
||||
(equal res (selected-window))))
|
||||
(error
|
||||
(if (= (length (aw-window-list)) 2)
|
||||
(progn
|
||||
(other-window 1)
|
||||
(setq res (selected-window)))
|
||||
(error "No previous windows stored"))))
|
||||
res))
|
||||
|
||||
(defun aw-switch-to-window (window)
|
||||
"Switch to the window WINDOW."
|
||||
(let ((frame (window-frame window)))
|
||||
(aw--push-window (selected-window))
|
||||
(when (and (frame-live-p frame)
|
||||
(not (eq frame (selected-frame))))
|
||||
(select-frame-set-input-focus frame))
|
||||
(if (window-live-p window)
|
||||
(select-window window)
|
||||
(error "Got a dead window %S" window))))
|
||||
|
||||
(defun aw-flip-window ()
|
||||
"Switch to the window you were previously in."
|
||||
(interactive)
|
||||
(aw-switch-to-window (aw--pop-window)))
|
||||
|
||||
(defun aw-delete-window (window)
|
||||
"Delete window WINDOW."
|
||||
(let ((frame (window-frame window)))
|
||||
(when (and (frame-live-p frame)
|
||||
(not (eq frame (selected-frame))))
|
||||
(select-frame-set-input-focus (window-frame window)))
|
||||
(if (= 1 (length (window-list)))
|
||||
(delete-frame frame)
|
||||
(if (window-live-p window)
|
||||
(delete-window window)
|
||||
(error "Got a dead window %S" window)))))
|
||||
|
||||
(defcustom aw-swap-invert nil
|
||||
"When non-nil, the other of the two swapped windows gets the point."
|
||||
:type 'boolean)
|
||||
|
||||
(defun aw-swap-window (window)
|
||||
"Swap buffers of current window and WINDOW."
|
||||
(cl-labels ((swap-windows (window1 window2)
|
||||
"Swap the buffers of WINDOW1 and WINDOW2."
|
||||
(let ((buffer1 (window-buffer window1))
|
||||
(buffer2 (window-buffer window2)))
|
||||
(set-window-buffer window1 buffer2)
|
||||
(set-window-buffer window2 buffer1)
|
||||
(select-window window2))))
|
||||
(let ((frame (window-frame window))
|
||||
(this-window (selected-window)))
|
||||
(when (and (frame-live-p frame)
|
||||
(not (eq frame (selected-frame))))
|
||||
(select-frame-set-input-focus (window-frame window)))
|
||||
(when (and (window-live-p window)
|
||||
(not (eq window this-window)))
|
||||
(aw--push-window this-window)
|
||||
(if aw-swap-invert
|
||||
(swap-windows window this-window)
|
||||
(swap-windows this-window window))))))
|
||||
|
||||
(defun aw-move-window (window)
|
||||
"Move the current buffer to WINDOW.
|
||||
Switch the current window to the previous buffer."
|
||||
(let ((buffer (current-buffer)))
|
||||
(switch-to-buffer (other-buffer))
|
||||
(aw-switch-to-window window)
|
||||
(switch-to-buffer buffer)))
|
||||
|
||||
(defun aw-split-window-vert (window)
|
||||
"Split WINDOW vertically."
|
||||
(select-window window)
|
||||
(split-window-vertically))
|
||||
|
||||
(defun aw-split-window-horz (window)
|
||||
"Split WINDOW horizontally."
|
||||
(select-window window)
|
||||
(split-window-horizontally))
|
||||
|
||||
(defun aw-offset (window)
|
||||
"Return point in WINDOW that's closest to top left corner.
|
||||
The point is writable, i.e. it's not part of space after newline."
|
||||
(let ((h (window-hscroll window))
|
||||
(beg (window-start window))
|
||||
(end (window-end window))
|
||||
(inhibit-field-text-motion t))
|
||||
(with-current-buffer
|
||||
(window-buffer window)
|
||||
(save-excursion
|
||||
(goto-char beg)
|
||||
(while (and (< (point) end)
|
||||
(< (- (line-end-position)
|
||||
(line-beginning-position))
|
||||
h))
|
||||
(forward-line))
|
||||
(+ (point) h)))))
|
||||
|
||||
;;* Mode line
|
||||
;;;###autoload
|
||||
(define-minor-mode ace-window-display-mode
|
||||
"Minor mode for showing the ace window key in the mode line."
|
||||
:global t
|
||||
(if ace-window-display-mode
|
||||
(progn
|
||||
(aw-update)
|
||||
(set-default
|
||||
'mode-line-format
|
||||
`((ace-window-display-mode
|
||||
(:eval (window-parameter (selected-window) 'ace-window-path)))
|
||||
,@(assq-delete-all
|
||||
'ace-window-display-mode
|
||||
(default-value 'mode-line-format))))
|
||||
(force-mode-line-update t)
|
||||
(add-hook 'window-configuration-change-hook 'aw-update))
|
||||
(set-default
|
||||
'mode-line-format
|
||||
(assq-delete-all
|
||||
'ace-window-display-mode
|
||||
(default-value 'mode-line-format)))
|
||||
(remove-hook 'window-configuration-change-hook 'aw-update)))
|
||||
|
||||
(defun aw-update ()
|
||||
"Update ace-window-path window parameter for all windows."
|
||||
(avy-traverse
|
||||
(avy-tree (aw-window-list) aw-keys)
|
||||
(lambda (path leaf)
|
||||
(set-window-parameter
|
||||
leaf 'ace-window-path
|
||||
(propertize
|
||||
(apply #'string (reverse path))
|
||||
'face 'aw-mode-line-face)))))
|
||||
|
||||
(provide 'ace-window)
|
||||
|
||||
;;; ace-window.el ends here
|
||||
@@ -1,122 +0,0 @@
|
||||
;;; ag-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "ag" "ag.el" (22539 28068 810569 198000))
|
||||
;;; Generated autoloads from ag.el
|
||||
|
||||
(autoload 'ag "ag" "\
|
||||
Search using ag in a given DIRECTORY for a given literal search STRING,
|
||||
with STRING defaulting to the symbol under point.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag.
|
||||
|
||||
\(fn STRING DIRECTORY)" t nil)
|
||||
|
||||
(autoload 'ag-files "ag" "\
|
||||
Search using ag in a given DIRECTORY for a given literal search STRING,
|
||||
limited to files that match FILE-TYPE. STRING defaults to the
|
||||
symbol under point.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag.
|
||||
|
||||
\(fn STRING FILE-TYPE DIRECTORY)" t nil)
|
||||
|
||||
(autoload 'ag-regexp "ag" "\
|
||||
Search using ag in a given directory for a given regexp.
|
||||
The regexp should be in PCRE syntax, not Emacs regexp syntax.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag.
|
||||
|
||||
\(fn STRING DIRECTORY)" t nil)
|
||||
|
||||
(autoload 'ag-project "ag" "\
|
||||
Guess the root of the current project and search it with ag
|
||||
for the given literal search STRING.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag.
|
||||
|
||||
\(fn STRING)" t nil)
|
||||
|
||||
(autoload 'ag-project-files "ag" "\
|
||||
Search using ag for a given literal search STRING,
|
||||
limited to files that match FILE-TYPE. STRING defaults to the
|
||||
symbol under point.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag.
|
||||
|
||||
\(fn STRING FILE-TYPE)" t nil)
|
||||
|
||||
(autoload 'ag-project-regexp "ag" "\
|
||||
Guess the root of the current project and search it with ag
|
||||
for the given regexp. The regexp should be in PCRE syntax, not
|
||||
Emacs regexp syntax.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag.
|
||||
|
||||
\(fn REGEXP)" t nil)
|
||||
|
||||
(defalias 'ag-project-at-point 'ag-project)
|
||||
|
||||
(defalias 'ag-regexp-project-at-point 'ag-project-regexp)
|
||||
|
||||
(autoload 'ag-dired "ag" "\
|
||||
Recursively find files in DIR matching literal search STRING.
|
||||
|
||||
The PATTERN is matched against the full path to the file, not
|
||||
only against the file name.
|
||||
|
||||
The results are presented as a `dired-mode' buffer with
|
||||
`default-directory' being DIR.
|
||||
|
||||
See also `ag-dired-regexp'.
|
||||
|
||||
\(fn DIR STRING)" t nil)
|
||||
|
||||
(autoload 'ag-dired-regexp "ag" "\
|
||||
Recursively find files in DIR matching REGEXP.
|
||||
REGEXP should be in PCRE syntax, not Emacs regexp syntax.
|
||||
|
||||
The REGEXP is matched against the full path to the file, not
|
||||
only against the file name.
|
||||
|
||||
Results are presented as a `dired-mode' buffer with
|
||||
`default-directory' being DIR.
|
||||
|
||||
See also `find-dired'.
|
||||
|
||||
\(fn DIR REGEXP)" t nil)
|
||||
|
||||
(autoload 'ag-project-dired "ag" "\
|
||||
Recursively find files in current project matching PATTERN.
|
||||
|
||||
See also `ag-dired'.
|
||||
|
||||
\(fn PATTERN)" t nil)
|
||||
|
||||
(autoload 'ag-project-dired-regexp "ag" "\
|
||||
Recursively find files in current project matching REGEXP.
|
||||
|
||||
See also `ag-dired-regexp'.
|
||||
|
||||
\(fn REGEXP)" t nil)
|
||||
|
||||
(autoload 'ag-kill-buffers "ag" "\
|
||||
Kill all `ag-mode' buffers.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'ag-kill-other-buffers "ag" "\
|
||||
Kill all `ag-mode' buffers other than the current buffer.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; ag-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "ag" "20161021.2133" "A front-end for ag ('the silver searcher'), the C ack replacement." '((dash "2.8.0") (s "1.9.0") (cl-lib "0.5")))
|
||||
@@ -1,676 +0,0 @@
|
||||
;;; ag.el --- A front-end for ag ('the silver searcher'), the C ack replacement.
|
||||
|
||||
;; Copyright (C) 2013-2014 Wilfred Hughes <me@wilfred.me.uk>
|
||||
;;
|
||||
;; Author: Wilfred Hughes <me@wilfred.me.uk>
|
||||
;; Created: 11 January 2013
|
||||
;; Version: 0.48
|
||||
;; Package-Version: 20161021.2133
|
||||
;; Package-Requires: ((dash "2.8.0") (s "1.9.0") (cl-lib "0.5"))
|
||||
;;; Commentary:
|
||||
|
||||
;; Please see README.md for documentation, or read it online at
|
||||
;; https://github.com/Wilfred/ag.el/#agel
|
||||
|
||||
;;; License:
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;; However, it is distributed under the same license.
|
||||
|
||||
;; 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, 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; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
|
||||
;;; Code:
|
||||
(require 'cl-lib) ;; cl-letf, cl-defun
|
||||
(require 'dired) ;; dired-sort-inhibit
|
||||
(require 'dash)
|
||||
(require 's)
|
||||
(require 'find-dired) ;; find-dired-filter
|
||||
|
||||
(defgroup ag nil
|
||||
"A front-end for ag - The Silver Searcher."
|
||||
:group 'tools
|
||||
:group 'matching)
|
||||
|
||||
(defcustom ag-executable
|
||||
"ag"
|
||||
"Name of the ag executable to use."
|
||||
:type 'string
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-arguments
|
||||
(list "--smart-case" "--stats")
|
||||
"Additional arguments passed to ag.
|
||||
|
||||
Ag.el internally uses --column, --line-number and --color
|
||||
options (with specific colors) to match groups, so options
|
||||
specified here should not conflict.
|
||||
|
||||
--line-number is required on Windows, as otherwise ag will not
|
||||
print line numbers when the input is a stream."
|
||||
:type '(repeat (string))
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-context-lines nil
|
||||
"Number of context lines to include before and after a matching line."
|
||||
:type 'integer
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-group-matches t
|
||||
"Group matches in the same file together.
|
||||
|
||||
If nil, the file name is repeated at the beginning of every match line."
|
||||
:type 'boolean
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-highlight-search nil
|
||||
"Non-nil means we highlight the current search term in results.
|
||||
|
||||
This requires the ag command to support --color-match, which is only in v0.14+"
|
||||
:type 'boolean
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-reuse-buffers nil
|
||||
"Non-nil means we reuse the existing search results buffer or
|
||||
dired results buffer, rather than creating one buffer per unique
|
||||
search."
|
||||
:type 'boolean
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-reuse-window nil
|
||||
"Non-nil means we open search results in the same window,
|
||||
hiding the results buffer."
|
||||
:type 'boolean
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-project-root-function nil
|
||||
"A function to determine the project root for `ag-project'.
|
||||
|
||||
If set to a function, call this function with the name of the
|
||||
file or directory for which to determine the project root
|
||||
directory.
|
||||
|
||||
If set to nil, fall back to finding VCS root directories."
|
||||
:type '(choice (const :tag "Default (VCS root)" nil)
|
||||
(function :tag "Function"))
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-ignore-list nil
|
||||
"A list of patterns for files/directories to ignore when searching."
|
||||
:type '(repeat (string))
|
||||
:group 'ag)
|
||||
|
||||
(require 'compile)
|
||||
|
||||
;; Although ag results aren't exactly errors, we treat them as errors
|
||||
;; so `next-error' and `previous-error' work. However, we ensure our
|
||||
;; face inherits from `compilation-info-face' so the results are
|
||||
;; styled appropriately.
|
||||
(defface ag-hit-face '((t :inherit compilation-info))
|
||||
"Face name to use for ag matches."
|
||||
:group 'ag)
|
||||
|
||||
(defface ag-match-face '((t :inherit match))
|
||||
"Face name to use for ag matches."
|
||||
:group 'ag)
|
||||
|
||||
(defvar ag-search-finished-hook nil
|
||||
"Hook run when ag completes a search in a buffer.")
|
||||
|
||||
(defun ag/run-finished-hook (buffer how-finished)
|
||||
"Run the ag hook to signal that the search has completed."
|
||||
(with-current-buffer buffer
|
||||
(run-hooks 'ag-search-finished-hook)))
|
||||
|
||||
(defmacro ag/with-patch-function (fun-name fun-args fun-body &rest body)
|
||||
"Temporarily override the definition of FUN-NAME whilst BODY is executed.
|
||||
|
||||
Assumes FUNCTION is already defined (see http://emacs.stackexchange.com/a/3452/304)."
|
||||
`(cl-letf (((symbol-function ,fun-name)
|
||||
(lambda ,fun-args ,fun-body)))
|
||||
,@body))
|
||||
|
||||
(defun ag/next-error-function (n &optional reset)
|
||||
"Open the search result at point in the current window or a
|
||||
different window, according to `ag-reuse-window'."
|
||||
(if ag-reuse-window
|
||||
;; prevent changing the window
|
||||
(ag/with-patch-function
|
||||
'pop-to-buffer (buffer &rest args) (switch-to-buffer buffer)
|
||||
(compilation-next-error-function n reset))
|
||||
|
||||
;; just navigate to the results as normal
|
||||
(compilation-next-error-function n reset)))
|
||||
|
||||
;; Note that we want to use as tight a regexp as we can to try and
|
||||
;; handle weird file names (with colons in them) as well as possible.
|
||||
;; E.g. we use [1-9][0-9]* rather than [0-9]+ so as to accept ":034:"
|
||||
;; in file names.
|
||||
(defvar ag/file-column-pattern-nogroup
|
||||
"^\\(.+?\\):\\([1-9][0-9]*\\):\\([1-9][0-9]*\\):"
|
||||
"A regexp pattern that groups output into filename, line number and column number.")
|
||||
|
||||
(defvar ag/file-column-pattern-group
|
||||
"^\\([[:digit:]]+\\):\\([[:digit:]]+\\):"
|
||||
"A regexp pattern to match line number and column number with grouped output.")
|
||||
|
||||
(defun ag/compilation-match-grouped-filename ()
|
||||
"Match filename backwards when a line/column match is found in grouped output mode."
|
||||
(save-match-data
|
||||
(save-excursion
|
||||
(when (re-search-backward "^File: \\(.*\\)$" (point-min) t)
|
||||
(list (match-string 1))))))
|
||||
|
||||
(define-compilation-mode ag-mode "Ag"
|
||||
"Ag results compilation mode"
|
||||
(set (make-local-variable 'compilation-error-regexp-alist)
|
||||
'(compilation-ag-nogroup compilation-ag-group))
|
||||
(set (make-local-variable 'compilation-error-regexp-alist-alist)
|
||||
(list (cons 'compilation-ag-nogroup (list ag/file-column-pattern-nogroup 1 2 3))
|
||||
(cons 'compilation-ag-group (list ag/file-column-pattern-group
|
||||
'ag/compilation-match-grouped-filename 1 2))))
|
||||
(set (make-local-variable 'compilation-error-face) 'ag-hit-face)
|
||||
(set (make-local-variable 'next-error-function) #'ag/next-error-function)
|
||||
(set (make-local-variable 'compilation-finish-functions)
|
||||
#'ag/run-finished-hook)
|
||||
(add-hook 'compilation-filter-hook 'ag-filter nil t))
|
||||
|
||||
(define-key ag-mode-map (kbd "p") #'compilation-previous-error)
|
||||
(define-key ag-mode-map (kbd "n") #'compilation-next-error)
|
||||
(define-key ag-mode-map (kbd "k") '(lambda () (interactive)
|
||||
(let (kill-buffer-query-functions) (kill-buffer))))
|
||||
|
||||
(defun ag/buffer-name (search-string directory regexp)
|
||||
"Return a buffer name formatted according to ag.el conventions."
|
||||
(cond
|
||||
(ag-reuse-buffers "*ag search")
|
||||
(regexp (format "*ag search regexp:%s dir:%s" search-string directory))
|
||||
(:else (format "*ag search text:%s dir:%s" search-string directory))))
|
||||
|
||||
(defun ag/format-ignore (ignores)
|
||||
"Prepend '--ignore' to every item in IGNORES."
|
||||
(apply #'append
|
||||
(mapcar (lambda (item) (list "--ignore" item)) ignores)))
|
||||
|
||||
(cl-defun ag/search (string directory
|
||||
&key (regexp nil) (file-regex nil) (file-type nil))
|
||||
"Run ag searching for the STRING given in DIRECTORY.
|
||||
If REGEXP is non-nil, treat STRING as a regular expression."
|
||||
(let ((default-directory (file-name-as-directory directory))
|
||||
(arguments ag-arguments)
|
||||
(shell-command-switch "-c"))
|
||||
;; Add double dashes at the end of command line if not specified in
|
||||
;; ag-arguments.
|
||||
(unless (equal (car (last arguments)) "--")
|
||||
(setq arguments (append arguments '("--"))))
|
||||
(setq arguments
|
||||
(append '("--line-number" "--column" "--color" "--color-match" "30;43"
|
||||
"--color-path" "1;32")
|
||||
arguments))
|
||||
(if ag-group-matches
|
||||
(setq arguments (cons "--group" arguments))
|
||||
(setq arguments (cons "--nogroup" arguments)))
|
||||
(unless regexp
|
||||
(setq arguments (cons "--literal" arguments)))
|
||||
(when (or (eq system-type 'windows-nt) (eq system-type 'cygwin))
|
||||
;; Use --vimgrep to work around issue #97 on Windows.
|
||||
(setq arguments (cons "--vimgrep" arguments)))
|
||||
(when (char-or-string-p file-regex)
|
||||
(setq arguments (append `("--file-search-regex" ,file-regex) arguments)))
|
||||
(when file-type
|
||||
(setq arguments (cons (format "--%s" file-type) arguments)))
|
||||
(if (integerp current-prefix-arg)
|
||||
(setq arguments (cons (format "--context=%d" (abs current-prefix-arg)) arguments))
|
||||
(when ag-context-lines
|
||||
(setq arguments (cons (format "--context=%d" ag-context-lines) arguments))))
|
||||
(when ag-ignore-list
|
||||
(setq arguments (append (ag/format-ignore ag-ignore-list) arguments)))
|
||||
(unless (file-exists-p default-directory)
|
||||
(error "No such directory %s" default-directory))
|
||||
(let ((command-string
|
||||
(mapconcat #'shell-quote-argument
|
||||
(append (list ag-executable) arguments (list string "."))
|
||||
" ")))
|
||||
;; If we're called with a prefix, let the user modify the command before
|
||||
;; running it. Typically this means they want to pass additional arguments.
|
||||
;; The numeric value is used for context lines: positive is just context
|
||||
;; number (no modification), negative allows further modification.
|
||||
(when (and current-prefix-arg (not (and (integerp current-prefix-arg) (> current-prefix-arg 0))))
|
||||
;; Make a space in the command-string for the user to enter more arguments.
|
||||
(setq command-string (ag/replace-first command-string " -- " " -- "))
|
||||
;; Prompt for the command.
|
||||
(let ((adjusted-point (- (length command-string) (length string) 5)))
|
||||
(setq command-string
|
||||
(read-from-minibuffer "ag command: "
|
||||
(cons command-string adjusted-point)))))
|
||||
;; Call ag.
|
||||
(compilation-start
|
||||
command-string
|
||||
#'ag-mode
|
||||
`(lambda (mode-name) ,(ag/buffer-name string directory regexp))))))
|
||||
|
||||
(defun ag/dwim-at-point ()
|
||||
"If there's an active selection, return that.
|
||||
Otherwise, get the symbol at point, as a string."
|
||||
(cond ((use-region-p)
|
||||
(buffer-substring-no-properties (region-beginning) (region-end)))
|
||||
((symbol-at-point)
|
||||
(substring-no-properties
|
||||
(symbol-name (symbol-at-point))))))
|
||||
|
||||
(defun ag/buffer-extension-regex ()
|
||||
"If the current buffer has an extension, return
|
||||
a PCRE pattern that matches files with that extension.
|
||||
Returns an empty string otherwise."
|
||||
(let ((file-name (buffer-file-name)))
|
||||
(if (stringp file-name)
|
||||
(format "\\.%s$" (ag/escape-pcre (file-name-extension file-name)))
|
||||
"")))
|
||||
|
||||
(defun ag/longest-string (&rest strings)
|
||||
"Given a list of strings and nils, return the longest string."
|
||||
(let ((longest-string nil))
|
||||
(dolist (string strings)
|
||||
(cond ((null longest-string)
|
||||
(setq longest-string string))
|
||||
((stringp string)
|
||||
(when (< (length longest-string)
|
||||
(length string))
|
||||
(setq longest-string string)))))
|
||||
longest-string))
|
||||
|
||||
(defun ag/replace-first (string before after)
|
||||
"Replace the first occurrence of BEFORE in STRING with AFTER."
|
||||
(replace-regexp-in-string
|
||||
(concat "\\(" (regexp-quote before) "\\)" ".*\\'")
|
||||
after string
|
||||
nil nil 1))
|
||||
|
||||
(autoload 'vc-git-root "vc-git")
|
||||
|
||||
(require 'vc-svn)
|
||||
;; Emacs 23.4 doesn't provide vc-svn-root.
|
||||
(unless (functionp 'vc-svn-root)
|
||||
(defun vc-svn-root (file)
|
||||
(vc-find-root file vc-svn-admin-directory)))
|
||||
|
||||
(autoload 'vc-hg-root "vc-hg")
|
||||
|
||||
(autoload 'vc-bzr-root "vc-bzr")
|
||||
|
||||
(defun ag/project-root (file-path)
|
||||
"Guess the project root of the given FILE-PATH.
|
||||
|
||||
Use `ag-project-root-function' if set, or fall back to VCS
|
||||
roots."
|
||||
(if ag-project-root-function
|
||||
(funcall ag-project-root-function file-path)
|
||||
(or (ag/longest-string
|
||||
(vc-git-root file-path)
|
||||
(vc-svn-root file-path)
|
||||
(vc-hg-root file-path)
|
||||
(vc-bzr-root file-path))
|
||||
file-path)))
|
||||
|
||||
(defun ag/dired-align-size-column ()
|
||||
(beginning-of-line)
|
||||
(when (looking-at "^ ")
|
||||
(forward-char 2)
|
||||
(search-forward " " nil t 4)
|
||||
(let* ((size-start (point))
|
||||
(size-end (search-forward " " nil t))
|
||||
(width (and size-end (- size-end size-start))))
|
||||
(when (and size-end
|
||||
(< width 12)
|
||||
(> width 1))
|
||||
(goto-char size-start)
|
||||
(insert (make-string (- 12 width) ? ))))))
|
||||
|
||||
(defun ag/dired-filter (proc string)
|
||||
"Filter the output of ag to make it suitable for `dired-mode'."
|
||||
(let ((buf (process-buffer proc))
|
||||
(inhibit-read-only t))
|
||||
(if (buffer-name buf)
|
||||
(with-current-buffer buf
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
(let ((beg (point-max)))
|
||||
(goto-char beg)
|
||||
(insert string)
|
||||
(goto-char beg)
|
||||
(or (looking-at "^")
|
||||
(progn
|
||||
(ag/dired-align-size-column)
|
||||
(forward-line 1)))
|
||||
(while (looking-at "^")
|
||||
(insert " ")
|
||||
(ag/dired-align-size-column)
|
||||
(forward-line 1))
|
||||
(goto-char beg)
|
||||
(beginning-of-line)
|
||||
|
||||
;; Remove occurrences of default-directory.
|
||||
(while (search-forward (concat " " default-directory) nil t)
|
||||
(replace-match " " nil t))
|
||||
|
||||
(goto-char (point-max))
|
||||
(if (search-backward "\n" (process-mark proc) t)
|
||||
(progn
|
||||
(dired-insert-set-properties (process-mark proc)
|
||||
(1+ (point)))
|
||||
(move-marker (process-mark proc) (1+ (point)))))))))
|
||||
(delete-process proc))))
|
||||
|
||||
(defun ag/dired-sentinel (proc state)
|
||||
"Update the status/modeline after the process finishes."
|
||||
(let ((buf (process-buffer proc))
|
||||
(inhibit-read-only t))
|
||||
(if (buffer-name buf)
|
||||
(with-current-buffer buf
|
||||
(let ((buffer-read-only nil))
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(insert "\n ag " state)
|
||||
(forward-char -1) ;Back up before \n at end of STATE.
|
||||
(insert " at " (substring (current-time-string) 0 19))
|
||||
(forward-char 1)
|
||||
(setq mode-line-process
|
||||
(concat ":" (symbol-name (process-status proc))))
|
||||
;; Since the buffer and mode line will show that the
|
||||
;; process is dead, we can delete it now. Otherwise it
|
||||
;; will stay around until M-x list-processes.
|
||||
(delete-process proc)
|
||||
(force-mode-line-update)))
|
||||
(run-hooks 'dired-after-readin-hook)
|
||||
(message "%s finished." (current-buffer))))))
|
||||
|
||||
(defun ag/kill-process ()
|
||||
"Kill the `ag' process running in the current buffer."
|
||||
(interactive)
|
||||
(let ((ag (get-buffer-process (current-buffer))))
|
||||
(and ag (eq (process-status ag) 'run)
|
||||
(eq (process-filter ag) (function find-dired-filter))
|
||||
(condition-case nil
|
||||
(delete-process ag)
|
||||
(error nil)))))
|
||||
|
||||
(defun ag/escape-pcre (regexp)
|
||||
"Escape the PCRE-special characters in REGEXP so that it is
|
||||
matched literally."
|
||||
(let ((alphanum "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"))
|
||||
(apply #'concat
|
||||
(mapcar
|
||||
(lambda (c)
|
||||
(cond
|
||||
((not (string-match-p (regexp-quote c) alphanum))
|
||||
(concat "\\" c))
|
||||
(t c)))
|
||||
(mapcar #'char-to-string (string-to-list regexp))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag (string directory)
|
||||
"Search using ag in a given DIRECTORY for a given literal search STRING,
|
||||
with STRING defaulting to the symbol under point.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag."
|
||||
(interactive (list (ag/read-from-minibuffer "Search string")
|
||||
(read-directory-name "Directory: ")))
|
||||
(ag/search string directory))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-files (string file-type directory)
|
||||
"Search using ag in a given DIRECTORY for a given literal search STRING,
|
||||
limited to files that match FILE-TYPE. STRING defaults to the
|
||||
symbol under point.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag."
|
||||
(interactive (list (ag/read-from-minibuffer "Search string")
|
||||
(ag/read-file-type)
|
||||
(read-directory-name "Directory: ")))
|
||||
(apply #'ag/search string directory file-type))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-regexp (string directory)
|
||||
"Search using ag in a given directory for a given regexp.
|
||||
The regexp should be in PCRE syntax, not Emacs regexp syntax.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag."
|
||||
(interactive "sSearch regexp: \nDDirectory: ")
|
||||
(ag/search string directory :regexp t))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-project (string)
|
||||
"Guess the root of the current project and search it with ag
|
||||
for the given literal search STRING.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag."
|
||||
(interactive (list (ag/read-from-minibuffer "Search string")))
|
||||
(ag/search string (ag/project-root default-directory)))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-project-files (string file-type)
|
||||
"Search using ag for a given literal search STRING,
|
||||
limited to files that match FILE-TYPE. STRING defaults to the
|
||||
symbol under point.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag."
|
||||
(interactive (list (ag/read-from-minibuffer "Search string")
|
||||
(ag/read-file-type)))
|
||||
(apply 'ag/search string (ag/project-root default-directory) file-type))
|
||||
|
||||
(defun ag/read-from-minibuffer (prompt)
|
||||
"Read a value from the minibuffer with PROMPT.
|
||||
If there's a string at point, offer that as a default."
|
||||
(let* ((suggested (ag/dwim-at-point))
|
||||
(final-prompt
|
||||
(if suggested
|
||||
(format "%s (default %s): " prompt suggested)
|
||||
(format "%s: " prompt)))
|
||||
;; Ask the user for input, but add `suggested' to the history
|
||||
;; so they can use M-n if they want to modify it.
|
||||
(user-input (read-from-minibuffer
|
||||
final-prompt
|
||||
nil nil nil nil suggested)))
|
||||
;; Return the input provided by the user, or use `suggested' if
|
||||
;; the input was empty.
|
||||
(if (> (length user-input) 0)
|
||||
user-input
|
||||
suggested)))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-project-regexp (regexp)
|
||||
"Guess the root of the current project and search it with ag
|
||||
for the given regexp. The regexp should be in PCRE syntax, not
|
||||
Emacs regexp syntax.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag."
|
||||
(interactive (list (ag/read-from-minibuffer "Search regexp")))
|
||||
(ag/search regexp (ag/project-root default-directory) :regexp t))
|
||||
|
||||
(autoload 'symbol-at-point "thingatpt")
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'ag-project-at-point 'ag-project)
|
||||
(make-obsolete 'ag-project-at-point 'ag-project "0.19")
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'ag-regexp-project-at-point 'ag-project-regexp)
|
||||
(make-obsolete 'ag-regexp-project-at-point 'ag-project-regexp "0.46")
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-dired (dir string)
|
||||
"Recursively find files in DIR matching literal search STRING.
|
||||
|
||||
The PATTERN is matched against the full path to the file, not
|
||||
only against the file name.
|
||||
|
||||
The results are presented as a `dired-mode' buffer with
|
||||
`default-directory' being DIR.
|
||||
|
||||
See also `ag-dired-regexp'."
|
||||
(interactive "DDirectory: \nsFile pattern: ")
|
||||
(ag-dired-regexp dir (ag/escape-pcre string)))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-dired-regexp (dir regexp)
|
||||
"Recursively find files in DIR matching REGEXP.
|
||||
REGEXP should be in PCRE syntax, not Emacs regexp syntax.
|
||||
|
||||
The REGEXP is matched against the full path to the file, not
|
||||
only against the file name.
|
||||
|
||||
Results are presented as a `dired-mode' buffer with
|
||||
`default-directory' being DIR.
|
||||
|
||||
See also `find-dired'."
|
||||
(interactive "DDirectory: \nsFile regexp: ")
|
||||
(let* ((dired-buffers dired-buffers) ;; do not mess with regular dired buffers
|
||||
(orig-dir dir)
|
||||
(dir (file-name-as-directory (expand-file-name dir)))
|
||||
(buffer-name (if ag-reuse-buffers
|
||||
"*ag dired*"
|
||||
(format "*ag dired pattern:%s dir:%s*" regexp dir)))
|
||||
(cmd (concat ag-executable " --nocolor -g '" regexp "' "
|
||||
(shell-quote-argument dir)
|
||||
" | grep -v '^$' | sed s/\\'/\\\\\\\\\\'/ | xargs -I '{}' ls "
|
||||
dired-listing-switches " '{}' &")))
|
||||
(with-current-buffer (get-buffer-create buffer-name)
|
||||
(switch-to-buffer (current-buffer))
|
||||
(widen)
|
||||
(kill-all-local-variables)
|
||||
(if (fboundp 'read-only-mode)
|
||||
(read-only-mode -1)
|
||||
(setq buffer-read-only nil))
|
||||
(let ((inhibit-read-only t)) (erase-buffer))
|
||||
(setq default-directory dir)
|
||||
(run-hooks 'dired-before-readin-hook)
|
||||
(shell-command cmd (current-buffer))
|
||||
(insert " " dir ":\n")
|
||||
(insert " " cmd "\n")
|
||||
(dired-mode dir)
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map (current-local-map))
|
||||
(define-key map "\C-c\C-k" 'ag/kill-process)
|
||||
(use-local-map map))
|
||||
(set (make-local-variable 'dired-sort-inhibit) t)
|
||||
(set (make-local-variable 'revert-buffer-function)
|
||||
`(lambda (ignore-auto noconfirm)
|
||||
(ag-dired-regexp ,orig-dir ,regexp)))
|
||||
(if (fboundp 'dired-simple-subdir-alist)
|
||||
(dired-simple-subdir-alist)
|
||||
(set (make-local-variable 'dired-subdir-alist)
|
||||
(list (cons default-directory (point-min-marker)))))
|
||||
(let ((proc (get-buffer-process (current-buffer))))
|
||||
(set-process-filter proc #'ag/dired-filter)
|
||||
(set-process-sentinel proc #'ag/dired-sentinel)
|
||||
;; Initialize the process marker; it is used by the filter.
|
||||
(move-marker (process-mark proc) 1 (current-buffer)))
|
||||
(setq mode-line-process '(":%s")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-project-dired (pattern)
|
||||
"Recursively find files in current project matching PATTERN.
|
||||
|
||||
See also `ag-dired'."
|
||||
(interactive "sFile pattern: ")
|
||||
(ag-dired-regexp (ag/project-root default-directory) (ag/escape-pcre pattern)))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-project-dired-regexp (regexp)
|
||||
"Recursively find files in current project matching REGEXP.
|
||||
|
||||
See also `ag-dired-regexp'."
|
||||
(interactive "sFile regexp: ")
|
||||
(ag-dired-regexp (ag/project-root default-directory) regexp))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-kill-buffers ()
|
||||
"Kill all `ag-mode' buffers."
|
||||
(interactive)
|
||||
(dolist (buffer (buffer-list))
|
||||
(when (eq (buffer-local-value 'major-mode buffer) 'ag-mode)
|
||||
(kill-buffer buffer))))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-kill-other-buffers ()
|
||||
"Kill all `ag-mode' buffers other than the current buffer."
|
||||
(interactive)
|
||||
(let ((current-buffer (current-buffer)))
|
||||
(dolist (buffer (buffer-list))
|
||||
(when (and
|
||||
(eq (buffer-local-value 'major-mode buffer) 'ag-mode)
|
||||
(not (eq buffer current-buffer)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
;; Based on grep-filter.
|
||||
(defun ag-filter ()
|
||||
"Handle escape sequences inserted by the ag process.
|
||||
This function is called from `compilation-filter-hook'."
|
||||
(save-excursion
|
||||
(forward-line 0)
|
||||
(let ((end (point)) beg)
|
||||
(goto-char compilation-filter-start)
|
||||
(forward-line 0)
|
||||
(setq beg (point))
|
||||
;; Only operate on whole lines so we don't get caught with part of an
|
||||
;; escape sequence in one chunk and the rest in another.
|
||||
(when (< (point) end)
|
||||
(setq end (copy-marker end))
|
||||
(when ag-highlight-search
|
||||
;; Highlight ag matches and delete marking sequences.
|
||||
(while (re-search-forward "\033\\[30;43m\\(.*?\\)\033\\[0m\033\\[K" end 1)
|
||||
(replace-match (propertize (match-string 1)
|
||||
'face nil 'font-lock-face 'ag-match-face)
|
||||
t t)))
|
||||
;; Add marker at start of line for files. This is used by the match
|
||||
;; in `compilation-error-regexp-alist' to extract the file name.
|
||||
(when ag-group-matches
|
||||
(goto-char beg)
|
||||
(while (re-search-forward "\033\\[1;32m\\(.*\\)\033\\[0m\033\\[K" end 1)
|
||||
(replace-match
|
||||
(concat "File: " (propertize (match-string 1) 'face nil 'font-lock-face
|
||||
'compilation-info))
|
||||
t t)))
|
||||
;; Delete all remaining escape sequences
|
||||
(goto-char beg)
|
||||
(while (re-search-forward "\033\\[[0-9;]*[mK]" end 1)
|
||||
(replace-match "" t t))))))
|
||||
|
||||
(defun ag/get-supported-types ()
|
||||
"Query the ag executable for which file types it recognises."
|
||||
(let* ((ag-output (shell-command-to-string (format "%s --list-file-types" ag-executable)))
|
||||
(lines (-map #'s-trim (s-lines ag-output)))
|
||||
(types (--keep (when (s-starts-with? "--" it) (s-chop-prefix "--" it )) lines))
|
||||
(extensions (--map (s-split " " it) (--filter (s-starts-with? "." it) lines))))
|
||||
(-zip types extensions)))
|
||||
|
||||
(defun ag/read-file-type ()
|
||||
"Prompt the user for a known file type, or let them specify a PCRE regex."
|
||||
(let* ((all-types-with-extensions (ag/get-supported-types))
|
||||
(all-types (mapcar 'car all-types-with-extensions))
|
||||
(file-type
|
||||
(completing-read "Select file type: "
|
||||
(append '("custom (provide a PCRE regex)") all-types)))
|
||||
(file-type-extensions
|
||||
(cdr (assoc file-type all-types-with-extensions))))
|
||||
(if file-type-extensions
|
||||
(list :file-type file-type)
|
||||
(list :file-regex
|
||||
(read-from-minibuffer "Filenames which match PCRE: "
|
||||
(ag/buffer-extension-regex))))))
|
||||
|
||||
(provide 'ag)
|
||||
;;; ag.el ends here
|
||||
@@ -1,92 +0,0 @@
|
||||
;;; alert-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "alert" "alert.el" (22533 17539 221493 451000))
|
||||
;;; Generated autoloads from alert.el
|
||||
|
||||
(autoload 'alert-add-rule "alert" "\
|
||||
Programmatically add an alert configuration rule.
|
||||
|
||||
Normally, users should custoimze `alert-user-configuration'.
|
||||
This facility is for module writers and users that need to do
|
||||
things the Lisp way.
|
||||
|
||||
Here is a rule the author currently uses with ERC, so that the
|
||||
fringe gets colored whenever people chat on BitlBee:
|
||||
|
||||
\(alert-add-rule :status \\='(buried visible idle)
|
||||
:severity \\='(moderate high urgent)
|
||||
:mode \\='erc-mode
|
||||
:predicate
|
||||
#\\='(lambda (info)
|
||||
(string-match (concat \"\\\\`[^&].*@BitlBee\\\\\\='\")
|
||||
(erc-format-target-and/or-network)))
|
||||
:persistent
|
||||
#\\='(lambda (info)
|
||||
;; If the buffer is buried, or the user has been
|
||||
;; idle for `alert-reveal-idle-time' seconds,
|
||||
;; make this alert persistent. Normally, alerts
|
||||
;; become persistent after
|
||||
;; `alert-persist-idle-time' seconds.
|
||||
(memq (plist-get info :status) \\='(buried idle)))
|
||||
:style \\='fringe
|
||||
:continue t)
|
||||
|
||||
\(fn &key SEVERITY STATUS MODE CATEGORY TITLE MESSAGE PREDICATE ICON (style alert-default-style) PERSISTENT CONTINUE NEVER-PERSIST APPEND)" nil nil)
|
||||
|
||||
(autoload 'alert "alert" "\
|
||||
Alert the user that something has happened.
|
||||
MESSAGE is what the user will see. You may also use keyword
|
||||
arguments to specify additional details. Here is a full example:
|
||||
|
||||
\(alert \"This is a message\"
|
||||
:severity \\='high ;; The default severity is `normal'
|
||||
:title \"Title\" ;; An optional title
|
||||
:category \\='example ;; A symbol to identify the message
|
||||
:mode \\='text-mode ;; Normally determined automatically
|
||||
:buffer (current-buffer) ;; This is the default
|
||||
:data nil ;; Unused by alert.el itself
|
||||
:persistent nil ;; Force the alert to be persistent;
|
||||
;; it is best not to use this
|
||||
:never-persist nil ;; Force this alert to never persist
|
||||
:style \\='fringe) ;; Force a given style to be used;
|
||||
;; this is only for debugging!
|
||||
|
||||
If no :title is given, the buffer-name of :buffer is used. If
|
||||
:buffer is nil, it is the current buffer at the point of call.
|
||||
|
||||
:data is an opaque value which modules can pass through to their
|
||||
own styles if they wish.
|
||||
|
||||
Here are some more typical examples of usage:
|
||||
|
||||
;; This is the most basic form usage
|
||||
(alert \"This is an alert\")
|
||||
|
||||
;; You can adjust the severity for more important messages
|
||||
(alert \"This is an alert\" :severity \\='high)
|
||||
|
||||
;; Or decrease it for purely informative ones
|
||||
(alert \"This is an alert\" :severity \\='trivial)
|
||||
|
||||
;; Alerts can have optional titles. Otherwise, the title is the
|
||||
;; buffer-name of the (current-buffer) where the alert originated.
|
||||
(alert \"This is an alert\" :title \"My Alert\")
|
||||
|
||||
;; Further, alerts can have categories. This allows users to
|
||||
;; selectively filter on them.
|
||||
(alert \"This is an alert\" :title \"My Alert\"
|
||||
:category \\='some-category-or-other)
|
||||
|
||||
\(fn MESSAGE &key (severity (quote normal)) TITLE ICON CATEGORY BUFFER MODE DATA STYLE PERSISTENT NEVER-PERSIST)" nil nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; alert-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "alert" "20160824.821" "Growl-style notification system for Emacs" '((gntp "0.1") (log4e "0.3.0")) :url "https://github.com/jwiegley/alert" :keywords '("notification" "emacs" "message"))
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,73 +0,0 @@
|
||||
;;; ascii-art-to-unicode-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "ascii-art-to-unicode" "ascii-art-to-unicode.el"
|
||||
;;;;;; (22505 22834 381650 654000))
|
||||
;;; Generated autoloads from ascii-art-to-unicode.el
|
||||
|
||||
(autoload 'aa2u "ascii-art-to-unicode" "\
|
||||
Convert simple ASCII art line drawings to Unicode.
|
||||
Specifically, perform the following replacements:
|
||||
|
||||
- (hyphen) BOX DRAWINGS LIGHT HORIZONTAL
|
||||
| (vertical bar) BOX DRAWINGS LIGHT VERTICAL
|
||||
+ (plus) (one of)
|
||||
BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
|
||||
BOX DRAWINGS LIGHT DOWN AND RIGHT
|
||||
BOX DRAWINGS LIGHT DOWN AND LEFT
|
||||
BOX DRAWINGS LIGHT UP AND RIGHT
|
||||
BOX DRAWINGS LIGHT UP AND LEFT
|
||||
BOX DRAWINGS LIGHT VERTICAL AND RIGHT
|
||||
BOX DRAWINGS LIGHT VERTICAL AND LEFT
|
||||
BOX DRAWINGS LIGHT UP AND HORIZONTAL
|
||||
BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
|
||||
BOX DRAWINGS LIGHT UP
|
||||
BOX DRAWINGS LIGHT DOWN
|
||||
BOX DRAWINGS LIGHT LEFT
|
||||
BOX DRAWINGS LIGHT RIGHT
|
||||
QUESTION MARK
|
||||
|
||||
More precisely, hyphen and vertical bar are substituted unconditionally,
|
||||
first, and plus is substituted with a character depending on its north,
|
||||
south, east and west neighbors.
|
||||
|
||||
NB: Actually, `aa2u' can also use \"HEAVY\" instead of \"LIGHT\",
|
||||
depending on the value of variable `aa2u-uniform-weight'.
|
||||
|
||||
This command operates on either the active region,
|
||||
or the accessible portion otherwise.
|
||||
|
||||
\(fn BEG END &optional INTERACTIVE)" t nil)
|
||||
|
||||
(autoload 'aa2u-rectangle "ascii-art-to-unicode" "\
|
||||
Like `aa2u' on the region-rectangle.
|
||||
When called from a program the rectangle's corners
|
||||
are START (top left) and END (bottom right).
|
||||
|
||||
\(fn START END)" t nil)
|
||||
|
||||
(autoload 'aa2u-mark-as-text "ascii-art-to-unicode" "\
|
||||
Set property `aa2u-text' of the text from START to END.
|
||||
This prevents `aa2u' from misinterpreting \"|\", \"-\" and \"+\"
|
||||
in that region as lines and intersections to be replaced.
|
||||
Prefix arg means to remove property `aa2u-text', instead.
|
||||
|
||||
\(fn START END &optional UNMARK)" t nil)
|
||||
|
||||
(autoload 'aa2u-mark-rectangle-as-text "ascii-art-to-unicode" "\
|
||||
Like `aa2u-mark-as-text' on the region-rectangle.
|
||||
When called from a program the rectangle's corners
|
||||
are START (top left) and END (bottom right).
|
||||
|
||||
\(fn START END &optional UNMARK)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; ascii-art-to-unicode-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "ascii-art-to-unicode" "1.9" "a small artist adjunct" 'nil :url "http://www.gnuvola.org/software/aa2u/" :keywords '("ascii" "unicode" "box-drawing"))
|
||||
@@ -1,510 +0,0 @@
|
||||
;;; ascii-art-to-unicode.el --- a small artist adjunct -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2014 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;; Version: 1.9
|
||||
;; Keywords: ascii, unicode, box-drawing
|
||||
;; URL: http://www.gnuvola.org/software/aa2u/
|
||||
|
||||
;; 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:
|
||||
|
||||
;; The command `aa2u' converts simple ASCII art line drawings in
|
||||
;; the {active,accessible} region of the current buffer to Unicode.
|
||||
;; Command `aa2u-rectangle' is like `aa2u', but works on rectangles.
|
||||
;;
|
||||
;; Example use case:
|
||||
;; - M-x artist-mode RET
|
||||
;; - C-c C-a r ; artist-select-op-rectangle
|
||||
;; - (draw two rectangles)
|
||||
;;
|
||||
;; +---------------+
|
||||
;; | |
|
||||
;; | +-------+--+
|
||||
;; | | | |
|
||||
;; | | | |
|
||||
;; | | | |
|
||||
;; +-------+-------+ |
|
||||
;; | |
|
||||
;; | |
|
||||
;; | |
|
||||
;; +----------+
|
||||
;;
|
||||
;; - C-c C-c ; artist-mode-off (optional)
|
||||
;; - C-x n n ; narrow-to-region
|
||||
;; - M-x aa2u RET
|
||||
;;
|
||||
;; ┌───────────────┐
|
||||
;; │ │
|
||||
;; │ ┌───────┼──┐
|
||||
;; │ │ │ │
|
||||
;; │ │ │ │
|
||||
;; │ │ │ │
|
||||
;; └───────┼───────┘ │
|
||||
;; │ │
|
||||
;; │ │
|
||||
;; │ │
|
||||
;; └──────────┘
|
||||
;;
|
||||
;; Much easier on the eyes now!
|
||||
;;
|
||||
;; Normally, lines are drawn with the `LIGHT' weight. If you set var
|
||||
;; `aa2u-uniform-weight' to symbol `HEAVY', you will see, instead:
|
||||
;;
|
||||
;; ┏━━━━━━━━━━━━━━━┓
|
||||
;; ┃ ┃
|
||||
;; ┃ ┏━━━━━━━╋━━┓
|
||||
;; ┃ ┃ ┃ ┃
|
||||
;; ┃ ┃ ┃ ┃
|
||||
;; ┃ ┃ ┃ ┃
|
||||
;; ┗━━━━━━━╋━━━━━━━┛ ┃
|
||||
;; ┃ ┃
|
||||
;; ┃ ┃
|
||||
;; ┃ ┃
|
||||
;; ┗━━━━━━━━━━┛
|
||||
;;
|
||||
;; To protect particular ‘|’, ‘-’ or ‘+’ characters from conversion,
|
||||
;; you can set the property `aa2u-text' on that text with command
|
||||
;; `aa2u-mark-as-text'. A prefix arg clears the property, instead.
|
||||
;; (You can use `describe-text-properties' to check.) For example:
|
||||
;;
|
||||
;; ┌───────────────────┐
|
||||
;; │ │
|
||||
;; │ |\/| │
|
||||
;; │ `Oo' --Oop Ack! │
|
||||
;; │ ^&-MM. │
|
||||
;; │ │
|
||||
;; └─────────┬─────────┘
|
||||
;; │
|
||||
;; """""""""
|
||||
;;
|
||||
;; Command `aa2u-mark-rectangle-as-text' is similar, for rectangles.
|
||||
;;
|
||||
;; Tip: For best results, you should make sure all the tab characaters
|
||||
;; are converted to spaces. See: `untabify', `indent-tabs-mode'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'pcase)
|
||||
|
||||
(autoload 'apply-on-rectangle "rect")
|
||||
|
||||
(defvar aa2u-uniform-weight 'LIGHT
|
||||
"A symbol, either `LIGHT' or `HEAVY'.
|
||||
This specifies the weight of all the lines.")
|
||||
|
||||
;;;---------------------------------------------------------------------------
|
||||
;;; support
|
||||
|
||||
(defsubst aa2u--text-p (pos)
|
||||
(get-text-property pos 'aa2u-text))
|
||||
|
||||
(defun aa2u-ucs-bd-uniform-name (&rest components)
|
||||
"Return a string naming UCS char w/ WEIGHT and COMPONENTS.
|
||||
The string begins with \"BOX DRAWINGS\"; followed by the weight
|
||||
as per variable `aa2u-uniform-weight', followed by COMPONENTS,
|
||||
a list of one or two symbols from the set:
|
||||
|
||||
VERTICAL
|
||||
HORIZONTAL
|
||||
DOWN
|
||||
UP
|
||||
RIGHT
|
||||
LEFT
|
||||
|
||||
If of length two, the first element in COMPONENTS should be
|
||||
the \"Y-axis\" (VERTICAL, DOWN, UP). In that case, the returned
|
||||
string includes \"AND\" between the elements of COMPONENTS.
|
||||
|
||||
Lastly, all words are separated by space (U+20)."
|
||||
(format "BOX DRAWINGS %s %s"
|
||||
aa2u-uniform-weight
|
||||
(mapconcat 'symbol-name components
|
||||
" AND ")))
|
||||
|
||||
(defun aa2u-1c (stringifier &rest components)
|
||||
"Apply STRINGIFIER to COMPONENTS; return the UCS char w/ this name.
|
||||
The char is a string (of length one), with two properties:
|
||||
|
||||
aa2u-stringifier
|
||||
aa2u-components
|
||||
|
||||
Their values are STRINGIFIER and COMPONENTS, respectively."
|
||||
(let ((s (string (cdr (assoc-string (apply stringifier components)
|
||||
(ucs-names))))))
|
||||
(propertize s
|
||||
'aa2u-stringifier stringifier
|
||||
'aa2u-components components)))
|
||||
|
||||
(defun aa2u-phase-1 ()
|
||||
(cl-flet
|
||||
((gsr (was name)
|
||||
(goto-char (point-min))
|
||||
(let ((now (aa2u-1c 'aa2u-ucs-bd-uniform-name name)))
|
||||
(while (search-forward was nil t)
|
||||
(unless (aa2u--text-p (match-beginning 0))
|
||||
(replace-match now t t))))))
|
||||
(gsr "|" 'VERTICAL)
|
||||
(gsr "-" 'HORIZONTAL)))
|
||||
|
||||
(defun aa2u-replacement (pos)
|
||||
(let ((cc (- pos (line-beginning-position))))
|
||||
(cl-flet*
|
||||
((ok (name pos)
|
||||
(when (or
|
||||
;; Infer LIGHTness between "snug" ‘?+’es.
|
||||
;; |
|
||||
;; +-----------++--+ +
|
||||
;; | somewhere ++--+---+-+----+
|
||||
;; +-+---------+ nowhere |+--+
|
||||
;; + +---------++
|
||||
;; | +---|
|
||||
(eq ?+ (char-after pos))
|
||||
;; Require properly directional neighborliness.
|
||||
(memq (cl-case name
|
||||
((UP DOWN) 'VERTICAL)
|
||||
((LEFT RIGHT) 'HORIZONTAL))
|
||||
(get-text-property pos 'aa2u-components)))
|
||||
name))
|
||||
(v (name dir) (let ((bol (line-beginning-position dir))
|
||||
(eol (line-end-position dir)))
|
||||
(when (< cc (- eol bol))
|
||||
(ok name (+ bol cc)))))
|
||||
(h (name dir) (let ((bol (line-beginning-position))
|
||||
(eol (line-end-position))
|
||||
(pos (+ pos dir)))
|
||||
(unless (or (> bol pos)
|
||||
(<= eol pos))
|
||||
(ok name pos))))
|
||||
(two-p (ls) (= 2 (length ls)))
|
||||
(just (&rest args) (delq nil args)))
|
||||
(apply 'aa2u-1c
|
||||
'aa2u-ucs-bd-uniform-name
|
||||
(just (pcase (just (v 'UP 0)
|
||||
(v 'DOWN 2))
|
||||
((pred two-p) 'VERTICAL)
|
||||
(`(,vc) vc)
|
||||
(_ nil))
|
||||
(pcase (just (h 'LEFT -1)
|
||||
(h 'RIGHT 1))
|
||||
((pred two-p) 'HORIZONTAL)
|
||||
(`(,hc) hc)
|
||||
(_ nil)))))))
|
||||
|
||||
(defun aa2u-phase-2 ()
|
||||
(goto-char (point-min))
|
||||
(let (changes)
|
||||
;; (phase 2.1 -- what WOULD change)
|
||||
;; This is for the benefit of ‘aa2u-replacement ok’, which
|
||||
;; otherwise (monolithic phase 2) would need to convert the
|
||||
;; "properly directional neighborliness" impl from a simple
|
||||
;; ‘memq’ to an ‘intersction’.
|
||||
(while (search-forward "+" nil t)
|
||||
(let ((p (point)))
|
||||
(unless (aa2u--text-p (1- p))
|
||||
(push (cons p (or (aa2u-replacement (1- p))
|
||||
"?"))
|
||||
changes))))
|
||||
;; (phase 2.2 -- apply changes)
|
||||
(dolist (ch changes)
|
||||
(goto-char (car ch))
|
||||
(delete-char -1)
|
||||
(insert (cdr ch)))))
|
||||
|
||||
(defun aa2u-phase-3 ()
|
||||
(remove-text-properties (point-min) (point-max)
|
||||
(list 'aa2u-stringifier nil
|
||||
'aa2u-components nil)))
|
||||
|
||||
;;;---------------------------------------------------------------------------
|
||||
;;; commands
|
||||
|
||||
;;;###autoload
|
||||
(defun aa2u (beg end &optional interactive)
|
||||
"Convert simple ASCII art line drawings to Unicode.
|
||||
Specifically, perform the following replacements:
|
||||
|
||||
- (hyphen) BOX DRAWINGS LIGHT HORIZONTAL
|
||||
| (vertical bar) BOX DRAWINGS LIGHT VERTICAL
|
||||
+ (plus) (one of)
|
||||
BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
|
||||
BOX DRAWINGS LIGHT DOWN AND RIGHT
|
||||
BOX DRAWINGS LIGHT DOWN AND LEFT
|
||||
BOX DRAWINGS LIGHT UP AND RIGHT
|
||||
BOX DRAWINGS LIGHT UP AND LEFT
|
||||
BOX DRAWINGS LIGHT VERTICAL AND RIGHT
|
||||
BOX DRAWINGS LIGHT VERTICAL AND LEFT
|
||||
BOX DRAWINGS LIGHT UP AND HORIZONTAL
|
||||
BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
|
||||
BOX DRAWINGS LIGHT UP
|
||||
BOX DRAWINGS LIGHT DOWN
|
||||
BOX DRAWINGS LIGHT LEFT
|
||||
BOX DRAWINGS LIGHT RIGHT
|
||||
QUESTION MARK
|
||||
|
||||
More precisely, hyphen and vertical bar are substituted unconditionally,
|
||||
first, and plus is substituted with a character depending on its north,
|
||||
south, east and west neighbors.
|
||||
|
||||
NB: Actually, `aa2u' can also use \"HEAVY\" instead of \"LIGHT\",
|
||||
depending on the value of variable `aa2u-uniform-weight'.
|
||||
|
||||
This command operates on either the active region,
|
||||
or the accessible portion otherwise."
|
||||
(interactive "r\np")
|
||||
;; This weirdness, along w/ the undocumented "p" in the ‘interactive’
|
||||
;; form, is to allow ‘M-x aa2u’ (interactive invocation) w/ no region
|
||||
;; selected to default to the accessible portion (as documented), which
|
||||
;; was the norm in ascii-art-to-unicode.el prior to 1.5. A bugfix,
|
||||
;; essentially. This is ugly, unfortunately -- is there a better way?!
|
||||
(when (and interactive (not (region-active-p)))
|
||||
(setq beg (point-min)
|
||||
end (point-max)))
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
(narrow-to-region beg end)
|
||||
(aa2u-phase-1)
|
||||
(aa2u-phase-2)
|
||||
(aa2u-phase-3))))
|
||||
|
||||
;;;###autoload
|
||||
(defun aa2u-rectangle (start end)
|
||||
"Like `aa2u' on the region-rectangle.
|
||||
When called from a program the rectangle's corners
|
||||
are START (top left) and END (bottom right)."
|
||||
(interactive "r")
|
||||
(let* ((was (delete-extract-rectangle start end))
|
||||
(now (with-temp-buffer
|
||||
(insert-rectangle was)
|
||||
(aa2u (point) (mark))
|
||||
(extract-rectangle (point-min) (point-max)))))
|
||||
(goto-char (min start end))
|
||||
(insert-rectangle now)))
|
||||
|
||||
;;;###autoload
|
||||
(defun aa2u-mark-as-text (start end &optional unmark)
|
||||
"Set property `aa2u-text' of the text from START to END.
|
||||
This prevents `aa2u' from misinterpreting \"|\", \"-\" and \"+\"
|
||||
in that region as lines and intersections to be replaced.
|
||||
Prefix arg means to remove property `aa2u-text', instead."
|
||||
(interactive "r\nP")
|
||||
(funcall (if unmark
|
||||
'remove-text-properties
|
||||
'add-text-properties)
|
||||
start end
|
||||
'(aa2u-text t)))
|
||||
|
||||
;;;###autoload
|
||||
(defun aa2u-mark-rectangle-as-text (start end &optional unmark)
|
||||
"Like `aa2u-mark-as-text' on the region-rectangle.
|
||||
When called from a program the rectangle's corners
|
||||
are START (top left) and END (bottom right)."
|
||||
(interactive "r\nP")
|
||||
(apply-on-rectangle
|
||||
(lambda (scol ecol unmark)
|
||||
(let ((p (point)))
|
||||
(aa2u-mark-as-text (+ p scol) (+ p ecol) unmark)))
|
||||
start end
|
||||
unmark))
|
||||
|
||||
;;;---------------------------------------------------------------------------
|
||||
;;; that's it
|
||||
|
||||
;;;; ChangeLog:
|
||||
|
||||
;; 2014-05-29 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u] Release: 1.9
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [Version]: Bump
|
||||
;; to "1.9".
|
||||
;;
|
||||
;; 2014-05-29 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u] Mention TAB infelicity.
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [Commentary]:
|
||||
;; ...here.
|
||||
;;
|
||||
;; 2014-05-29 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u] Update homepage; drop other links.
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [URL]: New
|
||||
;; header.
|
||||
;; [Commentary]: Remove the HACKING and Tip Jar links.
|
||||
;;
|
||||
;; 2014-05-29 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u] New command: aa2u-mark-rectangle-as-text
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el: Arrange to
|
||||
;; autoload "rect" for ‘apply-on-rectangle’.
|
||||
;; (aa2u-mark-rectangle-as-text): New command, w/ autoload cookie.
|
||||
;;
|
||||
;; 2014-05-24 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u maint] Mention TAB infelicity in HACKING; nfc.
|
||||
;;
|
||||
;; 2014-05-21 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u] Release: 1.8
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [Version]: Bump
|
||||
;; to "1.8".
|
||||
;;
|
||||
;; 2014-05-21 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u] New command: aa2u-mark-as-text
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el
|
||||
;; (aa2u--text-p): New defsubst.
|
||||
;; (aa2u-phase-1, aa2u-phase-2): If the character in question is
|
||||
;; ‘aa2u--text-p’, just ignore it.
|
||||
;; (aa2u-mark-as-text): New command, w/ autoload cookie.
|
||||
;;
|
||||
;; 2014-05-21 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u int] Add abstraction: gsr
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el
|
||||
;; (aa2u-phase-1 gsr): New internal func.
|
||||
;;
|
||||
;; 2014-05-21 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u] Declare package keywords.
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [Keywords]: New
|
||||
;; header.
|
||||
;;
|
||||
;; 2014-05-21 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u maint] Add ‘Maintainer’ header per top-level README; nfc.
|
||||
;;
|
||||
;; 2014-05-11 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u] Release: 1.7
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [Version]: Bump
|
||||
;; to "1.7".
|
||||
;;
|
||||
;; 2014-05-11 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u] New command: aa2u-rectangle
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el
|
||||
;; (aa2u-rectangle): New command.
|
||||
;;
|
||||
;; 2014-05-11 Andreas Schwab <schwab@linux-m68k.org>
|
||||
;;
|
||||
;; ascii-art-to-unicode.el (aa2u-replacement): Use cl-case instead of
|
||||
;; case.
|
||||
;;
|
||||
;; 2014-05-09 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; fixup! [aa2u] Make weight dynamically customizable.
|
||||
;;
|
||||
;; 2014-05-09 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u maint] Update HACKING; nfc.
|
||||
;;
|
||||
;; 2014-05-09 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u] Make weight dynamically customizable.
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el
|
||||
;; (aa2u-uniform-weight): New defvar.
|
||||
;; (aa2u-ucs-bd-uniform-name): Don't take arg WEIGHT; instead, consult
|
||||
;; ‘aa2u-uniform-weight’.
|
||||
;; (aa2u-phase-1, aa2u-replacement): Update calls to
|
||||
;; ‘aa2u-ucs-bd-uniform-name’.
|
||||
;; (aa2u): Mention new var in docstring.
|
||||
;;
|
||||
;; 2014-05-09 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u int] Compute vertical/horizontal components separately.
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el
|
||||
;; (aa2u-replacement ok): Recognize ‘UP’, ‘DOWN’, ‘LEFT’, ‘RIGHT’ instead
|
||||
;; of ‘n’, ‘s’, ‘w’, ‘e’.
|
||||
;; (aa2u-replacement two-p): New internal func.
|
||||
;; (aa2u-replacement just): Likewise.
|
||||
;; (aa2u-replacement): Don't glom everything for one ‘pcase’; instead,
|
||||
;; construct args to ‘aa2u-ucs-bd-uniform-name’ by computing vertical and
|
||||
;; horizontal components separately.
|
||||
;;
|
||||
;; 2014-05-09 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u int] Don't use ‘cl-labels’ when ‘cl-flet*’ will do.
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el
|
||||
;; (aa2u-replacement): ...here.
|
||||
;;
|
||||
;; 2014-05-09 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u int] Add "Tip Jar" URL in Commentary; nfc.
|
||||
;;
|
||||
;; 2014-05-09 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u maint] Extract NEWS and HACKING to separate files; nfc.
|
||||
;;
|
||||
;; 2014-05-08 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u] Release: 1.6
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [Version]: Bump
|
||||
;; to "1.6".
|
||||
;;
|
||||
;; 2014-05-08 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u] Fix bug: Make ‘M-x aa2u’ operate on accessible portion.
|
||||
;;
|
||||
;; Regression introduced 2014-04-03, "Make ‘aa2u’ region-aware".
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el (aa2u): Take
|
||||
;; optional arg INTERACTIVE; add "p" to ‘interactive’ form; when
|
||||
;; INTERACTIVE and region is not active, set BEG, END.
|
||||
;;
|
||||
;; 2014-04-03 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u] Release: 1.5
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el [Version]: Bump
|
||||
;; to "1.5".
|
||||
;;
|
||||
;; 2014-04-03 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; [aa2u] Make ‘aa2u’ region-aware.
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el (aa2u): Take
|
||||
;; args BEG and END; use "r" in ‘interactive’ spec; don't bother w/
|
||||
;; internal func ‘do-it!’.
|
||||
;;
|
||||
;; 2014-01-14 Thien-Thi Nguyen <ttn@gnu.org>
|
||||
;;
|
||||
;; New package: ascii-art-to-unicode
|
||||
;;
|
||||
;; * packages/ascii-art-to-unicode/: New dir.
|
||||
;; * packages/ascii-art-to-unicode/ascii-art-to-unicode.el: New file.
|
||||
;;
|
||||
|
||||
|
||||
(provide 'ascii-art-to-unicode)
|
||||
|
||||
;;; ascii-art-to-unicode.el ends here
|
||||
@@ -1,131 +0,0 @@
|
||||
;;; async-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "async" "async.el" (22525 59329 588470 914000))
|
||||
;;; Generated autoloads from async.el
|
||||
|
||||
(autoload 'async-start-process "async" "\
|
||||
Start the executable PROGRAM asynchronously. See `async-start'.
|
||||
PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
|
||||
process object when done. If FINISH-FUNC is nil, the future
|
||||
object will return the process object when the program is
|
||||
finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
|
||||
working directory.
|
||||
|
||||
\(fn NAME PROGRAM FINISH-FUNC &rest PROGRAM-ARGS)" nil nil)
|
||||
|
||||
(autoload 'async-start "async" "\
|
||||
Execute START-FUNC (often a lambda) in a subordinate Emacs process.
|
||||
When done, the return value is passed to FINISH-FUNC. Example:
|
||||
|
||||
(async-start
|
||||
;; What to do in the child process
|
||||
(lambda ()
|
||||
(message \"This is a test\")
|
||||
(sleep-for 3)
|
||||
222)
|
||||
|
||||
;; What to do when it finishes
|
||||
(lambda (result)
|
||||
(message \"Async process done, result should be 222: %s\"
|
||||
result)))
|
||||
|
||||
If FINISH-FUNC is nil or missing, a future is returned that can
|
||||
be inspected using `async-get', blocking until the value is
|
||||
ready. Example:
|
||||
|
||||
(let ((proc (async-start
|
||||
;; What to do in the child process
|
||||
(lambda ()
|
||||
(message \"This is a test\")
|
||||
(sleep-for 3)
|
||||
222))))
|
||||
|
||||
(message \"I'm going to do some work here\") ;; ....
|
||||
|
||||
(message \"Waiting on async process, result should be 222: %s\"
|
||||
(async-get proc)))
|
||||
|
||||
If you don't want to use a callback, and you don't care about any
|
||||
return value from the child process, pass the `ignore' symbol as
|
||||
the second argument (if you don't, and never call `async-get', it
|
||||
will leave *emacs* process buffers hanging around):
|
||||
|
||||
(async-start
|
||||
(lambda ()
|
||||
(delete-file \"a remote file on a slow link\" nil))
|
||||
'ignore)
|
||||
|
||||
Note: Even when FINISH-FUNC is present, a future is still
|
||||
returned except that it yields no value (since the value is
|
||||
passed to FINISH-FUNC). Call `async-get' on such a future always
|
||||
returns nil. It can still be useful, however, as an argument to
|
||||
`async-ready' or `async-wait'.
|
||||
|
||||
\(fn START-FUNC &optional FINISH-FUNC)" nil nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "async-bytecomp" "async-bytecomp.el" (22525
|
||||
;;;;;; 59329 584470 885000))
|
||||
;;; Generated autoloads from async-bytecomp.el
|
||||
|
||||
(autoload 'async-byte-recompile-directory "async-bytecomp" "\
|
||||
Compile all *.el files in DIRECTORY asynchronously.
|
||||
All *.elc files are systematically deleted before proceeding.
|
||||
|
||||
\(fn DIRECTORY &optional QUIET)" nil nil)
|
||||
|
||||
(defvar async-bytecomp-package-mode nil "\
|
||||
Non-nil if Async-Bytecomp-Package mode is enabled.
|
||||
See the `async-bytecomp-package-mode' command
|
||||
for a description of this minor mode.
|
||||
Setting this variable directly does not take effect;
|
||||
either customize it (see the info node `Easy Customization')
|
||||
or call the function `async-bytecomp-package-mode'.")
|
||||
|
||||
(custom-autoload 'async-bytecomp-package-mode "async-bytecomp" nil)
|
||||
|
||||
(autoload 'async-bytecomp-package-mode "async-bytecomp" "\
|
||||
Byte compile asynchronously packages installed with package.el.
|
||||
Async compilation of packages can be controlled by
|
||||
`async-bytecomp-allowed-packages'.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "dired-async" "dired-async.el" (22525 59329
|
||||
;;;;;; 572470 801000))
|
||||
;;; Generated autoloads from dired-async.el
|
||||
|
||||
(defvar dired-async-mode nil "\
|
||||
Non-nil if Dired-Async mode is enabled.
|
||||
See the `dired-async-mode' command
|
||||
for a description of this minor mode.
|
||||
Setting this variable directly does not take effect;
|
||||
either customize it (see the info node `Easy Customization')
|
||||
or call the function `dired-async-mode'.")
|
||||
|
||||
(custom-autoload 'dired-async-mode "dired-async" nil)
|
||||
|
||||
(autoload 'dired-async-mode "dired-async" "\
|
||||
Do dired actions asynchronously.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("async-pkg.el" "smtpmail-async.el") (22525
|
||||
;;;;;; 59329 592470 942000))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; async-autoloads.el ends here
|
||||
@@ -1,177 +0,0 @@
|
||||
;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
|
||||
|
||||
;; Authors: John Wiegley <jwiegley@gmail.com>
|
||||
;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
|
||||
|
||||
;; Keywords: dired async byte-compile
|
||||
;; X-URL: https://github.com/jwiegley/dired-async
|
||||
|
||||
;; 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:
|
||||
;;
|
||||
;; This package provide the `async-byte-recompile-directory' function
|
||||
;; which allows, as the name says to recompile a directory outside of
|
||||
;; your running emacs.
|
||||
;; The benefit is your files will be compiled in a clean environment without
|
||||
;; the old *.el files loaded.
|
||||
;; Among other things, this fix a bug in package.el which recompile
|
||||
;; the new files in the current environment with the old files loaded, creating
|
||||
;; errors in most packages after upgrades.
|
||||
;;
|
||||
;; NB: This package is advicing the function `package--compile'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'async)
|
||||
|
||||
(defcustom async-bytecomp-allowed-packages
|
||||
'(async helm helm-core helm-ls-git helm-ls-hg magit)
|
||||
"Packages in this list will be compiled asynchronously by `package--compile'.
|
||||
All the dependencies of these packages will be compiled async too,
|
||||
so no need to add dependencies to this list.
|
||||
The value of this variable can also be a list with a single element,
|
||||
the symbol `all', in this case packages are always compiled asynchronously."
|
||||
:group 'async
|
||||
:type '(repeat (choice symbol)))
|
||||
|
||||
(defvar async-byte-compile-log-file "~/.emacs.d/async-bytecomp.log")
|
||||
|
||||
;;;###autoload
|
||||
(defun async-byte-recompile-directory (directory &optional quiet)
|
||||
"Compile all *.el files in DIRECTORY asynchronously.
|
||||
All *.elc files are systematically deleted before proceeding."
|
||||
(cl-loop with dir = (directory-files directory t "\\.elc\\'")
|
||||
unless dir return nil
|
||||
for f in dir
|
||||
when (file-exists-p f) do (delete-file f))
|
||||
;; Ensure async is reloaded when async.elc is deleted.
|
||||
;; This happen when recompiling its own directory.
|
||||
(load "async")
|
||||
(let ((call-back
|
||||
(lambda (&optional _ignore)
|
||||
(if (file-exists-p async-byte-compile-log-file)
|
||||
(let ((buf (get-buffer-create byte-compile-log-buffer))
|
||||
(n 0))
|
||||
(with-current-buffer buf
|
||||
(goto-char (point-max))
|
||||
(let ((inhibit-read-only t))
|
||||
(insert-file-contents async-byte-compile-log-file)
|
||||
(compilation-mode))
|
||||
(display-buffer buf)
|
||||
(delete-file async-byte-compile-log-file)
|
||||
(unless quiet
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^.*:Error:" nil t)
|
||||
(cl-incf n)))
|
||||
(if (> n 0)
|
||||
(message "Failed to compile %d files in directory `%s'" n directory)
|
||||
(message "Directory `%s' compiled asynchronously with warnings" directory)))))
|
||||
(unless quiet
|
||||
(message "Directory `%s' compiled asynchronously with success" directory))))))
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(require 'bytecomp)
|
||||
,(async-inject-variables "\\`\\(load-path\\)\\|byte\\'")
|
||||
(let ((default-directory (file-name-as-directory ,directory))
|
||||
error-data)
|
||||
(add-to-list 'load-path default-directory)
|
||||
(byte-recompile-directory ,directory 0 t)
|
||||
(when (get-buffer byte-compile-log-buffer)
|
||||
(setq error-data (with-current-buffer byte-compile-log-buffer
|
||||
(buffer-substring-no-properties (point-min) (point-max))))
|
||||
(unless (string= error-data "")
|
||||
(with-temp-file ,async-byte-compile-log-file
|
||||
(erase-buffer)
|
||||
(insert error-data))))))
|
||||
call-back)
|
||||
(unless quiet (message "Started compiling asynchronously directory %s" directory))))
|
||||
|
||||
(defvar package-archive-contents)
|
||||
(defvar package-alist)
|
||||
(declare-function package-desc-reqs "package.el" (cl-x))
|
||||
|
||||
(defun async-bytecomp--get-package-deps (pkg &optional only)
|
||||
;; Same as `package--get-deps' but parse instead `package-archive-contents'
|
||||
;; because PKG is not already installed and not present in `package-alist'.
|
||||
;; However fallback to `package-alist' in case PKG no more present
|
||||
;; in `package-archive-contents' due to modification to `package-archives'.
|
||||
;; See issue #58.
|
||||
(let* ((pkg-desc (cadr (or (assq pkg package-archive-contents)
|
||||
(assq pkg package-alist))))
|
||||
(direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
|
||||
for name = (car p)
|
||||
when (or (assq name package-archive-contents)
|
||||
(assq name package-alist))
|
||||
collect name))
|
||||
(indirect-deps (unless (eq only 'direct)
|
||||
(delete-dups
|
||||
(cl-loop for p in direct-deps append
|
||||
(async-bytecomp--get-package-deps p))))))
|
||||
(cl-case only
|
||||
(direct direct-deps)
|
||||
(separate (list direct-deps indirect-deps))
|
||||
(indirect indirect-deps)
|
||||
(t (delete-dups (append direct-deps indirect-deps))))))
|
||||
|
||||
(defun async-bytecomp-get-allowed-pkgs ()
|
||||
(when (and async-bytecomp-allowed-packages
|
||||
(listp async-bytecomp-allowed-packages))
|
||||
(if package-archive-contents
|
||||
(cl-loop for p in async-bytecomp-allowed-packages
|
||||
when (assq p package-archive-contents)
|
||||
append (async-bytecomp--get-package-deps p) into reqs
|
||||
finally return
|
||||
(delete-dups
|
||||
(append async-bytecomp-allowed-packages reqs)))
|
||||
async-bytecomp-allowed-packages)))
|
||||
|
||||
(defadvice package--compile (around byte-compile-async)
|
||||
(let ((cur-package (package-desc-name pkg-desc))
|
||||
(pkg-dir (package-desc-dir pkg-desc)))
|
||||
(if (or (equal async-bytecomp-allowed-packages '(all))
|
||||
(memq cur-package (async-bytecomp-get-allowed-pkgs)))
|
||||
(progn
|
||||
(when (eq cur-package 'async)
|
||||
(fmakunbound 'async-byte-recompile-directory))
|
||||
;; Add to `load-path' the latest version of async and
|
||||
;; reload it when reinstalling async.
|
||||
(when (string= cur-package "async")
|
||||
(cl-pushnew pkg-dir load-path)
|
||||
(load "async-bytecomp"))
|
||||
;; `async-byte-recompile-directory' will add directory
|
||||
;; as needed to `load-path'.
|
||||
(async-byte-recompile-directory (package-desc-dir pkg-desc) t))
|
||||
ad-do-it)))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode async-bytecomp-package-mode
|
||||
"Byte compile asynchronously packages installed with package.el.
|
||||
Async compilation of packages can be controlled by
|
||||
`async-bytecomp-allowed-packages'."
|
||||
:group 'async
|
||||
:global t
|
||||
(if async-bytecomp-package-mode
|
||||
(ad-activate 'package--compile)
|
||||
(ad-deactivate 'package--compile)))
|
||||
|
||||
(provide 'async-bytecomp)
|
||||
|
||||
;;; async-bytecomp.el ends here
|
||||
@@ -1,6 +0,0 @@
|
||||
(define-package "async" "20161010.2322" "Asynchronous processing in Emacs" 'nil :keywords
|
||||
'("async")
|
||||
:url "https://github.com/jwiegley/emacs-async")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
@@ -1,303 +0,0 @@
|
||||
;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: John Wiegley <jwiegley@gmail.com>
|
||||
;; Created: 18 Jun 2012
|
||||
;; Version: 1.9
|
||||
|
||||
;; Keywords: async
|
||||
;; X-URL: https://github.com/jwiegley/emacs-async
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Adds the ability to call asynchronous functions and process with ease. See
|
||||
;; the documentation for `async-start' and `async-start-process'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defgroup async nil
|
||||
"Simple asynchronous processing in Emacs"
|
||||
:group 'emacs)
|
||||
|
||||
(defvar async-debug nil)
|
||||
(defvar async-send-over-pipe t)
|
||||
(defvar async-in-child-emacs nil)
|
||||
(defvar async-callback nil)
|
||||
(defvar async-callback-for-process nil)
|
||||
(defvar async-callback-value nil)
|
||||
(defvar async-callback-value-set nil)
|
||||
(defvar async-current-process nil)
|
||||
(defvar async--procvar nil)
|
||||
|
||||
(defun async-inject-variables
|
||||
(include-regexp &optional predicate exclude-regexp)
|
||||
"Return a `setq' form that replicates part of the calling environment.
|
||||
It sets the value for every variable matching INCLUDE-REGEXP and
|
||||
also PREDICATE. It will not perform injection for any variable
|
||||
matching EXCLUDE-REGEXP (if present). It is intended to be used
|
||||
as follows:
|
||||
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(require 'smtpmail)
|
||||
(with-temp-buffer
|
||||
(insert ,(buffer-substring-no-properties (point-min) (point-max)))
|
||||
;; Pass in the variable environment for smtpmail
|
||||
,(async-inject-variables \"\\`\\(smtpmail\\|\\(user-\\)?mail\\)-\")
|
||||
(smtpmail-send-it)))
|
||||
'ignore)"
|
||||
`(setq
|
||||
,@(let (bindings)
|
||||
(mapatoms
|
||||
(lambda (sym)
|
||||
(if (and (boundp sym)
|
||||
(or (null include-regexp)
|
||||
(string-match include-regexp (symbol-name sym)))
|
||||
(not (string-match
|
||||
(or exclude-regexp "-syntax-table\\'")
|
||||
(symbol-name sym))))
|
||||
(let ((value (symbol-value sym)))
|
||||
(when (or (null predicate)
|
||||
(funcall predicate sym))
|
||||
(setq bindings (cons `(quote ,value) bindings)
|
||||
bindings (cons sym bindings)))))))
|
||||
bindings)))
|
||||
|
||||
(defalias 'async-inject-environment 'async-inject-variables)
|
||||
|
||||
(defun async-handle-result (func result buf)
|
||||
(if (null func)
|
||||
(progn
|
||||
(set (make-local-variable 'async-callback-value) result)
|
||||
(set (make-local-variable 'async-callback-value-set) t))
|
||||
(unwind-protect
|
||||
(if (and (listp result)
|
||||
(eq 'async-signal (nth 0 result)))
|
||||
(signal (car (nth 1 result))
|
||||
(cdr (nth 1 result)))
|
||||
(funcall func result))
|
||||
(unless async-debug
|
||||
(kill-buffer buf)))))
|
||||
|
||||
(defun async-when-done (proc &optional _change)
|
||||
"Process sentinel used to retrieve the value from the child process."
|
||||
(when (eq 'exit (process-status proc))
|
||||
(with-current-buffer (process-buffer proc)
|
||||
(let ((async-current-process proc))
|
||||
(if (= 0 (process-exit-status proc))
|
||||
(if async-callback-for-process
|
||||
(if async-callback
|
||||
(prog1
|
||||
(funcall async-callback proc)
|
||||
(unless async-debug
|
||||
(kill-buffer (current-buffer))))
|
||||
(set (make-local-variable 'async-callback-value) proc)
|
||||
(set (make-local-variable 'async-callback-value-set) t))
|
||||
(goto-char (point-max))
|
||||
(backward-sexp)
|
||||
(async-handle-result async-callback (read (current-buffer))
|
||||
(current-buffer)))
|
||||
(set (make-local-variable 'async-callback-value)
|
||||
(list 'error
|
||||
(format "Async process '%s' failed with exit code %d"
|
||||
(process-name proc) (process-exit-status proc))))
|
||||
(set (make-local-variable 'async-callback-value-set) t))))))
|
||||
|
||||
(defun async--receive-sexp (&optional stream)
|
||||
(let ((sexp (decode-coding-string (base64-decode-string
|
||||
(read stream)) 'utf-8-unix))
|
||||
;; Parent expects UTF-8 encoded text.
|
||||
(coding-system-for-write 'utf-8-unix))
|
||||
(if async-debug
|
||||
(message "Received sexp {{{%s}}}" (pp-to-string sexp)))
|
||||
(setq sexp (read sexp))
|
||||
(if async-debug
|
||||
(message "Read sexp {{{%s}}}" (pp-to-string sexp)))
|
||||
(eval sexp)))
|
||||
|
||||
(defun async--insert-sexp (sexp)
|
||||
(let (print-level
|
||||
print-length
|
||||
(print-escape-nonascii t)
|
||||
(print-circle t))
|
||||
(prin1 sexp (current-buffer))
|
||||
;; Just in case the string we're sending might contain EOF
|
||||
(encode-coding-region (point-min) (point-max) 'utf-8-unix)
|
||||
(base64-encode-region (point-min) (point-max) t)
|
||||
(goto-char (point-min)) (insert ?\")
|
||||
(goto-char (point-max)) (insert ?\" ?\n)))
|
||||
|
||||
(defun async--transmit-sexp (process sexp)
|
||||
(with-temp-buffer
|
||||
(if async-debug
|
||||
(message "Transmitting sexp {{{%s}}}" (pp-to-string sexp)))
|
||||
(async--insert-sexp sexp)
|
||||
(process-send-region process (point-min) (point-max))))
|
||||
|
||||
(defun async-batch-invoke ()
|
||||
"Called from the child Emacs process' command-line."
|
||||
;; Make sure 'message' and 'prin1' encode stuff in UTF-8, as parent
|
||||
;; process expects.
|
||||
(let ((coding-system-for-write 'utf-8-unix))
|
||||
(setq async-in-child-emacs t
|
||||
debug-on-error async-debug)
|
||||
(if debug-on-error
|
||||
(prin1 (funcall
|
||||
(async--receive-sexp (unless async-send-over-pipe
|
||||
command-line-args-left))))
|
||||
(condition-case err
|
||||
(prin1 (funcall
|
||||
(async--receive-sexp (unless async-send-over-pipe
|
||||
command-line-args-left))))
|
||||
(error
|
||||
(prin1 (list 'async-signal err)))))))
|
||||
|
||||
(defun async-ready (future)
|
||||
"Query a FUTURE to see if the ready is ready -- i.e., if no blocking
|
||||
would result from a call to `async-get' on that FUTURE."
|
||||
(and (memq (process-status future) '(exit signal))
|
||||
(with-current-buffer (process-buffer future)
|
||||
async-callback-value-set)))
|
||||
|
||||
(defun async-wait (future)
|
||||
"Wait for FUTURE to become ready."
|
||||
(while (not (async-ready future))
|
||||
(sit-for 0.05)))
|
||||
|
||||
(defun async-get (future)
|
||||
"Get the value from an asynchronously function when it is ready.
|
||||
FUTURE is returned by `async-start' or `async-start-process' when
|
||||
its FINISH-FUNC is nil."
|
||||
(async-wait future)
|
||||
(with-current-buffer (process-buffer future)
|
||||
(async-handle-result #'identity async-callback-value (current-buffer))))
|
||||
|
||||
(defun async-message-p (value)
|
||||
"Return true of VALUE is an async.el message packet."
|
||||
(and (listp value)
|
||||
(plist-get value :async-message)))
|
||||
|
||||
(defun async-send (&rest args)
|
||||
"Send the given messages to the asychronous Emacs PROCESS."
|
||||
(let ((args (append args '(:async-message t))))
|
||||
(if async-in-child-emacs
|
||||
(if async-callback
|
||||
(funcall async-callback args))
|
||||
(async--transmit-sexp (car args) (list 'quote (cdr args))))))
|
||||
|
||||
(defun async-receive ()
|
||||
"Send the given messages to the asychronous Emacs PROCESS."
|
||||
(async--receive-sexp))
|
||||
|
||||
;;;###autoload
|
||||
(defun async-start-process (name program finish-func &rest program-args)
|
||||
"Start the executable PROGRAM asynchronously. See `async-start'.
|
||||
PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
|
||||
process object when done. If FINISH-FUNC is nil, the future
|
||||
object will return the process object when the program is
|
||||
finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
|
||||
working directory."
|
||||
(let* ((buf (generate-new-buffer (concat "*" name "*")))
|
||||
(proc (let ((process-connection-type nil))
|
||||
(apply #'start-process name buf program program-args))))
|
||||
(with-current-buffer buf
|
||||
(set (make-local-variable 'async-callback) finish-func)
|
||||
(set-process-sentinel proc #'async-when-done)
|
||||
(unless (string= name "emacs")
|
||||
(set (make-local-variable 'async-callback-for-process) t))
|
||||
proc)))
|
||||
|
||||
;;;###autoload
|
||||
(defun async-start (start-func &optional finish-func)
|
||||
"Execute START-FUNC (often a lambda) in a subordinate Emacs process.
|
||||
When done, the return value is passed to FINISH-FUNC. Example:
|
||||
|
||||
(async-start
|
||||
;; What to do in the child process
|
||||
(lambda ()
|
||||
(message \"This is a test\")
|
||||
(sleep-for 3)
|
||||
222)
|
||||
|
||||
;; What to do when it finishes
|
||||
(lambda (result)
|
||||
(message \"Async process done, result should be 222: %s\"
|
||||
result)))
|
||||
|
||||
If FINISH-FUNC is nil or missing, a future is returned that can
|
||||
be inspected using `async-get', blocking until the value is
|
||||
ready. Example:
|
||||
|
||||
(let ((proc (async-start
|
||||
;; What to do in the child process
|
||||
(lambda ()
|
||||
(message \"This is a test\")
|
||||
(sleep-for 3)
|
||||
222))))
|
||||
|
||||
(message \"I'm going to do some work here\") ;; ....
|
||||
|
||||
(message \"Waiting on async process, result should be 222: %s\"
|
||||
(async-get proc)))
|
||||
|
||||
If you don't want to use a callback, and you don't care about any
|
||||
return value from the child process, pass the `ignore' symbol as
|
||||
the second argument (if you don't, and never call `async-get', it
|
||||
will leave *emacs* process buffers hanging around):
|
||||
|
||||
(async-start
|
||||
(lambda ()
|
||||
(delete-file \"a remote file on a slow link\" nil))
|
||||
'ignore)
|
||||
|
||||
Note: Even when FINISH-FUNC is present, a future is still
|
||||
returned except that it yields no value (since the value is
|
||||
passed to FINISH-FUNC). Call `async-get' on such a future always
|
||||
returns nil. It can still be useful, however, as an argument to
|
||||
`async-ready' or `async-wait'."
|
||||
(let ((sexp start-func)
|
||||
;; Subordinate Emacs will send text encoded in UTF-8.
|
||||
(coding-system-for-read 'utf-8-unix))
|
||||
(setq async--procvar
|
||||
(async-start-process
|
||||
"emacs" (file-truename
|
||||
(expand-file-name invocation-name
|
||||
invocation-directory))
|
||||
finish-func
|
||||
"-Q" "-l"
|
||||
;; Using `locate-library' ensure we use the right file
|
||||
;; when the .elc have been deleted.
|
||||
(locate-library "async")
|
||||
"-batch" "-f" "async-batch-invoke"
|
||||
(if async-send-over-pipe
|
||||
"<none>"
|
||||
(with-temp-buffer
|
||||
(async--insert-sexp (list 'quote sexp))
|
||||
(buffer-string)))))
|
||||
(if async-send-over-pipe
|
||||
(async--transmit-sexp async--procvar (list 'quote sexp)))
|
||||
async--procvar))
|
||||
|
||||
(defmacro async-sandbox(func)
|
||||
"Evaluate FUNC in a separate Emacs process, synchronously."
|
||||
`(async-get (async-start ,func)))
|
||||
|
||||
(provide 'async)
|
||||
|
||||
;;; async.el ends here
|
||||
@@ -1,333 +0,0 @@
|
||||
;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
|
||||
|
||||
;; Authors: John Wiegley <jwiegley@gmail.com>
|
||||
;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
|
||||
|
||||
;; Keywords: dired async network
|
||||
;; X-URL: https://github.com/jwiegley/dired-async
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This file provide a redefinition of `dired-create-file' function,
|
||||
;; performs copies, moves and all what is handled by `dired-create-file'
|
||||
;; in the background using a slave Emacs process,
|
||||
;; by means of the async.el module.
|
||||
;; To use it, put this in your .emacs:
|
||||
|
||||
;; (dired-async-mode 1)
|
||||
|
||||
;; This will enable async copy/rename etc...
|
||||
;; in dired and helm.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'dired-aux)
|
||||
(require 'async)
|
||||
|
||||
(eval-when-compile
|
||||
(defvar async-callback))
|
||||
|
||||
(defgroup dired-async nil
|
||||
"Copy rename files asynchronously from dired."
|
||||
:group 'dired)
|
||||
|
||||
(defcustom dired-async-env-variables-regexp
|
||||
"\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*"
|
||||
"Variables matching this regexp will be loaded on Child Emacs."
|
||||
:type 'regexp
|
||||
:group 'dired-async)
|
||||
|
||||
(defcustom dired-async-message-function 'dired-async-mode-line-message
|
||||
"Function to use to notify result when operation finish.
|
||||
Should take same args as `message'."
|
||||
:group 'dired-async
|
||||
:type 'function)
|
||||
|
||||
(defcustom dired-async-log-file "/tmp/dired-async.log"
|
||||
"File use to communicate errors from Child Emacs to host Emacs."
|
||||
:group 'dired-async
|
||||
:type 'string)
|
||||
|
||||
(defface dired-async-message
|
||||
'((t (:foreground "yellow")))
|
||||
"Face used for mode-line message."
|
||||
:group 'dired-async)
|
||||
|
||||
(defface dired-async-failures
|
||||
'((t (:foreground "red")))
|
||||
"Face used for mode-line message."
|
||||
:group 'dired-async)
|
||||
|
||||
(defface dired-async-mode-message
|
||||
'((t (:foreground "Gold")))
|
||||
"Face used for `dired-async--modeline-mode' lighter."
|
||||
:group 'dired-async)
|
||||
|
||||
(define-minor-mode dired-async--modeline-mode
|
||||
"Notify mode-line that an async process run."
|
||||
:group 'dired-async
|
||||
:global t
|
||||
:lighter (:eval (propertize (format " [%s Async job(s) running]"
|
||||
(length (dired-async-processes)))
|
||||
'face 'dired-async-mode-message))
|
||||
(unless dired-async--modeline-mode
|
||||
(let ((visible-bell t)) (ding))))
|
||||
|
||||
(defun dired-async-mode-line-message (text face &rest args)
|
||||
"Notify end of operation in `mode-line'."
|
||||
(message nil)
|
||||
(let ((mode-line-format (concat
|
||||
" " (propertize
|
||||
(if args
|
||||
(apply #'format text args)
|
||||
text)
|
||||
'face face))))
|
||||
(force-mode-line-update)
|
||||
(sit-for 3)
|
||||
(force-mode-line-update)))
|
||||
|
||||
(defun dired-async-processes ()
|
||||
(cl-loop for p in (process-list)
|
||||
when (cl-loop for c in (process-command p) thereis
|
||||
(string= "async-batch-invoke" c))
|
||||
collect p))
|
||||
|
||||
(defun dired-async-kill-process ()
|
||||
(interactive)
|
||||
(let* ((processes (dired-async-processes))
|
||||
(proc (car (last processes))))
|
||||
(and proc (delete-process proc))
|
||||
(unless (> (length processes) 1)
|
||||
(dired-async--modeline-mode -1))))
|
||||
|
||||
(defun dired-async-after-file-create (total operation failures skipped)
|
||||
"Callback function used for operation handled by `dired-create-file'."
|
||||
(unless (dired-async-processes)
|
||||
;; Turn off mode-line notification
|
||||
;; only when last process end.
|
||||
(dired-async--modeline-mode -1))
|
||||
(when operation
|
||||
(if (file-exists-p dired-async-log-file)
|
||||
(progn
|
||||
(pop-to-buffer (get-buffer-create dired-log-buffer))
|
||||
(goto-char (point-max))
|
||||
(setq inhibit-read-only t)
|
||||
(insert "Error: ")
|
||||
(insert-file-contents dired-async-log-file)
|
||||
(special-mode)
|
||||
(shrink-window-if-larger-than-buffer)
|
||||
(delete-file dired-async-log-file))
|
||||
(run-with-timer
|
||||
0.1 nil
|
||||
(lambda ()
|
||||
;; First send error messages.
|
||||
(cond (failures
|
||||
(funcall dired-async-message-function
|
||||
"%s failed for %d of %d file%s -- See *Dired log* buffer"
|
||||
'dired-async-failures
|
||||
(car operation) (length failures)
|
||||
total (dired-plural-s total)))
|
||||
(skipped
|
||||
(funcall dired-async-message-function
|
||||
"%s: %d of %d file%s skipped -- See *Dired log* buffer"
|
||||
'dired-async-failures
|
||||
(car operation) (length skipped) total
|
||||
(dired-plural-s total))))
|
||||
;; Finally send the success message.
|
||||
(funcall dired-async-message-function
|
||||
"Asynchronous %s of %s on %s file%s done"
|
||||
'dired-async-message
|
||||
(car operation) (cadr operation)
|
||||
total (dired-plural-s total)))))))
|
||||
|
||||
(defun dired-async-maybe-kill-ftp ()
|
||||
"Return a form to kill ftp process in child emacs."
|
||||
(quote
|
||||
(progn
|
||||
(require 'cl-lib)
|
||||
(let ((buf (cl-loop for b in (buffer-list)
|
||||
thereis (and (string-match
|
||||
"\\`\\*ftp.*"
|
||||
(buffer-name b)) b))))
|
||||
(when buf (kill-buffer buf))))))
|
||||
|
||||
(defvar overwrite-query)
|
||||
(defun dired-async-create-files (file-creator operation fn-list name-constructor
|
||||
&optional _marker-char)
|
||||
"Same as `dired-create-files' but asynchronous.
|
||||
|
||||
See `dired-create-files' for the behavior of arguments."
|
||||
(setq overwrite-query nil)
|
||||
(let ((total (length fn-list))
|
||||
failures async-fn-list skipped callback)
|
||||
(let (to)
|
||||
(dolist (from fn-list)
|
||||
(setq to (funcall name-constructor from))
|
||||
(if (equal to from)
|
||||
(progn
|
||||
(setq to nil)
|
||||
(dired-log "Cannot %s to same file: %s\n"
|
||||
(downcase operation) from)))
|
||||
(if (not to)
|
||||
(setq skipped (cons (dired-make-relative from) skipped))
|
||||
(let* ((overwrite (and (null (eq file-creator 'backup-file))
|
||||
(file-exists-p to)))
|
||||
(dired-overwrite-confirmed ; for dired-handle-overwrite
|
||||
(and overwrite
|
||||
(let ((help-form `(format "\
|
||||
Type SPC or `y' to overwrite file `%s',
|
||||
DEL or `n' to skip to next,
|
||||
ESC or `q' to not overwrite any of the remaining files,
|
||||
`!' to overwrite all remaining files with no more questions." ,to)))
|
||||
(dired-query 'overwrite-query "Overwrite `%s'?" to)))))
|
||||
;; Handle the `dired-copy-file' file-creator specially
|
||||
;; When copying a directory to another directory or
|
||||
;; possibly to itself or one of its subdirectories.
|
||||
;; e.g "~/foo/" => "~/test/"
|
||||
;; or "~/foo/" =>"~/foo/"
|
||||
;; or "~/foo/ => ~/foo/bar/")
|
||||
;; In this case the 'name-constructor' have set the destination
|
||||
;; TO to "~/test/foo" because the old emacs23 behavior
|
||||
;; of `copy-directory' was to not create the subdirectory
|
||||
;; and instead copy the contents.
|
||||
;; With the new behavior of `copy-directory'
|
||||
;; (similar to the `cp' shell command) we don't
|
||||
;; need such a construction of the target directory,
|
||||
;; so modify the destination TO to "~/test/" instead of "~/test/foo/".
|
||||
(let ((destname (file-name-directory to)))
|
||||
(when (and (file-directory-p from)
|
||||
(file-directory-p to)
|
||||
(eq file-creator 'dired-copy-file))
|
||||
(setq to destname))
|
||||
;; If DESTNAME is a subdirectory of FROM, not a symlink,
|
||||
;; and the method in use is copying, signal an error.
|
||||
(and (eq t (car (file-attributes destname)))
|
||||
(eq file-creator 'dired-copy-file)
|
||||
(file-in-directory-p destname from)
|
||||
(error "Cannot copy `%s' into its subdirectory `%s'"
|
||||
from to)))
|
||||
(if overwrite
|
||||
(or (and dired-overwrite-confirmed
|
||||
(push (cons from to) async-fn-list))
|
||||
(progn
|
||||
(push (dired-make-relative from) failures)
|
||||
(dired-log "%s `%s' to `%s' failed\n"
|
||||
operation from to)))
|
||||
(push (cons from to) async-fn-list)))))
|
||||
;; When failures have been printed to dired log add the date at bob.
|
||||
(when (or failures skipped) (dired-log t))
|
||||
;; When async-fn-list is empty that's mean only one file
|
||||
;; had to be copied and user finally answer NO.
|
||||
;; In this case async process will never start and callback
|
||||
;; will have no chance to run, so notify failures here.
|
||||
(unless async-fn-list
|
||||
(cond (failures
|
||||
(funcall dired-async-message-function
|
||||
"%s failed for %d of %d file%s -- See *Dired log* buffer"
|
||||
'dired-async-failures
|
||||
operation (length failures)
|
||||
total (dired-plural-s total)))
|
||||
(skipped
|
||||
(funcall dired-async-message-function
|
||||
"%s: %d of %d file%s skipped -- See *Dired log* buffer"
|
||||
'dired-async-failures
|
||||
operation (length skipped) total
|
||||
(dired-plural-s total)))))
|
||||
;; Setup callback.
|
||||
(setq callback
|
||||
(lambda (&optional _ignore)
|
||||
(dired-async-after-file-create
|
||||
total (list operation (length async-fn-list)) failures skipped)
|
||||
(when (string= (downcase operation) "rename")
|
||||
(cl-loop for (file . to) in async-fn-list
|
||||
for bf = (get-file-buffer file)
|
||||
for destp = (file-exists-p to)
|
||||
do (and bf destp
|
||||
(with-current-buffer bf
|
||||
(set-visited-file-name to t t))))))))
|
||||
;; Start async process.
|
||||
(when async-fn-list
|
||||
(async-start `(lambda ()
|
||||
(require 'cl-lib) (require 'dired-aux) (require 'dired-x)
|
||||
,(async-inject-variables dired-async-env-variables-regexp)
|
||||
(let ((dired-recursive-copies (quote always))
|
||||
(dired-copy-preserve-time
|
||||
,dired-copy-preserve-time))
|
||||
(setq overwrite-backup-query nil)
|
||||
;; Inline `backup-file' as long as it is not
|
||||
;; available in emacs.
|
||||
(defalias 'backup-file
|
||||
;; Same feature as "cp --backup=numbered from to"
|
||||
;; Symlinks are copied as file from source unlike
|
||||
;; `dired-copy-file' which is same as cp -d.
|
||||
;; Directories are omitted.
|
||||
(lambda (from to ok)
|
||||
(cond ((file-directory-p from) (ignore))
|
||||
(t (let ((count 0))
|
||||
(while (let ((attrs (file-attributes to)))
|
||||
(and attrs (null (nth 0 attrs))))
|
||||
(cl-incf count)
|
||||
(setq to (concat (file-name-sans-versions to)
|
||||
(format ".~%s~" count)))))
|
||||
(condition-case err
|
||||
(copy-file from to ok dired-copy-preserve-time)
|
||||
(file-date-error
|
||||
(dired-log "Can't set date on %s:\n%s\n" from err)))))))
|
||||
;; Now run the FILE-CREATOR function on files.
|
||||
(cl-loop with fn = (quote ,file-creator)
|
||||
for (from . dest) in (quote ,async-fn-list)
|
||||
do (condition-case err
|
||||
(funcall fn from dest t)
|
||||
(file-error
|
||||
(dired-log "%s: %s\n" (car err) (cdr err)))
|
||||
nil))
|
||||
(when (get-buffer dired-log-buffer)
|
||||
(dired-log t)
|
||||
(with-current-buffer dired-log-buffer
|
||||
(write-region (point-min) (point-max)
|
||||
,dired-async-log-file))))
|
||||
,(dired-async-maybe-kill-ftp))
|
||||
callback)
|
||||
;; Run mode-line notifications while process running.
|
||||
(dired-async--modeline-mode 1)
|
||||
(message "%s proceeding asynchronously..." operation))))
|
||||
|
||||
(defadvice dired-create-files (around dired-async)
|
||||
(dired-async-create-files file-creator operation fn-list
|
||||
name-constructor marker-char))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode dired-async-mode
|
||||
"Do dired actions asynchronously."
|
||||
:group 'dired-async
|
||||
:global t
|
||||
(if dired-async-mode
|
||||
(if (fboundp 'advice-add)
|
||||
(advice-add 'dired-create-files :override #'dired-async-create-files)
|
||||
(ad-activate 'dired-create-files))
|
||||
(if (fboundp 'advice-remove)
|
||||
(advice-remove 'dired-create-files #'dired-async-create-files)
|
||||
(ad-deactivate 'dired-create-files))))
|
||||
|
||||
|
||||
(provide 'dired-async)
|
||||
|
||||
;;; dired-async.el ends here
|
||||
@@ -1,73 +0,0 @@
|
||||
;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: John Wiegley <jwiegley@gmail.com>
|
||||
;; Created: 18 Jun 2012
|
||||
|
||||
;; Keywords: email async
|
||||
;; X-URL: https://github.com/jwiegley/emacs-async
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Send e-mail with smtpmail.el asynchronously. To use:
|
||||
;;
|
||||
;; (require 'smtpmail-async)
|
||||
;;
|
||||
;; (setq send-mail-function 'async-smtpmail-send-it
|
||||
;; message-send-mail-function 'async-smtpmail-send-it)
|
||||
;;
|
||||
;; This assumes you already have smtpmail.el working.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defgroup smtpmail-async nil
|
||||
"Send e-mail with smtpmail.el asynchronously"
|
||||
:group 'smptmail)
|
||||
|
||||
(require 'async)
|
||||
(require 'smtpmail)
|
||||
(require 'message)
|
||||
|
||||
(defvar async-smtpmail-before-send-hook nil
|
||||
"Hook running in the child emacs in `async-smtpmail-send-it'.
|
||||
It is called just before calling `smtpmail-send-it'.")
|
||||
|
||||
(defun async-smtpmail-send-it ()
|
||||
(let ((to (message-field-value "To"))
|
||||
(buf-content (buffer-substring-no-properties
|
||||
(point-min) (point-max))))
|
||||
(message "Delivering message to %s..." to)
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(require 'smtpmail)
|
||||
(with-temp-buffer
|
||||
(insert ,buf-content)
|
||||
(set-buffer-multibyte nil)
|
||||
;; Pass in the variable environment for smtpmail
|
||||
,(async-inject-variables
|
||||
"\\`\\(smtpmail\\|async-smtpmail\\|\\(user-\\)?mail\\)-\\|auth-sources\\|epg"
|
||||
nil "\\`\\(mail-header-format-function\\|smtpmail-address-buffer\\|mail-mode-abbrev-table\\)")
|
||||
(run-hooks 'async-smtpmail-before-send-hook)
|
||||
(smtpmail-send-it)))
|
||||
(lambda (&optional _ignore)
|
||||
(message "Delivering message to %s...done" to)))))
|
||||
|
||||
(provide 'smtpmail-async)
|
||||
|
||||
;;; smtpmail-async.el ends here
|
||||
@@ -1,218 +0,0 @@
|
||||
;;; avy-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "avy" "avy.el" (22527 12801 314759 26000))
|
||||
;;; Generated autoloads from avy.el
|
||||
|
||||
(autoload 'avy-goto-char "avy" "\
|
||||
Jump to the currently visible CHAR.
|
||||
The window scope is determined by `avy-all-windows' (ARG negates it).
|
||||
|
||||
\(fn CHAR &optional ARG)" t nil)
|
||||
|
||||
(autoload 'avy-goto-char-in-line "avy" "\
|
||||
Jump to the currently visible CHAR in the current line.
|
||||
|
||||
\(fn CHAR)" t nil)
|
||||
|
||||
(autoload 'avy-goto-char-2 "avy" "\
|
||||
Jump to the currently visible CHAR1 followed by CHAR2.
|
||||
The window scope is determined by `avy-all-windows' (ARG negates it).
|
||||
|
||||
\(fn CHAR1 CHAR2 &optional ARG BEG END)" t nil)
|
||||
|
||||
(autoload 'avy-goto-char-2-above "avy" "\
|
||||
Jump to the currently visible CHAR1 followed by CHAR2.
|
||||
This is a scoped version of `avy-goto-char-2', where the scope is
|
||||
the visible part of the current buffer up to point.
|
||||
|
||||
\(fn CHAR1 CHAR2 &optional ARG)" t nil)
|
||||
|
||||
(autoload 'avy-goto-char-2-below "avy" "\
|
||||
Jump to the currently visible CHAR1 followed by CHAR2.
|
||||
This is a scoped version of `avy-goto-char-2', where the scope is
|
||||
the visible part of the current buffer following point.
|
||||
|
||||
\(fn CHAR1 CHAR2 &optional ARG)" t nil)
|
||||
|
||||
(autoload 'avy-isearch "avy" "\
|
||||
Jump to one of the current isearch candidates.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'avy-goto-word-0 "avy" "\
|
||||
Jump to a word start.
|
||||
The window scope is determined by `avy-all-windows' (ARG negates it).
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(autoload 'avy-goto-word-1 "avy" "\
|
||||
Jump to the currently visible CHAR at a word start.
|
||||
The window scope is determined by `avy-all-windows' (ARG negates it).
|
||||
|
||||
\(fn CHAR &optional ARG BEG END SYMBOL)" t nil)
|
||||
|
||||
(autoload 'avy-goto-word-1-above "avy" "\
|
||||
Jump to the currently visible CHAR at a word start.
|
||||
This is a scoped version of `avy-goto-word-1', where the scope is
|
||||
the visible part of the current buffer up to point.
|
||||
|
||||
\(fn CHAR &optional ARG)" t nil)
|
||||
|
||||
(autoload 'avy-goto-word-1-below "avy" "\
|
||||
Jump to the currently visible CHAR at a word start.
|
||||
This is a scoped version of `avy-goto-word-1', where the scope is
|
||||
the visible part of the current buffer following point.
|
||||
|
||||
\(fn CHAR &optional ARG)" t nil)
|
||||
|
||||
(autoload 'avy-goto-symbol-1 "avy" "\
|
||||
Jump to the currently visible CHAR at a symbol start.
|
||||
The window scope is determined by `avy-all-windows' (ARG negates it).
|
||||
|
||||
\(fn CHAR &optional ARG)" t nil)
|
||||
|
||||
(autoload 'avy-goto-symbol-1-above "avy" "\
|
||||
Jump to the currently visible CHAR at a symbol start.
|
||||
This is a scoped version of `avy-goto-symbol-1', where the scope is
|
||||
the visible part of the current buffer up to point.
|
||||
|
||||
\(fn CHAR &optional ARG)" t nil)
|
||||
|
||||
(autoload 'avy-goto-symbol-1-below "avy" "\
|
||||
Jump to the currently visible CHAR at a symbol start.
|
||||
This is a scoped version of `avy-goto-symbol-1', where the scope is
|
||||
the visible part of the current buffer following point.
|
||||
|
||||
\(fn CHAR &optional ARG)" t nil)
|
||||
|
||||
(autoload 'avy-goto-subword-0 "avy" "\
|
||||
Jump to a word or subword start.
|
||||
|
||||
The window scope is determined by `avy-all-windows' (ARG negates it).
|
||||
|
||||
When PREDICATE is non-nil it's a function of zero parameters that
|
||||
should return true.
|
||||
|
||||
\(fn &optional ARG PREDICATE)" t nil)
|
||||
|
||||
(autoload 'avy-goto-subword-1 "avy" "\
|
||||
Jump to the currently visible CHAR at a subword start.
|
||||
The window scope is determined by `avy-all-windows' (ARG negates it).
|
||||
The case of CHAR is ignored.
|
||||
|
||||
\(fn CHAR &optional ARG)" t nil)
|
||||
|
||||
(autoload 'avy-goto-word-or-subword-1 "avy" "\
|
||||
Forward to `avy-goto-subword-1' or `avy-goto-word-1'.
|
||||
Which one depends on variable `subword-mode'.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'avy-goto-line "avy" "\
|
||||
Jump to a line start in current buffer.
|
||||
|
||||
When ARG is 1, jump to lines currently visible, with the option
|
||||
to cancel to `goto-line' by entering a number.
|
||||
|
||||
When ARG is 4, negate the window scope determined by
|
||||
`avy-all-windows'.
|
||||
|
||||
Otherwise, forward to `goto-line' with ARG.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(autoload 'avy-goto-line-above "avy" "\
|
||||
Goto visible line above the cursor.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'avy-goto-line-below "avy" "\
|
||||
Goto visible line below the cursor.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'avy-copy-line "avy" "\
|
||||
Copy a selected line above the current line.
|
||||
ARG lines can be used.
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(autoload 'avy-move-line "avy" "\
|
||||
Move a selected line above the current line.
|
||||
ARG lines can be used.
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(autoload 'avy-copy-region "avy" "\
|
||||
Select two lines and copy the text between them to point.
|
||||
|
||||
The window scope is determined by `avy-all-windows' or
|
||||
`avy-all-windows-alt' when ARG is non-nil.
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(autoload 'avy-move-region "avy" "\
|
||||
Select two lines and move the text between them here.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'avy-kill-region "avy" "\
|
||||
Select two lines and kill the region between them.
|
||||
|
||||
The window scope is determined by `avy-all-windows' or
|
||||
`avy-all-windows-alt' when ARG is non-nil.
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(autoload 'avy-kill-ring-save-region "avy" "\
|
||||
Select two lines and save the region between them to the kill ring.
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(autoload 'avy-kill-whole-line "avy" "\
|
||||
Select line and kill the whole selected line.
|
||||
|
||||
With a numerical prefix ARG, kill ARG line(s) starting from the
|
||||
selected line. If ARG is negative, kill backward.
|
||||
|
||||
If ARG is zero, kill the selected line but exclude the trailing
|
||||
newline.
|
||||
|
||||
\\[universal-argument] 3 \\[avy-kil-whole-line] kill three lines
|
||||
starting from the selected line. \\[universal-argument] -3
|
||||
|
||||
\\[avy-kill-whole-line] kill three lines backward including the
|
||||
selected line.
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(autoload 'avy-kill-ring-save-whole-line "avy" "\
|
||||
Select line and Save the whole selected line as if killed, but don’t kill it.
|
||||
|
||||
This command is similar to `avy-kill-whole-line', except that it
|
||||
saves the line(s) as if killed, but does not kill it(them).
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(autoload 'avy-setup-default "avy" "\
|
||||
Setup the default shortcuts.
|
||||
|
||||
\(fn)" nil nil)
|
||||
|
||||
(autoload 'avy-goto-char-timer "avy" "\
|
||||
Read one or many consecutive chars and jump to the first one.
|
||||
The window scope is determined by `avy-all-windows' (ARG negates it).
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; avy-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "avy" "20160814.250" "tree-based completion" '((emacs "24.1") (cl-lib "0.5")) :url "https://github.com/abo-abo/avy" :keywords '("point" "location"))
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,43 +0,0 @@
|
||||
;;; beacon-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "beacon" "beacon.el" (22536 46955 18715 721000))
|
||||
;;; Generated autoloads from beacon.el
|
||||
|
||||
(autoload 'beacon-blink "beacon" "\
|
||||
Blink the beacon at the position of the cursor.
|
||||
Unlike `beacon-blink-automated', the beacon will blink
|
||||
unconditionally (even if `beacon-mode' is disabled), and this can
|
||||
be invoked as a user command or called from lisp code.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(defvar beacon-mode nil "\
|
||||
Non-nil if Beacon mode is enabled.
|
||||
See the `beacon-mode' command
|
||||
for a description of this minor mode.
|
||||
Setting this variable directly does not take effect;
|
||||
either customize it (see the info node `Easy Customization')
|
||||
or call the function `beacon-mode'.")
|
||||
|
||||
(custom-autoload 'beacon-mode "beacon" nil)
|
||||
|
||||
(autoload 'beacon-mode "beacon" "\
|
||||
Toggle Beacon mode on or off.
|
||||
With a prefix argument ARG, enable Beacon mode if ARG is
|
||||
positive, and disable it otherwise. If called from Lisp, enable
|
||||
the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
|
||||
\\{beacon-mode-map}
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; beacon-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "beacon" "20161004.756" "Highlight the cursor whenever the window scrolls" '((seq "2.14")) :url "https://github.com/Malabarba/beacon" :keywords '("convenience"))
|
||||
@@ -1,481 +0,0 @@
|
||||
;;; beacon.el --- Highlight the cursor whenever the window scrolls -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Artur Malabarba <emacs@endlessparentheses.com>
|
||||
;; URL: https://github.com/Malabarba/beacon
|
||||
;; Package-Version: 20161004.756
|
||||
;; Keywords: convenience
|
||||
;; Version: 1.3.2
|
||||
;; Package-Requires: ((seq "2.14"))
|
||||
|
||||
;; 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 global minor-mode. Turn it on everywhere with:
|
||||
;; ┌────
|
||||
;; │ (beacon-mode 1)
|
||||
;; └────
|
||||
;;
|
||||
;; Whenever the window scrolls a light will shine on top of your cursor so
|
||||
;; you know where it is.
|
||||
;;
|
||||
;; That’s it.
|
||||
;;
|
||||
;; See the accompanying Readme.org for configuration details.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'seq)
|
||||
(require 'faces)
|
||||
(unless (fboundp 'seq-mapn)
|
||||
;; This is for people who are on outdated Emacs snapshots. Will be
|
||||
;; deleted in a couple of weeks.
|
||||
(defun seq-mapn (function sequence &rest sequences)
|
||||
"Like `seq-map' but FUNCTION is mapped over all SEQUENCES.
|
||||
The arity of FUNCTION must match the number of SEQUENCES, and the
|
||||
mapping stops on the shortest sequence.
|
||||
Return a list of the results.
|
||||
|
||||
\(fn FUNCTION SEQUENCES...)"
|
||||
(let ((result nil)
|
||||
(sequences (seq-map (lambda (s) (seq-into s 'list))
|
||||
(cons sequence sequences))))
|
||||
(while (not (memq nil sequences))
|
||||
(push (apply function (seq-map #'car sequences)) result)
|
||||
(setq sequences (seq-map #'cdr sequences)))
|
||||
(nreverse result))))
|
||||
|
||||
(defgroup beacon nil
|
||||
"Customization group for beacon."
|
||||
:group 'emacs
|
||||
:prefix "beacon-")
|
||||
|
||||
(defvar beacon--timer nil)
|
||||
|
||||
(defcustom beacon-push-mark 35
|
||||
"Should the mark be pushed before long movements?
|
||||
If nil, `beacon' will not push the mark.
|
||||
Otherwise this should be a number, and `beacon' will push the
|
||||
mark whenever point moves more than that many lines."
|
||||
:type '(choice integer (const nil)))
|
||||
|
||||
(defcustom beacon-blink-when-point-moves-vertically nil
|
||||
"Should the beacon blink when moving a long distance vertically?
|
||||
If nil, don't blink due to vertical movement.
|
||||
If non-nil, this should be an integer, which is the minimum
|
||||
movement distance (in lines) that triggers a beacon blink."
|
||||
:type '(choice integer (const nil)))
|
||||
|
||||
(defcustom beacon-blink-when-point-moves-horizontally nil
|
||||
"Should the beacon blink when moving a long distance horizontally?
|
||||
If nil, don't blink due to horizontal movement.
|
||||
If non-nil, this should be an integer, which is the minimum
|
||||
movement distance (in columns) that triggers a beacon blink."
|
||||
:type '(choice integer (const nil)))
|
||||
|
||||
(defcustom beacon-blink-when-buffer-changes t
|
||||
"Should the beacon blink when changing buffer?"
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom beacon-blink-when-window-scrolls t
|
||||
"Should the beacon blink when the window scrolls?"
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom beacon-blink-when-window-changes t
|
||||
"Should the beacon blink when the window changes?"
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom beacon-blink-when-focused nil
|
||||
"Should the beacon blink when Emacs gains focus?
|
||||
Note that, due to a limitation of `focus-in-hook', this might
|
||||
trigger false positives on some systems."
|
||||
:type 'boolean
|
||||
:package-version '(beacon . "0.2"))
|
||||
|
||||
(defcustom beacon-blink-duration 0.3
|
||||
"Time, in seconds, that the blink should last."
|
||||
:type 'number)
|
||||
|
||||
(defcustom beacon-blink-delay 0.3
|
||||
"Time, in seconds, before starting to fade the beacon."
|
||||
:type 'number)
|
||||
|
||||
(defcustom beacon-size 40
|
||||
"Size of the beacon in characters."
|
||||
:type 'number)
|
||||
|
||||
(defcustom beacon-color 0.5
|
||||
"Color of the beacon.
|
||||
This can be a string or a number.
|
||||
|
||||
If it is a number, the color is taken to be white or
|
||||
black (depending on the current theme's background) and this
|
||||
number is a float between 0 and 1 specifing the brightness.
|
||||
|
||||
If it is a string, it is a color name or specification,
|
||||
e.g. \"#666600\"."
|
||||
:type '(choice number color))
|
||||
|
||||
(defface beacon-fallback-background
|
||||
'((((class color) (background light)) (:background "black"))
|
||||
(((class color) (background dark)) (:background "white")))
|
||||
"Fallback beacon background color.
|
||||
Used in cases where the color can't be determined by Emacs.
|
||||
Only the background of this face is used.")
|
||||
|
||||
(defvar beacon-dont-blink-predicates nil
|
||||
"A list of predicates that prevent the beacon blink.
|
||||
These predicate functions are called in order, with no
|
||||
arguments, before blinking the beacon. If any returns
|
||||
non-nil, the beacon will not blink.
|
||||
|
||||
For instance, if you want to disable beacon on buffers where
|
||||
`hl-line-mode' is on, you can do:
|
||||
|
||||
(add-hook \\='beacon-dont-blink-predicates
|
||||
(lambda () (bound-and-true-p hl-line-mode)))")
|
||||
|
||||
(defun beacon--compilation-mode-p ()
|
||||
"Non-nil if this is some form of compilation mode."
|
||||
(or (derived-mode-p 'compilation-mode)
|
||||
(bound-and-true-p compilation-minor-mode)))
|
||||
|
||||
(add-hook 'beacon-dont-blink-predicates #'window-minibuffer-p)
|
||||
(add-hook 'beacon-dont-blink-predicates #'beacon--compilation-mode-p)
|
||||
|
||||
(defcustom beacon-dont-blink-major-modes '(t magit-status-mode magit-popup-mode
|
||||
inf-ruby-mode
|
||||
gnus-summary-mode gnus-group-mode)
|
||||
"A list of major-modes where the beacon won't blink.
|
||||
Whenever the current buffer satisfies `derived-mode-p' for
|
||||
one of the major-modes on this list, the beacon will not
|
||||
blink."
|
||||
:type '(repeat symbol))
|
||||
|
||||
(defcustom beacon-dont-blink-commands '(next-line previous-line
|
||||
forward-line)
|
||||
"A list of commands that should not make the beacon blink.
|
||||
Use this for commands that scroll the window in very
|
||||
predictable ways, when the blink would be more distracting
|
||||
than helpful.."
|
||||
:type '(repeat symbol))
|
||||
|
||||
(defcustom beacon-before-blink-hook nil
|
||||
"Hook run immediately before blinking the beacon."
|
||||
:type 'hook)
|
||||
|
||||
|
||||
;;; Internal variables
|
||||
(defvar beacon--window-scrolled nil)
|
||||
(defvar beacon--previous-place nil)
|
||||
(defvar beacon--previous-mark-head nil)
|
||||
(defvar beacon--previous-window nil)
|
||||
(defvar beacon--previous-window-start 0)
|
||||
|
||||
(defun beacon--record-vars ()
|
||||
(unless (window-minibuffer-p)
|
||||
(setq beacon--previous-mark-head (car mark-ring))
|
||||
(setq beacon--previous-place (point-marker))
|
||||
(setq beacon--previous-window (selected-window))
|
||||
(setq beacon--previous-window-start (window-start))))
|
||||
|
||||
|
||||
;;; Overlays
|
||||
(defvar beacon--ovs nil)
|
||||
|
||||
(defconst beacon-overlay-priority (/ most-positive-fixnum 2)
|
||||
"Priotiy used on all of our overlays.")
|
||||
|
||||
(defun beacon--make-overlay (length &rest properties)
|
||||
"Put an overlay at point with background COLOR."
|
||||
(let ((ov (make-overlay (point) (+ length (point)))))
|
||||
(overlay-put ov 'beacon t)
|
||||
;; Our overlay is very temporary, so we take the liberty of giving
|
||||
;; it a high priority.
|
||||
(overlay-put ov 'priority beacon-overlay-priority)
|
||||
(overlay-put ov 'window (selected-window))
|
||||
(while properties
|
||||
(overlay-put ov (pop properties) (pop properties)))
|
||||
(push ov beacon--ovs)
|
||||
ov))
|
||||
|
||||
(defun beacon--colored-overlay (color)
|
||||
"Put an overlay at point with background COLOR."
|
||||
(beacon--make-overlay 1 'face (list :background color)))
|
||||
|
||||
(defun beacon--ov-put-after-string (overlay colors)
|
||||
"Add an after-string property to OVERLAY.
|
||||
The property's value is a string of spaces with background
|
||||
COLORS applied to each one.
|
||||
If COLORS is nil, OVERLAY is deleted!"
|
||||
(if (not colors)
|
||||
(when (overlayp overlay)
|
||||
(delete-overlay overlay))
|
||||
(overlay-put overlay 'beacon-colors colors)
|
||||
(overlay-put overlay 'after-string
|
||||
(propertize
|
||||
(mapconcat (lambda (c) (propertize " " 'face (list :background c)))
|
||||
colors
|
||||
"")
|
||||
'cursor 1000))))
|
||||
|
||||
(defun beacon--after-string-overlay (colors)
|
||||
"Put an overlay at point with an after-string property.
|
||||
The property's value is a string of spaces with background
|
||||
COLORS applied to each one."
|
||||
;; The after-string must not be longer than the remaining columns
|
||||
;; from point to right window-end else it will be wrapped around.
|
||||
(let ((colors (seq-take colors (- (window-width) (current-column)))))
|
||||
(beacon--ov-put-after-string (beacon--make-overlay 0) colors)))
|
||||
|
||||
(defun beacon--ov-at-point ()
|
||||
(car (or (seq-filter (lambda (o) (overlay-get o 'beacon))
|
||||
(overlays-in (point) (point)))
|
||||
(seq-filter (lambda (o) (overlay-get o 'beacon))
|
||||
(overlays-at (point))))))
|
||||
|
||||
(defun beacon--vanish (&rest _)
|
||||
"Turn off the beacon."
|
||||
(unless (string-match "\\` \\*\\(temp-buffer\\|Echo Area.*\\)\\*"
|
||||
(buffer-name))
|
||||
(when (timerp beacon--timer)
|
||||
(cancel-timer beacon--timer))
|
||||
(mapc #'delete-overlay beacon--ovs)
|
||||
(setq beacon--ovs nil)))
|
||||
|
||||
|
||||
;;; Colors
|
||||
(defun beacon--int-range (a b)
|
||||
"Return a list of integers between A inclusive and B exclusive.
|
||||
Only returns `beacon-size' elements."
|
||||
(let ((d (/ (- b a) beacon-size))
|
||||
(out (list a)))
|
||||
(dotimes (_ (1- beacon-size))
|
||||
(push (+ (car out) d) out))
|
||||
(nreverse out)))
|
||||
|
||||
(defun beacon--color-range ()
|
||||
"Return a list of background colors for the beacon."
|
||||
(let* ((default-bg (or (save-excursion
|
||||
(unless (eobp)
|
||||
(forward-line 1)
|
||||
(unless (or (bobp) (not (bolp)))
|
||||
(forward-char -1)))
|
||||
(background-color-at-point))
|
||||
(face-background 'default)))
|
||||
(bg (color-values (if (or (not (stringp default-bg))
|
||||
(string-match "\\`unspecified-" default-bg))
|
||||
(face-attribute 'beacon-fallback-background :background)
|
||||
default-bg)))
|
||||
(fg (cond
|
||||
((stringp beacon-color) (color-values beacon-color))
|
||||
((and (stringp bg)
|
||||
(< (color-distance "black" bg)
|
||||
(color-distance "white" bg)))
|
||||
(make-list 3 (* beacon-color 65535)))
|
||||
(t (make-list 3 (* (- 1 beacon-color) 65535))))))
|
||||
(when bg
|
||||
(apply #'seq-mapn (lambda (r g b) (format "#%04x%04x%04x" r g b))
|
||||
(mapcar (lambda (n) (butlast (beacon--int-range (elt fg n) (elt bg n))))
|
||||
[0 1 2])))))
|
||||
|
||||
|
||||
;;; Blinking
|
||||
(defun beacon--shine ()
|
||||
"Shine a beacon at point."
|
||||
(let ((colors (beacon--color-range)))
|
||||
(save-excursion
|
||||
(while colors
|
||||
(if (looking-at "$")
|
||||
(progn
|
||||
(beacon--after-string-overlay colors)
|
||||
(setq colors nil))
|
||||
(beacon--colored-overlay (pop colors))
|
||||
(forward-char 1))))))
|
||||
|
||||
(defun beacon--dec ()
|
||||
"Decrease the beacon brightness by one."
|
||||
(pcase (beacon--ov-at-point)
|
||||
(`nil (beacon--vanish))
|
||||
((and o (let c (overlay-get o 'beacon-colors)) (guard c))
|
||||
(beacon--ov-put-after-string o (cdr c)))
|
||||
(o
|
||||
(delete-overlay o)
|
||||
(save-excursion
|
||||
(while (and (condition-case nil
|
||||
(progn (forward-char 1) t)
|
||||
(end-of-buffer nil))
|
||||
(setq o (beacon--ov-at-point)))
|
||||
(let ((colors (overlay-get o 'beacon-colors)))
|
||||
(if (not colors)
|
||||
(move-overlay o (1- (point)) (point))
|
||||
(forward-char -1)
|
||||
(beacon--colored-overlay (pop colors))
|
||||
(beacon--ov-put-after-string o colors)
|
||||
(forward-char 1))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun beacon-blink ()
|
||||
"Blink the beacon at the position of the cursor.
|
||||
Unlike `beacon-blink-automated', the beacon will blink
|
||||
unconditionally (even if `beacon-mode' is disabled), and this can
|
||||
be invoked as a user command or called from lisp code."
|
||||
(interactive)
|
||||
(beacon--vanish)
|
||||
(run-hooks 'beacon-before-blink-hook)
|
||||
(beacon--shine)
|
||||
(setq beacon--timer
|
||||
(run-at-time beacon-blink-delay
|
||||
(/ beacon-blink-duration 1.0 beacon-size)
|
||||
#'beacon--dec)))
|
||||
|
||||
(defun beacon-blink-automated ()
|
||||
"If appropriate, blink the beacon at the position of the cursor.
|
||||
Unlike `beacon-blink', the blinking is conditioned on a series of
|
||||
variables: `beacon-mode', `beacon-dont-blink-commands',
|
||||
`beacon-dont-blink-major-modes', and
|
||||
`beacon-dont-blink-predicates'."
|
||||
;; Record vars here in case something is blinking outside the
|
||||
;; command loop.
|
||||
(beacon--record-vars)
|
||||
(unless (or (not beacon-mode)
|
||||
(run-hook-with-args-until-success 'beacon-dont-blink-predicates)
|
||||
(seq-find #'derived-mode-p beacon-dont-blink-major-modes)
|
||||
(memq (or this-command last-command) beacon-dont-blink-commands))
|
||||
(beacon-blink)))
|
||||
|
||||
|
||||
;;; Movement detection
|
||||
(defun beacon--movement-> (delta-y &optional delta-x)
|
||||
"Return non-nil if latest vertical movement is > DELTA-Y.
|
||||
If DELTA-Y is nil, return nil.
|
||||
The same is true for DELTA-X and horizonta movement."
|
||||
(and delta-y
|
||||
(markerp beacon--previous-place)
|
||||
(equal (marker-buffer beacon--previous-place)
|
||||
(current-buffer))
|
||||
;; Quick check that prevents running the code below in very
|
||||
;; short movements (like typing).
|
||||
(> (abs (- (point) beacon--previous-place))
|
||||
delta-y)
|
||||
;; Col movement.
|
||||
(or (and delta-x
|
||||
(> (abs (- (current-column)
|
||||
(save-excursion
|
||||
(goto-char beacon--previous-place)
|
||||
(current-column))))
|
||||
delta-x))
|
||||
;; Check if the movement was >= DELTA lines by moving DELTA
|
||||
;; lines. `count-screen-lines' is too slow if the movement had
|
||||
;; thousands of lines.
|
||||
(save-excursion
|
||||
(let ((p (point)))
|
||||
(goto-char (min beacon--previous-place p))
|
||||
(vertical-motion delta-y)
|
||||
(> (max p beacon--previous-place)
|
||||
(line-beginning-position)))))))
|
||||
|
||||
(defun beacon--maybe-push-mark ()
|
||||
"Push mark if it seems to be safe."
|
||||
(when (and (not mark-active)
|
||||
(beacon--movement-> beacon-push-mark))
|
||||
(let ((head (car mark-ring)))
|
||||
(when (and (eq beacon--previous-mark-head head)
|
||||
(not (equal head beacon--previous-place)))
|
||||
(push-mark beacon--previous-place 'silent)))))
|
||||
|
||||
(defun beacon--post-command ()
|
||||
"Blink if point moved very far."
|
||||
(cond
|
||||
;; Sanity check.
|
||||
((not (markerp beacon--previous-place)))
|
||||
;; Blink for switching buffers.
|
||||
((and beacon-blink-when-buffer-changes
|
||||
(not (eq (marker-buffer beacon--previous-place)
|
||||
(current-buffer))))
|
||||
(beacon-blink-automated))
|
||||
;; Blink for switching windows.
|
||||
((and beacon-blink-when-window-changes
|
||||
(not (eq beacon--previous-window (selected-window))))
|
||||
(beacon-blink-automated))
|
||||
;; Blink for scrolling.
|
||||
((and beacon--window-scrolled
|
||||
(equal beacon--window-scrolled (selected-window)))
|
||||
(beacon-blink-automated))
|
||||
;; Blink for movement
|
||||
((beacon--movement-> beacon-blink-when-point-moves-vertically
|
||||
beacon-blink-when-point-moves-horizontally)
|
||||
(beacon-blink-automated)))
|
||||
(beacon--maybe-push-mark)
|
||||
(setq beacon--window-scrolled nil))
|
||||
|
||||
(defun beacon--window-scroll-function (win start-pos)
|
||||
"Blink the beacon or record that window has been scrolled.
|
||||
If invoked during the command loop, record the current window so
|
||||
that it may be blinked on post-command. This is because the
|
||||
scrolled window might not be active, but we only know that at
|
||||
`post-command-hook'.
|
||||
|
||||
If invoked outside the command loop, `post-command-hook' would be
|
||||
unreliable, so just blink immediately."
|
||||
(unless (or (and (equal beacon--previous-window-start start-pos)
|
||||
(equal beacon--previous-window win))
|
||||
(not beacon-blink-when-window-scrolls))
|
||||
(if this-command
|
||||
(setq beacon--window-scrolled win)
|
||||
(setq beacon--window-scrolled nil)
|
||||
(beacon-blink-automated))))
|
||||
|
||||
(defun beacon--blink-on-focus ()
|
||||
"Blink if `beacon-blink-when-focused' is non-nil"
|
||||
(when beacon-blink-when-focused
|
||||
(beacon-blink-automated)))
|
||||
|
||||
|
||||
;;; Minor-mode
|
||||
(defcustom beacon-lighter
|
||||
(cond
|
||||
;; ((char-displayable-p ?💡) " 💡")
|
||||
;; ((char-displayable-p ?Λ) " Λ")
|
||||
(t " (*)"))
|
||||
"Lighter string used on the mode-line."
|
||||
:type 'string)
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode beacon-mode
|
||||
nil nil beacon-lighter nil
|
||||
:global t
|
||||
(if beacon-mode
|
||||
(progn
|
||||
(add-hook 'window-scroll-functions #'beacon--window-scroll-function)
|
||||
(add-hook 'focus-in-hook #'beacon--blink-on-focus)
|
||||
(add-hook 'post-command-hook #'beacon--post-command)
|
||||
(add-hook 'before-change-functions #'beacon--vanish)
|
||||
(add-hook 'pre-command-hook #'beacon--record-vars)
|
||||
(add-hook 'pre-command-hook #'beacon--vanish))
|
||||
(remove-hook 'focus-in-hook #'beacon--blink-on-focus)
|
||||
(remove-hook 'window-scroll-functions #'beacon--window-scroll-function)
|
||||
(remove-hook 'post-command-hook #'beacon--post-command)
|
||||
(remove-hook 'before-change-functions #'beacon--vanish)
|
||||
(remove-hook 'pre-command-hook #'beacon--record-vars)
|
||||
(remove-hook 'pre-command-hook #'beacon--vanish)))
|
||||
|
||||
(provide 'beacon)
|
||||
;;; beacon.el ends here
|
||||
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: nil
|
||||
;; End:
|
||||
@@ -1,72 +0,0 @@
|
||||
;;; bind-key-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "bind-key" "bind-key.el" (22523 35882 90832
|
||||
;;;;;; 599000))
|
||||
;;; Generated autoloads from bind-key.el
|
||||
|
||||
(autoload 'bind-key "bind-key" "\
|
||||
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.
|
||||
|
||||
\(fn KEY-NAME COMMAND &optional KEYMAP PREDICATE)" nil t)
|
||||
|
||||
(autoload 'unbind-key "bind-key" "\
|
||||
Unbind the given KEY-NAME, within the KEYMAP (if specified).
|
||||
See `bind-key' for more details.
|
||||
|
||||
\(fn KEY-NAME &optional KEYMAP)" nil t)
|
||||
|
||||
(autoload 'bind-key* "bind-key" "\
|
||||
Similar to `bind-key', but overrides any mode-specific bindings.
|
||||
|
||||
\(fn KEY-NAME COMMAND &optional PREDICATE)" nil t)
|
||||
|
||||
(autoload 'bind-keys "bind-key" "\
|
||||
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).
|
||||
|
||||
\(fn &rest ARGS)" nil t)
|
||||
|
||||
(autoload 'bind-keys* "bind-key" "\
|
||||
|
||||
|
||||
\(fn &rest ARGS)" nil t)
|
||||
|
||||
(autoload 'describe-personal-keybindings "bind-key" "\
|
||||
Display all the personal keybindings defined by `bind-key'.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; bind-key-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "bind-key" "20160227.48" "A simple way to manage personal keybindings" 'nil :url "https://github.com/jwiegley/use-package" :keywords '("keys" "keybinding" "config" "dotemacs"))
|
||||
@@ -1,414 +0,0 @@
|
||||
;;; 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
|
||||
;; Package-Version: 20160227.48
|
||||
;; 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.
|
||||
|
||||
(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)
|
||||
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:
|
||||
;; indent-tabs-mode: nil
|
||||
;; End:
|
||||
|
||||
;;; bind-key.el ends here
|
||||
@@ -1,27 +0,0 @@
|
||||
;;; cheatsheet-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "cheatsheet" "cheatsheet.el" (22539 27682 220569
|
||||
;;;;;; 346000))
|
||||
;;; Generated autoloads from cheatsheet.el
|
||||
|
||||
(autoload 'cheatsheet-add "cheatsheet" "\
|
||||
Add CHEAT to cheatsheet.
|
||||
|
||||
\(fn &rest CHEAT)" nil nil)
|
||||
|
||||
(autoload 'cheatsheet-show "cheatsheet" "\
|
||||
Create buffer and show cheatsheet.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; cheatsheet-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "cheatsheet" "20151203.151" "create your own cheatsheet" '((emacs "24") (cl-lib "0.5")) :url "http://github.com/darksmile/cheatsheet/" :keywords '("convenience" "usability"))
|
||||
@@ -1,145 +0,0 @@
|
||||
;;; cheatsheet.el --- create your own cheatsheet
|
||||
|
||||
;; Copyright (C) 2015 Shirin Nikita and contributors
|
||||
;;
|
||||
;; Author: Shirin Nikita <shirin.nikita@gmail.com> and contributors
|
||||
;; URL: http://github.com/darksmile/cheatsheet/
|
||||
;; Package-Version: 20151203.151
|
||||
;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
|
||||
;; Version: 1.0
|
||||
;; Keywords: convenience, usability
|
||||
|
||||
;; This file is not part of GNU Emacs
|
||||
|
||||
;;; Licence:
|
||||
|
||||
;; Licensed under the same terms as Emacs.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Quick start:
|
||||
;; Load package
|
||||
;; Add your first cheat:
|
||||
;; (cheatsheet-add :group 'Common
|
||||
;; :key "C-x C-c"
|
||||
;; :description "leave Emacs.")
|
||||
;; Run (cheatsheet-show) and enjoy looking at your own Emacs cheatsheet.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
|
||||
(defconst cheatsheet--group-face
|
||||
'(:foreground "red")
|
||||
"Group name font face.")
|
||||
|
||||
(defconst cheatsheet--key-face
|
||||
'(:foreground "orange")
|
||||
"Cheat key font face.")
|
||||
|
||||
(defconst cheatsheet--keymap
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "C-q") 'kill-buffer-and-window)
|
||||
map))
|
||||
|
||||
|
||||
(defvar cheatsheet--cheat-list '()
|
||||
"List of cheats.")
|
||||
|
||||
;; Getters for CHEAT and GROUP plists
|
||||
(defun cheatsheet--if-symbol-to-string (string-like)
|
||||
"Convert STRING-LIKE to string."
|
||||
(if (symbolp string-like) (symbol-name string-like) string-like))
|
||||
|
||||
(defun cheatsheet--group-name (group)
|
||||
"Get GROUP name."
|
||||
(cheatsheet--if-symbol-to-string (plist-get group :name)))
|
||||
|
||||
(defun cheatsheet--group-cheats (group)
|
||||
"Get GROUP cheats."
|
||||
(cheatsheet--if-symbol-to-string (plist-get group :cheats)))
|
||||
|
||||
(defun cheatsheet--cheat-key (cheat)
|
||||
"Get CHEAT key."
|
||||
(cheatsheet--if-symbol-to-string (plist-get cheat :key)))
|
||||
|
||||
(defun cheatsheet--cheat-group (cheat)
|
||||
"Get CHEAT group."
|
||||
(cheatsheet--if-symbol-to-string (plist-get cheat :group)))
|
||||
|
||||
(defun cheatsheet--cheat-description (cheat)
|
||||
"Get CHEAT description."
|
||||
(cheatsheet--if-symbol-to-string (plist-get cheat :description)))
|
||||
|
||||
;; Functions to get data from CHEATSHEET in convenient format
|
||||
(defun cheatsheet--cheat-groups ()
|
||||
"Get all groups, submitted to cheatsheet."
|
||||
(reverse (delete-dups
|
||||
(mapcar 'cheatsheet--cheat-group
|
||||
cheatsheet--cheat-list))))
|
||||
|
||||
(defun cheatsheet--get-group (group)
|
||||
"Get group struct with all cheats, belonging to GROUP."
|
||||
(cl-flet ((is-current-group (cheat)
|
||||
(if (string= (cheatsheet--cheat-group cheat)
|
||||
group)
|
||||
cheat
|
||||
nil)))
|
||||
(delq nil (mapcar #'is-current-group cheatsheet--cheat-list))))
|
||||
|
||||
;; Functions to format cheatsheet items and prepare to print
|
||||
(defun cheatsheet--format-cheat (cheat key-cell-length)
|
||||
"Format CHEAT row with KEY-CELL-LENGTH key cell length."
|
||||
(let* ((format-string (format "%%%ds - %%s\n" key-cell-length))
|
||||
(key (cheatsheet--cheat-key cheat))
|
||||
(description (cheatsheet--cheat-description cheat))
|
||||
(faced-key (propertize key 'face cheatsheet--key-face)))
|
||||
(format format-string faced-key description)))
|
||||
|
||||
(defun cheatsheet--format-group (group)
|
||||
"Format GROUP to table."
|
||||
(cl-flet ((key-length (cheat) (length (cheatsheet--cheat-key cheat)))
|
||||
(format-cheat (key-cell-length cheat)
|
||||
(cheatsheet--format-cheat cheat key-cell-length)))
|
||||
|
||||
(let* ((name (cheatsheet--group-name group))
|
||||
(cheats (cheatsheet--group-cheats group))
|
||||
(key-max-length (apply 'max (mapcar #'key-length cheats)))
|
||||
(key-cell-length (+ 2 key-max-length))
|
||||
(format-cheat (apply-partially #'format-cheat key-cell-length))
|
||||
(formatted-cheats (apply 'concat (mapcar format-cheat cheats)))
|
||||
(faced-group-name (propertize name 'face cheatsheet--group-face)))
|
||||
(concat faced-group-name "\n" formatted-cheats "\n"))))
|
||||
|
||||
(defun cheatsheet--format ()
|
||||
"Print the whole cheatsheet."
|
||||
(let* ((cheatsheet (cheatsheet-get))
|
||||
(formatted-groups (mapcar 'cheatsheet--format-group cheatsheet))
|
||||
(formatted-cheatsheet (apply 'concat formatted-groups)))
|
||||
formatted-cheatsheet))
|
||||
|
||||
;; Interface
|
||||
;;;###autoload
|
||||
(defun cheatsheet-add (&rest cheat)
|
||||
"Add CHEAT to cheatsheet."
|
||||
(add-to-list 'cheatsheet--cheat-list cheat))
|
||||
|
||||
(defun cheatsheet-get ()
|
||||
"Get cheatsheet as list of group structs, keeping defining order."
|
||||
(cl-flet ((make-group (group)
|
||||
(list :name group
|
||||
:cheats (cheatsheet--get-group group))))
|
||||
(mapcar #'make-group (cheatsheet--cheat-groups))))
|
||||
|
||||
;;;###autoload
|
||||
(defun cheatsheet-show ()
|
||||
"Create buffer and show cheatsheet."
|
||||
(interactive)
|
||||
(switch-to-buffer-other-window "*cheatsheet*")
|
||||
(use-local-map cheatsheet--keymap)
|
||||
(erase-buffer)
|
||||
(insert (cheatsheet--format))
|
||||
(setq buffer-read-only t))
|
||||
|
||||
(provide 'cheatsheet)
|
||||
;;; cheatsheet.el ends here
|
||||
@@ -1,32 +0,0 @@
|
||||
;;; coffee-mode-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "coffee-mode" "coffee-mode.el" (22454 5298
|
||||
;;;;;; 807704 278000))
|
||||
;;; Generated autoloads from coffee-mode.el
|
||||
|
||||
(autoload 'coffee-mode "coffee-mode" "\
|
||||
Major mode for editing CoffeeScript.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(add-to-list 'auto-mode-alist '("\\.coffee\\'" . coffee-mode))
|
||||
|
||||
(add-to-list 'auto-mode-alist '("\\.iced\\'" . coffee-mode))
|
||||
|
||||
(add-to-list 'auto-mode-alist '("Cakefile\\'" . coffee-mode))
|
||||
|
||||
(add-to-list 'auto-mode-alist '("\\.cson\\'" . coffee-mode))
|
||||
|
||||
(add-to-list 'interpreter-mode-alist '("coffee" . coffee-mode))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; coffee-mode-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "coffee-mode" "20160808.1712" "Major mode for CoffeeScript code" '((emacs "24.1") (cl-lib "0.5")) :url "http://github.com/defunkt/coffee-mode" :keywords '("coffeescript" "major" "mode"))
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,27 +0,0 @@
|
||||
;;; command-log-mode-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "command-log-mode" "command-log-mode.el" (22506
|
||||
;;;;;; 36214 708146 298000))
|
||||
;;; Generated autoloads from command-log-mode.el
|
||||
|
||||
(autoload 'command-log-mode "command-log-mode" "\
|
||||
Toggle keyboard command logging.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(autoload 'clm/toggle-command-log-buffer "command-log-mode" "\
|
||||
Toggle the command log showing or not.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; command-log-mode-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "command-log-mode" "20160412.2147" "log keyboard commands to buffer" 'nil :url "https://github.com/lewang/command-log-mode" :keywords '("help"))
|
||||
@@ -1,323 +0,0 @@
|
||||
;;; command-log-mode.el --- log keyboard commands to buffer
|
||||
|
||||
;; homepage: https://github.com/lewang/command-log-mode
|
||||
|
||||
;; Copyright (C) 2013 Nic Ferrier
|
||||
;; Copyright (C) 2012 Le Wang
|
||||
;; Copyright (C) 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Michael Weber <michaelw@foldr.org>
|
||||
;; Keywords: help
|
||||
;; Package-Version: 20160412.2147
|
||||
;; Initial-version: <2004-10-07 11:41:28 michaelw>
|
||||
;; Time-stamp: <2004-11-06 17:08:11 michaelw>
|
||||
|
||||
;; This file is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 2, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; This file is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with 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:
|
||||
|
||||
;; This add-on can be used to demo Emacs to an audience. When
|
||||
;; activated, keystrokes get logged into a designated buffer, along
|
||||
;; with the command bound to them.
|
||||
|
||||
;; To enable, use e.g.:
|
||||
;;
|
||||
;; (require 'command-log-mode)
|
||||
;; (add-hook 'LaTeX-mode-hook 'command-log-mode)
|
||||
;;
|
||||
;; To see the log buffer, call M-x clm/open-command-log-buffer.
|
||||
|
||||
;; The key strokes in the log are decorated with ISO9601 timestamps on
|
||||
;; the property `:time' so if you want to convert the log for
|
||||
;; screencasting purposes you could use the time stamp as a key into
|
||||
;; the video beginning.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defvar clm/log-text t
|
||||
"A non-nil setting means text will be saved to the command log.")
|
||||
|
||||
(defvar clm/log-repeat nil
|
||||
"A nil setting means repetitions of the same command are merged into the single log line.")
|
||||
|
||||
(defvar clm/recent-history-string ""
|
||||
"This string will hold recently typed text.")
|
||||
|
||||
(defun clm/recent-history ()
|
||||
(setq clm/recent-history-string
|
||||
(concat clm/recent-history-string
|
||||
(buffer-substring-no-properties (- (point) 1) (point)))))
|
||||
|
||||
(add-hook 'post-self-insert-hook 'clm/recent-history)
|
||||
|
||||
(defun clm/zap-recent-history ()
|
||||
(unless (or (member this-original-command
|
||||
clm/log-command-exceptions*)
|
||||
(eq this-original-command #'self-insert-command))
|
||||
(setq clm/recent-history-string "")))
|
||||
|
||||
(add-hook 'post-command-hook 'clm/zap-recent-history)
|
||||
|
||||
(defvar clm/time-string "%Y-%m-%dT%H:%M:%S"
|
||||
"The string sent to `format-time-string' when command time is logged.")
|
||||
|
||||
(defvar clm/logging-dir "~/log/"
|
||||
"Directory in which to store files containing logged commands.")
|
||||
|
||||
(defvar clm/log-command-exceptions*
|
||||
'(nil self-insert-command backward-char forward-char
|
||||
delete-char delete-backward-char backward-delete-char
|
||||
backward-delete-char-untabify
|
||||
universal-argument universal-argument-other-key
|
||||
universal-argument-minus universal-argument-more
|
||||
beginning-of-line end-of-line recenter
|
||||
move-end-of-line move-beginning-of-line
|
||||
handle-switch-frame
|
||||
newline previous-line next-line)
|
||||
"A list commands which should not be logged, despite logging being enabled.
|
||||
Frequently used non-interesting commands (like cursor movements) should be put here.")
|
||||
|
||||
(defvar clm/command-log-buffer nil
|
||||
"Reference of the currenly used buffer to display logged commands.")
|
||||
(defvar clm/command-repetitions 0
|
||||
"Count of how often the last keyboard commands has been repeated.")
|
||||
(defvar clm/last-keyboard-command nil
|
||||
"Last logged keyboard command.")
|
||||
|
||||
|
||||
(defvar clm/log-command-indentation 11
|
||||
"*Indentation of commands in command log buffer.")
|
||||
|
||||
(defgroup command-log nil
|
||||
"Customization for the command log.")
|
||||
|
||||
(defcustom command-log-mode-auto-show nil
|
||||
"Show the command-log window or frame automatically."
|
||||
:group 'command-log
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom command-log-mode-window-size 40
|
||||
"The size of the command-log window."
|
||||
:group 'command-log
|
||||
:type 'integer)
|
||||
|
||||
(defcustom command-log-mode-window-font-size 2
|
||||
"The font-size of the command-log window."
|
||||
:group 'command-log
|
||||
:type 'integer)
|
||||
|
||||
(defcustom command-log-mode-key-binding-open-log "C-c o"
|
||||
"The key binding used to toggle the log window."
|
||||
:group 'command-log
|
||||
:type '(radio
|
||||
(const :tag "No key" nil)
|
||||
(key-sequence "C-c o"))) ;; this is not right though it works for kbd
|
||||
|
||||
(defcustom command-log-mode-open-log-turns-on-mode nil
|
||||
"Does opening the command log turn on the mode?"
|
||||
:group 'command-log
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom command-log-mode-is-global nil
|
||||
"Does turning on command-log-mode happen globally?"
|
||||
:group 'command-log
|
||||
:type 'boolean)
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode command-log-mode
|
||||
"Toggle keyboard command logging."
|
||||
:init-value nil
|
||||
:lighter " command-log"
|
||||
:keymap nil
|
||||
(if command-log-mode
|
||||
(when (and
|
||||
command-log-mode-auto-show
|
||||
(not (get-buffer-window clm/command-log-buffer)))
|
||||
(clm/open-command-log-buffer))
|
||||
;; We can close the window though
|
||||
(clm/close-command-log-buffer)))
|
||||
|
||||
(define-global-minor-mode global-command-log-mode command-log-mode
|
||||
command-log-mode)
|
||||
|
||||
(defun clm/buffer-log-command-p (cmd &optional buffer)
|
||||
"Determines whether keyboard command CMD should be logged.
|
||||
If non-nil, BUFFER specifies the buffer used to determine whether CMD should be logged.
|
||||
If BUFFER is nil, the current buffer is assumed."
|
||||
(let ((val (if buffer
|
||||
(buffer-local-value command-log-mode buffer)
|
||||
command-log-mode)))
|
||||
(and (not (null val))
|
||||
(null (member cmd clm/log-command-exceptions*)))))
|
||||
|
||||
(defmacro clm/save-command-environment (&rest body)
|
||||
(declare (indent 0))
|
||||
`(let ((deactivate-mark nil) ; do not deactivate mark in transient
|
||||
; mark mode
|
||||
;; do not let random commands scribble over
|
||||
;; {THIS,LAST}-COMMAND
|
||||
(this-command this-command)
|
||||
(last-command last-command))
|
||||
,@body))
|
||||
|
||||
(defun clm/open-command-log-buffer (&optional arg)
|
||||
"Opens (and creates, if non-existant) a buffer used for logging keyboard commands.
|
||||
If ARG is Non-nil, the existing command log buffer is cleared."
|
||||
(interactive "P")
|
||||
(with-current-buffer
|
||||
(setq clm/command-log-buffer
|
||||
(get-buffer-create " *command-log*"))
|
||||
(text-scale-set 1))
|
||||
(when arg
|
||||
(with-current-buffer clm/command-log-buffer
|
||||
(erase-buffer)))
|
||||
(let ((new-win (split-window-horizontally
|
||||
(- 0 command-log-mode-window-size))))
|
||||
(set-window-buffer new-win clm/command-log-buffer)
|
||||
(set-window-dedicated-p new-win t)))
|
||||
|
||||
(defun clm/close-command-log-buffer ()
|
||||
"Close the command log window."
|
||||
(interactive)
|
||||
(with-current-buffer
|
||||
(setq clm/command-log-buffer
|
||||
(get-buffer-create " *command-log*"))
|
||||
(let ((win (get-buffer-window (current-buffer))))
|
||||
(when (windowp win)
|
||||
(delete-window win)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun clm/toggle-command-log-buffer (&optional arg)
|
||||
"Toggle the command log showing or not."
|
||||
(interactive "P")
|
||||
(when (and command-log-mode-open-log-turns-on-mode
|
||||
(not command-log-mode))
|
||||
(if command-log-mode-is-global
|
||||
(global-command-log-mode)
|
||||
(command-log-mode)))
|
||||
(with-current-buffer
|
||||
(setq clm/command-log-buffer
|
||||
(get-buffer-create " *command-log*"))
|
||||
(let ((win (get-buffer-window (current-buffer))))
|
||||
(if (windowp win)
|
||||
(clm/close-command-log-buffer)
|
||||
;; Else open the window
|
||||
(clm/open-command-log-buffer arg)))))
|
||||
|
||||
(defun clm/scroll-buffer-window (buffer &optional move-fn)
|
||||
"Updates `point' of windows containing BUFFER according to MOVE-FN.
|
||||
If non-nil, MOVE-FN is called on every window which displays BUFFER.
|
||||
If nil, MOVE-FN defaults to scrolling to the bottom, making the last line visible.
|
||||
|
||||
Scrolling up can be accomplished with:
|
||||
\(clm/scroll-buffer-window buf (lambda () (goto-char (point-min))))
|
||||
"
|
||||
(let ((selected (selected-window))
|
||||
(point-mover (or move-fn
|
||||
(function (lambda () (goto-char (point-max)))))))
|
||||
(walk-windows (function (lambda (window)
|
||||
(when (eq (window-buffer window) buffer)
|
||||
(select-window window)
|
||||
(funcall point-mover)
|
||||
(select-window selected))))
|
||||
nil t)))
|
||||
|
||||
(defmacro clm/with-command-log-buffer (&rest body)
|
||||
(declare (indent 0))
|
||||
`(when (and (not (null clm/command-log-buffer))
|
||||
(buffer-name clm/command-log-buffer))
|
||||
(with-current-buffer clm/command-log-buffer
|
||||
,@body)))
|
||||
|
||||
(defun clm/log-command (&optional cmd)
|
||||
"Hook into `pre-command-hook' to intercept command activation."
|
||||
(clm/save-command-environment
|
||||
(setq cmd (or cmd this-command))
|
||||
(when (clm/buffer-log-command-p cmd)
|
||||
(clm/with-command-log-buffer
|
||||
(let ((current (current-buffer)))
|
||||
(goto-char (point-max))
|
||||
(cond ((and (not clm/log-repeat) (eq cmd clm/last-keyboard-command))
|
||||
(incf clm/command-repetitions)
|
||||
(save-match-data
|
||||
(when (and (> clm/command-repetitions 1)
|
||||
(search-backward "[" (line-beginning-position -1) t))
|
||||
(delete-region (point) (line-end-position))))
|
||||
(backward-char) ; skip over either ?\newline or ?\space before ?\[
|
||||
(insert " [")
|
||||
(princ (1+ clm/command-repetitions) current)
|
||||
(insert " times]"))
|
||||
(t ;; (message "last cmd: %s cur: %s" last-command cmd)
|
||||
;; showing accumulated text with interleaved key presses isn't very useful
|
||||
(when (and clm/log-text (not clm/log-repeat))
|
||||
(if (eq clm/last-keyboard-command 'self-insert-command)
|
||||
(insert "[text: " clm/recent-history-string "]\n")))
|
||||
(setq clm/command-repetitions 0)
|
||||
(insert
|
||||
(propertize
|
||||
(key-description (this-command-keys))
|
||||
:time (format-time-string clm/time-string (current-time))))
|
||||
(when (>= (current-column) clm/log-command-indentation)
|
||||
(newline))
|
||||
(move-to-column clm/log-command-indentation t)
|
||||
(princ (if (byte-code-function-p cmd) "<bytecode>" cmd) current)
|
||||
(newline)
|
||||
(setq clm/last-keyboard-command cmd)))
|
||||
(clm/scroll-buffer-window current))))))
|
||||
|
||||
(defun clm/command-log-clear ()
|
||||
"Clear the command log buffer."
|
||||
(interactive)
|
||||
(with-current-buffer clm/command-log-buffer
|
||||
(erase-buffer)))
|
||||
|
||||
(defun clm/save-log-line (start end)
|
||||
"Helper function for `clm/save-command-log' to export text properties."
|
||||
(save-excursion
|
||||
(goto-char start)
|
||||
(let ((time (get-text-property (point) :time)))
|
||||
(if time
|
||||
(list (cons start (if time
|
||||
(concat "[" (get-text-property (point) :time) "] ")
|
||||
"")))))))
|
||||
|
||||
(defun clm/save-command-log ()
|
||||
"Save commands to today's log.
|
||||
Clears the command log buffer after saving."
|
||||
(interactive)
|
||||
(save-window-excursion
|
||||
(set-buffer (get-buffer " *command-log*"))
|
||||
(goto-char (point-min))
|
||||
(let ((now (format-time-string "%Y-%m-%d"))
|
||||
(write-region-annotate-functions '(clm/save-log-line)))
|
||||
(while (and (re-search-forward "^.*" nil t)
|
||||
(not (eobp)))
|
||||
(append-to-file (line-beginning-position) (1+ (line-end-position)) (concat clm/logging-dir now))))
|
||||
(clm/command-log-clear)))
|
||||
|
||||
(add-hook 'pre-command-hook 'clm/log-command)
|
||||
|
||||
(eval-after-load 'command-log-mode
|
||||
'(when command-log-mode-key-binding-open-log
|
||||
(global-set-key
|
||||
(kbd command-log-mode-key-binding-open-log)
|
||||
'clm/toggle-command-log-buffer)))
|
||||
|
||||
(provide 'command-log-mode)
|
||||
|
||||
;;; command-log-mode.el ends here
|
||||
@@ -1,50 +0,0 @@
|
||||
;;; company-abbrev.el --- company-mode completion backend for abbrev
|
||||
|
||||
;; Copyright (C) 2009-2011, 2015 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 'cl-lib)
|
||||
(require 'abbrev)
|
||||
|
||||
(defun company-abbrev-insert (match)
|
||||
"Replace MATCH with the expanded abbrev."
|
||||
(expand-abbrev))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-abbrev (command &optional arg &rest ignored)
|
||||
"`company-mode' completion backend for abbrev."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-abbrev
|
||||
'company-abbrev-insert))
|
||||
(prefix (company-grab-symbol))
|
||||
(candidates (nconc
|
||||
(delete "" (all-completions arg global-abbrev-table))
|
||||
(delete "" (all-completions arg local-abbrev-table))))
|
||||
(meta (abbrev-expansion arg))))
|
||||
|
||||
(provide 'company-abbrev)
|
||||
;;; company-abbrev.el ends here
|
||||
@@ -1,298 +0,0 @@
|
||||
;;; company-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||
|
||||
;;;### (autoloads nil "company" "company.el" (22490 24940 331394
|
||||
;;;;;; 500000))
|
||||
;;; Generated autoloads from company.el
|
||||
|
||||
(autoload 'company-mode "company" "\
|
||||
\"complete anything\"; is an in-buffer completion framework.
|
||||
Completion starts automatically, depending on the values
|
||||
`company-idle-delay' and `company-minimum-prefix-length'.
|
||||
|
||||
Completion can be controlled with the commands:
|
||||
`company-complete-common', `company-complete-selection', `company-complete',
|
||||
`company-select-next', `company-select-previous'. If these commands are
|
||||
called before `company-idle-delay', completion will also start.
|
||||
|
||||
Completions can be searched with `company-search-candidates' or
|
||||
`company-filter-candidates'. These can be used while completion is
|
||||
inactive, as well.
|
||||
|
||||
The completion data is retrieved using `company-backends' and displayed
|
||||
using `company-frontends'. If you want to start a specific backend, call
|
||||
it interactively or use `company-begin-backend'.
|
||||
|
||||
By default, the completions list is sorted alphabetically, unless the
|
||||
backend chooses otherwise, or `company-transformers' changes it later.
|
||||
|
||||
regular keymap (`company-mode-map'):
|
||||
|
||||
\\{company-mode-map}
|
||||
keymap during active completions (`company-active-map'):
|
||||
|
||||
\\{company-active-map}
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(defvar global-company-mode nil "\
|
||||
Non-nil if Global-Company mode is enabled.
|
||||
See the command `global-company-mode' for a description of this minor mode.
|
||||
Setting this variable directly does not take effect;
|
||||
either customize it (see the info node `Easy Customization')
|
||||
or call the function `global-company-mode'.")
|
||||
|
||||
(custom-autoload 'global-company-mode "company" nil)
|
||||
|
||||
(autoload 'global-company-mode "company" "\
|
||||
Toggle Company mode in all buffers.
|
||||
With prefix ARG, enable Global-Company mode if ARG is positive;
|
||||
otherwise, disable it. If called from Lisp, enable the mode if
|
||||
ARG is omitted or nil.
|
||||
|
||||
Company mode is enabled in all buffers where
|
||||
`company-mode-on' would do it.
|
||||
See `company-mode' for more information on Company mode.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(autoload 'company-manual-begin "company" "\
|
||||
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'company-complete "company" "\
|
||||
Insert the common part of all candidates or the current selection.
|
||||
The first time this is called, the common part is inserted, the second
|
||||
time, or when the selection has been changed, the selected candidate is
|
||||
inserted.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-abbrev" "company-abbrev.el" (22490
|
||||
;;;;;; 24940 399394 311000))
|
||||
;;; Generated autoloads from company-abbrev.el
|
||||
|
||||
(autoload 'company-abbrev "company-abbrev" "\
|
||||
`company-mode' completion backend for abbrev.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-bbdb" "company-bbdb.el" (22490 24940
|
||||
;;;;;; 379394 367000))
|
||||
;;; Generated autoloads from company-bbdb.el
|
||||
|
||||
(autoload 'company-bbdb "company-bbdb" "\
|
||||
`company-mode' completion backend for BBDB.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORE)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-css" "company-css.el" (22490 24940
|
||||
;;;;;; 327394 512000))
|
||||
;;; Generated autoloads from company-css.el
|
||||
|
||||
(autoload 'company-css "company-css" "\
|
||||
`company-mode' completion backend for `css-mode'.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-dabbrev" "company-dabbrev.el" (22490
|
||||
;;;;;; 24940 355394 433000))
|
||||
;;; Generated autoloads from company-dabbrev.el
|
||||
|
||||
(autoload 'company-dabbrev "company-dabbrev" "\
|
||||
dabbrev-like `company-mode' completion backend.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-dabbrev-code" "company-dabbrev-code.el"
|
||||
;;;;;; (22490 24940 347394 456000))
|
||||
;;; Generated autoloads from company-dabbrev-code.el
|
||||
|
||||
(autoload 'company-dabbrev-code "company-dabbrev-code" "\
|
||||
dabbrev-like `company-mode' backend for code.
|
||||
The backend looks for all symbols in the current buffer that aren't in
|
||||
comments or strings.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-elisp" "company-elisp.el" (22490 24940
|
||||
;;;;;; 407394 288000))
|
||||
;;; Generated autoloads from company-elisp.el
|
||||
|
||||
(autoload 'company-elisp "company-elisp" "\
|
||||
`company-mode' completion backend for Emacs Lisp.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-etags" "company-etags.el" (22490 24940
|
||||
;;;;;; 339394 478000))
|
||||
;;; Generated autoloads from company-etags.el
|
||||
|
||||
(autoload 'company-etags "company-etags" "\
|
||||
`company-mode' completion backend for etags.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-files" "company-files.el" (22490 24940
|
||||
;;;;;; 363394 410000))
|
||||
;;; Generated autoloads from company-files.el
|
||||
|
||||
(autoload 'company-files "company-files" "\
|
||||
`company-mode' completion backend existing file names.
|
||||
Completions works for proper absolute and relative files paths.
|
||||
File paths with spaces are only supported inside strings.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-gtags" "company-gtags.el" (22490 24940
|
||||
;;;;;; 299394 590000))
|
||||
;;; Generated autoloads from company-gtags.el
|
||||
|
||||
(autoload 'company-gtags "company-gtags" "\
|
||||
`company-mode' completion backend for GNU Global.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-ispell" "company-ispell.el" (22490
|
||||
;;;;;; 24940 403394 299000))
|
||||
;;; Generated autoloads from company-ispell.el
|
||||
|
||||
(autoload 'company-ispell "company-ispell" "\
|
||||
`company-mode' completion backend using Ispell.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-keywords" "company-keywords.el" (22490
|
||||
;;;;;; 24940 371394 389000))
|
||||
;;; Generated autoloads from company-keywords.el
|
||||
|
||||
(autoload 'company-keywords "company-keywords" "\
|
||||
`company-mode' backend for programming language keywords.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-nxml" "company-nxml.el" (22490 24940
|
||||
;;;;;; 383394 355000))
|
||||
;;; Generated autoloads from company-nxml.el
|
||||
|
||||
(autoload 'company-nxml "company-nxml" "\
|
||||
`company-mode' completion backend for `nxml-mode'.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-oddmuse" "company-oddmuse.el" (22490
|
||||
;;;;;; 24940 319394 534000))
|
||||
;;; Generated autoloads from company-oddmuse.el
|
||||
|
||||
(autoload 'company-oddmuse "company-oddmuse" "\
|
||||
`company-mode' completion backend for `oddmuse-mode'.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-semantic" "company-semantic.el" (22490
|
||||
;;;;;; 24940 303394 579000))
|
||||
;;; Generated autoloads from company-semantic.el
|
||||
|
||||
(autoload 'company-semantic "company-semantic" "\
|
||||
`company-mode' completion backend using CEDET Semantic.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-tempo" "company-tempo.el" (22490 24940
|
||||
;;;;;; 351394 444000))
|
||||
;;; Generated autoloads from company-tempo.el
|
||||
|
||||
(autoload 'company-tempo "company-tempo" "\
|
||||
`company-mode' completion backend for tempo.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-xcode" "company-xcode.el" (22490 24940
|
||||
;;;;;; 395394 322000))
|
||||
;;; Generated autoloads from company-xcode.el
|
||||
|
||||
(autoload 'company-xcode "company-xcode" "\
|
||||
`company-mode' completion backend for Xcode projects.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "company-yasnippet" "company-yasnippet.el"
|
||||
;;;;;; (22490 24940 391394 333000))
|
||||
;;; Generated autoloads from company-yasnippet.el
|
||||
|
||||
(autoload 'company-yasnippet "company-yasnippet" "\
|
||||
`company-mode' backend for `yasnippet'.
|
||||
|
||||
This backend should be used with care, because as long as there are
|
||||
snippets defined for the current major mode, this backend will always
|
||||
shadow backends that come after it. Recommended usages:
|
||||
|
||||
* In a buffer-local value of `company-backends', grouped with a backend or
|
||||
several that provide actual text completions.
|
||||
|
||||
(add-hook 'js-mode-hook
|
||||
(lambda ()
|
||||
(set (make-local-variable 'company-backends)
|
||||
'((company-dabbrev-code company-yasnippet)))))
|
||||
|
||||
* After keyword `:with', grouped with other backends.
|
||||
|
||||
(push '(company-semantic :with company-yasnippet) company-backends)
|
||||
|
||||
* Not in `company-backends', just bound to a key.
|
||||
|
||||
(global-set-key (kbd \"C-c y\") 'company-yasnippet)
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORE)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("company-capf.el" "company-clang.el" "company-cmake.el"
|
||||
;;;;;; "company-eclim.el" "company-pkg.el" "company-template.el")
|
||||
;;;;;; (22490 24940 420783 348000))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; company-autoloads.el ends here
|
||||
@@ -1,61 +0,0 @@
|
||||
;;; company-bbdb.el --- company-mode completion backend for BBDB in message-mode
|
||||
|
||||
;; Copyright (C) 2013-2014, 2016 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Jan Tatarik <jan.tatarik@gmail.com>
|
||||
|
||||
;; 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/>.
|
||||
|
||||
(require 'company)
|
||||
(require 'cl-lib)
|
||||
|
||||
(declare-function bbdb-record-get-field "bbdb")
|
||||
(declare-function bbdb-records "bbdb")
|
||||
(declare-function bbdb-dwim-mail "bbdb-com")
|
||||
(declare-function bbdb-search "bbdb-com")
|
||||
|
||||
(defgroup company-bbdb nil
|
||||
"Completion backend for BBDB."
|
||||
:group 'company)
|
||||
|
||||
(defcustom company-bbdb-modes '(message-mode)
|
||||
"Major modes in which `company-bbdb' may complete."
|
||||
:type '(repeat (symbol :tag "Major mode"))
|
||||
:package-version '(company . "0.8.8"))
|
||||
|
||||
(defun company-bbdb--candidates (arg)
|
||||
(cl-mapcan (lambda (record)
|
||||
(mapcar (lambda (mail) (bbdb-dwim-mail record mail))
|
||||
(bbdb-record-get-field record 'mail)))
|
||||
(eval '(bbdb-search (bbdb-records) arg nil arg))))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-bbdb (command &optional arg &rest ignore)
|
||||
"`company-mode' completion backend for BBDB."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-bbdb))
|
||||
(prefix (and (memq major-mode company-bbdb-modes)
|
||||
(featurep 'bbdb-com)
|
||||
(looking-back "^\\(To\\|Cc\\|Bcc\\): *.*? *\\([^,;]*\\)"
|
||||
(line-beginning-position))
|
||||
(match-string-no-properties 2)))
|
||||
(candidates (company-bbdb--candidates arg))
|
||||
(sorted t)
|
||||
(no-cache t)))
|
||||
|
||||
(provide 'company-bbdb)
|
||||
;;; company-bbdb.el ends here
|
||||
@@ -1,167 +0,0 @@
|
||||
;;; company-capf.el --- company-mode completion-at-point-functions backend -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
;; 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 'cl-lib)
|
||||
|
||||
(defvar company--capf-cache nil)
|
||||
|
||||
(defun company--capf-data ()
|
||||
(let ((cache company--capf-cache))
|
||||
(if (and (equal (current-buffer) (car cache))
|
||||
(equal (point) (car (setq cache (cdr cache))))
|
||||
(equal (buffer-chars-modified-tick) (car (setq cache (cdr cache)))))
|
||||
(cadr cache)
|
||||
(let ((data (company--capf-data-real)))
|
||||
(setq company--capf-cache
|
||||
(list (current-buffer) (point) (buffer-chars-modified-tick) data))
|
||||
data))))
|
||||
|
||||
(defun company--capf-data-real ()
|
||||
(cl-letf* (((default-value 'completion-at-point-functions)
|
||||
;; Ignore tags-completion-at-point-function because it subverts
|
||||
;; company-etags in the default value of company-backends, where
|
||||
;; the latter comes later.
|
||||
(remove 'tags-completion-at-point-function
|
||||
(default-value 'completion-at-point-functions)))
|
||||
(completion-at-point-functions (company--capf-workaround))
|
||||
(data (run-hook-wrapped 'completion-at-point-functions
|
||||
;; Ignore misbehaving functions.
|
||||
#'completion--capf-wrapper 'optimist)))
|
||||
(when (and (consp (cdr data)) (integer-or-marker-p (nth 1 data))) data)))
|
||||
|
||||
(declare-function python-shell-get-process "python")
|
||||
|
||||
(defun company--capf-workaround ()
|
||||
;; For http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18067
|
||||
(if (or (not (listp completion-at-point-functions))
|
||||
(not (memq 'python-completion-complete-at-point completion-at-point-functions))
|
||||
(python-shell-get-process))
|
||||
completion-at-point-functions
|
||||
(remq 'python-completion-complete-at-point completion-at-point-functions)))
|
||||
|
||||
(defun company-capf (command &optional arg &rest _args)
|
||||
"`company-mode' backend using `completion-at-point-functions'."
|
||||
(interactive (list 'interactive))
|
||||
(pcase command
|
||||
(`interactive (company-begin-backend 'company-capf))
|
||||
(`prefix
|
||||
(let ((res (company--capf-data)))
|
||||
(when res
|
||||
(let ((length (plist-get (nthcdr 4 res) :company-prefix-length))
|
||||
(prefix (buffer-substring-no-properties (nth 1 res) (point))))
|
||||
(cond
|
||||
((> (nth 2 res) (point)) 'stop)
|
||||
(length (cons prefix length))
|
||||
(t prefix))))))
|
||||
(`candidates
|
||||
(let ((res (company--capf-data)))
|
||||
(when res
|
||||
(let* ((table (nth 3 res))
|
||||
(pred (plist-get (nthcdr 4 res) :predicate))
|
||||
(meta (completion-metadata
|
||||
(buffer-substring (nth 1 res) (nth 2 res))
|
||||
table pred))
|
||||
(sortfun (cdr (assq 'display-sort-function meta)))
|
||||
(candidates (completion-all-completions arg table pred (length arg)))
|
||||
(last (last candidates))
|
||||
(base-size (and (numberp (cdr last)) (cdr last))))
|
||||
(when base-size
|
||||
(setcdr last nil))
|
||||
(when sortfun
|
||||
(setq candidates (funcall sortfun candidates)))
|
||||
(if (not (zerop (or base-size 0)))
|
||||
(let ((before (substring arg 0 base-size)))
|
||||
(mapcar (lambda (candidate)
|
||||
(concat before candidate))
|
||||
candidates))
|
||||
candidates)))))
|
||||
(`sorted
|
||||
(let ((res (company--capf-data)))
|
||||
(when res
|
||||
(let ((meta (completion-metadata
|
||||
(buffer-substring (nth 1 res) (nth 2 res))
|
||||
(nth 3 res) (plist-get (nthcdr 4 res) :predicate))))
|
||||
(cdr (assq 'display-sort-function meta))))))
|
||||
(`match
|
||||
;; Can't just use 0 when base-size (see above) is non-zero.
|
||||
(let ((start (if (get-text-property 0 'face arg)
|
||||
0
|
||||
(next-single-property-change 0 'face arg))))
|
||||
(when start
|
||||
;; completions-common-part comes first, but we can't just look for this
|
||||
;; value because it can be in a list.
|
||||
(or
|
||||
(let ((value (get-text-property start 'face arg)))
|
||||
(text-property-not-all start (length arg)
|
||||
'face value arg))
|
||||
(length arg)))))
|
||||
(`duplicates t)
|
||||
(`no-cache t) ;Not much can be done here, as long as we handle
|
||||
;non-prefix matches.
|
||||
(`meta
|
||||
(let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-docsig)))
|
||||
(when f (funcall f arg))))
|
||||
(`doc-buffer
|
||||
(let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-doc-buffer)))
|
||||
(when f (funcall f arg))))
|
||||
(`location
|
||||
(let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-location)))
|
||||
(when f (funcall f arg))))
|
||||
(`annotation
|
||||
(save-excursion
|
||||
;; FIXME: `company-begin' sets `company-point' after calling
|
||||
;; `company--begin-new'. We shouldn't rely on `company-point' here,
|
||||
;; better to cache the capf-data value instead. However: we can't just
|
||||
;; save the last capf-data value in `prefix', because that command can
|
||||
;; get called more often than `candidates', and at any point in the
|
||||
;; buffer (https://github.com/company-mode/company-mode/issues/153).
|
||||
;; We could try propertizing the returned prefix string, but it's not
|
||||
;; passed to `annotation', and `company-prefix' is set only after
|
||||
;; `company--strip-duplicates' is called.
|
||||
(when company-point
|
||||
(goto-char company-point))
|
||||
(let ((f (plist-get (nthcdr 4 (company--capf-data)) :annotation-function)))
|
||||
(when f (funcall f arg)))))
|
||||
(`require-match
|
||||
(plist-get (nthcdr 4 (company--capf-data)) :company-require-match))
|
||||
(`init nil) ;Don't bother: plenty of other ways to initialize the code.
|
||||
(`post-completion
|
||||
(let* ((res (company--capf-data))
|
||||
(exit-function (plist-get (nthcdr 4 res) :exit-function))
|
||||
(table (nth 3 res))
|
||||
(pred (plist-get (nthcdr 4 res) :predicate)))
|
||||
(if exit-function
|
||||
;; Follow the example of `completion--done'.
|
||||
(funcall exit-function arg
|
||||
(if (eq (try-completion arg table pred) t)
|
||||
'finished 'sole)))))
|
||||
))
|
||||
|
||||
(provide 'company-capf)
|
||||
|
||||
;;; company-capf.el ends here
|
||||
@@ -1,331 +0,0 @@
|
||||
;;; 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 "\\((.*)[ 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 (apply #'start-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
|
||||
@@ -1,198 +0,0 @@
|
||||
;;; company-cmake.el --- company-mode completion backend for CMake
|
||||
|
||||
;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Chen Bin <chenbin DOT sh AT gmail>
|
||||
;; Version: 0.2
|
||||
|
||||
;; 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:
|
||||
;;
|
||||
;; company-cmake offers completions for module names, variable names and
|
||||
;; commands used by CMake. And their descriptions.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'company)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defgroup company-cmake nil
|
||||
"Completion backend for CMake."
|
||||
:group 'company)
|
||||
|
||||
(defcustom company-cmake-executable
|
||||
(executable-find "cmake")
|
||||
"Location of cmake executable."
|
||||
:type 'file)
|
||||
|
||||
(defvar company-cmake-executable-arguments
|
||||
'("--help-command-list"
|
||||
"--help-module-list"
|
||||
"--help-variable-list")
|
||||
"The arguments we pass to cmake, separately.
|
||||
They affect which types of symbols we get completion candidates for.")
|
||||
|
||||
(defvar company-cmake--completion-pattern
|
||||
"^\\(%s[a-zA-Z0-9_<>]%s\\)$"
|
||||
"Regexp to match the candidates.")
|
||||
|
||||
(defvar company-cmake-modes '(cmake-mode)
|
||||
"Major modes in which cmake may complete.")
|
||||
|
||||
(defvar company-cmake--candidates-cache nil
|
||||
"Cache for the raw candidates.")
|
||||
|
||||
(defvar company-cmake--meta-command-cache nil
|
||||
"Cache for command arguments to retrieve descriptions for the candidates.")
|
||||
|
||||
(defun company-cmake--replace-tags (rlt)
|
||||
(setq rlt (replace-regexp-in-string
|
||||
"\\(.*?\\(IS_GNU\\)?\\)<LANG>\\(.*\\)"
|
||||
(lambda (_match)
|
||||
(mapconcat 'identity
|
||||
(if (match-beginning 2)
|
||||
'("\\1CXX\\3" "\\1C\\3" "\\1G77\\3")
|
||||
'("\\1CXX\\3" "\\1C\\3" "\\1Fortran\\3"))
|
||||
"\n"))
|
||||
rlt t))
|
||||
(setq rlt (replace-regexp-in-string
|
||||
"\\(.*\\)<CONFIG>\\(.*\\)"
|
||||
(mapconcat 'identity '("\\1DEBUG\\2" "\\1RELEASE\\2"
|
||||
"\\1RELWITHDEBINFO\\2" "\\1MINSIZEREL\\2")
|
||||
"\n")
|
||||
rlt))
|
||||
rlt)
|
||||
|
||||
(defun company-cmake--fill-candidates-cache (arg)
|
||||
"Fill candidates cache if needed."
|
||||
(let (rlt)
|
||||
(unless company-cmake--candidates-cache
|
||||
(setq company-cmake--candidates-cache (make-hash-table :test 'equal)))
|
||||
|
||||
;; If hash is empty, fill it.
|
||||
(unless (gethash arg company-cmake--candidates-cache)
|
||||
(with-temp-buffer
|
||||
(let ((res (call-process company-cmake-executable nil t nil arg)))
|
||||
(unless (zerop res)
|
||||
(message "cmake executable exited with error=%d" res)))
|
||||
(setq rlt (buffer-string)))
|
||||
(setq rlt (company-cmake--replace-tags rlt))
|
||||
(puthash arg rlt company-cmake--candidates-cache))
|
||||
))
|
||||
|
||||
(defun company-cmake--parse (prefix content cmd)
|
||||
(let ((start 0)
|
||||
(pattern (format company-cmake--completion-pattern
|
||||
(regexp-quote prefix)
|
||||
(if (zerop (length prefix)) "+" "*")))
|
||||
(lines (split-string content "\n"))
|
||||
match
|
||||
rlt)
|
||||
(dolist (line lines)
|
||||
(when (string-match pattern line)
|
||||
(let ((match (match-string 1 line)))
|
||||
(when match
|
||||
(puthash match cmd company-cmake--meta-command-cache)
|
||||
(push match rlt)))))
|
||||
rlt))
|
||||
|
||||
(defun company-cmake--candidates (prefix)
|
||||
(let (results
|
||||
cmd-opts
|
||||
str)
|
||||
|
||||
(unless company-cmake--meta-command-cache
|
||||
(setq company-cmake--meta-command-cache (make-hash-table :test 'equal)))
|
||||
|
||||
(dolist (arg company-cmake-executable-arguments)
|
||||
(company-cmake--fill-candidates-cache arg)
|
||||
(setq cmd-opts (replace-regexp-in-string "-list$" "" arg) )
|
||||
|
||||
(setq str (gethash arg company-cmake--candidates-cache))
|
||||
(when str
|
||||
(setq results (nconc results
|
||||
(company-cmake--parse prefix str cmd-opts)))))
|
||||
results))
|
||||
|
||||
(defun company-cmake--unexpand-candidate (candidate)
|
||||
(cond
|
||||
((string-match "^CMAKE_\\(C\\|CXX\\|Fortran\\)\\(_.*\\)$" candidate)
|
||||
(setq candidate (concat "CMAKE_<LANG>" (match-string 2 candidate))))
|
||||
|
||||
;; C flags
|
||||
((string-match "^\\(.*_\\)IS_GNU\\(C\\|CXX\\|G77\\)$" candidate)
|
||||
(setq candidate (concat (match-string 1 candidate) "IS_GNU<LANG>")))
|
||||
|
||||
;; C flags
|
||||
((string-match "^\\(.*_\\)OVERRIDE_\\(C\\|CXX\\|Fortran\\)$" candidate)
|
||||
(setq candidate (concat (match-string 1 candidate) "OVERRIDE_<LANG>")))
|
||||
|
||||
((string-match "^\\(.*\\)\\(_DEBUG\\|_RELEASE\\|_RELWITHDEBINFO\\|_MINSIZEREL\\)\\(.*\\)$" candidate)
|
||||
(setq candidate (concat (match-string 1 candidate)
|
||||
"_<CONFIG>"
|
||||
(match-string 3 candidate)))))
|
||||
candidate)
|
||||
|
||||
(defun company-cmake--meta (candidate)
|
||||
(let ((cmd-opts (gethash candidate company-cmake--meta-command-cache))
|
||||
result)
|
||||
(setq candidate (company-cmake--unexpand-candidate candidate))
|
||||
|
||||
;; Don't cache the documentation of every candidate (command)
|
||||
;; Cache in this case will cost too much memory.
|
||||
(with-temp-buffer
|
||||
(call-process company-cmake-executable nil t nil cmd-opts candidate)
|
||||
;; Go to the third line, trim it and return the result.
|
||||
;; Tested with cmake 2.8.9.
|
||||
(goto-char (point-min))
|
||||
(forward-line 2)
|
||||
(setq result (buffer-substring-no-properties (line-beginning-position)
|
||||
(line-end-position)))
|
||||
(setq result (replace-regexp-in-string "^[ \t\n\r]+" "" result))
|
||||
result)))
|
||||
|
||||
(defun company-cmake--doc-buffer (candidate)
|
||||
(let ((cmd-opts (gethash candidate company-cmake--meta-command-cache)))
|
||||
|
||||
(setq candidate (company-cmake--unexpand-candidate candidate))
|
||||
(with-temp-buffer
|
||||
(call-process company-cmake-executable nil t nil cmd-opts candidate)
|
||||
;; Go to the third line, trim it and return the doc buffer.
|
||||
;; Tested with cmake 2.8.9.
|
||||
(goto-char (point-min))
|
||||
(forward-line 2)
|
||||
(company-doc-buffer
|
||||
(buffer-substring-no-properties (line-beginning-position)
|
||||
(point-max))))))
|
||||
|
||||
(defun company-cmake (command &optional arg &rest ignored)
|
||||
"`company-mode' completion backend for CMake.
|
||||
CMake is a cross-platform, open-source make system."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-cmake))
|
||||
(init (when (memq major-mode company-cmake-modes)
|
||||
(unless company-cmake-executable
|
||||
(error "Company found no cmake executable"))))
|
||||
(prefix (and (memq major-mode company-cmake-modes)
|
||||
(not (company-in-string-or-comment))
|
||||
(company-grab-symbol)))
|
||||
(candidates (company-cmake--candidates arg))
|
||||
(meta (company-cmake--meta arg))
|
||||
(doc-buffer (company-cmake--doc-buffer arg))
|
||||
))
|
||||
|
||||
(provide 'company-cmake)
|
||||
;;; company-cmake.el ends here
|
||||
@@ -1,442 +0,0 @@
|
||||
;;; company-css.el --- company-mode completion backend for css-mode -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2009, 2011, 2014 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 'cl-lib)
|
||||
|
||||
(declare-function web-mode-language-at-pos "web-mode" (&optional pos))
|
||||
|
||||
(defconst company-css-property-alist
|
||||
;; see http://www.w3.org/TR/CSS21/propidx.html
|
||||
'(("azimuth" angle "left-side" "far-left" "left" "center-left" "center"
|
||||
"center-right" "right" "far-right" "right-side" "behind" "leftwards"
|
||||
"rightwards")
|
||||
("background" background-color background-image background-repeat
|
||||
background-attachment background-position
|
||||
background-clip background-origin background-size)
|
||||
("background-attachment" "scroll" "fixed")
|
||||
("background-color" color "transparent")
|
||||
("background-image" uri "none")
|
||||
("background-position" percentage length "left" "center" "right" percentage
|
||||
length "top" "center" "bottom" "left" "center" "right" "top" "center"
|
||||
"bottom")
|
||||
("background-repeat" "repeat" "repeat-x" "repeat-y" "no-repeat")
|
||||
("border" border-width border-style border-color)
|
||||
("border-bottom" border)
|
||||
("border-bottom-color" border-color)
|
||||
("border-bottom-style" border-style)
|
||||
("border-bottom-width" border-width)
|
||||
("border-collapse" "collapse" "separate")
|
||||
("border-color" color "transparent")
|
||||
("border-left" border)
|
||||
("border-left-color" border-color)
|
||||
("border-left-style" border-style)
|
||||
("border-left-width" border-width)
|
||||
("border-right" border)
|
||||
("border-right-color" border-color)
|
||||
("border-right-style" border-style)
|
||||
("border-right-width" border-width)
|
||||
("border-spacing" length length)
|
||||
("border-style" border-style)
|
||||
("border-top" border)
|
||||
("border-top-color" border-color)
|
||||
("border-top-style" border-style)
|
||||
("border-top-width" border-width)
|
||||
("border-width" border-width)
|
||||
("bottom" length percentage "auto")
|
||||
("caption-side" "top" "bottom")
|
||||
("clear" "none" "left" "right" "both")
|
||||
("clip" shape "auto")
|
||||
("color" color)
|
||||
("content" "normal" "none" string uri counter "attr()" "open-quote"
|
||||
"close-quote" "no-open-quote" "no-close-quote")
|
||||
("counter-increment" identifier integer "none")
|
||||
("counter-reset" identifier integer "none")
|
||||
("cue" cue-before cue-after)
|
||||
("cue-after" uri "none")
|
||||
("cue-before" uri "none")
|
||||
("cursor" uri "*" "auto" "crosshair" "default" "pointer" "move" "e-resize"
|
||||
"ne-resize" "nw-resize" "n-resize" "se-resize" "sw-resize" "s-resize"
|
||||
"w-resize" "text" "wait" "help" "progress")
|
||||
("direction" "ltr" "rtl")
|
||||
("display" "inline" "block" "list-item" "run-in" "inline-block" "table"
|
||||
"inline-table" "table-row-group" "table-header-group" "table-footer-group"
|
||||
"table-row" "table-column-group" "table-column" "table-cell"
|
||||
"table-caption" "none")
|
||||
("elevation" angle "below" "level" "above" "higher" "lower")
|
||||
("empty-cells" "show" "hide")
|
||||
("float" "left" "right" "none")
|
||||
("font" font-style font-weight font-size "/" line-height
|
||||
font-family "caption" "icon" "menu" "message-box" "small-caption"
|
||||
"status-bar" "normal" "small-caps"
|
||||
;; CSS3
|
||||
font-stretch)
|
||||
("font-family" family-name generic-family)
|
||||
("font-size" absolute-size relative-size length percentage)
|
||||
("font-style" "normal" "italic" "oblique")
|
||||
("font-weight" "normal" "bold" "bolder" "lighter" "100" "200" "300" "400"
|
||||
"500" "600" "700" "800" "900")
|
||||
("height" length percentage "auto")
|
||||
("left" length percentage "auto")
|
||||
("letter-spacing" "normal" length)
|
||||
("line-height" "normal" number length percentage)
|
||||
("list-style" list-style-type list-style-position list-style-image)
|
||||
("list-style-image" uri "none")
|
||||
("list-style-position" "inside" "outside")
|
||||
("list-style-type" "disc" "circle" "square" "decimal" "decimal-leading-zero"
|
||||
"lower-roman" "upper-roman" "lower-greek" "lower-latin" "upper-latin"
|
||||
"armenian" "georgian" "lower-alpha" "upper-alpha" "none")
|
||||
("margin" margin-width)
|
||||
("margin-bottom" margin-width)
|
||||
("margin-left" margin-width)
|
||||
("margin-right" margin-width)
|
||||
("margin-top" margin-width)
|
||||
("max-height" length percentage "none")
|
||||
("max-width" length percentage "none")
|
||||
("min-height" length percentage)
|
||||
("min-width" length percentage)
|
||||
("orphans" integer)
|
||||
("outline" outline-color outline-style outline-width)
|
||||
("outline-color" color "invert")
|
||||
("outline-style" border-style)
|
||||
("outline-width" border-width)
|
||||
("overflow" "visible" "hidden" "scroll" "auto"
|
||||
;; CSS3:
|
||||
"no-display" "no-content")
|
||||
("padding" padding-width)
|
||||
("padding-bottom" padding-width)
|
||||
("padding-left" padding-width)
|
||||
("padding-right" padding-width)
|
||||
("padding-top" padding-width)
|
||||
("page-break-after" "auto" "always" "avoid" "left" "right")
|
||||
("page-break-before" "auto" "always" "avoid" "left" "right")
|
||||
("page-break-inside" "avoid" "auto")
|
||||
("pause" time percentage)
|
||||
("pause-after" time percentage)
|
||||
("pause-before" time percentage)
|
||||
("pitch" frequency "x-low" "low" "medium" "high" "x-high")
|
||||
("pitch-range" number)
|
||||
("play-during" uri "mix" "repeat" "auto" "none")
|
||||
("position" "static" "relative" "absolute" "fixed")
|
||||
("quotes" string string "none")
|
||||
("richness" number)
|
||||
("right" length percentage "auto")
|
||||
("speak" "normal" "none" "spell-out")
|
||||
("speak-header" "once" "always")
|
||||
("speak-numeral" "digits" "continuous")
|
||||
("speak-punctuation" "code" "none")
|
||||
("speech-rate" number "x-slow" "slow" "medium" "fast" "x-fast" "faster"
|
||||
"slower")
|
||||
("stress" number)
|
||||
("table-layout" "auto" "fixed")
|
||||
("text-align" "left" "right" "center" "justify")
|
||||
("text-indent" length percentage)
|
||||
("text-transform" "capitalize" "uppercase" "lowercase" "none")
|
||||
("top" length percentage "auto")
|
||||
("unicode-bidi" "normal" "embed" "bidi-override")
|
||||
("vertical-align" "baseline" "sub" "super" "top" "text-top" "middle"
|
||||
"bottom" "text-bottom" percentage length)
|
||||
("visibility" "visible" "hidden" "collapse")
|
||||
("voice-family" specific-voice generic-voice "*" specific-voice
|
||||
generic-voice)
|
||||
("volume" number percentage "silent" "x-soft" "soft" "medium" "loud"
|
||||
"x-loud")
|
||||
("white-space" "normal" "pre" "nowrap" "pre-wrap" "pre-line")
|
||||
("widows" integer)
|
||||
("width" length percentage "auto")
|
||||
("word-spacing" "normal" length)
|
||||
("z-index" "auto" integer)
|
||||
;; CSS3
|
||||
("align-content" align-stretch "space-between" "space-around")
|
||||
("align-items" align-stretch "baseline")
|
||||
("align-self" align-items "auto")
|
||||
("animation" animation-name animation-duration animation-timing-function
|
||||
animation-delay animation-iteration-count animation-direction
|
||||
animation-fill-mode)
|
||||
("animation-delay" time)
|
||||
("animation-direction" "normal" "reverse" "alternate" "alternate-reverse")
|
||||
("animation-duration" time)
|
||||
("animation-fill-mode" "none" "forwards" "backwards" "both")
|
||||
("animation-iteration-count" integer "infinite")
|
||||
("animation-name" "none")
|
||||
("animation-play-state" "paused" "running")
|
||||
("animation-timing-function" transition-timing-function
|
||||
"step-start" "step-end" "steps(,)")
|
||||
("backface-visibility" "visible" "hidden")
|
||||
("background-clip" background-origin)
|
||||
("background-origin" "border-box" "padding-box" "content-box")
|
||||
("background-size" length percentage "auto" "cover" "contain")
|
||||
("border-image" border-image-outset border-image-repeat border-image-source
|
||||
border-image-slice border-image-width)
|
||||
("border-image-outset" length)
|
||||
("border-image-repeat" "stretch" "repeat" "round" "space")
|
||||
("border-image-source" uri "none")
|
||||
("border-image-slice" length)
|
||||
("border-image-width" length percentage)
|
||||
("border-radius" length)
|
||||
("border-top-left-radius" length)
|
||||
("border-top-right-radius" length)
|
||||
("border-bottom-left-radius" length)
|
||||
("border-bottom-right-radius" length)
|
||||
("box-decoration-break" "slice" "clone")
|
||||
("box-shadow" length color)
|
||||
("box-sizing" "content-box" "border-box")
|
||||
("break-after" "auto" "always" "avoid" "left" "right" "page" "column"
|
||||
"avoid-page" "avoid-column")
|
||||
("break-before" break-after)
|
||||
("break-inside" "avoid" "auto")
|
||||
("columns" column-width column-count)
|
||||
("column-count" integer)
|
||||
("column-fill" "auto" "balance")
|
||||
("column-gap" length "normal")
|
||||
("column-rule" column-rule-width column-rule-style column-rule-color)
|
||||
("column-rule-color" color)
|
||||
("column-rule-style" border-style)
|
||||
("column-rule-width" border-width)
|
||||
("column-span" "all" "none")
|
||||
("column-width" length "auto")
|
||||
("filter" url "blur()" "brightness()" "contrast()" "drop-shadow()"
|
||||
"grayscale()" "hue-rotate()" "invert()" "opacity()" "saturate()" "sepia()")
|
||||
("flex" flex-grow flex-shrink flex-basis)
|
||||
("flex-basis" percentage length "auto")
|
||||
("flex-direction" "row" "row-reverse" "column" "column-reverse")
|
||||
("flex-flow" flex-direction flex-wrap)
|
||||
("flex-grow" number)
|
||||
("flex-shrink" number)
|
||||
("flex-wrap" "nowrap" "wrap" "wrap-reverse")
|
||||
("font-feature-setting" normal string number)
|
||||
("font-kerning" "auto" "normal" "none")
|
||||
("font-language-override" "normal" string)
|
||||
("font-size-adjust" "none" number)
|
||||
("font-stretch" "normal" "ultra-condensed" "extra-condensed" "condensed"
|
||||
"semi-condensed" "semi-expanded" "expanded" "extra-expanded" "ultra-expanded")
|
||||
("font-synthesis" "none" "weight" "style")
|
||||
("font-variant" font-variant-alternates font-variant-caps
|
||||
font-variant-east-asian font-variant-ligatures font-variant-numeric
|
||||
font-variant-position)
|
||||
("font-variant-alternates" "normal" "historical-forms" "stylistic()"
|
||||
"styleset()" "character-variant()" "swash()" "ornaments()" "annotation()")
|
||||
("font-variant-caps" "normal" "small-caps" "all-small-caps" "petite-caps"
|
||||
"all-petite-caps" "unicase" "titling-caps")
|
||||
("font-variant-east-asian" "jis78" "jis83" "jis90" "jis04" "simplified"
|
||||
"traditional" "full-width" "proportional-width" "ruby")
|
||||
("font-variant-ligatures" "normal" "none" "common-ligatures"
|
||||
"no-common-ligatures" "discretionary-ligatures" "no-discretionary-ligatures"
|
||||
"historical-ligatures" "no-historical-ligatures" "contextual" "no-contextual")
|
||||
("font-variant-numeric" "normal" "ordinal" "slashed-zero"
|
||||
"lining-nums" "oldstyle-nums" "proportional-nums" "tabular-nums"
|
||||
"diagonal-fractions" "stacked-fractions")
|
||||
("font-variant-position" "normal" "sub" "super")
|
||||
("hyphens" "none" "manual" "auto")
|
||||
("justify-content" align-common "space-between" "space-around")
|
||||
("line-break" "auto" "loose" "normal" "strict")
|
||||
("marquee-direction" "forward" "reverse")
|
||||
("marquee-play-count" integer "infinite")
|
||||
("marquee-speed" "slow" "normal" "fast")
|
||||
("marquee-style" "scroll" "slide" "alternate")
|
||||
("opacity" number)
|
||||
("order" number)
|
||||
("outline-offset" length)
|
||||
("overflow-x" overflow)
|
||||
("overflow-y" overflow)
|
||||
("overflow-style" "auto" "marquee-line" "marquee-block")
|
||||
("overflow-wrap" "normal" "break-word")
|
||||
("perspective" "none" length)
|
||||
("perspective-origin" percentage length "left" "center" "right" "top" "bottom")
|
||||
("resize" "none" "both" "horizontal" "vertical")
|
||||
("tab-size" integer length)
|
||||
("text-align-last" "auto" "start" "end" "left" "right" "center" "justify")
|
||||
("text-decoration" text-decoration-color text-decoration-line text-decoration-style)
|
||||
("text-decoration-color" color)
|
||||
("text-decoration-line" "none" "underline" "overline" "line-through" "blink")
|
||||
("text-decoration-style" "solid" "double" "dotted" "dashed" "wavy")
|
||||
("text-overflow" "clip" "ellipsis")
|
||||
("text-shadow" color length)
|
||||
("text-underline-position" "auto" "under" "left" "right")
|
||||
("transform" "matrix(,,,,,)" "translate(,)" "translateX()" "translateY()"
|
||||
"scale()" "scaleX()" "scaleY()" "rotate()" "skewX()" "skewY()" "none")
|
||||
("transform-origin" perspective-origin)
|
||||
("transform-style" "flat" "preserve-3d")
|
||||
("transition" transition-property transition-duration
|
||||
transition-timing-function transition-delay)
|
||||
("transition-delay" time)
|
||||
("transition-duration" time)
|
||||
("transition-timing-function"
|
||||
"ease" "linear" "ease-in" "ease-out" "ease-in-out" "cubic-bezier(,,,)")
|
||||
("transition-property" "none" "all" identifier)
|
||||
("word-wrap" overflow-wrap)
|
||||
("word-break" "normal" "break-all" "keep-all"))
|
||||
"A list of CSS properties and their possible values.")
|
||||
|
||||
(defconst company-css-value-classes
|
||||
'((absolute-size "xx-small" "x-small" "small" "medium" "large" "x-large"
|
||||
"xx-large")
|
||||
(align-common "flex-start" "flex-end" "center")
|
||||
(align-stretch align-common "stretch")
|
||||
(border-style "none" "hidden" "dotted" "dashed" "solid" "double" "groove"
|
||||
"ridge" "inset" "outset")
|
||||
(border-width "thick" "medium" "thin")
|
||||
(color "aqua" "black" "blue" "fuchsia" "gray" "green" "lime" "maroon" "navy"
|
||||
"olive" "orange" "purple" "red" "silver" "teal" "white" "yellow")
|
||||
(counter "counter(,)")
|
||||
(family-name "Courier" "Helvetica" "Times")
|
||||
(generic-family "serif" "sans-serif" "cursive" "fantasy" "monospace")
|
||||
(generic-voice "male" "female" "child")
|
||||
(margin-width "auto") ;; length percentage
|
||||
(relative-size "larger" "smaller")
|
||||
(shape "rect(,,,)")
|
||||
(uri "url()"))
|
||||
"A list of CSS property value classes and their contents.")
|
||||
;; missing, because not completable
|
||||
;; <angle><frequency><identifier><integer><length><number><padding-width>
|
||||
;; <percentage><specific-voice><string><time><uri>
|
||||
|
||||
(defconst company-css-html-tags
|
||||
'("a" "abbr" "acronym" "address" "applet" "area" "b" "base" "basefont" "bdo"
|
||||
"big" "blockquote" "body" "br" "button" "caption" "center" "cite" "code"
|
||||
"col" "colgroup" "dd" "del" "dfn" "dir" "div" "dl" "dt" "em" "fieldset"
|
||||
"font" "form" "frame" "frameset" "h1" "h2" "h3" "h4" "h5" "h6" "head" "hr"
|
||||
"html" "i" "iframe" "img" "input" "ins" "isindex" "kbd" "label" "legend"
|
||||
"li" "link" "map" "menu" "meta" "noframes" "noscript" "object" "ol"
|
||||
"optgroup" "option" "p" "param" "pre" "q" "s" "samp" "script" "select"
|
||||
"small" "span" "strike" "strong" "style" "sub" "sup" "table" "tbody" "td"
|
||||
"textarea" "tfoot" "th" "thead" "title" "tr" "tt" "u" "ul" "var"
|
||||
;; HTML5
|
||||
"section" "article" "aside" "header" "footer" "nav" "figure" "figcaption"
|
||||
"time" "mark" "main")
|
||||
"A list of HTML tags for use in CSS completion.")
|
||||
|
||||
(defconst company-css-pseudo-classes
|
||||
'("active" "after" "before" "first" "first-child" "first-letter" "first-line"
|
||||
"focus" "hover" "lang" "left" "link" "right" "visited")
|
||||
"Identifiers for CSS pseudo-elements and pseudo-classes.")
|
||||
|
||||
(defconst company-css-property-cache (make-hash-table :size 115 :test 'equal))
|
||||
|
||||
(defun company-css-property-values (attribute)
|
||||
"Access the `company-css-property-alist' cached and flattened."
|
||||
(or (gethash attribute company-css-property-cache)
|
||||
(let (results)
|
||||
(dolist (value (cdr (assoc attribute company-css-property-alist)))
|
||||
(if (symbolp value)
|
||||
(dolist (child (or (cdr (assoc value company-css-value-classes))
|
||||
(company-css-property-values
|
||||
(symbol-name value))))
|
||||
(push child results))
|
||||
(push value results)))
|
||||
(setq results (sort results 'string<))
|
||||
(puthash attribute
|
||||
(if (fboundp 'delete-consecutive-dups)
|
||||
(delete-consecutive-dups results)
|
||||
(delete-dups results))
|
||||
company-css-property-cache)
|
||||
results)))
|
||||
|
||||
;;; bracket detection
|
||||
|
||||
(defconst company-css-braces-syntax-table
|
||||
(let ((table (make-syntax-table)))
|
||||
(setf (aref table ?{) '(4 . 125))
|
||||
(setf (aref table ?}) '(5 . 123))
|
||||
table)
|
||||
"A syntax table giving { and } paren syntax.")
|
||||
|
||||
(defun company-css-inside-braces-p ()
|
||||
"Return non-nil, if point is within matched { and }."
|
||||
(ignore-errors
|
||||
(with-syntax-table company-css-braces-syntax-table
|
||||
(let ((parse-sexp-ignore-comments t))
|
||||
(scan-lists (point) -1 1)))))
|
||||
|
||||
;;; tags
|
||||
(defconst company-css-tag-regexp
|
||||
(concat "\\(?:\\`\\|}\\)[[:space:]]*"
|
||||
;; multiple
|
||||
"\\(?:"
|
||||
;; previous tags:
|
||||
"\\(?:#\\|\\_<[[:alpha:]]\\)[[:alnum:]-#]*\\(?:\\[[^]]*\\]\\)?"
|
||||
;; space or selectors
|
||||
"\\(?:[[:space:]]+\\|[[:space:]]*[+,>][[:space:]]*\\)"
|
||||
"\\)*"
|
||||
"\\(\\(?:#\\|\\_<[[:alpha:]]\\)\\(?:[[:alnum:]-#]*\\_>\\)?\\_>\\|\\)"
|
||||
"\\=")
|
||||