Remove the elpa/ directory from version control

All my packages are now installed via `use-package`.
This commit is contained in:
Gergely Polonkai 2016-10-24 12:49:15 +02:00
parent cba24cbf20
commit 3b2cf68142
1773 changed files with 2 additions and 356540 deletions

2
.gitignore vendored
View File

@ -15,6 +15,8 @@
/url/ /url/
/hgs-cache /hgs-cache
/smex-items /smex-items
# All hail use-package!
/elpa/
# History-related files. Its a real pain merging them together # History-related files. Its a real pain merging them together
/history /history

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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.
;;
;; Thats 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:

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -1 +0,0 @@
(define-package "electric-case" "20150417.412" "insert camelCase, snake_case words without \"Shift\"ing" 'nil :url "http://hins11.yu-yake.com/")

View File

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

View File

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

View File

@ -1 +0,0 @@
(define-package "electric-spacing" "20151209.736" "Insert operators with surrounding spaces smartly" 'nil)

View File

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

View File

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

View File

@ -1 +0,0 @@
(define-package "emamux" "20160602.653" "Interact with tmux" '((emacs "24") (cl-lib "0.5")) :url "https://github.com/syohex/emacs-emamux")

View File

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

View File

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

View File

@ -1 +0,0 @@
(define-package "epl" "20150517.433" "Emacs Package Library" '((cl-lib "0.3")) :url "http://github.com/cask/epl" :keywords '("convenience"))

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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