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:]-#]*\\_>\\)?\\_>\\|\\)"
|
||||
"\\=")
|
||||
"A regular expression matching CSS tags.")
|
||||
|
||||
;;; pseudo id
|
||||
(defconst company-css-pseudo-regexp
|
||||
(concat "\\(?:\\`\\|}\\)[[:space:]]*"
|
||||
;; multiple
|
||||
"\\(?:"
|
||||
;; previous tags:
|
||||
"\\(?:#\\|\\_<[[:alpha:]]\\)[[:alnum:]-#]*\\(?:\\[[^]]*\\]\\)?"
|
||||
;; space or delimiters
|
||||
"\\(?:[[:space:]]+\\|[[:space:]]*[+,>][[:space:]]*\\)"
|
||||
"\\)*"
|
||||
"\\(?:\\(?:\\#\\|\\_<[[:alpha:]]\\)[[:alnum:]-#]*\\):"
|
||||
"\\([[:alpha:]-]+\\_>\\|\\)\\_>\\=")
|
||||
"A regular expression matching CSS pseudo classes.")
|
||||
|
||||
;;; properties
|
||||
|
||||
(defun company-css-grab-property ()
|
||||
"Return the CSS property before point, if any.
|
||||
Returns \"\" if no property found, but feasible at this position."
|
||||
(when (company-css-inside-braces-p)
|
||||
(company-grab-symbol)))
|
||||
|
||||
;;; values
|
||||
(defconst company-css-property-value-regexp
|
||||
"\\_<\\([[:alpha:]-]+\\):\\(?:[^{};]*[[:space:]]+\\)?\\([^{};]*\\_>\\|\\)\\="
|
||||
"A regular expression matching CSS tags.")
|
||||
|
||||
;;;###autoload
|
||||
(defun company-css (command &optional arg &rest ignored)
|
||||
"`company-mode' completion backend for `css-mode'."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-css))
|
||||
(prefix (and (or (derived-mode-p 'css-mode)
|
||||
(and (derived-mode-p 'web-mode)
|
||||
(string= (web-mode-language-at-pos) "css")))
|
||||
(or (company-grab company-css-tag-regexp 1)
|
||||
(company-grab company-css-pseudo-regexp 1)
|
||||
(company-grab company-css-property-value-regexp 2)
|
||||
(company-css-grab-property))))
|
||||
(candidates
|
||||
(cond
|
||||
((company-grab company-css-tag-regexp 1)
|
||||
(all-completions arg company-css-html-tags))
|
||||
((company-grab company-css-pseudo-regexp 1)
|
||||
(all-completions arg company-css-pseudo-classes))
|
||||
((company-grab company-css-property-value-regexp 2)
|
||||
(all-completions arg
|
||||
(company-css-property-values
|
||||
(company-grab company-css-property-value-regexp 1))))
|
||||
((company-css-grab-property)
|
||||
(all-completions arg company-css-property-alist))))
|
||||
(sorted t)))
|
||||
|
||||
(provide 'company-css)
|
||||
;;; company-css.el ends here
|
||||
@@ -1,104 +0,0 @@
|
||||
;;; company-dabbrev-code.el --- dabbrev-like company-mode backend for code -*- 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 'company-dabbrev)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defgroup company-dabbrev-code nil
|
||||
"dabbrev-like completion backend for code."
|
||||
:group 'company)
|
||||
|
||||
(defcustom company-dabbrev-code-modes
|
||||
'(prog-mode
|
||||
batch-file-mode csharp-mode css-mode erlang-mode haskell-mode jde-mode
|
||||
lua-mode python-mode)
|
||||
"Modes that use `company-dabbrev-code'.
|
||||
In all these modes (and their derivatives) `company-dabbrev-code' will
|
||||
complete only symbols, not text in comments or strings. In other modes
|
||||
`company-dabbrev-code' will pass control to other backends
|
||||
\(e.g. `company-dabbrev'\). Value t means complete in all modes."
|
||||
:type '(choice (repeat :tag "Some modes" (symbol :tag "Major mode"))
|
||||
(const :tag "All modes" t)))
|
||||
|
||||
(defcustom company-dabbrev-code-other-buffers t
|
||||
"Determines whether `company-dabbrev-code' should search other buffers.
|
||||
If `all', search all other buffers, except the ignored ones. If t, search
|
||||
buffers with the same major mode. If `code', search all buffers with major
|
||||
modes in `company-dabbrev-code-modes', or derived from one of them. See
|
||||
also `company-dabbrev-code-time-limit'."
|
||||
:type '(choice (const :tag "Off" nil)
|
||||
(const :tag "Same major mode" t)
|
||||
(const :tag "Code major modes" code)
|
||||
(const :tag "All" all)))
|
||||
|
||||
(defcustom company-dabbrev-code-time-limit .1
|
||||
"Determines how long `company-dabbrev-code' should look for matches."
|
||||
:type '(choice (const :tag "Off" nil)
|
||||
(number :tag "Seconds")))
|
||||
|
||||
(defcustom company-dabbrev-code-everywhere nil
|
||||
"Non-nil to offer completions in comments and strings."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom company-dabbrev-code-ignore-case nil
|
||||
"Non-nil to ignore case when collecting completion candidates."
|
||||
:type 'boolean)
|
||||
|
||||
(defun company-dabbrev-code--make-regexp (prefix)
|
||||
(concat "\\_<" (if (equal prefix "")
|
||||
"\\([a-zA-Z]\\|\\s_\\)"
|
||||
(regexp-quote prefix))
|
||||
"\\(\\sw\\|\\s_\\)*\\_>"))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-dabbrev-code (command &optional arg &rest ignored)
|
||||
"dabbrev-like `company-mode' backend for code.
|
||||
The backend looks for all symbols in the current buffer that aren't in
|
||||
comments or strings."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-dabbrev-code))
|
||||
(prefix (and (or (eq t company-dabbrev-code-modes)
|
||||
(apply #'derived-mode-p company-dabbrev-code-modes))
|
||||
(or company-dabbrev-code-everywhere
|
||||
(not (company-in-string-or-comment)))
|
||||
(or (company-grab-symbol) 'stop)))
|
||||
(candidates (let ((case-fold-search company-dabbrev-code-ignore-case))
|
||||
(company-dabbrev--search
|
||||
(company-dabbrev-code--make-regexp arg)
|
||||
company-dabbrev-code-time-limit
|
||||
(pcase company-dabbrev-code-other-buffers
|
||||
(`t (list major-mode))
|
||||
(`code company-dabbrev-code-modes)
|
||||
(`all `all))
|
||||
(not company-dabbrev-code-everywhere))))
|
||||
(ignore-case company-dabbrev-code-ignore-case)
|
||||
(duplicates t)))
|
||||
|
||||
(provide 'company-dabbrev-code)
|
||||
;;; company-dabbrev-code.el ends here
|
||||
@@ -1,195 +0,0 @@
|
||||
;;; company-dabbrev.el --- dabbrev-like company-mode completion backend -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2009, 2011, 2014, 2015, 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 'cl-lib)
|
||||
|
||||
(defgroup company-dabbrev nil
|
||||
"dabbrev-like completion backend."
|
||||
:group 'company)
|
||||
|
||||
(defcustom company-dabbrev-other-buffers 'all
|
||||
"Determines whether `company-dabbrev' should search other buffers.
|
||||
If `all', search all other buffers, except the ignored ones. If t, search
|
||||
buffers with the same major mode. See also `company-dabbrev-time-limit'."
|
||||
:type '(choice (const :tag "Off" nil)
|
||||
(const :tag "Same major mode" t)
|
||||
(const :tag "All" all)))
|
||||
|
||||
(defcustom company-dabbrev-ignore-buffers "\\`[ *]"
|
||||
"Regexp matching the names of buffers to ignore.
|
||||
Or a function that returns non-nil for such buffers."
|
||||
:type '(choice (regexp :tag "Regexp")
|
||||
(function :tag "Predicate"))
|
||||
:package-version '(company . "0.9.0"))
|
||||
|
||||
(defcustom company-dabbrev-time-limit .1
|
||||
"Determines how many seconds `company-dabbrev' should look for matches."
|
||||
:type '(choice (const :tag "Off" nil)
|
||||
(number :tag "Seconds")))
|
||||
|
||||
(defcustom company-dabbrev-char-regexp "\\sw"
|
||||
"A regular expression matching the characters `company-dabbrev' looks for."
|
||||
:type 'regexp)
|
||||
|
||||
(defcustom company-dabbrev-ignore-case 'keep-prefix
|
||||
"Non-nil to ignore case when collecting completion candidates.
|
||||
When it's `keep-prefix', the text before point will remain unchanged after
|
||||
candidate is inserted, even some of its characters have different case.")
|
||||
|
||||
(defcustom company-dabbrev-downcase 'case-replace
|
||||
"Whether to downcase the returned candidates.
|
||||
|
||||
The value of nil means keep them as-is.
|
||||
`case-replace' means use the value of `case-replace'.
|
||||
Any other value means downcase.
|
||||
|
||||
If you set this value to nil, you may also want to set
|
||||
`company-dabbrev-ignore-case' to any value other than `keep-prefix'.")
|
||||
|
||||
(defcustom company-dabbrev-minimum-length 4
|
||||
"The minimum length for the completion candidate to be included.
|
||||
This variable affects both `company-dabbrev' and `company-dabbrev-code'."
|
||||
:type 'integer
|
||||
:package-version '(company . "0.8.3"))
|
||||
|
||||
(defcustom company-dabbrev-ignore-invisible nil
|
||||
"Non-nil to skip invisible text."
|
||||
:type 'boolean
|
||||
:package-version '(company . "0.9.0"))
|
||||
|
||||
(defmacro company-dabbrev--time-limit-while (test start limit freq &rest body)
|
||||
(declare (indent 3) (debug t))
|
||||
`(let ((company-time-limit-while-counter 0))
|
||||
(catch 'done
|
||||
(while ,test
|
||||
,@body
|
||||
(and ,limit
|
||||
(= (cl-incf company-time-limit-while-counter) ,freq)
|
||||
(setq company-time-limit-while-counter 0)
|
||||
(> (float-time (time-since ,start)) ,limit)
|
||||
(throw 'done 'company-time-out))))))
|
||||
|
||||
(defun company-dabbrev--make-regexp ()
|
||||
(concat "\\(?:" company-dabbrev-char-regexp "\\)+"))
|
||||
|
||||
(defun company-dabbrev--search-buffer (regexp pos symbols start limit
|
||||
ignore-comments)
|
||||
(save-excursion
|
||||
(cl-labels ((maybe-collect-match
|
||||
()
|
||||
(let ((match (match-string-no-properties 0)))
|
||||
(when (and (>= (length match) company-dabbrev-minimum-length)
|
||||
(not (and company-dabbrev-ignore-invisible
|
||||
(invisible-p (match-beginning 0)))))
|
||||
(push match symbols)))))
|
||||
(goto-char (if pos (1- pos) (point-min)))
|
||||
;; Search before pos.
|
||||
(let ((tmp-end (point)))
|
||||
(company-dabbrev--time-limit-while (> tmp-end (point-min))
|
||||
start limit 1
|
||||
(ignore-errors
|
||||
(forward-char -10000))
|
||||
(forward-line 0)
|
||||
(save-excursion
|
||||
;; Before, we used backward search, but it matches non-greedily, and
|
||||
;; that forced us to use the "beginning/end of word" anchors in
|
||||
;; `company-dabbrev--make-regexp'. It's also about 2x slower.
|
||||
(while (re-search-forward regexp tmp-end t)
|
||||
(if (and ignore-comments (save-match-data (company-in-string-or-comment)))
|
||||
(re-search-forward "\\s>\\|\\s!\\|\\s\"" tmp-end t)
|
||||
(maybe-collect-match))))
|
||||
(setq tmp-end (point))))
|
||||
(goto-char (or pos (point-min)))
|
||||
;; Search after pos.
|
||||
(company-dabbrev--time-limit-while (re-search-forward regexp nil t)
|
||||
start limit 25
|
||||
(if (and ignore-comments (save-match-data (company-in-string-or-comment)))
|
||||
(re-search-forward "\\s>\\|\\s!\\|\\s\"" nil t)
|
||||
(maybe-collect-match)))
|
||||
symbols)))
|
||||
|
||||
(defun company-dabbrev--search (regexp &optional limit other-buffer-modes
|
||||
ignore-comments)
|
||||
(let* ((start (current-time))
|
||||
(symbols (company-dabbrev--search-buffer regexp (point) nil start limit
|
||||
ignore-comments)))
|
||||
(when other-buffer-modes
|
||||
(cl-dolist (buffer (delq (current-buffer) (buffer-list)))
|
||||
(unless (if (stringp company-dabbrev-ignore-buffers)
|
||||
(string-match-p company-dabbrev-ignore-buffers
|
||||
(buffer-name buffer))
|
||||
(funcall company-dabbrev-ignore-buffers buffer))
|
||||
(with-current-buffer buffer
|
||||
(when (or (eq other-buffer-modes 'all)
|
||||
(apply #'derived-mode-p other-buffer-modes))
|
||||
(setq symbols
|
||||
(company-dabbrev--search-buffer regexp nil symbols start
|
||||
limit ignore-comments)))))
|
||||
(and limit
|
||||
(> (float-time (time-since start)) limit)
|
||||
(cl-return))))
|
||||
symbols))
|
||||
|
||||
(defun company-dabbrev--prefix ()
|
||||
;; Not in the middle of a word.
|
||||
(unless (looking-at company-dabbrev-char-regexp)
|
||||
;; Emacs can't do greedy backward-search.
|
||||
(company-grab-line (format "\\(?:^\\| \\)[^ ]*?\\(\\(?:%s\\)*\\)"
|
||||
company-dabbrev-char-regexp)
|
||||
1)))
|
||||
|
||||
(defun company-dabbrev--filter (prefix candidates)
|
||||
(let ((completion-ignore-case company-dabbrev-ignore-case))
|
||||
(all-completions prefix candidates)))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-dabbrev (command &optional arg &rest ignored)
|
||||
"dabbrev-like `company-mode' completion backend."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-dabbrev))
|
||||
(prefix (company-dabbrev--prefix))
|
||||
(candidates
|
||||
(let* ((case-fold-search company-dabbrev-ignore-case)
|
||||
(words (company-dabbrev--search (company-dabbrev--make-regexp)
|
||||
company-dabbrev-time-limit
|
||||
(pcase company-dabbrev-other-buffers
|
||||
(`t (list major-mode))
|
||||
(`all `all))))
|
||||
(downcase-p (if (eq company-dabbrev-downcase 'case-replace)
|
||||
case-replace
|
||||
company-dabbrev-downcase)))
|
||||
(setq words (company-dabbrev--filter arg words))
|
||||
(if downcase-p
|
||||
(mapcar 'downcase words)
|
||||
words)))
|
||||
(ignore-case company-dabbrev-ignore-case)
|
||||
(duplicates t)))
|
||||
|
||||
(provide 'company-dabbrev)
|
||||
;;; company-dabbrev.el ends here
|
||||
@@ -1,186 +0,0 @@
|
||||
;;; company-eclim.el --- company-mode completion backend for Eclim
|
||||
|
||||
;; Copyright (C) 2009, 2011, 2013, 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:
|
||||
;;
|
||||
;; Using `emacs-eclim' together with (or instead of) this backend is
|
||||
;; recommended, as it allows you to use other Eclim features.
|
||||
;;
|
||||
;; The alternative backend provided by `emacs-eclim' uses `yasnippet'
|
||||
;; instead of `company-template' to expand function calls, and it supports
|
||||
;; some languages other than Java.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'company)
|
||||
(require 'company-template)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defgroup company-eclim nil
|
||||
"Completion backend for Eclim."
|
||||
:group 'company)
|
||||
|
||||
(defun company-eclim-executable-find ()
|
||||
(let (file)
|
||||
(cl-dolist (eclipse-root '("/Applications/eclipse" "/usr/lib/eclipse"
|
||||
"/usr/local/lib/eclipse"))
|
||||
(and (file-exists-p (setq file (expand-file-name "plugins" eclipse-root)))
|
||||
(setq file (car (last (directory-files file t "^org.eclim_"))))
|
||||
(file-exists-p (setq file (expand-file-name "bin/eclim" file)))
|
||||
(cl-return file)))))
|
||||
|
||||
(defcustom company-eclim-executable
|
||||
(or (bound-and-true-p eclim-executable)
|
||||
(executable-find "eclim")
|
||||
(company-eclim-executable-find))
|
||||
"Location of eclim executable."
|
||||
:type 'file)
|
||||
|
||||
(defcustom company-eclim-auto-save t
|
||||
"Determines whether to save the buffer when retrieving completions.
|
||||
eclim can only complete correctly when the buffer has been saved."
|
||||
:type '(choice (const :tag "Off" nil)
|
||||
(const :tag "On" t)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defvar-local company-eclim--project-dir 'unknown)
|
||||
|
||||
(defvar-local company-eclim--project-name nil)
|
||||
|
||||
(declare-function json-read "json")
|
||||
(defvar json-array-type)
|
||||
|
||||
(defun company-eclim--call-process (&rest args)
|
||||
(let ((coding-system-for-read 'utf-8)
|
||||
res)
|
||||
(require 'json)
|
||||
(with-temp-buffer
|
||||
(if (= 0 (setq res (apply 'call-process company-eclim-executable nil t nil
|
||||
"-command" args)))
|
||||
(let ((json-array-type 'list))
|
||||
(goto-char (point-min))
|
||||
(unless (eobp)
|
||||
(json-read)))
|
||||
(message "Company-eclim command failed with error %d:\n%s" res
|
||||
(buffer-substring (point-min) (point-max)))
|
||||
nil))))
|
||||
|
||||
(defun company-eclim--project-list ()
|
||||
(company-eclim--call-process "project_list"))
|
||||
|
||||
(defun company-eclim--project-dir ()
|
||||
(if (eq company-eclim--project-dir 'unknown)
|
||||
(let ((dir (locate-dominating-file buffer-file-name ".project")))
|
||||
(when dir
|
||||
(setq company-eclim--project-dir
|
||||
(directory-file-name
|
||||
(expand-file-name dir)))))
|
||||
company-eclim--project-dir))
|
||||
|
||||
(defun company-eclim--project-name ()
|
||||
(or company-eclim--project-name
|
||||
(let ((dir (company-eclim--project-dir)))
|
||||
(when dir
|
||||
(setq company-eclim--project-name
|
||||
(cl-loop for project in (company-eclim--project-list)
|
||||
when (equal (cdr (assoc 'path project)) dir)
|
||||
return (cdr (assoc 'name project))))))))
|
||||
|
||||
(defun company-eclim--candidates (prefix)
|
||||
(interactive "d")
|
||||
(let ((project-file (file-relative-name buffer-file-name
|
||||
(company-eclim--project-dir)))
|
||||
completions)
|
||||
(when company-eclim-auto-save
|
||||
(when (buffer-modified-p)
|
||||
(basic-save-buffer))
|
||||
;; FIXME: Sometimes this isn't finished when we complete.
|
||||
(company-eclim--call-process "java_src_update"
|
||||
"-p" (company-eclim--project-name)
|
||||
"-f" project-file))
|
||||
(dolist (item (cdr (assoc 'completions
|
||||
(company-eclim--call-process
|
||||
"java_complete" "-p" (company-eclim--project-name)
|
||||
"-f" project-file
|
||||
"-o" (number-to-string
|
||||
(company-eclim--search-point prefix))
|
||||
"-e" "utf-8"
|
||||
"-l" "standard"))))
|
||||
(let* ((meta (cdr (assoc 'info item)))
|
||||
(completion meta))
|
||||
(when (string-match " ?[(:-]" completion)
|
||||
(setq completion (substring completion 0 (match-beginning 0))))
|
||||
(put-text-property 0 1 'meta meta completion)
|
||||
(push completion completions)))
|
||||
(let ((completion-ignore-case nil))
|
||||
(all-completions prefix completions))))
|
||||
|
||||
(defun company-eclim--search-point (prefix)
|
||||
(if (or (cl-plusp (length prefix)) (eq (char-before) ?.))
|
||||
(1- (point))
|
||||
(point)))
|
||||
|
||||
(defun company-eclim--meta (candidate)
|
||||
(get-text-property 0 'meta candidate))
|
||||
|
||||
(defun company-eclim--annotation (candidate)
|
||||
(let ((meta (company-eclim--meta candidate)))
|
||||
(when (string-match "\\(([^-]*\\) -" meta)
|
||||
(substring meta (match-beginning 1) (match-end 1)))))
|
||||
|
||||
(defun company-eclim--prefix ()
|
||||
(let ((prefix (company-grab-symbol)))
|
||||
(when prefix
|
||||
;; Completion candidates for annotations don't include '@'.
|
||||
(when (eq ?@ (string-to-char prefix))
|
||||
(setq prefix (substring prefix 1)))
|
||||
prefix)))
|
||||
|
||||
(defun company-eclim (command &optional arg &rest ignored)
|
||||
"`company-mode' completion backend for Eclim.
|
||||
Eclim provides access to Eclipse Java IDE features for other editors.
|
||||
|
||||
Eclim version 1.7.13 or newer (?) is required.
|
||||
|
||||
Completions only work correctly when the buffer has been saved.
|
||||
`company-eclim-auto-save' determines whether to do this automatically."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-eclim))
|
||||
(prefix (and (derived-mode-p 'java-mode 'jde-mode)
|
||||
buffer-file-name
|
||||
company-eclim-executable
|
||||
(company-eclim--project-name)
|
||||
(not (company-in-string-or-comment))
|
||||
(or (company-eclim--prefix) 'stop)))
|
||||
(candidates (company-eclim--candidates arg))
|
||||
(meta (company-eclim--meta arg))
|
||||
;; because "" doesn't return everything
|
||||
(no-cache (equal arg ""))
|
||||
(annotation (company-eclim--annotation arg))
|
||||
(post-completion (let ((anno (company-eclim--annotation arg)))
|
||||
(when anno
|
||||
(insert anno)
|
||||
(company-template-c-like-templatify anno))))))
|
||||
|
||||
(provide 'company-eclim)
|
||||
;;; company-eclim.el ends here
|
||||
@@ -1,225 +0,0 @@
|
||||
;;; company-elisp.el --- company-mode completion backend for Emacs Lisp -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2009, 2011-2013 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 'help-mode)
|
||||
(require 'find-func)
|
||||
|
||||
(defgroup company-elisp nil
|
||||
"Completion backend for Emacs Lisp."
|
||||
:group 'company)
|
||||
|
||||
(defcustom company-elisp-detect-function-context t
|
||||
"If enabled, offer Lisp functions only in appropriate contexts.
|
||||
Functions are offered for completion only after ' and \(."
|
||||
:type '(choice (const :tag "Off" nil)
|
||||
(const :tag "On" t)))
|
||||
|
||||
(defcustom company-elisp-show-locals-first t
|
||||
"If enabled, locally bound variables and functions are displayed
|
||||
first in the candidates list."
|
||||
:type '(choice (const :tag "Off" nil)
|
||||
(const :tag "On" t)))
|
||||
|
||||
(defun company-elisp--prefix ()
|
||||
(let ((prefix (company-grab-symbol)))
|
||||
(if prefix
|
||||
(when (if (company-in-string-or-comment)
|
||||
(= (char-before (- (point) (length prefix))) ?`)
|
||||
(company-elisp--should-complete))
|
||||
prefix)
|
||||
'stop)))
|
||||
|
||||
(defun company-elisp--predicate (symbol)
|
||||
(or (boundp symbol)
|
||||
(fboundp symbol)
|
||||
(facep symbol)
|
||||
(featurep symbol)))
|
||||
|
||||
(defun company-elisp--fns-regexp (&rest names)
|
||||
(concat "\\_<\\(?:cl-\\)?" (regexp-opt names) "\\*?\\_>"))
|
||||
|
||||
(defvar company-elisp-parse-limit 30)
|
||||
(defvar company-elisp-parse-depth 100)
|
||||
|
||||
(defvar company-elisp-defun-names '("defun" "defmacro" "defsubst"))
|
||||
|
||||
(defvar company-elisp-var-binding-regexp
|
||||
(apply #'company-elisp--fns-regexp "let" "lambda" "lexical-let"
|
||||
company-elisp-defun-names)
|
||||
"Regular expression matching head of a multiple variable bindings form.")
|
||||
|
||||
(defvar company-elisp-var-binding-regexp-1
|
||||
(company-elisp--fns-regexp "dolist" "dotimes")
|
||||
"Regular expression matching head of a form with one variable binding.")
|
||||
|
||||
(defvar company-elisp-fun-binding-regexp
|
||||
(company-elisp--fns-regexp "flet" "labels")
|
||||
"Regular expression matching head of a function bindings form.")
|
||||
|
||||
(defvar company-elisp-defuns-regexp
|
||||
(concat "([ \t\n]*"
|
||||
(apply #'company-elisp--fns-regexp company-elisp-defun-names)))
|
||||
|
||||
(defun company-elisp--should-complete ()
|
||||
(let ((start (point))
|
||||
(depth (car (syntax-ppss))))
|
||||
(not
|
||||
(when (> depth 0)
|
||||
(save-excursion
|
||||
(up-list (- depth))
|
||||
(when (looking-at company-elisp-defuns-regexp)
|
||||
(forward-char)
|
||||
(forward-sexp 1)
|
||||
(unless (= (point) start)
|
||||
(condition-case nil
|
||||
(let ((args-end (scan-sexps (point) 2)))
|
||||
(or (null args-end)
|
||||
(> args-end start)))
|
||||
(scan-error
|
||||
t)))))))))
|
||||
|
||||
(defun company-elisp--locals (prefix functions-p)
|
||||
(let ((regexp (concat "[ \t\n]*\\(\\_<" (regexp-quote prefix)
|
||||
"\\(?:\\sw\\|\\s_\\)*\\_>\\)"))
|
||||
(pos (point))
|
||||
res)
|
||||
(condition-case nil
|
||||
(save-excursion
|
||||
(dotimes (_ company-elisp-parse-depth)
|
||||
(up-list -1)
|
||||
(save-excursion
|
||||
(when (eq (char-after) ?\()
|
||||
(forward-char 1)
|
||||
(when (ignore-errors
|
||||
(save-excursion (forward-list)
|
||||
(<= (point) pos)))
|
||||
(skip-chars-forward " \t\n")
|
||||
(cond
|
||||
((looking-at (if functions-p
|
||||
company-elisp-fun-binding-regexp
|
||||
company-elisp-var-binding-regexp))
|
||||
(down-list 1)
|
||||
(condition-case nil
|
||||
(dotimes (_ company-elisp-parse-limit)
|
||||
(save-excursion
|
||||
(when (looking-at "[ \t\n]*(")
|
||||
(down-list 1))
|
||||
(when (looking-at regexp)
|
||||
(cl-pushnew (match-string-no-properties 1) res)))
|
||||
(forward-sexp))
|
||||
(scan-error nil)))
|
||||
((unless functions-p
|
||||
(looking-at company-elisp-var-binding-regexp-1))
|
||||
(down-list 1)
|
||||
(when (looking-at regexp)
|
||||
(cl-pushnew (match-string-no-properties 1) res)))))))))
|
||||
(scan-error nil))
|
||||
res))
|
||||
|
||||
(defun company-elisp-candidates (prefix)
|
||||
(let* ((predicate (company-elisp--candidates-predicate prefix))
|
||||
(locals (company-elisp--locals prefix (eq predicate 'fboundp)))
|
||||
(globals (company-elisp--globals prefix predicate))
|
||||
(locals (cl-loop for local in locals
|
||||
when (not (member local globals))
|
||||
collect local)))
|
||||
(if company-elisp-show-locals-first
|
||||
(append (sort locals 'string<)
|
||||
(sort globals 'string<))
|
||||
(append locals globals))))
|
||||
|
||||
(defun company-elisp--globals (prefix predicate)
|
||||
(all-completions prefix obarray predicate))
|
||||
|
||||
(defun company-elisp--candidates-predicate (prefix)
|
||||
(let* ((completion-ignore-case nil)
|
||||
(beg (- (point) (length prefix)))
|
||||
(before (char-before beg)))
|
||||
(if (and company-elisp-detect-function-context
|
||||
(not (memq before '(?' ?`))))
|
||||
(if (and (eq before ?\()
|
||||
(not
|
||||
(save-excursion
|
||||
(ignore-errors
|
||||
(goto-char (1- beg))
|
||||
(or (company-elisp--before-binding-varlist-p)
|
||||
(progn
|
||||
(up-list -1)
|
||||
(company-elisp--before-binding-varlist-p)))))))
|
||||
'fboundp
|
||||
'boundp)
|
||||
'company-elisp--predicate)))
|
||||
|
||||
(defun company-elisp--before-binding-varlist-p ()
|
||||
(save-excursion
|
||||
(and (prog1 (search-backward "(")
|
||||
(forward-char 1))
|
||||
(looking-at company-elisp-var-binding-regexp))))
|
||||
|
||||
(defun company-elisp--doc (symbol)
|
||||
(let* ((symbol (intern symbol))
|
||||
(doc (if (fboundp symbol)
|
||||
(documentation symbol t)
|
||||
(documentation-property symbol 'variable-documentation t))))
|
||||
(and (stringp doc)
|
||||
(string-match ".*$" doc)
|
||||
(match-string 0 doc))))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-elisp (command &optional arg &rest ignored)
|
||||
"`company-mode' completion backend for Emacs Lisp."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-elisp))
|
||||
(prefix (and (derived-mode-p 'emacs-lisp-mode 'inferior-emacs-lisp-mode)
|
||||
(company-elisp--prefix)))
|
||||
(candidates (company-elisp-candidates arg))
|
||||
(sorted company-elisp-show-locals-first)
|
||||
(meta (company-elisp--doc arg))
|
||||
(doc-buffer (let ((symbol (intern arg)))
|
||||
(save-window-excursion
|
||||
(ignore-errors
|
||||
(cond
|
||||
((fboundp symbol) (describe-function symbol))
|
||||
((boundp symbol) (describe-variable symbol))
|
||||
((featurep symbol) (describe-package symbol))
|
||||
((facep symbol) (describe-face symbol))
|
||||
(t (signal 'user-error nil)))
|
||||
(help-buffer)))))
|
||||
(location (let ((sym (intern arg)))
|
||||
(cond
|
||||
((fboundp sym) (find-definition-noselect sym nil))
|
||||
((boundp sym) (find-definition-noselect sym 'defvar))
|
||||
((featurep sym) (cons (find-file-noselect (find-library-name
|
||||
(symbol-name sym)))
|
||||
0))
|
||||
((facep sym) (find-definition-noselect sym 'defface)))))))
|
||||
|
||||
(provide 'company-elisp)
|
||||
;;; company-elisp.el ends here
|
||||
@@ -1,107 +0,0 @@
|
||||
;;; company-etags.el --- company-mode completion backend for etags
|
||||
|
||||
;; 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)
|
||||
(require 'etags)
|
||||
|
||||
(defgroup company-etags nil
|
||||
"Completion backend for etags."
|
||||
:group 'company)
|
||||
|
||||
(defcustom company-etags-use-main-table-list t
|
||||
"Always search `tags-table-list' if set.
|
||||
If this is disabled, `company-etags' will try to find the one table for each
|
||||
buffer automatically."
|
||||
:type '(choice (const :tag "off" nil)
|
||||
(const :tag "on" t)))
|
||||
|
||||
(defcustom company-etags-ignore-case nil
|
||||
"Non-nil to ignore case in completion candidates."
|
||||
:type 'boolean
|
||||
:package-version '(company . "0.7.3"))
|
||||
|
||||
(defcustom company-etags-everywhere nil
|
||||
"Non-nil to offer completions in comments and strings.
|
||||
Set it to t or to a list of major modes."
|
||||
:type '(choice (const :tag "Off" nil)
|
||||
(const :tag "Any supported mode" t)
|
||||
(repeat :tag "Some major modes"
|
||||
(symbol :tag "Major mode")))
|
||||
:package-version '(company . "0.9.0"))
|
||||
|
||||
(defvar company-etags-modes '(prog-mode c-mode objc-mode c++-mode java-mode
|
||||
jde-mode pascal-mode perl-mode python-mode))
|
||||
|
||||
(defvar-local company-etags-buffer-table 'unknown)
|
||||
|
||||
(defun company-etags-find-table ()
|
||||
(let ((file (expand-file-name
|
||||
"TAGS"
|
||||
(locate-dominating-file (or buffer-file-name
|
||||
default-directory)
|
||||
"TAGS"))))
|
||||
(when (and file (file-regular-p file))
|
||||
(list file))))
|
||||
|
||||
(defun company-etags-buffer-table ()
|
||||
(or (and company-etags-use-main-table-list tags-table-list)
|
||||
(if (eq company-etags-buffer-table 'unknown)
|
||||
(setq company-etags-buffer-table (company-etags-find-table))
|
||||
company-etags-buffer-table)))
|
||||
|
||||
(defun company-etags--candidates (prefix)
|
||||
(let ((tags-table-list (company-etags-buffer-table))
|
||||
(completion-ignore-case company-etags-ignore-case))
|
||||
(and (or tags-file-name tags-table-list)
|
||||
(fboundp 'tags-completion-table)
|
||||
(save-excursion
|
||||
(visit-tags-table-buffer)
|
||||
(all-completions prefix (tags-completion-table))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-etags (command &optional arg &rest ignored)
|
||||
"`company-mode' completion backend for etags."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-etags))
|
||||
(prefix (and (apply #'derived-mode-p company-etags-modes)
|
||||
(or (eq t company-etags-everywhere)
|
||||
(apply #'derived-mode-p company-etags-everywhere)
|
||||
(not (company-in-string-or-comment)))
|
||||
(company-etags-buffer-table)
|
||||
(or (company-grab-symbol) 'stop)))
|
||||
(candidates (company-etags--candidates arg))
|
||||
(location (let ((tags-table-list (company-etags-buffer-table)))
|
||||
(when (fboundp 'find-tag-noselect)
|
||||
(save-excursion
|
||||
(let ((buffer (find-tag-noselect arg)))
|
||||
(cons buffer (with-current-buffer buffer (point))))))))
|
||||
(ignore-case company-etags-ignore-case)))
|
||||
|
||||
(provide 'company-etags)
|
||||
;;; company-etags.el ends here
|
||||
@@ -1,148 +0,0 @@
|
||||
;;; company-files.el --- company-mode completion backend for file names
|
||||
|
||||
;; Copyright (C) 2009-2011, 2014-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)
|
||||
|
||||
(defgroup company-files nil
|
||||
"Completion backend for file names."
|
||||
:group 'company)
|
||||
|
||||
(defcustom company-files-exclusions nil
|
||||
"File name extensions and directory names to ignore.
|
||||
The values should use the same format as `completion-ignored-extensions'."
|
||||
:type '(const string)
|
||||
:package-version '(company . "0.9.1"))
|
||||
|
||||
(defun company-files--directory-files (dir prefix)
|
||||
;; Don't use directory-files. It produces directories without trailing /.
|
||||
(condition-case err
|
||||
(let ((comp (sort (file-name-all-completions prefix dir)
|
||||
(lambda (s1 s2) (string-lessp (downcase s1) (downcase s2))))))
|
||||
(when company-files-exclusions
|
||||
(setq comp (company-files--exclusions-filtered comp)))
|
||||
(if (equal prefix "")
|
||||
(delete "../" (delete "./" comp))
|
||||
comp))
|
||||
(file-error nil)))
|
||||
|
||||
(defun company-files--exclusions-filtered (completions)
|
||||
(let* ((dir-exclusions (cl-delete-if-not #'company-files--trailing-slash-p
|
||||
company-files-exclusions))
|
||||
(file-exclusions (cl-set-difference company-files-exclusions
|
||||
dir-exclusions)))
|
||||
(cl-loop for c in completions
|
||||
unless (if (company-files--trailing-slash-p c)
|
||||
(member c dir-exclusions)
|
||||
(cl-find-if (lambda (exclusion)
|
||||
(string-suffix-p exclusion c))
|
||||
file-exclusions))
|
||||
collect c)))
|
||||
|
||||
(defvar company-files--regexps
|
||||
(let* ((root (if (eq system-type 'windows-nt)
|
||||
"[a-zA-Z]:/"
|
||||
"/"))
|
||||
(begin (concat "\\(?:\\.\\{1,2\\}/\\|~/\\|" root "\\)")))
|
||||
(list (concat "\"\\(" begin "[^\"\n]*\\)")
|
||||
(concat "\'\\(" begin "[^\'\n]*\\)")
|
||||
(concat "\\(?:[ \t]\\|^\\)\\(" begin "[^ \t\n]*\\)"))))
|
||||
|
||||
(defun company-files--grab-existing-name ()
|
||||
;; Grab the file name.
|
||||
;; When surrounded with quotes, it can include spaces.
|
||||
(let (file dir)
|
||||
(and (cl-dolist (regexp company-files--regexps)
|
||||
(when (setq file (company-grab-line regexp 1))
|
||||
(cl-return file)))
|
||||
(company-files--connected-p file)
|
||||
(setq dir (file-name-directory file))
|
||||
(not (string-match "//" dir))
|
||||
(file-exists-p dir)
|
||||
file)))
|
||||
|
||||
(defun company-files--connected-p (file)
|
||||
(or (not (file-remote-p file))
|
||||
(file-remote-p file nil t)))
|
||||
|
||||
(defun company-files--trailing-slash-p (file)
|
||||
;; `file-directory-p' is very expensive on remotes. We are relying on
|
||||
;; `file-name-all-completions' returning directories with trailing / instead.
|
||||
(let ((len (length file)))
|
||||
(and (> len 0) (eq (aref file (1- len)) ?/))))
|
||||
|
||||
(defvar company-files--completion-cache nil)
|
||||
|
||||
(defun company-files--complete (prefix)
|
||||
(let* ((dir (file-name-directory prefix))
|
||||
(file (file-name-nondirectory prefix))
|
||||
(key (list file
|
||||
(expand-file-name dir)
|
||||
(nth 5 (file-attributes dir))))
|
||||
(completion-ignore-case read-file-name-completion-ignore-case))
|
||||
(unless (company-file--keys-match-p key (car company-files--completion-cache))
|
||||
(let* ((candidates (mapcar (lambda (f) (concat dir f))
|
||||
(company-files--directory-files dir file)))
|
||||
(directories (unless (file-remote-p dir)
|
||||
(cl-remove-if-not (lambda (f)
|
||||
(and (company-files--trailing-slash-p f)
|
||||
(not (file-remote-p f))
|
||||
(company-files--connected-p f)))
|
||||
candidates)))
|
||||
(children (and directories
|
||||
(cl-mapcan (lambda (d)
|
||||
(mapcar (lambda (c) (concat d c))
|
||||
(company-files--directory-files d "")))
|
||||
directories))))
|
||||
(setq company-files--completion-cache
|
||||
(cons key (append candidates children)))))
|
||||
(all-completions prefix
|
||||
(cdr company-files--completion-cache))))
|
||||
|
||||
(defun company-file--keys-match-p (new old)
|
||||
(and (equal (cdr old) (cdr new))
|
||||
(string-prefix-p (car old) (car new))))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-files (command &optional arg &rest ignored)
|
||||
"`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."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-files))
|
||||
(prefix (company-files--grab-existing-name))
|
||||
(candidates (company-files--complete arg))
|
||||
(location (cons (dired-noselect
|
||||
(file-name-directory (directory-file-name arg))) 1))
|
||||
(post-completion (when (company-files--trailing-slash-p arg)
|
||||
(delete-char -1)))
|
||||
(sorted t)
|
||||
(no-cache t)))
|
||||
|
||||
(provide 'company-files)
|
||||
;;; company-files.el ends here
|
||||
@@ -1,117 +0,0 @@
|
||||
;;; company-gtags.el --- company-mode completion backend for GNU Global
|
||||
|
||||
;; 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 'company-template)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defgroup company-gtags nil
|
||||
"Completion backend for GNU Global."
|
||||
:group 'company)
|
||||
|
||||
(defcustom company-gtags-executable
|
||||
(executable-find "global")
|
||||
"Location of GNU global executable."
|
||||
:type 'string)
|
||||
|
||||
(define-obsolete-variable-alias
|
||||
'company-gtags-gnu-global-program-name
|
||||
'company-gtags-executable "earlier")
|
||||
|
||||
(defcustom company-gtags-insert-arguments t
|
||||
"When non-nil, insert function arguments as a template after completion."
|
||||
:type 'boolean
|
||||
:package-version '(company . "0.8.1"))
|
||||
|
||||
(defvar-local company-gtags--tags-available-p 'unknown)
|
||||
|
||||
(defcustom company-gtags-modes '(prog-mode jde-mode)
|
||||
"Modes that use `company-gtags'.
|
||||
In all these modes (and their derivatives) `company-gtags' will perform
|
||||
completion."
|
||||
:type '(repeat (symbol :tag "Major mode"))
|
||||
:package-version '(company . "0.8.4"))
|
||||
|
||||
(defun company-gtags--tags-available-p ()
|
||||
(if (eq company-gtags--tags-available-p 'unknown)
|
||||
(setq company-gtags--tags-available-p
|
||||
(locate-dominating-file buffer-file-name "GTAGS"))
|
||||
company-gtags--tags-available-p))
|
||||
|
||||
(defun company-gtags--fetch-tags (prefix)
|
||||
(with-temp-buffer
|
||||
(let (tags)
|
||||
(when (= 0 (call-process company-gtags-executable nil
|
||||
;; "-T" goes through all the tag files listed in GTAGSLIBPATH
|
||||
(list (current-buffer) nil) nil "-xGqT" (concat "^" prefix)))
|
||||
(goto-char (point-min))
|
||||
(cl-loop while
|
||||
(re-search-forward (concat
|
||||
"^"
|
||||
"\\([^ ]*\\)" ;; completion
|
||||
"[ \t]+\\([[:digit:]]+\\)" ;; linum
|
||||
"[ \t]+\\([^ \t]+\\)" ;; file
|
||||
"[ \t]+\\(.*\\)" ;; definition
|
||||
"$"
|
||||
) nil t)
|
||||
collect
|
||||
(propertize (match-string 1)
|
||||
'meta (match-string 4)
|
||||
'location (cons (expand-file-name (match-string 3))
|
||||
(string-to-number (match-string 2)))
|
||||
))))))
|
||||
|
||||
(defun company-gtags--annotation (arg)
|
||||
(let ((meta (get-text-property 0 'meta arg)))
|
||||
(when (string-match (concat arg "\\((.*)\\).*") meta)
|
||||
(match-string 1 meta))))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-gtags (command &optional arg &rest ignored)
|
||||
"`company-mode' completion backend for GNU Global."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-gtags))
|
||||
(prefix (and company-gtags-executable
|
||||
buffer-file-name
|
||||
(apply #'derived-mode-p company-gtags-modes)
|
||||
(not (company-in-string-or-comment))
|
||||
(company-gtags--tags-available-p)
|
||||
(or (company-grab-symbol) 'stop)))
|
||||
(candidates (company-gtags--fetch-tags arg))
|
||||
(sorted t)
|
||||
(duplicates t)
|
||||
(annotation (company-gtags--annotation arg))
|
||||
(meta (get-text-property 0 'meta arg))
|
||||
(location (get-text-property 0 'location arg))
|
||||
(post-completion (let ((anno (company-gtags--annotation arg)))
|
||||
(when (and company-gtags-insert-arguments anno)
|
||||
(insert anno)
|
||||
(company-template-c-like-templatify anno))))))
|
||||
|
||||
(provide 'company-gtags)
|
||||
;;; company-gtags.el ends here
|
||||
@@ -1,82 +0,0 @@
|
||||
;;; company-ispell.el --- company-mode completion backend using Ispell
|
||||
|
||||
;; 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 'cl-lib)
|
||||
(require 'ispell)
|
||||
|
||||
(defgroup company-ispell nil
|
||||
"Completion backend using Ispell."
|
||||
:group 'company)
|
||||
|
||||
(defcustom company-ispell-dictionary nil
|
||||
"Dictionary to use for `company-ispell'.
|
||||
If nil, use `ispell-complete-word-dict'."
|
||||
:type '(choice (const :tag "default (nil)" nil)
|
||||
(file :tag "dictionary" t)))
|
||||
|
||||
(defvar company-ispell-available 'unknown)
|
||||
|
||||
(defalias 'company-ispell--lookup-words
|
||||
(if (fboundp 'ispell-lookup-words)
|
||||
'ispell-lookup-words
|
||||
'lookup-words))
|
||||
|
||||
(defun company-ispell-available ()
|
||||
(when (eq company-ispell-available 'unknown)
|
||||
(condition-case err
|
||||
(progn
|
||||
(company-ispell--lookup-words "WHATEVER")
|
||||
(setq company-ispell-available t))
|
||||
(error
|
||||
(message "Company: ispell-look-command not found")
|
||||
(setq company-ispell-available nil))))
|
||||
company-ispell-available)
|
||||
|
||||
;;;###autoload
|
||||
(defun company-ispell (command &optional arg &rest ignored)
|
||||
"`company-mode' completion backend using Ispell."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-ispell))
|
||||
(prefix (when (company-ispell-available)
|
||||
(company-grab-word)))
|
||||
(candidates
|
||||
(let ((words (company-ispell--lookup-words
|
||||
arg
|
||||
(or company-ispell-dictionary ispell-complete-word-dict)))
|
||||
(completion-ignore-case t))
|
||||
(if (string= arg "")
|
||||
;; Small optimization.
|
||||
words
|
||||
;; Work around issue #284.
|
||||
(all-completions arg words))))
|
||||
(sorted t)
|
||||
(ignore-case 'keep-prefix)))
|
||||
|
||||
(provide 'company-ispell)
|
||||
;;; company-ispell.el ends here
|
||||
@@ -1,263 +0,0 @@
|
||||
;;; company-keywords.el --- A company backend for programming language keywords
|
||||
|
||||
;; Copyright (C) 2009-2011, 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 'cl-lib)
|
||||
|
||||
(defun company-keywords-upper-lower (&rest lst)
|
||||
;; Upcase order is different for _.
|
||||
(nconc (sort (mapcar 'upcase lst) 'string<) lst))
|
||||
|
||||
(defvar company-keywords-alist
|
||||
;; Please contribute corrections or additions.
|
||||
`((c++-mode
|
||||
"alignas" "alignof" "asm" "auto" "bool" "break" "case" "catch" "char"
|
||||
"char16_t" "char32_t" "class" "const" "const_cast" "constexpr" "continue"
|
||||
"decltype" "default" "delete" "do" "double" "dynamic_cast" "else" "enum"
|
||||
"explicit" "export" "extern" "false" "final" "float" "for" "friend"
|
||||
"goto" "if" "inline" "int" "long" "mutable" "namespace" "new" "noexcept"
|
||||
"nullptr" "operator" "override"
|
||||
"private" "protected" "public" "register" "reinterpret_cast"
|
||||
"return" "short" "signed" "sizeof" "static" "static_assert"
|
||||
"static_cast" "struct" "switch" "template" "this" "thread_local"
|
||||
"throw" "true" "try" "typedef" "typeid" "typename"
|
||||
"union" "unsigned" "using" "virtual" "void" "volatile" "wchar_t" "while")
|
||||
(c-mode
|
||||
"auto" "break" "case" "char" "const" "continue" "default" "do"
|
||||
"double" "else" "enum" "extern" "float" "for" "goto" "if" "int" "long"
|
||||
"register" "return" "short" "signed" "sizeof" "static" "struct"
|
||||
"switch" "typedef" "union" "unsigned" "void" "volatile" "while")
|
||||
(csharp-mode
|
||||
"abstract" "add" "alias" "as" "base" "bool" "break" "byte" "case"
|
||||
"catch" "char" "checked" "class" "const" "continue" "decimal" "default"
|
||||
"delegate" "do" "double" "else" "enum" "event" "explicit" "extern"
|
||||
"false" "finally" "fixed" "float" "for" "foreach" "get" "global" "goto"
|
||||
"if" "implicit" "in" "int" "interface" "internal" "is" "lock" "long"
|
||||
"namespace" "new" "null" "object" "operator" "out" "override" "params"
|
||||
"partial" "private" "protected" "public" "readonly" "ref" "remove"
|
||||
"return" "sbyte" "sealed" "set" "short" "sizeof" "stackalloc" "static"
|
||||
"string" "struct" "switch" "this" "throw" "true" "try" "typeof" "uint"
|
||||
"ulong" "unchecked" "unsafe" "ushort" "using" "value" "var" "virtual"
|
||||
"void" "volatile" "where" "while" "yield")
|
||||
(d-mode
|
||||
;; from http://www.digitalmars.com/d/2.0/lex.html
|
||||
"abstract" "alias" "align" "asm"
|
||||
"assert" "auto" "body" "bool" "break" "byte" "case" "cast" "catch"
|
||||
"cdouble" "cent" "cfloat" "char" "class" "const" "continue" "creal"
|
||||
"dchar" "debug" "default" "delegate" "delete" "deprecated" "do"
|
||||
"double" "else" "enum" "export" "extern" "false" "final" "finally"
|
||||
"float" "for" "foreach" "foreach_reverse" "function" "goto" "idouble"
|
||||
"if" "ifloat" "import" "in" "inout" "int" "interface" "invariant"
|
||||
"ireal" "is" "lazy" "long" "macro" "mixin" "module" "new" "nothrow"
|
||||
"null" "out" "override" "package" "pragma" "private" "protected"
|
||||
"public" "pure" "real" "ref" "return" "scope" "short" "static" "struct"
|
||||
"super" "switch" "synchronized" "template" "this" "throw" "true" "try"
|
||||
"typedef" "typeid" "typeof" "ubyte" "ucent" "uint" "ulong" "union"
|
||||
"unittest" "ushort" "version" "void" "volatile" "wchar" "while" "with")
|
||||
(f90-mode .
|
||||
;; from f90.el
|
||||
;; ".AND." ".GE." ".GT." ".LT." ".LE." ".NE." ".OR." ".TRUE." ".FALSE."
|
||||
,(company-keywords-upper-lower
|
||||
"abs" "abstract" "achar" "acos" "adjustl" "adjustr" "aimag" "aint"
|
||||
"align" "all" "all_prefix" "all_scatter" "all_suffix" "allocatable"
|
||||
"allocate" "allocated" "and" "anint" "any" "any_prefix" "any_scatter"
|
||||
"any_suffix" "asin" "assign" "assignment" "associate" "associated"
|
||||
"asynchronous" "atan" "atan2" "backspace" "bind" "bit_size" "block"
|
||||
"btest" "c_alert" "c_associated" "c_backspace" "c_bool"
|
||||
"c_carriage_return" "c_char" "c_double" "c_double_complex" "c_f_pointer"
|
||||
"c_f_procpointer" "c_float" "c_float_complex" "c_form_feed" "c_funloc"
|
||||
"c_funptr" "c_horizontal_tab" "c_int" "c_int16_t" "c_int32_t" "c_int64_t"
|
||||
"c_int8_t" "c_int_fast16_t" "c_int_fast32_t" "c_int_fast64_t"
|
||||
"c_int_fast8_t" "c_int_least16_t" "c_int_least32_t" "c_int_least64_t"
|
||||
"c_int_least8_t" "c_intmax_t" "c_intptr_t" "c_loc" "c_long"
|
||||
"c_long_double" "c_long_double_complex" "c_long_long" "c_new_line"
|
||||
"c_null_char" "c_null_funptr" "c_null_ptr" "c_ptr" "c_short"
|
||||
"c_signed_char" "c_size_t" "c_vertical_tab" "call" "case" "ceiling"
|
||||
"char" "character" "character_storage_size" "class" "close" "cmplx"
|
||||
"command_argument_count" "common" "complex" "conjg" "contains" "continue"
|
||||
"copy_prefix" "copy_scatter" "copy_suffix" "cos" "cosh" "count"
|
||||
"count_prefix" "count_scatter" "count_suffix" "cpu_time" "cshift"
|
||||
"cycle" "cyclic" "data" "date_and_time" "dble" "deallocate" "deferred"
|
||||
"digits" "dim" "dimension" "distribute" "do" "dot_product" "double"
|
||||
"dprod" "dynamic" "elemental" "else" "elseif" "elsewhere" "end" "enddo"
|
||||
"endfile" "endif" "entry" "enum" "enumerator" "eoshift" "epsilon" "eq"
|
||||
"equivalence" "eqv" "error_unit" "exit" "exp" "exponent" "extends"
|
||||
"extends_type_of" "external" "extrinsic" "false" "file_storage_size"
|
||||
"final" "floor" "flush" "forall" "format" "fraction" "function" "ge"
|
||||
"generic" "get_command" "get_command_argument" "get_environment_variable"
|
||||
"goto" "grade_down" "grade_up" "gt" "hpf_alignment" "hpf_distribution"
|
||||
"hpf_template" "huge" "iachar" "iall" "iall_prefix" "iall_scatter"
|
||||
"iall_suffix" "iand" "iany" "iany_prefix" "iany_scatter" "iany_suffix"
|
||||
"ibclr" "ibits" "ibset" "ichar" "ieee_arithmetic" "ieee_exceptions"
|
||||
"ieee_features" "ieee_get_underflow_mode" "ieee_set_underflow_mode"
|
||||
"ieee_support_underflow_control" "ieor" "if" "ilen" "implicit"
|
||||
"import" "include" "independent" "index" "inherit" "input_unit"
|
||||
"inquire" "int" "integer" "intent" "interface" "intrinsic" "ior"
|
||||
"iostat_end" "iostat_eor" "iparity" "iparity_prefix" "iparity_scatter"
|
||||
"iparity_suffix" "ishft" "ishftc" "iso_c_binding" "iso_fortran_env"
|
||||
"kind" "lbound" "le" "leadz" "len" "len_trim" "lge" "lgt" "lle" "llt"
|
||||
"log" "log10" "logical" "lt" "matmul" "max" "maxexponent" "maxloc"
|
||||
"maxval" "maxval_prefix" "maxval_scatter" "maxval_suffix" "merge"
|
||||
"min" "minexponent" "minloc" "minval" "minval_prefix" "minval_scatter"
|
||||
"minval_suffix" "mod" "module" "modulo" "move_alloc" "mvbits" "namelist"
|
||||
"ne" "nearest" "neqv" "new" "new_line" "nint" "non_intrinsic"
|
||||
"non_overridable" "none" "nopass" "not" "null" "nullify"
|
||||
"number_of_processors" "numeric_storage_size" "only" "onto" "open"
|
||||
"operator" "optional" "or" "output_unit" "pack" "parameter" "parity"
|
||||
"parity_prefix" "parity_scatter" "parity_suffix" "pass" "pause"
|
||||
"pointer" "popcnt" "poppar" "precision" "present" "print" "private"
|
||||
"procedure" "processors" "processors_shape" "product" "product_prefix"
|
||||
"product_scatter" "product_suffix" "program" "protected" "public"
|
||||
"pure" "radix" "random_number" "random_seed" "range" "read" "real"
|
||||
"realign" "recursive" "redistribute" "repeat" "reshape" "result"
|
||||
"return" "rewind" "rrspacing" "same_type_as" "save" "scale" "scan"
|
||||
"select" "selected_char_kind" "selected_int_kind" "selected_real_kind"
|
||||
"sequence" "set_exponent" "shape" "sign" "sin" "sinh" "size" "spacing"
|
||||
"spread" "sqrt" "stop" "subroutine" "sum" "sum_prefix" "sum_scatter"
|
||||
"sum_suffix" "system_clock" "tan" "tanh" "target" "template" "then"
|
||||
"tiny" "transfer" "transpose" "trim" "true" "type" "ubound" "unpack"
|
||||
"use" "value" "verify" "volatile" "wait" "where" "while" "with" "write"))
|
||||
(java-mode
|
||||
"abstract" "assert" "boolean" "break" "byte" "case" "catch" "char" "class"
|
||||
"continue" "default" "do" "double" "else" "enum" "extends" "final"
|
||||
"finally" "float" "for" "if" "implements" "import" "instanceof" "int"
|
||||
"interface" "long" "native" "new" "package" "private" "protected" "public"
|
||||
"return" "short" "static" "strictfp" "super" "switch" "synchronized"
|
||||
"this" "throw" "throws" "transient" "try" "void" "volatile" "while")
|
||||
(javascript-mode
|
||||
"break" "catch" "const" "continue" "delete" "do" "else" "export" "for"
|
||||
"function" "if" "import" "in" "instanceOf" "label" "let" "new" "return"
|
||||
"switch" "this" "throw" "try" "typeof" "var" "void" "while" "with" "yield")
|
||||
(objc-mode
|
||||
"@catch" "@class" "@encode" "@end" "@finally" "@implementation"
|
||||
"@interface" "@private" "@protected" "@protocol" "@public"
|
||||
"@selector" "@synchronized" "@throw" "@try" "alloc" "autorelease"
|
||||
"bycopy" "byref" "in" "inout" "oneway" "out" "release" "retain")
|
||||
(perl-mode
|
||||
;; from cperl.el
|
||||
"AUTOLOAD" "BEGIN" "CHECK" "CORE" "DESTROY" "END" "INIT" "__END__"
|
||||
"__FILE__" "__LINE__" "abs" "accept" "alarm" "and" "atan2" "bind"
|
||||
"binmode" "bless" "caller" "chdir" "chmod" "chomp" "chop" "chown" "chr"
|
||||
"chroot" "close" "closedir" "cmp" "connect" "continue" "cos"
|
||||
"crypt" "dbmclose" "dbmopen" "defined" "delete" "die" "do" "dump" "each"
|
||||
"else" "elsif" "endgrent" "endhostent" "endnetent" "endprotoent"
|
||||
"endpwent" "endservent" "eof" "eq" "eval" "exec" "exists" "exit" "exp"
|
||||
"fcntl" "fileno" "flock" "for" "foreach" "fork" "format" "formline"
|
||||
"ge" "getc" "getgrent" "getgrgid" "getgrnam" "gethostbyaddr"
|
||||
"gethostbyname" "gethostent" "getlogin" "getnetbyaddr" "getnetbyname"
|
||||
"getnetent" "getpeername" "getpgrp" "getppid" "getpriority"
|
||||
"getprotobyname" "getprotobynumber" "getprotoent" "getpwent" "getpwnam"
|
||||
"getpwuid" "getservbyname" "getservbyport" "getservent" "getsockname"
|
||||
"getsockopt" "glob" "gmtime" "goto" "grep" "gt" "hex" "if" "index" "int"
|
||||
"ioctl" "join" "keys" "kill" "last" "lc" "lcfirst" "le" "length"
|
||||
"link" "listen" "local" "localtime" "lock" "log" "lstat" "lt" "map"
|
||||
"mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "my" "ne" "next" "no"
|
||||
"not" "oct" "open" "opendir" "or" "ord" "our" "pack" "package" "pipe"
|
||||
"pop" "pos" "print" "printf" "push" "q" "qq" "quotemeta" "qw" "qx"
|
||||
"rand" "read" "readdir" "readline" "readlink" "readpipe" "recv" "redo"
|
||||
"ref" "rename" "require" "reset" "return" "reverse" "rewinddir" "rindex"
|
||||
"rmdir" "scalar" "seek" "seekdir" "select" "semctl" "semget" "semop"
|
||||
"send" "setgrent" "sethostent" "setnetent" "setpgrp" "setpriority"
|
||||
"setprotoent" "setpwent" "setservent" "setsockopt" "shift" "shmctl"
|
||||
"shmget" "shmread" "shmwrite" "shutdown" "sin" "sleep" "socket"
|
||||
"socketpair" "sort" "splice" "split" "sprintf" "sqrt" "srand" "stat"
|
||||
"study" "sub" "substr" "symlink" "syscall" "sysopen" "sysread" "system"
|
||||
"syswrite" "tell" "telldir" "tie" "time" "times" "tr" "truncate" "uc"
|
||||
"ucfirst" "umask" "undef" "unless" "unlink" "unpack" "unshift" "untie"
|
||||
"until" "use" "utime" "values" "vec" "wait" "waitpid"
|
||||
"wantarray" "warn" "while" "write" "x" "xor" "y")
|
||||
(php-mode
|
||||
"__CLASS__" "__DIR__" "__FILE__" "__FUNCTION__" "__LINE__" "__METHOD__"
|
||||
"__NAMESPACE__" "_once" "abstract" "and" "array" "as" "break" "case"
|
||||
"catch" "cfunction" "class" "clone" "const" "continue" "declare"
|
||||
"default" "die" "do" "echo" "else" "elseif" "empty" "enddeclare"
|
||||
"endfor" "endforeach" "endif" "endswitch" "endwhile" "eval" "exception"
|
||||
"exit" "extends" "final" "for" "foreach" "function" "global"
|
||||
"goto" "if" "implements" "include" "instanceof" "interface"
|
||||
"isset" "list" "namespace" "new" "old_function" "or" "php_user_filter"
|
||||
"print" "private" "protected" "public" "require" "require_once" "return"
|
||||
"static" "switch" "this" "throw" "try" "unset" "use" "var" "while" "xor")
|
||||
(python-mode
|
||||
"and" "assert" "break" "class" "continue" "def" "del" "elif" "else"
|
||||
"except" "exec" "finally" "for" "from" "global" "if" "import" "in" "is"
|
||||
"lambda" "not" "or" "pass" "print" "raise" "return" "try" "while" "yield")
|
||||
(ruby-mode
|
||||
"BEGIN" "END" "alias" "and" "begin" "break" "case" "class" "def" "defined?"
|
||||
"do" "else" "elsif" "end" "ensure" "false" "for" "if" "in" "module"
|
||||
"next" "nil" "not" "or" "redo" "rescue" "retry" "return" "self" "super"
|
||||
"then" "true" "undef" "unless" "until" "when" "while" "yield")
|
||||
;; From https://doc.rust-lang.org/grammar.html#keywords
|
||||
;; but excluding unused reserved words: https://www.reddit.com/r/rust/comments/34fq0k/is_there_a_good_list_of_rusts_keywords/cqucvnj
|
||||
(rust-mode
|
||||
"Self"
|
||||
"as" "box" "break" "const" "continue" "crate" "else" "enum" "extern"
|
||||
"false" "fn" "for" "if" "impl" "in" "let" "loop" "macro" "match" "mod"
|
||||
"move" "mut" "pub" "ref" "return" "self" "static" "struct" "super"
|
||||
"trait" "true" "type" "unsafe" "use" "where" "while")
|
||||
(scala-mode
|
||||
"abstract" "case" "catch" "class" "def" "do" "else" "extends" "false"
|
||||
"final" "finally" "for" "forSome" "if" "implicit" "import" "lazy" "match"
|
||||
"new" "null" "object" "override" "package" "private" "protected"
|
||||
"return" "sealed" "super" "this" "throw" "trait" "true" "try" "type" "val"
|
||||
"var" "while" "with" "yield")
|
||||
(julia-mode
|
||||
"abstract" "break" "case" "catch" "const" "continue" "do" "else" "elseif"
|
||||
"end" "eval" "export" "false" "finally" "for" "function" "global" "if"
|
||||
"ifelse" "immutable" "import" "importall" "in" "let" "macro" "module"
|
||||
"otherwise" "quote" "return" "switch" "throw" "true" "try" "type"
|
||||
"typealias" "using" "while"
|
||||
)
|
||||
;; aliases
|
||||
(js2-mode . javascript-mode)
|
||||
(js2-jsx-mode . javascript-mode)
|
||||
(espresso-mode . javascript-mode)
|
||||
(js-mode . javascript-mode)
|
||||
(js-jsx-mode . javascript-mode)
|
||||
(cperl-mode . perl-mode)
|
||||
(jde-mode . java-mode)
|
||||
(ess-julia-mode . julia-mode))
|
||||
"Alist mapping major-modes to sorted keywords for `company-keywords'.")
|
||||
|
||||
;;;###autoload
|
||||
(defun company-keywords (command &optional arg &rest ignored)
|
||||
"`company-mode' backend for programming language keywords."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-keywords))
|
||||
(prefix (and (assq major-mode company-keywords-alist)
|
||||
(not (company-in-string-or-comment))
|
||||
(or (company-grab-symbol) 'stop)))
|
||||
(candidates
|
||||
(let ((completion-ignore-case nil)
|
||||
(symbols (cdr (assq major-mode company-keywords-alist))))
|
||||
(all-completions arg (if (consp symbols)
|
||||
symbols
|
||||
(cdr (assq symbols company-keywords-alist))))))
|
||||
(sorted t)))
|
||||
|
||||
(provide 'company-keywords)
|
||||
;;; company-keywords.el ends here
|
||||
@@ -1,142 +0,0 @@
|
||||
;;; company-nxml.el --- company-mode completion backend for nxml-mode
|
||||
|
||||
;; Copyright (C) 2009-2011, 2013 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)
|
||||
|
||||
(defvar rng-open-elements)
|
||||
(defvar rng-validate-mode)
|
||||
(defvar rng-in-attribute-regex)
|
||||
(defvar rng-in-attribute-value-regex)
|
||||
(declare-function rng-set-state-after "rng-nxml")
|
||||
(declare-function rng-match-possible-start-tag-names "rng-match")
|
||||
(declare-function rng-adjust-state-for-attribute "rng-nxml")
|
||||
(declare-function rng-match-possible-attribute-names "rng-match")
|
||||
(declare-function rng-adjust-state-for-attribute-value "rng-nxml")
|
||||
(declare-function rng-match-possible-value-strings "rng-match")
|
||||
|
||||
(defconst company-nxml-token-regexp
|
||||
"\\(?:[_[:alpha:]][-._[:alnum:]]*\\_>\\)")
|
||||
|
||||
(defvar company-nxml-in-attribute-value-regexp
|
||||
(replace-regexp-in-string "w" company-nxml-token-regexp
|
||||
"<w\\(?::w\\)?\
|
||||
\\(?:[ \t\r\n]+w\\(?::w\\)?[ \t\r\n]*=\
|
||||
\[ \t\r\n]*\\(?:\"[^\"]*\"\\|'[^']*'\\)\\)*\
|
||||
\[ \t\r\n]+\\(w\\(:w\\)?\\)[ \t\r\n]*=[ \t\r\n]*\
|
||||
\\(\"\\([^\"]*\\>\\)\\|'\\([^']*\\>\\)\\)\\="
|
||||
t t))
|
||||
|
||||
(defvar company-nxml-in-tag-name-regexp
|
||||
(replace-regexp-in-string "w" company-nxml-token-regexp
|
||||
"<\\(/?w\\(?::w?\\)?\\)?\\=" t t))
|
||||
|
||||
(defun company-nxml-all-completions (prefix alist)
|
||||
(let ((candidates (mapcar 'cdr alist))
|
||||
(case-fold-search nil)
|
||||
filtered)
|
||||
(when (cdar rng-open-elements)
|
||||
(push (concat "/" (cdar rng-open-elements)) candidates))
|
||||
(setq candidates (sort (all-completions prefix candidates) 'string<))
|
||||
(while candidates
|
||||
(unless (equal (car candidates) (car filtered))
|
||||
(push (car candidates) filtered))
|
||||
(pop candidates))
|
||||
(nreverse filtered)))
|
||||
|
||||
(defmacro company-nxml-prepared (&rest body)
|
||||
(declare (indent 0) (debug t))
|
||||
`(let ((lt-pos (save-excursion (search-backward "<" nil t)))
|
||||
xmltok-dtd)
|
||||
(when (and lt-pos (= (rng-set-state-after lt-pos) lt-pos))
|
||||
,@body)))
|
||||
|
||||
(defun company-nxml-tag (command &optional arg &rest ignored)
|
||||
(cl-case command
|
||||
(prefix (and (derived-mode-p 'nxml-mode)
|
||||
rng-validate-mode
|
||||
(company-grab company-nxml-in-tag-name-regexp 1)))
|
||||
(candidates (company-nxml-prepared
|
||||
(company-nxml-all-completions
|
||||
arg (rng-match-possible-start-tag-names))))
|
||||
(sorted t)))
|
||||
|
||||
(defun company-nxml-attribute (command &optional arg &rest ignored)
|
||||
(cl-case command
|
||||
(prefix (and (derived-mode-p 'nxml-mode)
|
||||
rng-validate-mode
|
||||
(memq (char-after) '(?\ ?\t ?\n)) ;; outside word
|
||||
(company-grab rng-in-attribute-regex 1)))
|
||||
(candidates (company-nxml-prepared
|
||||
(and (rng-adjust-state-for-attribute
|
||||
lt-pos (- (point) (length arg)))
|
||||
(company-nxml-all-completions
|
||||
arg (rng-match-possible-attribute-names)))))
|
||||
(sorted t)))
|
||||
|
||||
(defun company-nxml-attribute-value (command &optional arg &rest ignored)
|
||||
(cl-case command
|
||||
(prefix (and (derived-mode-p 'nxml-mode)
|
||||
rng-validate-mode
|
||||
(and (memq (char-after) '(?' ?\" ?\ ?\t ?\n)) ;; outside word
|
||||
(looking-back company-nxml-in-attribute-value-regexp)
|
||||
(or (match-string-no-properties 4)
|
||||
(match-string-no-properties 5)
|
||||
""))))
|
||||
(candidates (company-nxml-prepared
|
||||
(let (attr-start attr-end colon)
|
||||
(and (looking-back rng-in-attribute-value-regex lt-pos)
|
||||
(setq colon (match-beginning 2)
|
||||
attr-start (match-beginning 1)
|
||||
attr-end (match-end 1))
|
||||
(rng-adjust-state-for-attribute lt-pos attr-start)
|
||||
(rng-adjust-state-for-attribute-value
|
||||
attr-start colon attr-end)
|
||||
(all-completions
|
||||
arg (rng-match-possible-value-strings))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-nxml (command &optional arg &rest ignored)
|
||||
"`company-mode' completion backend for `nxml-mode'."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-nxml))
|
||||
(prefix (or (company-nxml-tag 'prefix)
|
||||
(company-nxml-attribute 'prefix)
|
||||
(company-nxml-attribute-value 'prefix)))
|
||||
(candidates (cond
|
||||
((company-nxml-tag 'prefix)
|
||||
(company-nxml-tag 'candidates arg))
|
||||
((company-nxml-attribute 'prefix)
|
||||
(company-nxml-attribute 'candidates arg))
|
||||
((company-nxml-attribute-value 'prefix)
|
||||
(sort (company-nxml-attribute-value 'candidates arg)
|
||||
'string<))))
|
||||
(sorted t)))
|
||||
|
||||
(provide 'company-nxml)
|
||||
;;; company-nxml.el ends here
|
||||
@@ -1,57 +0,0 @@
|
||||
;;; company-oddmuse.el --- company-mode completion backend for oddmuse-mode
|
||||
|
||||
;; 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)
|
||||
(eval-when-compile (require 'yaoddmuse nil t))
|
||||
(eval-when-compile (require 'oddmuse nil t))
|
||||
|
||||
(defvar company-oddmuse-link-regexp
|
||||
"\\(\\<[A-Z][[:alnum:]]*\\>\\)\\|\\[\\[\\([[:alnum:]]+\\>\\|\\)")
|
||||
|
||||
(defun company-oddmuse-get-page-table ()
|
||||
(cl-case major-mode
|
||||
(yaoddmuse-mode (with-no-warnings
|
||||
(yaoddmuse-get-pagename-table yaoddmuse-wikiname)))
|
||||
(oddmuse-mode (with-no-warnings
|
||||
(oddmuse-make-completion-table oddmuse-wiki)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-oddmuse (command &optional arg &rest ignored)
|
||||
"`company-mode' completion backend for `oddmuse-mode'."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-oddmuse))
|
||||
(prefix (let ((case-fold-search nil))
|
||||
(and (memq major-mode '(oddmuse-mode yaoddmuse-mode))
|
||||
(looking-back company-oddmuse-link-regexp (point-at-bol))
|
||||
(or (match-string 1)
|
||||
(match-string 2)))))
|
||||
(candidates (all-completions arg (company-oddmuse-get-page-table)))))
|
||||
|
||||
(provide 'company-oddmuse)
|
||||
;;; company-oddmuse.el ends here
|
||||
@@ -1,8 +0,0 @@
|
||||
(define-package "company" "20160829.1206" "Modular text completion framework"
|
||||
'((emacs "24.1")
|
||||
(cl-lib "0.5"))
|
||||
:url "http://company-mode.github.io/" :keywords
|
||||
'("abbrev" "convenience" "matching"))
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
@@ -1,167 +0,0 @@
|
||||
;;; company-semantic.el --- company-mode completion backend using Semantic
|
||||
|
||||
;; 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)
|
||||
|
||||
(defvar semantic-idle-summary-function)
|
||||
(declare-function semantic-documentation-for-tag "semantic/doc" )
|
||||
(declare-function semantic-analyze-current-context "semantic/analyze")
|
||||
(declare-function semantic-analyze-possible-completions "semantic/complete")
|
||||
(declare-function semantic-analyze-find-tags-by-prefix "semantic/analyze/fcn")
|
||||
(declare-function semantic-tag-class "semantic/tag")
|
||||
(declare-function semantic-tag-name "semantic/tag")
|
||||
(declare-function semantic-tag-start "semantic/tag")
|
||||
(declare-function semantic-tag-buffer "semantic/tag")
|
||||
(declare-function semantic-active-p "semantic")
|
||||
(declare-function semantic-format-tag-prototype "semantic/format")
|
||||
|
||||
(defgroup company-semantic nil
|
||||
"Completion backend using Semantic."
|
||||
:group 'company)
|
||||
|
||||
(defcustom company-semantic-metadata-function 'company-semantic-summary-and-doc
|
||||
"The function turning a semantic tag into doc information."
|
||||
:type 'function)
|
||||
|
||||
(defcustom company-semantic-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-semantic-insert-arguments t
|
||||
"When non-nil, insert function arguments as a template after completion."
|
||||
:type 'boolean
|
||||
:package-version '(company . "0.9.0"))
|
||||
|
||||
(defvar company-semantic-modes '(c-mode c++-mode jde-mode java-mode))
|
||||
|
||||
(defvar-local company-semantic--current-tags nil
|
||||
"Tags for the current context.")
|
||||
|
||||
(defun company-semantic-documentation-for-tag (tag)
|
||||
(when (semantic-tag-buffer tag)
|
||||
;; When TAG's buffer is unknown, the function below raises an error.
|
||||
(semantic-documentation-for-tag tag)))
|
||||
|
||||
(defun company-semantic-doc-or-summary (tag)
|
||||
(or (company-semantic-documentation-for-tag tag)
|
||||
(and (require 'semantic-idle nil t)
|
||||
(require 'semantic/idle nil t)
|
||||
(funcall semantic-idle-summary-function tag nil t))))
|
||||
|
||||
(defun company-semantic-summary-and-doc (tag)
|
||||
(let ((doc (company-semantic-documentation-for-tag tag))
|
||||
(summary (funcall semantic-idle-summary-function tag nil t)))
|
||||
(and (stringp doc)
|
||||
(string-match "\n*\\(.*\\)$" doc)
|
||||
(setq doc (match-string 1 doc)))
|
||||
(concat summary
|
||||
(when doc
|
||||
(if (< (+ (length doc) (length summary) 4) (window-width))
|
||||
" -- "
|
||||
"\n"))
|
||||
doc)))
|
||||
|
||||
(defun company-semantic-doc-buffer (tag)
|
||||
(let ((doc (company-semantic-documentation-for-tag tag)))
|
||||
(when doc
|
||||
(company-doc-buffer
|
||||
(concat (funcall semantic-idle-summary-function tag nil t)
|
||||
"\n"
|
||||
doc)))))
|
||||
|
||||
(defsubst company-semantic-completions (prefix)
|
||||
(ignore-errors
|
||||
(let ((completion-ignore-case nil)
|
||||
(context (semantic-analyze-current-context)))
|
||||
(setq company-semantic--current-tags
|
||||
(semantic-analyze-possible-completions context 'no-unique))
|
||||
(all-completions prefix company-semantic--current-tags))))
|
||||
|
||||
(defun company-semantic-completions-raw (prefix)
|
||||
(setq company-semantic--current-tags nil)
|
||||
(dolist (tag (semantic-analyze-find-tags-by-prefix prefix))
|
||||
(unless (eq (semantic-tag-class tag) 'include)
|
||||
(push tag company-semantic--current-tags)))
|
||||
(delete "" (mapcar 'semantic-tag-name company-semantic--current-tags)))
|
||||
|
||||
(defun company-semantic-annotation (argument tags)
|
||||
(let* ((tag (assq argument tags))
|
||||
(kind (when tag (elt tag 1))))
|
||||
(cl-case kind
|
||||
(function (let* ((prototype (semantic-format-tag-prototype tag nil nil))
|
||||
(par-pos (string-match "(" prototype)))
|
||||
(when par-pos (substring prototype par-pos)))))))
|
||||
|
||||
(defun company-semantic--prefix ()
|
||||
(if company-semantic-begin-after-member-access
|
||||
(company-grab-symbol-cons "\\.\\|->\\|::" 2)
|
||||
(company-grab-symbol)))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-semantic (command &optional arg &rest ignored)
|
||||
"`company-mode' completion backend using CEDET Semantic."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-semantic))
|
||||
(prefix (and (featurep 'semantic)
|
||||
(semantic-active-p)
|
||||
(memq major-mode company-semantic-modes)
|
||||
(not (company-in-string-or-comment))
|
||||
(or (company-semantic--prefix) 'stop)))
|
||||
(candidates (if (and (equal arg "")
|
||||
(not (looking-back "->\\|\\." (- (point) 2))))
|
||||
(company-semantic-completions-raw arg)
|
||||
(company-semantic-completions arg)))
|
||||
(meta (funcall company-semantic-metadata-function
|
||||
(assoc arg company-semantic--current-tags)))
|
||||
(annotation (company-semantic-annotation arg
|
||||
company-semantic--current-tags))
|
||||
(doc-buffer (company-semantic-doc-buffer
|
||||
(assoc arg company-semantic--current-tags)))
|
||||
;; Because "" is an empty context and doesn't return local variables.
|
||||
(no-cache (equal arg ""))
|
||||
(duplicates t)
|
||||
(location (let ((tag (assoc arg company-semantic--current-tags)))
|
||||
(when (buffer-live-p (semantic-tag-buffer tag))
|
||||
(cons (semantic-tag-buffer tag)
|
||||
(semantic-tag-start tag)))))
|
||||
(post-completion (let ((anno (company-semantic-annotation
|
||||
arg company-semantic--current-tags)))
|
||||
(when (and company-semantic-insert-arguments anno)
|
||||
(insert anno)
|
||||
(company-template-c-like-templatify (concat arg anno)))
|
||||
))))
|
||||
|
||||
(provide 'company-semantic)
|
||||
;;; company-semantic.el ends here
|
||||
@@ -1,214 +0,0 @@
|
||||
;;; company-template.el --- utility library for template expansion
|
||||
|
||||
;; Copyright (C) 2009, 2010, 2014-2016 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Nikolaj Schumacher
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
|
||||
(defface company-template-field
|
||||
'((((background dark)) (:background "yellow" :foreground "black"))
|
||||
(((background light)) (:background "orange" :foreground "black")))
|
||||
"Face used for editable text in template fields."
|
||||
:group 'company)
|
||||
|
||||
(defvar company-template-nav-map
|
||||
(let ((keymap (make-sparse-keymap)))
|
||||
(define-key keymap [tab] 'company-template-forward-field)
|
||||
(define-key keymap (kbd "TAB") 'company-template-forward-field)
|
||||
keymap))
|
||||
|
||||
(defvar-local company-template--buffer-templates nil)
|
||||
|
||||
;; interactive ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun company-template-templates-at (pos)
|
||||
(let (os)
|
||||
(dolist (o (overlays-at pos))
|
||||
;; FIXME: Always return the whole list of templates?
|
||||
;; We remove templates not at point after every command.
|
||||
(when (memq o company-template--buffer-templates)
|
||||
(push o os)))
|
||||
os))
|
||||
|
||||
(defun company-template-move-to-first (templ)
|
||||
(interactive)
|
||||
(goto-char (overlay-start templ))
|
||||
(company-template-forward-field))
|
||||
|
||||
(defun company-template-forward-field ()
|
||||
(interactive)
|
||||
(let* ((start (point))
|
||||
(templates (company-template-templates-at (point)))
|
||||
(minimum (apply 'max (mapcar 'overlay-end templates)))
|
||||
(fields (cl-loop for templ in templates
|
||||
append (overlay-get templ 'company-template-fields))))
|
||||
(dolist (pos (mapcar 'overlay-start fields))
|
||||
(and pos
|
||||
(> pos (point))
|
||||
(< pos minimum)
|
||||
(setq minimum pos)))
|
||||
(push-mark)
|
||||
(goto-char minimum)
|
||||
(company-template-remove-field (company-template-field-at start))))
|
||||
|
||||
(defun company-template-field-at (&optional point)
|
||||
(cl-loop for ovl in (overlays-at (or point (point)))
|
||||
when (overlay-get ovl 'company-template-parent)
|
||||
return ovl))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun company-template-declare-template (beg end)
|
||||
(let ((ov (make-overlay beg end)))
|
||||
;; (overlay-put ov 'face 'highlight)
|
||||
(overlay-put ov 'keymap company-template-nav-map)
|
||||
(overlay-put ov 'priority 101)
|
||||
(overlay-put ov 'evaporate t)
|
||||
(push ov company-template--buffer-templates)
|
||||
(add-hook 'post-command-hook 'company-template-post-command nil t)
|
||||
ov))
|
||||
|
||||
(defun company-template-remove-template (templ)
|
||||
(mapc 'company-template-remove-field
|
||||
(overlay-get templ 'company-template-fields))
|
||||
(setq company-template--buffer-templates
|
||||
(delq templ company-template--buffer-templates))
|
||||
(delete-overlay templ))
|
||||
|
||||
(defun company-template-add-field (templ beg end &optional display)
|
||||
"Add new field to template TEMPL spanning from BEG to END.
|
||||
When DISPLAY is non-nil, set the respective property on the overlay.
|
||||
Leave point at the end of the field."
|
||||
(cl-assert templ)
|
||||
(when (> end (overlay-end templ))
|
||||
(move-overlay templ (overlay-start templ) end))
|
||||
(let ((ov (make-overlay beg end))
|
||||
(siblings (overlay-get templ 'company-template-fields)))
|
||||
;; (overlay-put ov 'evaporate t)
|
||||
(overlay-put ov 'intangible t)
|
||||
(overlay-put ov 'face 'company-template-field)
|
||||
(when display
|
||||
(overlay-put ov 'display display))
|
||||
(overlay-put ov 'company-template-parent templ)
|
||||
(overlay-put ov 'insert-in-front-hooks '(company-template-insert-hook))
|
||||
(push ov siblings)
|
||||
(overlay-put templ 'company-template-fields siblings)))
|
||||
|
||||
(defun company-template-remove-field (ovl &optional clear)
|
||||
(when (overlayp ovl)
|
||||
(when (overlay-buffer ovl)
|
||||
(when clear
|
||||
(delete-region (overlay-start ovl) (overlay-end ovl)))
|
||||
(delete-overlay ovl))
|
||||
(let* ((templ (overlay-get ovl 'company-template-parent))
|
||||
(siblings (overlay-get templ 'company-template-fields)))
|
||||
(setq siblings (delq ovl siblings))
|
||||
(overlay-put templ 'company-template-fields siblings))))
|
||||
|
||||
(defun company-template-clean-up (&optional pos)
|
||||
"Clean up all templates that don't contain POS."
|
||||
(let ((local-ovs (overlays-at (or pos (point)))))
|
||||
(dolist (templ company-template--buffer-templates)
|
||||
(unless (memq templ local-ovs)
|
||||
(company-template-remove-template templ)))))
|
||||
|
||||
;; hooks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun company-template-insert-hook (ovl after-p &rest _ignore)
|
||||
"Called when a snippet input prompt is modified."
|
||||
(unless after-p
|
||||
(company-template-remove-field ovl t)))
|
||||
|
||||
(defun company-template-post-command ()
|
||||
(company-template-clean-up)
|
||||
(unless company-template--buffer-templates
|
||||
(remove-hook 'post-command-hook 'company-template-post-command t)))
|
||||
|
||||
;; common ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun company-template-c-like-templatify (call)
|
||||
(let* ((end (point-marker))
|
||||
(beg (- (point) (length call)))
|
||||
(templ (company-template-declare-template beg end))
|
||||
paren-open paren-close)
|
||||
(with-syntax-table (make-syntax-table (syntax-table))
|
||||
(modify-syntax-entry ?< "(")
|
||||
(modify-syntax-entry ?> ")")
|
||||
(when (search-backward ")" beg t)
|
||||
(setq paren-close (point-marker))
|
||||
(forward-char 1)
|
||||
(delete-region (point) end)
|
||||
(backward-sexp)
|
||||
(forward-char 1)
|
||||
(setq paren-open (point-marker)))
|
||||
(when (search-backward ">" beg t)
|
||||
(let ((angle-close (point-marker)))
|
||||
(forward-char 1)
|
||||
(backward-sexp)
|
||||
(forward-char)
|
||||
(company-template--c-like-args templ angle-close)))
|
||||
(when (looking-back "\\((\\*)\\)(" (line-beginning-position))
|
||||
(delete-region (match-beginning 1) (match-end 1)))
|
||||
(when paren-open
|
||||
(goto-char paren-open)
|
||||
(company-template--c-like-args templ paren-close)))
|
||||
(if (overlay-get templ 'company-template-fields)
|
||||
(company-template-move-to-first templ)
|
||||
(company-template-remove-template templ)
|
||||
(goto-char end))))
|
||||
|
||||
(defun company-template--c-like-args (templ end)
|
||||
(let ((last-pos (point)))
|
||||
(while (re-search-forward "\\([^,]+\\),?" end 'move)
|
||||
(when (zerop (car (parse-partial-sexp last-pos (point))))
|
||||
(company-template-add-field templ last-pos (match-end 1))
|
||||
(skip-chars-forward " ")
|
||||
(setq last-pos (point))))))
|
||||
|
||||
;; objc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun company-template-objc-templatify (selector)
|
||||
(let* ((end (point-marker))
|
||||
(beg (- (point) (length selector) 1))
|
||||
(templ (company-template-declare-template beg end))
|
||||
(cnt 0))
|
||||
(save-excursion
|
||||
(goto-char beg)
|
||||
(catch 'stop
|
||||
(while (search-forward ":" end t)
|
||||
(if (looking-at "\\(([^)]*)\\) ?")
|
||||
(company-template-add-field templ (point) (match-end 1))
|
||||
;; Not sure which conditions this case manifests under, but
|
||||
;; apparently it did before, when I wrote the first test for this
|
||||
;; function. FIXME: Revisit it.
|
||||
(company-template-add-field templ (point)
|
||||
(progn
|
||||
(insert (format "arg%d" cnt))
|
||||
(point)))
|
||||
(when (< (point) end)
|
||||
(insert " "))
|
||||
(cl-incf cnt))
|
||||
(when (>= (point) end)
|
||||
(throw 'stop t)))))
|
||||
(company-template-move-to-first templ)))
|
||||
|
||||
(provide 'company-template)
|
||||
;;; company-template.el ends here
|
||||
@@ -1,71 +0,0 @@
|
||||
;;; company-tempo.el --- company-mode completion backend for tempo
|
||||
|
||||
;; 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 'tempo)
|
||||
|
||||
(defgroup company-tempo nil
|
||||
"Tempo completion backend."
|
||||
:group 'company)
|
||||
|
||||
(defcustom company-tempo-expand nil
|
||||
"Whether to expand a tempo tag after completion."
|
||||
:type '(choice (const :tag "Off" nil)
|
||||
(const :tag "On" t)))
|
||||
|
||||
(defsubst company-tempo-lookup (match)
|
||||
(cdr (assoc match (tempo-build-collection))))
|
||||
|
||||
(defun company-tempo-insert (match)
|
||||
"Replace MATCH with the expanded tempo template."
|
||||
(search-backward match)
|
||||
(goto-char (match-beginning 0))
|
||||
(replace-match "")
|
||||
(call-interactively (company-tempo-lookup match)))
|
||||
|
||||
(defsubst company-tempo-meta (match)
|
||||
(let ((templ (company-tempo-lookup match))
|
||||
doc)
|
||||
(and templ
|
||||
(setq doc (documentation templ t))
|
||||
(car (split-string doc "\n" t)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-tempo (command &optional arg &rest ignored)
|
||||
"`company-mode' completion backend for tempo."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-tempo))
|
||||
(prefix (or (car (tempo-find-match-string tempo-match-finder)) ""))
|
||||
(candidates (all-completions arg (tempo-build-collection)))
|
||||
(meta (company-tempo-meta arg))
|
||||
(post-completion (when company-tempo-expand (company-tempo-insert arg)))
|
||||
(sorted t)))
|
||||
|
||||
(provide 'company-tempo)
|
||||
;;; company-tempo.el ends here
|
||||
@@ -1,123 +0,0 @@
|
||||
;;; company-xcode.el --- company-mode completion backend for Xcode projects
|
||||
|
||||
;; 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)
|
||||
|
||||
(defgroup company-xcode nil
|
||||
"Completion backend for Xcode projects."
|
||||
:group 'company)
|
||||
|
||||
(defcustom company-xcode-xcodeindex-executable (executable-find "xcodeindex")
|
||||
"Location of xcodeindex executable."
|
||||
:type 'file)
|
||||
|
||||
(defvar company-xcode-tags nil)
|
||||
|
||||
(defun company-xcode-reset ()
|
||||
"Reset the cached tags."
|
||||
(interactive)
|
||||
(setq company-xcode-tags nil))
|
||||
|
||||
(defcustom company-xcode-types
|
||||
'("Class" "Constant" "Enum" "Macro" "Modeled Class" "Structure"
|
||||
"Type" "Union" "Function")
|
||||
"The types of symbols offered by `company-xcode'.
|
||||
No context-enabled completion is available. Types like methods will be
|
||||
offered regardless of whether the class supports them. The defaults should be
|
||||
valid in most contexts."
|
||||
:set (lambda (variable value)
|
||||
(set variable value)
|
||||
(company-xcode-reset))
|
||||
:type '(set (const "Category") (const "Class") (const "Class Method")
|
||||
(const "Class Variable") (const "Constant") (const "Enum")
|
||||
(const "Field") (const "Instance Method")
|
||||
(const "Instance Variable") (const "Macro")
|
||||
(const "Modeled Class") (const "Modeled Method")
|
||||
(const "Modeled Property") (const "Property") (const "Protocol")
|
||||
(const "Structure") (const "Type") (const "Union")
|
||||
(const "Variable") (const "Function")))
|
||||
|
||||
(defvar-local company-xcode-project 'unknown)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun company-xcode-fetch (project-bundle)
|
||||
(setq project-bundle (directory-file-name project-bundle))
|
||||
(message "Retrieving dump from %s..." project-bundle)
|
||||
(with-temp-buffer
|
||||
(let ((default-directory (file-name-directory project-bundle)))
|
||||
(call-process company-xcode-xcodeindex-executable nil (current-buffer)
|
||||
nil "dump" "-project"
|
||||
(file-name-nondirectory project-bundle) "-quiet")
|
||||
(goto-char (point-min))
|
||||
(let ((regexp (concat "^\\([^\t\n]*\\)\t[^\t\n]*\t"
|
||||
(regexp-opt company-xcode-types)
|
||||
"\t[^\t\n]*\t[^\t\n]*"))
|
||||
candidates)
|
||||
(while (re-search-forward regexp nil t)
|
||||
(cl-pushnew (match-string 1) candidates :test #'equal))
|
||||
(message "Retrieving dump from %s...done" project-bundle)
|
||||
candidates))))
|
||||
|
||||
(defun company-xcode-find-project ()
|
||||
(let ((dir (if buffer-file-name
|
||||
(file-name-directory buffer-file-name)
|
||||
(expand-file-name default-directory)))
|
||||
(prev-dir nil)
|
||||
file)
|
||||
(while (not (or file (equal dir prev-dir)))
|
||||
(setq file (car (directory-files dir t ".xcodeproj\\'" t))
|
||||
prev-dir dir
|
||||
dir (file-name-directory (directory-file-name dir))))
|
||||
file))
|
||||
|
||||
(defun company-xcode-tags ()
|
||||
(when (eq company-xcode-project 'unknown)
|
||||
(setq company-xcode-project (company-xcode-find-project)))
|
||||
(when company-xcode-project
|
||||
(cdr (or (assoc company-xcode-project company-xcode-tags)
|
||||
(car (push (cons company-xcode-project
|
||||
(company-xcode-fetch company-xcode-project))
|
||||
company-xcode-tags))))))
|
||||
;;;###autoload
|
||||
(defun company-xcode (command &optional arg &rest ignored)
|
||||
"`company-mode' completion backend for Xcode projects."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-xcode))
|
||||
(prefix (and company-xcode-xcodeindex-executable
|
||||
(company-xcode-tags)
|
||||
(not (company-in-string-or-comment))
|
||||
(or (company-grab-symbol) 'stop)))
|
||||
(candidates (let ((completion-ignore-case nil))
|
||||
(company-xcode-tags)
|
||||
(all-completions arg (company-xcode-tags))))))
|
||||
|
||||
|
||||
(provide 'company-xcode)
|
||||
;;; company-xcode.el ends here
|
||||
@@ -1,147 +0,0 @@
|
||||
;;; company-yasnippet.el --- company-mode completion backend for Yasnippet
|
||||
|
||||
;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Dmitry Gutov
|
||||
|
||||
;; 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 yas--table-hash "yasnippet")
|
||||
(declare-function yas--get-snippet-tables "yasnippet")
|
||||
(declare-function yas-expand-snippet "yasnippet")
|
||||
(declare-function yas--template-content "yasnippet")
|
||||
(declare-function yas--template-expand-env "yasnippet")
|
||||
(declare-function yas--warning "yasnippet")
|
||||
|
||||
(defun company-yasnippet--key-prefixes ()
|
||||
;; Mostly copied from `yas--templates-for-key-at-point'.
|
||||
(defvar yas-key-syntaxes)
|
||||
(save-excursion
|
||||
(let ((original (point))
|
||||
(methods yas-key-syntaxes)
|
||||
prefixes
|
||||
method)
|
||||
(while methods
|
||||
(unless (eq method (car methods))
|
||||
(goto-char original))
|
||||
(setq method (car methods))
|
||||
(cond ((stringp method)
|
||||
(skip-syntax-backward method)
|
||||
(setq methods (cdr methods)))
|
||||
((functionp method)
|
||||
(unless (eq (funcall method original)
|
||||
'again)
|
||||
(setq methods (cdr methods))))
|
||||
(t
|
||||
(setq methods (cdr methods))
|
||||
(yas--warning "Invalid element `%s' in `yas-key-syntaxes'" method)))
|
||||
(let ((prefix (buffer-substring-no-properties (point) original)))
|
||||
(unless (equal prefix (car prefixes))
|
||||
(push prefix prefixes))))
|
||||
prefixes)))
|
||||
|
||||
(defun company-yasnippet--candidates (prefix)
|
||||
;; Process the prefixes in reverse: unlike Yasnippet, we look for prefix
|
||||
;; matches, so the longest prefix with any matches should be the most useful.
|
||||
(cl-loop with tables = (yas--get-snippet-tables)
|
||||
for key-prefix in (company-yasnippet--key-prefixes)
|
||||
;; Only consider keys at least as long as the symbol at point.
|
||||
when (>= (length key-prefix) (length prefix))
|
||||
thereis (company-yasnippet--completions-for-prefix prefix
|
||||
key-prefix
|
||||
tables)))
|
||||
|
||||
(defun company-yasnippet--completions-for-prefix (prefix key-prefix tables)
|
||||
(cl-mapcan
|
||||
(lambda (table)
|
||||
(let ((keyhash (yas--table-hash table))
|
||||
res)
|
||||
(when keyhash
|
||||
(maphash
|
||||
(lambda (key value)
|
||||
(when (and (stringp key)
|
||||
(string-prefix-p key-prefix key))
|
||||
(maphash
|
||||
(lambda (name template)
|
||||
(push
|
||||
(propertize key
|
||||
'yas-annotation name
|
||||
'yas-template template
|
||||
'yas-prefix-offset (- (length key-prefix)
|
||||
(length prefix)))
|
||||
res))
|
||||
value)))
|
||||
keyhash))
|
||||
res))
|
||||
tables))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-yasnippet (command &optional arg &rest ignore)
|
||||
"`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)
|
||||
"
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-yasnippet))
|
||||
(prefix
|
||||
;; Should probably use `yas--current-key', but that's bound to be slower.
|
||||
;; How many trigger keys start with non-symbol characters anyway?
|
||||
(and (bound-and-true-p yas-minor-mode)
|
||||
(company-grab-symbol)))
|
||||
(annotation
|
||||
(concat
|
||||
(unless company-tooltip-align-annotations " -> ")
|
||||
(get-text-property 0 'yas-annotation arg)))
|
||||
(candidates (company-yasnippet--candidates arg))
|
||||
(no-cache t)
|
||||
(post-completion
|
||||
(let ((template (get-text-property 0 'yas-template arg))
|
||||
(prefix-offset (get-text-property 0 'yas-prefix-offset arg)))
|
||||
(yas-expand-snippet (yas--template-content template)
|
||||
(- (point) (length arg) prefix-offset)
|
||||
(point)
|
||||
(yas--template-expand-env template))))))
|
||||
|
||||
(provide 'company-yasnippet)
|
||||
;;; company-yasnippet.el ends here
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,22 +0,0 @@
|
||||
;;; company-c-headers-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||
|
||||
;;;### (autoloads nil "company-c-headers" "company-c-headers.el"
|
||||
;;;;;; (22297 53348 894925 450000))
|
||||
;;; Generated autoloads from company-c-headers.el
|
||||
|
||||
(autoload 'company-c-headers "company-c-headers" "\
|
||||
Company backend for C/C++ header files.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; company-c-headers-autoloads.el ends here
|
||||
@@ -1 +0,0 @@
|
||||
(define-package "company-c-headers" "20150801.901" "Company mode backend for C/C++ header files" '((emacs "24.1") (company "0.8")) :keywords '("development" "company"))
|
||||
@@ -1,188 +0,0 @@
|
||||
;;; company-c-headers.el --- Company mode backend for C/C++ header files -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2014 Alastair Rankine
|
||||
|
||||
;; Author: Alastair Rankine <alastair@girtby.net>
|
||||
;; Keywords: development company
|
||||
;; Package-Version: 20150801.901
|
||||
;; Package-Requires: ((emacs "24.1") (company "0.8"))
|
||||
|
||||
;; This file is not 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 of the License, 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 this file. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This library enables the completion of C/C++ header file names using Company.
|
||||
;;
|
||||
;; To initialize it, just add it to `company-backends':
|
||||
;;
|
||||
;; (add-to-list 'company-backends 'company-c-headers)
|
||||
;;
|
||||
;; When you type an #include declaration within a supported major mode (see
|
||||
;; `company-c-headers-modes'), company-c-headers will search for header files
|
||||
;; within predefined search paths. company-c-headers can search "system" and
|
||||
;; "user" paths, depending on the type of #include declaration you type.
|
||||
;;
|
||||
;; You will probably want to customize the `company-c-headers-path-user' and
|
||||
;; `company-c-headers-path-system' variables for your specific needs.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'company)
|
||||
(require 'rx)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defgroup company-c-headers nil
|
||||
"Completion back-end for C/C++ header files."
|
||||
:group 'company)
|
||||
|
||||
(defcustom company-c-headers-path-system
|
||||
'("/usr/include/" "/usr/local/include/")
|
||||
"List of paths to search for system (i.e. angle-bracket
|
||||
delimited) header files. Alternatively, a function can be
|
||||
supplied which returns the path list."
|
||||
:type '(choice (repeat directory)
|
||||
function)
|
||||
)
|
||||
|
||||
(defcustom company-c-headers-path-user
|
||||
'(".")
|
||||
"List of paths to search for user (i.e. double-quote delimited)
|
||||
header files. Alternatively, a function can be supplied which
|
||||
returns the path list. Note that paths in
|
||||
`company-c-headers-path-system' are implicitly appended."
|
||||
:type '(choice (repeat directory)
|
||||
function)
|
||||
)
|
||||
|
||||
(defvar company-c-headers-include-declaration
|
||||
(rx
|
||||
line-start
|
||||
"#" (zero-or-more blank) (or "include" "import")
|
||||
(one-or-more blank)
|
||||
(submatch
|
||||
(in "<\"")
|
||||
(zero-or-more (not (in ">\""))))
|
||||
)
|
||||
"Prefix matching C/C++/ObjC include directives.")
|
||||
|
||||
(defvar company-c-headers-modes
|
||||
`(
|
||||
(c-mode . ,(rx ".h" line-end))
|
||||
(c++-mode . ,(rx (or (: line-start (one-or-more (in "A-Za-z0-9_")))
|
||||
(or ".h" ".hpp" ".hxx" ".hh"))
|
||||
line-end))
|
||||
(objc-mode . ,(rx ".h" line-end))
|
||||
)
|
||||
"Assoc list of supported major modes and associated header file names.")
|
||||
|
||||
(defun call-if-function (path)
|
||||
"If PATH is bound to a function, return the result of calling it.
|
||||
Otherwise just return the value."
|
||||
(if (functionp path)
|
||||
(funcall path)
|
||||
path))
|
||||
|
||||
(defun company-c-headers--candidates-for (prefix dir)
|
||||
"Return a list of candidates for PREFIX in directory DIR.
|
||||
Filters on the appropriate regex for the current major mode."
|
||||
(let* ((delim (substring prefix 0 1))
|
||||
(fileprefix (substring prefix 1))
|
||||
(prefixdir (file-name-directory fileprefix))
|
||||
(subdir (and prefixdir (concat (file-name-as-directory dir) prefixdir)))
|
||||
(hdrs (cdr (assoc major-mode company-c-headers-modes)))
|
||||
candidates)
|
||||
|
||||
;; If we need to complete inside a subdirectory, use that
|
||||
(when (and subdir (file-directory-p subdir))
|
||||
(setq dir subdir)
|
||||
(setq fileprefix (file-name-nondirectory fileprefix))
|
||||
(setq delim (concat delim prefixdir))
|
||||
)
|
||||
|
||||
;; Using a list of completions for this directory, remove those that a) don't match the
|
||||
;; headers regexp, and b) are not directories (except for "." and ".." which ARE removed)
|
||||
(setq candidates (cl-remove-if
|
||||
(lambda (F) (and (not (string-match-p hdrs F))
|
||||
(or (cl-member (directory-file-name F) '("." "..") :test 'equal)
|
||||
(not (file-directory-p (concat (file-name-as-directory dir) F))))))
|
||||
(file-name-all-completions fileprefix dir)))
|
||||
|
||||
;; We want to see candidates in alphabetical order per directory
|
||||
(setq candidates (sort candidates #'string<))
|
||||
|
||||
;; Add the delimiter and metadata
|
||||
(mapcar (lambda (C) (propertize (concat delim C) 'directory dir)) candidates)
|
||||
))
|
||||
|
||||
(defun company-c-headers--candidates (prefix)
|
||||
"Return candidates for PREFIX."
|
||||
(let ((p (if (equal (aref prefix 0) ?\")
|
||||
(call-if-function company-c-headers-path-user)
|
||||
(call-if-function company-c-headers-path-system)))
|
||||
(next (when (equal (aref prefix 0) ?\")
|
||||
(call-if-function company-c-headers-path-system)))
|
||||
candidates)
|
||||
(while p
|
||||
(when (file-directory-p (car p))
|
||||
(setq candidates (append candidates (company-c-headers--candidates-for prefix (car p)))))
|
||||
|
||||
(setq p (or (cdr p)
|
||||
(let ((tmp next))
|
||||
(setq next nil)
|
||||
tmp)))
|
||||
)
|
||||
candidates
|
||||
))
|
||||
|
||||
(defun company-c-headers--meta (candidate)
|
||||
"Return the metadata associated with CANDIDATE. Currently just the directory."
|
||||
(get-text-property 0 'directory candidate))
|
||||
|
||||
(defun company-c-headers--location (candidate)
|
||||
"Return the location associated with CANDIDATE."
|
||||
(cons (concat (file-name-as-directory (get-text-property 0 'directory candidate))
|
||||
(file-name-nondirectory (substring candidate 1)))
|
||||
1))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-c-headers (command &optional arg &rest ignored)
|
||||
"Company backend for C/C++ header files."
|
||||
(interactive (list 'interactive))
|
||||
(pcase command
|
||||
(`interactive (company-begin-backend 'company-c-headers))
|
||||
(`prefix
|
||||
(when (and (assoc major-mode company-c-headers-modes)
|
||||
(looking-back company-c-headers-include-declaration (line-beginning-position)))
|
||||
(match-string-no-properties 1)))
|
||||
(`sorted t)
|
||||
(`candidates (company-c-headers--candidates arg))
|
||||
(`meta (company-c-headers--meta arg))
|
||||
(`location (company-c-headers--location arg))
|
||||
(`post-completion
|
||||
(when (looking-back company-c-headers-include-declaration (line-beginning-position))
|
||||
(let ((matched (match-string-no-properties 1)))
|
||||
;; Add a terminating delimiter unless we've completed a directory name
|
||||
;; If pre-existing terminating delimiter already exist, move cursor
|
||||
;; to end of line.
|
||||
(unless (equal matched (file-name-as-directory matched))
|
||||
(pcase (aref matched 0)
|
||||
(?\" (if (looking-at "\"") (end-of-line) (insert "\"")))
|
||||
(?< (if (looking-at ">") (end-of-line) (insert ">"))))))))
|
||||
))
|
||||
|
||||
(provide 'company-c-headers)
|
||||
|
||||
;;; company-c-headers.el ends here
|
||||
@@ -1,34 +0,0 @@
|
||||
;;; company-emoji-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "company-emoji" "company-emoji.el" (22539 28067
|
||||
;;;;;; 410569 200000))
|
||||
;;; Generated autoloads from company-emoji.el
|
||||
|
||||
(autoload 'company-emoji "company-emoji" "\
|
||||
Provide a backend for company to complete emoji-words.
|
||||
|
||||
company.el calls this function, and passes a COMMAND to it that
|
||||
depends on the context: 'prefix', 'candidates', 'annotation',
|
||||
etc. In some contexts it also passes ARG, which is the list of
|
||||
candidates that match what has been typed so far. Sometimes ARG
|
||||
is a single candidate, as when COMMAND is 'annotation' or
|
||||
'post-completion'. Other arguments are IGNORED.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" nil nil)
|
||||
|
||||
(autoload 'company-emoji-init "company-emoji" "\
|
||||
Add emoji to the company backends.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; company-emoji-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "company-emoji" "20160331.1641" "company-mode backend for emoji" '((cl-lib "0.5") (company "0.8.0")) :url "https://github.com/dunn/company-emoji.git" :keywords '("emoji" "company" "honk"))
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,23 +0,0 @@
|
||||
;;; company-restclient-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "company-restclient" "company-restclient.el"
|
||||
;;;;;; (22538 5602 910843 848000))
|
||||
;;; Generated autoloads from company-restclient.el
|
||||
|
||||
(autoload 'company-restclient "company-restclient" "\
|
||||
`company-mode' completion back-end for `restclient-mode'.
|
||||
Provide completion info according to COMMAND and ARG. IGNORED, not used.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; company-restclient-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "company-restclient" "20151202.401" "company-mode completion back-end for restclient-mode" '((cl-lib "0.5") (company "0.8.0") (emacs "24") (know-your-http-well "0.2.0") (restclient "0.0.0")) :url "https://github.com/iquiw/company-restclient")
|
||||
@@ -1,140 +0,0 @@
|
||||
;;; company-restclient.el --- company-mode completion back-end for restclient-mode
|
||||
|
||||
;; Public domain.
|
||||
|
||||
;; Author: Iku Iwasa <iku.iwasa@gmail.com>
|
||||
;; URL: https://github.com/iquiw/company-restclient
|
||||
;; Package-Version: 20151202.401
|
||||
;; Version: 0.2.0
|
||||
;; Package-Requires: ((cl-lib "0.5") (company "0.8.0") (emacs "24") (know-your-http-well "0.2.0") (restclient "0.0.0"))
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; `company-mode' back-end for `restclient-mode'.
|
||||
;;
|
||||
;; It provides auto-completion for HTTP methods and headers in `restclient-mode'.
|
||||
;; Completion source is given by `know-your-http-well'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'company)
|
||||
(require 'know-your-http-well)
|
||||
(require 'restclient)
|
||||
|
||||
(defcustom company-restclient-header-values
|
||||
'(("content-type" . ("application/json"
|
||||
"application/xml"
|
||||
"application/x-www-form-urlencoded"
|
||||
"text/csv"
|
||||
"text/html"
|
||||
"text/plain")))
|
||||
"Association list of completion candidates for HTTP header values.
|
||||
The key is header name and the value is list of header values.")
|
||||
|
||||
(defvar company-restclient--current-context nil)
|
||||
|
||||
(defun company-restclient--find-context ()
|
||||
"Find context (method, header, body) of the current line."
|
||||
(save-excursion
|
||||
(forward-line 0)
|
||||
(cond
|
||||
((looking-at-p "^:") 'vardecl)
|
||||
((looking-at-p "^#") 'comment)
|
||||
(t
|
||||
(catch 'result
|
||||
(let ((state 0))
|
||||
(while (and (>= (forward-line -1) 0)
|
||||
(null (looking-at-p "^#")))
|
||||
(cond
|
||||
((looking-at-p "^\\([[:space:]]*$\\|:\\)")
|
||||
(cond
|
||||
((= state 0) (setq state 1))
|
||||
((= state 2) (setq state 3))))
|
||||
((= state 0) (setq state 2))
|
||||
((or (= state 1) (= state 3))
|
||||
(throw 'result 'body))))
|
||||
|
||||
(if (or (= state 0) (= state 1))
|
||||
(throw 'result 'method)
|
||||
(throw 'result 'header))))))))
|
||||
|
||||
(defun company-restclient-prefix ()
|
||||
"Provide completion prefix at the current point."
|
||||
(cl-case (company-restclient--find-context)
|
||||
(method (or (let ((case-fold-search nil)) (company-grab "^[[:upper:]]*"))
|
||||
(company-restclient--grab-var)))
|
||||
(header (or (company-grab "^[-[:alpha:]]*")
|
||||
(company-restclient--grab-var)
|
||||
(company-grab-symbol)))
|
||||
(vardecl nil)
|
||||
(comment nil)
|
||||
(t (company-restclient--grab-var))))
|
||||
|
||||
(defun company-restclient--grab-var ()
|
||||
"Grab variable for completion prefix."
|
||||
(company-grab ".\\(:[^: \n]*\\)" 1))
|
||||
|
||||
(defun company-restclient-candidates (prefix)
|
||||
"Provide completion candidates for the given PREFIX."
|
||||
(cond
|
||||
((string-match-p "^:" prefix)
|
||||
(setq company-restclient--current-context 'varref)
|
||||
(all-completions
|
||||
prefix
|
||||
(sort (mapcar #'car (restclient-find-vars-before-point)) #'string<)))
|
||||
(t
|
||||
(cl-case (setq company-restclient--current-context
|
||||
(company-restclient--find-context))
|
||||
(method
|
||||
(all-completions prefix http-methods))
|
||||
(header
|
||||
(cond
|
||||
((looking-back "^\\([-[:alpha:]]+\\): .*")
|
||||
(setq company-restclient--current-context 'header-value)
|
||||
(all-completions prefix
|
||||
(cdr
|
||||
(assoc
|
||||
(downcase (match-string-no-properties 1))
|
||||
company-restclient-header-values))))
|
||||
(t
|
||||
(all-completions (downcase prefix) http-headers))))))))
|
||||
|
||||
(defun company-restclient-meta (candidate)
|
||||
"Return description of CANDIDATE to display as meta information."
|
||||
(cl-case company-restclient--current-context
|
||||
(method (cl-caadr (assoc candidate http-methods)))
|
||||
(header (cl-caadr (assoc candidate http-headers)))))
|
||||
|
||||
(defun company-restclient-post-completion (candidate)
|
||||
"Format CANDIDATE in the buffer according to the current context.
|
||||
For HTTP method, insert space after it.
|
||||
For HTTP header, capitalize if necessary and insert colon and space after it."
|
||||
(cl-case company-restclient--current-context
|
||||
(method (insert " "))
|
||||
(header (let (start (end (point)))
|
||||
(when (save-excursion
|
||||
(backward-char (length candidate))
|
||||
(setq start (point))
|
||||
(let ((case-fold-search nil))
|
||||
(looking-at-p "[[:upper:]]")))
|
||||
(delete-region start end)
|
||||
(insert
|
||||
(mapconcat 'capitalize (split-string candidate "-") "-"))))
|
||||
(insert ": "))))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-restclient (command &optional arg &rest ignored)
|
||||
"`company-mode' completion back-end for `restclient-mode'.
|
||||
Provide completion info according to COMMAND and ARG. IGNORED, not used."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-restclient))
|
||||
(prefix (and (derived-mode-p 'restclient-mode) (company-restclient-prefix)))
|
||||
(candidates (company-restclient-candidates arg))
|
||||
(ignore-case 'keep-prefix)
|
||||
(meta (company-restclient-meta arg))
|
||||
(post-completion (company-restclient-post-completion arg))))
|
||||
|
||||
(provide 'company-restclient)
|
||||
;;; company-restclient.el ends here
|
||||
@@ -1,32 +0,0 @@
|
||||
;;; company-shell-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "company-shell" "company-shell.el" (22514 17686
|
||||
;;;;;; 400754 769000))
|
||||
;;; Generated autoloads from company-shell.el
|
||||
|
||||
(autoload 'company-shell-rebuild-cache "company-shell" "\
|
||||
Builds the cache of all completions found on the $PATH and all fish functions.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'company-fish-shell "company-shell" "\
|
||||
Company backend for fish shell functions.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
(autoload 'company-shell "company-shell" "\
|
||||
Company mode backend for binaries found on the $PATH.
|
||||
|
||||
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; company-shell-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "company-shell" "20161002.505" "Company mode backend for shell functions" '((company "0.8.12") (dash "2.12.0") (cl-lib "0.5")) :url "https://github.com/Alexander-Miller/company-shell" :keywords '("company" "shell"))
|
||||
@@ -1,184 +0,0 @@
|
||||
;;; company-shell.el --- Company mode backend for shell functions
|
||||
|
||||
;; Copyright (C) 2015 Alexander Miller
|
||||
|
||||
;; Author: Alexander Miller <alexanderm@web.de>
|
||||
;; Package-Requires: ((company "0.8.12") (dash "2.12.0") (cl-lib "0.5"))
|
||||
;; Package-Version: 20161002.505
|
||||
;; Homepage: https://github.com/Alexander-Miller/company-shell
|
||||
;; Version: 1.0
|
||||
;; Keywords: company, shell
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Backend for company mode to complete binaries found on your $PATH
|
||||
;; and fish shell functions.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'company)
|
||||
(require 'dash)
|
||||
(require 'cl-lib)
|
||||
(require 'subr-x)
|
||||
|
||||
(defvar company-shell--cache nil
|
||||
"Cache of all possible $PATH completions. Automatically built when nil. Invoke `company-shell-rebuild-cache' to rebuild manually.")
|
||||
|
||||
(defvar company-shell--fish-cache nil
|
||||
"Cache of all possible fish shell function completions. Automatically built when nil. Invoke `company-shell-rebuild-cache' to rebuild manually.")
|
||||
|
||||
(defvar company-shell-delete-duplicates t
|
||||
"If non-nil the list of completions will be purged of duplicates. Duplicates in this context means any two
|
||||
string-equal entries, regardless where they have been found. This would prevent a completion candidate
|
||||
appearing twice because it is found in both /usr/bin/ and /usr/local/bin.
|
||||
|
||||
For a change to this variable to take effect the cache needs to be rebuilt via `company-shell-rebuild-cache'.")
|
||||
|
||||
(defvar company-shell-modes '(sh-mode fish-mode shell-mode eshell-mode)
|
||||
"List of major modes where `company-shell' will be providing completions if it is part of `company-backends'.
|
||||
All modes not on this list will be ignored. Set value to nil to enable company-shell regardless of current major-mode.")
|
||||
|
||||
(defvar company-fish-shell-modes '(fish-mode shell-mode)
|
||||
"List of major modes where `company-fish-shell' will be providing completions if it is part of `company-backends'.
|
||||
All modes not on this list will be ignored. Set value to nil to enable company-fish-shell regardless of current major-mode.")
|
||||
|
||||
(defvar company-shell-use-help-arg nil
|
||||
"SETTING THIS TO t IS POTENTIALLY UNSAFE.
|
||||
|
||||
If non-nil company-(fish)-shell will try and find a doc-string by running `arg --help'
|
||||
if `man arg' did not produce any valid results. This is not completely safe since
|
||||
company-shell does not and can not know whether it is safe to run a command in this
|
||||
fashion. Some applications may simply ignore or misinterpret the command flag, with
|
||||
unpredictable results. Usually this just means that instead of any actual documentation
|
||||
you'll see an error message telling you the program doesn't know what to do with the
|
||||
--help arg or that it was started with invalid input. In rare cases a program may simple
|
||||
ignore the --help arg and directly spawn a GUI like xfce4-notes-settings does.
|
||||
|
||||
To mitigate any such issues company-shell will run the --help attempt on a timer of
|
||||
1 second. This is more than enough to fetch the doc output if it is available, but will
|
||||
quickly close any process that may accidentally have been spawned. In addition the command
|
||||
will run in a restricted shell (via $(which sh) --restricted) to further avoid any unwanted
|
||||
side effects.
|
||||
|
||||
Despite these precautions company-shell will nonetheless need to sometimes run completely unknown
|
||||
binaries, which is why this option is turned off by default. You need to consciously enable
|
||||
it in the understanding that you do this AT YOUR OWN RISK.")
|
||||
|
||||
(defun company-shell--fetch-candidates ()
|
||||
(unless company-shell--cache (company-shell--build-cache))
|
||||
company-shell--cache)
|
||||
|
||||
(defun company-shell--fetch-fish-candidates ()
|
||||
(unless company-shell--fish-cache (company-shell--build-fish-cache))
|
||||
company-shell--fish-cache)
|
||||
|
||||
(defun company-shell--build-cache ()
|
||||
(let ((completions (-mapcat
|
||||
(lambda (dir)
|
||||
(-map
|
||||
(lambda (file)
|
||||
(propertize (file-name-sans-extension file)
|
||||
'origin dir))
|
||||
(directory-files dir)))
|
||||
(-filter 'file-readable-p exec-path))))
|
||||
(setq company-shell--cache (sort
|
||||
(if company-shell-delete-duplicates
|
||||
(delete-dups completions)
|
||||
completions)
|
||||
'string-lessp))))
|
||||
|
||||
(defun company-shell--build-fish-cache ()
|
||||
(when (executable-find "fish")
|
||||
(setq company-shell--fish-cache
|
||||
(-> (shell-command-to-string "fish -c \"functions -a\"")
|
||||
(split-string "\n")
|
||||
(sort 'string-lessp)))))
|
||||
|
||||
(defun company-shell--prefix (mode-list)
|
||||
(when (or (null mode-list)
|
||||
(-contains? mode-list major-mode))
|
||||
(company-grab-symbol)))
|
||||
|
||||
(defun company-shell--doc-buffer (arg)
|
||||
(company-doc-buffer
|
||||
(let ((man-page (shell-command-to-string (format "man %s" arg))))
|
||||
(if (or
|
||||
(null man-page)
|
||||
(string= man-page "")
|
||||
(string-prefix-p "No manual entry" man-page))
|
||||
(company-shell--help-page arg)
|
||||
man-page))))
|
||||
|
||||
(defun company-shell--help-page (arg)
|
||||
(when company-shell-use-help-arg
|
||||
(shell-command-to-string
|
||||
(format "echo \"timeout 1 %s --help\" | %s --restricted"
|
||||
arg
|
||||
(string-trim (shell-command-to-string "which sh"))))))
|
||||
|
||||
(defun company-shell--meta-string (arg)
|
||||
(-some-> (format "whatis %s" arg)
|
||||
(shell-command-to-string)
|
||||
(split-string "\n")
|
||||
(cl-first)
|
||||
(split-string " - ")
|
||||
(cl-second)))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-shell-rebuild-cache ()
|
||||
"Builds the cache of all completions found on the $PATH and all fish functions."
|
||||
(interactive)
|
||||
(company-shell--build-cache)
|
||||
(company-shell--build-fish-cache))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-fish-shell (command &optional arg &rest ignored)
|
||||
"Company backend for fish shell functions."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-fish-shell))
|
||||
(prefix (company-shell--prefix company-fish-shell-modes))
|
||||
(sorted t)
|
||||
(duplicates nil)
|
||||
(ignore-case nil)
|
||||
(no-cache nil)
|
||||
(annotation "Fish Function")
|
||||
(doc-buffer (company-shell--doc-buffer arg))
|
||||
(meta (company-shell--meta-string arg))
|
||||
(candidates (cl-remove-if-not
|
||||
(lambda (candidate) (string-prefix-p arg candidate))
|
||||
(company-shell--fetch-fish-candidates)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-shell (command &optional arg &rest ignored)
|
||||
"Company mode backend for binaries found on the $PATH."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-shell))
|
||||
(prefix (company-shell--prefix company-shell-modes))
|
||||
(sorted t)
|
||||
(duplicates nil)
|
||||
(ignore-case nil)
|
||||
(no-cache nil)
|
||||
(annotation (get-text-property 0 'origin arg))
|
||||
(doc-buffer (company-shell--doc-buffer arg))
|
||||
(meta (company-shell--meta-string arg))
|
||||
(candidates (cl-remove-if-not
|
||||
(lambda (candidate) (string-prefix-p arg candidate))
|
||||
(company-shell--fetch-candidates)))))
|
||||
|
||||
(provide 'company-shell)
|
||||
;;; company-shell.el ends here
|
||||
@@ -1,15 +0,0 @@
|
||||
;;; dash-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil nil ("dash.el") (22533 64997 280351 636000))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; dash-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "dash" "20161018.136" "A modern list library for Emacs" 'nil :keywords '("lists"))
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,57 +0,0 @@
|
||||
;;; diminish-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "diminish" "diminish.el" (22523 35881 630829
|
||||
;;;;;; 741000))
|
||||
;;; Generated autoloads from diminish.el
|
||||
|
||||
(autoload 'diminish "diminish" "\
|
||||
Diminish mode-line display of minor mode MODE to TO-WHAT (default \"\").
|
||||
|
||||
Interactively, enter (with completion) the name of any minor mode, followed
|
||||
on the next line by what you want it diminished to (default empty string).
|
||||
The response to neither prompt should be quoted. However, in Lisp code,
|
||||
both args must be quoted, the first as a symbol, the second as a string,
|
||||
as in (diminish 'jiggle-mode \" Jgl\").
|
||||
|
||||
The mode-line displays of minor modes usually begin with a space, so
|
||||
the modes' names appear as separate words on the mode line. However, if
|
||||
you're having problems with a cramped mode line, you may choose to use single
|
||||
letters for some modes, without leading spaces. Capitalizing them works
|
||||
best; if you then diminish some mode to \"X\" but have abbrev-mode enabled as
|
||||
well, you'll get a display like \"AbbrevX\". This function prepends a space
|
||||
to TO-WHAT if it's > 1 char long & doesn't already begin with a space.
|
||||
|
||||
\(fn MODE &optional TO-WHAT)" t nil)
|
||||
|
||||
(autoload 'diminish-undo "diminish" "\
|
||||
Restore mode-line display of diminished mode MODE to its minor-mode value.
|
||||
Do nothing if the arg is a minor mode that hasn't been diminished.
|
||||
|
||||
Interactively, enter (with completion) the name of any diminished mode (a
|
||||
mode that was formerly a minor mode on which you invoked \\[diminish]).
|
||||
To restore all diminished modes to minor status, answer `diminished-modes'.
|
||||
The response to the prompt shouldn't be quoted. However, in Lisp code,
|
||||
the arg must be quoted as a symbol, as in (diminish-undo 'diminished-modes).
|
||||
|
||||
\(fn MODE)" t nil)
|
||||
|
||||
(autoload 'diminished-modes "diminish" "\
|
||||
Echo all active diminished or minor modes as if they were minor.
|
||||
The display goes in the echo area; if it's too long even for that,
|
||||
you can see the whole thing in the *Messages* buffer.
|
||||
This doesn't change the status of any modes; it just lets you see
|
||||
what diminished modes would be on the mode-line if they were still minor.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; diminish-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "diminish" "20151215.915" "Diminished modes are minor modes with no modeline display" 'nil :url "https://github.com/myrjola/diminish.el" :keywords '("extensions" "diminish" "minor" "codeprose"))
|
||||
@@ -1,293 +0,0 @@
|
||||
;;; diminish.el --- Diminished modes are minor modes with no modeline display
|
||||
|
||||
;; Copyright (C) 1998 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Will Mengarini <seldon@eskimo.com>
|
||||
;; Maintainer: Martin Yrjölä <martin.yrjola@gmail.com>
|
||||
;; URL: <https://github.com/myrjola/diminish.el>
|
||||
;; Package-Version: 20151215.915
|
||||
;; Created: Th 19 Feb 98
|
||||
;; Version: 0.45
|
||||
;; Keywords: extensions, diminish, minor, codeprose
|
||||
|
||||
;; 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
|
||||
;; this program; see the file LICENSE. If not, write to the write to the Free
|
||||
;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||||
;; 02110-1301, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Minor modes each put a word on the mode line to signify that they're
|
||||
;; active. This can cause other displays, such as % of file that point is
|
||||
;; at, to run off the right side of the screen. For some minor modes, such
|
||||
;; as mouse-avoidance-mode, the display is a waste of space, since users
|
||||
;; typically set the mode in their .emacs & never change it. For other
|
||||
;; modes, such as my jiggle-mode, it's a waste because there's already a
|
||||
;; visual indication of whether the mode is in effect.
|
||||
|
||||
;; A diminished mode is a minor mode that has had its mode line
|
||||
;; display diminished, usually to nothing, although diminishing to a
|
||||
;; shorter word or a single letter is also supported. This package
|
||||
;; implements diminished modes.
|
||||
|
||||
;; You can use this package either interactively or from your .emacs file.
|
||||
;; In either case, first you'll need to copy this file to a directory that
|
||||
;; appears in your load-path. `load-path' is the name of a variable that
|
||||
;; contains a list of directories Emacs searches for files to load.
|
||||
;; To prepend another directory to load-path, put a line like
|
||||
;; (add-to-list 'load-path "c:/My_Directory") in your .emacs file.
|
||||
|
||||
;; To create diminished modes interactively, type
|
||||
;; M-x load-library
|
||||
;; to get a prompt like
|
||||
;; Load library:
|
||||
;; and respond `diminish' (unquoted). Then type
|
||||
;; M-x diminish
|
||||
;; to get a prompt like
|
||||
;; Diminish what minor mode:
|
||||
;; and respond with the name of some minor mode, like mouse-avoidance-mode.
|
||||
;; You'll then get this prompt:
|
||||
;; To what mode-line display:
|
||||
;; Respond by just hitting <Enter> if you want the name of the mode
|
||||
;; completely removed from the mode line. If you prefer, you can abbreviate
|
||||
;; the name. If your abbreviation is 2 characters or more, such as "Av",
|
||||
;; it'll be displayed as a separate word on the mode line, just like minor
|
||||
;; modes' names. If it's a single character, such as "V", it'll be scrunched
|
||||
;; up against the previous word, so for example if the undiminished mode line
|
||||
;; display had been "Abbrev Fill Avoid", it would become "Abbrev FillV".
|
||||
;; Multiple single-letter diminished modes will all be scrunched together.
|
||||
;; The display of undiminished modes will not be affected.
|
||||
|
||||
;; To find out what the mode line would look like if all diminished modes
|
||||
;; were still minor, type M-x diminished-modes. This displays in the echo
|
||||
;; area the complete list of minor or diminished modes now active, but
|
||||
;; displays them all as minor. They remain diminished on the mode line.
|
||||
|
||||
;; To convert a diminished mode back to a minor mode, type M-x diminish-undo
|
||||
;; to get a prompt like
|
||||
;; Restore what diminished mode:
|
||||
;; Respond with the name of some diminished mode. To convert all
|
||||
;; diminished modes back to minor modes, respond to that prompt
|
||||
;; with `diminished-modes' (unquoted, & note the hyphen).
|
||||
|
||||
;; When you're responding to the prompts for mode names, you can use
|
||||
;; completion to avoid extra typing; for example, m o u SPC SPC SPC
|
||||
;; is usually enough to specify mouse-avoidance-mode. Mode names
|
||||
;; typically end in "-mode", but for historical reasons
|
||||
;; auto-fill-mode is named by "auto-fill-function".
|
||||
|
||||
;; To create diminished modes noninteractively in your .emacs file, put
|
||||
;; code like
|
||||
;; (require 'diminish)
|
||||
;; (diminish 'abbrev-mode "Abv")
|
||||
;; (diminish 'jiggle-mode)
|
||||
;; (diminish 'mouse-avoidance-mode "M")
|
||||
;; near the end of your .emacs file. It should be near the end so that any
|
||||
;; minor modes your .emacs loads will already have been loaded by the time
|
||||
;; they're to be converted to diminished modes.
|
||||
|
||||
;; To diminish a major mode, (setq mode-name "whatever") in the mode hook.
|
||||
|
||||
;;; Epigraph:
|
||||
|
||||
;; "The quality of our thoughts is bordered on all sides
|
||||
;; by our facility with language."
|
||||
;; --J. Michael Straczynski
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defvar diminish-must-not-copy-minor-mode-alist nil
|
||||
"Non-nil means loading diminish.el won't (copy-alist minor-mode-alist).
|
||||
Normally `minor-mode-alist' is setq to that copy on loading diminish because
|
||||
at least one of its cons cells, that for abbrev-mode, is read-only (see
|
||||
ELisp Info on \"pure storage\"). If you setq this variable to t & then
|
||||
try to diminish abbrev-mode under GNU Emacs 19.34, you'll get the error
|
||||
message \"Attempt to modify read-only object\".")
|
||||
|
||||
(or diminish-must-not-copy-minor-mode-alist
|
||||
(callf copy-alist minor-mode-alist))
|
||||
|
||||
(defvar diminished-mode-alist nil
|
||||
"The original `minor-mode-alist' value of all (diminish)ed modes.")
|
||||
|
||||
(defvar diminish-history-symbols nil
|
||||
"Command history for symbols of diminished modes.")
|
||||
|
||||
(defvar diminish-history-names nil
|
||||
"Command history for names of diminished modes.")
|
||||
|
||||
;; When we diminish a mode, we are saying we want it to continue doing its
|
||||
;; work for us, but we no longer want to be reminded of it. It becomes a
|
||||
;; night worker, like a janitor; it becomes an invisible man; it remains a
|
||||
;; component, perhaps an important one, sometimes an indispensable one, of
|
||||
;; the mechanism that maintains the day-people's world, but its place in
|
||||
;; their thoughts is diminished, usually to nothing. As we grow old we
|
||||
;; diminish more and more such thoughts, such people, usually to nothing.
|
||||
|
||||
;; "The wise man knows that to keep under is to endure." The diminished
|
||||
;; often come to value their invisibility. We speak--speak--of "the strong
|
||||
;; silent type", but only as a superficiality; a stereotype in a movie,
|
||||
;; perhaps, but even if an acquaintance, necessarily, by hypothesis, a
|
||||
;; distant one. The strong silent type is actually a process. It begins
|
||||
;; with introspection, continues with judgment, and is shaped by the
|
||||
;; discovery that these judgments are impractical to share; there is no
|
||||
;; appetite for the wisdom of the self-critical among the creatures of
|
||||
;; material appetite who dominate our world. Their dominance's Darwinian
|
||||
;; implications reinforce the self-doubt that is the germ of higher wisdom.
|
||||
;; The thoughtful contemplate the evolutionary triumph of the predator.
|
||||
;; Gnostics deny the cosmos could be so evil; this must all be a prank; the
|
||||
;; thoughtful remain silent, invisible, self-diminished, and discover,
|
||||
;; perhaps at first in surprise, the freedom they thus gain, and grow strong.
|
||||
|
||||
;;;###autoload
|
||||
(defun diminish (mode &optional to-what)
|
||||
"Diminish mode-line display of minor mode MODE to TO-WHAT (default \"\").
|
||||
|
||||
Interactively, enter (with completion) the name of any minor mode, followed
|
||||
on the next line by what you want it diminished to (default empty string).
|
||||
The response to neither prompt should be quoted. However, in Lisp code,
|
||||
both args must be quoted, the first as a symbol, the second as a string,
|
||||
as in (diminish 'jiggle-mode \" Jgl\").
|
||||
|
||||
The mode-line displays of minor modes usually begin with a space, so
|
||||
the modes' names appear as separate words on the mode line. However, if
|
||||
you're having problems with a cramped mode line, you may choose to use single
|
||||
letters for some modes, without leading spaces. Capitalizing them works
|
||||
best; if you then diminish some mode to \"X\" but have abbrev-mode enabled as
|
||||
well, you'll get a display like \"AbbrevX\". This function prepends a space
|
||||
to TO-WHAT if it's > 1 char long & doesn't already begin with a space."
|
||||
(interactive (list (read (completing-read
|
||||
"Diminish what minor mode: "
|
||||
(mapcar (lambda (x) (list (symbol-name (car x))))
|
||||
minor-mode-alist)
|
||||
nil t nil 'diminish-history-symbols))
|
||||
(read-from-minibuffer
|
||||
"To what mode-line display: "
|
||||
nil nil nil 'diminish-history-names)))
|
||||
(let ((minor (assq mode minor-mode-alist)))
|
||||
(when minor
|
||||
(progn (callf or to-what "")
|
||||
(when (> (length to-what) 1)
|
||||
(or (= (string-to-char to-what) ?\ )
|
||||
(callf2 concat " " to-what)))
|
||||
(or (assq mode diminished-mode-alist)
|
||||
(push (copy-sequence minor) diminished-mode-alist))
|
||||
(setcdr minor (list to-what))))))
|
||||
|
||||
;; But an image comes to me, vivid in its unreality, of a loon alone on his
|
||||
;; forest lake, shrieking his soul out into a canopy of stars. Alone this
|
||||
;; afternoon in my warm city apartment, I can feel the bite of his night air,
|
||||
;; and smell his conifers. In him there is no acceptance of diminishment.
|
||||
|
||||
;; "I have a benevolent habit of pouring out myself to everybody,
|
||||
;; and would even pay for a listener, and I am afraid
|
||||
;; that the Athenians may think me too talkative."
|
||||
;; --Socrates, in the /Euthyphro/
|
||||
|
||||
;; I remember a news story about a retired plumber who had somehow managed to
|
||||
;; steal a military tank. He rode it down city streets, rode over a parked
|
||||
;; car--no one was hurt--rode onto a freeway, that concrete symbol of the
|
||||
;; American spirit, or so we fancy it, shouting "Plumber Bob! Plumber Bob!".
|
||||
;; He was shot dead by police.
|
||||
|
||||
;;;###autoload
|
||||
(defun diminish-undo (mode)
|
||||
"Restore mode-line display of diminished mode MODE to its minor-mode value.
|
||||
Do nothing if the arg is a minor mode that hasn't been diminished.
|
||||
|
||||
Interactively, enter (with completion) the name of any diminished mode (a
|
||||
mode that was formerly a minor mode on which you invoked \\[diminish]).
|
||||
To restore all diminished modes to minor status, answer `diminished-modes'.
|
||||
The response to the prompt shouldn't be quoted. However, in Lisp code,
|
||||
the arg must be quoted as a symbol, as in (diminish-undo 'diminished-modes)."
|
||||
(interactive
|
||||
(list (read (completing-read
|
||||
"Restore what diminished mode: "
|
||||
(cons (list "diminished-modes")
|
||||
(mapcar (lambda (x) (list (symbol-name (car x))))
|
||||
diminished-mode-alist))
|
||||
nil t nil 'diminish-history-symbols))))
|
||||
(if (eq mode 'diminished-modes)
|
||||
(let ((diminished-modes diminished-mode-alist))
|
||||
(while diminished-modes
|
||||
(diminish-undo (caar diminished-modes))
|
||||
(callf cdr diminished-modes)))
|
||||
(let ((minor (assq mode minor-mode-alist))
|
||||
(diminished (assq mode diminished-mode-alist)))
|
||||
(or minor
|
||||
(error "%S is not currently registered as a minor mode" mode))
|
||||
(when diminished
|
||||
(setcdr minor (cdr diminished))))))
|
||||
|
||||
;; Plumber Bob was not from Seattle, my grey city, for rainy Seattle is a
|
||||
;; city of interiors, a city of the self-diminished. When I moved here one
|
||||
;; sunny June I was delighted to find that ducks and geese were common in
|
||||
;; the streets. But I hoped to find a loon or two, and all I found were
|
||||
;; ducks and geese. I wondered about this; I wondered why there were no
|
||||
;; loons in Seattle; but my confusion resulted from my ignorance of the
|
||||
;; psychology of rain, which is to say my ignorance of diminished modes.
|
||||
;; What I needed, and lacked, was a way to discover they were there.
|
||||
|
||||
;;;###autoload
|
||||
(defun diminished-modes ()
|
||||
"Echo all active diminished or minor modes as if they were minor.
|
||||
The display goes in the echo area; if it's too long even for that,
|
||||
you can see the whole thing in the *Messages* buffer.
|
||||
This doesn't change the status of any modes; it just lets you see
|
||||
what diminished modes would be on the mode-line if they were still minor."
|
||||
(interactive)
|
||||
(let ((minor-modes minor-mode-alist)
|
||||
message)
|
||||
(while minor-modes
|
||||
(when (symbol-value (caar minor-modes))
|
||||
;; This minor mode is active in this buffer
|
||||
(let* ((mode-pair (car minor-modes))
|
||||
(mode (car mode-pair))
|
||||
(minor-pair (or (assq mode diminished-mode-alist) mode-pair))
|
||||
(minor-name (cadr minor-pair)))
|
||||
(when (symbolp minor-name)
|
||||
;; This minor mode uses symbol indirection in the cdr
|
||||
(let ((symbols-seen (list minor-name)))
|
||||
(while (and (symbolp (callf symbol-value minor-name))
|
||||
(not (memq minor-name symbols-seen)))
|
||||
(push minor-name symbols-seen))))
|
||||
(push minor-name message)))
|
||||
(callf cdr minor-modes))
|
||||
(setq message (mapconcat 'identity (nreverse message) ""))
|
||||
(when (= (string-to-char message) ?\ )
|
||||
(callf substring message 1))
|
||||
(message "%s" message)))
|
||||
|
||||
;; A human mind is a Black Forest of diminished modes. Some are dangerous;
|
||||
;; most of the mind of an intimate is a secret stranger, and these diminished
|
||||
;; modes are rendered more unpredictable by their long isolation from the
|
||||
;; corrective influence of interaction with reality. The student of history
|
||||
;; learns that this description applies to whole societies as well. In some
|
||||
;; ways the self-diminished are better able to discern the night worker.
|
||||
;; They are rendered safer by their heightened awareness of others'
|
||||
;; diminished modes, and more congenial by the spare blandness of their own
|
||||
;; mode lines. To some people rain is truly depressing, but others it just
|
||||
;; makes pensive, and, forcing them indoors where they may not have the
|
||||
;; luxury of solitude, teaches them to self-diminish. That was what I had
|
||||
;; not understood when I was searching for loons among the ducks and geese.
|
||||
;; Loons come to Seattle all the time, but the ones that like it learn to be
|
||||
;; silent, learn to self-diminish, and take on the colors of ducks and geese.
|
||||
;; Now, here a dozen years, I can recognize them everywhere, standing quietly
|
||||
;; in line with the ducks and geese at the espresso counter, gazing placidly
|
||||
;; out on the world through loon-red eyes, thinking secret thoughts.
|
||||
|
||||
(provide 'diminish)
|
||||
|
||||
;;; diminish.el ends here
|
||||
@@ -1,78 +0,0 @@
|
||||
;;; drag-stuff-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||
|
||||
;;;### (autoloads nil "drag-stuff" "drag-stuff.el" (22505 10892 547932
|
||||
;;;;;; 56000))
|
||||
;;; Generated autoloads from drag-stuff.el
|
||||
|
||||
(autoload 'drag-stuff-up "drag-stuff" "\
|
||||
Drag stuff ARG lines up.
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(autoload 'drag-stuff-down "drag-stuff" "\
|
||||
Drag stuff ARG lines down.
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(autoload 'drag-stuff-right "drag-stuff" "\
|
||||
Drag stuff ARG lines to the right.
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(autoload 'drag-stuff-left "drag-stuff" "\
|
||||
Drag stuff ARG lines to the left.
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(autoload 'drag-stuff-mode "drag-stuff" "\
|
||||
Drag stuff around.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(autoload 'turn-on-drag-stuff-mode "drag-stuff" "\
|
||||
Turn on `drag-stuff-mode'.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'turn-off-drag-stuff-mode "drag-stuff" "\
|
||||
Turn off `drag-stuff-mode'.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(defvar drag-stuff-global-mode nil "\
|
||||
Non-nil if Drag-Stuff-Global mode is enabled.
|
||||
See the command `drag-stuff-global-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 `drag-stuff-global-mode'.")
|
||||
|
||||
(custom-autoload 'drag-stuff-global-mode "drag-stuff" nil)
|
||||
|
||||
(autoload 'drag-stuff-global-mode "drag-stuff" "\
|
||||
Toggle Drag-Stuff mode in all buffers.
|
||||
With prefix ARG, enable Drag-Stuff-Global mode if ARG is positive;
|
||||
otherwise, disable it. If called from Lisp, enable the mode if
|
||||
ARG is omitted or nil.
|
||||
|
||||
Drag-Stuff mode is enabled in all buffers where
|
||||
`turn-on-drag-stuff-mode' would do it.
|
||||
See `drag-stuff-mode' for more information on Drag-Stuff mode.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("drag-stuff-pkg.el") (22505 10892 574776
|
||||
;;;;;; 658000))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; drag-stuff-autoloads.el ends here
|
||||
@@ -1,4 +0,0 @@
|
||||
(define-package "drag-stuff" "20160520.1159" "Drag stuff (lines, words, region, etc...) around" 'nil)
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
@@ -1,366 +0,0 @@
|
||||
;;; drag-stuff.el --- Drag stuff (lines, words, region, etc...) around
|
||||
|
||||
;; Copyright (C) 2010-2016 Johan Andersson
|
||||
|
||||
;; Author: Johan Andersson <johan.rejeep@gmail.com>
|
||||
;; Maintainer: Johan Andersson <johan.rejeep@gmail.com>
|
||||
;; Version: 0.2.0
|
||||
;; Keywords: speed, convenience
|
||||
;; URL: http://github.com/rejeep/drag-stuff
|
||||
|
||||
;; This file is NOT part of GNU Emacs.
|
||||
|
||||
;;; License:
|
||||
|
||||
;; 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, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; drag-stuff is a minor mode for dragging stuff around in Emacs. You
|
||||
;; can drag lines, words and region.
|
||||
|
||||
;; To use drag-stuff, make sure that this file is in Emacs load-path
|
||||
;; (add-to-list 'load-path "/path/to/directory/or/file")
|
||||
;;
|
||||
;; Then require drag-stuff
|
||||
;; (require 'drag-stuff)
|
||||
|
||||
;; To start drag-stuff
|
||||
;; (drag-stuff-mode t) or M-x drag-stuff-mode
|
||||
;;
|
||||
;; drag-stuff is buffer local, so hook it up
|
||||
;; (add-hook 'ruby-mode-hook 'drag-stuff-mode)
|
||||
;;
|
||||
;; Or use the global mode to activate it in all buffers.
|
||||
;; (drag-stuff-global-mode t)
|
||||
|
||||
;; Drag Stuff stores a list (`drag-stuff-except-modes') of modes in
|
||||
;; which `drag-stuff-mode' should not be activated in (note, only if
|
||||
;; you use the global mode) because of conflicting use.
|
||||
;;
|
||||
;; You can add new except modes:
|
||||
;; (add-to-list 'drag-stuff-except-modes 'conflicting-mode)
|
||||
|
||||
;; Default modifier key is the meta-key. This can be changed and is
|
||||
;; controlled by the variable `drag-stuff-modifier'.
|
||||
;;
|
||||
;; Control key as modifier:
|
||||
;; (setq drag-stuff-modifier 'control)
|
||||
;;
|
||||
;; Meta and Shift keys as modifier:
|
||||
;; (setq drag-stuff-modifier '(meta shift))
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
(defvar drag-stuff-except-modes ()
|
||||
"A list of modes in which `drag-stuff-mode' should not be activated.")
|
||||
|
||||
(defvar drag-stuff-modifier 'meta
|
||||
"Modifier key(s) for bindings in `drag-stuff-mode-map'.")
|
||||
|
||||
(defvar drag-stuff-mode-map (make-sparse-keymap)
|
||||
"Keymap for `drag-stuff-mode'.")
|
||||
|
||||
(defvar drag-stuff-before-drag-hook nil
|
||||
"Called before dragging occurs.")
|
||||
|
||||
(defvar drag-stuff-after-drag-hook nil
|
||||
"Called after dragging occurs.")
|
||||
|
||||
;; save-mark-and-excursion in Emacs 25 works like save-excursion did before
|
||||
(eval-when-compile
|
||||
(when (not (fboundp #'save-mark-and-excursion))
|
||||
(defmacro save-mark-and-excursion (&rest body)
|
||||
`(save-excursion ,@body))))
|
||||
|
||||
(defun drag-stuff--evil-p ()
|
||||
"Predicate for checking if we're in evil visual state."
|
||||
(and (bound-and-true-p evil-mode) (evil-visual-state-p)))
|
||||
|
||||
(defun drag-stuff--kbd (key)
|
||||
"Key binding helper."
|
||||
(let ((mod (if (listp drag-stuff-modifier)
|
||||
drag-stuff-modifier
|
||||
(list drag-stuff-modifier))))
|
||||
(vector (append mod (list key)))))
|
||||
|
||||
(defun drag-stuff--line-at-mark ()
|
||||
"Returns the line number where mark (first char selected) is."
|
||||
(line-number-at-pos
|
||||
(if evilp evil-visual-mark (mark))))
|
||||
|
||||
(defun drag-stuff--line-at-point ()
|
||||
"Returns the line number where point (current selected char) is."
|
||||
(line-number-at-pos
|
||||
(if evilp evil-visual-point (point))))
|
||||
|
||||
(defun drag-stuff--col-at-mark ()
|
||||
"Returns the column number where mark (first char selected) is."
|
||||
(if evilp
|
||||
(save-mark-and-excursion (goto-char evil-visual-mark) (current-column))
|
||||
(save-mark-and-excursion (exchange-point-and-mark) (current-column))))
|
||||
|
||||
(defun drag-stuff--col-at-point ()
|
||||
"Returns the column number where point (current selected char) is."
|
||||
(if evilp
|
||||
(save-mark-and-excursion (goto-char evil-visual-point) (current-column))
|
||||
(current-column)))
|
||||
|
||||
(defmacro drag-stuff--execute (&rest body)
|
||||
"Execute BODY without conflicting modes."
|
||||
`(let ((auto-fill-function nil)
|
||||
(electric-indent-mode nil)
|
||||
(longlines-mode-active
|
||||
(and (boundp 'longlines-mode) longlines-mode)))
|
||||
(when longlines-mode-active
|
||||
(longlines-mode -1))
|
||||
(run-hooks 'drag-stuff-before-drag-hook)
|
||||
,@body
|
||||
(run-hooks 'drag-stuff-after-drag-hook)
|
||||
(when longlines-mode-active
|
||||
(longlines-mode 1))))
|
||||
|
||||
;;;###autoload
|
||||
(defun drag-stuff-up (arg)
|
||||
"Drag stuff ARG lines up."
|
||||
(interactive "p")
|
||||
(drag-stuff--execute
|
||||
(if mark-active
|
||||
(drag-stuff-lines-up (- arg))
|
||||
(drag-stuff-line-up (- arg)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun drag-stuff-down (arg)
|
||||
"Drag stuff ARG lines down."
|
||||
(interactive "p")
|
||||
(drag-stuff--execute
|
||||
(if mark-active
|
||||
(drag-stuff-lines-down arg)
|
||||
(drag-stuff-line-down arg))))
|
||||
|
||||
;;;###autoload
|
||||
(defun drag-stuff-right (arg)
|
||||
"Drag stuff ARG lines to the right."
|
||||
(interactive "p")
|
||||
(if mark-active
|
||||
(drag-stuff-region-right arg)
|
||||
(drag-stuff-word-right arg)))
|
||||
|
||||
;;;###autoload
|
||||
(defun drag-stuff-left (arg)
|
||||
"Drag stuff ARG lines to the left."
|
||||
(interactive "p")
|
||||
(if mark-active
|
||||
(drag-stuff-region-left arg)
|
||||
(drag-stuff-word-left arg)))
|
||||
|
||||
(defun drag-stuff-line-up (arg)
|
||||
"Drag current line ARG lines up."
|
||||
(if (> (line-number-at-pos) (abs arg))
|
||||
(drag-stuff-line-vertically
|
||||
(lambda (beg end column)
|
||||
(drag-stuff-drag-region-up beg end arg)
|
||||
(move-to-column column)))
|
||||
(message "Can not move line further up")))
|
||||
|
||||
(defun drag-stuff-line-down (arg)
|
||||
"Drag current line ARG lines down."
|
||||
(if (<= (+ (line-number-at-pos) arg) (count-lines (point-min) (point-max)))
|
||||
(drag-stuff-line-vertically
|
||||
(lambda (beg end column)
|
||||
(drag-stuff-drag-region-down beg end arg)
|
||||
(move-to-column column)))
|
||||
(message "Can not move line further down")))
|
||||
|
||||
(defun drag-stuff-line-vertically (fn)
|
||||
"Yields variables used to drag line vertically."
|
||||
(let ((column (current-column))
|
||||
(beg (line-beginning-position))
|
||||
(end (line-end-position)))
|
||||
(funcall fn beg end column)))
|
||||
|
||||
(defun drag-stuff-lines-up (arg)
|
||||
"Move all lines in the selected region ARG lines up."
|
||||
(if (> (line-number-at-pos (region-beginning)) (abs arg))
|
||||
(drag-stuff-lines-vertically
|
||||
(lambda (beg end)
|
||||
(drag-stuff-drag-region-up beg end arg)))
|
||||
(message "Can not move lines further up")))
|
||||
|
||||
(defun drag-stuff-lines-down (arg)
|
||||
"Move all lines in the selected region ARG lines up."
|
||||
(let ((selection-end (if (drag-stuff--evil-p)
|
||||
(save-mark-and-excursion (evil-visual-goto-end))
|
||||
(region-end))))
|
||||
(if (<= (+ (line-number-at-pos selection-end) arg) (count-lines (point-min) (point-max)))
|
||||
(drag-stuff-lines-vertically
|
||||
(lambda (beg end)
|
||||
(drag-stuff-drag-region-down beg end arg)))
|
||||
(message "Can not move lines further down"))))
|
||||
|
||||
(defun drag-stuff-lines-vertically (fn)
|
||||
"Yields variables used to drag lines vertically."
|
||||
(let* ((evilp (drag-stuff--evil-p))
|
||||
(vtype (if evilp (evil-visual-type) nil))
|
||||
(mark-line (drag-stuff--line-at-mark))
|
||||
(point-line (drag-stuff--line-at-point))
|
||||
(mark-col (drag-stuff--col-at-mark))
|
||||
(point-col (drag-stuff--col-at-point))
|
||||
(bounds (drag-stuff-whole-lines-region))
|
||||
(beg (car bounds))
|
||||
(end (car (cdr bounds)))
|
||||
(deactivate-mark nil))
|
||||
|
||||
(funcall fn beg end)
|
||||
;; Restore region
|
||||
(goto-line mark-line)
|
||||
(forward-line arg)
|
||||
(move-to-column mark-col)
|
||||
(exchange-point-and-mark)
|
||||
(goto-line point-line)
|
||||
(forward-line arg)
|
||||
(move-to-column point-col)
|
||||
(when evilp
|
||||
(evil-visual-make-selection (mark) (point))
|
||||
(when (eq vtype 'line) (evil-visual-line (mark) (point))))))
|
||||
|
||||
|
||||
(defun drag-stuff-drag-region-up (beg end arg)
|
||||
"Drags region between BEG and END ARG lines up."
|
||||
(let ((region (buffer-substring-no-properties beg end)))
|
||||
(when (drag-stuff--evil-p) (evil-exit-visual-state))
|
||||
(delete-region beg end)
|
||||
(backward-delete-char 1)
|
||||
(forward-line (+ arg 1))
|
||||
(goto-char (line-beginning-position))
|
||||
(insert region)
|
||||
(newline)
|
||||
(forward-line -1)))
|
||||
|
||||
(defun drag-stuff-drag-region-down (beg end arg)
|
||||
"Drags region between BEG and END ARG lines down."
|
||||
(let ((region (buffer-substring-no-properties beg end)))
|
||||
(when (drag-stuff--evil-p) (evil-exit-visual-state))
|
||||
(delete-region beg end)
|
||||
(delete-char 1)
|
||||
(forward-line (- arg 1))
|
||||
(goto-char (line-end-position))
|
||||
(newline)
|
||||
(insert region)))
|
||||
|
||||
(defun drag-stuff-whole-lines-region ()
|
||||
"Return the positions of the region with whole lines included."
|
||||
(let (beg end)
|
||||
(cond (evilp
|
||||
(setq beg (save-mark-and-excursion (goto-char (region-beginning)) (line-beginning-position)))
|
||||
(setq end (save-mark-and-excursion (evil-visual-goto-end) (line-end-position))))
|
||||
(t
|
||||
(if (> (point) (mark))
|
||||
(exchange-point-and-mark))
|
||||
(setq beg (line-beginning-position))
|
||||
(if mark-active
|
||||
(exchange-point-and-mark))
|
||||
(setq end (line-end-position))))
|
||||
(list beg end)))
|
||||
|
||||
(defun drag-stuff-region-left (arg)
|
||||
"Drags region left ARG times."
|
||||
(if (> (min (point) (mark)) (point-min))
|
||||
(drag-stuff-region-horizontally (- arg))
|
||||
(message "Can not move region further to the left")))
|
||||
|
||||
(defun drag-stuff-region-right (arg)
|
||||
"Drags region right ARG times."
|
||||
(if (< (max (point) (mark)) (point-max))
|
||||
(drag-stuff-region-horizontally arg)
|
||||
(message "Can not move region further to the right")))
|
||||
|
||||
(defun drag-stuff-region-horizontally (arg)
|
||||
"Drags region horizontally ARG times."
|
||||
(let* ((beg (mark))
|
||||
(end (point))
|
||||
(region (buffer-substring-no-properties beg end))
|
||||
(deactivate-mark nil))
|
||||
(delete-region beg end)
|
||||
(forward-char arg)
|
||||
(insert region)
|
||||
(set-mark (+ beg arg))
|
||||
(goto-char (+ end arg))))
|
||||
|
||||
(defun drag-stuff-word-left (arg)
|
||||
"Drags word left ARG times."
|
||||
(drag-stuff-word-horizontally (- arg)))
|
||||
|
||||
(defun drag-stuff-word-right (arg)
|
||||
"Drags word right ARG times."
|
||||
(drag-stuff-word-horizontally arg))
|
||||
|
||||
(defun drag-stuff-word-horizontally (arg)
|
||||
"Drags word horizontally ARG times."
|
||||
(let ((old-point (point))
|
||||
(offset (- (save-mark-and-excursion (forward-word) (point)) (point))))
|
||||
(condition-case err
|
||||
(progn
|
||||
(transpose-words arg)
|
||||
(backward-char offset))
|
||||
(error
|
||||
(message
|
||||
(if (> arg 0)
|
||||
"Can not move word further to the right"
|
||||
"Can not move word further to the left"))
|
||||
(goto-char old-point)))))
|
||||
|
||||
(defun drag-stuff-define-keys ()
|
||||
"Defines keys for `drag-stuff-mode'."
|
||||
(define-key drag-stuff-mode-map (drag-stuff--kbd 'up) 'drag-stuff-up)
|
||||
(define-key drag-stuff-mode-map (drag-stuff--kbd 'down) 'drag-stuff-down)
|
||||
(define-key drag-stuff-mode-map (drag-stuff--kbd 'right) 'drag-stuff-right)
|
||||
(define-key drag-stuff-mode-map (drag-stuff--kbd 'left) 'drag-stuff-left))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode drag-stuff-mode
|
||||
"Drag stuff around."
|
||||
:init-value nil
|
||||
:lighter " drag"
|
||||
:keymap drag-stuff-mode-map
|
||||
(when drag-stuff-mode
|
||||
(drag-stuff-define-keys)))
|
||||
|
||||
;;;###autoload
|
||||
(defun turn-on-drag-stuff-mode ()
|
||||
"Turn on `drag-stuff-mode'."
|
||||
(interactive)
|
||||
(unless (member major-mode drag-stuff-except-modes)
|
||||
(drag-stuff-mode +1)))
|
||||
|
||||
;;;###autoload
|
||||
(defun turn-off-drag-stuff-mode ()
|
||||
"Turn off `drag-stuff-mode'."
|
||||
(interactive)
|
||||
(drag-stuff-mode -1))
|
||||
|
||||
;;;###autoload
|
||||
(define-globalized-minor-mode drag-stuff-global-mode
|
||||
drag-stuff-mode
|
||||
turn-on-drag-stuff-mode)
|
||||
|
||||
|
||||
(provide 'drag-stuff)
|
||||
|
||||
;;; drag-stuff.el ends here
|
||||
@@ -1,16 +0,0 @@
|
||||
;;; electric-case-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||
|
||||
;;;### (autoloads nil nil ("electric-case.el") (22499 30815 963740
|
||||
;;;;;; 197000))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; electric-case-autoloads.el ends here
|
||||
@@ -1 +0,0 @@
|
||||
(define-package "electric-case" "20150417.412" "insert camelCase, snake_case words without \"Shift\"ing" 'nil :url "http://hins11.yu-yake.com/")
|
||||
@@ -1,383 +0,0 @@
|
||||
;;; electric-case.el --- insert camelCase, snake_case words without "Shift"ing
|
||||
|
||||
;; Copyright (C) 2013-2015 zk_phi
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 2 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program; if not, write to the Free Software
|
||||
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
;; Version: 2.2.2
|
||||
;; Package-Version: 20150417.412
|
||||
;; Author: zk_phi
|
||||
;; URL: http://hins11.yu-yake.com/
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Load this script
|
||||
;;
|
||||
;; (require 'electric-case)
|
||||
;;
|
||||
;; and initialize in major-mode hooks.
|
||||
;;
|
||||
;; (add-hook 'java-mode-hook 'electric-case-java-init)
|
||||
;;
|
||||
;; And when you type the following in java-mode for example,
|
||||
;;
|
||||
;; public class test-class{
|
||||
;; public void test-method(void){
|
||||
;;
|
||||
;; =electric-case= automatically converts it into :
|
||||
;;
|
||||
;; public class TestClass{
|
||||
;; public void testMethod(void){
|
||||
;;
|
||||
;; Preconfigured settings for some other languages are also
|
||||
;; provided. Try:
|
||||
;;
|
||||
;; (add-hook 'c-mode-hook electric-case-c-init)
|
||||
;; (add-hook 'ahk-mode-hook electric-case-ahk-init)
|
||||
;; (add-hook 'scala-mode-hook electric-case-scala-init)
|
||||
;;
|
||||
;; For more informations, see Readme.org.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;; 1.0.0 first released
|
||||
;; 1.0.1 fixed java settings
|
||||
;; 1.0.2 minor fixes
|
||||
;; 1.0.3 fixed java settings
|
||||
;; 1.0.4 fixed java settings
|
||||
;; 1.0.5 fixed C settings
|
||||
;; 1.1.0 added electric-case-convert-calls
|
||||
;; 1.1.1 modified arguments for criteria function
|
||||
;; 1.1.2 added ahk-mode settings
|
||||
;; 1.1.3 added scala-mode settings, and refactord
|
||||
;; 1.1.4 fixes and improvements
|
||||
;; 2.0.0 added pending-overlays
|
||||
;; 2.0.1 added electric-case-trigger to post-command-hook
|
||||
;; deleted variable "convert-calls"
|
||||
;; 2.0.2 minow fixes for criterias
|
||||
;; 2.0.3 removed electric-case-trigger from post-command-hook
|
||||
;; 2.0.4 fixed trigger and added hook again
|
||||
;; 2.1.0 added 2 custom variables, minor fixes
|
||||
;; 2.1.1 added 2 custom variables
|
||||
;; 2.2.0 changed behavior
|
||||
;; now only symbols overlayd are converted
|
||||
;; 2.2.1 fixed bug that words without overlay may converted
|
||||
;; 2.2.2 fixed bug that electric-case-convert-end is ignored
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
;; * constants
|
||||
|
||||
(defconst electric-case-version "2.2.2")
|
||||
|
||||
;; * customs
|
||||
|
||||
(defgroup electric-case nil
|
||||
"Insert camelCase, snake_case words without \"Shift\"ing"
|
||||
:group 'emacs)
|
||||
|
||||
(defcustom electric-case-pending-overlay 'shadow
|
||||
"Face used to highlight pending symbols"
|
||||
:group 'electric-case)
|
||||
|
||||
(defcustom electric-case-convert-calls nil
|
||||
"When nil, only declarations are converted."
|
||||
:group 'electric-case)
|
||||
|
||||
(defcustom electric-case-convert-nums nil
|
||||
"When non-nil, hyphens around numbers are also counted as a
|
||||
part of the symbol."
|
||||
:group 'electric-case)
|
||||
|
||||
(defcustom electric-case-convert-beginning nil
|
||||
"When non-nil, hyphens at the beginning of symbols are also
|
||||
counted as a part of the symbol."
|
||||
:group 'electric-case)
|
||||
|
||||
(defcustom electric-case-convert-end nil
|
||||
"When non-nil, hyphens at the end of symbols are also counted
|
||||
as a part of the symbol."
|
||||
:group 'electric-case)
|
||||
|
||||
;; * mode variables
|
||||
|
||||
(define-minor-mode electric-case-mode
|
||||
"insert camelCase, snake_case words without \"Shift\"ing"
|
||||
:init-value nil
|
||||
:lighter "eCase"
|
||||
:global nil
|
||||
(if electric-case-mode
|
||||
(add-hook 'post-command-hook 'electric-case--post-command-function nil t)
|
||||
(remove-hook 'post-command-hook 'electric-case--post-command-function t)))
|
||||
|
||||
;; * buffer-local variables
|
||||
|
||||
(defvar electric-case-criteria (lambda (b e) 'camel))
|
||||
(make-variable-buffer-local 'electric-case-criteria)
|
||||
|
||||
(defvar electric-case-max-iteration 1)
|
||||
(make-variable-buffer-local 'electric-case-max-iteration)
|
||||
|
||||
;; * utilities
|
||||
;; ** motion
|
||||
|
||||
(defun electric-case--range (n)
|
||||
(save-excursion
|
||||
(let* ((pos (point))
|
||||
(beg (ignore-errors
|
||||
(dotimes (_ n)
|
||||
(when (bobp) (error "beginning of buffer"))
|
||||
(backward-word)
|
||||
(if electric-case-convert-nums
|
||||
(skip-chars-backward "[:alnum:]-")
|
||||
(skip-chars-backward "[:alpha:]-"))
|
||||
(unless electric-case-convert-beginning
|
||||
(skip-chars-forward "-")))
|
||||
(point)))
|
||||
(end (when beg
|
||||
(goto-char beg)
|
||||
(if electric-case-convert-nums
|
||||
(skip-chars-forward "[:alnum:]-")
|
||||
(skip-chars-forward "[:alpha:]-"))
|
||||
(unless electric-case-convert-end
|
||||
(skip-chars-backward "-"))
|
||||
(point))))
|
||||
;; inside-lo|ng-symbol => nil
|
||||
;; b p e
|
||||
(when (and end (<= end pos))
|
||||
(cons beg end)))))
|
||||
|
||||
;; ** replace buffer
|
||||
|
||||
(defun electric-case--replace-buffer (beg end str)
|
||||
"(replace 1 2 \"aa\")
|
||||
buffer-string => aaffer-string"
|
||||
(when (not (string= (buffer-substring-no-properties beg end) str))
|
||||
(let ((pos (point))
|
||||
(oldlen (- end beg))
|
||||
(newlen (length str)))
|
||||
(kill-region beg end)
|
||||
(goto-char beg)
|
||||
(insert str)
|
||||
(remove-overlays beg (+ beg newlen))
|
||||
(goto-char (+ pos (- newlen oldlen))))))
|
||||
|
||||
;; ** overlay management
|
||||
|
||||
(defvar electric-case--overlays nil)
|
||||
(make-variable-buffer-local 'electric-case--overlays)
|
||||
|
||||
(defun electric-case--put-overlay (n)
|
||||
(let ((range (electric-case--range n)))
|
||||
(when range
|
||||
(let ((ov (make-overlay (car range) (cdr range))))
|
||||
(overlay-put ov 'face electric-case-pending-overlay)
|
||||
(add-to-list 'electric-case--overlays ov)))))
|
||||
|
||||
(defun electric-case--remove-overlays ()
|
||||
(mapc 'delete-overlay electric-case--overlays)
|
||||
(setq electric-case--overlays nil))
|
||||
|
||||
(defun electric-case--not-on-overlay-p ()
|
||||
(let ((res t) (pos (point)))
|
||||
(dolist (ov electric-case--overlays res)
|
||||
(setq res (and res
|
||||
(or (< pos (overlay-start ov))
|
||||
(< (overlay-end ov) pos)))))))
|
||||
|
||||
;; * commands
|
||||
|
||||
(defun electric-case--convert-all ()
|
||||
(dolist (ov electric-case--overlays)
|
||||
(let ((beg (overlay-start ov))
|
||||
(end (overlay-end ov)))
|
||||
;; vvv i dont remember why i added whis line vvv
|
||||
(when (string-match "[a-z]" (buffer-substring-no-properties beg end))
|
||||
(let* ((type (apply electric-case-criteria (list beg end)))
|
||||
(str (buffer-substring-no-properties beg end))
|
||||
(wlst (split-string str "-"))
|
||||
(convstr (case type
|
||||
('ucamel (mapconcat (lambda (w) (upcase-initials w)) wlst ""))
|
||||
('camel (concat
|
||||
(car wlst)
|
||||
(mapconcat (lambda (w) (upcase-initials w)) (cdr wlst) "")))
|
||||
('usnake (mapconcat (lambda (w) (upcase w)) wlst "_"))
|
||||
('snake (mapconcat 'identity wlst "_"))
|
||||
(t nil))))
|
||||
(when convstr
|
||||
(electric-case--replace-buffer beg end convstr))))))
|
||||
(electric-case--remove-overlays))
|
||||
|
||||
(defun electric-case--post-command-function ()
|
||||
;; update overlay
|
||||
(when (and (eq 'self-insert-command (key-binding (this-single-command-keys)))
|
||||
(characterp last-command-event)
|
||||
(string-match
|
||||
(if electric-case-convert-nums "[a-zA-Z0-9]" "[a-zA-Z]")
|
||||
(char-to-string last-command-event)))
|
||||
(electric-case--remove-overlays)
|
||||
(let (n)
|
||||
(dotimes (n electric-case-max-iteration)
|
||||
(electric-case--put-overlay (- electric-case-max-iteration n)))))
|
||||
;; electric-case trigger
|
||||
(when (and (electric-case--not-on-overlay-p)
|
||||
(not mark-active))
|
||||
(electric-case--convert-all)))
|
||||
|
||||
;; * settings
|
||||
;; ** utilities
|
||||
|
||||
(defun electric-case--possible-properties (beg end)
|
||||
(let* ((ret (point))
|
||||
(str (buffer-substring beg end))
|
||||
(convstr (replace-regexp-in-string "-" "" str))
|
||||
(val (progn (electric-case--replace-buffer beg end convstr)
|
||||
(font-lock-fontify-buffer)
|
||||
(sit-for 0)
|
||||
(text-properties-at beg))))
|
||||
(electric-case--replace-buffer beg (+ beg (length convstr)) str)
|
||||
(font-lock-fontify-buffer)
|
||||
val))
|
||||
|
||||
(defun electric-case--this-line-string ()
|
||||
(buffer-substring (save-excursion (beginning-of-line) (point))
|
||||
(save-excursion (end-of-line) (point))))
|
||||
|
||||
;; ** c-mode
|
||||
|
||||
(defun electric-case-c-init ()
|
||||
|
||||
(electric-case-mode 1)
|
||||
(setq electric-case-max-iteration 2)
|
||||
|
||||
(setq electric-case-criteria
|
||||
(lambda (b e)
|
||||
(let ((proper (electric-case--possible-properties b e))
|
||||
(key (key-description (this-single-command-keys))))
|
||||
(cond
|
||||
((member 'font-lock-variable-name-face proper)
|
||||
;; #ifdef A_MACRO / int variable_name;
|
||||
(if (member '(cpp-macro) (c-guess-basic-syntax)) 'usnake 'snake))
|
||||
((member 'font-lock-string-face proper) nil)
|
||||
((member 'font-lock-comment-face proper) nil)
|
||||
((member 'font-lock-keyword-face proper) nil)
|
||||
((member 'font-lock-function-name-face proper) 'snake)
|
||||
((member 'font-lock-type-face proper) 'snake)
|
||||
(electric-case-convert-calls 'snake)
|
||||
(t nil)))))
|
||||
|
||||
(defadvice electric-case-trigger (around electric-case-c-try-semi activate)
|
||||
(when (and electric-case-mode
|
||||
(eq major-mode 'c-mode))
|
||||
(if (not (string= (key-description (this-single-command-keys)) ";"))
|
||||
ad-do-it
|
||||
(insert ";")
|
||||
(backward-char)
|
||||
ad-do-it
|
||||
(delete-char 1))))
|
||||
)
|
||||
|
||||
;; ** java-mode
|
||||
|
||||
(defconst electric-case-java-primitives
|
||||
'("boolean" "char" "byte" "short" "int" "long" "float" "double" "void"))
|
||||
|
||||
(defun electric-case-java-init ()
|
||||
|
||||
(electric-case-mode 1)
|
||||
(setq electric-case-max-iteration 2)
|
||||
|
||||
(setq electric-case-criteria
|
||||
(lambda (b e)
|
||||
;; do not convert primitives
|
||||
(when (not (member (buffer-substring b e) electric-case-java-primitives))
|
||||
(let ((proper (electric-case--possible-properties b e))
|
||||
(str (electric-case--this-line-string)))
|
||||
(cond
|
||||
((string-match "^import" str)
|
||||
;; import java.util.ArrayList;
|
||||
(if (= (char-before) ?\;) 'ucamel nil))
|
||||
;; annotation
|
||||
((save-excursion (goto-char b)
|
||||
(and (not (= (point) (point-min)))
|
||||
(= (char-before) ?@)))
|
||||
'camel)
|
||||
((member 'font-lock-string-face proper) nil)
|
||||
((member 'font-lock-comment-face proper) nil)
|
||||
((member 'font-lock-keyword-face proper) nil)
|
||||
((member 'font-lock-type-face proper) 'ucamel)
|
||||
((member 'font-lock-function-name-face proper) 'camel)
|
||||
((member 'font-lock-variable-name-face proper) 'camel)
|
||||
(electric-case-convert-calls 'camel)
|
||||
(t nil))))))
|
||||
|
||||
(defadvice electric-case-trigger (around electric-case-java-try-semi activate)
|
||||
(when (and electric-case-mode
|
||||
(eq major-mode 'java-mode))
|
||||
(if (not (string= (key-description (this-single-command-keys)) ";"))
|
||||
ad-do-it
|
||||
(insert ";")
|
||||
(backward-char)
|
||||
ad-do-it
|
||||
(delete-char 1))))
|
||||
)
|
||||
|
||||
;; ** scala-mode
|
||||
|
||||
(defun electric-case-scala-init ()
|
||||
|
||||
(electric-case-mode 1)
|
||||
(setq electric-case-max-iteration 2)
|
||||
|
||||
(setq electric-case-criteria
|
||||
(lambda (b e)
|
||||
(when (not (member (buffer-substring b e) electric-case-java-primitives))
|
||||
(let ((proper (electric-case--possible-properties b e)))
|
||||
(cond
|
||||
((member 'font-lock-string-face proper) nil)
|
||||
((member 'font-lock-comment-face proper) nil)
|
||||
((member 'font-lock-keyword-face proper) nil)
|
||||
((member 'font-lock-type-face proper) 'ucamel)
|
||||
((member 'font-lock-function-name-face proper) 'camel)
|
||||
((member 'font-lock-variable-name-face proper) 'camel)
|
||||
(electric-case-convert-calls 'camel)
|
||||
(t nil))))))
|
||||
)
|
||||
|
||||
;; ** ahk-mode
|
||||
|
||||
(defun electric-case-ahk-init ()
|
||||
|
||||
(electric-case-mode 1)
|
||||
(setq electric-case-max-iteration 1)
|
||||
|
||||
(setq electric-case-criteria
|
||||
(lambda (b e)
|
||||
(let ((proper (electric-case--possible-properties b e)))
|
||||
(cond
|
||||
((member 'font-lock-string-face proper) nil)
|
||||
((member 'font-lock-comment-face proper) nil)
|
||||
((member 'font-lock-keyword-face proper) 'ucamel)
|
||||
(electric-case-convert-calls 'camel)
|
||||
(t nil)))))
|
||||
)
|
||||
|
||||
;; * provide
|
||||
|
||||
(provide 'electric-case)
|
||||
|
||||
;;; electric-case.el ends here
|
||||
@@ -1,29 +0,0 @@
|
||||
;;; electric-spacing-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||
|
||||
;;;### (autoloads nil "electric-spacing" "electric-spacing.el" (22499
|
||||
;;;;;; 30815 203000 0))
|
||||
;;; Generated autoloads from electric-spacing.el
|
||||
|
||||
(autoload 'electric-spacing-mode "electric-spacing" "\
|
||||
Toggle automatic surrounding space insertion (Electric Spacing mode).
|
||||
With a prefix argument ARG, enable Electric Spacing mode if ARG is
|
||||
positive, and disable it otherwise. If called from Lisp, enable
|
||||
the mode if ARG is omitted or nil.
|
||||
|
||||
This is a local minor mode. When enabled, typing an operator automatically
|
||||
inserts surrounding spaces. e.g., `=' becomes ` = ',`+=' becomes ` += '. This
|
||||
is very handy for many programming languages.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; electric-spacing-autoloads.el ends here
|
||||
@@ -1 +0,0 @@
|
||||
(define-package "electric-spacing" "20151209.736" "Insert operators with surrounding spaces smartly" 'nil)
|
||||
@@ -1,405 +0,0 @@
|
||||
;;; electric-spacing.el --- Insert operators with surrounding spaces smartly
|
||||
|
||||
;; Copyright (C) 2004, 2005, 2007-2015 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: William Xu <william.xwl@gmail.com>
|
||||
;; Version: 5.0
|
||||
;; Package-Version: 20151209.736
|
||||
|
||||
;; 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, 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 EMMS; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Smart Operator mode is a minor mode which automatically inserts
|
||||
;; surrounding spaces around operator symbols. For example, `='
|
||||
;; becomes ` = ', `+=' becomes ` += '. This is most handy for writing
|
||||
;; C-style source code.
|
||||
;;
|
||||
;; Type `M-x electric-spacing-mode' to toggle this minor mode.
|
||||
|
||||
;;; Acknowledgements
|
||||
|
||||
;; Nikolaj Schumacher <n_schumacher@web.de>, for suggesting
|
||||
;; reimplementing as a minor mode and providing an initial patch for
|
||||
;; that.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cc-mode)
|
||||
(require 'thingatpt)
|
||||
|
||||
;;; electric-spacing minor mode
|
||||
|
||||
(defcustom electric-spacing-double-space-docs t
|
||||
"Enable double spacing of . in document lines - e,g, type '.' => get '. '."
|
||||
:type 'boolean
|
||||
:group 'electricity)
|
||||
|
||||
(defcustom electric-spacing-docs t
|
||||
"Enable electric-spacing in strings and comments."
|
||||
:type 'boolean
|
||||
:group 'electricity)
|
||||
|
||||
(defvar electric-spacing-rules
|
||||
'((?= . electric-spacing-self-insert-command)
|
||||
(?< . electric-spacing-<)
|
||||
(?> . electric-spacing->)
|
||||
(?% . electric-spacing-%)
|
||||
(?+ . electric-spacing-+)
|
||||
(?- . electric-spacing--)
|
||||
(?* . electric-spacing-*)
|
||||
(?/ . electric-spacing-/)
|
||||
(?& . electric-spacing-&)
|
||||
(?| . electric-spacing-self-insert-command)
|
||||
(?: . electric-spacing-:)
|
||||
(?? . electric-spacing-?)
|
||||
(?, . electric-spacing-\,)
|
||||
(?~ . electric-spacing-~)
|
||||
(?. . electric-spacing-.)
|
||||
(?^ . electric-spacing-self-insert-command)))
|
||||
|
||||
(defun electric-spacing-post-self-insert-function ()
|
||||
(when (electric-spacing-should-run?)
|
||||
(let ((rule (cdr (assq last-command-event electric-spacing-rules))))
|
||||
(when rule
|
||||
(goto-char (electric--after-char-pos))
|
||||
(delete-char -1)
|
||||
(funcall rule)))))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode electric-spacing-mode
|
||||
"Toggle automatic surrounding space insertion (Electric Spacing mode).
|
||||
With a prefix argument ARG, enable Electric Spacing mode if ARG is
|
||||
positive, and disable it otherwise. If called from Lisp, enable
|
||||
the mode if ARG is omitted or nil.
|
||||
|
||||
This is a local minor mode. When enabled, typing an operator automatically
|
||||
inserts surrounding spaces. e.g., `=' becomes ` = ',`+=' becomes ` += '. This
|
||||
is very handy for many programming languages."
|
||||
:global nil
|
||||
:group 'electricity
|
||||
:lighter " _+_"
|
||||
|
||||
;; body
|
||||
(if electric-spacing-mode
|
||||
(add-hook 'post-self-insert-hook
|
||||
#'electric-spacing-post-self-insert-function nil t)
|
||||
(remove-hook 'post-self-insert-hook
|
||||
#'electric-spacing-post-self-insert-function t)))
|
||||
|
||||
(defun electric-spacing-self-insert-command ()
|
||||
"Insert character with surrounding spaces."
|
||||
(electric-spacing-insert (string last-command-event)))
|
||||
|
||||
(defun electric-spacing-insert (op &optional only-where)
|
||||
"See `electric-spacing-insert-1'."
|
||||
(delete-horizontal-space)
|
||||
(cond ((and (electric-spacing-lispy-mode?)
|
||||
(not (electric-spacing-document?)))
|
||||
(electric-spacing-lispy op))
|
||||
(t
|
||||
(electric-spacing-insert-1 op only-where))))
|
||||
|
||||
(defun electric-spacing-insert-1 (op &optional only-where)
|
||||
"Insert operator OP with surrounding spaces.
|
||||
e.g., `=' becomes ` = ', `+=' becomes ` += '.
|
||||
|
||||
When `only-where' is 'after, we will insert space at back only;
|
||||
when `only-where' is 'before, we will insert space at front only;
|
||||
when `only-where' is 'middle, we will not insert space."
|
||||
(pcase only-where
|
||||
(`before (insert " " op))
|
||||
(`middle (insert op))
|
||||
(`after (insert op " "))
|
||||
(_
|
||||
(let ((begin? (bolp)))
|
||||
(unless (or (looking-back (regexp-opt
|
||||
(mapcar 'char-to-string
|
||||
(mapcar 'car electric-spacing-rules)))
|
||||
(line-beginning-position))
|
||||
begin?)
|
||||
(insert " "))
|
||||
(insert op " ")
|
||||
(when begin?
|
||||
(indent-according-to-mode))))))
|
||||
|
||||
(defun electric-spacing-c-types ()
|
||||
(concat c-primitive-type-key "?"))
|
||||
|
||||
(defun electric-spacing-document? ()
|
||||
(nth 8 (syntax-ppss)))
|
||||
|
||||
(defun electric-spacing-should-run? ()
|
||||
(or (not electric-spacing-docs)
|
||||
(not (electric-spacing-document?))))
|
||||
|
||||
(defun electric-spacing-lispy-mode? ()
|
||||
(derived-mode-p 'emacs-lisp-mode
|
||||
'lisp-mode
|
||||
'lisp-interaction-mode
|
||||
'scheme-mode))
|
||||
|
||||
(defun electric-spacing-lispy (op)
|
||||
"We're in a Lisp-ish mode, so let's look for parenthesis.
|
||||
Meanwhile, if not found after ( operators are more likely to be function names,
|
||||
so let's not get too insert-happy."
|
||||
(cond
|
||||
((save-excursion
|
||||
(backward-char 1)
|
||||
(looking-at "("))
|
||||
(if (equal op ",")
|
||||
(electric-spacing-insert-1 op 'middle)
|
||||
(electric-spacing-insert-1 op 'after)))
|
||||
((equal op ",")
|
||||
(electric-spacing-insert-1 op 'before))
|
||||
(t
|
||||
(electric-spacing-insert-1 op 'middle))))
|
||||
|
||||
(defconst electric-spacing-operators-regexp
|
||||
(regexp-opt
|
||||
(mapcar (lambda (el) (char-to-string (car el)))
|
||||
electric-spacing-rules)))
|
||||
|
||||
|
||||
;;; Fine Tunings
|
||||
|
||||
(defun electric-spacing-< ()
|
||||
"See `electric-spacing-insert'."
|
||||
(cond
|
||||
((or (and c-buffer-is-cc-mode
|
||||
(looking-back
|
||||
(concat "\\("
|
||||
(regexp-opt
|
||||
'("#include" "vector" "deque" "list" "map" "stack"
|
||||
"multimap" "set" "hash_map" "iterator" "template"
|
||||
"pair" "auto_ptr" "static_cast"
|
||||
"dynmaic_cast" "const_cast" "reintepret_cast"
|
||||
|
||||
"#import"))
|
||||
"\\)\\ *")
|
||||
(line-beginning-position)))
|
||||
(derived-mode-p 'sgml-mode))
|
||||
(insert "<>")
|
||||
(backward-char))
|
||||
(t
|
||||
(electric-spacing-insert "<"))))
|
||||
|
||||
(defun electric-spacing-: ()
|
||||
"See `electric-spacing-insert'."
|
||||
(cond (c-buffer-is-cc-mode
|
||||
(if (looking-back "\\?.+")
|
||||
(electric-spacing-insert ":")
|
||||
(electric-spacing-insert ":" 'middle)))
|
||||
((derived-mode-p 'haskell-mode)
|
||||
(electric-spacing-insert ":"))
|
||||
((derived-mode-p 'python-mode) (electric-spacing-python-:))
|
||||
((derived-mode-p 'ess-mode)
|
||||
(insert ":"))
|
||||
(t
|
||||
(electric-spacing-insert ":" 'after))))
|
||||
|
||||
(defun electric-spacing-\, ()
|
||||
"See `electric-spacing-insert'."
|
||||
(electric-spacing-insert "," 'after))
|
||||
|
||||
(defun electric-spacing-. ()
|
||||
"See `electric-spacing-insert'."
|
||||
(cond ((and electric-spacing-double-space-docs
|
||||
(electric-spacing-document?))
|
||||
(electric-spacing-insert "." 'after)
|
||||
(insert " "))
|
||||
((or (looking-back "[0-9]")
|
||||
(or (and c-buffer-is-cc-mode
|
||||
(looking-back "[a-z]"))
|
||||
(and
|
||||
(derived-mode-p 'python-mode 'ruby-mode)
|
||||
(looking-back "[a-z\)]"))
|
||||
(and
|
||||
(derived-mode-p 'js-mode 'js2-mode)
|
||||
(looking-back "[a-z\)$]"))))
|
||||
(insert "."))
|
||||
((derived-mode-p 'cperl-mode 'perl-mode 'ruby-mode)
|
||||
;; Check for the .. range operator
|
||||
(if (looking-back ".")
|
||||
(insert ".")
|
||||
(insert " . ")))
|
||||
(t
|
||||
(electric-spacing-insert "." 'after)
|
||||
(insert " "))))
|
||||
|
||||
(defun electric-spacing-& ()
|
||||
"See `electric-spacing-insert'."
|
||||
(cond (c-buffer-is-cc-mode
|
||||
;; ,----[ cases ]
|
||||
;; | char &a = b; // FIXME
|
||||
;; | void foo(const int& a);
|
||||
;; | char *a = &b;
|
||||
;; | int c = a & b;
|
||||
;; | a && b;
|
||||
;; `----
|
||||
(cond ((looking-back (concat (electric-spacing-c-types) " *" ))
|
||||
(electric-spacing-insert "&" 'after))
|
||||
((looking-back "= *")
|
||||
(electric-spacing-insert "&" 'before))
|
||||
(t
|
||||
(electric-spacing-insert "&"))))
|
||||
(t
|
||||
(electric-spacing-insert "&"))))
|
||||
|
||||
(defun electric-spacing-* ()
|
||||
"See `electric-spacing-insert'."
|
||||
(cond (c-buffer-is-cc-mode
|
||||
;; ,----
|
||||
;; | a * b;
|
||||
;; | char *a;
|
||||
;; | char **b;
|
||||
;; | (*a)->func();
|
||||
;; | *p++;
|
||||
;; | *a = *b;
|
||||
;; `----
|
||||
(cond ((looking-back (concat (electric-spacing-c-types) " *" ))
|
||||
(electric-spacing-insert "*" 'before))
|
||||
((looking-back "\\* *")
|
||||
(electric-spacing-insert "*" 'middle))
|
||||
((looking-back "^[ (]*")
|
||||
(electric-spacing-insert "*" 'middle)
|
||||
(indent-according-to-mode))
|
||||
((looking-back "= *")
|
||||
(electric-spacing-insert "*" 'before))
|
||||
(t
|
||||
(electric-spacing-insert "*"))))
|
||||
|
||||
;; Handle python *args and **kwargs
|
||||
((derived-mode-p 'python-mode)
|
||||
;; Can only occur after '(' ',' or on a new line, so just check
|
||||
;; for those. If it's just after a comma then also insert a space
|
||||
;; before the *.
|
||||
(cond ((looking-back ",") (insert " *"))
|
||||
((looking-back "[(,^)][ \t]*[*]?") (insert "*"))
|
||||
;; Othewise act as normal
|
||||
(t (electric-spacing-insert "*"))))
|
||||
(t
|
||||
(electric-spacing-insert "*"))))
|
||||
|
||||
(defun electric-spacing-> ()
|
||||
"See `electric-spacing-insert'."
|
||||
(cond ((and c-buffer-is-cc-mode (looking-back " - "))
|
||||
(delete-char -3)
|
||||
(insert "->"))
|
||||
(t
|
||||
(electric-spacing-insert ">"))))
|
||||
|
||||
(defun electric-spacing-+ ()
|
||||
"See `electric-spacing-insert'."
|
||||
(cond ((and c-buffer-is-cc-mode (looking-back "\\+ *"))
|
||||
(when (looking-back "[a-zA-Z0-9_] +\\+ *")
|
||||
(save-excursion
|
||||
(backward-char 2)
|
||||
(delete-horizontal-space)))
|
||||
(electric-spacing-insert "+" 'middle)
|
||||
(indent-according-to-mode))
|
||||
(t
|
||||
(electric-spacing-insert "+"))))
|
||||
|
||||
(defun electric-spacing-- ()
|
||||
"See `electric-spacing-insert'."
|
||||
(cond ((and c-buffer-is-cc-mode (looking-back "\\- *"))
|
||||
(when (looking-back "[a-zA-Z0-9_] +\\- *")
|
||||
(save-excursion
|
||||
(backward-char 2)
|
||||
(delete-horizontal-space)))
|
||||
(electric-spacing-insert "-" 'middle)
|
||||
(indent-according-to-mode))
|
||||
|
||||
;; exponent notation, e.g. 1e-10: don't space
|
||||
((looking-back "[0-9.]+[eE]")
|
||||
(insert "-"))
|
||||
|
||||
;; a = -9
|
||||
((and (looking-back (concat electric-spacing-operators-regexp " *"))
|
||||
(not (looking-back "- *")))
|
||||
(electric-spacing-insert "-" 'before))
|
||||
|
||||
(t
|
||||
(electric-spacing-insert "-"))))
|
||||
|
||||
(defun electric-spacing-? ()
|
||||
"See `electric-spacing-insert'."
|
||||
(cond (c-buffer-is-cc-mode
|
||||
(electric-spacing-insert "?"))
|
||||
(t
|
||||
(electric-spacing-insert "?" 'after))))
|
||||
|
||||
(defun electric-spacing-% ()
|
||||
"See `electric-spacing-insert'."
|
||||
(cond (c-buffer-is-cc-mode
|
||||
;; ,----
|
||||
;; | a % b;
|
||||
;; | printf("%d %d\n", a % b);
|
||||
;; `----
|
||||
(if (and (looking-back "\".*")
|
||||
(not (looking-back "\",.*")))
|
||||
(insert "%")
|
||||
(electric-spacing-insert "%")))
|
||||
;; If this is a comment or string, we most likely
|
||||
;; want no spaces - probably string formatting
|
||||
((and (derived-mode-p 'python-mode)
|
||||
(electric-spacing-document?))
|
||||
(insert "%"))
|
||||
(t
|
||||
(electric-spacing-insert "%"))))
|
||||
|
||||
(defun electric-spacing-~ ()
|
||||
"See `electric-spacing-insert'."
|
||||
;; First class regex operator =~ langs
|
||||
(cond ((derived-mode-p 'ruby-mode 'perl-mode 'cperl-mode)
|
||||
(if (looking-back "= ")
|
||||
(progn
|
||||
(delete-char -2)
|
||||
(insert "=~ "))
|
||||
(insert "~")))
|
||||
(t
|
||||
(insert "~"))))
|
||||
|
||||
(defun electric-spacing-/ ()
|
||||
"See `electric-spacing-insert'."
|
||||
;; *nix shebangs #!
|
||||
(cond ((and (eq 1 (line-number-at-pos))
|
||||
(save-excursion
|
||||
(move-beginning-of-line nil)
|
||||
(looking-at "#!")))
|
||||
(insert "/"))
|
||||
(t
|
||||
(electric-spacing-insert "/"))))
|
||||
|
||||
|
||||
(defun electric-spacing-enclosing-paren ()
|
||||
"Return the opening parenthesis of the enclosing parens, or nil if not inside any parens."
|
||||
(interactive)
|
||||
(let ((ppss (syntax-ppss)))
|
||||
(when (nth 1 ppss)
|
||||
(char-after (nth 1 ppss)))))
|
||||
|
||||
(defun electric-spacing-python-: ()
|
||||
(if (and (not (in-string-p))
|
||||
(eq (electric-spacing-enclosing-paren) ?\{))
|
||||
(electric-spacing-insert ":" 'after)
|
||||
(insert ":")))
|
||||
|
||||
(provide 'electric-spacing)
|
||||
|
||||
;;; electric-spacing.el ends here
|
||||
@@ -1,108 +0,0 @@
|
||||
;;; emamux-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||
|
||||
;;;### (autoloads nil "emamux" "emamux.el" (22499 62545 613623 56000))
|
||||
;;; Generated autoloads from emamux.el
|
||||
|
||||
(autoload 'emamux:send-command "emamux" "\
|
||||
Send command to target-session of tmux
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'emamux:send-region "emamux" "\
|
||||
Send region to target-session of tmux
|
||||
|
||||
\(fn BEG END)" t nil)
|
||||
|
||||
(autoload 'emamux:copy-kill-ring "emamux" "\
|
||||
Set (car kill-ring) to tmux buffer
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(autoload 'emamux:yank-from-list-buffers "emamux" "\
|
||||
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'emamux:kill-session "emamux" "\
|
||||
Kill tmux session
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'emamux:run-command "emamux" "\
|
||||
Run command
|
||||
|
||||
\(fn CMD &optional CMDDIR)" t nil)
|
||||
|
||||
(autoload 'emamux:run-last-command "emamux" "\
|
||||
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'emamux:close-runner-pane "emamux" "\
|
||||
Close runner pane
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'emamux:close-panes "emamux" "\
|
||||
Close all panes except current pane
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'emamux:inspect-runner "emamux" "\
|
||||
Enter copy-mode in runner pane
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'emamux:interrupt-runner "emamux" "\
|
||||
Send SIGINT to runner pane
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'emamux:clear-runner-history "emamux" "\
|
||||
Clear history of runner pane
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'emamux:zoom-runner "emamux" "\
|
||||
Zoom runner pane. This feature requires tmux 1.8 or higher
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'emamux:new-window "emamux" "\
|
||||
Create new window by cd-ing to current directory.
|
||||
With prefix-arg, use '-a' option to insert the new window next to current index.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'emamux:clone-current-frame "emamux" "\
|
||||
Clones current frame into a new tmux window.
|
||||
With prefix-arg, use '-a' option to insert the new window next to current index.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'emamux:split-window "emamux" "\
|
||||
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'emamux:split-window-horizontally "emamux" "\
|
||||
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'emamux:run-region "emamux" "\
|
||||
Send region to runner pane.
|
||||
|
||||
\(fn BEG END)" t nil)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; emamux-autoloads.el ends here
|
||||
@@ -1 +0,0 @@
|
||||
(define-package "emamux" "20160602.653" "Interact with tmux" '((emacs "24") (cl-lib "0.5")) :url "https://github.com/syohex/emacs-emamux")
|
||||
@@ -1,576 +0,0 @@
|
||||
;;; emamux.el --- Interact with tmux -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2016 by Syohei YOSHIDA
|
||||
|
||||
;; Author: Syohei YOSHIDA <syohex@gmail.com>
|
||||
;; URL: https://github.com/syohex/emacs-emamux
|
||||
;; Package-Version: 20160602.653
|
||||
;; Version: 0.13
|
||||
;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
|
||||
|
||||
;; 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:
|
||||
|
||||
;; emamux makes you interact emacs and tmux.
|
||||
;; emamux is inspired by `vimux' and `tslime.vim'.
|
||||
;;
|
||||
;; To use emamux, add the following code into your init.el or .emacs:
|
||||
;;
|
||||
;; (require 'emamux)
|
||||
;;
|
||||
;; Please see https://github.com/syohex/emacs-emamux/
|
||||
;; for more information.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(defvar helm-mode))
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'tramp)
|
||||
|
||||
(defgroup emamux nil
|
||||
"tmux manipulation from Emacs"
|
||||
:prefix "emamux:"
|
||||
:group 'processes)
|
||||
|
||||
(defcustom emamux:default-orientation 'vertical
|
||||
"Orientation of spliting runner pane"
|
||||
:type '(choice (const :tag "Split pane vertial" vertical)
|
||||
(const :tag "Split pane horizonal" horizonal)))
|
||||
|
||||
(defcustom emamux:runner-pane-height 20
|
||||
"Orientation of spliting runner pane"
|
||||
:type 'integer)
|
||||
|
||||
(defcustom emamux:use-nearest-pane nil
|
||||
"Use nearest pane for runner pane"
|
||||
:type 'boolean)
|
||||
|
||||
(defsubst emamux:helm-mode-enabled-p ()
|
||||
(and (featurep 'helm) helm-mode))
|
||||
|
||||
(defcustom emamux:completing-read-type (if ido-mode
|
||||
'ido
|
||||
(if (emamux:helm-mode-enabled-p)
|
||||
'helm
|
||||
'normal))
|
||||
"Function type to call for completing read.
|
||||
For helm completion use either `normal' or `helm' and turn on `helm-mode'."
|
||||
:type '(choice (const :tag "Using completing-read" 'normal)
|
||||
(const :tag "Using ido-completing-read" 'ido)
|
||||
(const :tag "Using helm completion" 'helm)))
|
||||
|
||||
(defvar emamux:last-command nil
|
||||
"Last emit command")
|
||||
|
||||
(defvar emamux:session nil)
|
||||
(defvar emamux:window nil)
|
||||
(defvar emamux:pane nil)
|
||||
|
||||
(defsubst emamux:tmux-running-p ()
|
||||
(zerop (process-file "tmux" nil nil nil "has-session")))
|
||||
|
||||
(defun emamux:tmux-run-command (output &rest args)
|
||||
(let ((retval (apply 'process-file "tmux" nil output nil args)))
|
||||
(unless (zerop retval)
|
||||
(error (format "Failed: %s(status = %d)"
|
||||
(mapconcat 'identity (cons "tmux" args) " ")
|
||||
retval)))))
|
||||
|
||||
(defun emamux:set-parameters ()
|
||||
(emamux:set-parameter-session)
|
||||
(emamux:set-parameter-window)
|
||||
(emamux:set-parameter-pane))
|
||||
|
||||
(defun emamux:unset-parameters ()
|
||||
(setq emamux:session nil emamux:window nil emamux:pane nil))
|
||||
|
||||
(defun emamux:set-parameters-p ()
|
||||
(and emamux:session emamux:window emamux:pane))
|
||||
|
||||
(defun emamux:select-completing-read-function ()
|
||||
(cl-case emamux:completing-read-type
|
||||
((normal helm) 'completing-read)
|
||||
(ido 'ido-completing-read)))
|
||||
|
||||
(defun emamux:mode-function ()
|
||||
(cl-case emamux:completing-read-type
|
||||
((normal ido) 'ignore)
|
||||
(helm (if (emamux:helm-mode-enabled-p) 'ignore 'helm-mode))))
|
||||
|
||||
(defun emamux:completing-read (prompt &rest args)
|
||||
(let ((mode-function (emamux:mode-function)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(funcall mode-function +1)
|
||||
(apply (emamux:select-completing-read-function) prompt args))
|
||||
(funcall mode-function -1))))
|
||||
|
||||
(defun emamux:read-parameter-session ()
|
||||
(let ((candidates (emamux:get-sessions)))
|
||||
(if (= (length candidates) 1)
|
||||
(car candidates)
|
||||
(emamux:completing-read "Session: " candidates nil t))))
|
||||
|
||||
(defun emamux:set-parameter-session ()
|
||||
(setq emamux:session (emamux:read-parameter-session)))
|
||||
|
||||
(defun emamux:read-parameter-window ()
|
||||
(let* ((candidates (emamux:get-window))
|
||||
(selected (if (= (length candidates) 1)
|
||||
(car candidates)
|
||||
(emamux:completing-read "Window: " candidates nil t))))
|
||||
(car (split-string selected ":"))))
|
||||
|
||||
(defun emamux:set-parameter-window ()
|
||||
(setq emamux:window (emamux:read-parameter-window)))
|
||||
|
||||
(defun emamux:read-parameter-pane ()
|
||||
(let ((candidates (emamux:get-pane)))
|
||||
(if (= (length candidates) 1)
|
||||
(car candidates)
|
||||
(emamux:completing-read "Input pane: " candidates))))
|
||||
|
||||
(defun emamux:set-parameter-pane ()
|
||||
(setq emamux:pane (emamux:read-parameter-pane)))
|
||||
|
||||
(cl-defun emamux:target-session (&optional (session emamux:session)
|
||||
(window emamux:window)
|
||||
(pane emamux:pane))
|
||||
(format "%s:%s.%s" session window pane))
|
||||
|
||||
(defun emamux:get-sessions ()
|
||||
(with-temp-buffer
|
||||
(emamux:tmux-run-command t "list-sessions")
|
||||
(goto-char (point-min))
|
||||
(let (sessions)
|
||||
(while (re-search-forward "^\\([^:]+\\):" nil t)
|
||||
(push (match-string-no-properties 1) sessions))
|
||||
sessions)))
|
||||
|
||||
(defun emamux:get-buffers ()
|
||||
(with-temp-buffer
|
||||
(emamux:tmux-run-command t "list-buffers")
|
||||
(goto-char (point-min))
|
||||
(cl-loop for count from 0 while
|
||||
(re-search-forward
|
||||
"^\\([0-9]+\\): +\\([0-9]+\\) +\\(bytes\\): +[\"]\\(.*\\)[\"]" nil t)
|
||||
collect (cons (replace-regexp-in-string
|
||||
"\\s\\" "" (match-string-no-properties 4))
|
||||
count))))
|
||||
|
||||
(defun emamux:show-buffer (index)
|
||||
(with-temp-buffer
|
||||
(emamux:tmux-run-command t "show-buffer" "-b" (number-to-string index))
|
||||
(buffer-substring-no-properties (point-min) (point-max))))
|
||||
|
||||
(defun emamux:get-window ()
|
||||
(with-temp-buffer
|
||||
(emamux:tmux-run-command t "list-windows" "-t" emamux:session)
|
||||
(goto-char (point-min))
|
||||
(let (windows)
|
||||
(while (re-search-forward "^\\([0-9]+: [^ ]+\\)" nil t)
|
||||
(push (match-string-no-properties 1) windows))
|
||||
(reverse windows))))
|
||||
|
||||
(defun emamux:get-pane ()
|
||||
(with-temp-buffer
|
||||
(let ((pane-id (concat emamux:session ":" emamux:window)))
|
||||
(emamux:tmux-run-command t "list-panes" "-t" pane-id))
|
||||
(goto-char (point-min))
|
||||
(let (panes)
|
||||
(while (re-search-forward "^\\([0-9]+\\):" nil t)
|
||||
(push (match-string-no-properties 1) panes))
|
||||
(reverse panes))))
|
||||
|
||||
(defun emamux:read-command (prompt use-last-cmd)
|
||||
(let ((cmd (read-shell-command prompt (and use-last-cmd emamux:last-command))))
|
||||
(setq emamux:last-command cmd)
|
||||
cmd))
|
||||
|
||||
(defun emamux:check-tmux-running ()
|
||||
(unless (emamux:tmux-running-p)
|
||||
(error "'tmux' does not run on this machine!!")))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:send-command ()
|
||||
"Send command to target-session of tmux"
|
||||
(interactive)
|
||||
(emamux:check-tmux-running)
|
||||
(condition-case nil
|
||||
(progn
|
||||
(if (or current-prefix-arg (not (emamux:set-parameters-p)))
|
||||
(emamux:set-parameters))
|
||||
(let* ((target (emamux:target-session))
|
||||
(prompt (format "Command [Send to (%s)]: " target))
|
||||
(input (emamux:read-command prompt t)))
|
||||
(emamux:reset-prompt target)
|
||||
(emamux:send-keys input)))
|
||||
(quit (emamux:unset-parameters))))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:send-region (beg end)
|
||||
"Send region to target-session of tmux"
|
||||
(interactive "r")
|
||||
(emamux:check-tmux-running)
|
||||
(condition-case nil
|
||||
(progn
|
||||
(if (or current-prefix-arg (not (emamux:set-parameters-p)))
|
||||
(emamux:set-parameters))
|
||||
(let ((target (emamux:target-session))
|
||||
(input (buffer-substring-no-properties beg end)))
|
||||
(setq emamux:last-command input)
|
||||
(emamux:reset-prompt target)
|
||||
(emamux:send-keys input)))
|
||||
(quit (emamux:unset-parameters))))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:copy-kill-ring (arg)
|
||||
"Set (car kill-ring) to tmux buffer"
|
||||
(interactive "P")
|
||||
(emamux:check-tmux-running)
|
||||
(when (null kill-ring)
|
||||
(error "kill-ring is nil!!"))
|
||||
(let ((index (or arg 0))
|
||||
(data (substring-no-properties (car kill-ring))))
|
||||
(emamux:set-buffer data index)))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:yank-from-list-buffers ()
|
||||
(interactive)
|
||||
(emamux:check-tmux-running)
|
||||
(let* ((candidates (emamux:get-buffers))
|
||||
(index (assoc-default
|
||||
(emamux:completing-read
|
||||
"Buffers: " (mapcar 'car candidates))
|
||||
candidates)))
|
||||
(insert (emamux:show-buffer index))))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:kill-session ()
|
||||
"Kill tmux session"
|
||||
(interactive)
|
||||
(emamux:check-tmux-running)
|
||||
(let ((session (emamux:read-parameter-session)))
|
||||
(emamux:tmux-run-command nil "kill-session" "-t" session)))
|
||||
|
||||
(defsubst emamux:escape-semicolon (str)
|
||||
(replace-regexp-in-string ";\\'" "\\\\;" str))
|
||||
|
||||
(cl-defun emamux:send-keys (input &optional (target (emamux:target-session)))
|
||||
(let ((escaped (emamux:escape-semicolon input)))
|
||||
(emamux:tmux-run-command nil "send-keys" "-t" target escaped "C-m")))
|
||||
|
||||
(defun emamux:set-buffer-argument (index data)
|
||||
(if (zerop index)
|
||||
(list data)
|
||||
(list "-b" (number-to-string index) data)))
|
||||
|
||||
(defun emamux:set-buffer (data index)
|
||||
(let ((args (emamux:set-buffer-argument index data)))
|
||||
(apply 'emamux:tmux-run-command nil "set-buffer" args)))
|
||||
|
||||
(defun emamux:in-tmux-p ()
|
||||
(and (not (display-graphic-p))
|
||||
(getenv "TMUX")))
|
||||
|
||||
(defvar emamux:runner-pane-id-map nil)
|
||||
|
||||
(defun emamux:gc-runner-pane-map ()
|
||||
(let ((alive-window-ids (emamux:window-ids))
|
||||
ret)
|
||||
(dolist (entry emamux:runner-pane-id-map)
|
||||
(if (and (member (car entry) alive-window-ids))
|
||||
(setq ret (cons entry ret))))
|
||||
(setq emamux:runner-pane-id-map ret)))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:run-command (cmd &optional cmddir)
|
||||
"Run command"
|
||||
(interactive
|
||||
(list (emamux:read-command "Run command: " nil)))
|
||||
(emamux:check-tmux-running)
|
||||
(unless (emamux:in-tmux-p)
|
||||
(error "You are not in 'tmux'"))
|
||||
(emamux:gc-runner-pane-map)
|
||||
(let ((current-pane (emamux:current-active-pane-id)))
|
||||
(unless (emamux:runner-alive-p)
|
||||
(emamux:setup-runner-pane)
|
||||
(emamux:chdir-pane cmddir))
|
||||
(emamux:send-keys cmd (emamux:get-runner-pane-id))
|
||||
(emamux:select-pane current-pane)))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:run-last-command ()
|
||||
(interactive)
|
||||
(unless emamux:last-command
|
||||
(error "You have never run command"))
|
||||
(emamux:run-command emamux:last-command))
|
||||
|
||||
(defun emamux:reset-prompt (pane)
|
||||
(emamux:tmux-run-command nil "send-keys" "-t" pane "q" "C-u"))
|
||||
|
||||
(defun emamux:chdir-pane (dir)
|
||||
(let ((chdir-cmd (format " cd %s" (or dir default-directory))))
|
||||
(emamux:send-keys chdir-cmd (emamux:get-runner-pane-id))))
|
||||
|
||||
(defun emamux:get-runner-pane-id ()
|
||||
(assoc-default (emamux:current-active-window-id) emamux:runner-pane-id-map))
|
||||
|
||||
(defun emamux:add-to-assoc (key value alist-variable)
|
||||
(let* ((alist (symbol-value alist-variable))
|
||||
(entry (assoc key alist)))
|
||||
(if entry (setcdr entry value)
|
||||
(set alist-variable
|
||||
(cons (cons key value) alist)))))
|
||||
|
||||
(defun emamux:setup-runner-pane ()
|
||||
(let ((nearest-pane-id (emamux:nearest-inactive-pane-id (emamux:list-panes))))
|
||||
(if (and emamux:use-nearest-pane nearest-pane-id)
|
||||
(progn
|
||||
(emamux:select-pane nearest-pane-id)
|
||||
(emamux:reset-prompt nearest-pane-id))
|
||||
(emamux:split-runner-pane))
|
||||
(emamux:add-to-assoc
|
||||
(emamux:current-active-window-id)
|
||||
(emamux:current-active-pane-id)
|
||||
'emamux:runner-pane-id-map)))
|
||||
|
||||
(defun emamux:select-pane (target)
|
||||
(emamux:tmux-run-command nil "select-pane" "-t" target))
|
||||
|
||||
(defconst emamux:orientation-option-alist
|
||||
'((vertical . "-v") (horizonal . "-h")))
|
||||
|
||||
(defun emamux:split-runner-pane ()
|
||||
(let ((orient-option (assoc-default emamux:default-orientation
|
||||
emamux:orientation-option-alist)))
|
||||
(emamux:tmux-run-command nil
|
||||
"split-window" "-p"
|
||||
(number-to-string emamux:runner-pane-height)
|
||||
orient-option)))
|
||||
|
||||
(defun emamux:list-panes ()
|
||||
(with-temp-buffer
|
||||
(emamux:tmux-run-command t "list-panes")
|
||||
(cl-loop initially (goto-char (point-min))
|
||||
while (re-search-forward "^\\(.+\\)$" nil t)
|
||||
collect (match-string-no-properties 1))))
|
||||
|
||||
(defun emamux:active-pane-id (panes)
|
||||
(cl-loop for pane in panes
|
||||
when (string-match "\\([^ ]+\\) (active)\\'" pane)
|
||||
return (match-string-no-properties 1 pane)))
|
||||
|
||||
(defun emamux:current-active-pane-id ()
|
||||
(emamux:active-pane-id (emamux:list-panes)))
|
||||
|
||||
(defun emamux:nearest-inactive-pane-id (panes)
|
||||
(cl-loop for pane in panes
|
||||
when (and (not (string-match-p "(active)\\'" pane))
|
||||
(string-match " \\([^ ]+\\)\\'" pane))
|
||||
return (match-string-no-properties 1 pane)))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:close-runner-pane ()
|
||||
"Close runner pane"
|
||||
(interactive)
|
||||
(let ((window-id (emamux:current-active-window-id)))
|
||||
(emamux:kill-pane window-id)
|
||||
(delete (assoc window-id emamux:runner-pane-id-map) emamux:runner-pane-id-map)))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:close-panes ()
|
||||
"Close all panes except current pane"
|
||||
(interactive)
|
||||
(when (> (length (emamux:list-panes)) 1)
|
||||
(emamux:kill-all-panes)))
|
||||
|
||||
(defun emamux:kill-all-panes ()
|
||||
(emamux:tmux-run-command nil "kill-pane" "-a"))
|
||||
|
||||
(defun emamux:kill-pane (target)
|
||||
(emamux:tmux-run-command nil "kill-pane" "-t" target))
|
||||
|
||||
(defsubst emamux:pane-alive-p (target)
|
||||
(zerop (process-file "tmux" nil nil nil "list-panes" "-t" target)))
|
||||
|
||||
(defun emamux:runner-alive-p ()
|
||||
(let ((pane-id
|
||||
(assoc-default
|
||||
(emamux:current-active-window-id)
|
||||
emamux:runner-pane-id-map)))
|
||||
(and pane-id (emamux:pane-alive-p pane-id))))
|
||||
|
||||
(defun emamux:check-runner-alive ()
|
||||
(unless (emamux:runner-alive-p)
|
||||
(error "There is no runner pane")))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:inspect-runner ()
|
||||
"Enter copy-mode in runner pane"
|
||||
(interactive)
|
||||
(emamux:check-runner-alive)
|
||||
(emamux:select-pane (emamux:get-runner-pane-id))
|
||||
(emamux:tmux-run-command nil "copy-mode"))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:interrupt-runner ()
|
||||
"Send SIGINT to runner pane"
|
||||
(interactive)
|
||||
(emamux:check-runner-alive)
|
||||
(emamux:tmux-run-command nil "send-keys" "-t" (emamux:get-runner-pane-id) "^c"))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:clear-runner-history ()
|
||||
"Clear history of runner pane"
|
||||
(interactive)
|
||||
(emamux:check-runner-alive)
|
||||
(emamux:tmux-run-command nil "clear-history" (emamux:get-runner-pane-id)))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:zoom-runner ()
|
||||
"Zoom runner pane. This feature requires tmux 1.8 or higher"
|
||||
(interactive)
|
||||
(emamux:check-runner-alive)
|
||||
(emamux:tmux-run-command nil "resize-pane" "-Z" "-t" (emamux:get-runner-pane-id)))
|
||||
|
||||
(defmacro emamux:ensure-ssh-and-cd (&rest body)
|
||||
"Do whatever the operation, and send keys of ssh and cd according to the `default-directory'."
|
||||
(cl-declare (special localname host))
|
||||
`(let (cd-to ssh-to)
|
||||
(if (file-remote-p default-directory)
|
||||
(with-parsed-tramp-file-name
|
||||
default-directory nil
|
||||
(setq cd-to localname)
|
||||
(unless (string-match tramp-local-host-regexp host)
|
||||
(setq ssh-to host)))
|
||||
(setq cd-to default-directory))
|
||||
(let ((default-directory (expand-file-name "~")))
|
||||
,@body
|
||||
(let ((new-pane-id (emamux:current-active-pane-id))
|
||||
(chdir-cmd (format " cd %s" cd-to)))
|
||||
(if ssh-to
|
||||
(emamux:send-keys (format " ssh %s" ssh-to) new-pane-id))
|
||||
(emamux:send-keys chdir-cmd new-pane-id)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:new-window ()
|
||||
"Create new window by cd-ing to current directory.
|
||||
With prefix-arg, use '-a' option to insert the new window next to current index."
|
||||
(interactive)
|
||||
(emamux:ensure-ssh-and-cd
|
||||
(apply 'emamux:tmux-run-command nil "new-window"
|
||||
(and current-prefix-arg '("-a")))))
|
||||
|
||||
(defun emamux:list-windows ()
|
||||
(with-temp-buffer
|
||||
(emamux:tmux-run-command t "list-windows")
|
||||
(cl-loop initially (goto-char (point-min))
|
||||
while (re-search-forward "^\\(.+\\)$" nil t)
|
||||
collect (match-string-no-properties 1))))
|
||||
|
||||
(defun emamux:window-ids ()
|
||||
(with-temp-buffer
|
||||
(emamux:tmux-run-command t "list-windows" "-F" "#{window_id}")
|
||||
(split-string (buffer-string))))
|
||||
|
||||
(defun emamux:active-window-id (windows)
|
||||
(cl-loop for window in windows
|
||||
when (string-match "\\([^ ]+\\) (active)\\'" window)
|
||||
return (match-string-no-properties 1 window)))
|
||||
|
||||
(defun emamux:current-active-window-id ()
|
||||
(emamux:active-window-id (emamux:list-windows)))
|
||||
|
||||
(defvar emamux:cloning-window-state nil)
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:clone-current-frame ()
|
||||
"Clones current frame into a new tmux window.
|
||||
With prefix-arg, use '-a' option to insert the new window next to current index."
|
||||
(interactive)
|
||||
(setq emamux:cloning-window-state (window-state-get (frame-root-window)))
|
||||
(apply 'emamux:tmux-run-command nil
|
||||
"new-window" (and current-prefix-arg '("-a")))
|
||||
(let ((new-window-id (emamux:current-active-window-id))
|
||||
(chdir-cmd (format " cd %s" default-directory))
|
||||
(emacsclient-cmd " emacsclient -t -e '(run-with-timer 0.01 nil (lambda () (window-state-put emamux:cloning-window-state nil (quote safe))))'"))
|
||||
(emamux:send-keys chdir-cmd new-window-id)
|
||||
(emamux:send-keys emacsclient-cmd new-window-id)))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:split-window ()
|
||||
(interactive)
|
||||
(emamux:ensure-ssh-and-cd
|
||||
(emamux:tmux-run-command nil "split-window")))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:split-window-horizontally ()
|
||||
(interactive)
|
||||
(emamux:ensure-ssh-and-cd
|
||||
(emamux:tmux-run-command nil "split-window" "-h")))
|
||||
|
||||
;;;###autoload
|
||||
(defun emamux:run-region (beg end)
|
||||
"Send region to runner pane."
|
||||
(interactive "r")
|
||||
(let ((input (buffer-substring-no-properties beg end)))
|
||||
(emamux:run-command input)))
|
||||
|
||||
|
||||
(defvar emamux:keymap
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "\C-s" #'emamux:send-command)
|
||||
(define-key map "\C-y" #'emamux:yank-from-list-buffers)
|
||||
(when (emamux:in-tmux-p)
|
||||
(define-key map "\M-!" #'emamux:run-command)
|
||||
(define-key map "\M-r" #'emamux:run-last-command)
|
||||
(define-key map "\M-s" #'emamux:run-region)
|
||||
(define-key map "\C-i" #'emamux:inspect-runner)
|
||||
(define-key map "\C-k" #'emamux:close-panes)
|
||||
(define-key map "\C-c" #'emamux:interrupt-runner)
|
||||
(define-key map "\M-k" #'emamux:clear-runner-history)
|
||||
(define-key map "c" #'emamux:new-window)
|
||||
(define-key map "C" #'emamux:clone-current-frame)
|
||||
(define-key map "2" #'emamux:split-window)
|
||||
(define-key map "3" #'emamux:split-window-horizontally))
|
||||
map)
|
||||
"Default keymap for emamux commands. Use like
|
||||
\(global-set-key (kbd \"M-g\") emamux:keymap\)
|
||||
|
||||
Keymap:
|
||||
|
||||
| Key | Command |
|
||||
|-----+----------------------------------|
|
||||
| C-s | emamux:send-command |
|
||||
| C-y | emamux:yank-from-list-buffers |
|
||||
| M-! | emamux:run-command |
|
||||
| M-r | emamux:run-last-command |
|
||||
| M-s | emamux:region |
|
||||
| C-i | emamux:inspect-runner |
|
||||
| C-k | emamux:close-panes |
|
||||
| C-c | emamux:interrupt-runner |
|
||||
| M-k | emamux:clear-runner-history |
|
||||
| c | emamux:new-window |
|
||||
| C | emamux:clone-current-frame |
|
||||
| 2 | emamux:split-window |
|
||||
| 3 | emamux:split-window-horizontally |
|
||||
")
|
||||
|
||||
(provide 'emamux)
|
||||
|
||||
;;; emamux.el ends here
|
||||
@@ -1,15 +0,0 @@
|
||||
;;; epl-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||
|
||||
;;;### (autoloads nil nil ("epl.el") (22297 53343 513795 651000))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; epl-autoloads.el ends here
|
||||
@@ -1 +0,0 @@
|
||||
(define-package "epl" "20150517.433" "Emacs Package Library" '((cl-lib "0.3")) :url "http://github.com/cask/epl" :keywords '("convenience"))
|
||||
@@ -1,695 +0,0 @@
|
||||
;;; epl.el --- Emacs Package Library -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2013-2015 Sebastian Wiesner
|
||||
;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2015 Free Software
|
||||
|
||||
;; Author: Sebastian Wiesner <swiesner@lunaryorn.com>
|
||||
;; Maintainer: Johan Andersson <johan.rejeep@gmail.com>
|
||||
;; Sebastian Wiesner <swiesner@lunaryorn.com>
|
||||
;; Version: 0.9-cvs
|
||||
;; Package-Version: 20150517.433
|
||||
;; Package-Requires: ((cl-lib "0.3"))
|
||||
;; Keywords: convenience
|
||||
;; URL: http://github.com/cask/epl
|
||||
|
||||
;; This file is NOT part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; A package management library for Emacs, based on package.el.
|
||||
|
||||
;; The purpose of this library is to wrap all the quirks and hassle of
|
||||
;; package.el into a sane API.
|
||||
|
||||
;; The following functions comprise the public interface of this library:
|
||||
|
||||
;;; Package directory selection
|
||||
|
||||
;; `epl-package-dir' gets the directory of packages.
|
||||
|
||||
;; `epl-default-package-dir' gets the default package directory.
|
||||
|
||||
;; `epl-change-package-dir' changes the directory of packages.
|
||||
|
||||
;;; Package system management
|
||||
|
||||
;; `epl-initialize' initializes the package system and activates all
|
||||
;; packages.
|
||||
|
||||
;; `epl-reset' resets the package system.
|
||||
|
||||
;; `epl-refresh' refreshes all package archives.
|
||||
|
||||
;; `epl-add-archive' adds a new package archive.
|
||||
|
||||
;;; Package objects
|
||||
|
||||
;; Struct `epl-requirement' describes a requirement of a package with `name' and
|
||||
;; `version' slots.
|
||||
|
||||
;; `epl-requirement-version-string' gets a requirement version as string.
|
||||
|
||||
;; Struct `epl-package' describes an installed or installable package with a
|
||||
;; `name' and some internal `description'.
|
||||
|
||||
;; `epl-package-version' gets the version of a package.
|
||||
|
||||
;; `epl-package-version-string' gets the version of a package as string.
|
||||
|
||||
;; `epl-package-summary' gets the summary of a package.
|
||||
|
||||
;; `epl-package-requirements' gets the requirements of a package.
|
||||
|
||||
;; `epl-package-directory' gets the installation directory of a package.
|
||||
|
||||
;; `epl-package-from-buffer' creates a package object for the package contained
|
||||
;; in the current buffer.
|
||||
|
||||
;; `epl-package-from-file' creates a package object for a package file, either
|
||||
;; plain lisp or tarball.
|
||||
|
||||
;; `epl-package-from-descriptor-file' creates a package object for a package
|
||||
;; description (i.e. *-pkg.el) file.
|
||||
|
||||
;;; Package database access
|
||||
|
||||
;; `epl-package-installed-p' determines whether a package is installed, either
|
||||
;; built-in or explicitly installed.
|
||||
|
||||
;; `epl-package-outdated-p' determines whether a package is outdated, that is,
|
||||
;; whether a package with a higher version number is available.
|
||||
|
||||
;; `epl-built-in-packages', `epl-installed-packages', `epl-outdated-packages'
|
||||
;; and `epl-available-packages' get all packages built-in, installed, outdated,
|
||||
;; or available for installation respectively.
|
||||
|
||||
;; `epl-find-built-in-package', `epl-find-installed-packages' and
|
||||
;; `epl-find-available-packages' find built-in, installed and available packages
|
||||
;; by name.
|
||||
|
||||
;; `epl-find-upgrades' finds all upgradable packages.
|
||||
|
||||
;; `epl-built-in-p' return true if package is built-in to Emacs.
|
||||
|
||||
;;; Package operations
|
||||
|
||||
;; `epl-install-file' installs a package file.
|
||||
|
||||
;; `epl-package-install' installs a package.
|
||||
|
||||
;; `epl-package-delete' deletes a package.
|
||||
|
||||
;; `epl-upgrade' upgrades packages.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'package)
|
||||
|
||||
|
||||
(unless (fboundp #'define-error)
|
||||
;; `define-error' for 24.3 and earlier, copied from subr.el
|
||||
(defun define-error (name message &optional parent)
|
||||
"Define NAME as a new error signal.
|
||||
MESSAGE is a string that will be output to the echo area if such an error
|
||||
is signaled without being caught by a `condition-case'.
|
||||
PARENT is either a signal or a list of signals from which it inherits.
|
||||
Defaults to `error'."
|
||||
(unless parent (setq parent 'error))
|
||||
(let ((conditions
|
||||
(if (consp parent)
|
||||
(apply #'append
|
||||
(mapcar (lambda (parent)
|
||||
(cons parent
|
||||
(or (get parent 'error-conditions)
|
||||
(error "Unknown signal `%s'" parent))))
|
||||
parent))
|
||||
(cons parent (get parent 'error-conditions)))))
|
||||
(put name 'error-conditions
|
||||
(delete-dups (copy-sequence (cons name conditions))))
|
||||
(when message (put name 'error-message message)))))
|
||||
|
||||
(defsubst epl--package-desc-p (package)
|
||||
"Whether PACKAGE is a `package-desc' object.
|
||||
|
||||
Like `package-desc-p', but return nil, if `package-desc-p' is not
|
||||
defined as function."
|
||||
(and (fboundp 'package-desc-p) (package-desc-p package)))
|
||||
|
||||
|
||||
;;; EPL errors
|
||||
(define-error 'epl-error "EPL error")
|
||||
|
||||
(define-error 'epl-invalid-package "Invalid EPL package" 'epl-error)
|
||||
|
||||
(define-error 'epl-invalid-package-file "Invalid EPL package file"
|
||||
'epl-invalid-package)
|
||||
|
||||
|
||||
;;; Package directory
|
||||
(defun epl-package-dir ()
|
||||
"Get the directory of packages."
|
||||
package-user-dir)
|
||||
|
||||
(defun epl-default-package-dir ()
|
||||
"Get the default directory of packages."
|
||||
(eval (car (get 'package-user-dir 'standard-value))))
|
||||
|
||||
(defun epl-change-package-dir (directory)
|
||||
"Change the directory of packages to DIRECTORY."
|
||||
(setq package-user-dir directory)
|
||||
(epl-initialize))
|
||||
|
||||
|
||||
;;; Package system management
|
||||
(defvar epl--load-path-before-initialize nil
|
||||
"Remember the load path for `epl-reset'.")
|
||||
|
||||
(defun epl-initialize (&optional no-activate)
|
||||
"Load Emacs Lisp packages and activate them.
|
||||
|
||||
With NO-ACTIVATE non-nil, do not activate packages."
|
||||
(setq epl--load-path-before-initialize load-path)
|
||||
(package-initialize no-activate))
|
||||
|
||||
(defalias 'epl-refresh 'package-refresh-contents)
|
||||
|
||||
(defun epl-add-archive (name url)
|
||||
"Add a package archive with NAME and URL."
|
||||
(add-to-list 'package-archives (cons name url)))
|
||||
|
||||
(defun epl-reset ()
|
||||
"Reset the package system.
|
||||
|
||||
Clear the list of installed and available packages, the list of
|
||||
package archives and reset the package directory."
|
||||
(setq package-alist nil
|
||||
package-archives nil
|
||||
package-archive-contents nil
|
||||
load-path epl--load-path-before-initialize)
|
||||
(when (boundp 'package-obsolete-alist) ; Legacy package.el
|
||||
(setq package-obsolete-alist nil))
|
||||
(epl-change-package-dir (epl-default-package-dir)))
|
||||
|
||||
|
||||
;;; Package structures
|
||||
(cl-defstruct (epl-requirement
|
||||
(:constructor epl-requirement-create))
|
||||
"Structure describing a requirement.
|
||||
|
||||
Slots:
|
||||
|
||||
`name' The name of the required package, as symbol.
|
||||
|
||||
`version' The version of the required package, as version list."
|
||||
name
|
||||
version)
|
||||
|
||||
(defun epl-requirement-version-string (requirement)
|
||||
"The version of a REQUIREMENT, as string."
|
||||
(package-version-join (epl-requirement-version requirement)))
|
||||
|
||||
(cl-defstruct (epl-package (:constructor epl-package-create))
|
||||
"Structure representing a package.
|
||||
|
||||
Slots:
|
||||
|
||||
`name' The package name, as symbol.
|
||||
|
||||
`description' The package description.
|
||||
|
||||
The format package description varies between package.el
|
||||
variants. For `package-desc' variants, it is simply the
|
||||
corresponding `package-desc' object. For legacy variants, it is
|
||||
a vector `[VERSION REQS DOCSTRING]'.
|
||||
|
||||
Do not access `description' directly, but instead use the
|
||||
`epl-package' accessors."
|
||||
name
|
||||
description)
|
||||
|
||||
(defmacro epl-package-as-description (var &rest body)
|
||||
"Cast VAR to a package description in BODY.
|
||||
|
||||
VAR is a symbol, bound to an `epl-package' object. This macro
|
||||
casts this object to the `description' object, and binds the
|
||||
description to VAR in BODY."
|
||||
(declare (indent 1))
|
||||
(unless (symbolp var)
|
||||
(signal 'wrong-type-argument (list #'symbolp var)))
|
||||
`(if (epl-package-p ,var)
|
||||
(let ((,var (epl-package-description ,var)))
|
||||
,@body)
|
||||
(signal 'wrong-type-argument (list #'epl-package-p ,var))))
|
||||
|
||||
(defsubst epl-package--package-desc-p (package)
|
||||
"Whether the description of PACKAGE is a `package-desc'."
|
||||
(epl--package-desc-p (epl-package-description package)))
|
||||
|
||||
(defun epl-package-version (package)
|
||||
"Get the version of PACKAGE, as version list."
|
||||
(epl-package-as-description package
|
||||
(cond
|
||||
((fboundp 'package-desc-version) (package-desc-version package))
|
||||
;; Legacy
|
||||
((fboundp 'package-desc-vers)
|
||||
(let ((version (package-desc-vers package)))
|
||||
(if (listp version) version (version-to-list version))))
|
||||
(:else (error "Cannot get version from %S" package)))))
|
||||
|
||||
(defun epl-package-version-string (package)
|
||||
"Get the version from a PACKAGE, as string."
|
||||
(package-version-join (epl-package-version package)))
|
||||
|
||||
(defun epl-package-summary (package)
|
||||
"Get the summary of PACKAGE, as string."
|
||||
(epl-package-as-description package
|
||||
(cond
|
||||
((fboundp 'package-desc-summary) (package-desc-summary package))
|
||||
((fboundp 'package-desc-doc) (package-desc-doc package)) ; Legacy
|
||||
(:else (error "Cannot get summary from %S" package)))))
|
||||
|
||||
(defsubst epl-requirement--from-req (req)
|
||||
"Create a `epl-requirement' from a `package-desc' REQ."
|
||||
(let ((version (cadr req)))
|
||||
(epl-requirement-create :name (car req)
|
||||
:version (if (listp version) version
|
||||
(version-to-list version)))))
|
||||
|
||||
(defun epl-package-requirements (package)
|
||||
"Get the requirements of PACKAGE.
|
||||
|
||||
The requirements are a list of `epl-requirement' objects."
|
||||
(epl-package-as-description package
|
||||
(mapcar #'epl-requirement--from-req (package-desc-reqs package))))
|
||||
|
||||
(defun epl-package-directory (package)
|
||||
"Get the directory PACKAGE is installed to.
|
||||
|
||||
Return the absolute path of the installation directory of
|
||||
PACKAGE, or nil, if PACKAGE is not installed."
|
||||
(cond
|
||||
((fboundp 'package-desc-dir)
|
||||
(package-desc-dir (epl-package-description package)))
|
||||
((fboundp 'package--dir)
|
||||
(package--dir (symbol-name (epl-package-name package))
|
||||
(epl-package-version-string package)))
|
||||
(:else (error "Cannot get package directory from %S" package))))
|
||||
|
||||
(defun epl-package-->= (pkg1 pkg2)
|
||||
"Determine whether PKG1 is before PKG2 by version."
|
||||
(not (version-list-< (epl-package-version pkg1)
|
||||
(epl-package-version pkg2))))
|
||||
|
||||
(defun epl-package--from-package-desc (package-desc)
|
||||
"Create an `epl-package' from a PACKAGE-DESC.
|
||||
|
||||
PACKAGE-DESC is a `package-desc' object, from recent package.el
|
||||
variants."
|
||||
(if (and (fboundp 'package-desc-name)
|
||||
(epl--package-desc-p package-desc))
|
||||
(epl-package-create :name (package-desc-name package-desc)
|
||||
:description package-desc)
|
||||
(signal 'wrong-type-argument (list 'epl--package-desc-p package-desc))))
|
||||
|
||||
(defun epl-package--parse-info (info)
|
||||
"Parse a package.el INFO."
|
||||
(if (epl--package-desc-p info)
|
||||
(epl-package--from-package-desc info)
|
||||
;; For legacy package.el, info is a vector [NAME REQUIRES DESCRIPTION
|
||||
;; VERSION COMMENTARY]. We need to re-shape this vector into the
|
||||
;; `package-alist' format [VERSION REQUIRES DESCRIPTION] to attach it to the
|
||||
;; new `epl-package'.
|
||||
(let ((name (intern (aref info 0)))
|
||||
(info (vector (aref info 3) (aref info 1) (aref info 2))))
|
||||
(epl-package-create :name name :description info))))
|
||||
|
||||
(defun epl-package-from-buffer (&optional buffer)
|
||||
"Create an `epl-package' object from BUFFER.
|
||||
|
||||
BUFFER defaults to the current buffer.
|
||||
|
||||
Signal `epl-invalid-package' if the buffer does not contain a
|
||||
valid package file."
|
||||
(let ((info (with-current-buffer (or buffer (current-buffer))
|
||||
(condition-case err
|
||||
(package-buffer-info)
|
||||
(error (signal 'epl-invalid-package (cdr err)))))))
|
||||
(epl-package--parse-info info)))
|
||||
|
||||
(defun epl-package-from-lisp-file (file-name)
|
||||
"Parse the package headers the file at FILE-NAME.
|
||||
|
||||
Return an `epl-package' object with the header metadata."
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file-name)
|
||||
(condition-case err
|
||||
(epl-package-from-buffer (current-buffer))
|
||||
;; Attach file names to invalid package errors
|
||||
(epl-invalid-package
|
||||
(signal 'epl-invalid-package-file (cons file-name (cdr err))))
|
||||
;; Forward other errors
|
||||
(error (signal (car err) (cdr err))))))
|
||||
|
||||
(defun epl-package-from-tar-file (file-name)
|
||||
"Parse the package tarball at FILE-NAME.
|
||||
|
||||
Return a `epl-package' object with the meta data of the tarball
|
||||
package in FILE-NAME."
|
||||
(condition-case nil
|
||||
;; In legacy package.el, `package-tar-file-info' takes the name of the tar
|
||||
;; file to parse as argument. In modern package.el, it has no arguments
|
||||
;; and works on the current buffer. Hence, we just try to call the legacy
|
||||
;; version, and if that fails because of a mismatch between formal and
|
||||
;; actual arguments, we use the modern approach. To avoid spurious
|
||||
;; signature warnings by the byte compiler, we suppress warnings when
|
||||
;; calling the function.
|
||||
(epl-package--parse-info (with-no-warnings
|
||||
(package-tar-file-info file-name)))
|
||||
(wrong-number-of-arguments
|
||||
(with-temp-buffer
|
||||
(insert-file-contents-literally file-name)
|
||||
;; Switch to `tar-mode' to enable extraction of the file. Modern
|
||||
;; `package-tar-file-info' relies on `tar-mode', and signals an error if
|
||||
;; called in a buffer with a different mode.
|
||||
(tar-mode)
|
||||
(epl-package--parse-info (with-no-warnings
|
||||
(package-tar-file-info)))))))
|
||||
|
||||
(defun epl-package-from-file (file-name)
|
||||
"Parse the package at FILE-NAME.
|
||||
|
||||
Return an `epl-package' object with the meta data of the package
|
||||
at FILE-NAME."
|
||||
(if (string-match-p (rx ".tar" string-end) file-name)
|
||||
(epl-package-from-tar-file file-name)
|
||||
(epl-package-from-lisp-file file-name)))
|
||||
|
||||
(defun epl-package--parse-descriptor-requirement (requirement)
|
||||
"Parse a REQUIREMENT in a package descriptor."
|
||||
;; This function is only called on legacy package.el. On package-desc
|
||||
;; package.el, we just let package.el do the work.
|
||||
(cl-destructuring-bind (name version-string) requirement
|
||||
(list name (version-to-list version-string))))
|
||||
|
||||
(defun epl-package-from-descriptor-file (descriptor-file)
|
||||
"Load a `epl-package' from a package DESCRIPTOR-FILE.
|
||||
|
||||
A package descriptor is a file defining a new package. Its name
|
||||
typically ends with -pkg.el."
|
||||
(with-temp-buffer
|
||||
(insert-file-contents descriptor-file)
|
||||
(goto-char (point-min))
|
||||
(let ((sexp (read (current-buffer))))
|
||||
(unless (eq (car sexp) 'define-package)
|
||||
(error "%S is no valid package descriptor" descriptor-file))
|
||||
(if (and (fboundp 'package-desc-from-define)
|
||||
(fboundp 'package-desc-name))
|
||||
;; In Emacs snapshot, we can conveniently call a function to parse the
|
||||
;; descriptor
|
||||
(let ((desc (apply #'package-desc-from-define (cdr sexp))))
|
||||
(epl-package-create :name (package-desc-name desc)
|
||||
:description desc))
|
||||
;; In legacy package.el, we must manually deconstruct the descriptor,
|
||||
;; because the load function has eval's the descriptor and has a lot of
|
||||
;; global side-effects.
|
||||
(cl-destructuring-bind
|
||||
(name version-string summary requirements) (cdr sexp)
|
||||
(epl-package-create
|
||||
:name (intern name)
|
||||
:description
|
||||
(vector (version-to-list version-string)
|
||||
(mapcar #'epl-package--parse-descriptor-requirement
|
||||
;; Strip the leading `quote' from the package list
|
||||
(cadr requirements))
|
||||
summary)))))))
|
||||
|
||||
|
||||
;;; Package database access
|
||||
(defun epl-package-installed-p (package)
|
||||
"Determine whether a PACKAGE is installed.
|
||||
|
||||
PACKAGE is either a package name as symbol, or a package object."
|
||||
(let ((name (if (epl-package-p package)
|
||||
(epl-package-name package)
|
||||
package))
|
||||
(version (when (epl-package-p package)
|
||||
(epl-package-version package))))
|
||||
(package-installed-p name version)))
|
||||
|
||||
(defun epl--parse-built-in-entry (entry)
|
||||
"Parse an ENTRY from the list of built-in packages.
|
||||
|
||||
Return the corresponding `epl-package' object."
|
||||
(if (fboundp 'package--from-builtin)
|
||||
;; In package-desc package.el, convert the built-in package to a
|
||||
;; `package-desc' and convert that to an `epl-package'
|
||||
(epl-package--from-package-desc (package--from-builtin entry))
|
||||
(epl-package-create :name (car entry) :description (cdr entry))))
|
||||
|
||||
(defun epl-built-in-packages ()
|
||||
"Get all built-in packages.
|
||||
|
||||
Return a list of `epl-package' objects."
|
||||
;; This looks mighty strange, but it's the only way to force package.el to
|
||||
;; build the list of built-in packages. Without this, `package--builtins'
|
||||
;; might be empty.
|
||||
(package-built-in-p 'foo)
|
||||
(mapcar #'epl--parse-built-in-entry package--builtins))
|
||||
|
||||
(defun epl-find-built-in-package (name)
|
||||
"Find a built-in package with NAME.
|
||||
|
||||
NAME is a package name, as symbol.
|
||||
|
||||
Return the built-in package as `epl-package' object, or nil if
|
||||
there is no built-in package with NAME."
|
||||
(when (package-built-in-p name)
|
||||
;; We must call `package-built-in-p' *before* inspecting
|
||||
;; `package--builtins', because otherwise `package--builtins' might be
|
||||
;; empty.
|
||||
(epl--parse-built-in-entry (assq name package--builtins))))
|
||||
|
||||
(defun epl-package-outdated-p (package)
|
||||
"Determine whether a PACKAGE is outdated.
|
||||
|
||||
A package is outdated, if there is an available package with a
|
||||
higher version.
|
||||
|
||||
PACKAGE is either a package name as symbol, or a package object.
|
||||
In the former case, test the installed or built-in package with
|
||||
the highest version number, in the later case, test the package
|
||||
object itself.
|
||||
|
||||
Return t, if the package is outdated, or nil otherwise."
|
||||
(let* ((package (if (epl-package-p package)
|
||||
package
|
||||
(or (car (epl-find-installed-packages package))
|
||||
(epl-find-built-in-package package))))
|
||||
(available (car (epl-find-available-packages
|
||||
(epl-package-name package)))))
|
||||
(and package available (version-list-< (epl-package-version package)
|
||||
(epl-package-version available)))))
|
||||
|
||||
(defun epl--parse-package-list-entry (entry)
|
||||
"Parse a list of packages from ENTRY.
|
||||
|
||||
ENTRY is a single entry in a package list, e.g. `package-alist',
|
||||
`package-archive-contents', etc. Typically it is a cons cell,
|
||||
but the exact format varies between package.el versions. This
|
||||
function tries to parse all known variants.
|
||||
|
||||
Return a list of `epl-package' objects parsed from ENTRY."
|
||||
(let ((descriptions (cdr entry)))
|
||||
(cond
|
||||
((listp descriptions)
|
||||
(sort (mapcar #'epl-package--from-package-desc descriptions)
|
||||
#'epl-package-->=))
|
||||
;; Legacy package.el has just a single package in an entry, which is a
|
||||
;; standard description vector
|
||||
((vectorp descriptions)
|
||||
(list (epl-package-create :name (car entry)
|
||||
:description descriptions)))
|
||||
(:else (error "Cannot parse entry %S" entry)))))
|
||||
|
||||
(defun epl-installed-packages ()
|
||||
"Get all installed packages.
|
||||
|
||||
Return a list of package objects."
|
||||
(apply #'append (mapcar #'epl--parse-package-list-entry package-alist)))
|
||||
|
||||
(defsubst epl--filter-outdated-packages (packages)
|
||||
"Filter outdated packages from PACKAGES."
|
||||
(let (res)
|
||||
(dolist (package packages)
|
||||
(when (epl-package-outdated-p package)
|
||||
(push package res)))
|
||||
(nreverse res)))
|
||||
|
||||
(defun epl-outdated-packages ()
|
||||
"Get all outdated packages, as in `epl-package-outdated-p'.
|
||||
|
||||
Return a list of package objects."
|
||||
(epl--filter-outdated-packages (epl-installed-packages)))
|
||||
|
||||
(defsubst epl--find-package-in-list (name list)
|
||||
"Find a package by NAME in a package LIST.
|
||||
|
||||
Return a list of corresponding `epl-package' objects."
|
||||
(let ((entry (assq name list)))
|
||||
(when entry
|
||||
(epl--parse-package-list-entry entry))))
|
||||
|
||||
(defun epl-find-installed-package (name)
|
||||
"Find the latest installed package by NAME.
|
||||
|
||||
NAME is a package name, as symbol.
|
||||
|
||||
Return the installed package with the highest version number as
|
||||
`epl-package' object, or nil, if no package with NAME is
|
||||
installed."
|
||||
(car (epl-find-installed-packages name)))
|
||||
(make-obsolete 'epl-find-installed-package 'epl-find-installed-packages "0.7")
|
||||
|
||||
(defun epl-find-installed-packages (name)
|
||||
"Find all installed packages by NAME.
|
||||
|
||||
NAME is a package name, as symbol.
|
||||
|
||||
Return a list of all installed packages with NAME, sorted by
|
||||
version number in descending order. Return nil, if there are no
|
||||
packages with NAME."
|
||||
(epl--find-package-in-list name package-alist))
|
||||
|
||||
(defun epl-available-packages ()
|
||||
"Get all packages available for installation.
|
||||
|
||||
Return a list of package objects."
|
||||
(apply #'append (mapcar #'epl--parse-package-list-entry
|
||||
package-archive-contents)))
|
||||
|
||||
(defun epl-find-available-packages (name)
|
||||
"Find available packages for NAME.
|
||||
|
||||
NAME is a package name, as symbol.
|
||||
|
||||
Return a list of available packages for NAME, sorted by version
|
||||
number in descending order. Return nil, if there are no packages
|
||||
for NAME."
|
||||
(epl--find-package-in-list name package-archive-contents))
|
||||
|
||||
(cl-defstruct (epl-upgrade
|
||||
(:constructor epl-upgrade-create))
|
||||
"Structure describing an upgradable package.
|
||||
Slots:
|
||||
|
||||
`installed' The installed package
|
||||
|
||||
`available' The package available for installation."
|
||||
installed
|
||||
available)
|
||||
|
||||
(defun epl-find-upgrades (&optional packages)
|
||||
"Find all upgradable PACKAGES.
|
||||
|
||||
PACKAGES is a list of package objects to upgrade, defaulting to
|
||||
all installed packages.
|
||||
|
||||
Return a list of `epl-upgrade' objects describing all upgradable
|
||||
packages."
|
||||
(let ((packages (or packages (epl-installed-packages)))
|
||||
upgrades)
|
||||
(dolist (pkg packages)
|
||||
(let* ((version (epl-package-version pkg))
|
||||
(name (epl-package-name pkg))
|
||||
;; Find the latest available package for NAME
|
||||
(available-pkg (car (epl-find-available-packages name)))
|
||||
(available-version (when available-pkg
|
||||
(epl-package-version available-pkg))))
|
||||
(when (and available-version (version-list-< version available-version))
|
||||
(push (epl-upgrade-create :installed pkg
|
||||
:available available-pkg)
|
||||
upgrades))))
|
||||
(nreverse upgrades)))
|
||||
|
||||
(defalias 'epl-built-in-p 'package-built-in-p)
|
||||
|
||||
|
||||
;;; Package operations
|
||||
|
||||
(defalias 'epl-install-file 'package-install-file)
|
||||
|
||||
(defun epl-package-install (package &optional force)
|
||||
"Install a PACKAGE.
|
||||
|
||||
PACKAGE is a `epl-package' object. If FORCE is given and
|
||||
non-nil, install PACKAGE, even if it is already installed."
|
||||
(when (or force (not (epl-package-installed-p package)))
|
||||
(if (epl-package--package-desc-p package)
|
||||
(package-install (epl-package-description package))
|
||||
;; The legacy API installs by name. We have no control over versioning,
|
||||
;; etc.
|
||||
(package-install (epl-package-name package)))))
|
||||
|
||||
(defun epl-package-delete (package)
|
||||
"Delete a PACKAGE.
|
||||
|
||||
PACKAGE is a `epl-package' object to delete."
|
||||
;; package-delete allows for packages being trashed instead of fully deleted.
|
||||
;; Let's prevent his silly behavior
|
||||
(let ((delete-by-moving-to-trash nil))
|
||||
;; The byte compiler will warn us that we are calling `package-delete' with
|
||||
;; the wrong number of arguments, since it can't infer that we guarantee to
|
||||
;; always call the correct version. Thus we suppress all warnings when
|
||||
;; calling `package-delete'. I wish there was a more granular way to
|
||||
;; disable just that specific warning, but it is what it is.
|
||||
(if (epl-package--package-desc-p package)
|
||||
(with-no-warnings
|
||||
(package-delete (epl-package-description package)))
|
||||
;; The legacy API deletes by name (as string!) and version instead by
|
||||
;; descriptor. Hence `package-delete' takes two arguments. For some
|
||||
;; insane reason, the arguments are strings here!
|
||||
(let ((name (symbol-name (epl-package-name package)))
|
||||
(version (epl-package-version-string package)))
|
||||
(with-no-warnings
|
||||
(package-delete name version))
|
||||
;; Legacy package.el does not remove the deleted package
|
||||
;; from the `package-alist', so we do it manually here.
|
||||
(let ((pkg (assq (epl-package-name package) package-alist)))
|
||||
(when pkg
|
||||
(setq package-alist (delq pkg package-alist))))))))
|
||||
|
||||
(defun epl-upgrade (&optional packages preserve-obsolete)
|
||||
"Upgrade PACKAGES.
|
||||
|
||||
PACKAGES is a list of package objects to upgrade, defaulting to
|
||||
all installed packages.
|
||||
|
||||
The old versions of the updated packages are deleted, unless
|
||||
PRESERVE-OBSOLETE is non-nil.
|
||||
|
||||
Return a list of all performed upgrades, as a list of
|
||||
`epl-upgrade' objects."
|
||||
(let ((upgrades (epl-find-upgrades packages)))
|
||||
(dolist (upgrade upgrades)
|
||||
(epl-package-install (epl-upgrade-available upgrade) 'force)
|
||||
(unless preserve-obsolete
|
||||
(epl-package-delete (epl-upgrade-installed upgrade))))
|
||||
upgrades))
|
||||
|
||||
(provide 'epl)
|
||||
|
||||
;;; epl.el ends here
|
||||
@@ -1,15 +0,0 @@
|
||||
;;; esxml-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil nil ("esxml.el") (22506 10601 921974 646000))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; esxml-autoloads.el ends here
|
||||
@@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "esxml" "20160703.1417" "Library for working with xml via esxml and sxml" 'nil :keywords '("tools" "lisp" "comm"))
|
||||
@@ -1,261 +0,0 @@
|
||||
;;; esxml.el --- Library for working with xml via esxml and sxml
|
||||
;; Copyright (C) 2012
|
||||
|
||||
;; Author: Evan Izaksonas-Smith <izak0002 at umn dot edu>
|
||||
;; Maintainer: Evan Izaksonas-Smith
|
||||
;; Created: 15th August 2012
|
||||
;; Version: 0.3.2
|
||||
;; Package-Version: 20160703.1417
|
||||
;; Keywords: tools, lisp, comm
|
||||
;; Description: A library for easily generating XML/XHTML in elisp
|
||||
;;
|
||||
;; 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 XML/XHTML done with S-Expressions in EmacsLisp. Simply,
|
||||
;; this is the easiest way to write HTML or XML in Lisp.
|
||||
;;
|
||||
;; This library uses the native form of XML representation as used by
|
||||
;; many libraries already included within emacs. This representation
|
||||
;; will be referred to as "esxml" throughout this library. See
|
||||
;; `esxml-to-xml' for a concise description of the format.
|
||||
;;
|
||||
;; This library is not intended to be used directly by a user, though
|
||||
;; it certainly could be. It could be used to generate static html,
|
||||
;; or use a library like `elnode' to serve dynamic pages. Or even to
|
||||
;; extract a form from a site to produce an API.
|
||||
;;
|
||||
;; TODO: Better documentation, more conveniance.
|
||||
;;
|
||||
;; NOTICE: Code base will be transitioning to using pcase instead of
|
||||
;; destructuring bind wherever possible. If this leads to hard to
|
||||
;; debug code, please let me know, and I will do whatever I can to
|
||||
;; resolve these issues.
|
||||
;;
|
||||
;;; Code:
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
(require 'xml)
|
||||
(require 'pcase)
|
||||
|
||||
(defun string-trim-whitespace (string)
|
||||
"A simple function, strips the whitespace from beginning and
|
||||
end of the string. Leaves all other whitespace untouched."
|
||||
(replace-regexp-in-string
|
||||
(rx string-start (* whitespace)
|
||||
(group (+? anything))
|
||||
(* whitespace) string-end)
|
||||
"\\1"
|
||||
string))
|
||||
|
||||
(defun esxml-trim-ws (esxml)
|
||||
"This may cause problems, is intended for parsing xml into sxml
|
||||
but may eroneously delete desirable white space."
|
||||
(if (stringp esxml) (string-trim-whitespace esxml)
|
||||
(pcase-let ((`(,tag ,attrs . ,body) esxml))
|
||||
`(,tag ,attrs
|
||||
,@(mapcar 'esxml-trim-ws body)))))
|
||||
|
||||
(defun attrp (attr)
|
||||
"Returns t if attr is a an esxml attribute.
|
||||
An esxml attribute is a cons of the form (symbol . string)"
|
||||
(and (consp attr)
|
||||
(symbolp (car attr))
|
||||
(stringp (cdr attr))))
|
||||
|
||||
(defun esxml--convert-pair (attr)
|
||||
"Converts from cons cell to attribute pair. Not intended for
|
||||
general use."
|
||||
(pcase-let ((`(,car . ,cdr) attr))
|
||||
(check-type cdr string)
|
||||
(concat (symbol-name car)
|
||||
"="
|
||||
(prin1-to-string cdr))))
|
||||
|
||||
(defun attrsp (attrs)
|
||||
"Returns t if attrs is a list of esxml attributes.
|
||||
|
||||
See: `attrp'"
|
||||
(and (listp attrs)
|
||||
(every (lambda (attr)
|
||||
(and (consp attr)
|
||||
(symbolp (car attr))
|
||||
(stringp (cdr attr))))
|
||||
attrs)))
|
||||
|
||||
(defun esxml-validate-form (esxml)
|
||||
"A fast esxml validator. Will error on invalid subparts making
|
||||
it suitable for hindsight testing."
|
||||
(cond ((stringp esxml) nil)
|
||||
((< (length esxml) 2)
|
||||
(error "%s is too short to be a valid esxml expression" esxml))
|
||||
(t (pcase-let ((`(,tag ,attrs . ,body) esxml))
|
||||
(check-type tag symbol)
|
||||
(check-type attrs attrs)
|
||||
(mapcar 'esxml-validate-form body)))))
|
||||
|
||||
;; While the following could certainly have been written using format,
|
||||
;; concat makes them easier to read. Update later if neccesary for
|
||||
;; efficiency.
|
||||
|
||||
;; Though at first glance the recursive nature of this function might
|
||||
;; give one pause, since xml is a recursive data type, a recursive
|
||||
;; parser is an optimal strategy. each node will be visited exactly
|
||||
;; once during the transformation.
|
||||
;;
|
||||
;; Further, since a string is a terminal node and since xml can be
|
||||
;; represented as a string, non dynamic portions of the page may be
|
||||
;; precached quite easily.
|
||||
(defun esxml--to-xml-recursive (esxml)
|
||||
(if (stringp esxml) esxml
|
||||
(pcase-let ((`(,tag ,attrs . ,body) esxml))
|
||||
;; code goes here to catch invalid data.
|
||||
(concat "<" (symbol-name tag)
|
||||
(when attrs
|
||||
(concat " " (mapconcat 'esxml--convert-pair attrs " ")))
|
||||
(if body
|
||||
(concat ">" (mapconcat 'esxml--to-xml-recursive body "")
|
||||
"</" (symbol-name tag) ">")
|
||||
"/>")))))
|
||||
|
||||
(defun esxml-to-xml (esxml)
|
||||
"This translates an esxml expression, i.e. that which is
|
||||
returned by xml-parse-region. The structure is defined as a
|
||||
string or a list where the first element is the tag the second is
|
||||
an alist of attribute value pairs and the remainder of the list
|
||||
is 0 or more esxml elements.
|
||||
|
||||
(TAG ATTRS &rest BODY) || STRING
|
||||
|
||||
TAG: is the tag and must be a symbol.
|
||||
|
||||
ATTRS: is an alist of attribute pairs each pair must be of the
|
||||
form (KEY . VALUE).
|
||||
|
||||
KEY: is the name of the attribute and must be a symbol.
|
||||
|
||||
VALUE: is the value of the attribute and must be a string.
|
||||
|
||||
BODY: is zero or more esxml expressions. Having no body forms
|
||||
implies that the tag should be self closed. If there is
|
||||
one or more body forms the tag will always be explicitly
|
||||
closed, even if they are the empty string.
|
||||
|
||||
STRING: if the esxml expression is a string it is returned
|
||||
unchanged, this allows for caching of any constant parts,
|
||||
such as headers and footers.
|
||||
"
|
||||
(condition-case nil
|
||||
(esxml--to-xml-recursive esxml)
|
||||
(error (esxml-validate-form esxml))))
|
||||
|
||||
(defun pp-esxml-to-xml (esxml)
|
||||
"This translates an esxml expresion as `esxml-to-xml' but
|
||||
indents it for ease of human readability, it is neccesarrily
|
||||
slower and will produce longer output."
|
||||
(cond ((stringp esxml) esxml)
|
||||
((and (listp esxml)
|
||||
(> (length esxml) 1))
|
||||
(pcase-let ((`(,tag ,attrs . ,body) esxml))
|
||||
(check-type tag symbol)
|
||||
(check-type attrs attrs)
|
||||
(concat "<" (symbol-name tag)
|
||||
(when attrs
|
||||
(concat " " (mapconcat 'esxml--convert-pair attrs " ")))
|
||||
(if body
|
||||
(concat ">" (if (every 'stringp body)
|
||||
(mapconcat 'identity body " ")
|
||||
(concat "\n"
|
||||
(replace-regexp-in-string
|
||||
"^" " "
|
||||
(mapconcat 'pp-esxml-to-xml body "\n"))
|
||||
"\n"))
|
||||
"</" (symbol-name tag) ">")
|
||||
"/>"))))
|
||||
(t (error "%s is not a valid esxml expression" esxml))))
|
||||
|
||||
(defun sxml-to-esxml (sxml)
|
||||
"Translates sxml to esxml so the common standard can be used.
|
||||
See: http://okmij.org/ftp/Scheme/SXML.html."
|
||||
(pcase sxml
|
||||
(`(,tag (@ . ,attrs) . ,body)
|
||||
`(,tag ,(mapcar (lambda (attr)
|
||||
(cons (first attr)
|
||||
(or (second attr)
|
||||
(prin1-to-string (first attr)))))
|
||||
attrs)
|
||||
,@(mapcar 'sxml-to-esxml body)))
|
||||
(`(,tag . ,body)
|
||||
`(,tag nil
|
||||
,@(mapcar 'sxml-to-esxml body)))
|
||||
((and sxml (pred stringp)) sxml)))
|
||||
|
||||
(defun sxml-to-xml (sxml)
|
||||
"Translates sxml to xml, via esxml, hey it's only a constant
|
||||
factor. :)"
|
||||
(esxml-to-xml (sxml-to-esxml sxml)))
|
||||
|
||||
|
||||
|
||||
;; TODO: make agnostic with respect to libxml vs xml.el
|
||||
(defun xml-to-esxml (string &optional trim)
|
||||
(with-temp-buffer
|
||||
(insert string)
|
||||
(let ((parse-tree (libxml-parse-xml-region (point-min)
|
||||
(point-max))))
|
||||
(if trim
|
||||
(esxml-trim-ws parse-tree)
|
||||
parse-tree))))
|
||||
|
||||
;; TODO, move to esxpath when mature
|
||||
(defun esxml-get-by-key (esxml key value)
|
||||
"Returns a list of all elements whose wttribute KEY match
|
||||
VALUE. KEY should be a symbol, and VALUE should be a string.
|
||||
Will not recurse below a match."
|
||||
(unless (stringp esxml)
|
||||
(pcase-let ((`(,tag ,attrs . ,body) esxml))
|
||||
(if (equal value
|
||||
(assoc-default key attrs))
|
||||
(list esxml)
|
||||
(apply 'append (mapcar (lambda (sexp)
|
||||
(esxml-get-by-key sexp key value))
|
||||
body))))))
|
||||
|
||||
(defun esxml-get-tags (esxml tags)
|
||||
"Returns a list of all elements whose tag is a member of TAGS.
|
||||
TAGS should be a list of tags to be matched against. Will not
|
||||
recurse below a match."
|
||||
(unless (stringp esxml)
|
||||
(pcase-let ((`(,tag ,attrs . ,body) esxml))
|
||||
(if (member tag tags)
|
||||
(list esxml)
|
||||
(apply 'append (mapcar (lambda (sexp)
|
||||
(esxml-get-tags sexp tags))
|
||||
body))))))
|
||||
|
||||
(defun esxml-get-forms (esxml)
|
||||
"Returns a list of all forms."
|
||||
(esxml-get-tags esxml '(form)))
|
||||
|
||||
;; taken from kv
|
||||
(defmacro esxml-destructuring-mapcar (args sexp seq)
|
||||
(declare (indent 2))
|
||||
(let ((entry (make-symbol)))
|
||||
`(mapcar (lambda (,entry)
|
||||
(destructuring-bind ,args ,entry ,sexp))
|
||||
,seq)))
|
||||
|
||||
(provide 'esxml)
|
||||
;;; esxml.el ends here
|
||||
@@ -1,240 +0,0 @@
|
||||
;;; flycheck-autoloads.el --- automatically extracted autoloads
|
||||
;;
|
||||
;;; Code:
|
||||
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
||||
|
||||
;;;### (autoloads nil "flycheck" "flycheck.el" (22541 41885 978061
|
||||
;;;;;; 448000))
|
||||
;;; Generated autoloads from flycheck.el
|
||||
|
||||
(autoload 'flycheck-manual "flycheck" "\
|
||||
Open the Flycheck manual.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(autoload 'flycheck-mode "flycheck" "\
|
||||
Minor mode for on-the-fly syntax checking.
|
||||
|
||||
When called interactively, toggle `flycheck-mode'. With prefix
|
||||
ARG, enable `flycheck-mode' if ARG is positive, otherwise disable
|
||||
it.
|
||||
|
||||
When called from Lisp, enable `flycheck-mode' if ARG is omitted,
|
||||
nil or positive. If ARG is `toggle', toggle `flycheck-mode'.
|
||||
Otherwise behave as if called interactively.
|
||||
|
||||
In `flycheck-mode' the buffer is automatically syntax-checked
|
||||
using the first suitable syntax checker from `flycheck-checkers'.
|
||||
Use `flycheck-select-checker' to select a checker for the current
|
||||
buffer manually.
|
||||
|
||||
\\{flycheck-mode-map}
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(defvar global-flycheck-mode nil "\
|
||||
Non-nil if Global Flycheck mode is enabled.
|
||||
See the `global-flycheck-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 `global-flycheck-mode'.")
|
||||
|
||||
(custom-autoload 'global-flycheck-mode "flycheck" nil)
|
||||
|
||||
(autoload 'global-flycheck-mode "flycheck" "\
|
||||
Toggle Flycheck mode in all buffers.
|
||||
With prefix ARG, enable Global Flycheck mode if ARG is positive;
|
||||
otherwise, disable it. If called from Lisp, enable the mode if
|
||||
ARG is omitted or nil.
|
||||
|
||||
Flycheck mode is enabled in all buffers where
|
||||
`flycheck-mode-on-safe' would do it.
|
||||
See `flycheck-mode' for more information on Flycheck mode.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(autoload 'flycheck-define-error-level "flycheck" "\
|
||||
Define a new error LEVEL with PROPERTIES.
|
||||
|
||||
The following PROPERTIES constitute an error level:
|
||||
|
||||
`:severity SEVERITY'
|
||||
A number denoting the severity of this level. The higher
|
||||
the number, the more severe is this level compared to other
|
||||
levels. Defaults to 0.
|
||||
|
||||
The severity is used by `flycheck-error-level-<' to
|
||||
determine the ordering of errors according to their levels.
|
||||
|
||||
`:compilation-level LEVEL'
|
||||
|
||||
A number indicating the broad class of messages that errors
|
||||
at this level belong to: one of 0 (info), 1 (warning), or
|
||||
2 or nil (error). Defaults to nil.
|
||||
|
||||
This is used by `flycheck-checker-pattern-to-error-regexp'
|
||||
to map error levels into `compilation-mode''s hierarchy and
|
||||
to get proper highlighting of errors in `compilation-mode'.
|
||||
|
||||
`:overlay-category CATEGORY'
|
||||
A symbol denoting the overlay category to use for error
|
||||
highlight overlays for this level. See Info
|
||||
node `(elisp)Overlay Properties' for more information about
|
||||
overlay categories.
|
||||
|
||||
A category for an error level overlay should at least define
|
||||
the `face' property, for error highlighting. Another useful
|
||||
property for error level categories is `priority', to
|
||||
influence the stacking of multiple error level overlays.
|
||||
|
||||
`:fringe-bitmap BITMAP'
|
||||
A fringe bitmap symbol denoting the bitmap to use for fringe
|
||||
indicators for this level. See Info node `(elisp)Fringe
|
||||
Bitmaps' for more information about fringe bitmaps,
|
||||
including a list of built-in fringe bitmaps.
|
||||
|
||||
`:fringe-face FACE'
|
||||
A face symbol denoting the face to use for fringe indicators
|
||||
for this level.
|
||||
|
||||
`:error-list-face FACE'
|
||||
A face symbol denoting the face to use for messages of this
|
||||
level in the error list. See `flycheck-list-errors'.
|
||||
|
||||
\(fn LEVEL &rest PROPERTIES)" nil nil)
|
||||
|
||||
(function-put 'flycheck-define-error-level 'lisp-indent-function '1)
|
||||
|
||||
(autoload 'flycheck-define-command-checker "flycheck" "\
|
||||
Define SYMBOL as syntax checker to run a command.
|
||||
|
||||
Define SYMBOL as generic syntax checker via
|
||||
`flycheck-define-generic-checker', which uses an external command
|
||||
to check the buffer. SYMBOL and DOCSTRING are the same as for
|
||||
`flycheck-define-generic-checker'.
|
||||
|
||||
In addition to the properties understood by
|
||||
`flycheck-define-generic-checker', the following PROPERTIES
|
||||
constitute a command syntax checker. Unless otherwise noted, all
|
||||
properties are mandatory. Note that the default `:error-filter'
|
||||
of command checkers is `flycheck-sanitize-errors'.
|
||||
|
||||
`:command COMMAND'
|
||||
The command to run for syntax checking.
|
||||
|
||||
COMMAND is a list of the form `(EXECUTABLE [ARG ...])'.
|
||||
|
||||
EXECUTABLE is a string with the executable of this syntax
|
||||
checker. It can be overridden with the variable
|
||||
`flycheck-SYMBOL-executable'. Note that this variable is
|
||||
NOT implicitly defined by this function. Use
|
||||
`flycheck-def-executable-var' to define this variable.
|
||||
|
||||
Each ARG is an argument to the executable, either as string,
|
||||
or as special symbol or form for
|
||||
`flycheck-substitute-argument', which see.
|
||||
|
||||
`:error-patterns PATTERNS'
|
||||
A list of patterns to parse the output of the `:command'.
|
||||
|
||||
Each ITEM in PATTERNS is a list `(LEVEL SEXP ...)', where
|
||||
LEVEL is a Flycheck error level (see
|
||||
`flycheck-define-error-level'), followed by one or more RX
|
||||
`SEXP's which parse an error of that level and extract line,
|
||||
column, file name and the message.
|
||||
|
||||
See `rx' for general information about RX, and
|
||||
`flycheck-rx-to-string' for some special RX forms provided
|
||||
by Flycheck.
|
||||
|
||||
All patterns are applied in the order of declaration to the
|
||||
whole output of the syntax checker. Output already matched
|
||||
by a pattern will not be matched by subsequent patterns. In
|
||||
other words, the first pattern wins.
|
||||
|
||||
This property is optional. If omitted, however, an
|
||||
`:error-parser' is mandatory.
|
||||
|
||||
`:error-parser FUNCTION'
|
||||
A function to parse errors with.
|
||||
|
||||
The function shall accept three arguments OUTPUT CHECKER
|
||||
BUFFER. OUTPUT is the syntax checker output as string,
|
||||
CHECKER the syntax checker that was used, and BUFFER a
|
||||
buffer object representing the checked buffer. The function
|
||||
must return a list of `flycheck-error' objects parsed from
|
||||
OUTPUT.
|
||||
|
||||
This property is optional. If omitted, it defaults to
|
||||
`flycheck-parse-with-patterns'. In this case,
|
||||
`:error-patterns' is mandatory.
|
||||
|
||||
`:standard-input t'
|
||||
Whether to send the buffer contents on standard input.
|
||||
|
||||
If this property is given and has a non-nil value, send the
|
||||
contents of the buffer on standard input.
|
||||
|
||||
Defaults to nil.
|
||||
|
||||
Note that you may not give `:start', `:interrupt', and
|
||||
`:print-doc' for a command checker. You can give a custom
|
||||
`:verify' function, though, whose results will be appended to the
|
||||
default `:verify' function of command checkers.
|
||||
|
||||
\(fn SYMBOL DOCSTRING &rest PROPERTIES)" nil nil)
|
||||
|
||||
(function-put 'flycheck-define-command-checker 'lisp-indent-function '1)
|
||||
|
||||
(function-put 'flycheck-define-command-checker 'doc-string-elt '2)
|
||||
|
||||
(autoload 'flycheck-def-config-file-var "flycheck" "\
|
||||
Define SYMBOL as config file variable for CHECKER, with default FILE-NAME.
|
||||
|
||||
SYMBOL is declared as customizable variable using `defcustom', to
|
||||
provide a configuration file for the given syntax CHECKER.
|
||||
CUSTOM-ARGS are forwarded to `defcustom'.
|
||||
|
||||
FILE-NAME is the initial value of the new variable. If omitted,
|
||||
the default value is nil.
|
||||
|
||||
Use this together with the `config-file' form in the `:command'
|
||||
argument to `flycheck-define-checker'.
|
||||
|
||||
\(fn SYMBOL CHECKER &optional FILE-NAME &rest CUSTOM-ARGS)" nil t)
|
||||
|
||||
(function-put 'flycheck-def-config-file-var 'lisp-indent-function '3)
|
||||
|
||||
(autoload 'flycheck-def-option-var "flycheck" "\
|
||||
Define SYMBOL as option variable with INIT-VALUE for CHECKER.
|
||||
|
||||
SYMBOL is declared as customizable variable using `defcustom', to
|
||||
provide an option for the given syntax CHECKERS (a checker or a
|
||||
list of checkers). INIT-VALUE is the initial value of the
|
||||
variable, and DOCSTRING is its docstring. CUSTOM-ARGS are
|
||||
forwarded to `defcustom'.
|
||||
|
||||
Use this together with the `option', `option-list' and
|
||||
`option-flag' forms in the `:command' argument to
|
||||
`flycheck-define-checker'.
|
||||
|
||||
\(fn SYMBOL INIT-VALUE CHECKERS DOCSTRING &rest CUSTOM-ARGS)" nil t)
|
||||
|
||||
(function-put 'flycheck-def-option-var 'lisp-indent-function '3)
|
||||
|
||||
(function-put 'flycheck-def-option-var 'doc-string-elt '4)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("flycheck-buttercup.el" "flycheck-ert.el"
|
||||
;;;;;; "flycheck-pkg.el") (22541 41885 968061 448000))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; End:
|
||||
;;; flycheck-autoloads.el ends here
|
||||
@@ -1,144 +0,0 @@
|
||||
;;; flycheck-buttercup.el --- Flycheck: Extensions to Buttercup -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2016 Sebastian Wiesner and Flycheck contributors
|
||||
|
||||
;; Author: Sebastian Wiesner <swiesner@lunaryorn.com>
|
||||
;; Keywords: lisp, tools
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Extensions to Buttercup to write BDD tests for Flycheck.
|
||||
;;
|
||||
;; Buttercup is a BDD testing framework for Emacs, see URL
|
||||
;; `https://github.com/jorgenschaefer/emacs-buttercup/'. Flycheck uses
|
||||
;; Buttercup extensively for new tests.
|
||||
;;
|
||||
;; This library provides extensions to Buttercup to write Specs for Flycheck.
|
||||
;;
|
||||
;; * Custom matchers
|
||||
;;
|
||||
;; (expect 'foo :to-be-local) - Is `foo' a local variable in the current buffer?
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'buttercup)
|
||||
(require 'flycheck)
|
||||
(require 'seq)
|
||||
|
||||
|
||||
;;; Buttercup helpers
|
||||
|
||||
(defun flycheck-buttercup-format-error-list (errors)
|
||||
"Format ERRORS into a human-readable string."
|
||||
(mapconcat (lambda (e) (flycheck-error-format e 'with-file-name))
|
||||
errors "\n"))
|
||||
|
||||
|
||||
;;; Data matchers
|
||||
|
||||
(buttercup-define-matcher :to-be-empty-string (s)
|
||||
(if (equal s "")
|
||||
(cons t (format "Expected %S not be an empty string" s))
|
||||
(cons nil (format "Expected %S to be an empty string" s))))
|
||||
|
||||
(buttercup-define-matcher :to-match-with-group (re s index match)
|
||||
(let* ((matches? (string-match re s))
|
||||
(result (and matches? (match-string index s))))
|
||||
(if (and matches? (equal result match))
|
||||
(cons t (format "Expected %S not to match %S with %S in group %s"
|
||||
re s match index))
|
||||
|
||||
(cons nil (format "Expected %S to match %S with %S in group %s, %s"
|
||||
re s match index
|
||||
(if matches?
|
||||
(format "but got %S" result)
|
||||
"but did not match"))))))
|
||||
|
||||
|
||||
;;; Emacs feature matchers
|
||||
|
||||
(buttercup-define-matcher :to-be-live (buffer)
|
||||
(let ((buffer (get-buffer buffer)))
|
||||
(if (buffer-live-p buffer)
|
||||
(cons t (format "Expected %S not to be a live buffer, but it is"
|
||||
buffer))
|
||||
(cons nil (format "Expected %S to be a live buffer, but it is not"
|
||||
buffer)))))
|
||||
|
||||
(buttercup-define-matcher :to-be-visible (buffer)
|
||||
(let ((buffer (get-buffer buffer)))
|
||||
(cond
|
||||
((and buffer (get-buffer-window buffer))
|
||||
(cons t (format "Expected %S not to be a visible buffer, but it is"
|
||||
buffer)))
|
||||
((not (bufferp buffer))
|
||||
(cons nil
|
||||
(format "Expected %S to be a visible buffer, but it is not a buffer"
|
||||
buffer)))
|
||||
(t (cons
|
||||
nil
|
||||
(format "Expected %S to be a visible buffer, but it is not visible"
|
||||
buffer))))))
|
||||
|
||||
(buttercup-define-matcher :to-be-local (symbol)
|
||||
(if (local-variable-p symbol)
|
||||
(cons t (format "Expected %S not to be a local variable, but it is"
|
||||
symbol))
|
||||
(cons nil (format "Expected %S to be a local variable, but it is not"
|
||||
symbol))))
|
||||
|
||||
(buttercup-define-matcher :to-contain-match (buffer re)
|
||||
(if (not (get-buffer buffer))
|
||||
(cons nil (format "Expected %S to contain a match of %s, \
|
||||
but is not a buffer" buffer re))
|
||||
(with-current-buffer buffer
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward re nil 'noerror)
|
||||
(cons t (format "Expected %S to contain a match \
|
||||
for %s, but it did not" buffer re))
|
||||
(cons nil (format "Expected %S not to contain a match for \
|
||||
%s but it did not." buffer re)))))))
|
||||
|
||||
|
||||
;;; Flycheck matchers
|
||||
|
||||
(buttercup-define-matcher :to-be-equal-flycheck-errors (a b)
|
||||
(let ((a-formatted (flycheck-buttercup-format-error-list a))
|
||||
(b-formatted (flycheck-buttercup-format-error-list b)))
|
||||
(if (equal a b)
|
||||
(cons t (format "Expected
|
||||
%s
|
||||
not to be equal to
|
||||
%s" a-formatted b-formatted))
|
||||
(cons nil (format "Expected
|
||||
%s
|
||||
to be equal to
|
||||
%s" a-formatted b-formatted)))))
|
||||
|
||||
(provide 'flycheck-buttercup)
|
||||
|
||||
;; Disable byte compilation for this library, to prevent package.el choking on a
|
||||
;; missing `buttercup' library. See
|
||||
;; https://github.com/flycheck/flycheck/issues/860
|
||||
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
|
||||
;;; flycheck-buttercup.el ends here
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user