Initial version
This commit is contained in:
commit
ef4409f2a2
|
|
@ -0,0 +1,5 @@
|
|||
*~
|
||||
/session*
|
||||
/tramp
|
||||
*.elc
|
||||
/elpa/archives/
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1 @@
|
|||
(define-package "ag" "0.42" "A front-end for ag ('the silver searcher'), the C ack replacement." (quote nil))
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
((nil . ((indent-tabs-mode . nil)
|
||||
(fill-column . 80)
|
||||
(sentence-end-double-space . t)
|
||||
(emacs-lisp-docstring-fill-column . 75))))
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
*.elc
|
||||
ert.el
|
||||
|
|
@ -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}
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
See the [homepage](http://company-mode.github.com/).
|
||||
[](http://githalytics.com/company-mode/company-mode)
|
||||
|
||||
[](https://travis-ci.org/company-mode/company-mode)
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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)))))
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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"))
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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))))))
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
|
@ -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'.
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1 @@
|
|||
(define-package "fiplr" "0.1.3" "Fuzzy finder for files in a project." (quote nil))
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
(define-package "grizzl" "0.1.1"
|
||||
"Fuzzy Search Library & Completing Read"
|
||||
'((cl-lib "0.1")))
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1 @@
|
|||
(define-package "haml-mode" "3.1.5" "Major mode for editing Haml files" (quote ((ruby-mode "1.0"))))
|
||||
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
|
@ -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
|
||||
|
|
@ -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)
|
||||
|
|
@ -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
|
||||
|
|
@ -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)
|
||||
|
|
@ -0,0 +1 @@
|
|||
(define-package "magit" "1.2.1" "Control Git from Emacs.")
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
|
@ -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
|
||||
|
|
@ -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
|
|
@ -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>
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1 @@
|
|||
(define-package "markup-faces" "1.0.0" "collection of faces for markup language modes" (quote nil))
|
||||
|
|
@ -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: '&' 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 & bar</b>',
|
||||
the output 'foo & bar' is fontified bold, thus I also want 'foo
|
||||
& 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
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1 @@
|
|||
(define-package "minimap" "1.2" "Sidebar showing a \"mini-map\" of a buffer" (quote nil))
|
||||
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1 @@
|
|||
(define-package "sass-mode" "3.0.16" "Major mode for editing Sass files" (quote ((haml-mode "3.0.15"))))
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1 @@
|
|||
Subproject commit 57efc8da95c7c491cb1ecf3172b947b174e3fdf8
|
||||
|
|
@ -0,0 +1 @@
|
|||
Subproject commit 4548521bc2a8495eb4a40b61d3cf98d7650c7351
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1 @@
|
|||
Subproject commit e21e6eb6aacfcb6ead4af2c78399faa045db2bbb
|
||||
|
|
@ -0,0 +1 @@
|
|||
Subproject commit 1c593c906895eda9f6659d033859436e5ca3beb1
|
||||
|
|
@ -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)))
|
||||
|
|
@ -0,0 +1 @@
|
|||
Subproject commit 4305e892005c9e982972eb61f84c62a8d413cb9c
|
||||
|
|
@ -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)
|
||||
Loading…
Reference in New Issue