Initial version

This commit is contained in:
Gergely Polonkai 2014-10-05 14:57:41 +02:00
commit ef4409f2a2
91 changed files with 28061 additions and 0 deletions

5
.gitignore vendored Normal file
View File

@ -0,0 +1,5 @@
*~
/session*
/tramp
*.elc
/elpa/archives/

15
.gitmodules vendored Normal file
View File

@ -0,0 +1,15 @@
[submodule "nyan-mode"]
path = nyan-mode
url = git://github.com/TeMPOraL/nyan-mode.git
[submodule "helm"]
path = helm
url = git://github.com/emacs-helm/helm.git
[submodule "emacs-async"]
path = emacs-async
url = git://github.com/jwiegley/emacs-async.git
[submodule "gobgen"]
path = gobgen
url = git://github.com/gergelypolonkai/gobgen.el.git
[submodule "emacs-helm-gtags"]
path = emacs-helm-gtags
url = git://github.com/syohex/emacs-helm-gtags.git

View File

@ -0,0 +1,129 @@
;;; ag-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (ag-kill-other-buffers ag-kill-buffers ag-project-dired-regexp
;;;;;; ag-project-dired ag-dired-regexp ag-dired ag-project-regexp
;;;;;; ag-project-files ag-project ag-regexp ag-files ag) "ag" "ag.el"
;;;;;; (21529 49183 36687 867000))
;;; Generated autoloads from ag.el
(autoload 'ag "ag" "\
Search using ag in a given DIRECTORY for a given 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 and file type regex FILE-REGEX
for a given search STRING, with STRING defaulting to the symbol under point.
If called with a prefix, prompts for flags to pass to ag.
\(fn STRING FILE-REGEX 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 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 in a given DIRECTORY and file type regex FILE-REGEX
for a given search STRING, with STRING defaulting to the symbol under point.
If called with a prefix, prompts for flags to pass to ag.
\(fn STRING FILE-REGEX)" 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 PATTERN.
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 PATTERN)" 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)
;;;***
;;;### (autoloads nil nil ("ag-pkg.el") (21529 49183 172114 552000))
;;;***
(provide 'ag-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; ag-autoloads.el ends here

1
elpa/ag-0.42/ag-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "ag" "0.42" "A front-end for ag ('the silver searcher'), the C ack replacement." (quote nil))

484
elpa/ag-0.42/ag.el Normal file
View File

@ -0,0 +1,484 @@
;;; 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.42
;;; 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:
(eval-when-compile (require 'cl)) ;; dolist, defun*, flet
(require 'dired) ;; dired-sort-inhibit
(defcustom ag-executable
"ag"
"Name of the ag executable to use."
:type 'string
:group 'ag)
(defcustom ag-arguments
(list "--smart-case" "--nogroup" "--column" "--")
"Default arguments passed to ag."
:type '(repeat (string))
: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)
(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)
(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-open-in-other-window'."
(if ag-reuse-window
;; prevent changing the window
(flet ((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)))
(define-compilation-mode ag-mode "Ag"
"Ag results compilation mode"
(let ((smbl 'compilation-ag-nogroup)
;; 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.
(pttrn '("^\\([^:\n]+?\\):\\([1-9][0-9]*\\):\\([1-9][0-9]*\\):" 1 2 3)))
(set (make-local-variable 'compilation-error-regexp-alist) (list smbl))
(set (make-local-variable 'compilation-error-regexp-alist-alist) (list (cons smbl pttrn))))
(set (make-local-variable 'compilation-error-face) 'ag-hit-face)
(set (make-local-variable 'next-error-function) 'ag/next-error-function)
(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)
(defun ag/buffer-name (search-string directory regexp)
(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/search (string directory
&key (regexp nil) (file-regex 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"))
(unless regexp
(setq arguments (cons "--literal" arguments)))
(if ag-highlight-search
(setq arguments (append '("--color" "--color-match" "30;43") arguments))
(setq arguments (append '("--nocolor") arguments)))
(when (char-or-string-p file-regex)
(setq arguments (append `("--file-search-regex" ,file-regex) 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 "."))
" ")))
(when current-prefix-arg
(setq command-string (read-from-minibuffer "ag command: " command-string)))
(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" (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))
(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")
(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))
file-path)))
(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 "^")
(forward-line 1))
(while (looking-at "^")
(insert " ")
(forward-line 1))
(goto-char beg)
(beginning-of-line)
;; Remove occurrences of default-directory.
(while (search-forward 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)))
(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 search STRING,
with STRING defaulting to the symbol under point.
If called with a prefix, prompts for flags to pass to ag."
(interactive (list (read-from-minibuffer "Search string: " (ag/dwim-at-point))
(read-directory-name "Directory: ")))
(ag/search string directory))
;;;###autoload
(defun ag-files (string file-regex directory)
"Search using ag in a given DIRECTORY and file type regex FILE-REGEX
for a given search STRING, with STRING defaulting to the symbol under point.
If called with a prefix, prompts for flags to pass to ag."
(interactive (list (read-from-minibuffer "Search string: " (ag/dwim-at-point))
(read-from-minibuffer "In filenames matching PCRE: " (ag/buffer-extension-regex))
(read-directory-name "Directory: ")))
(ag/search string directory :file-regex file-regex))
;;;###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 string.
If called with a prefix, prompts for flags to pass to ag."
(interactive (list (read-from-minibuffer "Search string: " (ag/dwim-at-point))))
(ag/search string (ag/project-root default-directory)))
;;;###autoload
(defun ag-project-files (string file-regex)
"Search using ag in a given DIRECTORY and file type regex FILE-REGEX
for a given search STRING, with STRING defaulting to the symbol under point.
If called with a prefix, prompts for flags to pass to ag."
(interactive (list (read-from-minibuffer "Search string: " (ag/dwim-at-point))
(read-from-minibuffer "In filenames matching PCRE: " (ag/buffer-extension-regex))))
(ag/search string (ag/project-root default-directory) :file-regex file-regex))
;;;###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 (read-from-minibuffer "Search regexp: "
(ag/escape-pcre (ag/dwim-at-point)))))
(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) ; TODO: mark as obsolete
;;;###autoload
(defun ag-dired (dir pattern)
"Recursively find files in DIR matching PATTERN.
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 pattern)))
;;;###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 --nocolor -g '" regexp "' " dir " | grep -v '^$' | 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)
(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 ,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)))))
;; Taken from grep-filter, just changed the color regex.
(defun ag-filter ()
"Handle match highlighting escape sequences inserted by the ag process.
This function is called from `compilation-filter-hook'."
(when ag-highlight-search
(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))
;; Highlight ag matches and delete marking sequences.
(while (re-search-forward "\033\\[30;43m\\(.*?\\)\033\\[[0-9]*m" end 1)
(replace-match (propertize (match-string 1)
'face nil 'font-lock-face 'ag-match-face)
t t))
;; Delete all remaining escape sequences
(goto-char beg)
(while (re-search-forward "\033\\[[0-9;]*[mK]" end 1)
(replace-match "" t t)))))))
(provide 'ag)
;;; ag.el ends here

View File

@ -0,0 +1,4 @@
((nil . ((indent-tabs-mode . nil)
(fill-column . 80)
(sentence-end-double-space . t)
(emacs-lisp-docstring-fill-column . 75))))

2
elpa/company-0.8.2/.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
*.elc
ert.el

View File

@ -0,0 +1,26 @@
# https://github.com/rolandwalker/emacs-travis
language: emacs-lisp
env:
matrix:
- EMACS=emacs24
- EMACS=emacs-snapshot
install:
- if [ "$EMACS" = "emacs24" ]; then
sudo add-apt-repository -y ppa:cassou/emacs &&
sudo apt-get update -qq &&
sudo apt-get install -qq emacs24 emacs24-el;
fi
- if [ "$EMACS" = "emacs-snapshot" ]; then
sudo add-apt-repository -y ppa:ubuntu-elisp/ppa &&
sudo apt-get update -qq &&
sudo apt-get install -qq emacs-snapshot;
fi
before_script:
make downloads
script:
make test-batch EMACS=${EMACS}

View File

@ -0,0 +1,255 @@
2014-07-26 Dmitry Gutov <dgutov@yandex.ru>
Merge commit 'b1d019a4c815ac8bdc240d69eaa74eb4e34640e8' from
company-master
2014-07-01 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '7c14dedc79bf0c6eaad5bf50b80ea80dd721afdc' from company
Conflicts:
packages/company/company-pysmell.el
2014-06-14 Stefan Monnier <monnier@iro.umontreal.ca>
* company/company-capf.el: Don't ignore things like semantic-capf.
2014-04-19 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '51c140ca9ee32d27cacc7b2b07d4539bf98ae575' from
company-master
Conflicts:
packages/company/company-pysmell.el
2014-03-25 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '4a7995ff69b25990dc520ed9e466dfbcdb7eafc8' from company
2014-03-19 Dmitry Gutov <dgutov@yandex.ru>
Merge commit 'fec7c0b4a8651160c5d759cc6703b2c45852d5bb'
2014-03-18 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '7be4321260f0c73ef4c3cadc646f6bb496650253' from company
2014-02-18 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '119822078ee3024c2d27017d45ef4578fa36040f' from company
2014-02-03 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '67ab56a5469f16652e73667ec3b4f76ff6befee6' from company
2014-01-25 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '8dc8f9525714db66f659a2a51322345068764bd3' from company
Conflicts:
packages/company/company-capf.el
2014-01-24 Stefan Monnier <monnier@iro.umontreal.ca>
* company-capf.el (company--capf-data): Don't get confused by lambda
exps.
2014-01-20 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '2badcc6227a88e1aba288f442af5f4e1ce55d366' from company
2014-01-15 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '8b4d7da0d6aa1e24379fe5ace5bd2705352ea07e' from company
2014-01-14 Dmitry Gutov <dgutov@yandex.ru>
Merge commit '67a96dbbfe645b64291ed62eab6f1eb391a834e0' from company
Conflicts:
packages/company/company-elisp.el
packages/company/company-oddmuse.el
2014-01-13 Stefan Monnier <monnier@iro.umontreal.ca>
* packages/company/company-etags.el: Require `cl' for `case'.
* packages/company/company-oddmuse.el: Avoid `eval-when' before
requiring `cl'.
* packages/company/company-elisp.el (company-elisp): Simplify.
2013-10-06 Dmitry Gutov <dgutov@yandex.ru>
Sync from company/master
2013-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
* packages/company/company-capf.el (company-capf): Add preliminary
support for doc-buffer, meta, location, and require-match.
2013-08-21 Stefan Monnier <monnier@iro.umontreal.ca>
* packages/company/company-cmake.el: Fix up copyright. Require CL.
* packages/company/company-template.el
(company-template--buffer-templates): Declare before first use.
* packages/company/company-eclim.el (json-array-type): Declare
json-array-type.
(company-eclim--candidates): Remove unused var `project-name'.
2013-08-21 Stefan Monnier <monnier@iro.umontreal.ca>
Sync from company/master
2013-08-14 Stefan Monnier <monnier@iro.umontreal.ca>
Mark merge point of company.
2013-06-27 Stefan Monnier <monnier@iro.umontreal.ca>
* GNUmakefile: Rename from Makefile. Add targets for in-place use.
(all, all-in-place): New targets.
* admin/archive-contents.el (archive--simple-package-p): Ignore
autosave files.
(archive--refresh-pkg-file): New function.
(archive--write-pkg-file): Print with ' and ` shorthands.
* packages/company/company-pysmell.el: Don't require pysmell during
compile.
* packages/muse/htmlize-hack.el: Don't require htmlize during compile.
* packages/shen-mode/shen-mode.el (shen-functions): Define during
compile.
* smart-operator/smart-operator.el (smart-operator-insert-1): Use
pcase.
2013-05-26 Dmitry Gutov <dgutov@yandex.ru>
company: Release 0.6.10
* Plays nicer with `org-indent-mode`.
* Works in horizontally scrolled windows.
Git commit 764d2aa4ba50081adf69408e62d4863905b68b7f
2013-05-10 Dmitry Gutov <dgutov@yandex.ru>
company: Release 0.6.9
* `company-capf` respects `:exit-function` completion property.
* `company-backends`: `prefix` command can return `t` in the cdr.
* `company-clang-begin-after-member-access`: New option.
* Mouse click outside the tooltip aborts completion.
* `company-clang` uses standard input to pass the contents of current
buffer to
Clang 2.9+, otherwise saves the buffer and passes the path to the
file.
* `company-clang-auto-save` option has been removed.
* Better interaction with `outline-minor-mode`.
* `company-dabbrev-code` supports all `prog-mode` derivatives.
Git commit 4c735454d91f9674da0ecea950504888b1e10ff7
2013-04-27 Stefan Monnier <monnier@iro.umontreal.ca>
* company.el (company-capf): Add support for `sorted' and
`post-completion'.
(company--capf-data): New function.
(company-backend): Declare before first use.
(company-require-match-p): Only call company-require-match is needed.
(company--continue-failed): Don't use backward-delete-char
non-interactively.
(company-search-assert-enabled): Demote it, since it comes too late to
be inlined.
(company-begin-with): Use a lexical closure, so the code is
byte-compiled.
(company--replacement-string, company--create-lines)
(company-pseudo-tooltip-edit, company-doc-buffer): Silence the
byte-compiler.
2013-04-16 Dmitry Gutov <dgutov@yandex.ru>
Release 0.6.8
* `company-auto-complete` is disabled by default.
* `company-auto-complete-chars` default value includes fewer syntax
classes.
* In expanded function calls, arguments skipped by the user default to
"argN".
* `company-eclim` and `company-clang` do not strip argument types from
fields.
* `company-clang` expands function calls for all three modes now.
* `company-clang` supports `c++-mode` by default.
Git commit 92ac3d0ef663bca26abbda33cc20a02a58b1c328
2013-04-05 Dmitry Gutov <dgutov@yandex.ru>
company: Release 0.6.7
* Two `company-elisp` tweaks.
Git commit 8dceda389115b397de48becc4b68a64f4dc4bbab
2013-04-01 Dmitry Gutov <dgutov@yandex.ru>
company: Release 0.6.6
## 2013-04-01 (0.6.6)
* `company-elisp` doesn't offer completions when typing the name and
the arguments of a new function or macro definition, allowing to
fall back to other back-ends like `company-dabbrev-code`.
## 2013-03-30 (0.6.5)
* Fixed keybindings when running in a terminal.
* `company-elisp-show-locals-first`: new customizable variable.
* `company-elisp` shows more accurate and comprehensive candidates
list.
## 2013-03-26 (0.6.4)
* `company-eclim` shows valid completions after an opening paren.
* Expanded template does not get removed until the point leaves it.
After your input the last argument in a method call expanded by
`company-eclim`, you can press `<tab>` once more, to jump after the
closing paren. No other bundled back-ends are affected.
## 2013-03-25 (0.6.3)
* New tooltip face colors used on themes with light background.
* Pseudo-tooltip stays up-to-date when text is inserted after the
point.
* Fixed `company-require-match` mechanics.
2013-03-24 Dmitry Gutov <dgutov@yandex.ru>
company: Release 0.6.2
2013-03-23 Dmitry Gutov <dgutov@yandex.ru>
company: Release 0.6.1
2013-03-21 Dmitry Gutov <dgutov@yandex.ru>
company: Remove angle brackets from README
2013-03-19 Dmitry Gutov <dgutov@yandex.ru>
company: Update pkg.el and summary string
2013-03-19 Dmitry Gutov <dgutov@yandex.ru>
company-tests.el: add copyright boilerplate
2013-03-19 Dmitry Gutov <dgutov@yandex.ru>
company-mode: Release 0.6
2011-08-01 Stefan Monnier <monnier@iro.umontreal.ca>
* company/*.el: Fix case misunderstanding. Use checkdoc.
* company/company.el (company-capf): First cut at making Company use
completion-at-point-functions.
2011-06-30 Chong Yidong <cyd@stupidchicken.com>
Remove version numbers in packages/ directory

View File

@ -0,0 +1,37 @@
EMACS=emacs
CURL=curl --silent
ERT_URL=http://git.savannah.gnu.org/cgit/emacs.git/plain/lisp/emacs-lisp/ert.el?h=emacs-24.3
.PHONY: ert test test-batch
package: *.el
@ver=`grep -o "Version: .*" company.el | cut -c 10-`; \
tar cjvf company-$$ver.tar.bz2 --mode 644 `git ls-files '*.el' | xargs`
elpa: *.el
@version=`grep -o "Version: .*" company.el | cut -c 10-`; \
dir=company-$$version; \
mkdir -p "$$dir"; \
cp `git ls-files '*.el' | xargs` company-$$version; \
echo "(define-package \"company\" \"$$version\" \
\"Modular in-buffer completion framework\")" \
> "$$dir"/company-pkg.el; \
tar cvf company-$$version.tar --mode 644 "$$dir"
clean:
@rm -rf company-*/ company-*.tar company-*.tar.bz2 *.elc ert.el
test:
${EMACS} -Q -nw -L . -l company-tests.el -l company-elisp-tests.el \
--eval "(let (pop-up-windows) (ert t))"
test-batch:
${EMACS} -Q --batch -L . -l company-tests.el -l company-elisp-tests.el \
--eval "(ert-run-tests-batch-and-exit '(not (tag interactive)))"
downloads:
${EMACS} -Q --batch -l ert || \
${CURL} ${ERT_URL} > ert.el
compile:
${EMACS} -Q --batch -L . -f batch-byte-compile company.el company-*.el

277
elpa/company-0.8.2/NEWS.md Normal file
View File

@ -0,0 +1,277 @@
# History of user-visible changes
## 2014-07-26 (0.8.2)
* New user option `company-occurrence-weight-function`, allowing to tweak the
behavior of the transformer `company-sort-by-occurrence`.
* Setting `company-idle-delay` to `t` is deprecated. Use the value 0 instead.
## 2014-07-01 (0.8.1)
* `company-require-match` is not in effect when the new input doesn't continue
the previous prefix, and that prefix was a match.
* The meaning of `company-begin-commands` value t has slightly changed.
* New transformer, `company-sort-by-backend-importance`.
* When grouped back-ends are used, the back-end of the current candidate is
indicated in the mode-line, enclosed in angle brackets.
* New user option `company-gtags-insert-arguments`, t by default.
* `company-css` knows about CSS3.
* `company-gtags` supports `meta` and `annotation`.
* User option `company-dabbrev-code-other-buffers` can have a new value: `code`.
* New user option `company-tooltip-flip-when-above`.
* `company-clang` uses the standard header search paths by default.
* `C-h` is bound to `company-show-doc-buffer` (like `f1`).
## 2014-04-19 (0.8.0)
* `company-capf` is included in `company-backends` in any supported Emacs
version (>= 24.1). `company-elisp` goes before it if Emacs version is < 24.4.
* New user option `company-clang-insert-arguments`, by default t.
* Default value of `company-idle-delay` lowered to `0.5`.
* New user option `company-tooltip-minimum-width`, by default 0.
* New function `company-grab-symbol-cons`.
* `company-clang` fetches completion candidates asynchronously.
* Added support for asynchronous back-ends (experimental).
* Support for back-end command `crop` dropped (it was never documented).
* Support for Emacs 23 dropped.
* New user option `company-abort-manual-when-too-short`.
## 2014-03-25 (0.7.3)
* New user option `company-etags-ignore-case`.
## 2014-03-19 (0.7.2)
* Support for Emacs 22 officially dropped.
* `company-clang` supports `indent-tabs-mode` and multibyte chars before point.
## 2014-03-18 (0.7.1)
* Group of back-ends can now contain keyword `:with`, which makes all back-ends
after it to be skipped for prefix calculation.
* New function `company-version`.
* New bundled back-end `company-yasnippet`.
* Completion candidates returned from grouped back-ends are tagged to remember
which back-end each came from.
* New user option `company-tooltip-align-annotations`, off by default.
* New bundled back-end `company-bbdb`.
## 2014-02-18 (0.7)
* New back-end command, `match`, for non-prefix completion.
* New user option `company-continue-commands`. The default value aborts
completion on buffer saving commands.
* New back-end command, `annotation`, for text displayed inline in the popup
that's not a part of completion candidate.
* `company-capf`, `company-clang` and `company-eclim` use `annotation`.
* `company-preview*` faces inherit from `company-tooltip-selection` and
`company-tooltip-common-selection` on light themes.
* New user option `company-transformers`.
* First transformer, `company-sort-by-occurrence`.
* New user options controlling `company-dabbrev` and `company-dabbrev-code`.
## 2014-01-25 (0.6.14)
* The tooltip front-end is rendered with scrollbar, controlled by the user
option `company-tooltip-offset-display`.
* The tooltip front-end is rendered with margins, controlled by the user option
`company-tooltip-margin`.
## 2014-01-14 (0.6.13)
* Experimental support for non-prefix completion.
* Starting with Emacs version 24.4, `company-capf` is included in
`company-backends` and replaces `company-elisp`.
* `company-capf` supports completion tables that return non-default boundaries.
* `company-elisp` is enabled in `inferior-emacs-lisp-mode`.
## 2013-09-28 (0.6.12)
* Default value of `company-begin-commands` changed to `(self-insert-command)`.
* Futher improvement in `org-indent-mode` compatibility.
## 2013-08-18 (0.6.11)
* `company-template-c-like-templatify` removes all text after closing paren, for
use in backends that display additional info there.
* `company-cmake` is now bundled.
* Better `linum` compatibility in Emacs <= 24.2.
* `company-global-modes`: New option.
## 2013-05-26 (0.6.10)
* Plays nicer with `org-indent-mode`.
* Works in horizontally scrolled windows.
## 2013-05-10 (0.6.9)
* `company-capf` respects `:exit-function` completion property.
* `company-backends`: `prefix` command can return `t` in the cdr.
* `company-clang-begin-after-member-access`: New option.
* Mouse click outside the tooltip aborts completion.
* `company-clang` uses standard input to pass the contents of current buffer to
Clang 2.9+, otherwise saves the buffer and passes the path to the file.
* `company-clang-auto-save` option has been removed.
* Better interaction with `outline-minor-mode`.
* `company-dabbrev-code` supports all `prog-mode` derivatives.
## 2013-04-16 (0.6.8)
* `company-auto-complete` is disabled by default.
* `company-auto-complete-chars` default value includes fewer syntax classes.
* In expanded function calls, arguments skipped by the user default to "argN".
* `company-eclim` and `company-clang` do not strip argument types from fields.
* `company-clang` expands function calls for all three modes now.
* `company-clang` supports `c++-mode` by default.
## 2013-04-05 (0.6.7)
* Two `company-elisp` tweaks.
## 2013-04-01 (0.6.6)
* `company-elisp` doesn't offer completions when typing the name and the
arguments of a new function or macro definition, allowing to fall back to
other back-ends like `company-dabbrev-code`.
## 2013-03-30 (0.6.5)
* Fixed keybindings when running in a terminal.
* `company-elisp-show-locals-first`: new customizable variable.
* `company-elisp` shows more accurate and comprehensive candidates list.
## 2013-03-26 (0.6.4)
* `company-eclim` shows valid completions after an opening paren.
* Expanded template does not get removed until the point leaves it. After your
input the last argument in a method call expanded by `company-eclim`, you can
press `<tab>` once more, to jump after the closing paren. No other bundled
back-ends are affected.
## 2013-03-25 (0.6.3)
* New tooltip face colors used on themes with light background.
* Pseudo-tooltip stays up-to-date when text is inserted after the point.
* Fixed `company-require-match` mechanics.
## 2013-03-24 (0.6.2)
* `global-company-mode` is now autoloaded.
## 2013-03-23 (0.6.1)
* Documented `init` and `post-completion` back-end commands.
* `company-eclim` and `company-clang` only expand the template on explicit user
action (such as `company-complete-{selection,number,mouse}`).
* `company-template` has some breaking changes. When point is at one of the
fields, it's displayed at the beginning, not right after it; `<tab>` jumps to
the next field, `forward-word` and `subword-forward` remappings are removed;
when you jump to the next field, if the current one hasn't been edited, the
overlay gets removed but the text remains.
* `company-eclim` shows method overloads and expands templates for calls.
* `company-clang-objc-templatify` does not insert spaces after colons anymore.
* `company-clang` is now only initialized in supported buffers.
So, no error messages if you don't have Clang until you open a C file.
* `company-clang` recognizes Clang included in recent Xcode.
* New commands `company-select-previous-or-abort` and
`company-select-next-or-abort`, bound to `<up>` and `<down>`.
## 2013-03-19 (0.6)
* Across-the-board bugfixing.
* `company-pysmell` is not used by default anymore.
* Loading of `nxml`, `semantic`, `pymacs` and `ropemacs` is now deferred.
* Candidates from grouped back-ends are merged more conservatively: only
back-ends that return the same prefix at point are used.
* `company-clang` now shows meta information, too.
* Some performance improvements.
* Fixed two old tooltip annoyances.
* Instead of `overrriding-terminal-local-map`, we're now using
`emulation-mode-map-alists` (experimental). This largely means that when the
completion keymap is active, other minor modes' keymaps are still used, so,
for example, it's not as easy to accidentally circumvent `paredit-mode`
when it's enabled.
* `company-elisp` has seen some improvements.
* Added `company-capf`: completion adapter using
`completion-at-point-functions`. (Stefan Monnier)
* Clang completions now include macros and are case-sensitive.
* Switching between tag files now works correctly with `company-etags`.
## 2010-02-24 (0.5)
* `company-ropemacs` now provides location and docs. (Fernando H. Silva)
* Added `company-with-candidate-inserted` macro.
* Added `company-clang` back-end.
* Added new mechanism for non-consecutive insertion.
(So far only used by clang for ObjC.)
* The semantic back-end now shows meta information for local symbols.
* Added compatibility for CEDET in Emacs 23.2 and from CVS. (Oleg Andreev)
## 2009-05-07 (0.4.3)
* Added `company-other-backend`.
* Idle completion no longer interrupts multi-key command input.
* Added `company-ropemacs` and `company-pysmell` back-ends.
## 2009-04-25 (0.4.2)
* In C modes . and -> now count towards `company-minimum-prefix-length`.
* Reverted default front-end back to `company-preview-if-just-one-frontend`.
* The pseudo tooltip will no longer be clipped at the right window edge.
* Added `company-tooltip-minimum`.
* Windows compatibility fixes.
## 2009-04-19 (0.4.1)
* Added `global-company-mode`.
* Performance enhancements.
* Added `company-eclim` back-end.
* Added safer workaround for Emacs `posn-col-row` bug.
## 2009-04-18 (0.4)
* Automatic completion is now aborted if the prefix gets too short.
* Added option `company-dabbrev-time-limit`.
* `company-backends` now supports merging back-ends.
* Added back-end `company-dabbrev-code` for generic code.
* Fixed `company-begin-with`.
## 2009-04-15 (0.3.1)
* Added 'stop prefix to prevent dabbrev from completing inside of symbols.
* Fixed issues with tabbar-mode and line-spacing.
* Performance enhancements.
## 2009-04-12 (0.3)
* Added `company-begin-commands` option.
* Added abbrev, tempo and Xcode back-ends.
* Back-ends are now interactive. You can start them with M-x backend-name.
* Added `company-begin-with` for starting company from elisp-code.
* Added hooks.
* Added `company-require-match` and `company-auto-complete` options.
## 2009-04-05 (0.2.1)
* Improved Emacs Lisp back-end behavior for local variables.
* Added `company-elisp-detect-function-context` option.
* The mouse can now be used for selection.
## 2009-03-22 (0.2)
* Added `company-show-location`.
* Added etags back-end.
* Added work-around for end-of-buffer bug.
* Added `company-filter-candidates`.
* More local Lisp variables are now included in the candidates.
## 2009-03-21 (0.1.5)
* Fixed elisp documentation buffer always showing the same doc.
* Added `company-echo-strip-common-frontend`.
* Added `company-show-numbers` option and M-0 ... M-9 default bindings.
* Don't hide the echo message if it isn't shown.
## 2009-03-20 (0.1)
* Initial release.

View File

@ -0,0 +1,4 @@
See the [homepage](http://company-mode.github.com/).
[![githalytics.com alpha](https://cruel-carlota.pagodabox.com/336ef4be2595a7859d52e2c17b7da2b2 "githalytics.com")](http://githalytics.com/company-mode/company-mode)
[![Build Status](https://travis-ci.org/company-mode/company-mode.png?branch=master)](https://travis-ci.org/company-mode/company-mode)

View File

@ -0,0 +1,51 @@
;;; company-abbrev.el --- company-mode completion back-end for abbrev
;; Copyright (C) 2009-2011 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 back-end 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))
(require-match t)))
(provide 'company-abbrev)
;;; company-abbrev.el ends here

View File

@ -0,0 +1,295 @@
;;; company-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (global-company-mode company-mode) "company" "company.el"
;;;;;; (21475 23817 56009 901000))
;;; 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 back-end, call
it interactively or use `company-begin-backend'.
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)
;;;***
;;;### (autoloads (company-abbrev) "company-abbrev" "company-abbrev.el"
;;;;;; (21475 23816 615018 715000))
;;; Generated autoloads from company-abbrev.el
(autoload 'company-abbrev "company-abbrev" "\
`company-mode' completion back-end for abbrev.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-bbdb) "company-bbdb" "company-bbdb.el"
;;;;;; (21475 23817 97009 82000))
;;; Generated autoloads from company-bbdb.el
(autoload 'company-bbdb "company-bbdb" "\
`company-mode' completion back-end for `bbdb'.
\(fn COMMAND &optional ARG &rest IGNORE)" t nil)
;;;***
;;;### (autoloads (company-css) "company-css" "company-css.el" (21475
;;;;;; 23816 641018 195000))
;;; Generated autoloads from company-css.el
(autoload 'company-css "company-css" "\
`company-mode' completion back-end for `css-mode'.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-dabbrev) "company-dabbrev" "company-dabbrev.el"
;;;;;; (21475 23816 683017 356000))
;;; Generated autoloads from company-dabbrev.el
(autoload 'company-dabbrev "company-dabbrev" "\
dabbrev-like `company-mode' completion back-end.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-dabbrev-code) "company-dabbrev-code" "company-dabbrev-code.el"
;;;;;; (21475 23817 330004 425000))
;;; Generated autoloads from company-dabbrev-code.el
(autoload 'company-dabbrev-code "company-dabbrev-code" "\
dabbrev-like `company-mode' back-end for code.
The back-end looks for all symbols in the current buffer that aren't in
comments or strings.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-elisp) "company-elisp" "company-elisp.el"
;;;;;; (21475 23816 807014 878000))
;;; Generated autoloads from company-elisp.el
(autoload 'company-elisp "company-elisp" "\
`company-mode' completion back-end for Emacs Lisp.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-etags) "company-etags" "company-etags.el"
;;;;;; (21475 23816 392023 172000))
;;; Generated autoloads from company-etags.el
(autoload 'company-etags "company-etags" "\
`company-mode' completion back-end for etags.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-files) "company-files" "company-files.el"
;;;;;; (21475 23816 847014 78000))
;;; Generated autoloads from company-files.el
(autoload 'company-files "company-files" "\
`company-mode' completion back-end existing file names.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-gtags) "company-gtags" "company-gtags.el"
;;;;;; (21475 23817 379003 447000))
;;; Generated autoloads from company-gtags.el
(autoload 'company-gtags "company-gtags" "\
`company-mode' completion back-end for GNU Global.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-ispell) "company-ispell" "company-ispell.el"
;;;;;; (21475 23816 351023 991000))
;;; Generated autoloads from company-ispell.el
(autoload 'company-ispell "company-ispell" "\
`company-mode' completion back-end using Ispell.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-keywords) "company-keywords" "company-keywords.el"
;;;;;; (21475 23816 426022 492000))
;;; Generated autoloads from company-keywords.el
(autoload 'company-keywords "company-keywords" "\
`company-mode' back-end for programming language keywords.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-nxml) "company-nxml" "company-nxml.el"
;;;;;; (21475 23816 467021 673000))
;;; Generated autoloads from company-nxml.el
(autoload 'company-nxml "company-nxml" "\
`company-mode' completion back-end for `nxml-mode'.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-oddmuse) "company-oddmuse" "company-oddmuse.el"
;;;;;; (21475 23816 881013 399000))
;;; Generated autoloads from company-oddmuse.el
(autoload 'company-oddmuse "company-oddmuse" "\
`company-mode' completion back-end for `oddmuse-mode'.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-pysmell) "company-pysmell" "company-pysmell.el"
;;;;;; (21475 23816 990011 221000))
;;; Generated autoloads from company-pysmell.el
(autoload 'company-pysmell "company-pysmell" "\
`company-mode' completion back-end for pysmell.
This requires pysmell.el and pymacs.el.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-semantic) "company-semantic" "company-semantic.el"
;;;;;; (21475 23817 594999 129000))
;;; Generated autoloads from company-semantic.el
(autoload 'company-semantic "company-semantic" "\
`company-mode' completion back-end using CEDET Semantic.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-tempo) "company-tempo" "company-tempo.el"
;;;;;; (21475 23817 172007 583000))
;;; Generated autoloads from company-tempo.el
(autoload 'company-tempo "company-tempo" "\
`company-mode' completion back-end for tempo.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-xcode) "company-xcode" "company-xcode.el"
;;;;;; (21475 23817 247006 84000))
;;; Generated autoloads from company-xcode.el
(autoload 'company-xcode "company-xcode" "\
`company-mode' completion back-end for Xcode projects.
\(fn COMMAND &optional ARG &rest IGNORED)" t nil)
;;;***
;;;### (autoloads (company-yasnippet) "company-yasnippet" "company-yasnippet.el"
;;;;;; (21475 23817 487001 288000))
;;; Generated autoloads from company-yasnippet.el
(autoload 'company-yasnippet "company-yasnippet" "\
`company-mode' back-end for `yasnippet'.
This back-end should be used with care, because as long as there are
snippets defined for the current major mode, this back-end will always
shadow back-ends that come after it. Recommended usages:
* In a buffer-local value of `company-backends', grouped with a back-end 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 back-ends.
(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-elisp-tests.el" "company-pkg.el"
;;;;;; "company-ropemacs.el" "company-template.el" "company-tests.el")
;;;;;; (21475 23817 679245 801000))
;;;***
(provide 'company-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; company-autoloads.el ends here

View File

@ -0,0 +1,49 @@
;;; company-bbdb.el --- company-mode completion back-end for BBDB in message-mode
;; Copyright (C) 2013-2014 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")
;;;###autoload
(defun company-bbdb (command &optional arg &rest ignore)
"`company-mode' completion back-end for `bbdb'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-bbdb))
(prefix (and (eq major-mode 'message-mode)
(featurep 'bbdb-com)
(looking-back "^\\(To\\|Cc\\|Bcc\\):.*"
(line-beginning-position))
(company-grab-symbol)))
(candidates (cl-mapcan (lambda (record)
(mapcar (lambda (mail) (bbdb-dwim-mail record mail))
(bbdb-record-get-field record 'mail)))
(bbdb-search (bbdb-records) arg nil arg)))
(sorted t)
(no-cache t)))
(provide 'company-bbdb)
;;; company-bbdb.el ends here

View File

@ -0,0 +1,135 @@
;;; company-capf.el --- company-mode completion-at-point-functions back-end -*- lexical-binding: t -*-
;; Copyright (C) 2013-2014 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)
(defun company--capf-data ()
(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)))
(data (run-hook-wrapped 'completion-at-point-functions
;; Ignore misbehaving functions.
#'completion--capf-wrapper 'optimist)))
(when (and (consp (cdr data)) (numberp (nth 1 data))) data)))
(defun company-capf (command &optional arg &rest _args)
"`company-mode' back-end using `completion-at-point-functions'."
(interactive (list 'interactive))
(pcase command
(`interactive (company-begin-backend 'company-capf))
(`prefix
(let ((res (company--capf-data)))
(when res
(if (> (nth 2 res) (point))
'stop
(buffer-substring-no-properties (nth 1 res) (point))))))
(`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 'font-lock-face arg)
0
(next-single-property-change 0 'font-lock-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 'font-lock-face arg)))
(text-property-not-all start (length arg)
'font-lock-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)))
(if exit-function
(funcall exit-function arg 'finished))))
))
(provide 'company-capf)
;;; company-capf.el ends here

View File

@ -0,0 +1,326 @@
;;; company-clang.el --- company-mode completion back-end for Clang -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2013-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-clang nil
"Completion back-end 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" nil)))
(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 ((meta (company-clang--meta candidate)))
(cond
((null meta) nil)
((string-match "[^:]:[^:]" meta)
(substring meta (1+ (match-beginning 0))))
((string-match "\\((.*)[ a-z]*\\'\\)" meta)
(match-string 1 meta)))))
(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*")))
(with-current-buffer buf (erase-buffer))
(if (get-buffer-process buf)
(funcall callback nil)
(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-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)
(when (looking-at "([^)]*) ?")
(delete-region (match-beginning 0) (match-end 0)))
(company-template-add-field templ (point) (format "arg%d" cnt))
(if (< (point) end)
(insert " ")
(throw 'stop t))
(cl-incf cnt))))
(company-template-move-to-first templ)))
(defun company-clang (command &optional arg &rest ignored)
"`company-mode' completion back-end 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-clang-objc-templatify anno)
(company-template-c-like-templatify anno)))))))
(provide 'company-clang)
;;; company-clang.el ends here

View File

@ -0,0 +1,129 @@
;;; company-cmake.el --- company-mode completion back-end for CMake
;; Copyright (C) 2013 Free Software Foundation, Inc.
;; Author: Chen Bin <chenbin DOT sh AT gmail>
;; Version: 0.1
;; 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 back-end 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--meta-command-cache nil
"Cache for command arguments to retrieve descriptions for the candidates.")
(defun company-cmake--parse-output (prefix cmd)
"Analyze the temp buffer and collect lines."
(goto-char (point-min))
(let ((pattern (format company-cmake--completion-pattern
(regexp-quote prefix)
(if (zerop (length prefix)) "+" "*")))
(case-fold-search nil)
lines match)
(while (re-search-forward pattern nil t)
(setq match (match-string-no-properties 1))
(puthash match cmd company-cmake--meta-command-cache)
(push match lines))
lines))
(defun company-cmake--candidates (prefix)
(let ((res 0)
results
cmd)
(setq company-cmake--meta-command-cache (make-hash-table :test 'equal))
(dolist (arg company-cmake-executable-arguments)
(with-temp-buffer
(setq res (call-process company-cmake-executable nil t nil arg))
(unless (eq 0 res)
(message "cmake executable exited with error=%d" res))
(setq cmd (replace-regexp-in-string "-list$" "" arg) )
(setq results (nconc results (company-cmake--parse-output prefix cmd)))))
results))
(defun company-cmake--meta (prefix)
(let ((cmd-opts (gethash prefix company-cmake--meta-command-cache))
result)
(with-temp-buffer
(call-process company-cmake-executable nil t nil cmd-opts prefix)
;; 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 (prefix)
(let ((cmd-opts (gethash prefix company-cmake--meta-command-cache)))
(with-temp-buffer
(call-process company-cmake-executable nil t nil cmd-opts prefix)
;; 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 back-end 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

@ -0,0 +1,438 @@
;;; company-css.el --- company-mode completion back-end 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)
(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 back-end for `css-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-css))
(prefix (and (derived-mode-p 'css-mode)
(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

@ -0,0 +1,104 @@
;;; company-dabbrev-code.el --- dabbrev-like company-mode back-end 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 back-end 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 back-ends
\(e.g. `company-dabbrev'\). Value t means complete in all modes."
:type '(choice (repeat (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. 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 in completion candidates."
:type 'boolean)
(defsubst 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' back-end for code.
The back-end 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))
t)))
(ignore-case company-dabbrev-code-ignore-case)
(duplicates t)))
(provide 'company-dabbrev-code)
;;; company-dabbrev-code.el ends here

View File

@ -0,0 +1,153 @@
;;; company-dabbrev.el --- dabbrev-like company-mode completion back-end -*- 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)
(defgroup company-dabbrev nil
"dabbrev-like completion back-end."
:group 'company)
(defcustom company-dabbrev-other-buffers 'all
"Determines whether `company-dabbrev' should search other buffers.
If `all', search all other buffers. 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-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
"The value of `ignore-case' returned by `company-dabbrev'.")
(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 (1+ company-minimum-prefix-length)
"The minimum length for the string to be included."
:type 'integer)
(defmacro company-dabrev--time-limit-while (test start limit &rest body)
(declare (indent 3) (debug t))
`(let ((company-time-limit-while-counter 0))
(catch 'done
(while ,test
,@body
(and ,limit
(eq (cl-incf company-time-limit-while-counter) 25)
(setq company-time-limit-while-counter 0)
(> (float-time (time-since ,start)) ,limit)
(throw 'done 'company-time-out))))))
(defsubst company-dabbrev--make-regexp (prefix)
(concat "\\<" (if (equal prefix "")
company-dabbrev-char-regexp
(regexp-quote prefix))
"\\(" company-dabbrev-char-regexp "\\)*\\>"))
(defun company-dabbrev--search-buffer (regexp pos symbols start limit
ignore-comments)
(save-excursion
(let (match)
(goto-char (if pos (1- pos) (point-min)))
;; search before pos
(company-dabrev--time-limit-while (re-search-backward regexp nil t)
start limit
(setq match (match-string-no-properties 0))
(if (and ignore-comments (company-in-string-or-comment))
(re-search-backward "\\s<\\|\\s!\\|\\s\"\\|\\s|" nil t)
(when (>= (length match) company-dabbrev-minimum-length)
(push match symbols))))
(goto-char (or pos (point-min)))
;; search after pos
(company-dabrev--time-limit-while (re-search-forward regexp nil t)
start limit
(setq match (match-string-no-properties 0))
(if (and ignore-comments (company-in-string-or-comment))
(re-search-forward "\\s>\\|\\s!\\|\\s\"" nil t)
(when (>= (length match) company-dabbrev-minimum-length)
(push match symbols))))
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)))
(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))
;;;###autoload
(defun company-dabbrev (command &optional arg &rest ignored)
"dabbrev-like `company-mode' completion back-end."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-dabbrev))
(prefix (company-grab-word))
(candidates
(let ((words (company-dabbrev--search (company-dabbrev--make-regexp arg)
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)))
(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

@ -0,0 +1,183 @@
;;; company-eclim.el --- company-mode completion back-end for Eclim
;; 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:
;;
;; Using `emacs-eclim' together with (or instead of) this back-end is
;; recommended, as it allows you to use other Eclim features.
;;
;; The alternative back-end 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 back-end 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 (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)
(setq company-eclim--project-dir
(directory-file-name
(expand-file-name
(locate-dominating-file buffer-file-name ".project"))))
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 back-end 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

@ -0,0 +1,193 @@
;;; company-elisp-tests.el --- company-elisp tests
;; Copyright (C) 2013-2014 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-elisp)
(defmacro company-elisp-with-buffer (contents &rest body)
(declare (indent 0))
`(with-temp-buffer
(insert ,contents)
(setq major-mode 'emacs-lisp-mode)
(re-search-backward "|")
(replace-match "")
(let ((company-elisp-detect-function-context t))
,@body)))
(ert-deftest company-elisp-candidates-predicate ()
(company-elisp-with-buffer
"(foo ba|)"
(should (eq (company-elisp--candidates-predicate "ba")
'boundp))
(should (eq (let (company-elisp-detect-function-context)
(company-elisp--candidates-predicate "ba"))
'company-elisp--predicate)))
(company-elisp-with-buffer
"(foo| )"
(should (eq (company-elisp--candidates-predicate "foo")
'fboundp))
(should (eq (let (company-elisp-detect-function-context)
(company-elisp--candidates-predicate "foo"))
'company-elisp--predicate)))
(company-elisp-with-buffer
"(foo 'b|)"
(should (eq (company-elisp--candidates-predicate "b")
'company-elisp--predicate))))
(ert-deftest company-elisp-candidates-predicate-in-docstring ()
(company-elisp-with-buffer
"(def foo () \"Doo be doo `ide|"
(should (eq 'company-elisp--predicate
(company-elisp--candidates-predicate "ide")))))
;; This one's also an integration test.
(ert-deftest company-elisp-candidates-recognizes-binding-form ()
(let ((company-elisp-detect-function-context t)
(obarray [when what whelp])
(what 1)
(whelp 2)
(wisp 3))
(company-elisp-with-buffer
"(let ((foo 7) (wh| )))"
(should (equal '("what" "whelp")
(company-elisp-candidates "wh"))))
(company-elisp-with-buffer
"(cond ((null nil) (wh| )))"
(should (equal '("when")
(company-elisp-candidates "wh"))))))
(ert-deftest company-elisp-candidates-predicate-binding-without-value ()
(cl-loop for (text prefix predicate) in '(("(let (foo|" "foo" boundp)
("(let (foo (bar|" "bar" boundp)
("(let (foo) (bar|" "bar" fboundp))
do
(eval `(company-elisp-with-buffer
,text
(should (eq ',predicate
(company-elisp--candidates-predicate ,prefix)))))))
(ert-deftest company-elisp-finds-vars ()
(let ((obarray [boo bar baz backquote])
(boo t)
(bar t)
(baz t))
(should (equal '("bar" "baz")
(company-elisp--globals "ba" 'boundp)))))
(ert-deftest company-elisp-finds-functions ()
(let ((obarray [when what whelp])
(what t)
(whelp t))
(should (equal '("when")
(company-elisp--globals "wh" 'fboundp)))))
(ert-deftest company-elisp-finds-things ()
(let ((obarray [when what whelp])
(what t)
(whelp t))
(should (equal '("what" "whelp" "when")
(sort (company-elisp--globals "wh" 'company-elisp--predicate)
'string<)))))
(ert-deftest company-elisp-locals-vars ()
(company-elisp-with-buffer
"(let ((foo 5) (bar 6))
(cl-labels ((borg ()))
(lambda (boo baz)
b|)))"
(should (equal '("bar" "baz" "boo")
(company-elisp--locals "b" nil)))))
(ert-deftest company-elisp-locals-single-var ()
(company-elisp-with-buffer
"(dotimes (itk 100)
(dolist (item items)
it|))"
(should (equal '("itk" "item")
(company-elisp--locals "it" nil)))))
(ert-deftest company-elisp-locals-funs ()
(company-elisp-with-buffer
"(cl-labels ((foo ())
(fee ()))
(let ((fun 4))
(f| )))"
(should (equal '("fee" "foo")
(sort (company-elisp--locals "f" t) 'string<)))))
(ert-deftest company-elisp-locals-skips-current-varlist ()
(company-elisp-with-buffer
"(let ((foo 1)
(f| )))"
(should (null (company-elisp--locals "f" nil)))))
(ert-deftest company-elisp-show-locals-first ()
(company-elisp-with-buffer
"(let ((floo 1)
(flop 2)
(flee 3))
fl|)"
(let ((obarray [float-pi]))
(let (company-elisp-show-locals-first)
(should (eq nil (company-elisp 'sorted))))
(let ((company-elisp-show-locals-first t))
(should (eq t (company-elisp 'sorted)))
(should (equal '("flee" "floo" "flop" "float-pi")
(company-elisp-candidates "fl")))))))
(ert-deftest company-elisp-candidates-no-duplicates ()
(company-elisp-with-buffer
"(let ((float-pi 4))
f|)"
(let ((obarray [float-pi])
(company-elisp-show-locals-first t))
(should (equal '("float-pi") (company-elisp-candidates "f"))))))
(ert-deftest company-elisp-shouldnt-complete-defun-name ()
(company-elisp-with-buffer
"(defun foob|)"
(should (null (company-elisp 'prefix)))))
(ert-deftest company-elisp-should-complete-def-call ()
(company-elisp-with-buffer
"(defu|"
(should (equal "defu" (company-elisp 'prefix)))))
(ert-deftest company-elisp-should-complete-in-defvar ()
;; It will also complete the var name, at least for now.
(company-elisp-with-buffer
"(defvar abc de|"
(should (equal "de" (company-elisp 'prefix)))))
(ert-deftest company-elisp-shouldnt-complete-in-defun-arglist ()
(company-elisp-with-buffer
"(defsubst foobar (ba|"
(should (null (company-elisp 'prefix)))))
(ert-deftest company-elisp-prefix-in-defun-body ()
(company-elisp-with-buffer
"(defun foob ()|)"
(should (equal "" (company-elisp 'prefix)))))

View File

@ -0,0 +1,225 @@
;;; company-elisp.el --- company-mode completion back-end 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 back-end 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 back-end 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

@ -0,0 +1,94 @@
;;; company-etags.el --- company-mode completion back-end 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 back-end 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"))
(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 (locate-dominating-file (or buffer-file-name
default-directory)
"TAGS")))
(when file
(list (expand-file-name 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 back-end for etags."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-etags))
(prefix (and (apply 'derived-mode-p company-etags-modes)
(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

@ -0,0 +1,93 @@
;;; company-files.el --- company-mode completion back-end for file names
;; 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)
(defun company-files-directory-files (dir prefix)
(ignore-errors
(if (equal prefix "")
(directory-files dir nil "\\`[^.]\\|\\`.[^.]")
(file-name-all-completions prefix dir))))
(defvar company-files-regexps
(let ((begin (if (eq system-type 'windows-nt)
"[a-z][A-Z]\\"
"~?/")))
(list (concat "\"\\(" begin "[^\"\n]*\\)")
(concat "\'\\(" begin "[^\'\n]*\\)")
(concat "\\(?:[ \t]\\|^\\)\\(" begin "[^ \t\n]*\\)"))))
(defun company-files-grab-existing-name ()
;; Grab file names with spaces, only when they include quotes.
(let (file dir)
(and (cl-dolist (regexp company-files-regexps)
(when (setq file (company-grab-line regexp 1))
(cl-return file)))
(setq dir (file-name-directory file))
(not (string-match "//" dir))
(file-exists-p dir)
(file-name-all-completions (file-name-nondirectory file) dir)
file)))
(defvar company-files-completion-cache nil)
(defun company-files-complete (prefix)
(let* ((dir (file-name-directory prefix))
(file (file-name-nondirectory prefix))
candidates directories)
(unless (equal dir (car company-files-completion-cache))
(dolist (file (company-files-directory-files dir file))
(setq file (concat dir file))
(push file candidates)
(when (file-directory-p file)
(push file directories)))
(dolist (directory (reverse directories))
;; Add one level of children.
(dolist (child (company-files-directory-files directory ""))
(push (concat directory
(unless (eq (aref directory (1- (length directory))) ?/) "/")
child) candidates)))
(setq company-files-completion-cache (cons dir (nreverse candidates))))
(all-completions prefix
(cdr company-files-completion-cache))))
;;;###autoload
(defun company-files (command &optional arg &rest ignored)
"`company-mode' completion back-end existing file names."
(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))
(sorted t)
(no-cache t)))
(provide 'company-files)
;;; company-files.el ends here

View File

@ -0,0 +1,109 @@
;;; company-gtags.el --- company-mode completion back-end 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 'cl-lib)
(defgroup company-gtags nil
"Completion back-end 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)
(defvar company-gtags-modes '(c-mode c++-mode jde-mode java-mode php-mode))
(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
(list (current-buffer) nil) nil "-xGq" (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 back-end for GNU Global."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-gtags))
(prefix (and company-gtags-executable
(memq major-mode 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

@ -0,0 +1,69 @@
;;; company-ispell.el --- company-mode completion back-end using Ispell
;; Copyright (C) 2009-2011 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 back-end 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)
(defun company-ispell-available ()
(when (eq company-ispell-available 'unknown)
(condition-case err
(progn
(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 back-end using Ispell."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-ispell))
(prefix (when (company-ispell-available)
(company-grab-word)))
(candidates (lookup-words arg (or company-ispell-dictionary
ispell-complete-word-dict)))
(sorted t)
(ignore-case 'keep-prefix)))
(provide 'company-ispell)
;;; company-ispell.el ends here

View File

@ -0,0 +1,236 @@
;;; company-keywords.el --- A company back-end for programming language keywords
;; Copyright (C) 2009-2011 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
"asm" "auto" "bool" "break" "case" "catch" "char" "class" "const"
"const_cast" "continue" "default" "delete" "do" "double" "dynamic_cast"
"else" "enum" "explicit" "export" "extern" "false" "float" "for" "friend"
"goto" "if" "inline" "int" "long" "mutable" "namespace" "new"
"operator" "private" "protected" "public" "register" "reinterpret_cast"
"return" "short" "signed" "sizeof" "static" "static_cast" "struct" "switch"
"template" "this" "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")
;; aliases
(js2-mode . javascript-mode)
(espresso-mode . javascript-mode)
(js-mode . javascript-mode)
(cperl-mode . perl-mode)
(jde-mode . java-mode))
"Alist mapping major-modes to sorted keywords for `company-keywords'.")
;;;###autoload
(defun company-keywords (command &optional arg &rest ignored)
"`company-mode' back-end 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

@ -0,0 +1,142 @@
;;; company-nxml.el --- company-mode completion back-end 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 back-end 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

@ -0,0 +1,57 @@
;;; company-oddmuse.el --- company-mode completion back-end 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 'yaooddmuse 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 back-end 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

@ -0,0 +1,2 @@
;; Generated package description from company.el
(define-package "company" "0.8.2" "Modular text completion framework" '((emacs "24.1") (cl-lib "0.5")) :url "http://company-mode.github.io/" :keywords '("abbrev" "convenience" "matching"))

View File

@ -0,0 +1,69 @@
;;; company-pysmell.el --- company-mode completion back-end for pysmell.el
;; Copyright (C) 2009-2011, 2013-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:
;;
;; The main problem with using this backend is installing Pysmell.
;; I couldn't manage to do that. --Dmitry
;;; Code:
(if t (require 'pysmell)) ;Don't load during compilation.
(require 'company)
(require 'cl-lib)
(defvar-local company-pysmell--available-p 'unknown)
(defun company-pysmell--available-p ()
(if (eq company-pysmell--available-p 'unknown)
(setq company-pysmell--available-p
(locate-dominating-file buffer-file-name "PYSMELLTAGS"))
company-pysmell--available-p))
(defun company-pysmell--grab-symbol ()
(let ((symbol (company-grab-symbol)))
(when symbol
(cons symbol
(save-excursion
(let ((pos (point)))
(goto-char (- (point) (length symbol)))
(while (eq (char-before) ?.)
(goto-char (1- (point)))
(skip-syntax-backward "w_"))
(- pos (point))))))))
;;;###autoload
(defun company-pysmell (command &optional arg &rest ignored)
"`company-mode' completion back-end for pysmell.
This requires pysmell.el and pymacs.el."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-pysmell))
(prefix (and (derived-mode-p 'python-mode)
buffer-file-name
(not (company-in-string-or-comment))
(company-pysmell--available-p)
(company-pysmell--grab-symbol)))
(candidates (delete "" (pysmell-get-all-completions)))))
(provide 'company-pysmell)
;;; company-pysmell.el ends here

View File

@ -0,0 +1,76 @@
;;; company-ropemacs.el --- company-mode completion back-end for ropemacs
;; 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 'cl-lib)
(defun company-ropemacs--grab-symbol ()
(let ((symbol (company-grab-symbol)))
(when symbol
(cons symbol
(save-excursion
(let ((pos (point)))
(goto-char (- (point) (length symbol)))
(while (eq (char-before) ?.)
(goto-char (1- (point)))
(skip-syntax-backward "w_"))
(- pos (point))))))))
(defun company-ropemacs-doc-buffer (candidate)
"Return buffer with docstring of CANDIDATE if it is available."
(let ((doc (company-with-candidate-inserted candidate (rope-get-doc))))
(when doc
(company-doc-buffer doc))))
(defun company-ropemacs-location (candidate)
"Return location of CANDIDATE in cons form (FILE . LINE) if it is available."
(let ((location (company-with-candidate-inserted candidate
(rope-definition-location))))
(when location
(cons (elt location 0) (elt location 1)))))
(defun company-ropemacs (command &optional arg &rest ignored)
"`company-mode' completion back-end for ropemacs.
Depends on third-party code: Pymacs (both Python and Emacs packages),
rope, ropemacs and ropemode."
(interactive (list 'interactive))
(cl-case command
(init (when (and (derived-mode-p 'python-mode)
(not (fboundp 'rope-completions)))
(require 'pymacs)
(pymacs-load "ropemacs" "rope-")))
(interactive (company-begin-backend 'company-ropemacs))
(prefix (and (derived-mode-p 'python-mode)
(not (company-in-string-or-comment))
(company-ropemacs--grab-symbol)))
(candidates (mapcar (lambda (element) (concat arg element))
(rope-completions)))
(doc-buffer (company-ropemacs-doc-buffer arg))
(location (company-ropemacs-location arg))))
(provide 'company-ropemacs)
;;; company-ropemacs.el ends here

View File

@ -0,0 +1,146 @@
;;; company-semantic.el --- company-mode completion back-end using Semantic
;; 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 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")
(defgroup company-semantic nil
"Completion back-end 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)
(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))
(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--pre-prefix-length (prefix-length)
"Sum up the length of all chained symbols before POS.
Symbols are chained by \".\" or \"->\"."
(save-excursion
(let ((pos (point)))
(goto-char (- (point) prefix-length))
(while (looking-back "->\\|\\.")
(goto-char (match-beginning 0))
(skip-syntax-backward "w_"))
(- pos (point)))))
(defun company-semantic--grab ()
"Grab the semantic prefix, but return everything before -> or . as length."
(let ((symbol (company-grab-symbol)))
(when symbol
(cons symbol (company-semantic--pre-prefix-length (length symbol))))))
;;;###autoload
(defun company-semantic (command &optional arg &rest ignored)
"`company-mode' completion back-end 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--grab) 'stop)))
(candidates (if (and (equal arg "")
(not (looking-back "->\\|\\.")))
(company-semantic-completions-raw arg)
(company-semantic-completions arg)))
(meta (funcall company-semantic-metadata-function
(assoc 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 ""))
(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)))))))
(provide 'company-semantic)
;;; company-semantic.el ends here

View File

@ -0,0 +1,170 @@
;;; company-template.el
;; Copyright (C) 2009, 2010, 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/>.
;;; 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 pos text &optional display)
"Add new field to template TEMPL at POS, inserting TEXT.
When DISPLAY is non-nil, set the respective property on the overlay.
Leave point at the end of the field."
(cl-assert templ)
(goto-char pos)
(insert text)
(when (> (point) (overlay-end templ))
(move-overlay templ (overlay-start templ) (point)))
(let ((ov (make-overlay pos (+ pos (length text))))
(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)))
(cnt 0))
(when (re-search-backward ")" beg t)
(delete-region (match-end 0) end))
(goto-char beg)
(when (search-forward "(" end 'move)
(if (eq (char-after) ?\))
(forward-char 1)
(let ((templ (company-template-declare-template beg end)))
(while (re-search-forward (concat " *\\([^,)]*\\)[,)]") end t)
(let ((sig (match-string 1)))
(delete-region (match-beginning 1) (match-end 1))
(save-excursion
(company-template-add-field templ (match-beginning 1)
(format "arg%d" cnt) sig))
(cl-incf cnt)))
(company-template-move-to-first templ))))))
(provide 'company-template)
;;; company-template.el ends here

View File

@ -0,0 +1,63 @@
;;; company-tempo.el --- company-mode completion back-end for tempo
;; Copyright (C) 2009-2011 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)
(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 back-end for tempo."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-tempo
'company-tempo-insert))
(prefix (or (car (tempo-find-match-string tempo-match-finder)) ""))
(candidates (all-completions arg (tempo-build-collection)))
(meta (company-tempo-meta arg))
(require-match t)
(sorted t)))
(provide 'company-tempo)
;;; company-tempo.el ends here

View File

@ -0,0 +1,830 @@
;;; company-tests.el --- company-mode tests -*- lexical-binding: t -*-
;; Copyright (C) 2011, 2013-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 'ert)
(require 'company)
(require 'company-keywords)
(require 'company-clang)
;;; Core
(ert-deftest company-sorted-keywords ()
"Test that keywords in `company-keywords-alist' are in alphabetical order."
(dolist (pair company-keywords-alist)
(when (consp (cdr pair))
(let ((prev (cadr pair)))
(dolist (next (cddr pair))
(should (not (equal prev next)))
(should (string< prev next))
(setq prev next))))))
(ert-deftest company-good-prefix ()
(let ((company-minimum-prefix-length 5)
company-abort-manual-when-too-short
company--manual-action ;idle begin
(company-selection-changed t)) ;has no effect
(should (eq t (company--good-prefix-p "!@#$%")))
(should (eq nil (company--good-prefix-p "abcd")))
(should (eq nil (company--good-prefix-p 'stop)))
(should (eq t (company--good-prefix-p '("foo" . 5))))
(should (eq nil (company--good-prefix-p '("foo" . 4))))
(should (eq t (company--good-prefix-p '("foo" . t))))))
(ert-deftest company--manual-prefix-set-and-unset ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(company-manual-begin)
(should (equal "ab" company--manual-prefix))
(company-abort)
(should (null company--manual-prefix)))))
(ert-deftest company-abort-manual-when-too-short ()
(let ((company-minimum-prefix-length 5)
(company-abort-manual-when-too-short t)
(company-selection-changed t)) ;has not effect
(let ((company--manual-action nil)) ;idle begin
(should (eq t (company--good-prefix-p "!@#$%")))
(should (eq t (company--good-prefix-p '("foo" . 5))))
(should (eq t (company--good-prefix-p '("foo" . t)))))
(let ((company--manual-action t)
(company--manual-prefix "abc")) ;manual begin from this prefix
(should (eq t (company--good-prefix-p "!@#$")))
(should (eq nil (company--good-prefix-p "ab")))
(should (eq nil (company--good-prefix-p 'stop)))
(should (eq t (company--good-prefix-p '("foo" . 4))))
(should (eq t (company--good-prefix-p "abcd")))
(should (eq t (company--good-prefix-p "abc")))
(should (eq t (company--good-prefix-p '("bar" . t)))))))
(ert-deftest company-multi-backend-with-lambdas ()
(let ((company-backend
(list (lambda (command &optional arg &rest ignore)
(cl-case command
(prefix "z")
(candidates '("a" "b"))))
(lambda (command &optional arg &rest ignore)
(cl-case command
(prefix "z")
(candidates '("c" "d")))))))
(should (equal (company-call-backend 'candidates "z") '("a" "b" "c" "d")))))
(ert-deftest company-multi-backend-filters-backends-by-prefix ()
(let ((company-backend
(list (lambda (command &optional arg &rest ignore)
(cl-case command
(prefix (cons "z" t))
(candidates '("a" "b"))))
(lambda (command &optional arg &rest ignore)
(cl-case command
(prefix "t")
(candidates '("c" "d"))))
(lambda (command &optional arg &rest ignore)
(cl-case command
(prefix "z")
(candidates '("e" "f")))))))
(should (equal (company-call-backend 'candidates "z") '("a" "b" "e" "f")))))
(ert-deftest company-multi-backend-remembers-candidate-backend ()
(let ((company-backend
(list (lambda (command &optional arg)
(cl-case command
(ignore-case nil)
(annotation "1")
(candidates '("a" "c"))
(post-completion "13")))
(lambda (command &optional arg)
(cl-case command
(ignore-case t)
(annotation "2")
(candidates '("b" "d"))
(post-completion "42")))
(lambda (command &optional arg)
(cl-case command
(annotation "3")
(candidates '("e"))
(post-completion "74"))))))
(let ((candidates (company-calculate-candidates nil)))
(should (equal candidates '("a" "b" "c" "d" "e")))
(should (equal t (company-call-backend 'ignore-case)))
(should (equal "1" (company-call-backend 'annotation (nth 0 candidates))))
(should (equal "2" (company-call-backend 'annotation (nth 1 candidates))))
(should (equal "13" (company-call-backend 'post-completion (nth 2 candidates))))
(should (equal "42" (company-call-backend 'post-completion (nth 3 candidates))))
(should (equal "3" (company-call-backend 'annotation (nth 4 candidates))))
(should (equal "74" (company-call-backend 'post-completion (nth 4 candidates)))))))
(ert-deftest company-multi-backend-handles-keyword-with ()
(let ((primo (lambda (command &optional arg)
(cl-case command
(prefix "a")
(candidates '("abb" "abc" "abd")))))
(secundo (lambda (command &optional arg)
(cl-case command
(prefix "a")
(candidates '("acc" "acd"))))))
(let ((company-backend (list 'ignore 'ignore :with secundo)))
(should (null (company-call-backend 'prefix))))
(let ((company-backend (list 'ignore primo :with secundo)))
(should (equal "a" (company-call-backend 'prefix)))
(should (equal '("abb" "abc" "abd" "acc" "acd")
(company-call-backend 'candidates "a"))))))
(ert-deftest company-begin-backend-failure-doesnt-break-company-backends ()
(with-temp-buffer
(insert "a")
(company-mode)
(should-error
(company-begin-backend (lambda (command &rest ignore))))
(let (company-frontends
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix "a")
(candidates '("a" "ab" "ac")))))))
(let (this-command)
(company-call 'complete))
(should (eq 3 company-candidates-length)))))
(ert-deftest company-require-match-explicit ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-require-match 'company-explicit-action-p)
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(let (this-command)
(company-complete))
(let ((last-command-event ?e))
(company-call 'self-insert-command 1))
(should (eq 2 company-candidates-length))
(should (eq 3 (point))))))
(ert-deftest company-dont-require-match-when-idle ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-minimum-prefix-length 2)
(company-require-match 'company-explicit-action-p)
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(should (eq 2 company-candidates-length))
(let ((last-command-event ?e))
(company-call 'self-insert-command 1))
(should (eq nil company-candidates-length))
(should (eq 4 (point))))))
(ert-deftest company-dont-require-match-if-old-prefix-ended-and-was-a-match ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-require-match 'company-explicit-action-p)
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (company-grab-word))
(candidates '("abc" "ab" "abd"))
(sorted t))))))
(let (this-command)
(company-complete))
(let ((last-command-event ?e))
(company-call 'self-insert-command 1))
(should (eq 3 company-candidates-length))
(should (eq 3 (point)))
(let ((last-command-event ? ))
(company-call 'self-insert-command 1))
(should (null company-candidates-length))
(should (eq 4 (point))))))
(ert-deftest company-should-complete-whitelist ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
company-begin-commands
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(let ((company-continue-commands nil))
(let (this-command)
(company-complete))
(company-call 'backward-delete-char 1)
(should (null company-candidates-length)))
(let ((company-continue-commands '(backward-delete-char)))
(let (this-command)
(company-complete))
(company-call 'backward-delete-char 1)
(should (eq 2 company-candidates-length))))))
(ert-deftest company-should-complete-blacklist ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
company-begin-commands
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abc" "abd")))))))
(let ((company-continue-commands '(not backward-delete-char)))
(let (this-command)
(company-complete))
(company-call 'backward-delete-char 1)
(should (null company-candidates-length)))
(let ((company-continue-commands '(not backward-delete-char-untabify)))
(let (this-command)
(company-complete))
(company-call 'backward-delete-char 1)
(should (eq 2 company-candidates-length))))))
(ert-deftest company-auto-complete-explicit ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-auto-complete 'company-explicit-action-p)
(company-auto-complete-chars '(? ))
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abcd" "abef")))))))
(let (this-command)
(company-complete))
(let ((last-command-event ? ))
(company-call 'self-insert-command 1))
(should (string= "abcd " (buffer-string))))))
(ert-deftest company-no-auto-complete-when-idle ()
(with-temp-buffer
(insert "ab")
(company-mode)
(let (company-frontends
(company-auto-complete 'company-explicit-action-p)
(company-auto-complete-chars '(? ))
(company-minimum-prefix-length 2)
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abcd" "abef")))))))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(let ((last-command-event ? ))
(company-call 'self-insert-command 1))
(should (string= "ab " (buffer-string))))))
(ert-deftest company-clears-explicit-action-when-no-matches ()
(with-temp-buffer
(company-mode)
(let (company-frontends
company-backends)
(company-call 'manual-begin) ;; fails
(should (null company-candidates))
(should (null (company-explicit-action-p))))))
(ert-deftest company-ignore-case-replaces-prefix ()
(with-temp-buffer
(company-mode)
(let (company-frontends
company-end-of-buffer-workaround
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abcd" "abef"))
(ignore-case t))))))
(insert "A")
(let (this-command)
(company-complete))
(should (string= "ab" (buffer-string)))
(delete-char -2)
(insert "A") ; hack, to keep it in one test
(company-complete-selection)
(should (string= "abcd" (buffer-string))))))
(ert-deftest company-ignore-case-with-keep-prefix ()
(with-temp-buffer
(insert "AB")
(company-mode)
(let (company-frontends
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("abcd" "abef"))
(ignore-case 'keep-prefix))))))
(let (this-command)
(company-complete))
(company-complete-selection)
(should (string= "ABcd" (buffer-string))))))
(ert-deftest company-non-prefix-completion ()
(with-temp-buffer
(insert "tc")
(company-mode)
(let (company-frontends
company-end-of-buffer-workaround
(company-backends
(list (lambda (command &optional arg)
(cl-case command
(prefix (buffer-substring (point-min) (point)))
(candidates '("tea-cup" "teal-color")))))))
(let (this-command)
(company-complete))
(should (string= "tc" (buffer-string)))
(company-complete-selection)
(should (string= "tea-cup" (buffer-string))))))
(ert-deftest company-pseudo-tooltip-does-not-get-displaced ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(save-excursion (insert " ff"))
(company-mode)
(let ((company-frontends '(company-pseudo-tooltip-frontend))
(company-begin-commands '(self-insert-command))
(company-backends
(list (lambda (c &optional arg)
(cl-case c (prefix "") (candidates '("a" "b" "c")))))))
(let (this-command)
(company-call 'complete))
(company-call 'open-line 1)
(should (eq 2 (overlay-start company-pseudo-tooltip-overlay)))))))
(ert-deftest company-pseudo-tooltip-show ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert "aaaa\n bb\nccccccc\nddd")
(search-backward "bb")
(let ((col (company--column))
(company-candidates-length 2)
(company-candidates '("123" "45"))
(company-backend 'ignore))
(company-pseudo-tooltip-show (company--row) col 0)
(let ((ov company-pseudo-tooltip-overlay))
;; With margins.
(should (eq (overlay-get ov 'company-width) 5))
;; FIXME: Make it 2?
(should (eq (overlay-get ov 'company-height) company-tooltip-limit))
(should (eq (overlay-get ov 'company-column) col))
(should (string= (overlay-get ov 'company-after)
" 123 \nc 45 c\nddd\n")))))))
(ert-deftest company-pseudo-tooltip-edit-updates-width ()
:tags '(interactive)
(with-temp-buffer
(set-window-buffer nil (current-buffer))
(let ((company-candidates-length 5)
(company-candidates '("123" "45" "67" "89" "1011"))
(company-backend 'ignore)
(company-tooltip-limit 4)
(company-tooltip-offset-display 'scrollbar))
(company-pseudo-tooltip-show (company--row)
(company--column)
0)
(should (eq (overlay-get company-pseudo-tooltip-overlay 'company-width)
6))
(company-pseudo-tooltip-edit 4)
(should (eq (overlay-get company-pseudo-tooltip-overlay 'company-width)
7)))))
(ert-deftest company-preview-show-with-annotations ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(save-excursion (insert "\n"))
(let ((company-candidates-length 1)
(company-candidates '("123")))
(company-preview-show-at-point (point))
(let ((ov company-preview-overlay))
(should (string= (overlay-get ov 'display) "123\n")))))))
(ert-deftest company-pseudo-tooltip-show-with-annotations ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert " ")
(save-excursion (insert "\n"))
(let ((company-candidates-length 2)
(company-backend (lambda (action &optional arg &rest _ignore)
(when (eq action 'annotation)
(cdr (assoc arg '(("123" . "(4)")))))))
(company-candidates '("123" "45"))
company-tooltip-align-annotations)
(company-pseudo-tooltip-show-at-point (point) 0)
(let ((ov company-pseudo-tooltip-overlay))
;; With margins.
(should (eq (overlay-get ov 'company-width) 8))
(should (string= (overlay-get ov 'company-after)
" 123(4) \n 45 \n")))))))
(ert-deftest company-pseudo-tooltip-show-with-annotations-right-aligned ()
:tags '(interactive)
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert " ")
(save-excursion (insert "\n"))
(let ((company-candidates-length 3)
(company-backend (lambda (action &optional arg &rest _ignore)
(when (eq action 'annotation)
(cdr (assoc arg '(("123" . "(4)")
("67" . "(891011)")))))))
(company-candidates '("123" "45" "67"))
(company-tooltip-align-annotations t))
(company-pseudo-tooltip-show-at-point (point) 0)
(let ((ov company-pseudo-tooltip-overlay))
;; With margins.
(should (eq (overlay-get ov 'company-width) 13))
(should (string= (overlay-get ov 'company-after)
" 123 (4) \n 45 \n 67 (891011) \n")))))))
(ert-deftest company-create-lines-shows-numbers ()
(let ((company-show-numbers t)
(company-candidates '("x" "y" "z"))
(company-candidates-length 3)
(company-backend 'ignore))
(should (equal '(" x 1 " " y 2 " " z 3 ")
(company--create-lines 0 999)))))
(ert-deftest company-create-lines-truncates-annotations ()
(let* ((ww (company--window-width))
(data `(("1" . "(123)")
("2" . nil)
("3" . ,(concat "(" (make-string (- ww 2) ?4) ")"))
(,(make-string ww ?4) . "<4>")))
(company-candidates (mapcar #'car data))
(company-candidates-length 4)
(company-tooltip-margin 1)
(company-backend (lambda (cmd &optional arg)
(when (eq cmd 'annotation)
(cdr (assoc arg data)))))
company-tooltip-align-annotations)
(should (equal (list (format " 1(123)%s " (company-space-string (- ww 8)))
(format " 2%s " (company-space-string (- ww 3)))
(format " 3(444%s " (make-string (- ww 7) ?4))
(format " %s " (make-string (- ww 2) ?4)))
(company--create-lines 0 999)))
(let ((company-tooltip-align-annotations t))
(should (equal (list (format " 1%s(123) " (company-space-string (- ww 8)))
(format " 2%s " (company-space-string (- ww 3)))
(format " 3 (444%s " (make-string (- ww 8) ?4))
(format " %s " (make-string (- ww 2) ?4)))
(company--create-lines 0 999))))))
(ert-deftest company-column-with-composition ()
(with-temp-buffer
(insert "lambda ()")
(compose-region 1 (1+ (length "lambda")) "\\")
(should (= (company--column) 4))))
(ert-deftest company-column-with-line-prefix ()
(with-temp-buffer
(insert "foo")
(put-text-property (point-min) (point) 'line-prefix " ")
(should (= (company--column) 5))))
(ert-deftest company-column-wth-line-prefix-on-empty-line ()
(with-temp-buffer
(insert "\n")
(forward-char -1)
(put-text-property (point-min) (point-max) 'line-prefix " ")
(should (= (company--column) 2))))
(ert-deftest company-plainify ()
(let ((tab-width 8))
(should (equal-including-properties
(company-plainify "\tabc\td\t")
(concat " "
"abc "
"d "))))
(should (equal-including-properties
(company-plainify (propertize "foobar" 'line-prefix "-*-"))
"-*-foobar")))
(ert-deftest company-modify-line ()
(let ((str "-*-foobar"))
(should (equal-including-properties
(company-modify-line str "zz" 4)
"-*-fzzbar"))
(should (equal-including-properties
(company-modify-line str "xx" 0)
"xx-foobar"))
(should (equal-including-properties
(company-modify-line str "zz" 10)
"-*-foobar zz"))))
(ert-deftest company-scrollbar-bounds ()
(should (equal nil (company--scrollbar-bounds 0 3 3)))
(should (equal nil (company--scrollbar-bounds 0 4 3)))
(should (equal '(0 . 0) (company--scrollbar-bounds 0 1 2)))
(should (equal '(1 . 1) (company--scrollbar-bounds 2 2 4)))
(should (equal '(2 . 3) (company--scrollbar-bounds 7 4 12)))
(should (equal '(1 . 2) (company--scrollbar-bounds 3 4 12)))
(should (equal '(1 . 3) (company--scrollbar-bounds 4 5 11))))
;;; Async
(defun company-async-backend (command &optional arg)
(pcase command
(`prefix "foo")
(`candidates
(cons :async
(lambda (cb)
(run-with-timer 0.05 nil
#'funcall cb '("abc" "abd")))))))
(ert-deftest company-call-backend-forces-sync ()
(let ((company-backend 'company-async-backend)
(company-async-timeout 0.1))
(should (equal '("abc" "abd") (company-call-backend 'candidates)))))
(ert-deftest company-call-backend-errors-on-timeout ()
(with-temp-buffer
(let* ((company-backend (lambda (command &optional _arg)
(pcase command
(`candidates (cons :async 'ignore)))))
(company-async-timeout 0.1)
(err (should-error (company-call-backend 'candidates "foo"))))
(should (string-match-p "async timeout" (cadr err))))))
(ert-deftest company-call-backend-raw-passes-return-value-verbatim ()
(let ((company-backend 'company-async-backend))
(should (equal "foo" (company-call-backend-raw 'prefix)))
(should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
(should (equal 'closure (cadr (company-call-backend-raw 'candidates "foo"))))))
(ert-deftest company-manual-begin-forces-async-candidates-to-sync ()
(with-temp-buffer
(company-mode)
(let (company-frontends
company-transformers
(company-backends (list 'company-async-backend)))
(company-manual-begin)
(should (equal "foo" company-prefix))
(should (equal '("abc" "abd") company-candidates)))))
(ert-deftest company-idle-begin-allows-async-candidates ()
(with-temp-buffer
(company-mode)
(let (company-frontends
company-transformers
(company-backends (list 'company-async-backend)))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(should (null company-candidates))
(sleep-for 0.1)
(should (equal "foo" company-prefix))
(should (equal '("abc" "abd") company-candidates)))))
(ert-deftest company-idle-begin-cancels-async-candidates-if-buffer-changed ()
(with-temp-buffer
(company-mode)
(let (company-frontends
(company-backends (list 'company-async-backend)))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(should (null company-candidates))
(insert "a")
(sleep-for 0.1)
(should (null company-candidates)))))
(ert-deftest company-idle-begin-async-allows-immediate-callbacks ()
(with-temp-buffer
(company-mode)
(let (company-frontends
(company-backends
(list (lambda (command &optional arg)
(pcase command
(`prefix (buffer-substring (point-min) (point)))
(`candidates
(let ((c (all-completions arg '("abc" "def"))))
(cons :async
(lambda (cb) (funcall cb c)))))
(`no-cache t)))))
(company-minimum-prefix-length 0))
(company-idle-begin (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point))
(should (equal '("abc" "def") company-candidates))
(let ((last-command-event ?a))
(company-call 'self-insert-command 1))
(should (equal '("abc") company-candidates)))))
(ert-deftest company-multi-backend-forces-prefix-to-sync ()
(with-temp-buffer
(let ((company-backend (list 'ignore
(lambda (command)
(should (eq command 'prefix))
(cons :async
(lambda (cb)
(run-with-timer
0.01 nil
(lambda () (funcall cb nil))))))
(lambda (command)
(should (eq command 'prefix))
"foo"))))
(should (equal "foo" (company-call-backend-raw 'prefix))))
(let ((company-backend (list (lambda (_command)
(cons :async
(lambda (cb)
(run-with-timer
0.01 nil
(lambda () (funcall cb "bar"))))))
(lambda (_command)
"foo"))))
(should (equal "bar" (company-call-backend-raw 'prefix))))))
(ert-deftest company-multi-backend-merges-deferred-candidates ()
(with-temp-buffer
(let* ((immediate (lambda (command &optional arg)
(pcase command
(`prefix "foo")
(`candidates
(cons :async
(lambda (cb) (funcall cb '("f"))))))))
(company-backend (list 'ignore
(lambda (command &optional arg)
(pcase command
(`prefix "foo")
(`candidates
(should (equal arg "foo"))
(cons :async
(lambda (cb)
(run-with-timer
0.01 nil
(lambda () (funcall cb '("a" "b")))))))))
(lambda (command &optional arg)
(pcase command
(`prefix "foo")
(`candidates '("c" "d" "e"))))
immediate)))
(should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
(should (equal '("a" "b" "c" "d" "e" "f")
(company-call-backend 'candidates "foo")))
(let ((company-backend (list immediate)))
(should (equal '("f") (company-call-backend 'candidates "foo")))))))
;;; Transformers
(ert-deftest company-occurrence-prefer-closest-above ()
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert "foo0
foo1
")
(save-excursion
(insert "
foo3
foo2"))
(let ((company-backend 'company-dabbrev)
(company-occurrence-weight-function
'company-occurrence-prefer-closest-above))
(should (equal '("foo1" "foo0" "foo3" "foo2" "foo4")
(company-sort-by-occurrence
'("foo0" "foo1" "foo2" "foo3" "foo4"))))))))
(ert-deftest company-occurrence-prefer-any-closest ()
(with-temp-buffer
(save-window-excursion
(set-window-buffer nil (current-buffer))
(insert "foo0
foo1
")
(save-excursion
(insert "
foo3
foo2"))
(let ((company-backend 'company-dabbrev)
(company-occurrence-weight-function
'company-occurrence-prefer-any-closest))
(should (equal '("foo1" "foo3" "foo0" "foo2" "foo4")
(company-sort-by-occurrence
'("foo0" "foo1" "foo2" "foo3" "foo4"))))))))
;;; Template
(ert-deftest company-template-removed-after-the-last-jump ()
(with-temp-buffer
(insert "{ }")
(goto-char 2)
(let ((tpl (company-template-declare-template (point) (1- (point-max)))))
(save-excursion
(dotimes (i 2)
(insert " ")
(company-template-add-field tpl (point) "foo")))
(company-call 'template-forward-field)
(should (= 3 (point)))
(company-call 'template-forward-field)
(should (= 7 (point)))
(company-call 'template-forward-field)
(should (= 11 (point)))
(should (zerop (length (overlay-get tpl 'company-template-fields))))
(should (null (overlay-buffer tpl))))))
(ert-deftest company-template-removed-after-input-and-jump ()
(with-temp-buffer
(insert "{ }")
(goto-char 2)
(let ((tpl (company-template-declare-template (point) (1- (point-max)))))
(save-excursion
(insert " ")
(company-template-add-field tpl (point) "bar"))
(company-call 'template-move-to-first tpl)
(should (= 3 (point)))
(dolist (c (string-to-list "tee"))
(let ((last-command-event c))
(company-call 'self-insert-command 1)))
(should (string= "{ tee }" (buffer-string)))
(should (overlay-buffer tpl))
(company-call 'template-forward-field)
(should (= 7 (point)))
(should (null (overlay-buffer tpl))))))
(defun company-call (name &rest args)
(let* ((maybe (intern (format "company-%s" name)))
(command (if (fboundp maybe) maybe name)))
(let ((this-command command))
(run-hooks 'pre-command-hook))
(apply command args)
(let ((this-command command))
(run-hooks 'post-command-hook))))
(ert-deftest company-template-c-like-templatify ()
(with-temp-buffer
(let ((text "foo(int a, short b)"))
(insert text)
(company-template-c-like-templatify text)
(should (equal "foo(arg0, arg1)" (buffer-string)))
(should (looking-at "arg0"))
(should (equal "int a"
(overlay-get (company-template-field-at) 'display))))))
(ert-deftest company-template-c-like-templatify-trims-after-closing-paren ()
(with-temp-buffer
(let ((text "foo(int a, short b)!@ #1334 a"))
(insert text)
(company-template-c-like-templatify text)
(should (equal "foo(arg0, arg1)" (buffer-string)))
(should (looking-at "arg0")))))
;;; Clang
(ert-deftest company-clang-objc-templatify ()
(with-temp-buffer
(let ((text "createBookWithTitle:andAuthor:"))
(insert text)
(company-clang-objc-templatify text)
(should (equal "createBookWithTitle:arg0 andAuthor:arg1" (buffer-string)))
(should (looking-at "arg0"))
(should (null (overlay-get (company-template-field-at) 'display))))))

View File

@ -0,0 +1,123 @@
;;; company-xcode.el --- company-mode completion back-end for Xcode projects
;; Copyright (C) 2009-2011 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 back-end 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)
(add-to-list 'candidates (match-string 1)))
(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 back-end 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

@ -0,0 +1,98 @@
;;; company-yasnippet.el --- company-mode completion back-end for Yasnippet
;; Copyright (C) 2014 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 'cl-lib)
(require 'yasnippet)
(defun company-yasnippet--candidates (prefix)
(mapcan
(lambda (table)
(let ((keyhash (yas--table-hash table))
res)
(when keyhash
(maphash
(lambda (key value)
(when (and (stringp key)
(string-prefix-p prefix key))
(maphash
(lambda (name template)
(push
(propertize key
'yas-annotation name
'yas-template template)
res))
value)))
keyhash))
res))
(yas--get-snippet-tables)))
;;;###autoload
(defun company-yasnippet (command &optional arg &rest ignore)
"`company-mode' back-end for `yasnippet'.
This back-end should be used with care, because as long as there are
snippets defined for the current major mode, this back-end will always
shadow back-ends that come after it. Recommended usages:
* In a buffer-local value of `company-backends', grouped with a back-end 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 back-ends.
(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 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))
(post-completion
(let ((template (get-text-property 0 'yas-template arg)))
(yas-expand-snippet (yas--template-content template)
(- (point) (length arg))
(point)
(yas--template-expand-env template))))))
(provide 'company-yasnippet)
;;; company-yasnippet.el ends here

File diff suppressed because it is too large Load Diff

36
elpa/company-readme.txt Normal file
View File

@ -0,0 +1,36 @@
Company is a modular completion mechanism. Modules for retrieving completion
candidates are called back-ends, modules for displaying them are front-ends.
Company comes with many back-ends, e.g. `company-elisp'. These are
distributed in separate files and can be used individually.
Place company.el and the back-ends you want to use in a directory and add the
following to your .emacs:
(add-to-list 'load-path "/path/to/company")
(autoload 'company-mode "company" nil t)
Enable company-mode with M-x company-mode. For further information look at
the documentation for `company-mode' (C-h f company-mode RET)
If you want to start a specific back-end, call it interactively or use
`company-begin-backend'. For example:
M-x company-abbrev will prompt for and insert an abbrev.
To write your own back-end, look at the documentation for `company-backends'.
Here is a simple example completing "foo":
(defun company-my-backend (command &optional arg &rest ignored)
(pcase command
(`prefix (when (looking-back "foo\\>")
(match-string 0)))
(`candidates (list "foobar" "foobaz" "foobarbaz"))
(`meta (format "This value is named %s" arg))))
Sometimes it is a good idea to mix several back-ends together, for example to
enrich gtags with dabbrev-code results (to emulate local variables).
To do this, add a list with both back-ends as an element in company-backends.
Known Issues:
When point is at the very end of the buffer, the pseudo-tooltip appears very
wrong, unless company is allowed to temporarily insert a fake newline.
This behavior is enabled by `company-end-of-buffer-workaround'.

View File

@ -0,0 +1,43 @@
;;; fiplr-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (fiplr-clear-cache fiplr-find-directory fiplr-find-file
;;;;;; fiplr-root) "fiplr" "fiplr.el" (21530 2995 788494 33000))
;;; Generated autoloads from fiplr.el
(autoload 'fiplr-root "fiplr" "\
Locate the root of the project by walking up the directory tree.
\(fn)" nil nil)
(autoload 'fiplr-find-file "fiplr" "\
Runs a completing prompt to find a file from the project.
\(fn)" nil nil)
(autoload 'fiplr-find-directory "fiplr" "\
Runs a completing prompt to find a directory from the project.
\(fn)" nil nil)
(autoload 'fiplr-clear-cache "fiplr" "\
Clears the internal caches used by fiplr so the project is searched again.
\(fn)" t nil)
;;;***
;;;### (autoloads nil nil ("fiplr-pkg.el") (21530 2995 927265 98000))
;;;***
(provide 'fiplr-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; fiplr-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "fiplr" "0.1.3" "Fuzzy finder for files in a project." (quote nil))

243
elpa/fiplr-0.1.3/fiplr.el Normal file
View File

@ -0,0 +1,243 @@
;;; fiplr.el --- Fuzzy finder for files in a project.
;; Copyright © 2013 Chris Corbyn
;;
;; Author: Chris Corbyn <chris@w3style.co.uk>
;; URL: https://github.com/d11wtq/fiplr
;; Version: 0.1.3
;; Keywords: convenience, usability, project
;; This file is not part of GNU Emacs.
;;; --- License
;; Licensed under the same terms as Emacs.
;;; --- Commentary
;; Overview:
;;
;; Fiplr makes it really use to find files anywhere within your entire project
;; by using a cached directory tree and delegating to ido while you search the
;; tree.
;;
;; M-x fiplr-find-file
;;
;; By default it looks through all the parent directories of the file you're
;; editing until it finds a .git, .hg, .bzr or .svn directory. You can
;; customize this list of root markers by setting `fiplr-root-markers'.
;;
;; (setq fiplr-root-markers '(".git" ".svn"))
;;
;; Some files are ignored from the directory tree because they are not text
;; files, or simply to speed up the search. The default list can be
;; customized by setting `fiplr-ignored-globs'.
;;
;; (setq fiplr-ignored-globs '((directories (".git" ".svn"))
;; (files ("*.jpg" "*.png" "*.zip" "*~"))))
;;
;; These globs are used by the UNIX `find' command's -name flag.
;;
;; Usage:
;;
;; Find files: M-x fiplr-find-file
;; Find directories: M-x fiplr-find-directory
;; Clear caches: M-x fiplr-clear-cache
;;
;; For convenience, bind "C-x f" to `fiplr-find-file':
;;
;; (global-set-key (kbd "C-x f") 'fiplr-find-file)
;;
(require 'cl)
;;; --- Package Configuration
;; A cache to avoid repeat searching.
(setq *fiplr-file-cache* '())
;; A cache to avoid repeat searching.
(setq *fiplr-directory-cache* '())
;; The default set of files/directories to look for at the root of a project.
(defvar *fiplr-default-root-markers*
'(".git" ".svn" ".hg" ".bzr"))
;; The default set of patterns to exclude from searches.
(defvar *fiplr-default-ignored-globs*
'((directories (".git" ".svn" ".hg" ".bzr"))
(files (".#*" "*.so"))))
;; Customization group declaration.
(defgroup fiplr nil
"Configuration options for fiplr - find in project.")
;; Settings for project root directories.
(defcustom fiplr-root-markers *fiplr-default-root-markers*
"A list of files or directories that are found at the root of a project."
:type '(repeat string)
:group 'fiplr
:options *fiplr-default-root-markers*)
;; Settings for files and directories that should be ignored.
(defcustom fiplr-ignored-globs *fiplr-default-ignored-globs*
"An alist of glob patterns to exclude from search results."
:type '(alist :key-type symbol :value-type (repeat string))
:group 'fiplr
:options *fiplr-default-ignored-globs*)
;;; --- Public Functions
;; Defines fiplr's determination of the project root.
;;;###autoload
(defun fiplr-root ()
"Locate the root of the project by walking up the directory tree."
"The first directory containing one of fiplr-root-markers is the root."
"If no root marker is found, the current working directory is used."
(let ((cwd (if (buffer-file-name)
(directory-file-name
(file-name-directory (buffer-file-name)))
(file-truename "."))))
(or (fiplr-find-root cwd fiplr-root-markers)
cwd)))
;; Locate a file in the current project.
;;;###autoload
(defun fiplr-find-file ()
"Runs a completing prompt to find a file from the project."
"The root of the project is the return value of `fiplr-root'."
(interactive)
(fiplr-find-file-in-directory (fiplr-root) fiplr-ignored-globs))
;; Locate a directory in the current project.
;;;###autoload
(defun fiplr-find-directory ()
"Runs a completing prompt to find a directory from the project."
"The root of the project is the return value of `fiplr-root'."
(interactive)
(fiplr-find-directory-in-directory (fiplr-root) fiplr-ignored-globs))
;; Clear the caches.
;;;###autoload
(defun fiplr-clear-cache ()
"Clears the internal caches used by fiplr so the project is searched again."
(interactive)
(setq *fiplr-file-cache* '())
(setq *fiplr-directory-cache* '()))
;;; --- Private Functions
;; Search algorithm to find dir with .git etc.
(defun fiplr-find-root (path root-markers)
"Tail-recursive part of project-root."
(let* ((this-dir (file-name-as-directory (file-truename path)))
(parent-dir (expand-file-name (concat this-dir "..")))
(system-root-dir (expand-file-name "/")))
(cond
((fiplr-root-p path root-markers) this-dir)
((equal system-root-dir this-dir) nil)
(t (fiplr-find-root parent-dir root-markers)))))
;; Predicate looking at path for a root marker.
(defun fiplr-root-p (path root-markers)
"Predicate to check if the given directory is a project root."
(let ((dir (file-name-as-directory path)))
(cl-member-if (lambda (marker)
(file-exists-p (concat dir marker)))
root-markers)))
;; Builds a gigantic `find' shell command with -prune, -o, -not and shit.
(defun fiplr-list-files-shell-command (type path ignored-globs)
"Builds the `find' command to locate all project files & directories."
"Path is the base directory to recurse from."
"Ignored-globs is an alist with keys 'directories and 'files."
(let* ((type-abbrev
(lambda (assoc-type)
(cl-case assoc-type
('directories "d")
('files "f"))))
(name-matcher
(lambda (glob)
(mapconcat 'identity
`("-name" ,(shell-quote-argument glob))
" ")))
(grouped-name-matchers
(lambda (type)
(mapconcat 'identity
`(,(shell-quote-argument "(")
,(mapconcat (lambda (v) (funcall name-matcher v))
(cadr (assoc type ignored-globs))
" -o ")
,(shell-quote-argument ")"))
" ")))
(matcher
(lambda (assoc-type)
(mapconcat 'identity
`(,(shell-quote-argument "(")
"-type"
,(funcall type-abbrev assoc-type)
,(funcall grouped-name-matchers assoc-type)
,(shell-quote-argument ")"))
" "))))
(mapconcat 'identity
`("find"
,(shell-quote-argument (directory-file-name path))
,(funcall matcher 'directories)
"-prune"
"-o"
"-not"
,(funcall matcher 'files)
"-type"
,(funcall type-abbrev type)
"-print")
" ")))
;; List all files found under the given path, ignoring ignored-globs.
(defun fiplr-list-files (type path ignored-globs)
"Expands to a flat list of files/directories found under path."
"The first parameter - type - is the symbol 'directories or 'files."
(let* ((prefix (file-name-as-directory (file-truename path)))
(prefix-length (length prefix))
(list-string
(shell-command-to-string (fiplr-list-files-shell-command
type
prefix
ignored-globs))))
(reverse (reduce (lambda (acc file)
(if (> (length file) prefix-length)
(cons (substring file prefix-length) acc)
acc))
(split-string list-string "[\r\n]+" t)
:initial-value '()))))
;; Runs the find file prompt for the specified path.
(defun fiplr-find-file-in-directory (path ignored-globs)
"Locate a file under the specified directory."
"If the directory has been searched previously, the cache is used."
(let ((root-dir (file-name-as-directory path)))
(unless (assoc root-dir *fiplr-file-cache*)
(push (cons root-dir (fiplr-list-files 'files root-dir ignored-globs))
*fiplr-file-cache*))
(let* ((project-files (cdr (assoc root-dir *fiplr-file-cache*)))
(prompt "Find project file: ")
(file (ido-completing-read prompt project-files)))
(find-file (concat root-dir file)))))
;; Runs the find directory prompt for the specified path.
(defun fiplr-find-directory-in-directory (path ignored-globs)
"Locate a directory under the specified directory."
"If the directory has been searched previously, the cache is used."
(let ((root-dir (file-name-as-directory path)))
(unless (assoc root-dir *fiplr-directory-cache*)
(push (cons root-dir (fiplr-list-files 'directories root-dir ignored-globs))
*fiplr-directory-cache*))
(let* ((project-dirs (cdr (assoc root-dir *fiplr-directory-cache*)))
(prompt "Find project directory: ")
(dirname (ido-completing-read prompt project-dirs)))
(condition-case nil
(dired (concat root-dir dirname))
(error (message (concat "Cannot open directory: " dirname)))))))
(provide 'fiplr)
;;; fiplr.el ends here

View File

@ -0,0 +1,85 @@
;;; grizzl-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (grizzl-result-strings grizzl-result-count grizzl-search
;;;;;; grizzl-make-index) "grizzl-core" "grizzl-core.el" (21530
;;;;;; 3273 796740 656000))
;;; Generated autoloads from grizzl-core.el
(autoload 'grizzl-make-index "grizzl-core" "\
Makes an index from the list STRINGS for use with `grizzl-search'.
If :PROGRESS-FN is given as a keyword argument, it is called repeatedly
with integers N and TOTAL.
If :CASE-SENSITIVE is specified as a non-nil keyword argument, the index
will be created case-sensitive, otherwise it will be case-insensitive.
\(fn STRINGS &rest OPTIONS)" nil nil)
(autoload 'grizzl-search "grizzl-core" "\
Fuzzy searches for TERM in INDEX prepared with `grizzl-make-index'.
OLD-RESULT may be specified as an existing search result to increment from.
The result can be read with `grizzl-result-strings'.
\(fn TERM INDEX &optional OLD-RESULT)" nil nil)
(autoload 'grizzl-result-count "grizzl-core" "\
Returns the number of matches present in RESULT.
\(fn RESULT)" nil nil)
(autoload 'grizzl-result-strings "grizzl-core" "\
Returns the ordered list of matched strings in RESULT, using INDEX.
If the :START option is specified, results are read from the given offset.
If the :END option is specified, up to :END results are returned.
\(fn RESULT INDEX &rest OPTIONS)" nil nil)
;;;***
;;;### (autoloads (grizzl-set-selection-1 grizzl-set-selection+1
;;;;;; grizzl-selected-result grizzl-completing-read) "grizzl-read"
;;;;;; "grizzl-read.el" (21530 3273 902738 462000))
;;; Generated autoloads from grizzl-read.el
(autoload 'grizzl-completing-read "grizzl-read" "\
Performs a completing-read in the minibuffer using INDEX to fuzzy search.
Each key pressed in the minibuffer filters down the list of matches.
\(fn PROMPT INDEX)" nil nil)
(autoload 'grizzl-selected-result "grizzl-read" "\
Get the selected string from INDEX in a `grizzl-completing-read'.
\(fn INDEX)" nil nil)
(autoload 'grizzl-set-selection+1 "grizzl-read" "\
Move the selection up one row in `grizzl-completing-read'.
\(fn)" t nil)
(autoload 'grizzl-set-selection-1 "grizzl-read" "\
Move the selection down one row in `grizzl-completing-read'.
\(fn)" t nil)
;;;***
;;;### (autoloads nil nil ("grizzl-pkg.el" "grizzl.el") (21530 3273
;;;;;; 979764 956000))
;;;***
(provide 'grizzl-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; grizzl-autoloads.el ends here

View File

@ -0,0 +1,226 @@
;;; grizzl-core.el --- Fast fuzzy search index for Emacs.
;; Copyright © 2013 Chris Corbyn
;;
;; Author: Chris Corbyn <chris@w3style.co.uk>
;; URL: https://github.com/d11wtq/grizzl
;; Version: 0.1.1
;; Keywords: convenience, usability
;; This file is NOT part of GNU Emacs.
;;; --- License
;; Licensed under the same terms as Emacs.
;;; --- Commentary
;; Grizzl provides a fuzzy completion framework for general purpose
;; use in Emacs Lisp projects.
;;
;; grizzl-core.el provides the underlying data structures and sesrch
;; algorithm without any UI attachment. At the core, a fuzzy search
;; index is created from a list of strings, using `grizzl-make-index'.
;; A fuzzy search term is then used to get a result from this index
;; with `grizzl-search'. Because grizzl considers the usage of a
;; fuzzy search index to operate in real-time as a user enters a
;; search term in the minibuffer, the framework optimizes for this use
;; case. Any result can be passed back into `grizzl-search' as a hint
;; to continue searching. The search algorithm is able to understand
;; insertions and deletions and therefore minimizes the work it needs
;; to do in this case. The intended use here is to collect a result
;; on each key press and feed that result into the search for the next
;; key press. Once a search is complete, the matched strings are then
;; read, using `grizzl-result-strings'. The results are ordered on the
;; a combination of the Levenshtein Distance and a character-proximity
;; scoring calculation. This means shorter strings are favoured, but
;; adjacent letters are more heavily favoured.
;;
;; It is assumed that the index will be re-used across multiple
;; searches on larger sets of data.
;;
;;
(eval-when-compile
(require 'cl-lib))
;;; --- Public Functions
;;;###autoload
(defun grizzl-make-index (strings &rest options)
"Makes an index from the list STRINGS for use with `grizzl-search'.
If :PROGRESS-FN is given as a keyword argument, it is called repeatedly
with integers N and TOTAL.
If :CASE-SENSITIVE is specified as a non-nil keyword argument, the index
will be created case-sensitive, otherwise it will be case-insensitive."
(let ((lookup-table (make-hash-table))
(total-strs (length strings))
(case-sensitive (plist-get options :case-sensitive))
(progress-fn (plist-get options :progress-fn))
(string-data (vconcat (mapcar (lambda (s)
(cons s (length s)))
strings))))
(reduce (lambda (list-offset str)
(grizzl-index-insert str list-offset lookup-table
:case-sensitive case-sensitive)
(when progress-fn
(funcall progress-fn (1+ list-offset) total-strs))
(1+ list-offset))
strings
:initial-value 0)
(maphash (lambda (char str-map)
(maphash (lambda (list-offset locations)
(puthash list-offset (reverse locations) str-map))
str-map)) lookup-table)
`((case-sensitive . ,case-sensitive)
(lookup-table . ,lookup-table)
(string-data . ,string-data))))
;;;###autoload
(defun grizzl-search (term index &optional old-result)
"Fuzzy searches for TERM in INDEX prepared with `grizzl-make-index'.
OLD-RESULT may be specified as an existing search result to increment from.
The result can be read with `grizzl-result-strings'."
(let* ((cased-term (if (grizzl-index-case-sensitive-p index)
term
(downcase term)))
(result (grizzl-rewind-result cased-term index old-result))
(matches (copy-hash-table (grizzl-result-matches result)))
(from-pos (length (grizzl-result-term result)))
(remainder (substring cased-term from-pos))
(lookup-table (grizzl-lookup-table index)))
(reduce (lambda (acc-res ch)
(let ((sub-table (gethash ch lookup-table)))
(if (not sub-table)
(clrhash matches)
(grizzl-search-increment sub-table matches))
(grizzl-cons-result cased-term matches acc-res)))
remainder
:initial-value result)))
;;;###autoload
(defun grizzl-result-count (result)
"Returns the number of matches present in RESULT."
(hash-table-count (grizzl-result-matches result)))
;;;###autoload
(defun grizzl-result-strings (result index &rest options)
"Returns the ordered list of matched strings in RESULT, using INDEX.
If the :START option is specified, results are read from the given offset.
If the :END option is specified, up to :END results are returned."
(let* ((matches (grizzl-result-matches result))
(strings (grizzl-index-strings index))
(loaded '())
(start (plist-get options :start))
(end (plist-get options :end)))
(maphash (lambda (string-offset char-offset)
(push string-offset loaded))
matches)
(let* ((ordered (sort loaded
(lambda (a b)
(< (cadr (gethash a matches))
(cadr (gethash b matches))))))
(best (if (or start end)
(delete-if-not 'identity
(subseq ordered (or start 0) end))
ordered)))
(mapcar (lambda (n)
(car (elt strings n)))
best))))
;;; --- Private Functions
(defun grizzl-cons-result (term matches results)
"Build a new result for TERM and hash-table MATCHES consed with RESULTS."
(cons (cons term matches) results))
(defun grizzl-rewind-result (term index result)
"Adjusts RESULT according to TERM, ready for a new search."
(if result
(let* ((old-term (grizzl-result-term result))
(new-len (length term))
(old-len (length old-term)))
(if (and (>= new-len old-len)
(string-equal old-term (substring term 0 old-len)))
result
(grizzl-rewind-result term index (cdr result))))
(grizzl-cons-result "" (grizzl-base-matches index) nil)))
(defun grizzl-base-matches (index)
"Returns the full set of matches in INDEX, with an out-of-bound offset."
(let ((matches (make-hash-table)))
(reduce (lambda (n s-len)
(puthash n (list -1 0 (cdr s-len)) matches)
(1+ n))
(grizzl-index-strings index)
:initial-value 0)
matches))
(defun grizzl-result-term (result)
"Returns the search term used to find the matches in RESULT."
(car (car result)))
(defun grizzl-result-matches (result)
"Returns the internal hash used to track the matches in RESULT."
(cdar result))
(defun grizzl-index-insert (string list-offset index &rest options)
"Inserts STRING at LIST-OFFSET into INDEX."
(let ((case-sensitive (plist-get options :case-sensitive)))
(reduce (lambda (char-offset cs-char)
(let* ((char (if case-sensitive
cs-char
(downcase cs-char)))
(str-map (or (gethash char index)
(puthash char (make-hash-table) index)))
(offsets (gethash list-offset str-map)))
(puthash list-offset
(cons char-offset offsets)
str-map)
(1+ char-offset)))
string
:initial-value 0)))
(defun grizzl-lookup-table (index)
"Returns the lookup table portion of INDEX."
(cdr (assoc 'lookup-table index)))
(defun grizzl-index-strings (index)
"Returns the vector of strings stored in INDEX."
(cdr (assoc 'string-data index)))
(defun grizzl-index-case-sensitive-p (index)
"Predicate to test of INDEX is case-sensitive."
(cdr (assoc 'case-sensitive index)))
(defun grizzl-search-increment (sub-table result)
"Use the search lookup table to filter already-accumulated results."
(cl-flet ((next-offset (key current sub-table)
(find-if (lambda (v)
(> v current))
(gethash key sub-table))))
(maphash (lambda (k v)
(let* ((oldpos (car v))
(oldrank (cadr v))
(len (caddr v))
(newpos (next-offset k oldpos sub-table)))
(if newpos
(puthash k (list newpos
(grizzl-inc-rank oldrank oldpos newpos len)
len)
result)
(remhash k result))))
result)))
(defun grizzl-inc-rank (oldrank oldpos newpos len)
"Increment the current match distance as a new char is matched."
(let ((distance (if (< oldpos 0) 1 (- newpos oldpos))))
(+ oldrank (* len (* distance distance)))))
(provide 'grizzl-core)
;;; grizzl-core.el ends here

View File

@ -0,0 +1,3 @@
(define-package "grizzl" "0.1.1"
"Fuzzy Search Library & Completing Read"
'((cl-lib "0.1")))

View File

@ -0,0 +1,186 @@
;;; grizzl-read.el --- A fuzzy completing-read backed by grizzl.
;; Copyright © 2013 Chris Corbyn
;;
;; Author: Chris Corbyn <chris@w3style.co.uk>
;; URL: https://github.com/d11wtq/grizzl
;; Version: 0.1.1
;; Keywords: convenience, usability
;; This file is NOT part of GNU Emacs.
;;; --- License
;; Licensed under the same terms as Emacs.
;;; --- Commentary
;; grizzl-read.el provides an implementation of the built-in Emacs
;; completing-read function, except it is backed by the grizzl fuzzy
;; search index. The goals are similar to ido-mode and helm, but grizzl
;; is heavily optimized for large data-sets, and as-such uses a
;; persistent fuzzy search index in its algorithm.
;;
;; The indexing and searching algorithm itself is defined in grizzl-core.el
;; with grizzl-read.el simply wrapping the search in a minibuffer with a
;; minor-mode defined.
;;
;; ---- Usage
;;
;; Call `grizzl-completing-read' with an index returned by
;; `grizzl-make-index':
;;
;; (defvar *index* (grizzl-make-index '("one" "two" "three")))
;; (grizzl-completing-read "Number: " index)
;;
;; When the user hits ENTER, either one of the strings is returned on
;; success, or nil of nothing matched.
;;
;; The arrow keys can be used to navigate within the results.
;;
(eval-when-compile
(require 'cl-lib))
;;; --- Configuration Variables
(defvar *grizzl-read-max-results* 10
"The maximum number of results to show in `grizzl-completing-read'.")
;;; --- Runtime Processing Variables
(defvar *grizzl-current-result* nil
"The search result in `grizzl-completing-read'.")
(defvar *grizzl-current-selection* 0
"The selected offset in `grizzl-completing-read'.")
;;; --- Minor Mode Definition
(defvar *grizzl-keymap* (make-sparse-keymap)
"Internal keymap used by the minor-mode in `grizzl-completing-read'.")
(define-key *grizzl-keymap* (kbd "<up>") 'grizzl-set-selection+1)
(define-key *grizzl-keymap* (kbd "C-p") 'grizzl-set-selection+1)
(define-key *grizzl-keymap* (kbd "<down>") 'grizzl-set-selection-1)
(define-key *grizzl-keymap* (kbd "C-n") 'grizzl-set-selection-1)
(define-minor-mode grizzl-mode
"Toggle the internal mode used by `grizzl-completing-read'."
nil
" Grizzl"
*grizzl-keymap*)
;;; --- Public Functions
;;;###autoload
(defun grizzl-completing-read (prompt index)
"Performs a completing-read in the minibuffer using INDEX to fuzzy search.
Each key pressed in the minibuffer filters down the list of matches."
(minibuffer-with-setup-hook
(lambda ()
(setq *grizzl-current-result* nil)
(setq *grizzl-current-selection* 0)
(grizzl-mode 1)
(lexical-let*
((hookfun (lambda ()
(setq *grizzl-current-result*
(grizzl-search (minibuffer-contents)
index
*grizzl-current-result*))
(grizzl-display-result index prompt)))
(exitfun (lambda ()
(grizzl-mode -1)
(remove-hook 'post-command-hook hookfun t))))
(add-hook 'minibuffer-exit-hook exitfun nil t)
(add-hook 'post-command-hook hookfun nil t)))
(read-from-minibuffer ">>> ")
(grizzl-selected-result index)))
;;;###autoload
(defun grizzl-selected-result (index)
"Get the selected string from INDEX in a `grizzl-completing-read'."
(elt (grizzl-result-strings *grizzl-current-result* index
:start 0
:end *grizzl-read-max-results*)
(grizzl-current-selection)))
;;;###autoload
(defun grizzl-set-selection+1 ()
"Move the selection up one row in `grizzl-completing-read'."
(interactive)
(grizzl-move-selection 1))
;;;###autoload
(defun grizzl-set-selection-1 ()
"Move the selection down one row in `grizzl-completing-read'."
(interactive)
(grizzl-move-selection -1))
;;; --- Private Functions
(defun grizzl-move-selection (delta)
"Move the selection by DELTA rows in `grizzl-completing-read'."
(setq *grizzl-current-selection* (+ (grizzl-current-selection) delta))
(when (not (= (grizzl-current-selection) *grizzl-current-selection*))
(beep)))
(defun grizzl-display-result (index prompt)
"Renders a series of overlays to list the matches in the result."
(let* ((matches (grizzl-result-strings *grizzl-current-result* index
:start 0
:end *grizzl-read-max-results*)))
(delete-all-overlays)
(overlay-put (make-overlay (point-min) (point-min))
'before-string
(format "%s\n%s\n"
(mapconcat 'identity
(grizzl-map-format-matches matches)
"\n")
(grizzl-format-prompt-line prompt)))
(set-window-text-height nil (max 3 (+ 2 (length matches))))))
(defun grizzl-map-format-matches (matches)
"Convert the set of string MATCHES into propertized text objects."
(if (= 0 (length matches))
(list (propertize "-- NO MATCH --" 'face 'outline-3))
(cdr (reduce (lambda (acc str)
(let* ((idx (car acc))
(lst (cdr acc))
(sel (= idx (grizzl-current-selection))))
(cons (1+ idx)
(cons (grizzl-format-match str sel) lst))))
matches
:initial-value '(0)))))
(defun grizzl-format-match (match-str selected)
"Default match string formatter in `grizzl-completing-read'.
MATCH-STR is the string in the selection list and SELECTED is non-nil
if this is the current selection."
(let ((margin (if selected "> " " "))
(face (if selected 'diredp-symlink 'default)))
(propertize (format "%s%s" margin match-str) 'face face)))
(defun grizzl-format-prompt-line (prompt)
"Returns a string to render a full-width prompt in `grizzl-completing-read'."
(let* ((count (grizzl-result-count *grizzl-current-result*))
(match-info (format " (%d candidate%s) ---- *-"
count (if (= count 1) "" "s"))))
(concat (propertize (format "-*%s *-" prompt) 'face 'modeline-inactive)
(propertize " "
'face 'modeline-inactive
'display `(space :align-to (- right
,(1+ (length match-info)))))
(propertize match-info 'face 'modeline-inactive))))
(defun grizzl-current-selection ()
"Get the currently selected index in `grizzl-completing-read'."
(let ((max-selection
(min (1- *grizzl-read-max-results*)
(1- (grizzl-result-count *grizzl-current-result*)))))
(max 0 (min max-selection *grizzl-current-selection*))))
(provide 'grizzl-read)
;;; grizzl-read.el ends here

View File

@ -0,0 +1,26 @@
;;; grizzl.el --- Fast fuzzy search index for Emacs.
;; Copyright © 2013 Chris Corbyn
;;
;; Author: Chris Corbyn <chris@w3style.co.uk>
;; URL: https://github.com/d11wtq/grizzl
;; Version: 0.1.1
;; Keywords: convenience, usability
;; This file is NOT part of GNU Emacs.
;;; --- License
;; Licensed under the same terms as Emacs.
;;; --- Commentary
;; This package is broken into separate files.
;;
(require 'grizzl-core)
(require 'grizzl-read)
(provide 'grizzl)
;;; grizzl.el ends here

View File

@ -0,0 +1,33 @@
;;; haml-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (haml-mode) "haml-mode" "haml-mode.el" (21553 16292
;;;;;; 429141 493000))
;;; Generated autoloads from haml-mode.el
(autoload 'haml-mode "haml-mode" "\
Major mode for editing Haml files.
\\{haml-mode-map}
\(fn)" t nil)
(add-to-list 'auto-mode-alist '("\\.haml\\'" . haml-mode))
;;;***
;;;### (autoloads nil nil ("haml-mode-pkg.el") (21553 16292 546790
;;;;;; 825000))
;;;***
(provide 'haml-mode-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; haml-mode-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "haml-mode" "3.1.5" "Major mode for editing Haml files" (quote ((ruby-mode "1.0"))))

View File

@ -0,0 +1,888 @@
;;; haml-mode.el --- Major mode for editing Haml files
;; Copyright (c) 2007, 2008 Nathan Weizenbaum
;; Author: Nathan Weizenbaum
;; URL: http://github.com/nex3/haml/tree/master
;; Package-Requires: ((ruby-mode "1.0"))
;; Version: 3.1.5
;; Created: 2007-03-08
;; By: Nathan Weizenbaum
;; Keywords: markup, language, html
;;; Commentary:
;; Because Haml's indentation schema is similar
;; to that of YAML and Python, many indentation-related
;; functions are similar to those in yaml-mode and python-mode.
;; To install, save this on your load path and add the following to
;; your .emacs file:
;;
;; (require 'haml-mode)
;;; Code:
(eval-when-compile (require 'cl))
(require 'ruby-mode)
;; Additional (optional) libraries for fontification
(require 'css-mode nil t)
(require 'textile-mode nil t)
(require 'markdown-mode nil t)
(or
(require 'js nil t)
(require 'javascript-mode "javascript" t))
;; User definable variables
(defgroup haml nil
"Support for the Haml template language."
:group 'languages
:prefix "haml-")
(defcustom haml-mode-hook nil
"Hook run when entering Haml mode."
:type 'hook
:group 'haml)
(defcustom haml-indent-offset 2
"Amount of offset per level of indentation."
:type 'integer
:group 'haml)
(defcustom haml-backspace-backdents-nesting t
"Non-nil to have `haml-electric-backspace' re-indent blocks of code.
This means that all code nested beneath the backspaced line is
re-indented along with the line itself."
:type 'boolean
:group 'haml)
(defvar haml-indent-function 'haml-indent-p
"A function for checking if nesting is allowed.
This function should look at the current line and return t
if the next line could be nested within this line.
The function can also return a positive integer to indicate
a specific level to which the current line could be indented.")
(defconst haml-tag-beg-re
"^[ \t]*\\([%\\.#][a-z0-9_:\\-]+\\)+\\(?:(.*)\\|{.*}\\|\\[.*\\]\\)*"
"A regexp matching the beginning of a Haml tag, through (), {}, and [].")
(defvar haml-block-openers
`(,(concat haml-tag-beg-re "[><]*[ \t]*$")
"^[ \t]*[&!]?[-=~].*do[ \t]*\\(|.*|[ \t]*\\)?$"
,(concat "^[ \t]*[&!]?[-=~][ \t]*\\("
(regexp-opt '("if" "unless" "while" "until" "else" "for"
"begin" "elsif" "rescue" "ensure" "when"))
"\\)")
"^[ \t]*/\\(\\[.*\\]\\)?[ \t]*$"
"^[ \t]*-#"
"^[ \t]*:")
"A list of regexps that match lines of Haml that open blocks.
That is, a Haml line that can have text nested beneath it should
be matched by a regexp in this list.")
;; Font lock
(defun haml-nested-regexp (re)
"Create a regexp to match a block starting with RE.
The line containing RE is matched, as well as all lines indented beneath it."
(concat "^\\([ \t]*\\)\\(" re "\\)\\([ \t]*\\(?:\n\\(?:\\1 +[^\n]*\\)?\\)*\n?\\)$"))
(defconst haml-font-lock-keywords
`((haml-highlight-interpolation 1 font-lock-variable-name-face prepend)
(haml-highlight-ruby-tag 1 font-lock-preprocessor-face)
(haml-highlight-ruby-script 1 font-lock-preprocessor-face)
;; TODO: distinguish between "/" comments, which can contain HAML
;; output directives, and "-#", which are completely ignored
haml-highlight-comment
haml-highlight-filter
("^!!!.*" 0 font-lock-constant-face)
("\\s| *$" 0 font-lock-string-face)))
(defconst haml-filter-re (haml-nested-regexp ":\\w+"))
(defconst haml-comment-re (haml-nested-regexp "\\(?:-\\#\\|/\\)[^\n]*"))
(defun haml-highlight-comment (limit)
"Highlight any -# or / comment found up to LIMIT."
(when (re-search-forward haml-comment-re limit t)
(let ((beg (match-beginning 0))
(end (match-end 0)))
(put-text-property beg end 'face 'font-lock-comment-face)
(goto-char end))))
;; Fontifying sub-regions for other languages
(defun haml-fontify-region
(beg end keywords syntax-table syntactic-keywords syntax-propertize-fn)
"Fontify a region between BEG and END using another mode's fontification.
KEYWORDS, SYNTAX-TABLE, SYNTACTIC-KEYWORDS and
SYNTAX-PROPERTIZE-FN are the values of that mode's
`font-lock-keywords', `font-lock-syntax-table',
`font-lock-syntactic-keywords', and `syntax-propertize-function'
respectively."
(save-excursion
(save-match-data
(let ((font-lock-keywords keywords)
(font-lock-syntax-table syntax-table)
(font-lock-syntactic-keywords syntactic-keywords)
(syntax-propertize-function syntax-propertize-fn)
(font-lock-multiline 'undecided)
(font-lock-dont-widen t)
font-lock-keywords-only
font-lock-extend-region-functions
font-lock-keywords-case-fold-search)
(save-restriction
(narrow-to-region (1- beg) end)
;; font-lock-fontify-region apparently isn't inclusive,
;; so we have to move the beginning back one char
(font-lock-fontify-region (1- beg) end))))))
(defun haml-fontify-region-as-ruby (beg end)
"Use Ruby's font-lock variables to fontify the region between BEG and END."
(haml-fontify-region beg end ruby-font-lock-keywords
ruby-font-lock-syntax-table
(when (boundp 'ruby-font-lock-syntactic-keywords)
ruby-font-lock-syntactic-keywords)
(when (fboundp 'ruby-syntax-propertize-function)
#'ruby-syntax-propertize-function)))
(defun haml-fontify-region-as-css (beg end)
"Fontify CSS code from BEG to END.
This requires that `css-mode' is available.
`css-mode' is included with Emacs 23."
(when (boundp 'css-font-lock-keywords)
(haml-fontify-region beg end
css-font-lock-keywords
css-mode-syntax-table
nil
nil)))
(defun haml-fontify-region-as-javascript (beg end)
"Fontify javascript code from BEG to END.
This requires that Karl Landström's javascript mode be available, either as the
\"js.el\" bundled with Emacs >= 23, or as \"javascript.el\" found in ELPA and
elsewhere."
(let ((keywords (or (and (featurep 'js) js--font-lock-keywords-3)
(and (featurep 'javascript-mode) js-font-lock-keywords-3)))
(syntax-table (or (and (featurep 'js) js-mode-syntax-table)
(and (featurep 'javascript-mode) javascript-mode-syntax-table)))
(syntax-propertize (and (featurep 'js) 'js-syntax-propertize)))
(when keywords
(when (and (fboundp 'js--update-quick-match-re) (null js--quick-match-re-func))
(js--update-quick-match-re))
(haml-fontify-region beg end keywords syntax-table nil syntax-propertize))))
(defun haml-fontify-region-as-textile (beg end)
"Highlight textile from BEG to END.
This requires that `textile-mode' be available.
Note that the results are not perfect, since `textile-mode' expects
certain constructs such as \"h1.\" to be at the beginning of a line,
and indented Haml filters always have leading whitespace."
(if (boundp 'textile-font-lock-keywords)
(haml-fontify-region beg end textile-font-lock-keywords nil nil nil)))
(defun haml-fontify-region-as-markdown (beg end)
"Highlight markdown from BEG to END.
This requires that `markdown-mode' be available."
(if (boundp 'markdown-mode-font-lock-keywords)
(haml-fontify-region beg end
markdown-mode-font-lock-keywords
markdown-mode-syntax-table
nil
nil)))
(defvar haml-fontify-filter-functions-alist
'(("ruby" . haml-fontify-region-as-ruby)
("css" . haml-fontify-region-as-css)
("javascript" . haml-fontify-region-as-javascript)
("textile" . haml-fontify-region-as-textile)
("markdown" . haml-fontify-region-as-markdown))
"An alist of (FILTER-NAME . FUNCTION) used to fontify code regions.
FILTER-NAME is a string and FUNCTION is a function which will be
used to fontify the filter's indented code region. FUNCTION will
be passed the extents of that region in two arguments BEG and
END.")
(defun haml-highlight-filter (limit)
"Highlight any :filter region found in the text up to LIMIT."
(when (re-search-forward haml-filter-re limit t)
;; fontify the filter name
(put-text-property (match-beginning 2) (1+ (match-end 2))
'face font-lock-preprocessor-face)
(let ((filter-name (substring (match-string 2) 1))
(code-start (1+ (match-beginning 3)))
(code-end (match-end 3)))
(save-match-data
(funcall (or (cdr (assoc filter-name haml-fontify-filter-functions-alist))
#'(lambda (beg end)
(put-text-property beg end
'face
'font-lock-string-face)))
code-start code-end))
(goto-char (match-end 0)))))
(defconst haml-possibly-multiline-code-re
"\\(\\(?:.*?,[ \t]*\n\\)*.*\\)"
"Regexp to match trailing ruby code which may continue onto subsequent lines.")
(defconst haml-ruby-script-re
(concat "^[ \t]*\\(-\\|[&!]?[=~]\\) " haml-possibly-multiline-code-re)
"Regexp to match -, = or ~ blocks and any continued code lines.")
(defun haml-highlight-ruby-script (limit)
"Highlight a Ruby script expression (-, =, or ~).
LIMIT works as it does in `re-search-forward'."
(when (re-search-forward haml-ruby-script-re limit t)
(haml-fontify-region-as-ruby (match-beginning 2) (match-end 2))))
(defun haml-move (re)
"Try matching and moving to the end of regular expression RE.
Returns non-nil if the expression was sucessfully matched."
(when (looking-at re)
(goto-char (match-end 0))
t))
(defun haml-highlight-ruby-tag (limit)
"Highlight Ruby code within a Haml tag.
LIMIT works as it does in `re-search-forward'.
This highlights the tag attributes and object refs of the tag,
as well as the script expression (-, =, or ~) following the tag.
For example, this will highlight all of the following:
%p{:foo => 'bar'}
%p[@bar]
%p= 'baz'
%p{:foo => 'bar'}[@bar]= 'baz'"
(when (re-search-forward "^[ \t]*[%.#]" limit t)
(forward-char -1)
;; Highlight tag, classes, and ids
(while (haml-move "\\([.#%]\\)[a-z0-9_:\\-]*")
(put-text-property (match-beginning 0) (match-end 0) 'face
(case (char-after (match-beginning 1))
(?% font-lock-keyword-face)
(?# font-lock-function-name-face)
(?. font-lock-variable-name-face))))
(block loop
(while t
(let ((eol (save-excursion (end-of-line) (point))))
(case (char-after)
;; Highlight obj refs
(?\[
(forward-char 1)
(let ((beg (point)))
(haml-limited-forward-sexp eol)
(haml-fontify-region-as-ruby beg (point))))
;; Highlight new attr hashes
(?\(
(forward-char 1)
(while
(and (haml-parse-new-attr-hash
(lambda (type beg end)
(case type
(name (put-text-property beg end
'face
font-lock-constant-face))
(value (haml-fontify-region-as-ruby beg end)))))
(not (eobp)))
(forward-line 1)
(beginning-of-line)))
;; Highlight old attr hashes
(?\{
(let ((beg (point)))
(haml-limited-forward-sexp eol)
;; Check for multiline
(while (and (eolp) (eq (char-before) ?,) (not (eobp)))
(forward-line)
(let ((eol (save-excursion (end-of-line) (point))))
;; If no sexps are closed,
;; we're still continuing a multiline hash
(if (>= (car (parse-partial-sexp (point) eol)) 0)
(end-of-line)
;; If sexps have been closed,
;; set the point at the end of the total sexp
(goto-char beg)
(haml-limited-forward-sexp eol))))
(haml-fontify-region-as-ruby (1+ beg) (point))))
(t (return-from loop))))))
;; Move past end chars
(haml-move "[<>&!]+")
;; Highlight script
(if (looking-at (concat "\\([=~]\\) " haml-possibly-multiline-code-re))
(haml-fontify-region-as-ruby (match-beginning 2) (match-end 2))
;; Give font-lock something to highlight
(forward-char -1)
(looking-at "\\(\\)"))
t))
(defun haml-highlight-interpolation (limit)
"Highlight Ruby interpolation (#{foo}).
LIMIT works as it does in `re-search-forward'."
(when (re-search-forward "\\(#{\\)" limit t)
(save-match-data
(forward-char -1)
(let ((beg (point)))
(haml-limited-forward-sexp limit)
(haml-fontify-region-as-ruby (1+ beg) (point)))
(when (eq (char-before) ?\})
(put-text-property (1- (point)) (point)
'face font-lock-variable-name-face))
t)))
(defun haml-limited-forward-sexp (limit &optional arg)
"Move forward using `forward-sexp' or to LIMIT, whichever comes first.
With ARG, do it that many times."
(let (forward-sexp-function)
(condition-case err
(save-restriction
(narrow-to-region (point) limit)
(forward-sexp arg))
(scan-error
(unless (equal (nth 1 err) "Unbalanced parentheses")
(signal 'scan-error (cdr err)))
(goto-char limit)))))
(defun haml-find-containing-block (re)
"If point is inside a block matching RE, return (start . end) for the block."
(save-excursion
(let ((pos (point))
start end)
(beginning-of-line)
(when (and
(or (looking-at re)
(when (re-search-backward re nil t)
(looking-at re)))
(< pos (match-end 0)))
(setq start (match-beginning 0)
end (match-end 0)))
(when start
(cons start end)))))
(defun haml-maybe-extend-region (extender)
"Maybe extend the font lock region using EXTENDER.
With point at the beginning of the font lock region, EXTENDER is called.
If it returns a (START . END) pair, those positions are used to possibly
extend the font lock region."
(let ((old-beg font-lock-beg)
(old-end font-lock-end))
(save-excursion
(goto-char font-lock-beg)
(let ((new-bounds (funcall extender)))
(when new-bounds
(setq font-lock-beg (min font-lock-beg (car new-bounds))
font-lock-end (max font-lock-end (cdr new-bounds))))))
(or (/= old-beg font-lock-beg)
(/= old-end font-lock-end))))
(defun haml-extend-region-nested-below ()
"Extend the font-lock region to any subsequent indented lines."
(haml-maybe-extend-region
(lambda ()
(beginning-of-line)
(when (looking-at (haml-nested-regexp "[^ \t].*"))
(cons (match-beginning 0) (match-end 0))))))
(defun haml-extend-region-to-containing-block (re)
"Extend the font-lock region to the smallest containing block matching RE."
(haml-maybe-extend-region
(lambda ()
(haml-find-containing-block re))))
(defun haml-extend-region-filter ()
"Extend the font-lock region to an enclosing filter."
(haml-extend-region-to-containing-block haml-filter-re))
(defun haml-extend-region-comment ()
"Extend the font-lock region to an enclosing comment."
(haml-extend-region-to-containing-block haml-comment-re))
(defun haml-extend-region-ruby-script ()
"Extend the font-lock region to encompass any current -/=/~ line."
(haml-extend-region-to-containing-block haml-ruby-script-re))
(defun haml-extend-region-multiline-hashes ()
"Extend the font-lock region to encompass multiline attribute hashes."
(haml-maybe-extend-region
(lambda ()
(let ((attr-props (haml-parse-multiline-attr-hash))
multiline-end
start)
(when attr-props
(setq start (cdr (assq 'point attr-props)))
(end-of-line)
;; Move through multiline attrs
(when (eq (char-before) ?,)
(save-excursion
(while (progn (end-of-line)
(and (eq (char-before) ?,) (not (eobp))))
(forward-line))
(forward-line -1)
(end-of-line)
(setq multiline-end (point))))
(goto-char (+ (cdr (assq 'point attr-props))
(cdr (assq 'hash-indent attr-props))
-1))
(haml-limited-forward-sexp
(or multiline-end
(save-excursion (end-of-line) (point))))
(cons start (point)))))))
(defun haml-extend-region-contextual ()
"Extend the font lock region piecemeal.
The result of calling this function repeatedly until it returns
nil is that (FONT-LOCK-BEG . FONT-LOCK-END) will be the smallest
possible region in which font-locking could be affected by
changes in the initial region."
(or
(haml-extend-region-filter)
(haml-extend-region-comment)
(haml-extend-region-ruby-script)
(haml-extend-region-multiline-hashes)
(haml-extend-region-nested-below)
(font-lock-extend-region-multiline)))
;; Mode setup
(defvar haml-mode-syntax-table
(let ((table (make-syntax-table)))
(modify-syntax-entry ?: "." table)
(modify-syntax-entry ?_ "w" table)
(modify-syntax-entry ?' "\"" table)
table)
"Syntax table in use in `haml-mode' buffers.")
(defvar haml-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [backspace] 'haml-electric-backspace)
(define-key map "\C-?" 'haml-electric-backspace)
(define-key map "\C-c\C-f" 'haml-forward-sexp)
(define-key map "\C-c\C-b" 'haml-backward-sexp)
(define-key map "\C-c\C-u" 'haml-up-list)
(define-key map "\C-c\C-d" 'haml-down-list)
(define-key map "\C-c\C-k" 'haml-kill-line-and-indent)
(define-key map "\C-c\C-r" 'haml-output-region)
(define-key map "\C-c\C-l" 'haml-output-buffer)
map))
(defalias 'haml-parent-mode
(if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
;;;###autoload
(define-derived-mode haml-mode haml-parent-mode "Haml"
"Major mode for editing Haml files.
\\{haml-mode-map}"
(set-syntax-table haml-mode-syntax-table)
(setq font-lock-extend-region-functions '(haml-extend-region-contextual))
(set (make-local-variable 'jit-lock-contextually) t)
(set (make-local-variable 'font-lock-multiline) t)
(set (make-local-variable 'indent-line-function) 'haml-indent-line)
(set (make-local-variable 'indent-region-function) 'haml-indent-region)
(set (make-local-variable 'parse-sexp-lookup-properties) t)
(set (make-local-variable 'comment-start) "-#")
(setq font-lock-defaults '((haml-font-lock-keywords) t t))
(setq indent-tabs-mode nil))
;; Useful functions
(defun haml-comment-block ()
"Comment the current block of Haml code."
(interactive)
(save-excursion
(let ((indent (current-indentation)))
(back-to-indentation)
(insert "-#")
(newline)
(indent-to indent)
(beginning-of-line)
(haml-mark-sexp)
(haml-reindent-region-by haml-indent-offset))))
(defun haml-uncomment-block ()
"Uncomment the current block of Haml code."
(interactive)
(save-excursion
(beginning-of-line)
(while (not (looking-at haml-comment-re))
(haml-up-list)
(beginning-of-line))
(haml-mark-sexp)
(kill-line 1)
(haml-reindent-region-by (- haml-indent-offset))))
(defun haml-replace-region (start end)
"Replace the current block of Haml code with the HTML equivalent.
Called from a program, START and END specify the region to indent."
(interactive "r")
(save-excursion
(goto-char end)
(setq end (point-marker))
(goto-char start)
(let ((ci (current-indentation)))
(while (re-search-forward "^ +" end t)
(replace-match (make-string (- (current-indentation) ci) ? ))))
(shell-command-on-region start end "haml" "haml-output" t)))
(defun haml-output-region (start end)
"Displays the HTML output for the current block of Haml code.
Called from a program, START and END specify the region to indent."
(interactive "r")
(kill-new (buffer-substring start end))
(with-temp-buffer
(yank)
(haml-indent-region (point-min) (point-max))
(shell-command-on-region (point-min) (point-max) "haml" "haml-output")))
(defun haml-output-buffer ()
"Displays the HTML output for entire buffer."
(interactive)
(haml-output-region (point-min) (point-max)))
;; Navigation
(defun haml-forward-through-whitespace (&optional backward)
"Move the point forward through any whitespace.
The point will move forward at least one line, until it reaches
either the end of the buffer or a line with no whitespace.
If BACKWARD is non-nil, move the point backward instead."
(let ((arg (if backward -1 1))
(endp (if backward 'bobp 'eobp)))
(loop do (forward-line arg)
while (and (not (funcall endp))
(looking-at "^[ \t]*$")))))
(defun haml-at-indent-p ()
"Return non-nil if the point is before any text on the line."
(let ((opoint (point)))
(save-excursion
(back-to-indentation)
(>= (point) opoint))))
(defun haml-forward-sexp (&optional arg)
"Move forward across one nested expression.
With ARG, do it that many times. Negative arg -N means move
backward across N balanced expressions.
A sexp in Haml is defined as a line of Haml code as well as any
lines nested beneath it."
(interactive "p")
(or arg (setq arg 1))
(if (and (< arg 0) (not (haml-at-indent-p)))
(back-to-indentation)
(while (/= arg 0)
(let ((indent (current-indentation)))
(loop do (haml-forward-through-whitespace (< arg 0))
while (and (not (eobp))
(not (bobp))
(> (current-indentation) indent)))
(unless (eobp)
(back-to-indentation))
(setq arg (+ arg (if (> arg 0) -1 1)))))))
(defun haml-backward-sexp (&optional arg)
"Move backward across one nested expression.
With ARG, do it that many times. Negative arg -N means move
forward across N balanced expressions.
A sexp in Haml is defined as a line of Haml code as well as any
lines nested beneath it."
(interactive "p")
(haml-forward-sexp (if arg (- arg) -1)))
(defun haml-up-list (&optional arg)
"Move out of one level of nesting.
With ARG, do this that many times."
(interactive "p")
(or arg (setq arg 1))
(while (> arg 0)
(let ((indent (current-indentation)))
(loop do (haml-forward-through-whitespace t)
while (and (not (bobp))
(>= (current-indentation) indent)))
(setq arg (1- arg))))
(back-to-indentation))
(defun haml-down-list (&optional arg)
"Move down one level of nesting.
With ARG, do this that many times."
(interactive "p")
(or arg (setq arg 1))
(while (> arg 0)
(let ((indent (current-indentation)))
(haml-forward-through-whitespace)
(when (<= (current-indentation) indent)
(haml-forward-through-whitespace t)
(back-to-indentation)
(error "Nothing is nested beneath this line"))
(setq arg (1- arg))))
(back-to-indentation))
(defun haml-mark-sexp ()
"Mark the next Haml block."
(let ((forward-sexp-function 'haml-forward-sexp))
(mark-sexp)))
(defun haml-mark-sexp-but-not-next-line ()
"Mark the next Haml block, but not the next line.
Put the mark at the end of the last line of the sexp rather than
the first non-whitespace character of the next line."
(haml-mark-sexp)
(set-mark
(save-excursion
(goto-char (mark))
(unless (eobp)
(forward-line -1)
(end-of-line))
(point))))
;; Indentation and electric keys
(defvar haml-empty-elements
'("area" "base" "br" "col" "command" "embed" "hr" "img" "input"
"keygen" "link" "meta" "param" "source" "track" "wbr")
"A list of html elements which may not contain content.
See http://www.w3.org/TR/html-markup/syntax.html.")
(defun haml-unnestable-tag-p ()
"Return t if the current line is an empty element tag, or one with content."
(when (looking-at haml-tag-beg-re)
(save-excursion
(goto-char (match-end 0))
(or (string-match-p (concat "%" (regexp-opt haml-empty-elements) "\\b")
(match-string 1))
(progn
(when (looking-at "[{(]")
(ignore-errors (forward-sexp)))
(looking-at "\\(?:=\\|==\\| \\)[[:blank:]]*[^[:blank:]\r\n]+"))))))
(defun haml-indent-p ()
"Return t if the current line can have lines nested beneath it."
(let ((attr-props (haml-parse-multiline-attr-hash)))
(when attr-props
(return-from haml-indent-p
(if (haml-unclosed-attr-hash-p) (cdr (assq 'hash-indent attr-props))
(list (+ (cdr (assq 'indent attr-props)) haml-indent-offset) nil)))))
(unless (or (haml-unnestable-tag-p))
(loop for opener in haml-block-openers
if (looking-at opener) return t
finally return nil)))
(defun* haml-parse-multiline-attr-hash ()
"Parses a multiline attribute hash, and returns
an alist with the following keys:
INDENT is the indentation of the line beginning the hash.
HASH-INDENT is the indentation of the first character
within the attribute hash.
POINT is the character position at the beginning of the line
beginning the hash."
(save-excursion
(while t
(beginning-of-line)
(if (looking-at (concat haml-tag-beg-re "\\([{(]\\)"))
(progn
(goto-char (1- (match-end 0)))
(haml-limited-forward-sexp (save-excursion (end-of-line) (point)))
(return-from haml-parse-multiline-attr-hash
(when (or (string-equal (match-string 1) "(") (eq (char-before) ?,))
`((indent . ,(current-indentation))
(hash-indent . ,(- (match-end 0) (match-beginning 0)))
(point . ,(match-beginning 0))))))
(when (bobp) (return-from haml-parse-multiline-attr-hash))
(forward-line -1)
(unless (haml-unclosed-attr-hash-p)
(return-from haml-parse-multiline-attr-hash))))))
(defun* haml-unclosed-attr-hash-p ()
"Return t if this line has an unclosed attribute hash, new or old."
(save-excursion
(end-of-line)
(when (eq (char-before) ?,) (return-from haml-unclosed-attr-hash-p t))
(re-search-backward "(\\|^")
(haml-move "(")
(haml-parse-new-attr-hash)))
(defun* haml-parse-new-attr-hash (&optional (fn (lambda (type beg end) ())))
"Parse a new-style attribute hash on this line, and returns
t if it's not finished on the current line.
FN should take three parameters: TYPE, BEG, and END.
TYPE is the type of text parsed ('name or 'value)
and BEG and END delimit that text in the buffer."
(let ((eol (save-excursion (end-of-line) (point))))
(while (not (haml-move ")"))
(haml-move "[ \t]*")
(unless (haml-move "[a-z0-9_:\\-]+")
(return-from haml-parse-new-attr-hash (haml-move "[ \t]*$")))
(funcall fn 'name (match-beginning 0) (match-end 0))
(haml-move "[ \t]*")
(when (haml-move "=")
(haml-move "[ \t]*")
(unless (looking-at "[\"'@a-z0-9]") (return-from haml-parse-new-attr-hash))
(let ((beg (point)))
(haml-limited-forward-sexp eol)
(funcall fn 'value beg (point)))
(haml-move "[ \t]*")))
nil))
(defun haml-compute-indentation ()
"Calculate the maximum sensible indentation for the current line."
(save-excursion
(beginning-of-line)
(if (bobp) (list 0 nil)
(haml-forward-through-whitespace t)
(let ((indent (funcall haml-indent-function)))
(cond
((consp indent) indent)
((integerp indent) (list indent t))
(indent (list (+ (current-indentation) haml-indent-offset) nil))
(t (list (current-indentation) nil)))))))
(defun haml-indent-region (start end)
"Indent each nonblank line in the region.
This is done by indenting the first line based on
`haml-compute-indentation' and preserving the relative
indentation of the rest of the region. START and END specify the
region to indent.
If this command is used multiple times in a row, it will cycle
between possible indentations."
(save-excursion
(goto-char end)
(setq end (point-marker))
(goto-char start)
(let (this-line-column current-column
(next-line-column
(if (and (equal last-command this-command) (/= (current-indentation) 0))
(* (/ (1- (current-indentation)) haml-indent-offset) haml-indent-offset)
(car (haml-compute-indentation)))))
(while (< (point) end)
(setq this-line-column next-line-column
current-column (current-indentation))
;; Delete whitespace chars at beginning of line
(delete-horizontal-space)
(unless (eolp)
(setq next-line-column (save-excursion
(loop do (forward-line 1)
while (and (not (eobp)) (looking-at "^[ \t]*$")))
(+ this-line-column
(- (current-indentation) current-column))))
;; Don't indent an empty line
(unless (eolp) (indent-to this-line-column)))
(forward-line 1)))
(move-marker end nil)))
(defun haml-indent-line ()
"Indent the current line.
The first time this command is used, the line will be indented to the
maximum sensible indentation. Each immediately subsequent usage will
back-dent the line by `haml-indent-offset' spaces. On reaching column
0, it will cycle back to the maximum sensible indentation."
(interactive "*")
(let ((ci (current-indentation))
(cc (current-column)))
(destructuring-bind (need strict) (haml-compute-indentation)
(save-excursion
(beginning-of-line)
(delete-horizontal-space)
(if (and (not strict) (equal last-command this-command) (/= ci 0))
(indent-to (* (/ (1- ci) haml-indent-offset) haml-indent-offset))
(indent-to need))))
(when (< (current-column) (current-indentation))
(forward-to-indentation 0))))
(defun haml-reindent-region-by (n)
"Add N spaces to the beginning of each line in the region.
If N is negative, will remove the spaces instead. Assumes all
lines in the region have indentation >= that of the first line."
(let* ((ci (current-indentation))
(indent-rx
(concat "^"
(if indent-tabs-mode
(concat (make-string (/ ci tab-width) ?\t)
(make-string (mod ci tab-width) ?\t))
(make-string ci ?\s)))))
(save-excursion
(while (re-search-forward indent-rx (mark) t)
(let ((ci (current-indentation)))
(delete-horizontal-space)
(beginning-of-line)
(indent-to (max 0 (+ ci n))))))))
(defun haml-electric-backspace (arg)
"Delete characters or back-dent the current line.
If invoked following only whitespace on a line, will back-dent
the line and all nested lines to the immediately previous
multiple of `haml-indent-offset' spaces. With ARG, do it that
many times.
Set `haml-backspace-backdents-nesting' to nil to just back-dent
the current line."
(interactive "*p")
(if (or (/= (current-indentation) (current-column))
(bolp)
(save-excursion
(beginning-of-line)
(looking-at "^[ \t]+$")))
(backward-delete-char arg)
(save-excursion
(beginning-of-line)
(unwind-protect
(progn
(if haml-backspace-backdents-nesting
(haml-mark-sexp-but-not-next-line)
(set-mark (save-excursion (end-of-line) (point))))
(haml-reindent-region-by (* (- arg) haml-indent-offset)))
(pop-mark)))
(back-to-indentation)))
(defun haml-kill-line-and-indent ()
"Kill the current line, and re-indent all lines nested beneath it."
(interactive)
(beginning-of-line)
(haml-mark-sexp-but-not-next-line)
(kill-line 1)
(haml-reindent-region-by (* -1 haml-indent-offset)))
(defun haml-indent-string ()
"Return the indentation string for `haml-indent-offset'."
(mapconcat 'identity (make-list haml-indent-offset " ") ""))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.haml\\'" . haml-mode))
;; Local Variables:
;; coding: utf-8
;; byte-compile-warnings: (not cl-functions)
;; eval: (checkdoc-minor-mode 1)
;; End:
(provide 'haml-mode)
;;; haml-mode.el ends here

18
elpa/magit-1.2.1/dir Normal file
View File

@ -0,0 +1,18 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "?" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Magit: (magit). Using Git from Emacs with Magit.

View File

@ -0,0 +1,164 @@
;;; magit-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (magit-status) "magit" "magit.el" (21539 9850 352318
;;;;;; 953000))
;;; Generated autoloads from magit.el
(autoload 'magit-status "magit" "\
Open a Magit status buffer for the Git repository containing
DIR. If DIR is not within a Git repository, offer to create a
Git repository in DIR.
Interactively, a prefix argument means to ask the user which Git
repository to use even if `default-directory' is under Git control.
Two prefix arguments means to ignore `magit-repo-dirs' when asking for
user input.
\(fn DIR)" t nil)
;;;***
;;;### (autoloads (magit-blame-mode) "magit-blame" "magit-blame.el"
;;;;;; (21539 9850 701311 580000))
;;; Generated autoloads from magit-blame.el
(autoload 'magit-blame-mode "magit-blame" "\
Display blame information inline.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads (turn-on-magit-stgit magit-stgit-mode) "magit-stgit"
;;;;;; "magit-stgit.el" (21539 9850 618313 333000))
;;; Generated autoloads from magit-stgit.el
(autoload 'magit-stgit-mode "magit-stgit" "\
StGit support for Magit
\(fn &optional ARG)" t nil)
(autoload 'turn-on-magit-stgit "magit-stgit" "\
Unconditionally turn on `magit-stgit-mode'.
\(fn)" nil nil)
;;;***
;;;### (autoloads (turn-on-magit-svn magit-svn-mode) "magit-svn"
;;;;;; "magit-svn.el" (21539 9850 435317 198000))
;;; Generated autoloads from magit-svn.el
(autoload 'magit-svn-mode "magit-svn" "\
SVN support for Magit
\(fn &optional ARG)" t nil)
(autoload 'turn-on-magit-svn "magit-svn" "\
Unconditionally turn on `magit-svn-mode'.
\(fn)" nil nil)
;;;***
;;;### (autoloads (turn-on-magit-topgit magit-topgit-mode) "magit-topgit"
;;;;;; "magit-topgit.el" (21539 9850 166322 880000))
;;; Generated autoloads from magit-topgit.el
(autoload 'magit-topgit-mode "magit-topgit" "\
Topgit support for Magit
\(fn &optional ARG)" t nil)
(autoload 'turn-on-magit-topgit "magit-topgit" "\
Unconditionally turn on `magit-topgit-mode'.
\(fn)" nil nil)
;;;***
;;;### (autoloads (global-magit-wip-save-mode magit-wip-save-mode
;;;;;; magit-wip-mode) "magit-wip" "magit-wip.el" (21539 9850 532315
;;;;;; 150000))
;;; Generated autoloads from magit-wip.el
(defvar magit-wip-mode nil "\
Non-nil if Magit-Wip mode is enabled.
See the command `magit-wip-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 `magit-wip-mode'.")
(custom-autoload 'magit-wip-mode "magit-wip" nil)
(autoload 'magit-wip-mode "magit-wip" "\
In Magit log buffers; give wip refs a special appearance.
\(fn &optional ARG)" t nil)
(autoload 'magit-wip-save-mode "magit-wip" "\
Magit support for committing to a work-in-progress ref.
When this minor mode is turned on and a file is saved inside a writable
git repository then it is also committed to a special work-in-progress
ref.
\(fn &optional ARG)" t nil)
(defvar global-magit-wip-save-mode nil "\
Non-nil if Global-Magit-Wip-Save mode is enabled.
See the command `global-magit-wip-save-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-magit-wip-save-mode'.")
(custom-autoload 'global-magit-wip-save-mode "magit-wip" nil)
(autoload 'global-magit-wip-save-mode "magit-wip" "\
Toggle Magit-Wip-Save mode in all buffers.
With prefix ARG, enable Global-Magit-Wip-Save mode if ARG is positive;
otherwise, disable it. If called from Lisp, enable the mode if
ARG is omitted or nil.
Magit-Wip-Save mode is enabled in all buffers where
`turn-on-magit-wip-save' would do it.
See `magit-wip-save-mode' for more information on Magit-Wip-Save mode.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads (rebase-mode) "rebase-mode" "rebase-mode.el" (21539
;;;;;; 9850 228321 571000))
;;; Generated autoloads from rebase-mode.el
(autoload 'rebase-mode "rebase-mode" "\
Major mode for editing of a Git rebase file.
Rebase files are generated when you run 'git rebase -i' or run
`magit-interactive-rebase'. They describe how Git should perform
the rebase. See the documentation for git-rebase (e.g., by
running 'man git-rebase' at the command line) for details.
\(fn)" t nil)
(add-to-list 'auto-mode-alist '("git-rebase-todo" . rebase-mode))
;;;***
;;;### (autoloads nil nil ("magit-bisect.el" "magit-key-mode.el"
;;;;;; "magit-pkg.el") (21539 9850 772800 71000))
;;;***
(provide 'magit-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; magit-autoloads.el ends here

View File

@ -0,0 +1,195 @@
(require 'magit)
(defvar magit--bisect-last-pos)
(defvar magit--bisect-tmp-file)
(defvar magit--bisect-info nil)
(make-variable-buffer-local 'magit--bisect-info)
(put 'magit--bisect-info 'permanent-local t)
(defun magit--bisecting-p (&optional required-status)
"Return t if a bisect session is running.
If REQUIRED-STATUS is not nil then the current status must also
match REQUIRED-STATUS."
(and (file-exists-p (concat (magit-git-dir) "BISECT_LOG"))
(or (not required-status)
(eq (plist-get (magit--bisect-info) :status)
required-status))))
(defun magit--bisect-info ()
(with-current-buffer (magit-find-status-buffer)
(or (if (local-variable-p 'magit--bisect-info) magit--bisect-info)
(list :status (if (magit--bisecting-p) 'running 'not-running)))))
(defun magit--bisect-cmd (&rest args)
"Run `git bisect ...' and update the status buffer"
(with-current-buffer (magit-find-status-buffer)
(let* ((output (apply 'magit-git-lines (append '("bisect") args)))
(cmd (car args))
(first-line (car output)))
(save-match-data
(setq magit--bisect-info
(cond ((string= cmd "reset")
(list :status 'not-running))
;; Bisecting: 78 revisions left to test after this (roughly 6 steps)
((string-match "^Bisecting:\\s-+\\([0-9]+\\).+roughly\\s-+\\([0-9]+\\)" first-line)
(list :status 'running
:revs (match-string 1 first-line)
:steps (match-string 2 first-line)))
;; e2596955d9253a80aec9071c18079705597fa102 is the first bad commit
((string-match "^\\([a-f0-9]+\\)\\s-.*first bad commit" first-line)
(list :status 'finished
:bad (match-string 1 first-line)))
(t
(list :status 'error)))))))
(magit-refresh))
(defun magit--bisect-info-for-status (branch)
"Return bisect info suitable for display in the status buffer"
(let* ((info (magit--bisect-info))
(status (plist-get info :status)))
(cond ((eq status 'not-running)
(or branch "(detached)"))
((eq status 'running)
(format "(bisecting; %s revisions & %s steps left)"
(or (plist-get info :revs) "unknown number of")
(or (plist-get info :steps) "unknown number of")))
((eq status 'finished)
(format "(bisected: first bad revision is %s)" (plist-get info :bad)))
(t
"(bisecting; unknown error occured)"))))
(defun magit-bisect-start ()
"Start a bisect session"
(interactive)
(if (magit--bisecting-p)
(error "Already bisecting"))
(let ((bad (magit-read-rev "Start bisect with known bad revision" "HEAD"))
(good (magit-read-rev "Good revision" (magit-default-rev))))
(magit--bisect-cmd "start" bad good)))
(defun magit-bisect-reset ()
"Quit a bisect session"
(interactive)
(unless (magit--bisecting-p)
(error "Not bisecting"))
(magit--bisect-cmd "reset"))
(defun magit-bisect-good ()
"Tell git that the current revision is good during a bisect session"
(interactive)
(unless (magit--bisecting-p 'running)
(error "Not bisecting"))
(magit--bisect-cmd "good"))
(defun magit-bisect-bad ()
"Tell git that the current revision is bad during a bisect session"
(interactive)
(unless (magit--bisecting-p 'running)
(error "Not bisecting"))
(magit--bisect-cmd "bad"))
(defun magit-bisect-skip ()
"Tell git to skip the current revision during a bisect session."
(interactive)
(unless (magit--bisecting-p 'running)
(error "Not bisecting"))
(magit--bisect-cmd "skip"))
(defun magit-bisect-log ()
"Show the bisect log"
(interactive)
(unless (magit--bisecting-p)
(error "Not bisecting"))
(magit-run-git "bisect" "log")
(magit-display-process))
(defun magit-bisect-visualize ()
"Show the remaining suspects with gitk"
(interactive)
(unless (magit--bisecting-p)
(error "Not bisecting"))
(magit-run-git "bisect" "visualize")
(unless (getenv "DISPLAY")
(magit-display-process)))
(easy-mmode-defmap magit-bisect-minibuffer-local-map
'(("\C-i" . comint-dynamic-complete-filename))
"Keymap for minibuffer prompting of rebase command."
:inherit minibuffer-local-map)
(defvar magit-bisect-mode-history nil
"Previously run bisect commands.")
(defun magit-bisect-run (command)
"Bisect automatically by running commands after each step"
(interactive
(list
(read-from-minibuffer "Run command (like this): "
""
magit-bisect-minibuffer-local-map
nil
'magit-bisect-mode-history)))
(unless (magit--bisecting-p)
(error "Not bisecting"))
(let ((file (make-temp-file "magit-bisect-run"))
buffer)
(with-temp-buffer
(insert "#!/bin/sh\n" command "\n")
(write-region (point-min) (point-max) file))
(set-file-modes file #o755)
(magit-run-git-async "bisect" "run" file)
(magit-display-process)
(setq buffer (get-buffer magit-process-buffer-name))
(with-current-buffer buffer
(set (make-local-variable 'magit--bisect-last-pos) 0)
(set (make-local-variable 'magit--bisect-tmp-file) file))
(set-process-filter (get-buffer-process buffer) 'magit--bisect-run-filter)
(set-process-sentinel (get-buffer-process buffer) 'magit--bisect-run-sentinel)))
(defun magit--bisect-run-filter (process output)
(with-current-buffer (process-buffer process)
(save-match-data
(let ((inhibit-read-only t)
line new-info)
(insert output)
(goto-char magit--bisect-last-pos)
(beginning-of-line)
(while (< (point) (point-max))
(cond ( ;; Bisecting: 78 revisions left to test after this (roughly 6 steps)
(looking-at "^Bisecting:\\s-+\\([0-9]+\\).+roughly\\s-+\\([0-9]+\\)")
(setq new-info (list :status 'running
:revs (match-string 1)
:steps (match-string 2))))
( ;; e2596955d9253a80aec9071c18079705597fa102 is the first bad commit
(looking-at "^\\([a-f0-9]+\\)\\s-.*first bad commit")
(setq new-info (list :status 'finished
:bad (match-string 1)))))
(forward-line 1))
(goto-char (point-max))
(setq magit--bisect-last-pos (point))
(if new-info
(with-current-buffer (magit-find-status-buffer)
(setq magit--bisect-info new-info)
(magit--bisect-update-status-buffer)))))))
(defun magit--bisect-run-sentinel (process event)
(if (string-match-p "^finish" event)
(with-current-buffer (process-buffer process)
(delete-file magit--bisect-tmp-file)))
(magit-process-sentinel process event))
(defun magit--bisect-update-status-buffer ()
(with-current-buffer (magit-find-status-buffer)
(save-excursion
(save-match-data
(let ((inhibit-read-only t))
(goto-char (point-min))
(when (search-forward-regexp "Local:" nil t)
(beginning-of-line)
(kill-line)
(insert (format "Local: %s %s"
(propertize (magit--bisect-info-for-status (magit-get-current-branch))
'face 'magit-branch)
(abbreviate-file-name default-directory)))))))))
(provide 'magit-bisect)

View File

@ -0,0 +1,303 @@
;;; magit-blame.el --- blame support for magit
;; Copyright (C) 2012 Rüdiger Sonderfeld
;; Copyright (C) 2012 Yann Hodique
;; Copyright (C) 2011 byplayer
;; Copyright (C) 2010 Alexander Prusov
;; Copyright (C) 2009 Tim Moore
;; Copyright (C) 2008 Linh Dang
;; Copyright (C) 2008 Marius Vollmer
;; Author: Yann Hodique <yann.hodique@gmail.com>
;; Keywords:
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This code has been backported from Egg (Magit fork) to Magit
;;; Code:
(eval-when-compile (require 'cl))
(require 'magit)
(defface magit-blame-header
'((t :inherit magit-header))
"Face for blame header."
:group 'magit-faces)
(defface magit-blame-sha1
'((t :inherit (magit-log-sha1
magit-blame-header)))
"Face for blame sha1."
:group 'magit-faces)
(defface magit-blame-culprit
'((t :inherit magit-blame-header))
"Face for blame culprit."
:group 'magit-faces)
(defface magit-blame-time
'((t :inherit magit-blame-header))
"Face for blame time."
:group 'magit-faces)
(defface magit-blame-subject
'((t :inherit (magit-log-message magit-blame-header)))
"Face for blame tag line."
:group 'magit-faces)
(defconst magit-blame-map
(let ((map (make-sparse-keymap "Magit:Blame")))
(define-key map (kbd "l") 'magit-blame-locate-commit)
(define-key map (kbd "RET") 'magit-blame-locate-commit)
(define-key map (kbd "q") 'magit-blame-mode)
(define-key map (kbd "n") 'magit-blame-next-chunk)
(define-key map (kbd "p") 'magit-blame-previous-chunk)
map)
"Keymap for an annotated section.\\{magit-blame-map}")
(defvar magit-blame-buffer-read-only)
(make-variable-buffer-local 'magit-blame-buffer-read-only)
;;;###autoload
(define-minor-mode magit-blame-mode
"Display blame information inline."
:keymap magit-blame-map
:lighter " blame"
(unless (buffer-file-name)
(error "Current buffer has no associated file!"))
(when (and (buffer-modified-p)
(y-or-n-p (format "save %s first? " (buffer-file-name))))
(save-buffer))
(if magit-blame-mode
(progn
(setq magit-blame-buffer-read-only buffer-read-only)
(magit-blame-file-on (current-buffer))
(set-buffer-modified-p nil)
(setq buffer-read-only t))
(magit-blame-file-off (current-buffer))
(set-buffer-modified-p nil)
(setq buffer-read-only magit-blame-buffer-read-only)))
(defun magit-blame-file-off (buffer)
(save-excursion
(save-restriction
(with-current-buffer buffer
(widen)
(mapc (lambda (ov)
(if (overlay-get ov :blame)
(delete-overlay ov)))
(overlays-in (point-min) (point-max)))))))
(defun magit-blame-file-on (buffer)
(magit-blame-file-off buffer)
(save-excursion
(with-current-buffer buffer
(save-restriction
(with-temp-buffer
(magit-git-insert (list "blame" "--porcelain" "--"
(file-name-nondirectory
(buffer-file-name buffer))))
(magit-blame-parse buffer (current-buffer)))))))
(defun magit-blame-locate-commit (pos)
"Jump to a commit in the branch history from an annotated blame section."
(interactive "d")
(let ((overlays (overlays-at pos))
sha1)
(dolist (ov overlays)
(if (overlay-get ov :blame)
(setq sha1 (plist-get (nth 3 (overlay-get ov :blame)) :sha1))))
(if sha1
(magit-show-commit sha1))))
(defun magit-find-next-overlay-change (BEG END PROP)
"Return the next position after BEG where an overlay matching a
property PROP starts or ends. If there are no matching overlay
boundaries from BEG to END, the return value is nil."
(save-excursion
(goto-char BEG)
(catch 'found
(flet ((overlay-change (pos)
(if (< BEG END) (next-overlay-change pos)
(previous-overlay-change pos)))
(within-bounds-p (pos)
(if (< BEG END) (< pos END)
(> pos END))))
(let ((ov-pos BEG))
;; iterate through overlay changes from BEG to END
(while (within-bounds-p ov-pos)
(let* ((next-ov-pos (overlay-change ov-pos))
;; search for an overlay with a PROP property
(next-ov
(let ((overlays (overlays-at next-ov-pos)))
(while (and overlays
(not (overlay-get (car overlays) PROP)))
(setq overlays (cdr overlays)))
(car overlays))))
(if next-ov
;; found the next overlay with prop PROP at next-ov-pos
(throw 'found next-ov-pos)
;; no matching overlay found, keep looking
(setq ov-pos next-ov-pos)))))))))
(defun magit-blame-next-chunk (pos)
"Go to the next blame chunk."
(interactive "d")
(let ((next-chunk-pos (magit-find-next-overlay-change pos (point-max) :blame)))
(when next-chunk-pos
(goto-char next-chunk-pos))))
(defun magit-blame-previous-chunk (pos)
"Go to the previous blame chunk."
(interactive "d")
(let ((prev-chunk-pos (magit-find-next-overlay-change pos (point-min) :blame)))
(when prev-chunk-pos
(goto-char prev-chunk-pos))))
(defcustom magit-time-format-string "%Y-%m-%dT%T%z"
"How to format time in magit-blame header."
:group 'magit
:type 'string)
(defun magit-blame-decode-time (unixtime &optional tz)
"Decode UNIXTIME into (HIGH LOW) format.
The second argument TZ can be used to add the timezone in (-)HHMM
format to UNIXTIME. UNIXTIME should be either a number
containing seconds since epoch or Emacs's (HIGH LOW
. IGNORED) format."
(when (numberp tz)
(unless (numberp unixtime)
(setq unixtime (float-time unixtime)))
(let* ((ptz (abs tz))
(min (+ (* (/ ptz 100) 60)
(mod ptz 100))))
(setq unixtime (+ (* (if (< tz 0) (- min) min) 60) unixtime))))
(when (numberp unixtime)
(setq unixtime (seconds-to-time unixtime)))
unixtime)
(defun magit-blame-format-time-string (format &optional unixtime tz)
"Use FORMAT to format the time UNIXTIME, or now if omitted.
UNIXTIME is specified as a number containing seconds since epoch
or Emacs's (HIGH LOW . IGNORED) format. The optional argument TZ
can be used to set the time zone. If TZ is a number it is
treated as a (-)HHMM offset to Universal Time. If TZ is not
a number and non-nil the time is printed in UTC. If TZ is nil
the local zime zone is used. The format of the function is
similar to `format-time-string' except for %Z which is not
officially supported at the moment."
(unless unixtime
(setq unixtime (current-time)))
(when (numberp tz) ;; TODO add support for %Z
(setq format (replace-regexp-in-string "%z" (format "%+05d" tz) format)))
(format-time-string format (magit-blame-decode-time unixtime tz) tz))
(defun magit-blame-parse (target-buf blame-buf)
"Parse blame-info in buffer BLAME-BUF and decorate TARGET-BUF buffer."
(save-match-data
(let ((blank (propertize " " 'face 'magit-blame-header))
(nl (propertize "\n" 'face 'magit-blame-header))
(commit-hash (make-hash-table :test 'equal :size 577))
commit commit-info old-line new-line num old-file subject author
author-time author-timezone info ov beg end blame)
(with-current-buffer blame-buf
(goto-char (point-min))
;; search for a ful commit info
(while (re-search-forward "^\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)$" nil t)
(setq commit (match-string-no-properties 1)
old-line (string-to-number
(match-string-no-properties 2))
new-line (string-to-number
(match-string-no-properties 3))
num (string-to-number
(match-string-no-properties 4)))
;; was this commit already seen (and stored in the hash)?
(setq commit-info (gethash commit commit-hash))
;; Nope, this is the 1st time, the full commit-info follow.
(unless commit-info
(re-search-forward "^author \\(.+\\)$")
(setq author (match-string-no-properties 1))
(re-search-forward "^author-time \\(.+\\)$")
(setq author-time (string-to-number
(match-string-no-properties 1)))
(re-search-forward "^author-tz \\(.+\\)$")
(setq author-timezone (string-to-number
(match-string-no-properties 1)))
(re-search-forward "^summary \\(.+\\)$")
(setq subject (match-string-no-properties 1))
(re-search-forward "^filename \\(.+\\)$")
(setq old-file (match-string-no-properties 1))
(setq commit-info (list :sha1 commit :author author
:author-time author-time
:author-timezone author-timezone
:subject subject :file old-file))
;; save it in the hash
(puthash commit commit-info commit-hash))
;; add the current blame-block into the list INFO.
(setq info (cons (list old-line new-line num commit-info)
info))))
;; now do from beginning
(setq info (nreverse info))
(with-current-buffer target-buf
;; for every blame chunk
(dolist (chunk info)
(setq commit-info (nth 3 chunk)
old-line (nth 0 chunk)
new-line (nth 1 chunk)
num (nth 2 chunk)
commit (plist-get commit-info :sha1)
author (plist-get commit-info :author)
author-time (plist-get commit-info :author-time)
author-timezone (plist-get commit-info :author-timezone)
subject (plist-get commit-info :subject))
(goto-char (point-min))
(forward-line (1- new-line))
(setq beg (line-beginning-position)
end (save-excursion
(forward-line num)
(line-beginning-position)))
;; mark the blame chunk
(put-text-property beg end :blame chunk)
;; make an overlay with blame info as 'before-string
;; on the current chunk.
(setq ov (make-overlay beg end))
(overlay-put ov :blame chunk)
(setq blame (concat
(propertize (substring-no-properties commit 0 8)
'face 'magit-blame-sha1)
blank
(propertize (format "%-20s" author)
'face 'magit-blame-culprit)
blank
(propertize (magit-blame-format-time-string
magit-time-format-string
author-time author-timezone)
'face 'magit-blame-time)
blank
(propertize subject 'face 'magit-blame-subject)
blank nl))
(overlay-put ov 'before-string blame))))))
(provide 'magit-blame)
;;; magit-blame.el ends here

View File

@ -0,0 +1,521 @@
(require 'magit)
(eval-when-compile (require 'cl))
(defvar magit-key-mode-key-maps '()
"This will be filled lazily with proper `define-key' built
keymaps as they're requested.")
(defvar magit-key-mode-buf-name "*magit-key*"
"Name of the buffer.")
(defvar magit-key-mode-current-args '()
"Will contain the arguments to be passed to git.")
(defvar magit-key-mode-current-options '()
"Will contain the arguments to be passed to git.")
(defvar magit-log-mode-window-conf nil
"Will hold the pre-menu configuration of magit.")
(defvar magit-key-mode-groups
'((logging
(man-page "git-log")
(actions
("l" "Short" magit-log)
("L" "Long" magit-log-long)
("h" "Reflog" magit-reflog)
("rl" "Ranged short" magit-log-ranged)
("rL" "Ranged long" magit-log-long-ranged)
("rh" "Ranged reflog" magit-reflog-ranged))
(switches
("-m" "Only merge commits" "--merges")
("-f" "First parent" "--first-parent")
("-i" "Case insensitive patterns" "-i")
("-pr" "Pickaxe regex" "--pickaxe-regex")
("-n" "Name only" "--name-only")
("-am" "All match" "--all-match")
("-al" "All" "--all"))
(arguments
("=r" "Relative" "--relative=" read-directory-name)
("=c" "Committer" "--committer=" read-from-minibuffer)
("=>" "Since" "--since=" read-from-minibuffer)
("=<" "Before" "--before=" read-from-minibuffer)
("=s" "Pickaxe search" "-S" read-from-minibuffer)
("=a" "Author" "--author=" read-from-minibuffer)
("=g" "Grep" "--grep=" read-from-minibuffer)))
(running
(actions
("!" "Command from root" magit-shell-command)
(":" "Git command" magit-git-command)
("g" "git gui" magit-run-git-gui)
("k" "gitk" magit-run-gitk)))
(fetching
(man-page "git-fetch")
(actions
("f" "Current" magit-fetch-current)
("a" "All" magit-remote-update)
("o" "Other" magit-fetch))
(switches
("-p" "Prune" "--prune")))
(pushing
(man-page "git-push")
(actions
("P" "Push" magit-push)
("t" "Push tags" magit-push-tags))
(switches
("-f" "Force" "--force")
("-d" "Dry run" "-n")
("-u" "Set upstream" "-u")))
(pulling
(man-page "git-pull")
(actions
("F" "Pull" magit-pull))
(switches
("-r" "Rebase" "--rebase")))
(branching
(man-page "git-branch")
(actions
("v" "Branch manager" magit-branch-manager)
("c" "Create" magit-create-branch)
("r" "Rename" magit-move-branch)
("k" "Delete" magit-delete-branch)
("b" "Checkout" magit-checkout)))
(remoting
(man-page "git-remote")
(actions
("v" "Branch manager" magit-branch-manager)
("a" "Add" magit-add-remote)
("r" "Rename" magit-rename-remote)
("k" "Remove" magit-remove-remote)))
(tagging
(man-page "git-tag")
(actions
("t" "Lightweight" magit-tag)
("a" "Annotated" magit-annotated-tag))
(switches
("-f" "Force" "-f")))
(stashing
(man-page "git-stash")
(actions
("z" "Save" magit-stash)
("s" "Snapshot" magit-stash-snapshot))
(switches
("-k" "Keep index" "--keep-index")
("-u" "Include untracked files" "--include-untracked")
("-a" "Include all files" "--all")))
(merging
(man-page "git-merge")
(actions
("m" "Merge" magit-manual-merge))
(switches
("-ff" "Fast-forward only" "--ff-only")
("-nf" "No fast-forward" "--no-ff")
("-sq" "Squash" "--squash"))
(arguments
("-st" "Strategy" "--strategy=" read-from-minibuffer)))
(rewriting
(actions
("b" "Begin" magit-rewrite-start)
("s" "Stop" magit-rewrite-stop)
("a" "Abort" magit-rewrite-abort)
("f" "Finish" magit-rewrite-finish)
("*" "Set unused" magit-rewrite-set-unused)
("." "Set used" magit-rewrite-set-used)))
(submodule
(man-page "git-submodule")
(actions
("u" "Update" magit-submodule-update)
("b" "Both update and init" magit-submodule-update-init)
("i" "Init" magit-submodule-init)
("s" "Sync" magit-submodule-sync)))
(bisecting
(man-page "git-bisect")
(actions
("b" "Bad" magit-bisect-bad)
("g" "Good" magit-bisect-good)
("k" "Skip" magit-bisect-skip)
("l" "Log" magit-bisect-log)
("r" "Reset" magit-bisect-reset)
("s" "Start" magit-bisect-start)
("u" "Run" magit-bisect-run)
("v" "Visualize" magit-bisect-visualize))))
"Holds the key, help, function mapping for the log-mode. If you
modify this make sure you reset `magit-key-mode-key-maps' to
nil.")
(defun magit-key-mode-delete-group (group)
"Delete a group from `magit-key-mode-key-maps'."
(let ((items (assoc group magit-key-mode-groups)))
(when items
;; reset the cache
(setq magit-key-mode-key-maps nil)
;; delete the whole group
(setq magit-key-mode-groups
(delq items magit-key-mode-groups))
;; unbind the defun
(magit-key-mode-de-generate group))
magit-key-mode-groups))
(defun magit-key-mode-add-group (group)
"Add a new group to `magit-key-mode-key-maps'. If there's
already a group of that name then this will completely remove it
and put in its place an empty one of the same name."
(when (assoc group magit-key-mode-groups)
(magit-key-mode-delete-group group))
(setq magit-key-mode-groups
(cons (list group (list 'actions)) magit-key-mode-groups)))
(defun magit-key-mode-key-defined-p (for-group key)
"If KEY is defined as any of switch, argument or action within
FOR-GROUP then return t"
(catch 'result
(let ((options (magit-key-mode-options-for-group for-group)))
(dolist (type '(actions switches arguments))
(when (assoc key (assoc type options))
(throw 'result t))))))
(defun magit-key-mode-update-group (for-group thing &rest args)
"Abstraction for setting values in `magit-key-mode-key-maps'."
(let* ((options (magit-key-mode-options-for-group for-group))
(things (assoc thing options))
(key (car args)))
(if (cdr things)
(if (magit-key-mode-key-defined-p for-group key)
(error "%s is already defined in the %s group." key for-group)
(setcdr (cdr things) (cons args (cddr things))))
(setcdr things (list args)))
(setq magit-key-mode-key-maps nil)
things))
(defun magit-key-mode-insert-argument (for-group key desc arg read-func)
"Add a new binding (KEY) in FOR-GROUP which will use READ-FUNC
to receive input to apply to argument ARG git is run. DESC should
be a brief description of the binding."
(magit-key-mode-update-group for-group 'arguments key desc arg read-func))
(defun magit-key-mode-insert-switch (for-group key desc switch)
"Add a new binding (KEY) in FOR-GROUP which will add SWITCH to git's
command line when it runs. DESC should be a brief description of
the binding."
(magit-key-mode-update-group for-group 'switches key desc switch))
(defun magit-key-mode-insert-action (for-group key desc func)
"Add a new binding (KEY) in FOR-GROUP which will run command
FUNC. DESC should be a brief description of the binding."
(magit-key-mode-update-group for-group 'actions key desc func))
(defun magit-key-mode-options-for-group (for-group)
"Retrieve the options (switches, commands and arguments) for
the group FOR-GROUP."
(or (cdr (assoc for-group magit-key-mode-groups))
(error "Unknown group '%s'" for-group)))
(defun magit-key-mode-help (for-group)
"Provide help for a key (which the user is prompted for) within
FOR-GROUP."
(let* ((opts (magit-key-mode-options-for-group for-group))
(man-page (cadr (assoc 'man-page opts)))
(seq (read-key-sequence
(format "Enter command prefix%s: "
(if man-page
(format ", `?' for man `%s'" man-page)
""))))
(actions (cdr (assoc 'actions opts))))
(cond
;; if it is an action popup the help for the to-be-run function
((assoc seq actions) (describe-function (nth 2 (assoc seq actions))))
;; if there is "?" show a man page if there is one
((equal seq "?")
(if man-page
(man man-page)
(error "No man page associated with `%s'" for-group)))
(t (error "No help associated with `%s'" seq)))))
(defun magit-key-mode-exec-at-point ()
"Run action/args/option at point."
(interactive)
(let* ((key (or (get-text-property (point) 'key-group-executor)
(error "Nothing at point to do.")))
(def (lookup-key (current-local-map) key)))
(call-interactively def)))
(defun magit-key-mode-jump-to-next-exec ()
"Jump to the next action/args/option point."
(interactive)
(let* ((oldp (point))
(old (get-text-property oldp 'key-group-executor))
(p (if (= oldp (point-max)) (point-min) (1+ oldp))))
(while (let ((new (get-text-property p 'key-group-executor)))
(and (not (= p oldp)) (or (not new) (eq new old))))
(setq p (if (= p (point-max)) (point-min) (1+ p))))
(goto-char p)
(skip-chars-forward " ")))
(defun magit-key-mode-build-keymap (for-group)
"Construct a normal looking keymap for the key mode to use and
put it in magit-key-mode-key-maps for fast lookup."
(let* ((options (magit-key-mode-options-for-group for-group))
(actions (cdr (assoc 'actions options)))
(switches (cdr (assoc 'switches options)))
(arguments (cdr (assoc 'arguments options)))
(map (make-sparse-keymap)))
(suppress-keymap map 'nodigits)
;; ret dwim
(define-key map (kbd "RET") 'magit-key-mode-exec-at-point)
;; tab jumps to the next "button"
(define-key map (kbd "TAB") 'magit-key-mode-jump-to-next-exec)
;; all maps should `quit' with `C-g' or `q'
(define-key map (kbd "C-g") `(lambda ()
(interactive)
(magit-key-mode-command nil)))
(define-key map (kbd "q") `(lambda ()
(interactive)
(magit-key-mode-command nil)))
;; run help
(define-key map (kbd "?") `(lambda ()
(interactive)
(magit-key-mode-help ',for-group)))
(flet ((defkey (k action)
(when (and (lookup-key map (car k))
(not (numberp (lookup-key map (car k)))))
(message "Warning: overriding binding for `%s' in %S"
(car k) for-group)
(ding)
(sit-for 2))
(define-key map (car k)
`(lambda () (interactive) ,action))))
(when actions
(dolist (k actions)
(defkey k `(magit-key-mode-command ',(nth 2 k)))))
(when switches
(dolist (k switches)
(defkey k `(magit-key-mode-add-option ',for-group ,(nth 2 k)))))
(when arguments
(dolist (k arguments)
(defkey k `(magit-key-mode-add-argument
',for-group ,(nth 2 k) ',(nth 3 k))))))
(push (cons for-group map) magit-key-mode-key-maps)
map))
(defvar magit-key-mode-prefix nil
"For internal use. Holds the prefix argument to the command
that brought up the key-mode window, so it can be used by the
command that's eventually invoked.")
(defun magit-key-mode-command (func)
(let ((args '()))
;; why can't maphash return a list?!
(maphash (lambda (k v)
(push (concat k (shell-quote-argument v)) args))
magit-key-mode-current-args)
(let ((magit-custom-options (append args magit-key-mode-current-options))
(current-prefix-arg (or current-prefix-arg magit-key-mode-prefix)))
(set-window-configuration magit-log-mode-window-conf)
(when func
(call-interactively func))
(magit-key-mode-kill-buffer))))
(defvar magit-key-mode-current-args nil
"A hash-table of current argument set (which will eventually
make it to the git command-line).")
(defun magit-key-mode-add-argument (for-group arg-name input-func)
(let ((input (funcall input-func (concat arg-name ": "))))
(puthash arg-name input magit-key-mode-current-args)
(magit-key-mode-redraw for-group)))
(defvar magit-key-mode-current-options '()
"Current option set (which will eventually make it to the git
command-line).")
(defun magit-key-mode-add-option (for-group option-name)
"Toggles the appearance of OPTION-NAME in
`magit-key-mode-current-options'."
(if (not (member option-name magit-key-mode-current-options))
(add-to-list 'magit-key-mode-current-options option-name)
(setq magit-key-mode-current-options
(delete option-name magit-key-mode-current-options)))
(magit-key-mode-redraw for-group))
(defun magit-key-mode-kill-buffer ()
(interactive)
(kill-buffer magit-key-mode-buf-name))
(defvar magit-log-mode-window-conf nil
"Pre-popup window configuration.")
(defun magit-key-mode (for-group &optional original-opts)
"Mode for magit key selection. All commands, switches and
options can be toggled/actioned with the key combination
highlighted before the description."
(interactive)
;; save the window config to restore it as was (no need to make this
;; buffer local)
(setq magit-log-mode-window-conf
(current-window-configuration))
;; setup the mode, draw the buffer
(let ((buf (get-buffer-create magit-key-mode-buf-name)))
(delete-other-windows)
(split-window-vertically)
(other-window 1)
(switch-to-buffer buf)
(kill-all-local-variables)
(set (make-local-variable
'magit-key-mode-current-options)
original-opts)
(set (make-local-variable
'magit-key-mode-current-args)
(make-hash-table))
(set (make-local-variable 'magit-key-mode-prefix) current-prefix-arg)
(magit-key-mode-redraw for-group))
(message
(concat
"Type a prefix key to toggle it. Run 'actions' with their prefixes. "
"'?' for more help.")))
(defun magit-key-mode-get-key-map (for-group)
"Get or build the keymap for FOR-GROUP."
(or (cdr (assoc for-group magit-key-mode-key-maps))
(magit-key-mode-build-keymap for-group)))
(defun magit-key-mode-redraw (for-group)
"(re)draw the magit key buffer."
(let ((buffer-read-only nil)
(old-point (point))
(is-first (zerop (buffer-size)))
(actions-p nil))
(erase-buffer)
(make-local-variable 'font-lock-defaults)
(use-local-map (magit-key-mode-get-key-map for-group))
(setq actions-p (magit-key-mode-draw for-group))
(delete-trailing-whitespace)
(setq mode-name "magit-key-mode" major-mode 'magit-key-mode)
(if (and is-first actions-p)
(progn (goto-char actions-p)
(magit-key-mode-jump-to-next-exec))
(goto-char old-point)))
(setq buffer-read-only t)
(fit-window-to-buffer))
(defun magit-key-mode-draw-header (header)
"Draw a header with the correct face."
(insert (propertize header 'face 'font-lock-keyword-face) "\n"))
(defvar magit-key-mode-args-in-cols nil
"When true, draw arguments in columns as with switches and
options.")
(defun magit-key-mode-draw-args (args)
"Draw the args part of the menu."
(magit-key-mode-draw-buttons
"Args"
args
(lambda (x)
(format "(%s) %s"
(nth 2 x)
(propertize (gethash (nth 2 x) magit-key-mode-current-args "")
'face 'widget-field)))
(not magit-key-mode-args-in-cols)))
(defun magit-key-mode-draw-switches (switches)
"Draw the switches part of the menu."
(magit-key-mode-draw-buttons
"Switches"
switches
(lambda (x)
(format "(%s)" (let ((s (nth 2 x)))
(if (member s magit-key-mode-current-options)
(propertize s 'face 'font-lock-warning-face)
s))))))
(defun magit-key-mode-draw-actions (actions)
"Draw the actions part of the menu."
(magit-key-mode-draw-buttons "Actions" actions nil))
(defun magit-key-mode-draw-buttons (section xs maker
&optional one-col-each)
(when xs
(magit-key-mode-draw-header section)
(magit-key-mode-draw-in-cols
(mapcar (lambda (x)
(let* ((head (propertize (car x) 'face 'font-lock-builtin-face))
(desc (nth 1 x))
(more (and maker (funcall maker x)))
(text (format " %s: %s%s%s"
head desc (if more " " "") (or more ""))))
(propertize text 'key-group-executor (car x))))
xs)
one-col-each)))
(defun magit-key-mode-draw-in-cols (strings one-col-each)
"Given a list of strings, print in columns (using `insert'). If
ONE-COL-EACH is true then don't columify, but rather, draw each
item on one line."
(let ((longest-act (apply 'max (mapcar 'length strings))))
(while strings
(let ((str (car strings)))
(let ((padding (make-string (- (+ longest-act 3) (length str)) ? )))
(insert str)
(if (or one-col-each
(and (> (+ (length padding) ;
(current-column)
longest-act)
(window-width))
(cdr strings)))
(insert "\n")
(insert padding))))
(setq strings (cdr strings))))
(insert "\n"))
(defun magit-key-mode-draw (for-group)
"Function used to draw actions, switches and parameters.
Returns the point before the actions part, if any."
(let* ((options (magit-key-mode-options-for-group for-group))
(switches (cdr (assoc 'switches options)))
(arguments (cdr (assoc 'arguments options)))
(actions (cdr (assoc 'actions options)))
(p nil))
(magit-key-mode-draw-switches switches)
(magit-key-mode-draw-args arguments)
(when actions (setq p (point-marker)))
(magit-key-mode-draw-actions actions)
(insert "\n")
p))
(defun magit-key-mode-de-generate (group)
"Unbind the function for GROUP."
(fmakunbound
(intern (concat "magit-key-mode-popup-" (symbol-name group)))))
(defun magit-key-mode-generate (group)
"Generate the key-group menu for GROUP"
(let ((opts (magit-key-mode-options-for-group group)))
(eval
`(defun ,(intern (concat "magit-key-mode-popup-" (symbol-name group))) nil
,(concat "Key menu for " (symbol-name group))
(interactive)
(magit-key-mode (quote ,group))))))
;; create the interactive functions for the key mode popups (which are
;; applied in the top-level key maps)
(mapc (lambda (g)
(magit-key-mode-generate (car g)))
magit-key-mode-groups)
(provide 'magit-key-mode)

View File

@ -0,0 +1 @@
(define-package "magit" "1.2.1" "Control Git from Emacs.")

View File

@ -0,0 +1,288 @@
;;; magit-stgit.el --- StGit plug-in for Magit
;; Copyright (C) 2011 Lluis Vilanova
;;
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This plug-in provides StGit functionality as a separate component of Magit.
;; Available actions:
;; - visit: Shows the patch at point in the series (stg show)
;; - apply: Goes to the patch at point in the series (stg goto)
;; - discard: Deletes the marked/at point patch in the series (stg delete)
;; Available commands:
;; - `magit-stgit-refresh': Refresh the marked/at point patch in the series
;; (stg refresh)
;; - `magit-stgit-repair': Repair the StGit metadata (stg repair)
;; - `magit-stgit-rebase': Rebase the whole series (stg rebase)
;; TODO:
;; - Let the user select which files must be included in a refresh.
;; - Missing actions for `magit-show-item-or-scroll-up' and
;; `magit-show-item-or-scroll-down'.
;; - Marking a patch is slow and refreshes all buffers, which resets their
;; position (i.e., the buffer is shown from its first line).
;;; Code:
(require 'magit)
(eval-when-compile
(require 'cl))
;;; Customizables:
(defcustom magit-stgit-executable "stg"
"The name of the StGit executable."
:group 'magit
:type 'string)
(defface magit-stgit-applied
'((t :inherit magit-diff-add))
"Face for an applied stgit patch."
:group 'magit-faces)
(defface magit-stgit-current
'((t :inherit magit-item-highlight))
"Face for the current stgit patch."
:group 'magit-faces)
(defface magit-stgit-other
'((t :inherit magit-diff-del))
"Face for a non-applied stgit patch."
:group 'magit-faces)
(defface magit-stgit-marked
'((t :inherit magit-item-mark))
"Face for a marked stgit patch."
:group 'magit-faces)
(defface magit-stgit-empty
'((t :inherit magit-item-mark))
"Face for an empty stgit patch."
:group 'magit-faces)
;;; Common code:
(defvar magit-stgit--enabled nil
"Whether this buffer has StGit support.")
(make-variable-buffer-local 'magit-stgit--enabled)
(defvar magit-stgit-mode)
(defun magit-stgit--enabled ()
"Whether this buffer has StGit support enabled."
(if (assoc 'magit-stgit--enabled (buffer-local-variables))
magit-stgit--enabled
(setq magit-stgit--enabled
(and magit-stgit-mode
(not (null
(member (concat (magit-get-current-branch) ".stgit")
(mapcar #'(lambda (line)
(string-match "^\\*?\s*\\([^\s]*\\)"
line)
(match-string 1 line))
(magit-git-lines "branch")))))))))
(defun magit-stgit--enabled-reset ()
"Reset the StGit enabled state."
(kill-local-variable 'magit-stgit--enabled))
(defvar magit-stgit--marked-patch nil
"The (per-buffer) currently marked patch in an StGit series.")
(make-variable-buffer-local 'magit-stgit--marked-patch)
;;; Menu:
(easy-menu-define magit-stgit-extension-menu
nil
"StGit extension menu"
'("StGit"
:active (magit-stgit--enabled)
["Refresh patch" magit-stgit-refresh
:help "Refresh the contents of a patch in an StGit series"]
["Repair" magit-stgit-repair
:help "Repair StGit metadata if branch was modified with git commands"]
["Rebase series" magit-stgit-rebase
:help "Rebase an StGit patch series"]
))
(easy-menu-add-item 'magit-mode-menu
'("Extensions")
magit-stgit-extension-menu)
;;; Series section:
(defun magit-stgit--wash-patch ()
(if (search-forward-regexp "^\\(.\\)\\(.\\) \\([^\s]*\\)\\(\s*# ?\\)\\(.*\\)"
(line-end-position) t)
(let* ((empty-str "[empty] ")
(indent-str (make-string (string-bytes empty-str) ?\ ))
(empty (match-string 1))
(state (match-string 2))
(patch (match-string 3))
(descr (match-string 5)))
(delete-region (line-beginning-position) (line-end-position))
(insert
(cond ((string= empty "0")
(propertize (concat empty-str " " state " " descr) 'face 'magit-stgit-empty))
((string= magit-stgit--marked-patch patch)
(propertize (concat indent-str " " state " " descr) 'face 'magit-stgit-marked))
((string= state "+")
(concat indent-str " " (propertize state 'face 'magit-stgit-applied) " " descr))
((string= state ">")
(propertize (concat indent-str " " state " " descr) 'face 'magit-stgit-current))
((string= state "-")
(concat indent-str " " (propertize state 'face 'magit-stgit-other) " " descr))))
(goto-char (line-beginning-position))
(magit-with-section patch 'series
(magit-set-section-info patch)
(goto-char (line-end-position)))
(forward-line))
(delete-region (line-beginning-position) (1+ (line-end-position))))
t)
(defun magit-stgit--wash-series ()
(let ((magit-old-top-section nil))
(magit-wash-sequence #'magit-stgit--wash-patch)))
(magit-define-inserter series ()
(when (executable-find magit-stgit-executable)
(magit-insert-section 'series
"Series:" 'magit-stgit--wash-series
magit-stgit-executable "series" "-a" "-d" "-e")))
;;; Actions:
;; Copy of `magit-refresh-commit-buffer' (version 1.0.0)
(defun magit-stgit--refresh-patch-buffer (patch)
(magit-create-buffer-sections
(magit-insert-section nil nil
'magit-wash-commit
magit-stgit-executable
"show"
patch)))
;; Copy of `magit-show-commit' (version 1.0.0)
(defun magit-stgit--show-patch (patch &optional scroll)
(when (magit-section-p patch)
(setq patch (magit-section-info patch)))
(let ((dir default-directory)
(buf (get-buffer-create magit-commit-buffer-name)))
(cond ((and (equal magit-currently-shown-commit patch)
;; if it's empty then the buffer was killed
(with-current-buffer buf
(> (length (buffer-string)) 1)))
(let ((win (get-buffer-window buf)))
(cond ((not win)
(display-buffer buf))
(scroll
(with-selected-window win
(funcall scroll))))))
(t
(setq magit-currently-shown-commit patch)
(display-buffer buf)
(with-current-buffer buf
(set-buffer buf)
(goto-char (point-min))
(magit-mode-init dir 'magit-commit-mode
#'magit-stgit--refresh-patch-buffer patch))))))
(magit-add-action (item info "visit")
((series)
(magit-stgit--show-patch info)
(pop-to-buffer magit-commit-buffer-name)))
(magit-add-action (item info "apply")
((series)
(magit-run magit-stgit-executable "goto" info)))
(magit-add-action (item info "discard")
((series)
(let ((patch (or magit-stgit--marked-patch info)))
(if (yes-or-no-p (format "Delete patch '%s' in series? " patch))
(progn
(if (string= magit-stgit--marked-patch patch)
(setq magit-stgit--marked-patch nil))
(magit-run magit-stgit-executable "delete" patch))))))
(defun magit-stgit--set-marked-patch (patch)
(setq magit-stgit--marked-patch
(if (string= magit-stgit--marked-patch patch)
nil
patch)))
(magit-add-action (item info "mark")
((series)
(magit-stgit--set-marked-patch info)
(magit-refresh-all)))
;;; Commands:
(defun magit-stgit-refresh ()
"Refresh the contents of a patch in an StGit series.
If there is no marked patch in the series, refreshes the current
patch.
Otherwise, refreshes the marked patch."
(interactive)
(if magit-stgit--marked-patch
(magit-run magit-stgit-executable "refresh" "-p" magit-stgit--marked-patch)
(magit-run magit-stgit-executable "refresh")))
(defun magit-stgit-repair ()
"Repair StGit metadata if branch was modified with git commands.
In the case of Git commits these will be imported as new patches
into the series."
(interactive)
(message "Repairing series...")
(magit-run magit-stgit-executable "repair")
(message ""))
(defun magit-stgit-rebase ()
"Rebase an StGit patch series."
(interactive)
(if (magit-get-current-remote)
(progn
(if (yes-or-no-p "Update remotes? ")
(progn
(message "Updating remotes...")
(magit-run-git-async "remote" "update")))
(magit-run magit-stgit-executable "rebase"
(format "remotes/%s/%s"
(magit-get-current-remote)
(magit-get-current-branch))))))
;;;###autoload
(define-minor-mode magit-stgit-mode "StGit support for Magit"
:lighter " Stg" :require 'magit-stgit
(or (derived-mode-p 'magit-mode)
(error "This mode only makes sense with magit"))
(if magit-stgit-mode
(progn
(add-hook 'magit-after-insert-stashes-hook 'magit-insert-series nil t))
(progn
(remove-hook 'magit-after-insert-stashes-hook 'magit-insert-series t)))
(when (called-interactively-p 'any)
(magit-refresh)))
;;;###autoload
(defun turn-on-magit-stgit ()
"Unconditionally turn on `magit-stgit-mode'."
(magit-stgit-mode 1))
(provide 'magit-stgit)
;;; magit-stgit.el ends here

View File

@ -0,0 +1,240 @@
;;; magit-svn.el --- git-svn plug-in for Magit
;; Copyright (C) 2008 Alex Ott
;; Copyright (C) 2009 Alexey Voinov
;; Copyright (C) 2009 John Wiegley
;; Copyright (C) 2008 Linh Dang
;; Copyright (C) 2008 Marcin Bachry
;; Copyright (C) 2008, 2009 Marius Vollmer
;; Copyright (C) 2010 Yann Hodique
;;
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This plug-in provides git-svn functionality as a separate component of Magit
;;; Code:
(require 'magit)
(eval-when-compile
(require 'cl))
;; git svn commands
(defun magit-svn-find-rev (rev &optional branch)
(interactive
(list (read-string "SVN revision: ")
(if current-prefix-arg
(read-string "In branch: "))))
(let* ((sha (apply 'magit-git-string
`("svn"
"find-rev"
,(concat "r" rev)
,@(when branch (list branch))))))
(if sha
(magit-show-commit
(magit-with-section sha 'commit
(magit-set-section-info sha)
sha))
(error "Revision %s could not be mapped to a commit" rev))))
(defun magit-svn-create-branch (name)
(interactive "sBranch name: ")
(magit-run-git "svn" "branch" name))
(defun magit-svn-rebase ()
(interactive)
(magit-run-git-async "svn" "rebase"))
(defun magit-svn-dcommit ()
(interactive)
(magit-run-git-async "svn" "dcommit"))
(defun magit-svn-enabled ()
(not (null (magit-svn-get-ref-info t))))
(defun magit-svn-expand-braces-in-branches (branch)
(if (not (string-match "\\(.+\\){\\(.+,.+\\)}\\(.*\\):\\(.*\\)\\\*" branch))
(list branch)
(let ((prefix (match-string 1 branch))
(suffix (match-string 3 branch))
(rhs (match-string 4 branch))
(pieces (split-string (match-string 2 branch) ",")))
(mapcar (lambda (p) (concat prefix p suffix ":" rhs p)) pieces))))
(defun magit-svn-get-local-ref (url)
(let* ((branches (cons (magit-get "svn-remote" "svn" "fetch")
(magit-get-all "svn-remote" "svn" "branches")))
(branches (apply 'nconc
(mapcar 'magit-svn-expand-braces-in-branches
branches)))
(base-url (magit-get "svn-remote" "svn" "url"))
(result nil))
(while branches
(let* ((pats (split-string (pop branches) ":"))
(src (replace-regexp-in-string "\\*" "\\\\(.*\\\\)" (car pats)))
(dst (replace-regexp-in-string "\\*" "\\\\1" (cadr pats)))
(base-url (replace-regexp-in-string "\\+" "\\\\+" base-url))
(base-url (replace-regexp-in-string "//.+@" "//" base-url))
(pat1 (concat "^" src "$"))
(pat2 (cond ((equal src "") (concat "^" base-url "$"))
(t (concat "^" base-url "/" src "$")))))
(cond ((string-match pat1 url)
(setq result (replace-match dst nil nil url))
(setq branches nil))
((string-match pat2 url)
(setq result (replace-match dst nil nil url))
(setq branches nil)))))
result))
(defvar magit-svn-get-ref-info-cache nil
"A cache for svn-ref-info.
As `magit-get-svn-ref-info' might be considered a quite
expensive operation a cache is taken so that `magit-status'
doesn't repeatedly call it.")
(defun magit-svn-get-ref-info (&optional use-cache)
"Gather details about the current git-svn repository.
Return nil if there isn't one. Keys of the alist are ref-path,
trunk-ref-name and local-ref-name.
If USE-CACHE is non-nil then return the value of `magit-get-svn-ref-info-cache'."
(if (and use-cache magit-svn-get-ref-info-cache)
magit-svn-get-ref-info-cache
(let* ((fetch (magit-get "svn-remote" "svn" "fetch"))
(url)
(revision))
(when fetch
(let* ((ref (cadr (split-string fetch ":")))
(ref-path (file-name-directory ref))
(trunk-ref-name (file-name-nondirectory ref)))
(set (make-local-variable
'magit-svn-get-ref-info-cache)
(list
(cons 'ref-path ref-path)
(cons 'trunk-ref-name trunk-ref-name)
;; get the local ref from the log. This is actually
;; the way that git-svn does it.
(cons 'local-ref
(with-temp-buffer
(insert (or (magit-git-string "log" "--first-parent"
"--grep" "git-svn" "-1")
""))
(goto-char (point-min))
(cond ((re-search-forward "git-svn-id: \\(.+/.+?\\)@\\([0-9]+\\)" nil t)
(setq url (match-string 1)
revision (match-string 2))
(magit-svn-get-local-ref url))
(t
(setq url (magit-get "svn-remote" "svn" "url"))
nil))))
(cons 'revision revision)
(cons 'url url))))))))
(defun magit-svn-get-ref (&optional use-cache)
"Get the best guess remote ref for the current git-svn based branch.
If USE-CACHE is non nil, use the cached information."
(let ((info (magit-svn-get-ref-info use-cache)))
(cdr (assoc 'local-ref info))))
(magit-define-inserter svn-unpulled (&optional use-cache)
(when (magit-svn-enabled)
(apply #'magit-git-section
'svn-unpulled "Unpulled commits (SVN):" 'magit-wash-log "log"
(append magit-git-log-options
(list
(format "HEAD..%s" (magit-svn-get-ref use-cache)))))))
(magit-define-inserter svn-unpushed (&optional use-cache)
(when (magit-svn-enabled)
(apply #'magit-git-section
'svn-unpushed "Unpushed commits (SVN):" 'magit-wash-log "log"
(append magit-git-log-options
(list
(format "%s..HEAD" (magit-svn-get-ref use-cache)))))))
(magit-define-section-jumper svn-unpushed "Unpushed commits (SVN)")
(defun magit-svn-remote-string ()
(let ((svn-info (magit-svn-get-ref-info)))
(when svn-info
(concat (cdr (assoc 'url svn-info))
" @ "
(cdr (assoc 'revision svn-info))))))
(defun magit-svn-remote-update ()
(interactive)
(when (magit-svn-enabled)
(magit-run-git-async "svn" "fetch")))
(easy-menu-define magit-svn-extension-menu
nil
"Git SVN extension menu"
'("Git SVN"
:visible magit-svn-mode
["Create branch" magit-svn-create-branch (magit-svn-enabled)]
["Rebase" magit-svn-rebase (magit-svn-enabled)]
["Fetch" magit-svn-remote-update (magit-svn-enabled)]
["Commit" magit-svn-dcommit (magit-svn-enabled)]))
(easy-menu-add-item 'magit-mode-menu
'("Extensions")
magit-svn-extension-menu)
;; add the group and its keys
(progn
;; (re-)create the group
(magit-key-mode-add-group 'svn)
(magit-key-mode-insert-action 'svn "r" "Rebase" 'magit-svn-rebase)
(magit-key-mode-insert-action 'svn "c" "DCommit" 'magit-svn-dcommit)
(magit-key-mode-insert-action 'svn "f" "Fetch" 'magit-svn-remote-update)
(magit-key-mode-insert-action 'svn "s" "Find rev" 'magit-svn-find-rev)
(magit-key-mode-insert-action 'svn "B" "Create branch" 'magit-svn-create-branch)
;; generate and bind the menu popup function
(magit-key-mode-generate 'svn))
(defvar magit-svn-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "N") 'magit-key-mode-popup-svn)
map))
;;;###autoload
(define-minor-mode magit-svn-mode "SVN support for Magit"
:lighter " SVN" :require 'magit-svn :keymap 'magit-svn-mode-map
(or (derived-mode-p 'magit-mode)
(error "This mode only makes sense with magit"))
(let ((unpulled-hook (lambda () (magit-insert-svn-unpulled t)))
(unpushed-hook (lambda () (magit-insert-svn-unpushed t)))
(remote-hook 'magit-svn-remote-string))
(if magit-svn-mode
(progn
(add-hook 'magit-after-insert-unpulled-commits-hook unpulled-hook nil t)
(add-hook 'magit-after-insert-unpushed-commits-hook unpushed-hook nil t)
(add-hook 'magit-remote-string-hook remote-hook nil t))
(progn
(remove-hook 'magit-after-insert-unpulled-commits-hook unpulled-hook t)
(remove-hook 'magit-after-insert-unpushed-commits-hook unpushed-hook t)
(remove-hook 'magit-remote-string-hook remote-hook t)))
(when (called-interactively-p 'any)
(magit-refresh))))
;;;###autoload
(defun turn-on-magit-svn ()
"Unconditionally turn on `magit-svn-mode'."
(magit-svn-mode 1))
(provide 'magit-svn)
;;; magit-svn.el ends here

View File

@ -0,0 +1,191 @@
;;; magit-topgit.el --- topgit plug-in for Magit
;; Copyright (C) 2010 Nathan Weizenbaum
;; Copyright (C) 2010 Yann Hodique
;;
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This plug-in provides topgit functionality as a separate component of Magit
;;; Code:
(require 'magit)
(eval-when-compile
(require 'cl))
(defcustom magit-topgit-executable "tg"
"The name of the TopGit executable."
:group 'magit
:type 'string)
(defcustom magit-topgit-branch-prefix "t/"
"Convention prefix for topic branch creation."
:group 'magit
:type 'string)
(defface magit-topgit-current
'((t :weight bold :inherit magit-branch))
"Face for section titles."
:group 'magit-faces)
;;; Topic branches (using topgit)
(defun magit-topgit-in-topic-p ()
(and (file-exists-p ".topdeps")
(executable-find magit-topgit-executable)))
(defun magit-topgit-create-branch (branch parent)
(when (zerop (or (string-match magit-topgit-branch-prefix branch) -1))
(magit-run* (list magit-topgit-executable "create"
branch (magit-rev-to-git parent))
nil nil nil t)
t))
(defun magit-topgit-pull ()
(when (magit-topgit-in-topic-p)
(magit-run* (list magit-topgit-executable "update")
nil nil nil t)
t))
(defun magit-topgit-push ()
(when (magit-topgit-in-topic-p)
(let* ((branch (or (magit-get-current-branch)
(error "Don't push a detached head. That's gross")))
(remote (magit-get "topgit" "remote"))
(push-remote (if (or current-prefix-arg (not remote))
(magit-read-remote (format "Push %s to" branch))
remote)))
(when (and (not remote)
(not current-prefix-arg))
(magit-set push-remote "topgit" "remote"))
(magit-run magit-topgit-executable "push" "-r" push-remote))
t))
(defun magit-topgit-remote-update (&optional remote)
(when (magit-topgit-in-topic-p)
(let* ((remote (magit-get "topgit" "remote"))
(remote-update (if (or current-prefix-arg (not remote))
(magit-read-remote)
remote)))
(if (and (not remote)
(not current-prefix-arg))
(progn
(magit-set remote-update "topgit" "remote")
(magit-run magit-topgit-executable "remote"
"--populate" remote-update)))
(magit-run magit-topgit-executable "remote" remote-update))
;; We return nil anyway, as we also want regular "git remote update" to
;; happen
nil))
(defun magit-topgit-parse-flags (flags-string)
(let ((flags (string-to-list flags-string))
(void-flag ?\ ))
(list :current (not (eq (nth 0 flags) void-flag))
:empty (not (eq (nth 1 flags) void-flag)))))
(defun magit-topgit-wash-topic ()
(let ((fmt "^\\(.\\{7\\}\\)\\s-\\(\\S-+\\)\\s-+\\(.*\\)"))
(if (search-forward-regexp fmt (line-end-position) t)
(let ((flags (magit-topgit-parse-flags (match-string 1)))
(topic (match-string 2)))
(goto-char (line-beginning-position))
(delete-char 8)
(insert "\t")
(goto-char (line-beginning-position))
(magit-with-section topic 'topic
(magit-set-section-info topic)
(let ((beg (1+ (line-beginning-position)))
(end (line-end-position)))
(when (plist-get flags :current)
(put-text-property beg end 'face 'magit-topgit-current))
(when (plist-get flags :empty)
(put-text-property beg end 'face `(:strike-through t :inherit ,(get-text-property beg 'face)))))
(forward-line)))
(delete-region (line-beginning-position) (1+ (line-end-position))))
t))
(defun magit-topgit-wash-topics ()
(let ((magit-old-top-section nil))
(magit-wash-sequence #'magit-topgit-wash-topic)))
(defun magit-topgit-section (section title washer &rest args)
(when (executable-find magit-topgit-executable)
(let ((magit-git-executable magit-topgit-executable)
(magit-git-standard-options nil))
(apply 'magit-git-section section title washer args))))
(magit-define-inserter topics ()
(magit-topgit-section 'topics
"Topics:" 'magit-topgit-wash-topics
"summary"))
(magit-add-action (item info "discard")
((topic)
(when (yes-or-no-p "Discard topic? ")
(magit-run* (list magit-topgit-executable "delete" "-f" info)
nil nil nil t))))
(magit-add-action (item info "visit")
((topic)
(magit-checkout info)))
(defun magit-topgit-get-top-bases-color (suffix)
(list nil nil))
(defun magit-topgit-get-remote-top-bases-color (suffix)
(when (string-match "^\\(?:[^/]+\\)/top-bases" suffix)
(list nil nil)))
(defconst magit-topgit-ignored-namespace
'("top-bases" magit-topgit-get-top-bases-color))
;;;###autoload
(define-minor-mode magit-topgit-mode "Topgit support for Magit"
:lighter " Topgit" :require 'magit-topgit
(or (derived-mode-p 'magit-mode)
(error "This mode only makes sense with magit"))
(if magit-topgit-mode
(progn
(add-hook 'magit-after-insert-stashes-hook 'magit-insert-topics nil t)
(add-hook 'magit-create-branch-command-hook 'magit-topgit-create-branch nil t)
(add-hook 'magit-pull-command-hook 'magit-topgit-pull nil t)
(add-hook 'magit-remote-update-command-hook 'magit-topgit-remote-update nil t)
(add-hook 'magit-push-command-hook 'magit-topgit-push nil t)
;; hide refs for top-bases namespace in any remote
(add-hook 'magit-log-remotes-color-hook
'magit-topgit-get-remote-top-bases-color)
;; hide refs in the top-bases namespace, as they're not meant for the user
(add-to-list 'magit-refs-namespaces magit-topgit-ignored-namespace))
(progn
(remove-hook 'magit-after-insert-stashes-hook 'magit-insert-topics t)
(remove-hook 'magit-create-branch-command-hook 'magit-topgit-create-branch t)
(remove-hook 'magit-pull-command-hook 'magit-topgit-pull t)
(remove-hook 'magit-remote-update-command-hook 'magit-topgit-remote-update t)
(remove-hook 'magit-push-command-hook 'magit-topgit-push t)
(remove-hook 'magit-log-remotes-color-hook
'magit-topgit-get-remote-top-bases-color)
(delete magit-topgit-ignored-namespace magit-refs-namespaces)))
(when (called-interactively-p 'any)
(magit-refresh)))
;;;###autoload
(defun turn-on-magit-topgit ()
"Unconditionally turn on `magit-topgit-mode'."
(magit-topgit-mode 1))
(provide 'magit-topgit)
;;; magit-topgit.el ends here

View File

@ -0,0 +1,153 @@
;;; magit-wip.el --- git-wip plug-in for Magit
;; Copyright (C) 2012 Jonas Bernoulli
;; Copyright (C) 2012 Ryan C. Thompson
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This plug-in provides support for special work-in-progress refs.
;; This requires the third-party git command "git wip" which is available
;; from https://github.com/bartman/git-wip.
;; The global mode `magit-wip-mode' provides highlighting of wip refs in
;; Magit buffers while the local mode `magit-wip-save-mode' commits to
;; such a ref when saving a file-visiting buffer.
;; To enable `magit-wip-save-mode' enable `global-magit-wip-save-mode'
;; and use the Magit extension mechanism to select the repositories in
;; which you want to use a work-in-progress ref. Usually you also want
;; to enable `magit-wip-mode'.
;;
;; (magit-wip-mode 1)
;; (global-magit-wip-save-mode 1)
;;
;; $ git config --add magit.extension wip-save # or
;; $ git config --global --add magit.extension wip-save
;; Note that `global-magit-wip-save-mode' is the only mode that uses the
;; extension mechanism for file-visiting buffers all other global modes
;; making use of it to turn on local modes in Magit buffers.
;;; Code:
(require 'magit)
(require 'format-spec)
;;; Magit Wip Mode.
(defface magit-log-head-label-wip
'((((class color) (background light))
:box t
:background "Grey95"
:foreground "LightSkyBlue3")
(((class color) (background dark))
:box t
:background "Grey07"
:foreground "LightSkyBlue4"))
"Face for git-wip labels shown in log buffer."
:group 'magit-faces)
(defun magit-log-get-wip-color (suffix)
(list (concat "(WIP) " suffix)
'magit-log-head-label-wip))
(defconst magit-wip-refs-namespace
'("wip" magit-log-get-wip-color))
;;;###autoload
(define-minor-mode magit-wip-mode
"In Magit log buffers; give wip refs a special appearance."
:group 'magit
:global t
(if magit-wip-mode
(add-to-list 'magit-refs-namespaces magit-wip-refs-namespace 'append)
(setq magit-refs-namespaces
(delete magit-wip-refs-namespace magit-refs-namespaces))))
;;; Magit Wip Save Mode.
(defcustom magit-wip-commit-message "WIP %r"
"Commit message for git-wip commits.
The following `format'-like specs are supported:
%f the full name of the file being saved, and
%r the name of the file being saved, relative to the repository root
%g the root of the git repository."
:group 'magit
:type 'string)
(defcustom magit-wip-echo-area-message "Wrote %f (wip)"
"Message shown in the echo area after creating a git-wip commit.
The following `format'-like specs are supported:
%f the full name of the file being saved, and
%r the name of the file being saved, relative to the repository root.
%g the root of the git repository."
:group 'magit
:type '(choice (const :tag "No message" nil) string))
(defvar magit-wip-save-mode-lighter " Wip")
;;;###autoload
(define-minor-mode magit-wip-save-mode
"Magit support for committing to a work-in-progress ref.
When this minor mode is turned on and a file is saved inside a writable
git repository then it is also committed to a special work-in-progress
ref."
:lighter magit-wip-save-mode-lighter
(if magit-wip-save-mode
(add-hook 'after-save-hook 'magit-wip-save-safe t t)
(remove-hook 'after-save-hook 'magit-wip-save-safe t)))
;;;###autoload
(define-globalized-minor-mode global-magit-wip-save-mode
magit-wip-save-mode turn-on-magit-wip-save
:group 'magit)
(defun turn-on-magit-wip-save ()
(when (and (buffer-file-name)
(magit-get-top-dir default-directory)
(member "wip-save" (magit-get-all "magit.extension")))
(if (= (magit-git-exit-code "wip" "-h") 0)
(magit-wip-save-mode 1)
(message "Git command 'git wip' cannot be found"))))
(defun magit-wip-save-safe ()
(condition-case err
(magit-wip-save)
(error
(message "Magit WIP got an error: %S" err))))
(defun magit-wip-save ()
(let* ((top-dir (magit-get-top-dir default-directory))
(name (file-truename (buffer-file-name)))
(spec `((?r . ,(file-relative-name name top-dir))
(?f . ,(buffer-file-name))
(?g . ,top-dir))))
(when (and top-dir (file-writable-p top-dir))
(save-excursion ; kludge see https://github.com/magit/magit/issues/441
(magit-run-git "wip" "save"
(format-spec magit-wip-commit-message spec)
"--editor" "--" name))
(when magit-wip-echo-area-message
(message (format-spec magit-wip-echo-area-message spec))))))
(provide 'magit-wip)
;;; magit-wip.el ends here

5989
elpa/magit-1.2.1/magit.el Normal file

File diff suppressed because it is too large Load Diff

1362
elpa/magit-1.2.1/magit.info Normal file

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,322 @@
;;; rebase-mode -- edit git rebase files.
;; Copyright (C) 2010 Phil Jackson
;; Copyright (C) 2011 Peter J Weisberg
;;
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Allows the editing of a git rebase file (which you might get when
;; using 'git rebase -i' or hitting 'E' in Magit). Assumes editing is
;; happening in a server.
;;; Code:
(require 'server)
(defgroup rebase-mode nil
"Customize Rebase Mode"
:group 'faces)
(defface rebase-mode-killed-action-face
'((((class color))
:inherit font-lock-comment-face
:strike-through t))
"Action lines in the rebase TODO list that have been commented out."
:group 'rebase-mode)
(defface rebase-mode-description-face
'((t :inherit font-lock-comment-face))
"Face for one-line commit descriptions"
:group 'rebase-mode)
(defconst rebase-mode-action-line-re
(rx
line-start
(? "#")
(group
(|
(any "presf")
"pick"
"reword"
"edit"
"squash"
"fixup"))
(char space)
(group
(** 4 40 hex-digit)) ;sha1
(char space)
(group
(* not-newline)))
"Regexp that matches an action line in a rebase buffer.")
(defconst rebase-mode-exec-line-re
(rx
line-start
(? "#")
(group
(| "x"
"exec"))
(char space)
(group
(* not-newline)))
"Regexp that matches an exec line in a rebase buffer.")
(defconst rebase-mode-dead-line-re
(rx-to-string `(and line-start
(char ?#)
(or (regexp ,(substring rebase-mode-action-line-re 1))
(regexp ,(substring rebase-mode-exec-line-re 1)))) t)
"Regexp that matches a commented-out exec or action line in a rebase buffer.")
(defvar rebase-mode-font-lock-keywords
(list
(list rebase-mode-action-line-re
'(1 font-lock-keyword-face)
'(2 font-lock-builtin-face)
'(3 'rebase-mode-description-face))
(list rebase-mode-exec-line-re
'(1 font-lock-keyword-face))
(list (rx line-start (char "#") (* not-newline)) 0 font-lock-comment-face)
(list rebase-mode-dead-line-re 0 ''rebase-mode-killed-action-face t))
"Font lock keywords for `rebase-mode'.")
(defvar key-to-action-map
'(("c" . "pick")
("r" . "reword")
("e" . "edit")
("s" . "squash")
("f" . "fixup"))
"Mapping from key to action.")
(defvar rebase-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "q") 'server-edit)
(define-key map (kbd "C-c C-c") 'server-edit)
(define-key map (kbd "a") 'rebase-mode-abort)
(define-key map (kbd "C-c C-k") 'rebase-mode-abort)
(define-key map (kbd "M-p") 'rebase-mode-move-line-up)
(define-key map (kbd "M-n") 'rebase-mode-move-line-down)
(define-key map (kbd "k") 'rebase-mode-kill-line)
(define-key map (kbd "x") 'rebase-mode-exec)
(define-key map (kbd "n") 'forward-line)
(define-key map (kbd "p") '(lambda(n)
(interactive "p")
(forward-line (* n -1))))
(define-key map [remap undo] 'rebase-mode-undo)
map)
"Keymap for rebase-mode. Note this will be added to by the
top-level code which defines the edit functions.")
(require 'easymenu)
(easy-menu-define rebase-mode-menu rebase-mode-map
"Rebase-mode menu"
'("Rebase"
["Pick" rebase-mode-pick t]
["Reword" rebase-mode-reword t]
["Edit" rebase-mode-edit t]
["Squash" rebase-mode-squash t]
["Fixup" rebase-mode-fixup t]
["Kill" rebase-mode-kill-line t]
["Move Down" rebase-mode-move-line-down t]
["Move Up" rebase-mode-move-line-up t]
["Execute" rebase-mode-exec t]
"---"
["Abort" rebase-mode-abort t]
["Done" server-edit t]))
;; create the functions which edit the action lines themselves (based
;; on `key-to-action-map' above)
(mapc (lambda (key-action)
(let ((fun-name (intern (concat "rebase-mode-" (cdr key-action)))))
;; define the function
(eval `(defun ,fun-name ()
(interactive)
(rebase-mode-edit-line ,(cdr key-action))))
;; bind the function in `rebase-mode-map'
(define-key rebase-mode-map (car key-action) fun-name)))
key-to-action-map)
(defun rebase-mode-edit-line (change-to)
"Change the keyword at the start of the current action line to
that of CHANGE-TO."
(when (rebase-mode-looking-at-action)
(let ((buffer-read-only nil)
(start (point)))
(goto-char (point-at-bol))
(delete-region (point) (progn (forward-word 1) (point)))
(insert change-to)
(goto-char start))))
(defun rebase-mode-looking-at-action ()
"Return non-nil if looking at an action line."
(save-excursion
(goto-char (point-at-bol))
(looking-at rebase-mode-action-line-re)))
(defun rebase-mode-looking-at-action-or-exec ()
"Return non-nil if looking at an action line or exec line."
(save-excursion
(goto-char (point-at-bol))
(or (looking-at rebase-mode-action-line-re)
(looking-at rebase-mode-exec-line-re))))
(defun rebase-mode-looking-at-exec ()
"Return non-nil if cursor is on an exec line."
(string-match rebase-mode-exec-line-re (thing-at-point 'line)))
(defun rebase-mode-looking-at-killed-exec ()
"Return non-nil if looking at an exec line that has been commented out"
(let ((line (thing-at-point 'line)))
(and (eq (aref line 0) ?#)
(string-match rebase-mode-exec-line-re line))))
(defun rebase-mode-move-line-up ()
"Move the current action line up."
(interactive)
(when (rebase-mode-looking-at-action-or-exec)
(let ((buffer-read-only nil)
(col (current-column)))
(transpose-lines 1)
(forward-line -2)
(move-to-column col))))
(defun rebase-mode-move-line-down ()
"Assuming the next line is also an action line, move the current line down."
(interactive)
;; if we're on an action and the next line is also an action
(when (and (rebase-mode-looking-at-action-or-exec)
(save-excursion
(forward-line)
(rebase-mode-looking-at-action-or-exec)))
(let ((buffer-read-only nil)
(col (current-column)))
(forward-line 1)
(transpose-lines 1)
(forward-line -1)
(move-to-column col))))
(defun rebase-mode-abort ()
"Abort this rebase (by emptying the buffer, saving and closing
server connection)."
(interactive)
(when (or (not (buffer-modified-p))
(y-or-n-p "Abort this rebase? "))
(let ((buffer-read-only nil))
(delete-region (point-min) (point-max))
(save-buffer)
(server-edit))))
(defun rebase-mode-kill-line ()
"Kill the current action line."
(interactive)
(when (and (not (eq (char-after (point-at-bol)) ?#))
(rebase-mode-looking-at-action-or-exec))
(beginning-of-line)
(let ((buffer-read-only nil))
(insert "#"))
(forward-line)))
(defun rebase-mode-exec (edit)
"Prompt the user for a shell command to be executed, and add it to
the todo list.
If the cursor is on a commented-out exec line, uncomment the
current line instead of prompting.
When the prefix argument EDIT is non-nil and the cursor is on an
exec line, edit that line instead of inserting a new one. If the
exec line was commented out, also uncomment it."
(interactive "P")
(cond
((and edit (rebase-mode-looking-at-exec))
(let ((new-line (rebase-mode-read-exec-line
(match-string-no-properties 2 (thing-at-point 'line))))
(inhibit-read-only t))
(delete-region (point-at-bol) (point-at-eol))
(if (not (equal "" new-line))
(insert "exec " new-line)
(delete-char -1)
(forward-line))
(move-beginning-of-line nil)))
((rebase-mode-looking-at-killed-exec)
(save-excursion
(beginning-of-line)
(let ((buffer-read-only nil))
(delete-char 1))))
(t
(let ((inhibit-read-only t)
(line (rebase-mode-read-exec-line)))
(unless (equal "" line)
(move-end-of-line nil)
(newline)
(insert (concat "exec " line))))
(move-beginning-of-line nil))))
(defun rebase-mode-read-exec-line (&optional initial-line)
(read-shell-command "Execute: " initial-line))
(defun rebase-mode-undo (&optional arg)
"A thin wrapper around `undo', which allows undoing in
read-only buffers."
(interactive "P")
(let ((inhibit-read-only t))
(undo arg)))
;;;###autoload
(define-derived-mode rebase-mode special-mode "Rebase"
"Major mode for editing of a Git rebase file.
Rebase files are generated when you run 'git rebase -i' or run
`magit-interactive-rebase'. They describe how Git should perform
the rebase. See the documentation for git-rebase (e.g., by
running 'man git-rebase' at the command line) for details."
(setq font-lock-defaults '(rebase-mode-font-lock-keywords t t)))
(defun rebase-mode-show-keybindings ()
"Modify the \"Commands:\" section of the comment Git generates
at the bottom of the file so that in place of the one-letter
abbreviation for the command, it shows the command's keybinding.
By default, this is the same except for the \"pick\" command."
(save-excursion
(goto-char (point-min))
(while (search-forward-regexp "^# \\(.\\), \\([[:alpha:]]+\\) = " nil t)
(let ((start (match-beginning 1))
(end (match-end 1))
(command (intern (concat "rebase-mode-" (match-string 2)))))
(when (fboundp command)
(let ((overlay (make-overlay start end)))
(overlay-put overlay
'display
(key-description (where-is-internal command nil t)))))))))
(add-hook 'rebase-mode-hook 'rebase-mode-show-keybindings t)
(defun rebase-mode-disable-before-save-hook ()
(set (make-local-variable 'before-save-hook) nil))
(add-hook 'rebase-mode-hook 'rebase-mode-disable-before-save-hook)
;;;###autoload
(add-to-list 'auto-mode-alist
'("git-rebase-todo" . rebase-mode))
(provide 'rebase-mode)
;;; rebase-mode.el ends here

View File

@ -0,0 +1,36 @@
;;; magithub-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (magithub-clone) "magithub" "magithub.el" (21539
;;;;;; 11653 143280 560000))
;;; Generated autoloads from magithub.el
(autoload 'magithub-clone "magithub" "\
Clone GitHub repo USERNAME/REPO into directory DIR.
If SSHP is non-nil, clone it using the SSH URL. Once the repo is
cloned, switch to a `magit-status' buffer for it.
Interactively, prompts for the repo name and directory. With a
prefix arg, clone using SSH.
\(fn USERNAME REPO DIR &optional SSHP)" t nil)
(eval-after-load 'magit '(unless (featurep 'magithub) (require 'magithub)))
;;;***
;;;### (autoloads nil nil ("magithub-pkg.el") (21539 11653 223834
;;;;;; 758000))
;;;***
(provide 'magithub-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; magithub-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "magithub" "0.2" "Magit extensions for using GitHub" (quote ((magit "0.8") (json "1.2"))))

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,34 @@
;;; markdown-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (gfm-mode markdown-mode) "markdown-mode" "markdown-mode.el"
;;;;;; (21483 45918 447833 502000))
;;; Generated autoloads from markdown-mode.el
(autoload 'markdown-mode "markdown-mode" "\
Major mode for editing Markdown files.
\(fn)" t nil)
(autoload 'gfm-mode "markdown-mode" "\
Major mode for editing GitHub Flavored Markdown files.
\(fn)" t nil)
;;;***
;;;### (autoloads nil nil ("markdown-mode-pkg.el") (21483 45918 571803
;;;;;; 838000))
;;;***
(provide 'markdown-mode-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; markdown-mode-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "markdown-mode" "2.0" "Emacs Major mode for Markdown-formatted text files" (quote nil))

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,56 @@
<!doctype html>
<html lang="en">
<head>
<link rel="stylesheet" href="/-/bootstrap/css/bootstrap.css" type="text/css"></link>
<link rel="stylesheet" href="/-/style.css" type="text/css"></link>
<title>marmalade-repo - for all your EmacsLisp needs</title>
</head>
<body>
<div class="navbar">
<div class="navbar-inner">
<ul class="nav pull-right">
<li class="active"><a href="/">marmalade-repo</a></li>
<li><a href="/register-comingsoon">register</a></li>
</ul>
</div>
</div>
<div id="blurb">
<div class="container">
<div class="row">
<h1>marmalade-repo</h1>
<div id="loginform">
<form class="form-horizontal" name="login" action="/login/" method="POST">
<legend>login</legend>
<fieldset>
<div class="control-group">
<label class="control-label" for="username">username:</label>
<input id="username" type="text" name="username"></input>
</div>
<div class="control-group">
<label class="control-label" for="password">password:</label>
<input id="password" type="password" name="password"></input><br></br>
</div>
<div class="control-group">
<div class="controls">
<input class="btn btn-large"
type="submit" name="login" value="login"></input>
</div>
</div>
</fieldset>
</form>
</div>
</div>
</div>
</div>
<footer>
<div>
<ul class="inline">
<li><a href="/terms">terms</a></li>
<li><a href="/docs">docs</a></li>
<li><a href="https://github.com/nicferrier/elmarmalade/issues">issues</a></li>
<li>(C) Nic Ferrier 2013</li>
</ul>
</div>
</footer>
</body>
</html>

View File

@ -0,0 +1,18 @@
;;; markup-faces-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads nil nil ("markup-faces-pkg.el" "markup-faces.el")
;;;;;; (21547 4601 213727 48000))
;;;***
(provide 'markup-faces-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; markup-faces-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "markup-faces" "1.0.0" "collection of faces for markup language modes" (quote nil))

View File

@ -0,0 +1,512 @@
;;; markup-faces.el --- collection of faces for markup language modes
;;
;; Copyright 2010-2013 Florian Kaufmann <sensorflo@gmail.com>
;;
;; Author: Florian Kaufmann <sensorflo@gmail.com>
;; URL: https://github.com/sensorflo/markup-faces
;; Version: 1.0.0
;; Created: 2010
;; Keywords: wp faces
;;
;; 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:
;;
;; As font-lock-faces, but tailored for markup languages instead programming
;; languages. The sub group markup-faces-text is also intended for 'text viewing
;; modes' such as info or (wo)man. This gives a common look and feel, or let's
;; say theme, across different markup language modes and 'text viewing modes'
;; respectively.
;;; Variables:
;; todo: describe the idea of the face structure.
;; - hierarchical structure: gen for text, meta for meta
;; - within text faces, choose properties wisely so they can overlap / add on
;; - buffer face mode: distinguish between meta / text / text-typewriter
(defgroup markup-faces nil
"Collection of faces for markup language modes and text viewing modes.
More info in the commentary section of the markup-faces library.
You can access it by typing M-x finder-commentary RET
markup-faces RET."
:group 'faces)
;;; group markup-faces-text
(defgroup markup-faces-text nil
"Faces for literal text in markup languages or for text modes"
:group 'markup-faces)
(defface markup-gen-face
'((((background light))
(:foreground "medium blue"))
(((background dark))
(:foreground "skyblue")))
"Generic/base face for text with special formatting.
Typically `markup-title-0-face', `markup-strong-face' etc.
inherit from it. Also used for generic text that hasn't got it's
own dedicated face, e.g. if a markup command imposes arbitrary
colors/sizes/fonts upon it."
:group 'markup-faces-text)
(defface markup-title-0-face
'((t (:inherit markup-gen-face :height 3.0)))
"For document's title"
:group 'markup-faces-text)
(defface markup-title-1-face
'((t :inherit markup-gen-face :height 2.4))
"For level 1 (i.e. top level) chapters/sections/headings"
:group 'markup-faces-text)
(defface markup-title-2-face
'((t :inherit markup-gen-face :height 1.8))
"For level 2 chapters/sections/headings"
:group 'markup-faces-text)
(defface markup-title-3-face
'((t :inherit markup-gen-face :height 1.4 :weight bold))
"For level 3 chapters/sections/headings"
:group 'markup-faces-text)
(defface markup-title-4-face
'((t :inherit markup-gen-face :height 1.2 :slant italic))
"For level 4 chapters/sections/headings"
:group 'markup-faces-text)
(defface markup-title-5-face
'((t :inherit markup-gen-face :height 1.2 :underline t))
"For level 5 chapters/sections/headings"
:group 'markup-faces-text)
(defface markup-emphasis-face
'((t :inherit markup-gen-face :slant italic))
"For emphasized text.
For example 'foo' in the following examples:
HTML: <em>foo</em>
LaTeX: \\emph{foo}
AsciiDoc: 'foo'"
:group 'markup-faces-text)
(defface markup-strong-face
'((t :inherit markup-gen-face :weight bold))
"For strongly emphasized text.
For example 'foo' in the following examples:
HTML: <strong>foo</strong>
AsciiDoc: *foo*"
:group 'markup-faces-text)
(defface markup-code-face
'((t :inherit (fixed-pitch markup-gen-face)))
"For text representing code/filenames/identifiers/....
Note that doesn't necessairily mean that the charachters are also
verbatim. See also `markup-verbatim-face', and
`markup-typewriter-face'.
For example 'foo' in the following examples:
HTML: <code>foo</code>
HTML: <var>foo</var>"
:group 'markup-faces-text)
(defface markup-verbatim-face
'((((background light))
(:background "cornsilk"))
(((background dark))
(:background "saddlebrown")))
"For verbatim text.
Verbatim in a sense that all its characters are to be taken
verbatim/literally. Note that doesn't necessarily mean that that it is
in a typewritter font.
For example 'foo' in the following examples:
HTML: <pre>foo</pre> (verbatim and typewriter font)
LaTeX: verb|foo| (verbatim and typewriter font)
MediaWiki: <nowiki>foo</nowiki> (only verbatim)
AsciiDoc: `foo` (verbatim and typewriter font)
AsciiDoc: +++foo+++ (only verbatim)"
:group 'markup-faces-text)
(defface markup-superscript-face
'((t :inherit markup-gen-face :height 0.8))
"For superscript text.
For example 'foo' in the following examples:
HTML: <sup>foo</sup>
LaTeX: ^{foo}
AsciiDoc: ^foo^
Note that typically the major mode doing the font lock
additionaly raises the text; face customization doesn't provide
this feature."
:group 'markup-faces-text)
(defface markup-subscript-face
'((t :inherit markup-gen-face :height 0.8))
"For subscript text.
For example 'foo' in the following examples:
HTML: <sub>foo</sub>
LaTeX: _{foo}
AsciiDoc: ~foo~
Note that typically the major mode doing the font lock
additionally lowers the text; face customization doesn't provide
this feature."
:group 'markup-faces-text)
(defface markup-reference-face
'((t :inherit markup-gen-face :underline t))
"For text being a link/reference
For example 'foo' in the following examples:
HTML: <a href=\"...\">foo</a>
MediaWiki: [[...|foo]] or [... foo]
AsciiDoc: ~foo~
See also `markup-internal-reference-face'."
:group 'markup-faces-text)
;; the real thing identifying markup-secondary-text-face is the :family. height
;; and color only help (as always). NO!!! This is not true, because of
;; markup-typewriter-face, markup-code-face etc, which must also be available
;; within secondary text. Maybe its really the height which identifies it. Or
;; ist it the color :-)? Or maybe its all of them a bit - if the secondary uses
;; <big>, the others help, if the secondary text uses <tt>, the others help etc.
(defface markup-secondary-text-face
'((t :inherit markup-gen-face :foreground "firebrick" :height 0.8))
"For text that is not part of the running text.
For example for captions of tables or images, or for footnotes, or for floating text."
:group 'markup-faces-text)
(defface markup-italic-face
'((t :inherit markup-gen-face :slant italic))
"For text in italic font.
For example 'foo' in the following examples:
HTML: <i>foo</i>
LaTeX: \\textit{foo}
Mediawiki: ''foo''"
:group 'markup-faces-text)
(defface markup-bold-face
'((t :inherit markup-gen-face :weight bold))
"For text with a bold font.
For example 'foo' in the following examples:
HTML: <b>foo</b>
LaTeX: \\textbf{foo}
Mediawiki: '''foo'''"
:group 'markup-faces-text)
(defface markup-underline-face
'((t :inherit markup-gen-face :underline t))
"For explicitly underlined text.
For example 'foo' in the following examples:
HTML: <u>foo</u>."
:group 'markup-faces-text)
(defface markup-typewriter-face
'((t :inherit (fixed-pitch markup-gen-face)))
"For text in typewriter/monospaced font.
For example 'foo' in the following examples:
HTML: <tt>foo</tt> (only typewriter font)
LaTeX: \\texttt{foo} (only typewriter font)
LaTeX: verb|foo| (verbatim and typewriter font)
AsciiDoc: +foo+ (only typewriter font)
AsciiDoc: `foo` (verbatim and typewriter font)
See also `markup-verbatim-face', and `markup-typewriter-face'."
:group 'markup-faces-text)
(defface markup-small-face
'((t :inherit markup-gen-face :height 0.8))
"For text in a smaller font.
For example 'foo' in the following examples:
HTML: <small>foo</small>
LaTeX: {\\small foo}"
:group 'markup-faces-text)
(defface markup-big-face
'((t :inherit markup-gen-face :height 1.3))
"For text in bigger font.
For example 'foo' in the following examples:
HTML: <big>foo</big>
LaTeX: {\\large foo}"
:group 'markup-faces-text)
;;; group markup-faces-meta
(defgroup markup-faces-meta nil
"Faces for meta text in markup languages"
:group 'markup-faces)
(defface markup-meta-face
'((default ( :family "Monospace" ; emacs's faces.el also directly uses "Monospace", so I assume it is safe to do so
:height 90
;; dummy, see doc string
:stipple nil
:inverse-video nil
:box nil
:strike-through nil
:overline nil
:underline nil
:slant normal
:weight normal
:width normal
:foundry "unknown"))
(((background light)) (:foreground "gray65"))
(((background dark)) (:foreground "gray30")))
"Face for general meta characters and base for special meta characters.
The default sets all face properties to a value because then it's
easier for major mode to write font lock regular expressions."
;; For example in '<b>...<foo>...</b>', if <foo> is fontified before <b>, <b>
;; might then make <foo> bold, which is not the intend.
:group 'markup-faces-meta)
(define-obsolete-face-alias 'markup-delimiter-face 'markup-meta-face "23.1")
;; (defface markup-delimiter-face
;; '((t :inherit markup-meta-face))
;; "Similar to `markup-meta-face'.
;;
;; I currently think markup-meta-face is for general meta characters
;; no having their own dedicated face, markup-delimiter-face is for
;; the delimiters separating section of meta characters from normal
;; text. E.g. the '<' and '>' in HTML, which delimit the tag, which
;; is a string of mete characters.
;;
;; It's questionable whether such a distinction makes sense. The
;; right thing to do is probably to drop markup-delimiter-face
;; altogether and replace references to it with markup-meta-face.
;; Historically I often used `markup-delimiter-face' for things which
;; actually should use `markup-meta-face'."
;; :group 'markup-faces-meta)
(define-obsolete-face-alias 'markup-hide-delimiter-face 'markup-meta-hide-face "23.1")
(defface markup-meta-hide-face
'((default (:inherit markup-meta-face :height 0.8))
(((background light)) :foreground "gray75")
(((background dark)) :foreground "gray25"))
"For meta characters which can be 'hidden'.
Hidden in the sense of *almost* not visible. They don't need to
be properly seen because one knows what these characters must be;
deduced from the highlighting of the near context. E.g in
AsciiDocs '_important_', the underlines would be highlighted with
markup-hide-delimiter-face, and the text 'important' would be
highlighted with markup-emphasis-face. Because 'important' is
highlighted, one knows that it must be surrounded with the meta
characters '_', and thus the meta characters don't need to be
properly seen.
For example:
AsciiDoc: *strong emphasis text* or _emphasis text_
^ ^ ^ ^"
:group 'markup-faces-meta)
(defface markup-command-face
'((t :inherit markup-meta-face :weight bold))
"For command names.
For example 'foo' the following examples:
HTML: <foo ...>...</foo>
LaTeX: \\{foo ...}
Mediawiki: {{foo ...}}
Note however that special commands might be fontified specially.
For example in HTML's <b>important</b>, the whole tags, (i.e. '<b>'
and '</b>') might be fontified with markup-bold-face. "
:group 'markup-faces-meta)
(defface markup-attribute-face
'((t :inherit markup-meta-face :slant italic))
"For attribute names"
:group 'markup-faces-meta)
(defface markup-value-face
'((t :inherit markup-meta-face))
"For attribute values"
:group 'markup-faces-meta)
(defface markup-complex-replacement-face
'((default (:inherit markup-meta-face
:box (:line-width 2 :style released-button)))
(((background light)) (:background "plum1" :foreground "purple3" :box (:color "plum1")))
(((background dark)) (:background "purple3" :foreground "plum1" :box (:color "purple3"))))
"Markup that is replaced by something complex.
For example an image, or a table of contents. See also
`markup-replacement-face'.
Examples:
MediaWiki: __TOC__
AsciiDoc: image:...[...]"
:group 'markup-faces-meta)
(defface markup-list-face
'((default (:inherit markup-meta-face))
(((background light)) (:background "plum1" :foreground "purple3"))
(((background dark)) (:background "purple3" :foreground "plum1")))
"For the bullets or numberings of list items."
:group 'markup-faces-meta)
(defface markup-table-face
'((default (:inherit markup-meta-face))
(((background light)) (:background "light blue" :foreground "royal blue"))
(((background dark)) (:background "dark blue" :foreground "dodger blue")))
"For the start / end delimiter of a table."
:group 'markup-faces-meta)
(defface markup-table-row-face
'((t :inherit markup-table-face))
"For the row start delimiter."
:group 'markup-faces-meta)
(defface markup-table-cell-face
'((default (:inherit markup-table-face))
(((background light)) (:background "lavender"))
(((background dark)) (:background "royal blue")))
"for the cell start delimiter."
:group 'markup-faces-meta)
(defface markup-anchor-face
'((t :inherit markup-meta-face :overline t))
"For the name/id of an anchor.
For example 'foo' in the following examples:
HTML: <a name=foo>...</a>
LaTeX: \\label{foo}
AsciiDoc: [[foo]]
See also `markup-internal-reference-face'"
:group 'markup-faces-meta)
(defface markup-internal-reference-face
'((t :inherit markup-meta-face :underline t))
"For an internal reference.
For example 'foo' in the following examples:
HTML: <a ref=foo>...</a>
MediaWiki: [[foo|...]] or [foo ...]
See also `markup-reference-face' and `markup-anchor-face'."
:group 'markup-faces-meta)
(defface markup-comment-face
'((t :inherit (font-lock-comment-face markup-meta-face)))
"For comments"
:group 'markup-faces-meta)
(defface markup-preprocessor-face
'((t :inherit (font-lock-preprocessor-face markup-meta-face)))
"For preprocessor constructs"
:group 'markup-faces-meta)
;;; group markup-faces-hybrid
(defgroup markup-faces-hybrid nil
"Faces for text that neither really fits in the literal nor the meta group"
:group 'markup-faces)
(defface markup-replacement-face
'((default (:family "Monospace"))
(((background light)) (:foreground "purple3"))
(((background dark)) (:foreground "plum1")))
"Meta characters that are replaced by text in the output.
See also `markup-complex-replacement-face'.
For example
AsciiDoc: '->' is replaced by an Unicode arrow
MediaWiki: In '{{Main|...}}', the part 'Main' is replaced by 'Main article: '
HTML: character entities: '&amp;' is replaced by an ampersand ('&')
It's difficult to say whether markup-replacement-face is part of
the group markup-faces-meta or part of the group
markup-faces-text. Technically they are clearly meta characters.
However they are just another representation of normal text and I
want to fontify them as such. E.g. in HTML '<b>foo &amp; bar</b>',
the output 'foo & bar' is fontified bold, thus I also want 'foo
&amp; bar' in the Emacs buffer be fontified with
markup-bold-face. Thus markup-replacement-face needs to be
something that is orthogonal to the markup-bold-face etc faces."
:group 'markup-faces-hybrid)
(defface markup-passthrough-face
'((t :inherit (fixed-pitch markup-gen-face)))
"For text that is passed through yet another parser/renderer.
Since this text is passed to an arbitrary renderer, it is unknown
wich of its chars are meta characters and which are literal characters."
:group 'markup-faces-hybrid)
;; todo: Make sure to avoid the error case that at the end something highlighted
;; with markup-error-face is not visible as such because some other face
;; prepended itself before it. Mmmh, however that would be the responsibility of
;; the major mode doing the font locking.
(defface markup-error-face
'((t :inherit (font-lock-warning-face)))
"For things that should stand out"
:group 'markup-faces-hybrid)
;;; ---
(defvar markup-gen-face 'markup-gen-face)
(defvar markup-title-0-face 'markup-title-0-face)
(defvar markup-title-1-face 'markup-title-1-face)
(defvar markup-title-2-face 'markup-title-2-face)
(defvar markup-title-3-face 'markup-title-3-face)
(defvar markup-title-4-face 'markup-title-4-face)
(defvar markup-title-5-face 'markup-title-5-face)
(defvar markup-emphasis-face 'markup-emphasis-face)
(defvar markup-strong-face 'markup-strong-face)
(defvar markup-verbatim-face 'markup-verbatim-face)
(defvar markup-code-face 'markup-code-face)
(defvar markup-superscript-face 'markup-superscript-face)
(defvar markup-subscript-face 'markup-subscript-face)
(defvar markup-reference-face 'markup-reference-face)
(defvar markup-secondary-text-face 'markup-secondary-text-face)
(defvar markup-italic-face 'markup-italic-face)
(defvar markup-bold-face 'markup-bold-face)
(defvar markup-underline-face 'markup-underline-face)
(defvar markup-typewriter-face 'markup-typewriter-face)
(defvar markup-small-face 'markup-small-face)
(defvar markup-big-face 'markup-big-face)
(defvar markup-meta-face 'markup-meta-face)
(defvaralias 'markup-delimiter-face 'markup-meta-face)
(defvar markup-meta-hide-face 'markup-meta-hide-face)
(defvaralias 'markup-hide-delimiter-face 'markup-meta-hide-face)
(defvar markup-command-face 'markup-command-face)
(defvar markup-attribute-face 'markup-attribute-face)
(defvar markup-value-face 'markup-value-face)
(defvar markup-complex-replacement-face 'markup-complex-replacement-face)
(defvar markup-list-face 'markup-list-face)
(defvar markup-table-face 'markup-table-face)
(defvar markup-table-row-face 'markup-table-row-face)
(defvar markup-table-cell-face 'markup-table-cell-face)
(defvar markup-anchor-face 'markup-anchor-face)
(defvar markup-internal-reference-face 'markup-internal-reference-face)
(defvar markup-comment-face 'markup-comment-face)
(defvar markup-preprocessor-face 'markup-preprocessor-face)
(defvar markup-replacement-face 'markup-replacement-face)
(defvar markup-passthrough-face 'markup-passthrough-face)
(defvar markup-error-face 'markup-error-face)
(provide 'markup-faces)
;;; markup-faces.el ends here

View File

@ -0,0 +1,38 @@
;;; minimap-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (minimap-mode) "minimap" "minimap.el" (21553 16341
;;;;;; 474124 681000))
;;; Generated autoloads from minimap.el
(defvar minimap-mode nil "\
Non-nil if Minimap mode is enabled.
See the command `minimap-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 `minimap-mode'.")
(custom-autoload 'minimap-mode "minimap" nil)
(autoload 'minimap-mode "minimap" "\
Toggle minimap mode.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil nil ("minimap-pkg.el") (21553 16341 559770
;;;;;; 203000))
;;;***
(provide 'minimap-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; minimap-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "minimap" "1.2" "Sidebar showing a \"mini-map\" of a buffer" (quote nil))

904
elpa/minimap-1.2/minimap.el Normal file
View File

@ -0,0 +1,904 @@
;;; minimap.el --- Sidebar showing a "mini-map" of a buffer
;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: David Engster <deng@randomsample.de>
;; Keywords:
;; Version: 1.2
;; This file is 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 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, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file is an implementation of a minimap sidebar, i.e., a
;; smaller display of the current buffer on the left side. It
;; highlights the currently shown region and updates its position
;; automatically. You can navigate in the minibar by dragging the
;; active region with the mouse, which will scroll the corresponding
;; edit buffer. Additionally, you can overlay information from the
;; tags gathered by CEDET's semantic analyzer.
;; Simply use M-x minimap-mode to toggle activation of the minimap.
;; Use 'M-x customize-group RET minimap RET' to adapt minimap to your
;; needs.
;;; KNOWN BUGS:
;; * Currently cannot deal with images.
;; * Display/movement can be a bit erratic at times.
;;; TODO:
;; * Fix known bugs.
;; * Make sidebar permanently visible. This requires something like a
;; 'window group' feature in Emacs, which is currently being worked on.
;; * Moving the active region with the keyboard / mouse-wheel ?
;;; News:
;;
;;;; Changes since v1.1:
;;
;; - Change some defaults: better colors, reduced update delay.
;; - `minimap-tag-only': New experimental feature to only display an
;; 'abstract view' of the buffer with overlays generated from
;; Semantic information. Works only for buffers parsed by Semantic.
;; - `minimap-highlight-line': Highlight current line in Minimap.
;; - Fix autoloads.
;; - Display lines denoting beginning/end of functions in Semantic
;; overlays.
;;
;;;; Changes since v1.0:
;;
;; - Largely rewritten as a minor mode; use M-x minimap-mode to
;; enable/disable.
;; - Minimap will now remain active for all buffers which derive from
;; `prog-mode' (can be changed through `minimap-major-modes'). The
;; minimap window will be automatically created or deleted (see new
;; variables `minimap-recreate-window' and
;; `minimap-automatically-delete-window').
;; - Possibility to set a minimum width of the minimap window
;; (`minimap-minimum-width').
;; - Minimap window will be marked so that you should not be able to
;; enter it.
;; - Semantic overlays will be automatically updated during editing.
;; - Lots of bug fixes.
(defgroup minimap nil
"A minimap sidebar for Emacs."
:group 'convenience)
(defface minimap-font-face
'((default :family "DejaVu Sans Mono" :height 30))
"Face used for text in minimap buffer, notably the font family and height.
This height should be really small. You probably want to use a
TrueType font for this. After changing this, you should
recreate the minimap to avoid problems with recentering."
:group 'minimap)
(defface minimap-active-region-background
'((((background dark)) (:background "#700000"))
(t (:background "#C847D8FEFFFF")))
"Face for the active region in the minimap.
By default, this is only a different background color."
:group 'minimap)
(defface minimap-semantic-function-face
'((((background dark))
(:box (:line-width 1 :color "white")
:inherit (font-lock-function-name-face minimap-font-face)
:height 2.75 :background "#202414"))
(t (:box (:line-width 1 :color "black")
:inherit (font-lock-function-name-face minimap-font-face)
:height 2.75 :background "gray90")))
"Face used for functions in the semantic overlay.")
(defface minimap-semantic-variable-face
'((((background dark))
(:box (:line-width 1 :color "white")
:inherit (font-lock-variable-name-face minimap-font-face)
:height 2.75 :background "gray10"))
(t (:box (:line-width 1 :color "black")
:inherit (font-lock-function-name-face minimap-font-face)
:height 2.75 :background "gray90")))
"Face used for variables in the semantic overlay.")
(defface minimap-semantic-type-face
'((((background dark))
(:box (:line-width 1 :color "white")
:inherit (font-lock-type-face minimap-font-face)
:height 2.75 :background "gray10"))
(t (:box (:line-width 1 :color "black")
:inherit (font-lock-function-name-face minimap-font-face)
:height 2.75 :background "gray90")))
"Face used for types in the semantic overlay.")
(defcustom minimap-width-fraction 0.15
"Fraction of width which should be used for minimap sidebar."
:type 'number
:group 'minimap)
(defcustom minimap-minimum-width 30
"Minimum width of minimap in characters (default size).
Use nil to disable."
:type 'number
:group 'minimap)
(defcustom minimap-window-location 'left
"Location of the minimap window.
Can be either the symbol `left' or `right'."
:type '(choice (const :tag "Left" left)
(const :tag "Right" right))
:group 'minimap)
(defcustom minimap-buffer-name " *MINIMAP*"
"Buffer name of minimap sidebar."
:type 'string
:group 'minimap)
(defcustom minimap-update-delay 0.1
"Delay in seconds after which sidebar gets updated.
Setting this to 0 will let the minimap react immediately, but
this will slow down scrolling."
:type 'number
:set (lambda (sym value)
(set sym value)
(when (and (boundp 'minimap-timer-object)
minimap-timer-object)
(cancel-timer minimap-timer-object)
(setq minimap-timer-object
(run-with-idle-timer
minimap-update-delay t 'minimap-update))))
:group 'minimap)
(defcustom minimap-always-recenter nil
"Whether minimap sidebar should be recentered after every point movement."
:type 'boolean
:group 'minimap)
(defcustom minimap-recenter-type 'relative
"Specifies the type of recentering the minimap should use.
The minimap can use different types of recentering, i.e., how the
minimap should behave when you scroll in the main window or when
you drag the active region with the mouse. The following
explanations will probably not help much, so simply try them and
choose the one which suits you best.
`relative' -- The position of the active region in the minimap
corresponds with the relative position of this region in the
buffer. This the default.
`middle' -- The active region will stay fixed in the middle of
the minimap.
`free' -- The position will be more or less free. When dragging
the active region, the minimap will scroll when you reach the
bottom or top."
:type '(choice (const :tag "Relative" relative)
(const :tag "Middle" middle)
(const :tag "Free" free))
:group 'minimap)
(defcustom minimap-hide-scroll-bar t
"Whether the minimap should hide the vertical scrollbar."
:type 'boolean
:group 'minimap)
(defcustom minimap-hide-fringes nil
"Whether the minimap should hide the fringes."
:type 'boolean
:group 'minimap)
(defcustom minimap-dedicated-window t
"Whether the minimap should create a dedicated window."
:type 'boolean
:group 'minimap)
(defcustom minimap-display-semantic-overlays t
"Display overlays from CEDET's semantic analyzer.
If you use CEDET and the buffer's major-mode is supported, the
minimap can display overlays generated by the semantic analyzer.
By default, it will apply the faces `minimap-semantic-<X>-face',
with <X> being \"function\", \"variable\" and \"type\". Also, it
will display the name of the tag in the middle of the overlay in
the corresponding font-lock face.
See also `minimap-enlarge-certain-faces', which can be used as
fallback."
:type 'boolean
:group 'minimap)
(defcustom minimap-enlarge-certain-faces 'as-fallback
"Whether certain faces should be enlarged in the minimap.
All faces listed in `minimap-normal-height-faces' will be
displayed using the default font height, allowing you to still
read text using those faces. By default, this should enlarge all
function names in the minimap, given you have font locking
enabled. This variable can have the following values:
'as-fallback (the default) -- The feature will only be activated
if information from CEDET's semantic analyzer isn't available
(see: `minimap-display-semantic-overlays').
'always -- Always active.
nil -- Inactive."
:type '(choice (const :tag "Fallback if CEDET unavailable." 'as-fallback)
(const :tag "Always active." 'always)
(const :tag "Inactive." nil))
:group 'minimap)
(defcustom minimap-normal-height-faces '(font-lock-function-name-face)
"List of faces which should be displayed with normal height.
When `minimap-enlarge-certain-faces' is non-nil, all faces in
this list will be displayed using the default font height. By
default, this list contains `font-lock-function-name-face', so
you can still read function names in the minimap."
:type '(repeat face)
:group 'minimap)
(defcustom minimap-sync-overlay-properties '(face invisible)
"Specifies which overlay properties should be synced.
Unlike text properties, overlays are not applied automatically to
the minimap and must be explicitly synced. This variable
specifies which overlay properties should be synced by
`minimap-sync-overlays'. Most importantly, this variable should
include 'invisible', so that hidden text does not appear in the
minimap buffer."
:type '(repeat symbol)
:group 'minimap)
(defcustom minimap-major-modes '(prog-mode)
"Major modes for which a minimap should be created.
This can also be a parent mode like 'prog-mode.
If nil, a minimap must be explicitly created for each buffer."
:type '(repeat symbol)
:group 'minimap)
(defcustom minimap-recreate-window t
"Whether the minimap window should be automatically re-created.
If this is non-nil, the side window for the minimap will be
automatically re-created as soon as you kill it."
:type 'boolean
:group 'minimap)
(defcustom minimap-automatically-delete-window t
"Whether the minimap window should be automatically deleted.
Setting this to non-nil will delete the minibuffer side window
when you enter a buffer which is not derived from
`minimap-major-modes' (excluding the minibuffer)."
:type 'boolean
:group 'minimap)
(defcustom minimap-tag-only nil
"Whether the minimap should only display parsed tags from CEDET."
:type 'boolean
:group 'minimap)
(defcustom minimap-highlight-line t
"Whether the minimap should highlight the current line."
:type 'boolean
:group 'minimap)
;;; Internal variables
;; The buffer currently displayed in the minimap
(defvar minimap-active-buffer nil)
;; Window start/end from the base buffer
(defvar minimap-start nil)
(defvar minimap-end nil)
;; General overlay for the minimap
(defvar minimap-base-overlay nil)
;; Overlay for the active region
(defvar minimap-active-overlay nil)
;; Timer
(defvar minimap-timer-object nil)
;; Lines the minimap can display
(defvar minimap-numlines nil)
(defvar minimap-pointmin-overlay nil)
;; Line overlay
(defvar minimap-line-overlay nil)
;;; Helpers
(defun minimap-active-current-buffer-p ()
"Whether the current buffer is displayed in the minimap."
(and (eq (current-buffer) minimap-active-buffer)
(get-buffer minimap-buffer-name)
(with-current-buffer minimap-buffer-name
(eq minimap-active-buffer (buffer-base-buffer)))))
(defsubst minimap-get-window ()
"Get current minimap window."
(when (get-buffer minimap-buffer-name)
(get-buffer-window minimap-buffer-name)))
(defsubst minimap-kill-buffer ()
"Kill the minimap buffer."
(when (get-buffer minimap-buffer-name)
(kill-buffer minimap-buffer-name)))
(defun minimap-create-window ()
(let ((width (round (* (window-width)
minimap-width-fraction))))
(when (< width minimap-minimum-width)
(setq width minimap-minimum-width))
(if (eq minimap-window-location 'left)
(split-window-horizontally width)
(split-window-horizontally
(* -1 width))
(other-window 1))
;; Set up the minimap window:
;; You should not be able to enter the minimap window.
(set-window-parameter nil 'no-other-window t)
;; Hide things.
(when minimap-hide-scroll-bar
(setq vertical-scroll-bar nil))
(when minimap-hide-fringes
(set-window-fringes nil 0 0))
;; Switch to buffer.
(switch-to-buffer
(get-buffer-create minimap-buffer-name) t t)
;; Do not fold lines in the minimap.
(setq truncate-lines t)
;; Make it dedicated.
(when minimap-dedicated-window
(set-window-dedicated-p nil t))
(prog1
(selected-window)
(other-window 1))))
(defun minimap-setup-hooks (&optional remove)
"Hook minimap into other modes.
If REMOVE is non-nil, remove minimap from other modes."
(if remove
(progn
(remove-hook 'outline-view-change-hook 'minimap-sync-overlays)
(remove-hook 'hs-hide-hook 'minimap-sync-overlays)
(remove-hook 'hs-show-hook 'minimap-sync-overlays))
;; outline-(minor-)mode
(add-hook 'outline-view-change-hook 'minimap-sync-overlays)
;; hideshow
(add-hook 'hs-hide-hook 'minimap-sync-overlays)
(add-hook 'hs-show-hook 'minimap-sync-overlays)))
;;; Minimap creation / killing
;;;###autoload
(define-minor-mode minimap-mode
"Toggle minimap mode."
:global t
:group 'minimap
:lighter " MMap"
(if minimap-mode
(progn
(when (and minimap-major-modes
(apply 'derived-mode-p minimap-major-modes))
(unless (minimap-get-window)
(minimap-create-window))
;; Create minimap.
(minimap-new-minimap))
;; Create timer.
(setq minimap-timer-object
(run-with-idle-timer minimap-update-delay t 'minimap-update))
;; Hook into other modes.
(minimap-setup-hooks))
;; Turn it off
(minimap-kill)
(minimap-setup-hooks t)))
(defun minimap-create ()
"Create a minimap sidebar."
(interactive)
(minimap-mode 1))
(defun minimap-new-minimap ()
"Create new minimap BUFNAME for current buffer and window.
Re-use already existing minimap window if possible."
(interactive)
(let ((currentbuffer (current-buffer))
(win (minimap-get-window))
(indbuf (make-indirect-buffer (current-buffer)
(concat minimap-buffer-name "_temp")))
(edges (window-pixel-edges)))
;; Remember the active buffer currently displayed in the minimap.
(setq minimap-active-buffer (current-buffer))
;; Hook into CEDET if necessary.
(when (and minimap-display-semantic-overlays
(boundp 'semantic-after-toplevel-cache-change-hook))
(add-hook 'semantic-after-partial-cache-change-hook
'minimap-apply-semantic-overlays nil t)
(add-hook 'semantic-after-toplevel-cache-change-hook
'minimap-apply-semantic-overlays nil t))
(with-selected-window win
;; Now set up the minimap:
(when (window-dedicated-p)
(set-window-dedicated-p nil nil))
(switch-to-buffer indbuf t t)
(minimap-kill-buffer)
(rename-buffer minimap-buffer-name)
;; Do not fold lines in the minimap.
(setq truncate-lines t)
(when minimap-dedicated-window
(set-window-dedicated-p nil t))
(setq minimap-base-overlay (make-overlay (point-min) (point-max) nil t t))
(overlay-put minimap-base-overlay 'face 'minimap-font-face)
(overlay-put minimap-base-overlay 'priority 1)
(when minimap-tag-only
(overlay-put minimap-base-overlay 'face
`(:inherit minimap-font-face
:foreground ,(face-background 'default))))
(setq minimap-pointmin-overlay (make-overlay (point-min) (1+ (point-min))))
(setq minimap-start (window-start)
minimap-end (window-end)
minimap-active-overlay (make-overlay minimap-start minimap-end)
line-spacing 0)
(overlay-put minimap-active-overlay 'face
'minimap-active-region-background)
(when minimap-tag-only
(overlay-put minimap-active-overlay 'face
`(:inherit 'minimap-active-region-background
:foreground ,(face-background 'minimap-active-region-background))))
(overlay-put minimap-active-overlay 'priority 5)
(minimap-sb-mode 1)
(when (and (boundp 'linum-mode)
linum-mode)
(linum-mode 0))
(setq buffer-read-only t)
;; Calculate the actual number of lines displayable with the minimap face.
(setq minimap-numlines
(floor
(/
(- (nth 3 edges) (nth 1 edges))
(car (progn (redisplay t) (window-line-height)))))))
(minimap-sync-overlays)))
(defun minimap-kill ()
"Kill minimap."
(interactive)
(when (minimap-get-window)
(delete-window (minimap-get-window)))
(cancel-timer minimap-timer-object))
;;; Minimap update
(defun minimap-update (&optional force)
"Update minimap sidebar if necessary.
This is meant to be called from the idle-timer or the post command hook.
When FORCE, enforce update of the active region."
(interactive)
;; If we are in the minibuffer, do nothing.
(unless (active-minibuffer-window)
(if (minimap-active-current-buffer-p)
;; We are still in the same buffer, so just update the minimap.
(let ((win (minimap-get-window))
(start (window-start))
(end (window-end))
(pt (point)))
(when (and (null win)
minimap-recreate-window)
;; The minimap window is no longer visible, so create it again...
(setq win (minimap-create-window))
;; ...and switch to existing minimap buffer.
(with-selected-window win
(when (window-dedicated-p)
(set-window-dedicated-p nil nil))
(switch-to-buffer minimap-buffer-name t t)
(when minimap-dedicated-window
(set-window-dedicated-p nil t))))
(with-selected-window win
;; Make sure the base overlay spans the whole buffer.
(unless (and (= (overlay-start minimap-base-overlay) (point-min))
(= (overlay-end minimap-base-overlay) (point-max)))
(move-overlay minimap-base-overlay (point-min) (point-max)))
(unless (and (not force)
(= minimap-start start)
(= minimap-end end))
;; Update the overlay.
(move-overlay minimap-active-overlay start end)
(setq minimap-start start
minimap-end end)
(minimap-recenter (line-number-at-pos (/ (+ end start) 2))
(/ (- (line-number-at-pos end)
(line-number-at-pos start))
2)))
(goto-char pt)
(beginning-of-line)
(unless minimap-line-overlay
(setq minimap-line-overlay (make-overlay (point) (1+ (point)) nil t))
(overlay-put minimap-line-overlay 'face '(:background "yellow" :foreground "yellow"))
(overlay-put minimap-line-overlay 'priority 6))
(move-overlay minimap-line-overlay (point) (line-beginning-position 2))
(when minimap-always-recenter
(recenter (round (/ (window-height) 2)))))
;; Redisplay
(sit-for 0))
;; The buffer was switched, check if the minimap should switch, too.
(if (and minimap-major-modes
(apply 'derived-mode-p minimap-major-modes))
(progn
;; Create window if necessary...
(unless (minimap-get-window)
(minimap-create-window))
;; ...and re-create minimap with new buffer...
(minimap-new-minimap)
;; Redisplay
(sit-for 0)
;; ...and call update again.
(minimap-update t))
;; Otherwise, delete window if the user so wishes.
(when (and (minimap-get-window)
minimap-automatically-delete-window)
;; We wait a tiny bit before deleting the window, since we
;; might only be temporarily in another buffer.
(run-with-timer 0.3 nil
(lambda ()
(when (and (null (minimap-active-current-buffer-p))
(minimap-get-window))
(delete-window (minimap-get-window))))))))))
;;; Overlay movement
(defun minimap-move-overlay-mouse (start-event)
"Move overlay by tracking mouse movement."
(interactive "e")
(mouse-set-point start-event)
(when (get-buffer-window (buffer-base-buffer (current-buffer)))
(let* ((echo-keystrokes 0)
(end-posn (event-end start-event))
(start-point (posn-point end-posn))
(make-cursor-line-fully-visible nil)
(cursor-type nil)
(minimap-automatically-delete-window nil)
(pcselmode (when (boundp 'pc-selection-mode)
pc-selection-mode))
pt ev)
(when (and pcselmode (fboundp 'pc-selection-mode))
(pc-selection-mode -1))
(move-overlay minimap-active-overlay start-point minimap-end)
(track-mouse
(minimap-set-overlay start-point)
(while (and
(consp (setq ev (read-event)))
(eq (car ev) 'mouse-movement))
(setq pt (posn-point (event-start ev)))
(when (numberp pt)
(goto-char pt)
(beginning-of-line)
(minimap-set-overlay (point)))))
(select-window (get-buffer-window (buffer-base-buffer)))
(minimap-update)
(when (and pcselmode (fboundp 'pc-selection-mode))
(pc-selection-mode 1)))))
(defun minimap-set-overlay (pt)
"Set overlay position, with PT being the middle."
(goto-char pt)
(let* ((ovstartline (line-number-at-pos minimap-start))
(ovendline (line-number-at-pos minimap-end))
(ovheight (round (/ (- ovendline ovstartline) 2)))
(line (line-number-at-pos))
(winstart (window-start))
(winend (window-end))
newstart newend)
(setq pt (point-at-bol))
(setq newstart (minimap-line-to-pos (- line ovheight)))
;; Perform recentering
(minimap-recenter line ovheight)
;; Set new position in main buffer and redisplay
(with-selected-window (get-buffer-window (buffer-base-buffer))
(goto-char pt)
(set-window-start nil newstart)
(redisplay t)
(setq newend (window-end)))
(when (eq minimap-recenter-type 'free)
(while (> newend winend)
(scroll-up 5)
(redisplay t)
(setq winend (window-end))))
(move-overlay minimap-active-overlay newstart newend)))
(defun minimap-line-to-pos (line)
"Return point position of line number LINE."
(save-excursion
(goto-char 1)
(if (eq selective-display t)
(re-search-forward "[\n\C-m]" nil 'end (1- line))
(forward-line (1- line)))
(point)))
(defun minimap-recenter (middle height)
"Recenter the minimap according to `minimap-recenter-type'.
MIDDLE is the line number in the middle of the active region.
HEIGHT is the number of lines from MIDDLE to begin/end of the
active region."
(cond
;; Relative recentering
((eq minimap-recenter-type 'relative)
(let* ((maxlines (line-number-at-pos (point-max)))
percentage relpos newline start numlines)
(setq numlines (count-lines (window-start) (window-end)))
(setq percentage (/ (float middle) (float maxlines)))
(setq newline (ceiling (* percentage numlines)))
(setq start (minimap-line-to-pos
(- middle height
(floor (* percentage
(- numlines height height))))))
(or (> start (point-min))
(setq start (point-min)))
;; If (point-max) already visible, don't go further
(if (and (> start (window-start))
(with-selected-window (get-buffer-window (buffer-base-buffer))
(= (point-max) (window-end))))
(save-excursion
(goto-char (point-max))
(recenter -1))
(unless (and (> start (window-start))
(= (point-max) (window-end)))
(set-window-start nil start)))))
;; Middle recentering
((eq minimap-recenter-type 'middle)
(let ((start (- middle height
(floor (* 0.5
(- minimap-numlines height height))))))
(if (< start 1)
(progn
;; Hack: Emacs cannot scroll down any further, so we fake
;; it using an overlay. Otherwise, the active region
;; would move to the top.
(overlay-put minimap-pointmin-overlay
'display (concat
(make-string (abs start) 10)
(buffer-substring (point-min) (1+ (point-min)))))
(overlay-put minimap-pointmin-overlay
'face `(:background ,(face-background 'default)))
(overlay-put minimap-pointmin-overlay
'priority 10)
(setq start 1))
(overlay-put minimap-pointmin-overlay 'display "")
(overlay-put minimap-pointmin-overlay 'face nil))
(set-window-start nil (minimap-line-to-pos start))))
;; Free recentering
((eq minimap-recenter-type 'free)
(let ((newstart (minimap-line-to-pos (- middle height)))
(winstart (window-start)))
(while (< newstart winstart)
(scroll-down 5)
(redisplay t)
(setq winstart (window-start)))))))
;;; Minimap minor mode
(defvar minimap-sb-mode-map (make-sparse-keymap)
"Keymap used by `minimap-sb-mode'.")
(define-key minimap-sb-mode-map [down-mouse-1] 'minimap-move-overlay-mouse)
(define-key minimap-sb-mode-map [down-mouse-2] 'minimap-move-overlay-mouse)
(define-key minimap-sb-mode-map [down-mouse-3] 'minimap-move-overlay-mouse)
(define-minor-mode minimap-sb-mode
"Minor mode for minimap sidebar."
nil "minimap" minimap-sb-mode-map)
;;; Sync minimap with modes which create/delete overlays.
(defun minimap-sync-overlays ()
"Synchronize overlays between base and minimap buffer.
Apply semantic overlays or face enlargement if necessary."
(interactive)
;; Get overlays and Semantic status from base buffer.
(when (and minimap-mode
(minimap-active-current-buffer-p))
(with-current-buffer minimap-active-buffer
(let ((baseov (overlays-in (point-min) (point-max)))
(semantic (and (boundp 'semantic-version)
(semantic-active-p)))
ov props p)
;; Apply overlays to minimap.
(with-current-buffer minimap-buffer-name
;; Delete overlays (but keep our own).
(let ((ovs (overlays-in (point-min) (point-max))))
(dolist (ov ovs)
(unless (member ov (list minimap-pointmin-overlay
minimap-base-overlay
minimap-active-overlay))
(delete-overlay ov))))
(while baseov
(when (and (eq (overlay-buffer (car baseov)) minimap-active-buffer)
(setq props (minimap-get-sync-properties (car baseov))))
(setq ov (make-overlay (overlay-start (car baseov))
(overlay-end (car baseov))))
(while (setq p (car props))
(overlay-put ov (car p) (cadr p))
(setq props (cdr props))))
(setq baseov (cdr baseov)))
(move-overlay minimap-pointmin-overlay (point-min) (1+ (point-min)))
;; Re-apply font overlay
(move-overlay minimap-base-overlay (point-min) (point-max)))
;; Face enlargement
(when (and font-lock-mode
(or (eq minimap-enlarge-certain-faces 'always)
(and (eq minimap-enlarge-certain-faces 'as-fallback)
(or (not minimap-display-semantic-overlays)
(not semantic)))))
(when (eq font-lock-support-mode 'jit-lock-mode)
(jit-lock-fontify-now))
(minimap-enlarge-faces))
;; Semantic overlays
(when (and semantic
minimap-display-semantic-overlays)
(minimap-apply-semantic-overlays t))))))
(defun minimap-get-sync-properties (ov)
"Get properties from overlay OV which should be synced.
You can specify those properties with
`minimap-sync-overlay-properties'."
(let ((syncprops minimap-sync-overlay-properties))
(when minimap-tag-only
(setq syncprops (delq 'face syncprops)))
(delq nil
(mapcar
(lambda (p)
(let ((val (overlay-get ov p)))
(if val
(list p val)
nil)))
syncprops))))
(defun minimap-enlarge-faces ()
"Apply default font to all faces in `minimap-normal-height-faces'."
(let ((pos (next-single-property-change (point-min) 'face))
next ov face)
(while pos
(setq face (get-text-property pos 'face))
(when (and face
(member face minimap-normal-height-faces))
(with-current-buffer minimap-buffer-name
(setq ov
(make-overlay pos
(setq pos (next-single-property-change pos 'face))))
(overlay-put ov 'face `(:family ,(face-font 'default)))
(overlay-put ov 'priority 5)))
(setq pos (next-single-property-change pos 'face)))))
(defun minimap-apply-semantic-overlays (tags)
"Apply semantic overlays to the minimap.
TAGS is the list of tags. If it is t, fetch tags from buffer."
(when (and tags
minimap-mode)
(with-current-buffer minimap-active-buffer
(let (tag class ov ovnew)
(when (eq tags t)
(setq tags (semantic-fetch-tags)))
(while tags
(setq tag (car tags))
(setq class (semantic-tag-class tag))
(setq ov (semantic-tag-overlay tag))
(when (and (overlayp ov)
(or (eq class 'function)
(eq class 'type)
(eq class 'variable)))
(with-current-buffer minimap-buffer-name
(let* ((start (overlay-start ov))
(end (overlay-end ov))
(name (semantic-tag-name tag))
(lstart (line-number-at-pos start))
(lend (line-number-at-pos end)))
;; First, remove old Semantic overlays.
(remove-overlays start end 'minimap-semantic t)
(if minimap-tag-only
;; Now put the new ones.
(overlay-put
(setq ovnew (make-overlay start end))
'face `(:background ,(face-background
(intern (format "minimap-semantic-%s-face"
(symbol-name class))))
:foreground
,(face-background
(intern (format "minimap-semantic-%s-face"
(symbol-name class))))
))
;; Now put the new ones.
(overlay-put
(setq ovnew (make-overlay start end))
'face `(:background ,(face-background
(intern (format "minimap-semantic-%s-face"
(symbol-name class)))))))
(overlay-put ovnew 'priority 4)
(when (and (eq class 'function)
(> (- lend lstart) 5))
(overlay-put ovnew 'priority 1)
(overlay-put ovnew 'minimap-semantic t)
(overlay-put (setq ovnew (make-overlay start (progn (goto-char start) (point-at-eol))))
'display (make-string 200 ?\u203E))
(overlay-put ovnew 'minimap-semantic t)
(overlay-put ovnew 'face `(:foreground ,(face-foreground 'default) :overline nil))
(overlay-put ovnew 'priority 8)
(overlay-put (setq ovnew (make-overlay (progn (goto-char end) (point-at-bol)) end))
'display (make-string 200 ?_))
(overlay-put ovnew 'face `(:foreground ,(face-foreground 'default)))
(overlay-put ovnew 'minimap-semantic t)
(overlay-put ovnew 'priority 8))
(setq start
(minimap-line-to-pos (/ (+ lstart lend) 2)))
(goto-char start)
(while (looking-at "^$")
(forward-line -1))
(setq start (point))
(setq end (progn (goto-char start) (point-at-eol)))
(setq ovnew (make-overlay start end))
(overlay-put ovnew 'face (format "minimap-semantic-%s-face"
(symbol-name class)))
(overlay-put ovnew 'display (concat " " name " "))
(overlay-put ovnew 'priority 7)
(overlay-put ovnew 'minimap-semantic t)
)))
(setq tags (cdr tags)))))))
;;;; ChangeLog:
;; 2014-03-11 David Engster <deng@randomsample.de>
;;
;; Update Minimap to version 1.2.
;;
;; - Change some defaults: better colors, reduced update delay.
;; - `minimap-tag-only': New experimental feature to only display an
;; 'abstract view' of the buffer with overlays generated from
;; Semantic information. Works only for buffers parsed by Semantic.
;; - `minimap-highlight-line': Highlight current line in Minimap.
;; - Fix autoloads.
;; - Display lines denoting beginning/end of functions in Semantic
;; overlays.
;;
;; 2014-02-24 David Engster <deng@randomsample.de>
;;
;; Minimap: Set `truncate-lines' directly.
;;
;; (minimap-new-minimap, minimap-create-window): Directly set
;; `truncate-lines' to avoid message.
;;
;; 2014-02-24 David Engster <deng@randomsample.de>
;;
;; Minimap: Update to version 1.1.
;;
;; - Largely rewritten as a minor mode; use M-x minimap-mode to
;; enable/disable.
;; - Minimap will now remain active for all buffers which derive from
;; `prog-mode' (can be changed through `minimap-major-modes'). The
;; minimap window will be automatically created or deleted (see new
;; variables `minimap-recreate-window' and
;; `minimap-automatically-delete-window').
;; - Possibility to set a minimum width of the minimap window
;; (`minimap-minimum-width').
;; - Minimap window will be marked so that you should not be able to
;; enter it.
;; - Semantic overlays will be automatically updated during editing.
;; - Lots of bug fixes.
;;
;; 2011-07-12 Chong Yidong <cyd@stupidchicken.com>
;;
;; Tweak minimap.el description to fit the *Packages* buffer better.
;;
;; 2011-07-12 David Engster <dengste@eml.cc>
;;
;; New package `minimap'.
;;
(provide 'minimap)
;;; minimap.el ends here

11
elpa/minimap-readme.txt Normal file
View File

@ -0,0 +1,11 @@
This file is an implementation of a minimap sidebar, i.e., a
smaller display of the current buffer on the left side. It
highlights the currently shown region and updates its position
automatically. You can navigate in the minibar by dragging the
active region with the mouse, which will scroll the corresponding
edit buffer. Additionally, you can overlay information from the
tags gathered by CEDET's semantic analyzer.
Simply use M-x minimap-mode to toggle activation of the minimap.
Use 'M-x customize-group RET minimap RET' to adapt minimap to your
needs.

View File

@ -0,0 +1,33 @@
;;; sass-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
;;;### (autoloads (sass-mode) "sass-mode" "sass-mode.el" (21528 2950
;;;;;; 162723 0))
;;; Generated autoloads from sass-mode.el
(autoload 'sass-mode "sass-mode" "\
Major mode for editing Sass files.
\\{sass-mode-map}
\(fn)" t nil)
(add-to-list 'auto-mode-alist '("\\.sass\\'" . sass-mode))
;;;***
;;;### (autoloads nil nil ("sass-mode-pkg.el") (21528 2950 239158
;;;;;; 431000))
;;;***
(provide 'sass-mode-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; sass-mode-autoloads.el ends here

View File

@ -0,0 +1 @@
(define-package "sass-mode" "3.0.16" "Major mode for editing Sass files" (quote ((haml-mode "3.0.15"))))

View File

@ -0,0 +1,237 @@
;;; sass-mode.el --- Major mode for editing Sass files
;; Copyright (c) 2007, 2008 Nathan Weizenbaum
;; Author: Nathan Weizenbaum
;; URL: http://github.com/nex3/haml/tree/master
;; Version: 3.0.16
;; Created: 2007-03-15
;; By: Nathan Weizenbaum
;; Keywords: markup, language, css
;; Package-Requires: ((haml-mode "3.0.15"))
;;; Commentary:
;; Because Sass's indentation schema is similar
;; to that of YAML and Python, many indentation-related
;; functions are similar to those in yaml-mode and python-mode.
;; To install, save this on your load path and add the following to
;; your .emacs file:
;;
;; (require 'sass-mode)
;; sass-mode requires haml-mode, which can be found at http://github.com/nex3/haml-mode.
;;; Code:
(require 'haml-mode)
;; User definable variables
(defgroup sass nil
"Support for the Sass template language."
:group 'languages
:prefix "sass-")
(defcustom sass-mode-hook nil
"Hook run when entering Sass mode."
:type 'hook
:group 'sass)
(defcustom sass-indent-offset 2
"Amount of offset per level of indentation."
:type 'integer
:group 'sass)
(defvar sass-non-block-openers
'("^.*,$" ;; Continued selectors
"^ *@\\(extend\\|debug\\|warn\\|include\\|import\\)" ;; Single-line mixins
"^ *[$!]" ;; Variables
"^ *[[:alnum:]\\-]+ *:" ;; Plain attribute values
)
"A list of regexps that match lines of Sass that couldn't have
text nested beneath them.")
;; Font lock
(defconst sass-selector-font-lock-keywords
'(;; Attribute selectors (e.g. p[foo=bar])
("\\[\\([^]=]+\\)" (1 font-lock-variable-name-face)
("[~|$^*]?=\\([^]=]+\\)" nil nil (1 font-lock-string-face)))
("&" 0 font-lock-constant-face)
("\\.\\w+" 0 font-lock-type-face)
("#\\w+" 0 font-lock-keyword-face)
;; Pseudo-selectors, optionally with arguments (e.g. :first, :nth-child(12))
("\\(::?\\w+\\)" (1 font-lock-function-name-face)
("(\\([^)]+\\))" nil nil (1 font-lock-string-face)))))
(defconst sass-script-font-lock-keywords
`(("\"\\([^\"\\\\]\\|\\\\.\\)*\"" 0 font-lock-string-face)
("!\\(\\w\\|_\\)+" 0 font-lock-variable-name-face)
("#[0-9a-fA-F]\\{0,6\\}" 0 font-lock-preprocessor-face)
(,(regexp-opt
'("true" "false" "black" "silver" "gray" "white" "maroon" "red"
"purple" "fuchsia" "green" "lime" "olive" "yellow" "navy"
"blue" "teal" "aqua"))
0 font-lock-constant-face)
(,(regexp-opt '("and" "or" "not")) 0 font-lock-keyword-face)))
(defconst sass-syntax-table
(let ((st (make-syntax-table)))
(modify-syntax-entry ?- "w" st)
(modify-syntax-entry ?_ "w" st)
st))
(defconst sass-script-syntax-table
(let ((st (make-syntax-table sass-syntax-table)))
(modify-syntax-entry ?- "." st)
st))
(defconst sass-font-lock-keywords
'((sass-highlight-line 1 nil nil t)))
(defconst sass-line-keywords
'(("@\\(\\w+\\)" 0 font-lock-keyword-face sass-highlight-directive)
("/[/*].*" 0 font-lock-comment-face)
("[=+]\\w+" 0 font-lock-function-name-face sass-highlight-script-after-match)
("!\\w+" 0 font-lock-variable-name-face sass-highlight-script-after-match)
(":\\w+" 0 font-lock-variable-name-face)
("\\w+\s*:" 0 font-lock-variable-name-face)
("\\(\\w+\\)\s*=" 1 font-lock-variable-name-face sass-highlight-script-after-match)
("\\(:\\w+\\)\s*=" 1 font-lock-variable-name-face sass-highlight-script-after-match)
(".*" sass-highlight-selector))
"A list of full-line Sass syntax to highlight, used by `sass-highlight-line'.
Each item is either of the form (REGEXP SUBEXP FACE), (REGEXP FN),
or (REGEXP SUBEXP FACE FN). Each REGEXP is run successively on the
beginning of non-whitespace on the current line until one matches.
If it has SUBEXP and FACE, then SUBEXP is highlighted using FACE.
If it has FN, FN is run.")
(defun sass-highlight-line (limit)
"Highlight a single line using some Sass single-line syntax.
This syntax is taken from `sass-line-keywords'.
LIMIT is the limit of the search."
(save-match-data
(when (re-search-forward "^ *\\(.+\\)$" limit t)
(goto-char (match-beginning 1))
(dolist (keyword sass-line-keywords)
(destructuring-bind (keyword subexp-or-fn &optional face fn) keyword
(when (looking-at keyword)
(if (integerp subexp-or-fn)
(put-text-property (match-beginning subexp-or-fn)
(match-end subexp-or-fn)
'face face)
(setq fn subexp-or-fn))
(when fn (funcall fn))
(end-of-line)
(return t)))))))
(defun sass-highlight-selector ()
"Highlight a CSS selector starting at `point' and ending at `end-of-line'."
(let ((font-lock-keywords sass-selector-font-lock-keywords)
font-lock-multiline)
(font-lock-fontify-region
(point) (progn (end-of-line) (point))))
t)
(defun sass-highlight-script (beg end)
"Highlight a section of SassScript between BEG and END."
(save-match-data
(with-syntax-table sass-script-syntax-table
(let ((font-lock-keywords sass-script-font-lock-keywords)
font-lock-syntax-table
font-lock-extend-region-functions)
(font-lock-fontify-region beg end)))))
(defun sass-highlight-script-after-match ()
"Highlight a section of SassScript after the last match."
(end-of-line)
(sass-highlight-script (match-end 0) (point)))
(defun sass-highlight-directive ()
"Highlight a Sass directive."
(goto-char (match-end 0))
(block nil
(case (intern (match-string 1))
(for
(unless (looking-at " +!\\w+") (return))
(put-text-property (match-beginning 0) (match-end 0)
'face font-lock-variable-name-face)
(goto-char (match-end 0))
(unless (looking-at " +from") (return))
(put-text-property (match-beginning 0) (match-end 0)
'face font-lock-keyword-face)
(goto-char (match-end 0))
(when (looking-at " +\\(.+?\\) +\\(to\\|through\\)")
(sass-highlight-script (match-beginning 1) (match-end 1))
(put-text-property (match-beginning 2) (match-end 2)
'face font-lock-keyword-face))
(sass-highlight-script-after-match))
(else
(unless (looking-at " +if") (return))
(put-text-property (match-beginning 0) (match-end 0)
'face font-lock-keyword-face)
(sass-highlight-script-after-match))
((if while debug) (sass-highlight-script-after-match)))))
;; Constants
;; Mode setup
(defvar sass-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-r" 'sass-output-region)
(define-key map "\C-c\C-l" 'sass-output-buffer)
map))
;;;###autoload
(define-derived-mode sass-mode haml-mode "Sass"
"Major mode for editing Sass files.
\\{sass-mode-map}"
(set-syntax-table sass-syntax-table)
(setq font-lock-extend-region-functions
'(font-lock-extend-region-wholelines font-lock-extend-region-multiline))
(set (make-local-variable 'font-lock-multiline) nil)
(set (make-local-variable 'comment-start) "/*")
(set (make-local-variable 'haml-indent-function) 'sass-indent-p)
(set (make-local-variable 'haml-indent-offset) sass-indent-offset)
(setq font-lock-defaults '(sass-font-lock-keywords t t)))
;; Indentation
(defun sass-indent-p ()
"Return non-nil if the current line can have lines nested beneath it."
(loop for opener in sass-non-block-openers
if (looking-at opener) return nil
finally return t))
;; Command
(defun sass-output-region (start end)
"Displays the CSS output for the current block of Sass code.
Called from a program, START and END specify the region to indent."
(interactive "r")
(let ((output-buffer "*sass-output*"))
(shell-command-on-region start end "sass --stdin" output-buffer)
(when (fboundp 'css-mode)
(with-current-buffer output-buffer
(css-mode)))
(switch-to-buffer-other-window output-buffer)))
(defun sass-output-buffer ()
"Displays the CSS output for entire buffer."
(interactive)
(sass-output-region (point-min) (point-max)))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.sass\\'" . sass-mode))
;; Setup/Activation
(provide 'sass-mode)
;;; sass-mode.el ends here

1
emacs-async Submodule

@ -0,0 +1 @@
Subproject commit 57efc8da95c7c491cb1ecf3172b947b174e3fdf8

1
emacs-helm-gtags Submodule

@ -0,0 +1 @@
Subproject commit 4548521bc2a8495eb4a40b61d3cf98d7650c7351

65
gnu-c-header.el Normal file
View File

@ -0,0 +1,65 @@
;;; gnu-c-header.el --- function to add a header to the C files licensed under the GPL
;; Author: Gergely Polonkai <gergely@polonkai.eu>
;; Copyright: public domain
;; URL: http://gergely.polonkai.eu/blog/2014/09/26/emacs-adding-gnu-c-headers
;; Keywords: gnu, c, header, helper, utilities
;;; Commentary:
;;; Code:
(defun file-name-base-with-extension (&optional filename)
"Return the base name of the FILENAME without its directory path.
FILENAME defaults to `buffer-file-name'."
(file-name-nondirectory (or filename (buffer-file-name))))
(defun add-gnu-c-header (progname purpose)
"Add a GNU GPL header to the current buffer"
(interactive "sProgram name (ie: MyProgram): \nsPurpose of the file (ie: string utility functions): ")
(save-excursion
(goto-char (point-min))
(insert (concat
"/* "
(file-name-base-with-extension buffer-file-name)
" - "
purpose
" for "
progname
"\n"
" *\n"
" * Copyright (C) "
(format-time-string "%Y" (current-time))
" "
(user-full-name)
"\n"
" *\n"))
(let ((start (point)))
(insert (concat
" * "
progname
" is \n * 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."))
(let ((end (point)))
(fill-region start end)))
(insert (concat
"\n"
" *\n"))
(let ((start (point)))
(insert (concat
" * "
progname
" is \n * 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."))
(let ((end (point)))
(fill-region start end)))
(insert (concat
"\n"
" *\n"))
(let ((start (point)))
(insert " * You \n * should have received a copy of the GNU General Public License along with this software; if not, see <http://www.gnu.org/licenses/>.")
(let ((end (point)))
(fill-region start end)))
(insert (concat
"\n"
" */\n"))
))
(provide 'gnu-c-header)
;;; gnu-c-header.el ends here

1
gobgen Submodule

@ -0,0 +1 @@
Subproject commit e21e6eb6aacfcb6ead4af2c78399faa045db2bbb

1
helm Submodule

@ -0,0 +1 @@
Subproject commit 1c593c906895eda9f6659d033859436e5ca3beb1

172
init.el Normal file
View File

@ -0,0 +1,172 @@
(custom-set-variables
;; custom-set-variables was added by Custom.
;; If you edit it by hand, you could mess it up, so be careful.
;; Your init file should contain only one such instance.
;; If there is more than one, they won't work right.
'(background-color "#7f7f7f")
'(background-mode dark)
'(blink-cursor-mode t)
'(column-number-mode t)
'(cursor-color "#5c5cff")
'(custom-enabled-themes (quote (tango-dark)))
'(custom-safe-themes (quote ("1e7e097ec8cb1f8c3a912d7e1e0331caeed49fef6cff220be63bd2a6ba4cc365" "fc5fcb6f1f1c1bc01305694c59a1a861b008c534cae8d0e48e4d5e81ad718bc6" default)))
'(ediff-merge-split-window-function (quote split-window-horizontally))
'(ediff-split-window-function (quote split-window-vertically))
'(foreground-color "#5c5cff")
'(helm-gtags-auto-update t)
'(helm-gtags-ignore-case t)
'(helm-gtags-path-style (quote relative))
'(inhibit-startup-screen t)
'(nxml-attribute-indent 4)
'(nxml-child-indent 2)
'(nxml-outline-child-indent 4)
'(package-archives (quote (("gnu" . "http://elpa.gnu.org/packages/") ("marmalade" . "http://marmalade-repo.org/packages/") ("e6h" . "http://www.e6h.org/packages/"))))
'(safe-local-variable-values (quote ((company-clang-arguments "-I.." "-I/home/polesz/jhbuild/install/include" "-I/home/polesz/jhbuild/install/include/atk-1.0" "-I/home/polesz/jhbuild/install/include/at-spi-2.0" "-I/home/polesz/jhbuild/install/include/at-spi2-atk/2.0" "-I/home/polesz/jhbuild/install/include/cairo" "-I/home/polesz/jhbuild/install/include/gdk-pixbuf-2.0" "-I/home/polesz/jhbuild/install/include/gio-unix-2.0/" "-I/home/polesz/jhbuild/install/include/glib-2.0" "-I/home/polesz/jhbuild/install/include/gtk-3.0" "-I/home/polesz/jhbuild/install/include/harfbuzz" "-I/home/polesz/jhbuild/install/include/libgda-5.0" "-I/home/polesz/jhbuild/install/include/libgda-5.0/libgda" "-I/home/polesz/jhbuild/install/include/librsvg-2.0" "-I/home/polesz/jhbuild/install/include/libsoup-2.4" "-I/home/polesz/jhbuild/install/include/pango-1.0" "-I/home/polesz/jhbuild/install/include/swe-glib" "-I/home/polesz/jhbuild/install/include/webkitgtk-4.0" "-I/home/polesz/jhbuild/install/lib/glib-2.0/include" "-I/usr/include/dbus-1.0" "-I/usr/include/freetype2" "-I/usr/include/libdrm" "-I/usr/include/libpng16" "-I/usr/include/libxml2" "-I/usr/include/pixman-1" "-I/usr/lib64/dbus-1.0/include") (company-clang-arguments "-I/home/polesz/jhbuild/install/include" "-I/home/polesz/jhbuild/install/include/atk-1.0" "-I/home/polesz/jhbuild/install/include/at-spi-2.0" "-I/home/polesz/jhbuild/install/include/at-spi2-atk/2.0" "-I/home/polesz/jhbuild/install/include/cairo" "-I/home/polesz/jhbuild/install/include/gdk-pixbuf-2.0" "-I/home/polesz/jhbuild/install/include/gio-unix-2.0/" "-I/home/polesz/jhbuild/install/include/glib-2.0" "-I/home/polesz/jhbuild/install/include/gtk-3.0" "-I/home/polesz/jhbuild/install/include/harfbuzz" "-I/home/polesz/jhbuild/install/include/libgda-5.0" "-I/home/polesz/jhbuild/install/include/libgda-5.0/libgda" "-I/home/polesz/jhbuild/install/include/librsvg-2.0" "-I/home/polesz/jhbuild/install/include/libsoup-2.4" "-I/home/polesz/jhbuild/install/include/pango-1.0" "-I/home/polesz/jhbuild/install/include/swe-glib" "-I/home/polesz/jhbuild/install/include/webkitgtk-4.0" "-I/home/polesz/jhbuild/install/lib/glib-2.0/include" "-I/usr/include/dbus-1.0" "-I/usr/include/freetype2" "-I/usr/include/libdrm" "-I/usr/include/libpng16" "-I/usr/include/libxml2" "-I/usr/include/pixman-1" "-I/usr/lib64/dbus-1.0/include") (company-clang-arguments "-I/usr/include/glib-2.0")))))
(set-default 'cursor-type 'bar)
; Nyanyanyanyanya
(add-to-list 'load-path "~/.emacs.d/nyan-mode")
(require 'nyan-mode)
(nyan-mode t)
; OrgMode mobileness
(setq org-directory "~/Dokumentumok/org")
(setq org-mobile-directory "~/Dokumentumok/org")
(setq org-mobile-inbox-for-pull "~/Dokumentumok/org/inbox.org")
(load "~/.emacs.d/gnu-c-header.el")
(load "~/.emacs.d/gobgen/gobgen.el")
(load "~/.emacs.d/toggle-window-split.el")
(add-to-list 'load-path "~/.emacs.d/emacs-async")
(add-to-list 'load-path "~/.emacs.d/helm")
(require 'helm-config)
(add-to-list 'load-path "~/.emacs.d/emacs-helm-gtags")
(require 'helm-gtags)
(add-hook 'c-mode-hook 'helm-gtags-mode)
;; customize helm-gtags
;; key bindings for helm-gtags
(eval-after-load "helm-gtags"
'(progn
(define-key helm-gtags-mode-map (kbd "M-t") 'helm-gtags-find-tag)
(define-key helm-gtags-mode-map (kbd "M-r") 'helm-gtags-find-rtag)
(define-key helm-gtags-mode-map (kbd "M-s") 'helm-gtags-find-symbol)
(define-key helm-gtags-mode-map (kbd "M-g M-p") 'helm-gtags-parse-file)
(define-key helm-gtags-mode-map (kbd "C-c <") 'helm-gtags-previous-history)
(define-key helm-gtags-mode-map (kbd "C-c >") 'helm-gtags-next-history)
(define-key helm-gtags-mode-map (kbd "M-,") 'helm-gtags-pop-stack)))
(which-func-mode)
(add-hook 'c-mode-common-hook
(lambda()
(local-set-key (kbd "C-c o") 'ff-find-other-file)))
(require 'whitespace)
(setq whitespace-style '(tabs trailing lines tab-mark))
(setq whitespace-line-column 78)
(global-whitespace-mode 1)
(setq tab-width 4)
(setq-default indent-tabs-mode nil)
(defvaralias 'c-basic-offset 'tab-width)
(defvaralias 'cperl-indent-level 'tab-width)
(global-set-key (kbd "C-x _") 'maximize-window)
(c-add-style "my"
'(
(c-basic-offset . 4)
(c-offsets-alist
(arglist-cont . 0)
(arglist-intro . ++)
(block-close . 0)
(brace-entry-open . 0)
(brace-list-close . 0)
(brace-list-intro . +)
(case-label . +)
(class-close . 0)
(defun-block-intro . +)
(defun-close . 0)
(defun-open . 0)
(inclass . +)
(statement . 0)
(statement-block-intro . +)
(statement-case-intro . +)
(statement-cont . 4)
(substatement-open . 0)
(topmost-intro . 0)
(topmost-intro-cont . 0)
(access-label . -)
(annotation-top-cont . 0)
(annotation-var-cont . +)
(arglist-close . c-lineup-close-paren)
(arglist-cont-nonempty . c-lineup-arglist)
(block-open . 0)
(brace-list-entry . 0)
(brace-list-open . 0)
(c . c-lineup-C-comments)
(catch-clause . 0)
(class-open . 0)
(comment-intro . c-lineup-comment)
(composition-close . 0)
(composition-open . 0)
(cpp-define-intro c-lineup-cpp-define +)
(cpp-macro . -1000)
(cpp-macro-cont . +)
(do-while-closure . 0)
(else-clause . 0)
(extern-lang-close . 0)
(extern-lang-open . 0)
(friend . 0)
(func-decl-cont . +)
(incomposition . +)
(inexpr-class . +)
(inexpr-statement . +)
(inextern-lang . +)
(inher-cont . c-lineup-multi-inher)
(inher-intro . +)
(inlambda . c-lineup-inexpr-block)
(inline-close . 0)
(inline-open . +)
(inmodule . +)
(innamespace . +)
(knr-argdecl . 0)
(knr-argdecl-intro . +)
(label . 2)
(lambda-intro-cont . +)
(member-init-cont . c-lineup-multi-inher)
(member-init-intro . +)
(module-close . 0)
(module-open . 0)
(namespace-close . 0)
(namespace-open . 0)
(objc-method-args-cont . c-lineup-ObjC-method-args)
(objc-method-call-cont c-lineup-ObjC-method-call-colons c-lineup-ObjC-method-call +)
(objc-method-intro .
[0])
(statement-case-open . 0)
(stream-op . c-lineup-streamop)
(string . -1000)
(substatement . +)
(substatement-label . 2)
(template-args-cont c-lineup-template-args +))))
(add-hook 'after-init-hook 'global-company-mode)
(require 'rcirc)
(setq rcirc-default-nick "GergelyPolonkai")
(setq rcirc-default-user-name "polesz")
(setq rcirc-default-full-name "Gergely Polonkai")
(add-hook 'after-init-hook 'fiplr-clear-cache)
(global-set-key (kbd "C-x f") 'fiplr-find-file)
(custom-set-faces
;; custom-set-faces was added by Custom.
;; If you edit it by hand, you could mess it up, so be careful.
;; Your init file should contain only one such instance.
;; If there is more than one, they won't work right.
)
(add-hook 'c-mode-common-hook
(lambda()
(local-set-key (kbd "C-c o") 'ff-find-other-file)))

1
nyan-mode Submodule

@ -0,0 +1 @@
Subproject commit 4305e892005c9e982972eb61f84c62a8d413cb9c

27
toggle-window-split.el Normal file
View File

@ -0,0 +1,27 @@
(defun toggle-window-split ()
(interactive)
(if (= (count-windows) 2)
(let* ((this-win-buffer (window-buffer))
(next-win-buffer (window-buffer (next-window)))
(this-win-edges (window-edges (selected-window)))
(next-win-edges (window-edges (next-window)))
(this-win-2nd (not (and (<= (car this-win-edges)
(car next-win-edges))
(<= (cadr this-win-edges)
(cadr next-win-edges)))))
(splitter
(if (= (car this-win-edges)
(car (window-edges (next-window))))
'split-window-horizontally
'split-window-vertically)))
(delete-other-windows)
(let ((first-win (selected-window)))
(funcall splitter)
(if this-win-2nd (other-window 1))
(set-window-buffer (selected-window) this-win-buffer)
(set-window-buffer (next-window) next-win-buffer)
(select-window first-win)
(if this-win-2nd (other-window 1))))
(error "This works only for two windows!")))
(global-set-key (kbd "C-x |") 'toggle-window-split)