Update packages

This commit is contained in:
Gergely Polonkai 2016-06-29 09:21:54 +02:00
parent 9777493048
commit 1ee823ee92
236 changed files with 5128 additions and 2839 deletions

View File

@ -3,7 +3,7 @@
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "async" "async.el" (22303 19287 502173 365000)) ;;;### (autoloads nil "async" "async.el" (22387 29376 289753 380000))
;;; Generated autoloads from async.el ;;; Generated autoloads from async.el
(autoload 'async-start-process "async" "\ (autoload 'async-start-process "async" "\
@ -68,8 +68,8 @@ returns nil. It can still be useful, however, as an argument to
;;;*** ;;;***
;;;### (autoloads nil "async-bytecomp" "async-bytecomp.el" (22303 ;;;### (autoloads nil "async-bytecomp" "async-bytecomp.el" (22387
;;;;;; 19287 498173 368000)) ;;;;;; 29376 281759 465000))
;;; Generated autoloads from async-bytecomp.el ;;; Generated autoloads from async-bytecomp.el
(autoload 'async-byte-recompile-directory "async-bytecomp" "\ (autoload 'async-byte-recompile-directory "async-bytecomp" "\
@ -96,8 +96,8 @@ Async compilation of packages can be controlled by
;;;*** ;;;***
;;;### (autoloads nil "dired-async" "dired-async.el" (22303 19287 ;;;### (autoloads nil "dired-async" "dired-async.el" (22387 29376
;;;;;; 486173 378000)) ;;;;;; 261774 676000))
;;; Generated autoloads from dired-async.el ;;; Generated autoloads from dired-async.el
(defvar dired-async-mode nil "\ (defvar dired-async-mode nil "\
@ -116,8 +116,8 @@ Do dired actions asynchronously.
;;;*** ;;;***
;;;### (autoloads nil nil ("async-pkg.el" "smtpmail-async.el") (22303 ;;;### (autoloads nil nil ("async-pkg.el" "smtpmail-async.el") (22387
;;;;;; 19287 520307 139000)) ;;;;;; 29376 315816 570000))
;;;*** ;;;***

View File

@ -1,4 +1,4 @@
;;; async-bytecomp.el --- Async functions to compile elisp files async ;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*-
;; Copyright (C) 2014-2016 Free Software Foundation, Inc. ;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
@ -65,27 +65,27 @@ All *.elc files are systematically deleted before proceeding."
;; This happen when recompiling its own directory. ;; This happen when recompiling its own directory.
(load "async") (load "async")
(let ((call-back (let ((call-back
`(lambda (&optional ignore) (lambda (&optional _ignore)
(if (file-exists-p async-byte-compile-log-file) (if (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer)) (let ((buf (get-buffer-create byte-compile-log-buffer))
(n 0)) (n 0))
(with-current-buffer buf (with-current-buffer buf
(goto-char (point-max)) (goto-char (point-max))
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file) (insert-file-contents async-byte-compile-log-file)
(compilation-mode)) (compilation-mode))
(display-buffer buf) (display-buffer buf)
(delete-file async-byte-compile-log-file) (delete-file async-byte-compile-log-file)
(unless ,quiet (unless quiet
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "^.*:Error:" nil t) (while (re-search-forward "^.*:Error:" nil t)
(cl-incf n))) (cl-incf n)))
(if (> n 0) (if (> n 0)
(message "Failed to compile %d files in directory `%s'" n ,directory) (message "Failed to compile %d files in directory `%s'" n directory)
(message "Directory `%s' compiled asynchronously with warnings" ,directory))))) (message "Directory `%s' compiled asynchronously with warnings" directory)))))
(unless ,quiet (unless quiet
(message "Directory `%s' compiled asynchronously with success" ,directory)))))) (message "Directory `%s' compiled asynchronously with success" directory))))))
(async-start (async-start
`(lambda () `(lambda ()
(require 'bytecomp) (require 'bytecomp)

View File

@ -1,4 +1,4 @@
(define-package "async" "20160425.551" "Asynchronous processing in Emacs" 'nil :keywords (define-package "async" "20160513.128" "Asynchronous processing in Emacs" 'nil :keywords
'("async") '("async")
:url "http://elpa.gnu.org/packages/async.html") :url "http://elpa.gnu.org/packages/async.html")
;; Local Variables: ;; Local Variables:

View File

@ -1,10 +1,10 @@
;;; async.el --- Asynchronous processing in Emacs ;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc. ;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;; Author: John Wiegley <jwiegley@gmail.com> ;; Author: John Wiegley <jwiegley@gmail.com>
;; Created: 18 Jun 2012 ;; Created: 18 Jun 2012
;; Version: 1.6 ;; Version: 1.9
;; Keywords: async ;; Keywords: async
;; X-URL: https://github.com/jwiegley/emacs-async ;; X-URL: https://github.com/jwiegley/emacs-async
@ -95,8 +95,8 @@ as follows:
(unless async-debug (unless async-debug
(kill-buffer buf))))) (kill-buffer buf)))))
(defun async-when-done (proc &optional change) (defun async-when-done (proc &optional _change)
"Process sentinal used to retrieve the value from the child process." "Process sentinel used to retrieve the value from the child process."
(when (eq 'exit (process-status proc)) (when (eq 'exit (process-status proc))
(with-current-buffer (process-buffer proc) (with-current-buffer (process-buffer proc)
(let ((async-current-process proc)) (let ((async-current-process proc))
@ -201,7 +201,7 @@ its FINISH-FUNC is nil."
(funcall async-callback args)) (funcall async-callback args))
(async--transmit-sexp (car args) (list 'quote (cdr args)))))) (async--transmit-sexp (car args) (list 'quote (cdr args))))))
(defun async-receive (&rest args) (defun async-receive ()
"Send the given messages to the asychronous Emacs PROCESS." "Send the given messages to the asychronous Emacs PROCESS."
(async--receive-sexp)) (async--receive-sexp))

View File

@ -1,4 +1,4 @@
;;; dired-async.el --- Copy/move/delete asynchronously in dired. ;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc. ;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
@ -44,7 +44,6 @@
(eval-when-compile (eval-when-compile
(defvar async-callback)) (defvar async-callback))
(defvar dired-async-operation nil)
(defgroup dired-async nil (defgroup dired-async nil
"Copy rename files asynchronously from dired." "Copy rename files asynchronously from dired."
@ -72,6 +71,11 @@ Should take same args as `message'."
"Face used for mode-line message." "Face used for mode-line message."
:group 'dired-async) :group 'dired-async)
(defface dired-async-failures
'((t (:foreground "red")))
"Face used for mode-line message."
:group 'dired-async)
(defface dired-async-mode-message (defface dired-async-mode-message
'((t (:foreground "Gold"))) '((t (:foreground "Gold")))
"Face used for `dired-async--modeline-mode' lighter." "Face used for `dired-async--modeline-mode' lighter."
@ -87,7 +91,7 @@ Should take same args as `message'."
(unless dired-async--modeline-mode (unless dired-async--modeline-mode
(let ((visible-bell t)) (ding)))) (let ((visible-bell t)) (ding))))
(defun dired-async-mode-line-message (text &rest args) (defun dired-async-mode-line-message (text face &rest args)
"Notify end of operation in `mode-line'." "Notify end of operation in `mode-line'."
(message nil) (message nil)
(let ((mode-line-format (concat (let ((mode-line-format (concat
@ -95,7 +99,7 @@ Should take same args as `message'."
(if args (if args
(apply #'format text args) (apply #'format text args)
text) text)
'face 'dired-async-message)))) 'face face))))
(force-mode-line-update) (force-mode-line-update)
(sit-for 3) (sit-for 3)
(force-mode-line-update))) (force-mode-line-update)))
@ -110,28 +114,49 @@ Should take same args as `message'."
(interactive) (interactive)
(let* ((processes (dired-async-processes)) (let* ((processes (dired-async-processes))
(proc (car (last processes)))) (proc (car (last processes))))
(delete-process proc) (and proc (delete-process proc))
(unless (> (length processes) 1) (unless (> (length processes) 1)
(dired-async--modeline-mode -1)))) (dired-async--modeline-mode -1))))
(defun dired-async-after-file-create (len-flist) (defun dired-async-after-file-create (total operation failures skipped)
"Callback function used for operation handled by `dired-create-file'." "Callback function used for operation handled by `dired-create-file'."
(unless (dired-async-processes) (unless (dired-async-processes)
;; Turn off mode-line notification ;; Turn off mode-line notification
;; only when last process end. ;; only when last process end.
(dired-async--modeline-mode -1)) (dired-async--modeline-mode -1))
(when dired-async-operation (when operation
(if (file-exists-p dired-async-log-file) (if (file-exists-p dired-async-log-file)
(progn (progn
(pop-to-buffer (get-buffer-create "*dired async*")) (pop-to-buffer (get-buffer-create dired-log-buffer))
(erase-buffer) (goto-char (point-max))
(setq inhibit-read-only t)
(insert "Error: ") (insert "Error: ")
(insert-file-contents dired-async-log-file) (insert-file-contents dired-async-log-file)
(special-mode)
(shrink-window-if-larger-than-buffer)
(delete-file dired-async-log-file)) (delete-file dired-async-log-file))
(run-with-timer (run-with-timer
0.1 nil 0.1 nil
dired-async-message-function "Asynchronous %s of %s file(s) on %s file(s) done" (lambda ()
(car dired-async-operation) (cadr dired-async-operation) len-flist)))) ;; First send error messages.
(cond (failures
(funcall dired-async-message-function
"%s failed for %d of %d file%s -- See *Dired log* buffer"
'dired-async-failures
(car operation) (length failures)
total (dired-plural-s total)))
(skipped
(funcall dired-async-message-function
"%s: %d of %d file%s skipped -- See *Dired log* buffer"
'dired-async-failures
(car operation) (length skipped) total
(dired-plural-s total))))
;; Finally send the success message.
(funcall dired-async-message-function
"Asynchronous %s of %s on %s file%s done"
'dired-async-message
(car operation) (cadr operation)
total (dired-plural-s total)))))))
(defun dired-async-maybe-kill-ftp () (defun dired-async-maybe-kill-ftp ()
"Return a form to kill ftp process in child emacs." "Return a form to kill ftp process in child emacs."
@ -144,19 +169,16 @@ Should take same args as `message'."
(buffer-name b)) b)))) (buffer-name b)) b))))
(when buf (kill-buffer buf)))))) (when buf (kill-buffer buf))))))
(defvar overwrite-query)
(defun dired-async-create-files (file-creator operation fn-list name-constructor (defun dired-async-create-files (file-creator operation fn-list name-constructor
&optional marker-char) &optional _marker-char)
"Same as `dired-create-files' but asynchronous. "Same as `dired-create-files' but asynchronous.
See `dired-create-files' for the behavior of arguments." See `dired-create-files' for the behavior of arguments."
(setq dired-async-operation nil) (setq overwrite-query nil)
(let (dired-create-files-failures (let ((total (length fn-list))
failures async-fn-list failures async-fn-list skipped callback)
skipped (success-count 0) (let (to)
(total (length fn-list))
callback)
(let (to overwrite-query
overwrite-backup-query) ; for dired-handle-overwrite
(dolist (from fn-list) (dolist (from fn-list)
(setq to (funcall name-constructor from)) (setq to (funcall name-constructor from))
(if (equal to from) (if (equal to from)
@ -170,19 +192,12 @@ See `dired-create-files' for the behavior of arguments."
(file-exists-p to))) (file-exists-p to)))
(dired-overwrite-confirmed ; for dired-handle-overwrite (dired-overwrite-confirmed ; for dired-handle-overwrite
(and overwrite (and overwrite
(let ((help-form '(format "\ (let ((help-form `(format "\
Type SPC or `y' to overwrite file `%s', Type SPC or `y' to overwrite file `%s',
DEL or `n' to skip to next, DEL or `n' to skip to next,
ESC or `q' to not overwrite any of the remaining files, ESC or `q' to not overwrite any of the remaining files,
`!' to overwrite all remaining files with no more questions." to))) `!' to overwrite all remaining files with no more questions." ,to)))
(dired-query 'overwrite-query (dired-query 'overwrite-query "Overwrite `%s'?" to)))))
"Overwrite `%s'?" to))))
;; must determine if FROM is marked before file-creator
;; gets a chance to delete it (in case of a move).
(actual-marker-char
(cond ((integerp marker-char) marker-char)
(marker-char (dired-file-marker from)) ; slow
(t nil))))
;; Handle the `dired-copy-file' file-creator specially ;; Handle the `dired-copy-file' file-creator specially
;; When copying a directory to another directory or ;; When copying a directory to another directory or
;; possibly to itself or one of its subdirectories. ;; possibly to itself or one of its subdirectories.
@ -214,48 +229,49 @@ ESC or `q' to not overwrite any of the remaining files,
(push (cons from to) async-fn-list)) (push (cons from to) async-fn-list))
(progn (progn
(push (dired-make-relative from) failures) (push (dired-make-relative from) failures)
(dired-log "%s `%s' to `%s' failed" (dired-log "%s `%s' to `%s' failed\n"
operation from to))) operation from to)))
(push (cons from to) async-fn-list))))) (push (cons from to) async-fn-list)))))
;; When failures have been printed to dired log add the date at bob.
(when (or failures skipped) (dired-log t))
;; When async-fn-list is empty that's mean only one file
;; had to be copied and user finally answer NO.
;; In this case async process will never start and callback
;; will have no chance to run, so notify failures here.
(unless async-fn-list
(cond (failures
(funcall dired-async-message-function
"%s failed for %d of %d file%s -- See *Dired log* buffer"
'dired-async-failures
operation (length failures)
total (dired-plural-s total)))
(skipped
(funcall dired-async-message-function
"%s: %d of %d file%s skipped -- See *Dired log* buffer"
'dired-async-failures
operation (length skipped) total
(dired-plural-s total)))))
;; Setup callback.
(setq callback (setq callback
`(lambda (&optional ignore) (lambda (&optional _ignore)
(dired-async-after-file-create ,total) (dired-async-after-file-create
(when (string= ,(downcase operation) "rename") total (list operation (length async-fn-list)) failures skipped)
(cl-loop for (file . to) in ',async-fn-list (when (string= (downcase operation) "rename")
do (and (get-file-buffer file) (cl-loop for (file . to) in async-fn-list
(with-current-buffer (get-file-buffer file) for bf = (get-file-buffer file)
for destp = (file-exists-p to)
do (and bf destp
(with-current-buffer bf
(set-visited-file-name to nil t)))))))) (set-visited-file-name to nil t))))))))
;; Handle error happening in host emacs.
(cond
(dired-create-files-failures
(setq failures (nconc failures dired-create-files-failures))
(dired-log-summary
(format "%s failed for %d file%s in %d requests"
operation (length failures)
(dired-plural-s (length failures))
total)
failures))
(failures
(dired-log-summary
(format "%s failed for %d of %d file%s"
operation (length failures)
total (dired-plural-s total))
failures))
(skipped
(dired-log-summary
(format "%s: %d of %d file%s skipped"
operation (length skipped) total
(dired-plural-s total))
skipped))
(t (message "%s: %s file%s"
operation success-count (dired-plural-s success-count))))
;; Start async process. ;; Start async process.
(when async-fn-list (when async-fn-list
(async-start `(lambda () (async-start `(lambda ()
(require 'cl-lib) (require 'dired-aux) (require 'dired-x) (require 'cl-lib) (require 'dired-aux) (require 'dired-x)
,(async-inject-variables dired-async-env-variables-regexp) ,(async-inject-variables dired-async-env-variables-regexp)
(condition-case err (let ((dired-recursive-copies (quote always))
(let ((dired-recursive-copies (quote always))) (dired-copy-preserve-time
,dired-copy-preserve-time))
(setq overwrite-backup-query nil)
;; Inline `backup-file' as long as it is not ;; Inline `backup-file' as long as it is not
;; available in emacs. ;; available in emacs.
(defalias 'backup-file (defalias 'backup-file
@ -274,21 +290,24 @@ ESC or `q' to not overwrite any of the remaining files,
(condition-case err (condition-case err
(copy-file from to ok dired-copy-preserve-time) (copy-file from to ok dired-copy-preserve-time)
(file-date-error (file-date-error
(push (dired-make-relative from)
dired-create-files-failures)
(dired-log "Can't set date on %s:\n%s\n" from err))))))) (dired-log "Can't set date on %s:\n%s\n" from err)))))))
;; Now run the FILE-CREATOR function on files. ;; Now run the FILE-CREATOR function on files.
(cl-loop with fn = (quote ,file-creator) (cl-loop with fn = (quote ,file-creator)
for (from . dest) in (quote ,async-fn-list) for (from . dest) in (quote ,async-fn-list)
do (funcall fn from dest t))) do (condition-case err
(file-error (funcall fn from dest t)
(with-temp-file ,dired-async-log-file (file-error
(insert (format "%S" err))))) (dired-log "%s: %s\n" (car err) (cdr err)))
nil))
(when (get-buffer dired-log-buffer)
(dired-log t)
(with-current-buffer dired-log-buffer
(write-region (point-min) (point-max)
,dired-async-log-file))))
,(dired-async-maybe-kill-ftp)) ,(dired-async-maybe-kill-ftp))
callback) callback)
;; Run mode-line notifications while process running. ;; Run mode-line notifications while process running.
(dired-async--modeline-mode 1) (dired-async--modeline-mode 1)
(setq dired-async-operation (list operation (length async-fn-list)))
(message "%s proceeding asynchronously..." operation)))) (message "%s proceeding asynchronously..." operation))))
(defadvice dired-create-files (around dired-async) (defadvice dired-create-files (around dired-async)

View File

@ -1,4 +1,4 @@
;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously ;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- lexical-binding: t -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc. ;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
@ -65,8 +65,8 @@ It is called just before calling `smtpmail-send-it'.")
nil "\\`\\(mail-header-format-function\\|smtpmail-address-buffer\\|mail-mode-abbrev-table\\)") nil "\\`\\(mail-header-format-function\\|smtpmail-address-buffer\\|mail-mode-abbrev-table\\)")
(run-hooks 'async-smtpmail-before-send-hook) (run-hooks 'async-smtpmail-before-send-hook)
(smtpmail-send-it))) (smtpmail-send-it)))
`(lambda (&optional ignore) (lambda (&optional _ignore)
(message "Delivering message to %s...done" ,to))))) (message "Delivering message to %s...done" to)))))
(provide 'smtpmail-async) (provide 'smtpmail-async)

View File

@ -1 +0,0 @@
(define-package "buffer-move" "20160108.708" "easily swap buffers" 'nil :url "https://github.com/lukhas/buffer-move" :keywords '("lisp" "convenience"))

View File

@ -3,8 +3,8 @@
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "buffer-move" "buffer-move.el" (22297 19848 ;;;### (autoloads nil "buffer-move" "buffer-move.el" (22387 29375
;;;;;; 209528 72000)) ;;;;;; 754161 271000))
;;; Generated autoloads from buffer-move.el ;;; Generated autoloads from buffer-move.el
(autoload 'buf-move-up "buffer-move" "\ (autoload 'buf-move-up "buffer-move" "\

View File

@ -0,0 +1 @@
(define-package "buffer-move" "20160615.1103" "easily swap buffers" 'nil :url "https://github.com/lukhas/buffer-move" :keywords '("lisp" "convenience"))

View File

@ -8,7 +8,7 @@
;; Geyslan G. Bem <geyslan@gmail.com> ;; Geyslan G. Bem <geyslan@gmail.com>
;; Mathis Hofer <mathis@fsfe.org> ;; Mathis Hofer <mathis@fsfe.org>
;; Keywords: lisp,convenience ;; Keywords: lisp,convenience
;; Package-Version: 20160108.708 ;; Package-Version: 20160615.1103
;; Version: 0.6.2 ;; Version: 0.6.2
;; URL : https://github.com/lukhas/buffer-move ;; URL : https://github.com/lukhas/buffer-move
@ -92,6 +92,12 @@
:group 'buffer-move :group 'buffer-move
:type 'symbol) :type 'symbol)
(defcustom buffer-move-stay-after-swap nil
"If set to non-nil, point will stay in the current window
so it will not be moved when swapping buffers. This setting
only has effect if `buffer-move-behavior' is set to 'swap."
:group 'buffer-move
:type 'boolean)
(defun buf-move-to (direction) (defun buf-move-to (direction)
"Helper function to move the current buffer to the window in the given "Helper function to move the current buffer to the window in the given
@ -116,7 +122,9 @@
;; switch other window to this buffer ;; switch other window to this buffer
(set-window-buffer other-win buf-this-buf) (set-window-buffer other-win buf-this-buf)
(select-window other-win)))) (when (or (null buffer-move-stay-after-swap)
(eq buffer-move-behavior 'move))
(select-window other-win)))))
;;;###autoload ;;;###autoload
(defun buf-move-up () (defun buf-move-up ()

View File

@ -1 +0,0 @@
(define-package "coffee-mode" "20160419.1947" "Major mode for CoffeeScript code" '((emacs "24.1") (cl-lib "0.5")) :url "http://github.com/defunkt/coffee-mode" :keywords '("coffeescript" "major" "mode"))

View File

@ -3,8 +3,8 @@
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "coffee-mode" "coffee-mode.el" (22297 53349 ;;;### (autoloads nil "coffee-mode" "coffee-mode.el" (22387 29375
;;;;;; 494925 803000)) ;;;;;; 378447 595000))
;;; Generated autoloads from coffee-mode.el ;;; Generated autoloads from coffee-mode.el
(autoload 'coffee-mode "coffee-mode" "\ (autoload 'coffee-mode "coffee-mode" "\

View File

@ -0,0 +1 @@
(define-package "coffee-mode" "20160520.146" "Major mode for CoffeeScript code" '((emacs "24.1") (cl-lib "0.5")) :url "http://github.com/defunkt/coffee-mode" :keywords '("coffeescript" "major" "mode"))

View File

@ -3,7 +3,7 @@
;; Copyright (C) 2010 Chris Wanstrath ;; Copyright (C) 2010 Chris Wanstrath
;; Version: 0.6.3 ;; Version: 0.6.3
;; Package-Version: 20160419.1947 ;; Package-Version: 20160520.146
;; Keywords: CoffeeScript major mode ;; Keywords: CoffeeScript major mode
;; Author: Chris Wanstrath <chris@ozmm.org> ;; Author: Chris Wanstrath <chris@ozmm.org>
;; URL: http://github.com/defunkt/coffee-mode ;; URL: http://github.com/defunkt/coffee-mode
@ -737,7 +737,7 @@ output in a compilation buffer."
"Return the indentation level of the previous non-blank line." "Return the indentation level of the previous non-blank line."
(save-excursion (save-excursion
(forward-line -1) (forward-line -1)
(while (and (looking-at "^[ \t]*$") (not (bobp))) (while (and (looking-at-p "^[ \t]*$") (not (bobp)))
(forward-line -1)) (forward-line -1))
(current-indentation))) (current-indentation)))
@ -815,15 +815,16 @@ previous line."
(or (and char-of-eol (memq char-of-eol coffee-indenters-eol)) (or (and char-of-eol (memq char-of-eol coffee-indenters-eol))
(progn (progn
(back-to-indentation) (back-to-indentation)
(looking-at (coffee-indenters-bol-regexp))))))) (and (looking-at-p (coffee-indenters-bol-regexp))
(not (re-search-forward "\\_<then\\_>" (line-end-position) t))))))))
(defun coffee-previous-line-is-single-line-comment () (defun coffee-previous-line-is-single-line-comment ()
"Return t if the previous line is a CoffeeScript single line comment." "Return t if the previous line is a CoffeeScript single line comment."
(save-excursion (save-excursion
(forward-line -1) (forward-line -1)
(back-to-indentation) (back-to-indentation)
(and (looking-at "#") (and (looking-at-p "#")
(not (looking-at "###\\(?:\\s-+.*\\)?$")) (not (looking-at-p "###\\(?:\\s-+.*\\)?$"))
(progn (progn
(goto-char (line-end-position)) (goto-char (line-end-position))
(nth 4 (syntax-ppss)))))) (nth 4 (syntax-ppss))))))
@ -865,7 +866,7 @@ indented less than COUNT columns."
;; Check that all lines can be shifted enough ;; Check that all lines can be shifted enough
(while (< (point) end) (while (< (point) end)
(if (and (< (current-indentation) amount) (if (and (< (current-indentation) amount)
(not (looking-at "[ \t]*$"))) (not (looking-at-p "[ \t]*$")))
(error "Can't shift all lines enough")) (error "Can't shift all lines enough"))
(forward-line)) (forward-line))
(indent-rigidly start end (- amount))))))) (indent-rigidly start end (- amount)))))))
@ -927,7 +928,7 @@ comments such as the following:
..." ..."
(let ((ret (forward-paragraph count))) (let ((ret (forward-paragraph count)))
(when (and (= count -1) (when (and (= count -1)
(looking-at "[[:space:]]*###[[:space:]]*$")) (looking-at-p "[[:space:]]*###[[:space:]]*$"))
(forward-line)) (forward-line))
ret)) ret))
@ -1236,6 +1237,19 @@ comments such as the following:
;; Define Major Mode ;; Define Major Mode
;; ;;
(defvar coffee-mode-syntax-table
(let ((table (make-syntax-table)))
;; perl style comment: "# ..."
(modify-syntax-entry ?# "< b" table)
(modify-syntax-entry ?\n "> b" table)
;; Treat slashes as paired delimiters; useful for finding regexps.
(modify-syntax-entry ?/ "/" table)
;; single quote strings
(modify-syntax-entry ?' "\"" table)
table))
;;;###autoload ;;;###autoload
(define-derived-mode coffee-mode prog-mode "Coffee" (define-derived-mode coffee-mode prog-mode "Coffee"
"Major mode for editing CoffeeScript." "Major mode for editing CoffeeScript."
@ -1247,18 +1261,9 @@ comments such as the following:
(set (make-local-variable 'comment-line-break-function) (set (make-local-variable 'comment-line-break-function)
#'coffee-comment-line-break-fn) #'coffee-comment-line-break-fn)
(set (make-local-variable 'normal-auto-fill-function) #'coffee-auto-fill-fn) (set (make-local-variable 'normal-auto-fill-function) #'coffee-auto-fill-fn)
;; perl style comment: "# ..."
(modify-syntax-entry ?# "< b" coffee-mode-syntax-table)
(modify-syntax-entry ?\n "> b" coffee-mode-syntax-table)
;; Treat slashes as paired delimiters; useful for finding regexps.
(modify-syntax-entry ?/ "/" coffee-mode-syntax-table)
(set (make-local-variable 'comment-start) "#") (set (make-local-variable 'comment-start) "#")
;; single quote strings
(modify-syntax-entry ?' "\"" coffee-mode-syntax-table)
;; indentation ;; indentation
(make-local-variable 'coffee-tab-width) (make-local-variable 'coffee-tab-width)
(make-local-variable 'coffee-indent-tabs-mode) (make-local-variable 'coffee-indent-tabs-mode)

View File

@ -3,8 +3,8 @@
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "company" "company.el" (22303 19286 146174 ;;;### (autoloads nil "company" "company.el" (22387 29374 119407
;;;;;; 415000)) ;;;;;; 928000))
;;; Generated autoloads from company.el ;;; Generated autoloads from company.el
(autoload 'company-mode "company" "\ (autoload 'company-mode "company" "\
@ -73,8 +73,8 @@ inserted.
;;;*** ;;;***
;;;### (autoloads nil "company-abbrev" "company-abbrev.el" (22303 ;;;### (autoloads nil "company-abbrev" "company-abbrev.el" (22387
;;;;;; 19286 222174 356000)) ;;;;;; 29374 199346 932000))
;;; Generated autoloads from company-abbrev.el ;;; Generated autoloads from company-abbrev.el
(autoload 'company-abbrev "company-abbrev" "\ (autoload 'company-abbrev "company-abbrev" "\
@ -84,8 +84,8 @@ inserted.
;;;*** ;;;***
;;;### (autoloads nil "company-bbdb" "company-bbdb.el" (22303 19286 ;;;### (autoloads nil "company-bbdb" "company-bbdb.el" (22387 29374
;;;;;; 206174 368000)) ;;;;;; 179362 181000))
;;; Generated autoloads from company-bbdb.el ;;; Generated autoloads from company-bbdb.el
(autoload 'company-bbdb "company-bbdb" "\ (autoload 'company-bbdb "company-bbdb" "\
@ -95,8 +95,8 @@ inserted.
;;;*** ;;;***
;;;### (autoloads nil "company-css" "company-css.el" (22303 19286 ;;;### (autoloads nil "company-css" "company-css.el" (22387 29374
;;;;;; 142174 418000)) ;;;;;; 115410 979000))
;;; Generated autoloads from company-css.el ;;; Generated autoloads from company-css.el
(autoload 'company-css "company-css" "\ (autoload 'company-css "company-css" "\
@ -106,8 +106,8 @@ inserted.
;;;*** ;;;***
;;;### (autoloads nil "company-dabbrev" "company-dabbrev.el" (22303 ;;;### (autoloads nil "company-dabbrev" "company-dabbrev.el" (22387
;;;;;; 19286 178174 390000)) ;;;;;; 29374 151383 530000))
;;; Generated autoloads from company-dabbrev.el ;;; Generated autoloads from company-dabbrev.el
(autoload 'company-dabbrev "company-dabbrev" "\ (autoload 'company-dabbrev "company-dabbrev" "\
@ -118,7 +118,7 @@ dabbrev-like `company-mode' completion backend.
;;;*** ;;;***
;;;### (autoloads nil "company-dabbrev-code" "company-dabbrev-code.el" ;;;### (autoloads nil "company-dabbrev-code" "company-dabbrev-code.el"
;;;;;; (22303 19286 170174 396000)) ;;;;;; (22387 29374 139392 679000))
;;; Generated autoloads from company-dabbrev-code.el ;;; Generated autoloads from company-dabbrev-code.el
(autoload 'company-dabbrev-code "company-dabbrev-code" "\ (autoload 'company-dabbrev-code "company-dabbrev-code" "\
@ -130,8 +130,8 @@ comments or strings.
;;;*** ;;;***
;;;### (autoloads nil "company-elisp" "company-elisp.el" (22303 19286 ;;;### (autoloads nil "company-elisp" "company-elisp.el" (22387 29374
;;;;;; 242174 341000)) ;;;;;; 207340 832000))
;;; Generated autoloads from company-elisp.el ;;; Generated autoloads from company-elisp.el
(autoload 'company-elisp "company-elisp" "\ (autoload 'company-elisp "company-elisp" "\
@ -141,8 +141,8 @@ comments or strings.
;;;*** ;;;***
;;;### (autoloads nil "company-etags" "company-etags.el" (22303 19286 ;;;### (autoloads nil "company-etags" "company-etags.el" (22387 29374
;;;;;; 154174 409000)) ;;;;;; 127401 829000))
;;; Generated autoloads from company-etags.el ;;; Generated autoloads from company-etags.el
(autoload 'company-etags "company-etags" "\ (autoload 'company-etags "company-etags" "\
@ -152,8 +152,8 @@ comments or strings.
;;;*** ;;;***
;;;### (autoloads nil "company-files" "company-files.el" (22303 19286 ;;;### (autoloads nil "company-files" "company-files.el" (22387 29374
;;;;;; 182174 387000)) ;;;;;; 159377 430000))
;;; Generated autoloads from company-files.el ;;; Generated autoloads from company-files.el
(autoload 'company-files "company-files" "\ (autoload 'company-files "company-files" "\
@ -165,8 +165,8 @@ File paths with spaces are only supported inside strings.
;;;*** ;;;***
;;;### (autoloads nil "company-gtags" "company-gtags.el" (22303 19286 ;;;### (autoloads nil "company-gtags" "company-gtags.el" (22387 29374
;;;;;; 114174 440000)) ;;;;;; 87432 327000))
;;; Generated autoloads from company-gtags.el ;;; Generated autoloads from company-gtags.el
(autoload 'company-gtags "company-gtags" "\ (autoload 'company-gtags "company-gtags" "\
@ -176,8 +176,8 @@ File paths with spaces are only supported inside strings.
;;;*** ;;;***
;;;### (autoloads nil "company-ispell" "company-ispell.el" (22303 ;;;### (autoloads nil "company-ispell" "company-ispell.el" (22387
;;;;;; 19286 230174 350000)) ;;;;;; 29374 203343 882000))
;;; Generated autoloads from company-ispell.el ;;; Generated autoloads from company-ispell.el
(autoload 'company-ispell "company-ispell" "\ (autoload 'company-ispell "company-ispell" "\
@ -187,8 +187,8 @@ File paths with spaces are only supported inside strings.
;;;*** ;;;***
;;;### (autoloads nil "company-keywords" "company-keywords.el" (22303 ;;;### (autoloads nil "company-keywords" "company-keywords.el" (22387
;;;;;; 19286 194174 378000)) ;;;;;; 29374 167371 330000))
;;; Generated autoloads from company-keywords.el ;;; Generated autoloads from company-keywords.el
(autoload 'company-keywords "company-keywords" "\ (autoload 'company-keywords "company-keywords" "\
@ -198,8 +198,8 @@ File paths with spaces are only supported inside strings.
;;;*** ;;;***
;;;### (autoloads nil "company-nxml" "company-nxml.el" (22303 19286 ;;;### (autoloads nil "company-nxml" "company-nxml.el" (22387 29374
;;;;;; 210174 365000)) ;;;;;; 187356 81000))
;;; Generated autoloads from company-nxml.el ;;; Generated autoloads from company-nxml.el
(autoload 'company-nxml "company-nxml" "\ (autoload 'company-nxml "company-nxml" "\
@ -209,8 +209,8 @@ File paths with spaces are only supported inside strings.
;;;*** ;;;***
;;;### (autoloads nil "company-oddmuse" "company-oddmuse.el" (22303 ;;;### (autoloads nil "company-oddmuse" "company-oddmuse.el" (22387
;;;;;; 19286 134174 424000)) ;;;;;; 29374 107417 78000))
;;; Generated autoloads from company-oddmuse.el ;;; Generated autoloads from company-oddmuse.el
(autoload 'company-oddmuse "company-oddmuse" "\ (autoload 'company-oddmuse "company-oddmuse" "\
@ -220,8 +220,8 @@ File paths with spaces are only supported inside strings.
;;;*** ;;;***
;;;### (autoloads nil "company-semantic" "company-semantic.el" (22303 ;;;### (autoloads nil "company-semantic" "company-semantic.el" (22387
;;;;;; 19286 122174 434000)) ;;;;;; 29374 91429 277000))
;;; Generated autoloads from company-semantic.el ;;; Generated autoloads from company-semantic.el
(autoload 'company-semantic "company-semantic" "\ (autoload 'company-semantic "company-semantic" "\
@ -231,8 +231,8 @@ File paths with spaces are only supported inside strings.
;;;*** ;;;***
;;;### (autoloads nil "company-tempo" "company-tempo.el" (22303 19286 ;;;### (autoloads nil "company-tempo" "company-tempo.el" (22387 29374
;;;;;; 174174 393000)) ;;;;;; 147386 580000))
;;; Generated autoloads from company-tempo.el ;;; Generated autoloads from company-tempo.el
(autoload 'company-tempo "company-tempo" "\ (autoload 'company-tempo "company-tempo" "\
@ -242,8 +242,8 @@ File paths with spaces are only supported inside strings.
;;;*** ;;;***
;;;### (autoloads nil "company-xcode" "company-xcode.el" (22303 19286 ;;;### (autoloads nil "company-xcode" "company-xcode.el" (22387 29374
;;;;;; 218174 359000)) ;;;;;; 195349 982000))
;;; Generated autoloads from company-xcode.el ;;; Generated autoloads from company-xcode.el
(autoload 'company-xcode "company-xcode" "\ (autoload 'company-xcode "company-xcode" "\
@ -254,7 +254,7 @@ File paths with spaces are only supported inside strings.
;;;*** ;;;***
;;;### (autoloads nil "company-yasnippet" "company-yasnippet.el" ;;;### (autoloads nil "company-yasnippet" "company-yasnippet.el"
;;;;;; (22303 19286 214174 362000)) ;;;;;; (22387 29374 191353 32000))
;;; Generated autoloads from company-yasnippet.el ;;; Generated autoloads from company-yasnippet.el
(autoload 'company-yasnippet "company-yasnippet" "\ (autoload 'company-yasnippet "company-yasnippet" "\
@ -286,7 +286,7 @@ shadow backends that come after it. Recommended usages:
;;;### (autoloads nil nil ("company-capf.el" "company-clang.el" "company-cmake.el" ;;;### (autoloads nil nil ("company-capf.el" "company-clang.el" "company-cmake.el"
;;;;;; "company-eclim.el" "company-pkg.el" "company-template.el") ;;;;;; "company-eclim.el" "company-pkg.el" "company-template.el")
;;;;;; (22303 19286 253549 387000)) ;;;;;; (22387 29374 220274 120000))
;;;*** ;;;***

View File

@ -41,8 +41,11 @@ buffers with the same major mode. See also `company-dabbrev-time-limit'."
(const :tag "All" all))) (const :tag "All" all)))
(defcustom company-dabbrev-ignore-buffers "\\`[ *]" (defcustom company-dabbrev-ignore-buffers "\\`[ *]"
"Regexp matching the names of buffers to ignore." "Regexp matching the names of buffers to ignore.
:type 'regexp) Or a function that returns non-nil for such buffers."
:type '(choice (regexp :tag "Regexp")
(function :tag "Predicate"))
:package-version '(company . "0.9.0"))
(defcustom company-dabbrev-time-limit .1 (defcustom company-dabbrev-time-limit .1
"Determines how many seconds `company-dabbrev' should look for matches." "Determines how many seconds `company-dabbrev' should look for matches."
@ -137,14 +140,16 @@ This variable affects both `company-dabbrev' and `company-dabbrev-code'."
ignore-comments))) ignore-comments)))
(when other-buffer-modes (when other-buffer-modes
(cl-dolist (buffer (delq (current-buffer) (buffer-list))) (cl-dolist (buffer (delq (current-buffer) (buffer-list)))
(with-current-buffer buffer (unless (if (stringp company-dabbrev-ignore-buffers)
(when (if (eq other-buffer-modes 'all) (string-match-p company-dabbrev-ignore-buffers
(not (string-match-p company-dabbrev-ignore-buffers (buffer-name buffer))
(buffer-name))) (funcall company-dabbrev-ignore-buffers buffer))
(apply #'derived-mode-p other-buffer-modes)) (with-current-buffer buffer
(setq symbols (when (or (eq other-buffer-modes 'all)
(company-dabbrev--search-buffer regexp nil symbols start (apply #'derived-mode-p other-buffer-modes))
limit ignore-comments)))) (setq symbols
(company-dabbrev--search-buffer regexp nil symbols start
limit ignore-comments)))))
(and limit (and limit
(> (float-time (time-since start)) limit) (> (float-time (time-since start)) limit)
(cl-return)))) (cl-return))))

View File

@ -89,10 +89,11 @@ eclim can only complete correctly when the buffer has been saved."
(defun company-eclim--project-dir () (defun company-eclim--project-dir ()
(if (eq company-eclim--project-dir 'unknown) (if (eq company-eclim--project-dir 'unknown)
(setq company-eclim--project-dir (let ((dir (locate-dominating-file buffer-file-name ".project")))
(directory-file-name (when dir
(expand-file-name (setq company-eclim--project-dir
(locate-dominating-file buffer-file-name ".project")))) (directory-file-name
(expand-file-name dir)))))
company-eclim--project-dir)) company-eclim--project-dir))
(defun company-eclim--project-name () (defun company-eclim--project-name ()

View File

@ -1,4 +1,4 @@
(define-package "company" "20160424.1521" "Modular text completion framework" (define-package "company" "20160626.1903" "Modular text completion framework"
'((emacs "24.1") '((emacs "24.1")
(cl-lib "0.5")) (cl-lib "0.5"))
:url "http://company-mode.github.io/" :keywords :url "http://company-mode.github.io/" :keywords

View File

@ -5,7 +5,7 @@
;; Author: Nikolaj Schumacher ;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru> ;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
;; URL: http://company-mode.github.io/ ;; URL: http://company-mode.github.io/
;; Version: 0.9.0-cvs ;; Version: 0.9.0
;; Keywords: abbrev, convenience, matching ;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5")) ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
@ -186,9 +186,13 @@ buffer-local wherever it is set."
(defun company-frontends-set (variable value) (defun company-frontends-set (variable value)
;; Uniquify. ;; Uniquify.
(let ((value (delete-dups (copy-sequence value)))) (let ((value (delete-dups (copy-sequence value))))
(and (memq 'company-pseudo-tooltip-unless-just-one-frontend value) (and (or (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value)
(memq 'company-pseudo-tooltip-frontend value) (memq 'company-pseudo-tooltip-frontend value))
(error "Pseudo tooltip frontend cannot be used twice")) (and (memq 'company-pseudo-tooltip-unless-just-one-frontend-with-delay value)
(memq 'company-pseudo-tooltip-frontend value))
(and (memq 'company-pseudo-tooltip-unless-just-one-frontend-with-delay value)
(memq 'company-pseudo-tooltip-unless-just-one-frontend value)))
(error "Pseudo tooltip frontend cannot be used more than once"))
(and (memq 'company-preview-if-just-one-frontend value) (and (memq 'company-preview-if-just-one-frontend value)
(memq 'company-preview-frontend value) (memq 'company-preview-frontend value)
(error "Preview frontend cannot be used twice")) (error "Preview frontend cannot be used twice"))
@ -233,6 +237,8 @@ The visualized data is stored in `company-prefix', `company-candidates',
company-pseudo-tooltip-frontend) company-pseudo-tooltip-frontend)
(const :tag "pseudo tooltip, multiple only" (const :tag "pseudo tooltip, multiple only"
company-pseudo-tooltip-unless-just-one-frontend) company-pseudo-tooltip-unless-just-one-frontend)
(const :tag "pseudo tooltip, multiple only, delayed"
company-pseudo-tooltip-unless-just-one-frontend-with-delay)
(const :tag "preview" company-preview-frontend) (const :tag "preview" company-preview-frontend)
(const :tag "preview, unique only" (const :tag "preview, unique only"
company-preview-if-just-one-frontend) company-preview-if-just-one-frontend)
@ -420,11 +426,11 @@ call is dispatched to the backend the candidate came from. In other
cases (except for `duplicates' and `sorted'), the first non-nil value among cases (except for `duplicates' and `sorted'), the first non-nil value among
all the backends is returned. all the backends is returned.
The group can also contain keywords. Currently, `:with' and `:sorted' The group can also contain keywords. Currently, `:with' and `:separate'
keywords are defined. If the group contains keyword `:with', the backends keywords are defined. If the group contains keyword `:with', the backends
listed after this keyword are ignored for the purpose of the `prefix' listed after this keyword are ignored for the purpose of the `prefix'
command. If the group contains keyword `:sorted', the final list of command. If the group contains keyword `:separate', the candidates that
candidates is not sorted after concatenation. come from different backends are sorted separately in the combined list.
Asynchronous backends Asynchronous backends
===================== =====================
@ -465,6 +471,8 @@ without duplicates."
(const :tag "Sort by occurrence" (company-sort-by-occurrence)) (const :tag "Sort by occurrence" (company-sort-by-occurrence))
(const :tag "Sort by backend importance" (const :tag "Sort by backend importance"
(company-sort-by-backend-importance)) (company-sort-by-backend-importance))
(const :tag "Prefer case sensitive prefix"
(company-sort-prefer-same-case-prefix))
(repeat :tag "User defined" (function)))) (repeat :tag "User defined" (function))))
(defcustom company-completion-started-hook nil (defcustom company-completion-started-hook nil
@ -557,6 +565,13 @@ happens. The value of nil means no idle completion."
(const :tag "immediate (0)" 0) (const :tag "immediate (0)" 0)
(number :tag "seconds"))) (number :tag "seconds")))
(defcustom company-tooltip-idle-delay .5
"The idle delay in seconds until tooltip is shown when using
`company-pseudo-tooltip-unless-just-one-frontend-with-delay'."
:type '(choice (const :tag "never (nil)" nil)
(const :tag "immediate (0)" 0)
(number :tag "seconds")))
(defcustom company-begin-commands '(self-insert-command (defcustom company-begin-commands '(self-insert-command
org-self-insert-command org-self-insert-command
orgtbl-self-insert-command orgtbl-self-insert-command
@ -720,9 +735,6 @@ keymap during active completions (`company-active-map'):
nil company-lighter company-mode-map nil company-lighter company-mode-map
(if company-mode (if company-mode
(progn (progn
(when (eq company-idle-delay t)
(setq company-idle-delay 0)
(warn "Setting `company-idle-delay' to t is deprecated. Set it to 0 instead."))
(add-hook 'pre-command-hook 'company-pre-command nil t) (add-hook 'pre-command-hook 'company-pre-command nil t)
(add-hook 'post-command-hook 'company-post-command nil t) (add-hook 'post-command-hook 'company-post-command nil t)
(mapc 'company-init-backend company-backends)) (mapc 'company-init-backend company-backends))
@ -905,19 +917,19 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
(let ((backends (cl-loop for b in backends (let ((backends (cl-loop for b in backends
when (not (and (symbolp b) when (not (and (symbolp b)
(eq 'failed (get b 'company-init)))) (eq 'failed (get b 'company-init))))
collect b))) collect b))
(separate (memq :separate backends)))
(when (eq command 'prefix) (when (eq command 'prefix)
(setq backends (butlast backends (length (member :with backends))))) (setq backends (butlast backends (length (member :with backends)))))
(unless (memq command '(sorted)) (setq backends (cl-delete-if #'keywordp backends))
(setq backends (cl-delete-if #'keywordp backends)))
(pcase command (pcase command
(`candidates (`candidates
(company--multi-backend-adapter-candidates backends (car args))) (company--multi-backend-adapter-candidates backends (car args) separate))
(`sorted (memq :sorted backends)) (`sorted separate)
(`duplicates t) (`duplicates (not separate))
((or `prefix `ignore-case `no-cache `require-match) ((or `prefix `ignore-case `no-cache `require-match)
(let (value) (let (value)
(cl-dolist (backend backends) (cl-dolist (backend backends)
@ -931,26 +943,35 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
(car backends)))) (car backends))))
(apply backend command args)))))))) (apply backend command args))))))))
(defun company--multi-backend-adapter-candidates (backends prefix) (defun company--multi-backend-adapter-candidates (backends prefix separate)
(let ((pairs (cl-loop for backend in (cdr backends) (let ((pairs (cl-loop for backend in backends
when (equal (company--prefix-str when (equal (company--prefix-str
(funcall backend 'prefix)) (funcall backend 'prefix))
prefix) prefix)
collect (cons (funcall backend 'candidates prefix) collect (cons (funcall backend 'candidates prefix)
(let ((b backend)) (company--multi-candidates-mapper
(lambda (candidates) backend
(mapcar separate
(lambda (str) ;; Small perf optimization: don't tag the
(propertize str 'company-backend b)) ;; candidates received from the first
candidates))))))) ;; backend in the group.
(when (equal (company--prefix-str (funcall (car backends) 'prefix)) prefix) (not (eq backend (car backends))))))))
;; Small perf optimization: don't tag the candidates received
;; from the first backend in the group.
(push (cons (funcall (car backends) 'candidates prefix)
'identity)
pairs))
(company--merge-async pairs (lambda (values) (apply #'append values))))) (company--merge-async pairs (lambda (values) (apply #'append values)))))
(defun company--multi-candidates-mapper (backend separate tag)
(lambda (candidates)
(when separate
(let ((company-backend backend))
(setq candidates
(company--preprocess-candidates candidates))))
(when tag
(setq candidates
(mapcar
(lambda (str)
(propertize str 'company-backend backend))
candidates)))
candidates))
(defun company--merge-async (pairs merger) (defun company--merge-async (pairs merger)
(let ((async (cl-loop for pair in pairs (let ((async (cl-loop for pair in pairs
thereis thereis
@ -1017,6 +1038,7 @@ Controlled by `company-auto-complete'.")
(defvar-local company-point nil) (defvar-local company-point nil)
(defvar company-timer nil) (defvar company-timer nil)
(defvar company-tooltip-timer nil)
(defsubst company-strip-prefix (str) (defsubst company-strip-prefix (str)
(substring str (length company-prefix))) (substring str (length company-prefix)))
@ -1202,10 +1224,11 @@ can retrieve meta-data for them."
(progn (setq res 'done) nil))))) (progn (setq res 'done) nil)))))
(defun company--preprocess-candidates (candidates) (defun company--preprocess-candidates (candidates)
(cl-assert (cl-every #'stringp candidates))
(unless (company-call-backend 'sorted) (unless (company-call-backend 'sorted)
(setq candidates (sort candidates 'string<))) (setq candidates (sort candidates 'string<)))
(when (company-call-backend 'duplicates) (when (company-call-backend 'duplicates)
(setq candidates (company--strip-duplicates candidates))) (company--strip-duplicates candidates))
candidates) candidates)
(defun company--postprocess-candidates (candidates) (defun company--postprocess-candidates (candidates)
@ -1216,37 +1239,27 @@ can retrieve meta-data for them."
(company--transform-candidates candidates)) (company--transform-candidates candidates))
(defun company--strip-duplicates (candidates) (defun company--strip-duplicates (candidates)
(let* ((annos 'unk) (let ((c2 candidates)
(str (car candidates)) (annos 'unk))
(ref (cdr candidates)) (while c2
res str2 anno2) (setcdr c2
(while ref (let ((str (pop c2)))
(setq str2 (pop ref)) (while (let ((str2 (car c2)))
(if (not (equal str str2)) (if (not (equal str str2))
(progn (progn
(push str res) (setq annos 'unk)
(setq str str2) nil)
(setq annos 'unk)) (when (eq annos 'unk)
(setq anno2 (company-call-backend (setq annos (list (company-call-backend
'annotation str2)) 'annotation str))))
(cond (let ((anno2 (company-call-backend
((null anno2)) ; Skip it. 'annotation str2)))
((when (eq annos 'unk) (if (member anno2 annos)
(let ((ann1 (company-call-backend 'annotation str))) t
(if (null ann1) (push anno2 annos)
;; No annotation on the earlier element, drop it. nil))))
t (pop c2))
(setq annos (list ann1)) c2)))))
nil)))
(setq annos (list anno2))
(setq str str2))
((member anno2 annos)) ; Also skip.
(t
(push anno2 annos)
(push str res) ; Maintain ordering.
(setq str str2)))))
(when str (push str res))
(nreverse res)))
(defun company--transform-candidates (candidates) (defun company--transform-candidates (candidates)
(let ((c candidates)) (let ((c candidates))
@ -1340,6 +1353,16 @@ from the rest of the backends in the group, if any, will be left at the end."
(let ((b1 (get-text-property 0 'company-backend c1))) (let ((b1 (get-text-property 0 'company-backend c1)))
(or (not b1) (not (memq b1 low-priority))))))))))) (or (not b1) (not (memq b1 low-priority)))))))))))
(defun company-sort-prefer-same-case-prefix (candidates)
"Prefer CANDIDATES with the exact same prefix.
If a backend returns case insensitive matches, candidates with the an exact
prefix match (same case) will be prioritized."
(cl-loop for candidate in candidates
if (string-prefix-p company-prefix candidate)
collect candidate into same-case
else collect candidate into other-case
finally return (append same-case other-case)))
(defun company-idle-begin (buf win tick pos) (defun company-idle-begin (buf win tick pos)
(and (eq buf (current-buffer)) (and (eq buf (current-buffer))
(eq win (selected-window)) (eq win (selected-window))
@ -1612,11 +1635,13 @@ from the rest of the backends in the group, if any, will be left at the end."
(company--perform))) (company--perform)))
(if company-candidates (if company-candidates
(company-call-frontends 'post-command) (company-call-frontends 'post-command)
(and (numberp company-idle-delay) (and (or (numberp company-idle-delay)
;; Deprecated.
(eq company-idle-delay t))
(not defining-kbd-macro) (not defining-kbd-macro)
(company--should-begin) (company--should-begin)
(setq company-timer (setq company-timer
(run-with-timer company-idle-delay nil (run-with-timer (company--idle-delay) nil
'company-idle-begin 'company-idle-begin
(current-buffer) (selected-window) (current-buffer) (selected-window)
(buffer-chars-modified-tick) (point)))))) (buffer-chars-modified-tick) (point))))))
@ -1625,6 +1650,11 @@ from the rest of the backends in the group, if any, will be left at the end."
(company-cancel)))) (company-cancel))))
(company-install-map)) (company-install-map))
(defun company--idle-delay ()
(if (memql company-idle-delay '(t 0 0.0))
0.01
company-idle-delay))
(defvar company--begin-inhibit-commands '(company-abort (defvar company--begin-inhibit-commands '(company-abort
company-complete-mouse company-complete-mouse
company-complete company-complete
@ -1951,15 +1981,23 @@ With ARG, move by that many elements."
"Select the candidate one page further." "Select the candidate one page further."
(interactive) (interactive)
(when (company-manual-begin) (when (company-manual-begin)
(company-set-selection (+ company-selection (if (and company-selection-wrap-around
company-tooltip-limit)))) (= company-selection (1- company-candidates-length)))
(company-set-selection 0)
(let (company-selection-wrap-around)
(company-set-selection (+ company-selection
company-tooltip-limit))))))
(defun company-previous-page () (defun company-previous-page ()
"Select the candidate one page earlier." "Select the candidate one page earlier."
(interactive) (interactive)
(when (company-manual-begin) (when (company-manual-begin)
(company-set-selection (- company-selection (if (and company-selection-wrap-around
company-tooltip-limit)))) (zerop company-selection))
(company-set-selection (1- company-candidates-length))
(let (company-selection-wrap-around)
(company-set-selection (- company-selection
company-tooltip-limit))))))
(defvar company-pseudo-tooltip-overlay) (defvar company-pseudo-tooltip-overlay)
@ -2057,6 +2095,15 @@ With ARG, move by that many elements."
(eq old-tick (buffer-chars-modified-tick))) (eq old-tick (buffer-chars-modified-tick)))
(company-complete-common)))))) (company-complete-common))))))
(defun company-select-next-if-tooltip-visible-or-complete-selection ()
"Insert selection if appropriate, or select the next candidate.
Insert selection if only preview is showing or only one candidate,
otherwise select the next candidate."
(interactive)
(if (and (company-tooltip-visible-p) (> company-candidates-length 1))
(call-interactively 'company-select-next)
(call-interactively 'company-complete-selection)))
;;;###autoload ;;;###autoload
(defun company-complete () (defun company-complete ()
"Insert the common part of all candidates or the current selection. "Insert the common part of all candidates or the current selection.
@ -2827,6 +2874,30 @@ Returns a negative number if the tooltip should be displayed above point."
(company--show-inline-p)) (company--show-inline-p))
(company-pseudo-tooltip-frontend command))) (company-pseudo-tooltip-frontend command)))
(defun company-pseudo-tooltip-unless-just-one-frontend-with-delay (command)
"`compandy-pseudo-tooltip-frontend', but shown after a delay.
Delay is determined by `company-tooltip-idle-delay'."
(defvar company-preview-overlay)
(when (and (memq command '(pre-command hide))
company-tooltip-timer)
(cancel-timer company-tooltip-timer)
(setq company-tooltip-timer nil))
(cl-case command
(post-command
(if (or company-tooltip-timer
(overlayp company-pseudo-tooltip-overlay))
(if (not (overlayp company-preview-overlay))
(company-pseudo-tooltip-unless-just-one-frontend command)
(let (company-tooltip-timer)
(company-call-frontends 'pre-command))
(company-call-frontends 'post-command))
(setq company-tooltip-timer
(run-with-timer company-tooltip-idle-delay nil
'company-pseudo-tooltip-unless-just-one-frontend-with-delay
'post-command))))
(t
(company-pseudo-tooltip-unless-just-one-frontend command))))
;;; overlay ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; overlay ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local company-preview-overlay nil) (defvar-local company-preview-overlay nil)
@ -2901,6 +2972,11 @@ Returns a negative number if the tooltip should be displayed above point."
(or (eq (company-call-backend 'ignore-case) 'keep-prefix) (or (eq (company-call-backend 'ignore-case) 'keep-prefix)
(string-prefix-p company-prefix company-common)))) (string-prefix-p company-prefix company-common))))
(defun company-tooltip-visible-p ()
"Returns whether the tooltip is visible."
(when (overlayp company-pseudo-tooltip-overlay)
(not (overlay-get company-pseudo-tooltip-overlay 'invisible))))
;;; echo ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; echo ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local company-echo-last-msg nil) (defvar-local company-echo-last-msg nil)

View File

@ -1 +0,0 @@
(define-package "company-shell" "20160212.1139" "Company mode backend for shell functions" '((company "0.8.12") (dash "2.12.0") (cl-lib "0.5")) :url "https://github.com/Alexander-Miller/company-shell" :keywords '("company" "shell"))

View File

@ -3,8 +3,8 @@
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "company-shell" "company-shell.el" (22297 53347 ;;;### (autoloads nil "company-shell" "company-shell.el" (22387 29373
;;;;;; 354924 555000)) ;;;;;; 371978 851000))
;;; Generated autoloads from company-shell.el ;;; Generated autoloads from company-shell.el
(autoload 'company-shell-rebuild-cache "company-shell" "\ (autoload 'company-shell-rebuild-cache "company-shell" "\

View File

@ -0,0 +1 @@
(define-package "company-shell" "20160528.507" "Company mode backend for shell functions" '((company "0.8.12") (dash "2.12.0") (cl-lib "0.5")) :url "https://github.com/Alexander-Miller/company-shell" :keywords '("company" "shell"))

View File

@ -4,9 +4,9 @@
;; Author: Alexander Miller <alexanderm@web.de> ;; Author: Alexander Miller <alexanderm@web.de>
;; Package-Requires: ((company "0.8.12") (dash "2.12.0") (cl-lib "0.5")) ;; Package-Requires: ((company "0.8.12") (dash "2.12.0") (cl-lib "0.5"))
;; Package-Version: 20160528.507
;; Homepage: https://github.com/Alexander-Miller/company-shell ;; Homepage: https://github.com/Alexander-Miller/company-shell
;; Version: 1.0 ;; Version: 1.0
;; Package-Version: 20160212.1139
;; Keywords: company, shell ;; Keywords: company, shell
;; This program is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
@ -32,6 +32,7 @@
(require 'company) (require 'company)
(require 'dash) (require 'dash)
(require 'cl-lib) (require 'cl-lib)
(require 'subr-x)
(defvar company-shell--cache nil (defvar company-shell--cache nil
"Cache of all possible $PATH completions. Automatically built when nil. Invoke `company-shell-rebuild-cache' to rebuild manually.") "Cache of all possible $PATH completions. Automatically built when nil. Invoke `company-shell-rebuild-cache' to rebuild manually.")
@ -88,7 +89,9 @@ it in the understanding that you do this AT YOUR OWN RISK.")
(let ((completions (-mapcat (let ((completions (-mapcat
(lambda (dir) (lambda (dir)
(-map (-map
(lambda (file) (propertize file 'origin dir)) (lambda (file)
(propertize (file-name-sans-extension file)
'origin dir))
(directory-files dir))) (directory-files dir)))
(-filter 'file-readable-p exec-path)))) (-filter 'file-readable-p exec-path))))
(setq company-shell--cache (sort (setq company-shell--cache (sort

View File

@ -1 +0,0 @@
(define-package "dash" "20160306.1222" "A modern list library for Emacs" 'nil :keywords '("lists"))

View File

@ -3,7 +3,7 @@
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("dash.el") (22297 19836 790973 907000)) ;;;### (autoloads nil nil ("dash.el") (22387 29373 79163 715000))
;;;*** ;;;***

View File

@ -0,0 +1 @@
(define-package "dash" "20160619.611" "A modern list library for Emacs" 'nil :keywords '("lists"))

View File

@ -4,7 +4,7 @@
;; Author: Magnar Sveen <magnars@gmail.com> ;; Author: Magnar Sveen <magnars@gmail.com>
;; Version: 2.12.1 ;; Version: 2.12.1
;; Package-Version: 20160306.1222 ;; Package-Version: 20160619.611
;; Keywords: lists ;; Keywords: lists
;; This program is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
@ -72,12 +72,38 @@ special values."
(setq it-index (1+ it-index)) (setq it-index (1+ it-index))
(!cdr ,l))))) (!cdr ,l)))))
(defmacro -doto (eval-initial-value &rest forms)
"Eval a form, then insert that form as the 2nd argument to other forms.
The EVAL-INITIAL-VALUE form is evaluated once. Its result is
passed to FORMS, which are then evaluated sequentially. Returns
the target form."
(declare (indent 1))
(let ((retval (make-symbol "value")))
`(let ((,retval ,eval-initial-value))
,@(mapcar (lambda (form)
(if (sequencep form)
`(,(-first-item form) ,retval ,@(cdr form))
`(funcall form ,retval)))
forms)
,retval)))
(defun -each (list fn) (defun -each (list fn)
"Call FN with every item in LIST. Return nil, used for side-effects only." "Call FN with every item in LIST. Return nil, used for side-effects only."
(--each list (funcall fn it))) (--each list (funcall fn it)))
(put '-each 'lisp-indent-function 1) (put '-each 'lisp-indent-function 1)
(defalias '--each-indexed '--each)
(defun -each-indexed (list fn)
"Call (FN index item) for each item in LIST.
In the anaphoric form `--each-indexed', the index is exposed as `it-index`.
See also: `-map-indexed'."
(--each list (funcall fn it-index it)))
(put '-each-indexed 'lisp-indent-function 1)
(defmacro --each-while (list pred &rest body) (defmacro --each-while (list pred &rest body)
"Anaphoric form of `-each-while'." "Anaphoric form of `-each-while'."
(declare (debug (form form body)) (declare (debug (form form body))
@ -271,7 +297,7 @@ See also: `-remove', `-map-first'"
Alias: `-reject-last' Alias: `-reject-last'
See also: `-remove', `-map-last'" See also: `-remove', `-map-last'"
(nreverse (-remove-first pred (nreverse list)))) (nreverse (-remove-first pred (reverse list))))
(defmacro --remove-last (form list) (defmacro --remove-last (form list)
"Anaphoric form of `-remove-last'." "Anaphoric form of `-remove-last'."
@ -318,7 +344,9 @@ If you want to select the original items satisfying a predicate use `-filter'."
(defun -map-indexed (fn list) (defun -map-indexed (fn list)
"Return a new list consisting of the result of (FN index item) for each item in LIST. "Return a new list consisting of the result of (FN index item) for each item in LIST.
In the anaphoric form `--map-indexed', the index is exposed as `it-index`." In the anaphoric form `--map-indexed', the index is exposed as `it-index`.
See also: `-each-indexed'."
(--map-indexed (funcall fn it-index it) list)) (--map-indexed (funcall fn it-index it) list))
(defmacro --map-when (pred rep list) (defmacro --map-when (pred rep list)
@ -362,7 +390,7 @@ See also: `-map-when', `-replace-first'"
"Replace first item in LIST satisfying PRED with result of REP called on this item. "Replace first item in LIST satisfying PRED with result of REP called on this item.
See also: `-map-when', `-replace-last'" See also: `-map-when', `-replace-last'"
(nreverse (-map-first pred rep (nreverse list)))) (nreverse (-map-first pred rep (reverse list))))
(defmacro --map-last (pred rep list) (defmacro --map-last (pred rep list)
"Anaphoric form of `-map-last'." "Anaphoric form of `-map-last'."
@ -544,11 +572,8 @@ Alias: `-any'"
(defun -butlast (list) (defun -butlast (list)
"Return a list of all items in list except for the last." "Return a list of all items in list except for the last."
(let (result) ;; no alias as we don't want magic optional argument
(while (cdr list) (butlast list))
(!cons (car list) result)
(!cdr list))
(nreverse result)))
(defmacro --count (pred list) (defmacro --count (pred list)
"Anaphoric form of `-count'." "Anaphoric form of `-count'."
@ -665,7 +690,9 @@ section is returned. Defaults to 1."
(nreverse new-list))) (nreverse new-list)))
(defun -take (n list) (defun -take (n list)
"Return a new list of the first N items in LIST, or all items if there are fewer than N." "Return a new list of the first N items in LIST, or all items if there are fewer than N.
See also: `-take-last'"
(let (result) (let (result)
(--dotimes n (--dotimes n
(when list (when list
@ -673,7 +700,23 @@ section is returned. Defaults to 1."
(!cdr list))) (!cdr list)))
(nreverse result))) (nreverse result)))
(defalias '-drop 'nthcdr "Return the tail of LIST without the first N items.") (defun -take-last (n list)
"Return the last N items of LIST in order.
See also: `-take'"
(copy-sequence (last list n)))
(defalias '-drop 'nthcdr
"Return the tail of LIST without the first N items.
See also: `-drop-last'")
(defun -drop-last (n list)
"Remove the last N items of LIST and return a copy.
See also: `-drop'"
;; No alias because we don't want magic optional argument
(butlast list n))
(defmacro --take-while (form list) (defmacro --take-while (form list)
"Anaphoric form of `-take-while'." "Anaphoric form of `-take-while'."
@ -1825,7 +1868,7 @@ Alias: `-uniq'"
(defalias '-uniq '-distinct) (defalias '-uniq '-distinct)
(defun -union (list list2) (defun -union (list list2)
"Return a new list containing the elements of LIST1 and elements of LIST2 that are not in LIST1. "Return a new list containing the elements of LIST and elements of LIST2 that are not in LIST.
The test for equality is done with `equal', The test for equality is done with `equal',
or with `-compare-fn' if that's non-nil." or with `-compare-fn' if that's non-nil."
;; We fall back to iteration implementation if the comparison ;; We fall back to iteration implementation if the comparison
@ -2213,6 +2256,8 @@ structure such as plist or alist."
(let ((new-keywords '( (let ((new-keywords '(
"-each" "-each"
"--each" "--each"
"-each-indexed"
"--each-indexed"
"-each-while" "-each-while"
"--each-while" "--each-while"
"-dotimes" "-dotimes"

View File

@ -1,4 +0,0 @@
(define-package "erlang" "20151013.157" "Erlang major mode" 'nil)
;; Local Variables:
;; no-byte-compile: t
;; End:

View File

@ -3,7 +3,7 @@
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "erlang" "erlang.el" (22297 19833 531790 580000)) ;;;### (autoloads nil "erlang" "erlang.el" (22387 29371 497412 949000))
;;; Generated autoloads from erlang.el ;;; Generated autoloads from erlang.el
(autoload 'erlang-mode "erlang" "\ (autoload 'erlang-mode "erlang" "\
@ -118,8 +118,8 @@ editing control characters:
;;;*** ;;;***
;;;### (autoloads nil "erlang-start" "erlang-start.el" (22297 19833 ;;;### (autoloads nil "erlang-start" "erlang-start.el" (22387 29371
;;;;;; 146797 463000)) ;;;;;; 473431 317000))
;;; Generated autoloads from erlang-start.el ;;; Generated autoloads from erlang-start.el
(let ((a '("\\.erl\\'" . erlang-mode)) (b '("\\.hrl\\'" . erlang-mode))) (or (assoc (car a) auto-mode-alist) (setq auto-mode-alist (cons a auto-mode-alist))) (or (assoc (car b) auto-mode-alist) (setq auto-mode-alist (cons b auto-mode-alist)))) (let ((a '("\\.erl\\'" . erlang-mode)) (b '("\\.hrl\\'" . erlang-mode))) (or (assoc (car a) auto-mode-alist) (setq auto-mode-alist (cons a auto-mode-alist))) (or (assoc (car b) auto-mode-alist) (setq auto-mode-alist (cons b auto-mode-alist))))
@ -131,8 +131,8 @@ editing control characters:
;;;*** ;;;***
;;;### (autoloads nil nil ("erlang-eunit.el" "erlang-flymake.el" ;;;### (autoloads nil nil ("erlang-eunit.el" "erlang-flymake.el"
;;;;;; "erlang-pkg.el" "erlang-skels-old.el" "erlang-skels.el" "erlang_appwiz.el") ;;;;;; "erlang-pkg.el" "erlang-skels-old.el" "erlang-skels.el" "erlang-test.el"
;;;;;; (22297 19834 170483 735000)) ;;;;;; "erlang_appwiz.el") (22387 29371 532912 630000))
;;;*** ;;;***

View File

@ -1,7 +1,7 @@
;; ;;
;; %CopyrightBegin% ;; %CopyrightBegin%
;; ;;
;; Copyright Ericsson AB 2009-2010. All Rights Reserved. ;; Copyright Ericsson AB 2009-2016. All Rights Reserved.
;; ;;
;; Licensed under the Apache License, Version 2.0 (the "License"); ;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License. ;; you may not use this file except in compliance with the License.

View File

@ -0,0 +1,4 @@
(define-package "erlang" "20160615.633" "Erlang major mode" 'nil)
;; Local Variables:
;; no-byte-compile: t
;; End:

View File

@ -1,7 +1,7 @@
;; ;;
;; %CopyrightBegin% ;; %CopyrightBegin%
;; ;;
;; Copyright Ericsson AB 2010. All Rights Reserved. ;; Copyright Ericsson AB 2010-2016. All Rights Reserved.
;; ;;
;; Licensed under the Apache License, Version 2.0 (the "License"); ;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License. ;; you may not use this file except in compliance with the License.
@ -816,7 +816,7 @@ Please see the function `tempo-define-template'.")
"%% Note: This directive should only be used in test suites." n "%% Note: This directive should only be used in test suites." n
"-compile(export_all)." n n "-compile(export_all)." n n
"-include_lib(\"test_server/include/test_server.hrl\")." n n "-include_lib(\"common_test/include/ct.hrl\")." n n
(erlang-skel-separator 2) (erlang-skel-separator 2)
"%% TEST SERVER CALLBACK FUNCTIONS" n "%% TEST SERVER CALLBACK FUNCTIONS" n

View File

@ -1,7 +1,7 @@
;; ;;
;; %CopyrightBegin% ;; %CopyrightBegin%
;; ;;
;; Copyright Ericsson AB 2010-2014. All Rights Reserved. ;; Copyright Ericsson AB 2010-2016. All Rights Reserved.
;; ;;
;; Licensed under the Apache License, Version 2.0 (the "License"); ;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License. ;; you may not use this file except in compliance with the License.
@ -56,6 +56,8 @@
erlang-skel-gen-event erlang-skel-header) erlang-skel-gen-event erlang-skel-header)
("gen_fsm" "gen-fsm" ("gen_fsm" "gen-fsm"
erlang-skel-gen-fsm erlang-skel-header) erlang-skel-gen-fsm erlang-skel-header)
("gen_statem" "gen-statem"
erlang-skel-gen-statem erlang-skel-header)
("wx_object" "wx-object" ("wx_object" "wx-object"
erlang-skel-wx-object erlang-skel-header) erlang-skel-wx-object erlang-skel-header)
("Library module" "gen-lib" ("Library module" "gen-lib"
@ -858,6 +860,122 @@ Please see the function `tempo-define-template'.")
"*The template of a gen_fsm. "*The template of a gen_fsm.
Please see the function `tempo-define-template'.") Please see the function `tempo-define-template'.")
(defvar erlang-skel-gen-statem
'((erlang-skel-include erlang-skel-large-header)
"-behaviour(gen_statem)." n n
"%% API" n
"-export([start_link/0])." n
n
"%% gen_statem callbacks" n
"-export([init/1, terminate/3, code_change/4])." n
"-export([state_name/3])." n
"-export([handle_event/4])." n
n
"-define(SERVER, ?MODULE)." n
n
"-record(data, {})." n
n
(erlang-skel-double-separator-start 3)
"%%% API" n
(erlang-skel-double-separator-end 3) n
(erlang-skel-separator-start 2)
"%% @doc" n
"%% Creates a gen_statem process which calls Module:init/1 to" n
"%% initialize. To ensure a synchronized start-up procedure, this" n
"%% function does not return until Module:init/1 has returned." n
"%%" n
(erlang-skel-separator-end 2)
"-spec start_link() ->" n>
"{ok, Pid :: pid()} |" n>
"ignore |" n>
"{error, Error :: term()}." n
"start_link() ->" n>
"gen_statem:start_link({local, ?SERVER}, ?MODULE, [], [])." n
n
(erlang-skel-double-separator-start 3)
"%%% gen_statem callbacks" n
(erlang-skel-double-separator-end 3) n
(erlang-skel-separator-start 2)
"%% @private" n
"%% @doc" n
"%% Whenever a gen_statem is started using gen_statem:start/[3,4] or" n
"%% gen_statem:start_link/[3,4], this function is called by the new" n
"%% process to initialize." n
(erlang-skel-separator-end 2)
"-spec init(Args :: term()) -> " n>
"{gen_statem:callback_mode()," n>
"State :: term(), Data :: term()} |" n>
"{gen_statem:callback_mode()," n>
"State :: term(), Data :: term()," n>
"[gen_statem:action()] | gen_statem:action()} |" n>
"ignore |" n>
"{stop, Reason :: term()}." n
"init([]) ->" n>
"{state_functions, state_name, #data{}}." n
n
(erlang-skel-separator-start 2)
"%% @private" n
"%% @doc" n
"%% If the gen_statem runs with CallbackMode =:= state_functions" n
"%% there should be one instance of this function for each possible" n
"%% state name. Whenever a gen_statem receives an event," n
"%% the instance of this function with the same name" n
"%% as the current state name StateName is called to" n
"%% handle the event." n
(erlang-skel-separator-end 2)
"-spec state_name(" n>
"gen_statem:event_type(), Msg :: term()," n>
"Data :: term()) ->" n>
"gen_statem:state_function_result(). " n
"state_name({call,Caller}, _Msg, Data) ->" n>
"{next_state, state_name, Data, [{reply,Caller,ok}]}." n
n
(erlang-skel-separator-start 2)
"%% @private" n
"%% @doc" n
"%% If the gen_statem runs with CallbackMode =:= handle_event_function" n
"%% this function is called for every event a gen_statem receives." n
(erlang-skel-separator-end 2)
"-spec handle_event(" n>
"gen_statem:event_type(), Msg :: term()," n>
"State :: term(), Data :: term()) ->" n>
"gen_statem:handle_event_result(). " n
"handle_event({call,From}, _Msg, State, Data) ->" n>
"{next_state, State, Data, [{reply,From,ok}]}." n
n
(erlang-skel-separator-start 2)
"%% @private" n
"%% @doc" n
"%% This function is called by a gen_statem when it is about to" n
"%% terminate. It should be the opposite of Module:init/1 and do any" n
"%% necessary cleaning up. When it returns, the gen_statem terminates with" n
"%% Reason. The return value is ignored." n
(erlang-skel-separator-end 2)
"-spec terminate(Reason :: term(), State :: term(), Data :: term()) ->" n>
"any()." n
"terminate(_Reason, _State, _Data) ->" n>
"void." n
n
(erlang-skel-separator-start 2)
"%% @private" n
"%% @doc" n
"%% Convert process state when code is changed" n
(erlang-skel-separator-end 2)
"-spec code_change(" n>
"OldVsn :: term() | {down,term()}," n>
"State :: term(), Data :: term(), Extra :: term()) ->" n>
"{ok, NewState :: term(), NewData :: term()}." n
"code_change(_OldVsn, State, Data, _Extra) ->" n>
"{ok, State, Data}." n
n
(erlang-skel-double-separator-start 3)
"%%% Internal functions" n
(erlang-skel-double-separator-end 3)
)
"*The template of a gen_statem.
Please see the function `tempo-define-template'.")
(defvar erlang-skel-wx-object (defvar erlang-skel-wx-object
'((erlang-skel-include erlang-skel-large-header) '((erlang-skel-include erlang-skel-large-header)
"-behaviour(wx_object)." n n "-behaviour(wx_object)." n n
@ -1070,7 +1188,7 @@ Please see the function `tempo-define-template'.")
"%% Note: This directive should only be used in test suites." n "%% Note: This directive should only be used in test suites." n
"-compile(export_all)." n n "-compile(export_all)." n n
"-include_lib(\"test_server/include/test_server.hrl\")." n n "-include_lib(\"common_test/include/ct.hrl\")." n n
(erlang-skel-separator-start 2) (erlang-skel-separator-start 2)
"%% TEST SERVER CALLBACK FUNCTIONS" n "%% TEST SERVER CALLBACK FUNCTIONS" n

View File

@ -0,0 +1,122 @@
;;; erlang-test.el -*- lexical-binding: t; coding: utf-8-unix -*-
;;; Unit tests for erlang.el.
;; Author: Johan Claesson
;; Created: 2016-05-07
;; Keywords: erlang, languages
;; %CopyrightBegin%
;;
;; Copyright Ericsson AB 2016. All Rights Reserved.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;
;; %CopyrightEnd%
;;; Commentary:
;; This library require GNU Emacs 25 or later.
;;; Code:
(require 'ert)
(require 'cl-lib)
(require 'erlang)
(defvar erlang-test-code
'((nil . "-module(erlang_test).")
(nil . "-import(lists, [map/2]).")
(nil . "-compile(export_all).")
("SYMBOL" . "-define(SYMBOL, value).")
("MACRO" . "-define(MACRO(X), X + X).")
("struct" . "-record(struct, {until,maps,are,everywhere}).")
("function". "function() -> #struct{}."))
"Alist of erlang test code.
Each entry have the format (TAGNAME . ERLANG_CODE). If TAGNAME
is nil there is no definitions in the ERLANG_CODE. The
ERLANG_CODE is a single line of erlang code. These lines will be
concatenated to form an erlang file to test on.")
(ert-deftest erlang-test-tags ()
(let* ((dir (make-temp-file "erlang-test" t))
(erlang-file (expand-file-name "erlang_test.erl" dir))
(tags-file (expand-file-name "TAGS" dir))
tags-file-name tags-table-list erlang-buffer)
(unwind-protect
(progn
(erlang-test-create-erlang-file erlang-file)
(erlang-test-compile-tags erlang-file tags-file)
(setq erlang-buffer (find-file-noselect erlang-file))
(with-current-buffer erlang-buffer
(setq-local tags-file-name tags-file))
;; Setting global tags-file-name is a workaround for
;; GNU Emacs bug#23164.
(setq tags-file-name tags-file)
(erlang-test-completion-table)
(erlang-test-xref-find-definitions erlang-file erlang-buffer))
(when (buffer-live-p erlang-buffer)
(kill-buffer erlang-buffer))
(let ((tags-buffer (find-buffer-visiting tags-file)))
(when (buffer-live-p tags-buffer)
(kill-buffer tags-buffer)))
(when (file-exists-p dir)
(delete-directory dir t)))))
(defun erlang-test-create-erlang-file (erlang-file)
(with-temp-file erlang-file
(cl-loop for (_ . code) in erlang-test-code
do (insert code "\n"))))
(defun erlang-test-compile-tags (erlang-file tags-file)
(should (zerop (call-process "etags" nil nil nil
"-o" tags-file
erlang-file))))
(defun erlang-test-completion-table ()
(let ((erlang-replace-etags-tags-completion-table t))
(setq tags-completion-table nil)
(tags-completion-table))
(should (equal (sort tags-completion-table #'string-lessp)
(sort (erlang-expected-completion-table) #'string-lessp))))
(defun erlang-expected-completion-table ()
(append (cl-loop for (symbol . _) in erlang-test-code
when (stringp symbol)
append (list symbol (concat "erlang_test:" symbol)))
(list "erlang_test:" "erlang_test:module_info")))
(defun erlang-test-xref-find-definitions (erlang-file erlang-buffer)
(cl-loop for (tagname . code) in erlang-test-code
for line = 1 then (1+ line)
do (when tagname
(switch-to-buffer erlang-buffer)
(xref-find-definitions tagname)
(erlang-test-verify-pos erlang-file line)
(xref-find-definitions (concat "erlang_test:" tagname))
(erlang-test-verify-pos erlang-file line)))
(xref-find-definitions "erlang_test:")
(erlang-test-verify-pos erlang-file 1))
(defun erlang-test-verify-pos (expected-file expected-line)
(should (string-equal (file-truename expected-file)
(file-truename (buffer-file-name))))
(should (eq expected-line (line-number-at-pos)))
(should (= (point-at-bol) (point))))
(provide 'erlang-test)
;;; erlang-test.el ends here

View File

@ -7,7 +7,7 @@
;; %CopyrightBegin% ;; %CopyrightBegin%
;; ;;
;; Copyright Ericsson AB 1996-2014. All Rights Reserved. ;; Copyright Ericsson AB 1996-2016. All Rights Reserved.
;; ;;
;; Licensed under the Apache License, Version 2.0 (the "License"); ;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License. ;; you may not use this file except in compliance with the License.
@ -70,8 +70,8 @@
;; `debug-on-error' to `t'. Repeat the error and enclose the debug ;; `debug-on-error' to `t'. Repeat the error and enclose the debug
;; information in your bug-report. ;; information in your bug-report.
;; ;;
;; To set the variable you can use the following command: ;; To toggle the variable you can use the following command:
;; M-x set-variable RET debug-on-error RET t RET ;; M-x toggle-debug-on-error RET
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
@ -897,6 +897,7 @@ resulting regexp is surrounded by \\_< and \\_>."
"get_module_info" "get_module_info"
"get_stacktrace" "get_stacktrace"
"hash" "hash"
"has_prepared_code_on_load"
"hibernate" "hibernate"
"insert_element" "insert_element"
"is_builtin" "is_builtin"
@ -970,7 +971,7 @@ resulting regexp is surrounded by \\_< and \\_>."
(defvar erlang-defun-prompt-regexp (concat "^" erlang-atom-regexp "\\s *(") (defvar erlang-defun-prompt-regexp (concat "^" erlang-atom-regexp "\\s *(")
"Regexp which should match beginning of a clause.") "Regexp which should match beginning of a clause.")
(defvar erlang-file-name-extension-regexp "\\.[eh]rl$" (defvar erlang-file-name-extension-regexp "\\.erl$"
"*Regexp which should match an Erlang file name. "*Regexp which should match an Erlang file name.
This regexp is used when an Erlang module name is extracted from the This regexp is used when an Erlang module name is extracted from the
@ -1067,8 +1068,14 @@ behaviour.")
"Font lock keyword highlighting a function header.") "Font lock keyword highlighting a function header.")
(defface erlang-font-lock-exported-function-name-face (defface erlang-font-lock-exported-function-name-face
'((default (:inherit font-lock-function-name-face))) (if (featurep 'xemacs)
"Face used for highlighting exported functions.") (progn
(require 'font-lock)
`((t (:foreground ,(face-foreground 'font-lock-function-name-face))
(:background ,(face-background 'font-lock-function-name-face)))))
'((default (:inherit font-lock-function-name-face))))
"Face used for highlighting exported functions."
:group 'erlang)
(defvar erlang-font-lock-exported-function-name-face (defvar erlang-font-lock-exported-function-name-face
'erlang-font-lock-exported-function-name-face) 'erlang-font-lock-exported-function-name-face)
@ -1284,6 +1291,11 @@ Unfortunately, XEmacs hasn't got support for a special Font
Lock syntax table. The effect is that `apply' in the atom Lock syntax table. The effect is that `apply' in the atom
`foo_apply' will be highlighted as a bif.") `foo_apply' will be highlighted as a bif.")
(defvar erlang-replace-etags-tags-completion-table nil
"Internal flag used by advice `erlang-replace-tags-table'.
This is non-nil when `etags-tags-completion-table' should be
replaced by `erlang-etags-tags-completion-table'.")
;;; Avoid errors while compiling this file. ;;; Avoid errors while compiling this file.
@ -1337,14 +1349,22 @@ Lock syntax table. The effect is that `apply' in the atom
(defun erlang-version () (defun erlang-version ()
"Return the current version of Erlang mode." "Return the current version of Erlang mode."
(interactive) (interactive)
(if (interactive-p) (if (erlang-interactive-p)
(message "Erlang mode version %s, written by Anders Lindgren" (message "Erlang mode version %s, written by Anders Lindgren"
erlang-version)) erlang-version))
erlang-version) erlang-version)
(defun erlang-interactive-p ()
(if (fboundp 'called-interactively-p)
(called-interactively-p 'interactive)
(funcall (symbol-function 'interactive-p))))
(unless (fboundp 'prog-mode)
(defun prog-mode ()
(use-local-map (make-keymap))))
;;;###autoload ;;;###autoload
(defun erlang-mode () (define-derived-mode erlang-mode prog-mode "Erlang"
"Major mode for editing Erlang source files in Emacs. "Major mode for editing Erlang source files in Emacs.
It knows about syntax and comment, it can indent code, it is capable It knows about syntax and comment, it can indent code, it is capable
of fontifying the source file, the TAGS commands are aware of Erlang of fontifying the source file, the TAGS commands are aware of Erlang
@ -1403,12 +1423,9 @@ and examples of hooks.
Other commands: Other commands:
\\{erlang-mode-map}" \\{erlang-mode-map}"
(interactive) ;; Use our own syntax table function
(kill-all-local-variables) :syntax-table nil
(setq major-mode 'erlang-mode)
(setq mode-name "Erlang")
(erlang-syntax-table-init) (erlang-syntax-table-init)
(use-local-map erlang-mode-map)
(erlang-electric-init) (erlang-electric-init)
(erlang-menu-init) (erlang-menu-init)
(erlang-mode-variables) (erlang-mode-variables)
@ -1417,13 +1434,13 @@ Other commands:
(erlang-tags-init) (erlang-tags-init)
(erlang-font-lock-init) (erlang-font-lock-init)
(erlang-skel-init) (erlang-skel-init)
(tempo-use-tag-list 'erlang-tempo-tags) (when (fboundp 'tempo-use-tag-list)
(tempo-use-tag-list 'erlang-tempo-tags))
(when (boundp 'xref-backend-functions)
(add-hook 'xref-backend-functions #'erlang-etags--xref-backend nil t))
(run-hooks 'erlang-mode-hook) (run-hooks 'erlang-mode-hook)
(if (zerop (buffer-size)) (if (zerop (buffer-size))
(run-hooks 'erlang-new-file-hook)) (run-hooks 'erlang-new-file-hook)))
;; Doesn't exist in Emacs v21.4; required by Emacs v23.
(if (boundp 'after-change-major-mode-hook)
(run-hooks 'after-change-major-mode-hook)))
;;;###autoload ;;;###autoload
(dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript" (dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript"
@ -1531,7 +1548,9 @@ Other commands:
(set (make-local-variable 'outline-regexp) "[[:lower:]0-9_]+ *(.*) *-> *$") (set (make-local-variable 'outline-regexp) "[[:lower:]0-9_]+ *(.*) *-> *$")
(set (make-local-variable 'outline-level) (lambda () 1)) (set (make-local-variable 'outline-level) (lambda () 1))
(set (make-local-variable 'add-log-current-defun-function) (set (make-local-variable 'add-log-current-defun-function)
'erlang-current-defun)) 'erlang-current-defun)
(set (make-local-variable 'find-tag-default-function)
'erlang-find-tag-for-completion))
(defun erlang-font-lock-init () (defun erlang-font-lock-init ()
"Initialize Font Lock for Erlang mode." "Initialize Font Lock for Erlang mode."
@ -1542,7 +1561,9 @@ Other commands:
table))) table)))
(set (make-local-variable 'font-lock-syntax-table) (set (make-local-variable 'font-lock-syntax-table)
erlang-font-lock-syntax-table) erlang-font-lock-syntax-table)
(set (make-local-variable 'font-lock-beginning-of-syntax-function) (set (make-local-variable (if (boundp 'syntax-begin-function)
'syntax-begin-function
'font-lock-beginning-of-syntax-function))
'erlang-beginning-of-clause) 'erlang-beginning-of-clause)
(make-local-variable 'font-lock-keywords) (make-local-variable 'font-lock-keywords)
(let ((level (cond ((boundp 'font-lock-maximum-decoration) (let ((level (cond ((boundp 'font-lock-maximum-decoration)
@ -2250,6 +2271,7 @@ mode with the command `M-x erlang-mode RET'.")))
;; This code is based on the package `tempo' which is part of modern ;; This code is based on the package `tempo' which is part of modern
;; Emacsen. (GNU Emacs 19.25 (?) and XEmacs 19.14.) ;; Emacsen. (GNU Emacs 19.25 (?) and XEmacs 19.14.)
(defvar erlang-skel)
(defun erlang-skel-init () (defun erlang-skel-init ()
"Generate the skeleton functions and menu items. "Generate the skeleton functions and menu items.
The variable `erlang-skel' contains the name and descriptions of The variable `erlang-skel' contains the name and descriptions of
@ -2976,8 +2998,9 @@ Return nil if inside string, t if in a comment."
(current-column))) (current-column)))
;; Type and Spec indentation ;; Type and Spec indentation
((eq (car stack-top) '::) ((eq (car stack-top) '::)
(if (looking-at "}") (if (looking-at "[},)]")
;; Closing record definition with types ;; Closing function spec, record definition with types,
;; or a comma at the start of the line
;; pop stack and recurse ;; pop stack and recurse
(erlang-calculate-stack-indent indent-point (erlang-calculate-stack-indent indent-point
(cons (erlang-pop stack) (cdr state))) (cons (erlang-pop stack) (cdr state)))
@ -3748,6 +3771,12 @@ In the future the list may contain more elements."
(if (assoc fk (cdr (car imports))) (if (assoc fk (cdr (car imports)))
(setq mod (car (car imports))) (setq mod (car (car imports)))
(setq imports (cdr imports)))) (setq imports (cdr imports))))
(cond ((eq (preceding-char) ?#)
(setq fk (concat "-record(" fk)))
((eq (preceding-char) ??)
(setq fk (concat "-define(" fk)))
((and (null mod) (not (member fk erlang-int-bifs)))
(setq mod (erlang-get-module))))
(setq res (list mod fk))))) (setq res (list mod fk)))))
(store-match-data md) (store-match-data md)
res))) res)))
@ -3818,20 +3847,19 @@ exported function."
(defun erlang-check-module-name-init () (defun erlang-check-module-name-init ()
"Initialize the functionality to compare file and module names. "Initialize the functionality to compare file and module names.
Unless we have `before-save-hook', we redefine the function Unless we have `before-save-hook', we advice the function
`set-visited-file-name' since it clears the variable `set-visited-file-name' since it clears the variable
`local-write-file-hooks'. The original function definition is `local-write-file-hooks'."
stored in `erlang-orig-set-visited-file-name'."
(if (boundp 'before-save-hook) (if (boundp 'before-save-hook)
;; If we have that, `make-local-hook' is obsolete.
(add-hook 'before-save-hook 'erlang-check-module-name nil t) (add-hook 'before-save-hook 'erlang-check-module-name nil t)
(require 'advice) (require 'advice)
(unless (ad-advised-definition-p 'set-visited-file-name) (when (fboundp 'ad-advised-definition-p)
(defadvice set-visited-file-name (after erlang-set-visited-file-name (unless (ad-advised-definition-p 'set-visited-file-name)
activate) (defadvice set-visited-file-name (after erlang-set-visited-file-name
(if (eq major-mode 'erlang-mode) activate)
(add-hook 'local-write-file-hooks 'erlang-check-module-name)))) (if (eq major-mode 'erlang-mode)
(add-hook 'local-write-file-hooks 'erlang-check-module-name))) (add-hook 'local-write-file-hooks 'erlang-check-module-name))))
(add-hook 'local-write-file-hooks 'erlang-check-module-name))))
(defun erlang-check-module-name () (defun erlang-check-module-name ()
@ -3908,7 +3936,7 @@ non-whitespace characters following the point on the current line."
(newline) (newline)
(if (condition-case nil (if (condition-case nil
(progn (erlang-indent-line) t) (progn (erlang-indent-line) t)
(error (if (bolp) (delete-backward-char 1)))) (error (if (bolp) (delete-char -1))))
(if (not (bolp)) (if (not (bolp))
(save-excursion (save-excursion
(insert " ->")) (insert " ->"))
@ -3920,7 +3948,7 @@ non-whitespace characters following the point on the current line."
(beginning-of-line) (beginning-of-line)
(newline (newline
erlang-electric-semicolon-insert-blank-lines)))) erlang-electric-semicolon-insert-blank-lines))))
(error (if (bolp) (delete-backward-char 1)))))))) (error (if (bolp) (delete-char -1))))))))
(defun erlang-electric-comma (&optional arg) (defun erlang-electric-comma (&optional arg)
@ -3950,7 +3978,7 @@ non-whitespace characters following the point on the current line."
(newline) (newline)
(condition-case nil (condition-case nil
(erlang-indent-line) (erlang-indent-line)
(error (if (bolp) (delete-backward-char 1)))))) (error (if (bolp) (delete-char -1))))))
(defun erlang-electric-lt (&optional arg) (defun erlang-electric-lt (&optional arg)
"Insert a less-than sign, and optionally mark it as an open paren." "Insert a less-than sign, and optionally mark it as an open paren."
@ -4036,7 +4064,7 @@ non-whitespace characters following the point on the current line."
(newline) (newline)
(condition-case nil (condition-case nil
(erlang-indent-line) (erlang-indent-line)
(error (if (bolp) (delete-backward-char 1)))))) (error (if (bolp) (delete-char -1))))))
;; Then it's just a plain greater-than. ;; Then it's just a plain greater-than.
(t (t
@ -4076,7 +4104,7 @@ After being split/merged into `erlang-after-arrow' and
(newline) (newline)
(condition-case nil (condition-case nil
(erlang-indent-line) (erlang-indent-line)
(error (if (bolp) (delete-backward-char 1))))))) (error (if (bolp) (delete-char -1)))))))
(defun erlang-electric-newline (&optional arg) (defun erlang-electric-newline (&optional arg)
@ -4341,12 +4369,12 @@ works under XEmacs.)"
(require 'etags) (require 'etags)
;; Test on a function available in the Emacs 19 version ;; Test on a function available in the Emacs 19 version
;; of tags but not in the XEmacs version. ;; of tags but not in the XEmacs version.
(if (not (fboundp 'find-tag-noselect)) (when (fboundp 'find-tag-noselect)
()
(erlang-tags-define-keys (current-local-map)) (erlang-tags-define-keys (current-local-map))
(setq erlang-tags-installed t))))) (setq erlang-tags-installed t)))))
;; Set all keys bound to `find-tag' et.al. in the global map and the ;; Set all keys bound to `find-tag' et.al. in the global map and the
;; menu to `erlang-find-tag' et.al. in `map'. ;; menu to `erlang-find-tag' et.al. in `map'.
;; ;;
@ -4369,10 +4397,6 @@ works under XEmacs.)"
(erlang-menu-init)) (erlang-menu-init))
;; There exists a variable `find-tag-default-function'. It is not used
;; since `complete-tag' uses it to get current word under point. In that
;; situation we don't want the module to be prepended.
(defun erlang-find-tag-default () (defun erlang-find-tag-default ()
"Return the default tag. "Return the default tag.
Search `-import' list of imported functions. Search `-import' list of imported functions.
@ -4552,6 +4576,11 @@ Tags can be given on the forms `tag', `module:', `module:tag'."
(current-buffer))) ; Return the new buffer. (current-buffer))) ; Return the new buffer.
;; Process interactive arguments for erlang-find-tag-*. ;; Process interactive arguments for erlang-find-tag-*.
;; ;;
;; Negative arguments work only for `etags', not `tags'. This is not ;; Negative arguments work only for `etags', not `tags'. This is not
@ -4645,9 +4674,25 @@ Tags can be given on the forms `tag', `module:', `module:tag'."
(set (make-local-variable 'find-tag-regexp-search-function) (set (make-local-variable 'find-tag-regexp-search-function)
'erlang-tags-regexp-search-forward) 'erlang-tags-regexp-search-forward)
(set (make-local-variable 'find-tag-tag-order) (set (make-local-variable 'find-tag-tag-order)
'(erlang-tag-match-module-p)) (mapcar #'erlang-make-order-function-aware-of-modules
erlang-tags-orig-tag-order))
(set (make-local-variable 'find-tag-regexp-tag-order) (set (make-local-variable 'find-tag-regexp-tag-order)
'(erlang-tag-match-module-regexp-p)))) (mapcar #'erlang-make-order-function-aware-of-modules
erlang-tags-orig-regexp-tag-order))))
(defun erlang-make-order-function-aware-of-modules (f)
`(lambda (tag)
(let (mod)
(when (string-match ":" tag)
(setq mod (substring tag 0 (match-beginning 0)))
(setq tag (substring tag (match-end 0) nil)))
(and (funcall ',f tag)
(or (null mod)
(erlang-tag-at-point-match-module-p mod))))))
(defun erlang-tag-at-point-match-module-p (mod)
(string-equal mod (erlang-get-module-from-file-name
(funcall (symbol-function 'file-of-tag)))))
(defun erlang-tags-remove-module-check () (defun erlang-tags-remove-module-check ()
@ -4724,61 +4769,34 @@ for a tag on the form `module:tag'."
(funcall erlang-tags-orig-regexp-search-function (funcall erlang-tags-orig-regexp-search-function
tag bound noerror count))) tag bound noerror count)))
;; t if point is at a tag line that matches TAG, containing
;; module information. Assumes that all other order functions
;; are stored in `erlang-tags-orig-[regex]-tag-order'.
(defun erlang-tag-match-module-p (tag)
(erlang-tag-match-module-common-p tag erlang-tags-orig-tag-order))
(defun erlang-tag-match-module-regexp-p (tag)
(erlang-tag-match-module-common-p tag erlang-tags-orig-regexp-tag-order))
(defun erlang-tag-match-module-common-p (tag order)
(let ((mod nil)
(found nil))
(if (string-match ":" tag)
(progn
(setq mod (substring tag 0 (match-beginning 0)))
(setq tag (substring tag (match-end 0) nil))))
(while (and order (not found))
(setq found
(and (not (memq (car order)
'(erlang-tag-match-module-p
erlang-tag-match-module-regexp-p)))
(funcall (car order) tag)))
(setq order (cdr order)))
(and found
(or (null mod)
(string= mod (erlang-get-module-from-file-name
(file-of-tag)))))))
;;; Tags completion, Emacs 19 `etags' specific. ;;; Tags completion, Emacs 19 `etags' specific.
;;; ;;;
;;; The basic idea is to create a second completion table `erlang-tags- ;;; The basic idea is to create a second completion table `erlang-tags-
;;; completion-table' containing all normal tags plus tags on the form ;;; completion-table' containing all normal tags plus tags on the form
;;; `module:tag'. ;;; `module:tag' and `module:'.
;; PENDING - Should probably make use of the
(when (and (fboundp 'etags-tags-completion-table) ;; `completion-at-point-functions' hook instead of this advice.
(when (and (locate-library "etags")
(require 'etags)
(fboundp 'etags-tags-completion-table)
(fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+ (fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+
(if (fboundp 'advice-add) (if (fboundp 'advice-add)
;; Emacs 24.4+ ;; Emacs 24.4+
(advice-add 'etags-tags-completion-table :around (advice-add 'etags-tags-completion-table :around
(lambda (oldfun) (lambda (oldfun)
(if (eq find-tag-default-function 'erlang-find-tag-for-completion) (if erlang-replace-etags-tags-completion-table
(erlang-etags-tags-completion-table) (erlang-etags-tags-completion-table)
(funcall oldfun))) (funcall oldfun)))
(list :name 'erlang-replace-tags-table)) (list :name 'erlang-replace-tags-table))
;; Emacs 23.1-24.3 ;; Emacs 23.1-24.3
(defadvice etags-tags-completion-table (around erlang-replace-tags-table activate) (defadvice etags-tags-completion-table (around
(if (eq find-tag-default-function 'erlang-find-tag-for-completion) erlang-replace-tags-table
activate)
(if erlang-replace-etags-tags-completion-table
(setq ad-return-value (erlang-etags-tags-completion-table)) (setq ad-return-value (erlang-etags-tags-completion-table))
ad-do-it)))) ad-do-it))))
(defun erlang-complete-tag () (defun erlang-complete-tag ()
"Perform tags completion on the text around point. "Perform tags completion on the text around point.
Completes to the set of names listed in the current tags table. Completes to the set of names listed in the current tags table.
@ -4792,23 +4810,19 @@ about Erlang modules."
(cond ((and erlang-tags-installed (cond ((and erlang-tags-installed
(fboundp 'etags-tags-completion-table) (fboundp 'etags-tags-completion-table)
(fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+ (fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+
;; This depends on the advice called erlang-replace-tags-table (let ((erlang-replace-etags-tags-completion-table t))
;; above. It is not enough to let-bind
;; tags-completion-table-function since that will not override
;; the buffer-local value in the TAGS buffer.
(let ((find-tag-default-function 'erlang-find-tag-for-completion))
(complete-tag))) (complete-tag)))
((and erlang-tags-installed ((and erlang-tags-installed
(fboundp 'complete-tag) (fboundp 'complete-tag)
(fboundp 'tags-complete-tag)) ; Emacs 19 (fboundp 'tags-complete-tag)) ; Emacs 19-22
(let ((orig-tags-complete-tag (symbol-function 'tags-complete-tag))) (let ((orig-tags-complete-tag (symbol-function 'tags-complete-tag)))
(fset 'tags-complete-tag (fset 'tags-complete-tag
(symbol-function 'erlang-tags-complete-tag)) (symbol-function 'erlang-tags-complete-tag))
(unwind-protect (unwind-protect
(funcall (symbol-function 'complete-tag)) (complete-tag)
(fset 'tags-complete-tag orig-tags-complete-tag)))) (fset 'tags-complete-tag orig-tags-complete-tag))))
((fboundp 'complete-tag) ; Emacs 19 ((fboundp 'complete-tag) ; Emacs 19
(funcall (symbol-function 'complete-tag))) (complete-tag))
((fboundp 'tag-complete-symbol) ; XEmacs ((fboundp 'tag-complete-symbol) ; XEmacs
(funcall (symbol-function 'tag-complete-symbol))) (funcall (symbol-function 'tag-complete-symbol)))
(t (t
@ -4823,19 +4837,22 @@ about Erlang modules."
(buffer-substring-no-properties start (point))))) (buffer-substring-no-properties start (point)))))
;; Based on `tags-complete-tag', but this one uses ;; Based on `tags-complete-tag', but this one uses
;; `erlang-tags-completion-table' instead of `tags-completion-table'. ;; `erlang-tags-completion-table' instead of `tags-completion-table'.
;; ;;
;; This is the entry-point called by system function `completing-read'. ;; This is the entry-point called by system function `completing-read'.
;;
;; Used for minibuffer completion in Emacs 19-24 and completion in
;; erlang buffers in Emacs 19-22.
(defun erlang-tags-complete-tag (string predicate what) (defun erlang-tags-complete-tag (string predicate what)
(save-excursion (with-current-buffer (window-buffer (minibuffer-selected-window))
;; If we need to ask for the tag table, allow that. (save-excursion
(let ((enable-recursive-minibuffers t)) ;; If we need to ask for the tag table, allow that.
(visit-tags-table-buffer)) (let ((enable-recursive-minibuffers t))
(visit-tags-table-buffer))
(if (eq what t) (if (eq what t)
(all-completions string (erlang-tags-completion-table) predicate) (all-completions string (erlang-tags-completion-table) predicate)
(try-completion string (erlang-tags-completion-table) predicate)))) (try-completion string (erlang-tags-completion-table) predicate)))))
;; `tags-completion-table' calls itself recursively, make it ;; `tags-completion-table' calls itself recursively, make it
@ -4853,7 +4870,6 @@ about Erlang modules."
(fset 'tags-completion-table (fset 'tags-completion-table
erlang-tags-orig-completion-table))) erlang-tags-orig-completion-table)))
(defun erlang-tags-completion-table-1 () (defun erlang-tags-completion-table-1 ()
(make-local-variable 'erlang-tags-completion-table) (make-local-variable 'erlang-tags-completion-table)
(or erlang-tags-completion-table (or erlang-tags-completion-table
@ -4864,59 +4880,190 @@ about Erlang modules."
(setq erlang-tags-completion-table tags-completion-table)))) (setq erlang-tags-completion-table tags-completion-table))))
;; Emacs 25 expects this function to return a list (and it is ok for
;; it to include duplicates). Older emacsen expects an obarray.
(defun erlang-etags-tags-completion-table ()
(if (>= emacs-major-version 25)
(erlang-etags-tags-completion-table-list)
(let ((obarray (make-vector 511 0)))
(dolist (tag (erlang-etags-tags-completion-table-list))
(intern tag obarray))
obarray)))
;; Based on `etags-tags-completion-table'. The difference is that we ;; Based on `etags-tags-completion-table'. The difference is that we
;; add three symbols to the vector, the tag, module: and module:tag. ;; add three strings to the list, the tag, module: and module:tag.
;; The module is extracted from the file name of a tag. (This one ;; The module is extracted from the file name of a tag. (This one
;; only works if we are looking at an `etags' file. However, this is ;; only works if we are looking at an `etags' file. However, this is
;; the only format supported by Emacs, so far.) ;; the only format supported by Emacs, so far.)
(defun erlang-etags-tags-completion-table () (defun erlang-etags-tags-completion-table-list ()
(let ((table (make-vector 511 0)) (let ((progress-reporter
(file nil) (make-progress-reporter
(progress-reporter (format "Making tags completion table for %s..." buffer-file-name)
(when (fboundp 'make-progress-reporter) (point-min) (point-max)))
(make-progress-reporter table module)
(format "Making erlang tags completion table for %s..." buffer-file-name)
(point-min) (point-max)))))
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
;; This monster regexp matches an etags tag line.
;; \1 is the string to match;
;; \2 is not interesting;
;; \3 is the guessed tag name; XXX guess should be better eg DEFUN
;; \4 is not interesting;
;; \5 is the explicitly-specified tag name.
;; \6 is the line to start searching at;
;; \7 is the char to start searching at.
(while (progn (while (progn
(while (and (while (and (eq (following-char) ?\f)
(eq (following-char) ?\f) (looking-at "\f\n\\([^,\n]*\\),.*\n"))
(looking-at "\f\n\\([^,\n]*\\),.*\n")) (let ((file (buffer-substring (match-beginning 1)
(setq file (buffer-substring (match-end 1))))
(match-beginning 1) (match-end 1))) (setq module (erlang-get-module-from-file-name file))
(goto-char (match-end 0))) (when module
(push (concat module ":") table)
(push (concat module ":module_info") table))
(forward-line 2)))
;; This regexp matches an explicit tag name or the
;; place where it would start.
(re-search-forward (re-search-forward
"\ "[\f\t\n\r()=,; ]?\177\\\(?:\\([^\n\001]+\\)\001\\)?"
^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\
\[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\
\\([0-9]+\\)?,\\([0-9]+\\)?\n"
nil t)) nil t))
(let ((tag (if (match-beginning 5) (let ((tag (if (match-beginning 1)
;; There is an explicit tag name. ;; There is an explicit tag name.
(buffer-substring (match-beginning 5) (match-end 5)) (buffer-substring (match-beginning 1) (match-end 1))
;; No explicit tag name. Best guess. ;; No explicit tag name. Backtrack a little,
(buffer-substring (match-beginning 3) (match-end 3)))) ;; and look for the implicit one.
(module (and file (goto-char (match-beginning 0))
(erlang-get-module-from-file-name file)))) (skip-chars-backward "^\f\t\n\r()=,; ")
(intern tag table) (buffer-substring (point) (match-beginning 0)))))
(forward-line 1)
(push tag table)
(when (stringp module) (when (stringp module)
(intern (concat module ":" tag) table) (push (concat module ":" tag) table))
;; Only the first ones will be stored in the table. (progress-reporter-update progress-reporter (point)))))
(intern (concat module ":") table)
(intern (concat module ":module_info") table))
(when progress-reporter
(progress-reporter-update progress-reporter (point))))))
table)) table))
;;; Xref backend erlang-etags
;; In GNU Emacs 25 xref was introduced. It is a framework for cross
;; referencing commands, in particular commands for finding
;; definitions. It does not replace etags. It rather resides on top
;; of it and provides user-friendly commands. The idea is that the
;; user commands should be the same regardless of what backend does
;; the actual finding of definitions.
;; The backend below is a wrapper around the built-in etags backend.
;; It adds awareness of the module:tag syntax in a similar way that is
;; done above for the old etags commands.
(defun erlang-etags--xref-backend () 'erlang-etags)
(defun erlang-soft-require (feature)
(when (locate-library (symbol-name feature))
(require feature)))
(and (erlang-soft-require 'xref)
(erlang-soft-require 'cl-generic)
;; The purpose of using eval here is to avoid compilation
;; warnings in emacsen without cl-defmethod.
(eval
'(progn
(cl-defmethod xref-backend-identifier-at-point
((_backend (eql erlang-etags)))
(erlang-find-tag-default))
(cl-defmethod xref-backend-definitions
((_backend (eql erlang-etags)) identifier)
(erlang-xref-find-definitions identifier))
(cl-defmethod xref-backend-apropos
((_backend (eql erlang-etags)) identifier)
(erlang-xref-find-definitions identifier t))
(cl-defmethod xref-backend-identifier-completion-table
((_backend (eql erlang-etags)))
(let ((erlang-replace-etags-tags-completion-table t))
(tags-completion-table))))))
(defun erlang-xref-find-definitions (identifier &optional is-regexp)
(let ((id-list (split-string identifier ":")))
(cond
;; Handle "tag"
((null (cdr id-list))
(erlang-xref-find-definitions-tag identifier is-regexp))
;; Handle "module:"
((string-equal (cadr id-list) "")
(erlang-xref-find-definitions-module (car id-list)))
;; Handle "module:tag"
(t
(erlang-xref-find-definitions-module-tag (car id-list)
(cadr id-list)
is-regexp)))))
(defun erlang-xref-find-definitions-tag (tag is-regexp)
"Find all definitions of TAG and reorder them so that
definitions in the currently visited file comes first."
(when (fboundp 'etags--xref-find-definitions)
(let* ((current-file (and (buffer-file-name)
(file-truename (buffer-file-name))))
(xrefs (etags--xref-find-definitions tag is-regexp))
local-xrefs non-local-xrefs)
(while xrefs
(if (string-equal (erlang-xref-truename-file (car xrefs))
current-file)
(push (car xrefs) local-xrefs)
(push (car xrefs) non-local-xrefs))
(setq xrefs (cdr xrefs)))
(append (reverse local-xrefs)
(reverse non-local-xrefs)))))
(defun erlang-xref-find-definitions-module (module)
(and (fboundp 'xref-make)
(fboundp 'xref-make-file-location)
(let* ((first-time t)
xrefs matching-files)
(save-excursion
(while (visit-tags-table-buffer (not first-time))
(setq first-time nil)
(let ((files (tags-table-files)))
(while files
(let* ((file (car files))
(m (erlang-get-module-from-file-name file)))
(when (and m (string-equal m module))
(unless (member file matching-files)
(push file
matching-files)
(push (xref-make file
(xref-make-file-location file 1 0))
xrefs))))
(setq files (cdr files))))))
(nreverse xrefs))))
(defun erlang-xref-find-definitions-module-tag (module tag is-regexp)
"Find all definitions of TAG and filter away definitions
outside of MODULE."
(when (fboundp 'etags--xref-find-definitions)
(let ((xrefs (etags--xref-find-definitions tag is-regexp))
xrefs-in-module)
(while xrefs
(when (string-equal module (erlang-xref-module (car xrefs)))
(push (car xrefs) xrefs-in-module))
(setq xrefs (cdr xrefs)))
xrefs-in-module)))
(defun erlang-xref-module (xref)
(erlang-get-module-from-file-name (erlang-xref-file xref)))
(defun erlang-xref-truename-file (xref)
(let ((file (erlang-xref-file xref)))
(and file
(file-truename file))))
(defun erlang-xref-file (xref)
(and (fboundp 'xref-location-group)
(fboundp 'xref-item-location)
(xref-location-group (xref-item-location xref))))
;;; ;;;
;;; Prepare for other methods to run an Erlang slave process. ;;; Prepare for other methods to run an Erlang slave process.
;;; ;;;
@ -5315,8 +5462,7 @@ frame will become deselected before the next command."
() ()
(or (inferior-erlang-running-p) (or (inferior-erlang-running-p)
(error "No inferior Erlang shell is running")) (error "No inferior Erlang shell is running"))
(save-excursion (with-current-buffer inferior-erlang-buffer
(set-buffer inferior-erlang-buffer)
(let ((msg nil)) (let ((msg nil))
(while (save-excursion (while (save-excursion
(goto-char (process-mark inferior-erlang-process)) (goto-char (process-mark inferior-erlang-process))
@ -5336,8 +5482,7 @@ frame will become deselected before the next command."
The empty command resembles hitting RET. This is useful in some The empty command resembles hitting RET. This is useful in some
situations, for instance if a crash or error report from sasl situations, for instance if a crash or error report from sasl
has been printed after the last prompt." has been printed after the last prompt."
(save-excursion (with-current-buffer inferior-erlang-buffer
(set-buffer inferior-erlang-buffer)
(if (> (point-max) 1) (if (> (point-max) 1)
;; make sure we get a prompt if buffer contains data ;; make sure we get a prompt if buffer contains data
(if (save-excursion (if (save-excursion
@ -5403,7 +5548,7 @@ Return the position after the newly inserted command."
(boundp 'comint-last-output-start)) (boundp 'comint-last-output-start))
(save-excursion (save-excursion
(goto-char (goto-char
(if (interactive-p) (if (erlang-interactive-p)
(symbol-value 'comint-last-input-end) (symbol-value 'comint-last-input-end)
(symbol-value 'comint-last-output-start))) (symbol-value 'comint-last-output-start)))
(while (progn (skip-chars-forward "^\C-h") (while (progn (skip-chars-forward "^\C-h")
@ -5422,7 +5567,7 @@ Return the position after the newly inserted command."
(let ((pmark (process-mark (get-buffer-process (current-buffer))))) (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
(save-excursion (save-excursion
(goto-char (goto-char
(if (interactive-p) (if (erlang-interactive-p)
(symbol-value 'comint-last-input-end) (symbol-value 'comint-last-input-end)
(symbol-value 'comint-last-output-start))) (symbol-value 'comint-last-output-start)))
(while (re-search-forward "\r+$" pmark t) (while (re-search-forward "\r+$" pmark t)
@ -5449,23 +5594,21 @@ There exists two workarounds for this bug:
(save-some-buffers) (save-some-buffers)
(inferior-erlang-prepare-for-input) (inferior-erlang-prepare-for-input)
(let* ((dir (inferior-erlang-compile-outdir)) (let* ((dir (inferior-erlang-compile-outdir))
;;; (file (file-name-nondirectory (buffer-file-name)))
(noext (substring (erlang-local-buffer-file-name) 0 -4)) (noext (substring (erlang-local-buffer-file-name) 0 -4))
(opts (append (list (cons 'outdir dir)) (opts (append (list (cons 'outdir dir))
(if current-prefix-arg (if current-prefix-arg
(list 'debug_info 'export_all)) (list 'debug_info 'export_all))
erlang-compile-extra-opts)) erlang-compile-extra-opts))
end) end)
(save-excursion (with-current-buffer inferior-erlang-buffer
(set-buffer inferior-erlang-buffer) (when (fboundp 'compilation-forget-errors)
(compilation-forget-errors)) (compilation-forget-errors)))
(setq end (inferior-erlang-send-command (setq end (inferior-erlang-send-command
(inferior-erlang-compute-compile-command noext opts) (inferior-erlang-compute-compile-command noext opts)
nil)) nil))
(sit-for 0) (sit-for 0)
(inferior-erlang-wait-prompt) (inferior-erlang-wait-prompt)
(save-excursion (with-current-buffer inferior-erlang-buffer
(set-buffer inferior-erlang-buffer)
(setq compilation-error-list nil) (setq compilation-error-list nil)
(set-marker compilation-parsing-end end)) (set-marker compilation-parsing-end end))
(setq compilation-last-buffer inferior-erlang-buffer))) (setq compilation-last-buffer inferior-erlang-buffer)))
@ -5505,7 +5648,8 @@ unless the optional NO-DISPLAY is non-nil."
(let ((ccfn erlang-compile-command-function-alist) (let ((ccfn erlang-compile-command-function-alist)
(res (inferior-erlang-compute-erl-compile-command module-name opts)) (res (inferior-erlang-compute-erl-compile-command module-name opts))
ccfn-entry ccfn-entry
done) done
result)
(if (not (null (erlang-local-buffer-file-name))) (if (not (null (erlang-local-buffer-file-name)))
(while (and (not done) (not (null ccfn))) (while (and (not done) (not (null ccfn)))
(setq ccfn-entry (car ccfn)) (setq ccfn-entry (car ccfn))
@ -5635,12 +5779,14 @@ unless the optional NO-DISPLAY is non-nil."
(tramp-tramp-file-p (buffer-file-name)))) (tramp-tramp-file-p (buffer-file-name))))
(defun erlang-tramp-get-localname () (defun erlang-tramp-get-localname ()
(let ((tramp-info (tramp-dissect-file-name (buffer-file-name)))) (when (fboundp 'tramp-dissect-file-name)
(if (fboundp 'tramp-file-name-localname) (let ((tramp-info (tramp-dissect-file-name (buffer-file-name))))
(tramp-file-name-localname tramp-info) (if (fboundp 'tramp-file-name-localname)
;; In old versions of tramp, it was `tramp-file-name-path' (tramp-file-name-localname tramp-info)
;; instead of the newer `tramp-file-name-localname' ;; In old versions of tramp, it was `tramp-file-name-path'
(tramp-file-name-path tramp-info)))) ;; instead of the newer `tramp-file-name-localname'
(when (fboundp 'tramp-file-name-path)
(tramp-file-name-path tramp-info))))))
;; `next-error' only accepts buffers with major mode `compilation-mode' ;; `next-error' only accepts buffers with major mode `compilation-mode'
;; or with the minor mode `compilation-minor-mode' activated. ;; or with the minor mode `compilation-minor-mode' activated.
@ -5657,16 +5803,14 @@ Capable of finding error messages in an inferior Erlang buffer."
(and (boundp 'compilation-last-buffer) (and (boundp 'compilation-last-buffer)
compilation-last-buffer)))) compilation-last-buffer))))
(if (and (bufferp buf) (if (and (bufferp buf)
(save-excursion (with-current-buffer buf
(set-buffer buf)
(and (eq major-mode 'erlang-shell-mode) (and (eq major-mode 'erlang-shell-mode)
(setq major-mode 'compilation-mode)))) (setq major-mode 'compilation-mode))))
(unwind-protect (unwind-protect
(progn (progn
(setq done t) (setq done t)
(next-error argp)) (next-error argp))
(save-excursion (with-current-buffer buf
(set-buffer buf)
(setq major-mode 'erlang-shell-mode)))) (setq major-mode 'erlang-shell-mode))))
(or done (or done
(next-error argp)))) (next-error argp))))
@ -5769,7 +5913,7 @@ Simplified version of a combination `defalias' and `make-obsolete',
it assumes that NEWDEF is loaded." it assumes that NEWDEF is loaded."
(defalias sym (symbol-function newdef)) (defalias sym (symbol-function newdef))
(if (fboundp 'make-obsolete) (if (fboundp 'make-obsolete)
(make-obsolete sym newdef))) (make-obsolete sym newdef "long ago")))
(erlang-obsolete 'calculate-erlang-indent 'erlang-calculate-indent) (erlang-obsolete 'calculate-erlang-indent 'erlang-calculate-indent)
@ -5787,11 +5931,8 @@ it assumes that NEWDEF is loaded."
(erlang-obsolete 'name-of-erlang-function 'erlang-name-of-function) (erlang-obsolete 'name-of-erlang-function 'erlang-name-of-function)
;; Fixme: shouldn't redefine `set-visited-file-name' anyhow -- see above.
(defconst erlang-unload-hook (defconst erlang-unload-hook
(list (lambda () (list (lambda ()
(defalias 'set-visited-file-name
'erlang-orig-set-visited-file-name)
(when (featurep 'advice) (when (featurep 'advice)
(ad-unadvise 'Man-notify-when-ready) (ad-unadvise 'Man-notify-when-ready)
(ad-unadvise 'set-visited-file-name))))) (ad-unadvise 'set-visited-file-name)))))

View File

@ -3,7 +3,7 @@
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "ggtags" "ggtags.el" (22297 20828 347968 373000)) ;;;### (autoloads nil "ggtags" "ggtags.el" (22387 29370 530154 256000))
;;; Generated autoloads from ggtags.el ;;; Generated autoloads from ggtags.el
(autoload 'ggtags-find-project "ggtags" "\ (autoload 'ggtags-find-project "ggtags" "\

View File

@ -1 +1 @@
(define-package "ggtags" "20151214.1344" "emacs frontend to GNU Global source code tagging system" '((emacs "24") (cl-lib "0.5")) :url "https://github.com/leoliu/ggtags" :keywords '("tools" "convenience")) (define-package "ggtags" "20160617.1840" "emacs frontend to GNU Global source code tagging system" '((emacs "24") (cl-lib "0.5")) :url "https://github.com/leoliu/ggtags" :keywords '("tools" "convenience"))

View File

@ -1,10 +1,10 @@
;;; ggtags.el --- emacs frontend to GNU Global source code tagging system -*- lexical-binding: t; -*- ;;; ggtags.el --- emacs frontend to GNU Global source code tagging system -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2015 Free Software Foundation, Inc. ;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
;; Author: Leo Liu <sdl.web@gmail.com> ;; Author: Leo Liu <sdl.web@gmail.com>
;; Version: 0.8.11 ;; Version: 0.8.12
;; Package-Version: 20151214.1344 ;; Package-Version: 20160617.1840
;; Keywords: tools, convenience ;; Keywords: tools, convenience
;; Created: 2013-01-29 ;; Created: 2013-01-29
;; URL: https://github.com/leoliu/ggtags ;; URL: https://github.com/leoliu/ggtags
@ -1942,7 +1942,12 @@ ggtags: history match invalid, jump to first match instead")
"Ligher for `ggtags-navigation-mode'; set to nil to disable it.") "Ligher for `ggtags-navigation-mode'; set to nil to disable it.")
(define-minor-mode ggtags-navigation-mode nil (define-minor-mode ggtags-navigation-mode nil
:lighter ggtags-navigation-mode-lighter ;; If `ggtags-enable-navigation-keys' is set to nil only display the
;; lighter in `ggtags-mode' buffers.
;; See https://github.com/leoliu/ggtags/issues/124
:lighter (:eval (and (or ggtags-enable-navigation-keys
ggtags-mode)
ggtags-navigation-mode-lighter))
:global t :global t
(if ggtags-navigation-mode (if ggtags-navigation-mode
(progn (progn

View File

@ -66,7 +66,7 @@
(defmethod logito-log ((api gh-api) level tag string &rest objects) (defmethod logito-log ((api gh-api) level tag string &rest objects)
(apply 'logito-log (oref api :log) level tag string objects)) (apply 'logito-log (oref api :log) level tag string objects))
(defmethod constructor :static ((api gh-api) &rest args) (defmethod initialize-instance ((api gh-api) &rest args)
(call-next-method)) (call-next-method))
(defmethod gh-api-set-default-auth ((api gh-api) auth) (defmethod gh-api-set-default-auth ((api gh-api) auth)
@ -107,15 +107,14 @@
(const :tag "OAuth" gh-oauth-authenticator)) (const :tag "OAuth" gh-oauth-authenticator))
:group 'gh-api) :group 'gh-api)
(defmethod constructor :static ((api gh-api-v3) &rest args) (defmethod initialize-instance ((api gh-api-v3) &rest args)
(let ((obj (call-next-method)) (call-next-method)
(gh-profile-current-profile (gh-profile-current-profile))) (let ((gh-profile-current-profile (gh-profile-current-profile)))
(oset obj :profile (gh-profile-current-profile)) (oset api :profile (gh-profile-current-profile))
(oset obj :base (gh-profile-url)) (oset api :base (gh-profile-url))
(gh-api-set-default-auth obj (gh-api-set-default-auth api
(or (oref obj :auth) (or (oref api :auth)
(funcall gh-api-v3-authenticator "auth"))) (funcall gh-api-v3-authenticator "auth")))))
obj))
(defclass gh-api-request (gh-url-request) (defclass gh-api-request (gh-url-request)
((default-response-cls :allocation :class :initform gh-api-response))) ((default-response-cls :allocation :class :initform gh-api-response)))
@ -136,7 +135,8 @@
(call-next-method resp (gh-api-json-decode data))) (call-next-method resp (gh-api-json-decode data)))
(defclass gh-api-paged-request (gh-api-request) (defclass gh-api-paged-request (gh-api-request)
((default-response-cls :allocation :class :initform gh-api-paged-response))) ((default-response-cls :allocation :class :initform gh-api-paged-response)
(page-limit :initarg :page-limit :initform -1)))
(defclass gh-api-paged-response (gh-api-response) (defclass gh-api-paged-response (gh-api-response)
()) ())
@ -155,13 +155,25 @@
(call-next-method) (call-next-method)
(oset resp :data (append previous-data (oref resp :data))) (oset resp :data (append previous-data (oref resp :data)))
(when (and next (not (equal 304 (oref resp :http-status)))) (when (and next (not (equal 304 (oref resp :http-status))))
(let ((req (oref resp :-req))) (let* ((req (oref resp :-req))
(oset resp :data-received nil) (last-page-limit (oref req :page-limit))
(oset req :url next) (this-page-limit (if (numberp last-page-limit) (- last-page-limit 1) -1)))
(gh-url-run-request req resp))))) (oset req :page-limit this-page-limit)
(unless (eq (oref req :page-limit) 0)
;; We use an explicit check for 0 since -1 indicates that
;; paging should continue forever.
(oset resp :data-received nil)
(oset req :url next)
;; Params need to be set to nil because the next uri will
;; already have query params. If params are non-nil this will
;; cause another set of params to be added to the end of the
;; string which will override the params that are set in the
;; next link.
(oset req :query nil)
(gh-url-run-request req resp))))))
(defmethod gh-api-authenticated-request (defmethod gh-api-authenticated-request
((api gh-api) transformer method resource &optional data params) ((api gh-api) transformer method resource &optional data params page-limit)
(let* ((fmt (oref api :data-format)) (let* ((fmt (oref api :data-format))
(headers (cond ((eq fmt :form) (headers (cond ((eq fmt :form)
'(("Content-Type" . '(("Content-Type" .
@ -200,10 +212,11 @@
(gh-api-json-encode data)) (gh-api-json-encode data))
(and (eq fmt :form) (and (eq fmt :form)
(gh-url-form-encode data)) (gh-url-form-encode data))
"")))))) "")
:page-limit page-limit)))))
(cond ((and has-value ;; got value from cache (cond ((and has-value ;; got value from cache
(not is-outdated)) (not is-outdated))
(gh-api-response "cached" :data-received t :data value)) (make-instance 'gh-api-response :data-received t :data value))
(cache-key ;; no value, but cache exists and method is safe (cache-key ;; no value, but cache exists and method is safe
(let ((resp (make-instance (oref req default-response-cls) (let ((resp (make-instance (oref req default-response-cls)
:transform transformer))) :transform transformer)))

View File

@ -95,11 +95,10 @@
((username :initarg :username :initform nil)) ((username :initarg :username :initform nil))
"Abstract authenticator") "Abstract authenticator")
(defmethod constructor :static ((auth gh-authenticator) &rest args) (defmethod initialize-instance ((auth gh-authenticator) &rest args)
(let ((obj (call-next-method))) (call-next-method)
(or (oref obj :username) (or (oref auth :username)
(oset obj :username (gh-auth-get-username))) (oset auth :username (gh-auth-get-username))))
obj))
(defmethod gh-auth-modify-request ((auth gh-authenticator) req) (defmethod gh-auth-modify-request ((auth gh-authenticator) req)
req) req)
@ -131,11 +130,10 @@
(2fa-cls :initform gh-auth-2fa-callback :allocation :class)) (2fa-cls :initform gh-auth-2fa-callback :allocation :class))
"Password-based authenticator") "Password-based authenticator")
(defmethod constructor :static ((auth gh-password-authenticator) &rest args) (defmethod initialize-instance ((auth gh-password-authenticator) &rest args)
(let ((obj (call-next-method))) (call-next-method)
(or (oref obj :password) (or (oref auth :password)
(oset obj :password (gh-auth-get-password (oref obj remember)))) (oset auth :password (gh-auth-get-password (oref auth remember)))))
obj))
(defmethod gh-auth-modify-request ((auth gh-password-authenticator) req) (defmethod gh-auth-modify-request ((auth gh-password-authenticator) req)
(object-add-to-list req :headers (object-add-to-list req :headers
@ -154,11 +152,10 @@
((token :initarg :token :protection :private :initform nil)) ((token :initarg :token :protection :private :initform nil))
"Oauth-based authenticator") "Oauth-based authenticator")
(defmethod constructor :static ((auth gh-oauth-authenticator) &rest args) (defmethod initialize-instance :static ((auth gh-oauth-authenticator) &rest args)
(let ((obj (call-next-method))) (call-next-method)
(or (oref obj :token) (or (oref auth :token)
(oset obj :token (gh-auth-get-oauth-token))) (oset auth :token (gh-auth-get-oauth-token))))
obj))
(defmethod gh-auth-modify-request ((auth gh-oauth-authenticator) req) (defmethod gh-auth-modify-request ((auth gh-oauth-authenticator) req)
(object-add-to-list req :headers (object-add-to-list req :headers

View File

@ -3,7 +3,7 @@
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "gh-api" "gh-api.el" (22221 60701 548000 0)) ;;;### (autoloads nil "gh-api" "gh-api.el" (22387 29369 466970 131000))
;;; Generated autoloads from gh-api.el ;;; Generated autoloads from gh-api.el
(require 'eieio) (require 'eieio)
@ -14,8 +14,8 @@
;;;*** ;;;***
;;;### (autoloads nil "gh-auth" "gh-auth.el" (22221 60701 635000 ;;;### (autoloads nil "gh-auth" "gh-auth.el" (22387 29369 526924
;;;;;; 0)) ;;;;;; 94000))
;;; Generated autoloads from gh-auth.el ;;; Generated autoloads from gh-auth.el
(require 'eieio) (require 'eieio)
@ -28,24 +28,24 @@
;;;*** ;;;***
;;;### (autoloads nil "gh-cache" "gh-cache.el" (22221 60701 606000 ;;;### (autoloads nil "gh-cache" "gh-cache.el" (22387 29369 498945
;;;;;; 0)) ;;;;;; 578000))
;;; Generated autoloads from gh-cache.el ;;; Generated autoloads from gh-cache.el
(require 'eieio) (require 'eieio)
;;;*** ;;;***
;;;### (autoloads nil "gh-common" "gh-common.el" (22221 60701 578000 ;;;### (autoloads nil "gh-common" "gh-common.el" (22387 29369 478960
;;;;;; 0)) ;;;;;; 924000))
;;; Generated autoloads from gh-common.el ;;; Generated autoloads from gh-common.el
(require 'eieio) (require 'eieio)
;;;*** ;;;***
;;;### (autoloads nil "gh-gist" "gh-gist.el" (22221 60701 536000 ;;;### (autoloads nil "gh-gist" "gh-gist.el" (22387 29369 442988
;;;;;; 0)) ;;;;;; 546000))
;;; Generated autoloads from gh-gist.el ;;; Generated autoloads from gh-gist.el
(require 'eieio) (require 'eieio)
@ -59,23 +59,23 @@
;;;*** ;;;***
;;;### (autoloads nil "gh-issue-comments" "gh-issue-comments.el" ;;;### (autoloads nil "gh-issue-comments" "gh-issue-comments.el"
;;;;;; (22221 60701 591000 0)) ;;;;;; (22387 29369 490951 716000))
;;; Generated autoloads from gh-issue-comments.el ;;; Generated autoloads from gh-issue-comments.el
(require 'eieio) (require 'eieio)
;;;*** ;;;***
;;;### (autoloads nil "gh-issues" "gh-issues.el" (22221 60701 615000 ;;;### (autoloads nil "gh-issues" "gh-issues.el" (22387 29369 502942
;;;;;; 0)) ;;;;;; 509000))
;;; Generated autoloads from gh-issues.el ;;; Generated autoloads from gh-issues.el
(require 'eieio) (require 'eieio)
;;;*** ;;;***
;;;### (autoloads nil "gh-oauth" "gh-oauth.el" (22221 60701 531000 ;;;### (autoloads nil "gh-oauth" "gh-oauth.el" (22387 29369 430997
;;;;;; 0)) ;;;;;; 753000))
;;; Generated autoloads from gh-oauth.el ;;; Generated autoloads from gh-oauth.el
(require 'eieio) (require 'eieio)
@ -84,8 +84,8 @@
;;;*** ;;;***
;;;### (autoloads nil "gh-orgs" "gh-orgs.el" (22221 60701 586000 ;;;### (autoloads nil "gh-orgs" "gh-orgs.el" (22387 29369 482957
;;;;;; 0)) ;;;;;; 854000))
;;; Generated autoloads from gh-orgs.el ;;; Generated autoloads from gh-orgs.el
(require 'eieio) (require 'eieio)
@ -96,16 +96,16 @@
;;;*** ;;;***
;;;### (autoloads nil "gh-pull-comments" "gh-pull-comments.el" (22221 ;;;### (autoloads nil "gh-pull-comments" "gh-pull-comments.el" (22387
;;;;;; 60701 627000 0)) ;;;;;; 29369 518930 232000))
;;; Generated autoloads from gh-pull-comments.el ;;; Generated autoloads from gh-pull-comments.el
(require 'eieio) (require 'eieio)
;;;*** ;;;***
;;;### (autoloads nil "gh-pulls" "gh-pulls.el" (22221 60701 621000 ;;;### (autoloads nil "gh-pulls" "gh-pulls.el" (22387 29369 506939
;;;;;; 0)) ;;;;;; 440000))
;;; Generated autoloads from gh-pulls.el ;;; Generated autoloads from gh-pulls.el
(require 'eieio) (require 'eieio)
@ -116,8 +116,8 @@
;;;*** ;;;***
;;;### (autoloads nil "gh-repos" "gh-repos.el" (22221 60701 598000 ;;;### (autoloads nil "gh-repos" "gh-repos.el" (22387 29369 494948
;;;;;; 0)) ;;;;;; 647000))
;;; Generated autoloads from gh-repos.el ;;; Generated autoloads from gh-repos.el
(require 'eieio) (require 'eieio)
@ -130,15 +130,15 @@
;;;*** ;;;***
;;;### (autoloads nil "gh-url" "gh-url.el" (22221 60701 497000 0)) ;;;### (autoloads nil "gh-url" "gh-url.el" (22387 29369 419006 961000))
;;; Generated autoloads from gh-url.el ;;; Generated autoloads from gh-url.el
(require 'eieio) (require 'eieio)
;;;*** ;;;***
;;;### (autoloads nil "gh-users" "gh-users.el" (22221 60701 569000 ;;;### (autoloads nil "gh-users" "gh-users.el" (22387 29369 474963
;;;;;; 0)) ;;;;;; 993000))
;;; Generated autoloads from gh-users.el ;;; Generated autoloads from gh-users.el
(require 'eieio) (require 'eieio)
@ -149,8 +149,8 @@
;;;*** ;;;***
;;;### (autoloads nil nil ("gh-pkg.el" "gh-profile.el" "gh.el") (22221 ;;;### (autoloads nil nil ("gh-pkg.el" "gh-profile.el" "gh-search.el"
;;;;;; 60701 645865 81000)) ;;;;;; "gh.el") (22387 29369 541412 67000))
;;;*** ;;;***

View File

@ -64,7 +64,7 @@
(with-slots (url html-url body user created-at updated-at) (with-slots (url html-url body user created-at updated-at)
comment comment
(setq url (gh-read data 'url) (setq url (gh-read data 'url)
html-url (gh-read data 'html-url) html-url (gh-read data 'html_url)
body (gh-read data 'body) body (gh-read data 'body)
user (gh-object-read (or (oref comment :user) user (gh-object-read (or (oref comment :user)
(oref comment user-cls)) (oref comment user-cls))

View File

@ -165,13 +165,13 @@
(gh-issues-milestone-req-to-update milestone))) (gh-issues-milestone-req-to-update milestone)))
(defmethod gh-issues-milestone-req-to-update ((milestone gh-issues-milestone)) (defmethod gh-issues-milestone-req-to-update ((milestone gh-issues-milestone))
(let ((state (oref milestone state) ) (let ((state (oref milestone :state))
(description (oref milestone description)) (description (oref milestone :description))
(due_on (oref milestone due_on)) (due-on (oref milestone :due-on))
(to-update `(("title" . ,(oref milestone title))))) (to-update `(("title" . ,(oref milestone :title)))))
(when state (nconc to-update `(("state" . ,state)))) (when state (nconc to-update `(("state" . ,state))))
(when description (nconc to-update `(("description" . ,description)))) (when description (nconc to-update `(("description" . ,description))))
(when due_on (nconc to-update `(("due_on" . ,due_on)))) (when due-on (nconc to-update `(("due_on" . ,due-on))))
to-update)) to-update))
(defmethod gh-issues-issue-get ((api gh-issues-api) user repo id) (defmethod gh-issues-issue-get ((api gh-issues-api) user repo id)
@ -180,18 +180,18 @@
(format "/repos/%s/%s/issues/%s" user repo id))) (format "/repos/%s/%s/issues/%s" user repo id)))
(defmethod gh-issues-issue-req-to-update ((req gh-issues-issue)) (defmethod gh-issues-issue-req-to-update ((req gh-issues-issue))
(let ((assignee (oref req assignee)) (let ((assignee (oref req :assignee))
;; (labels (oref req labels)) ;; (labels (oref req labels))
(milestone (oref req milestone)) (milestone (oref req :milestone))
(to-update `(("title" . ,(oref req title)) (to-update `(("title" . ,(oref req :title))
("state" . ,(oref req state)) ("state" . ,(oref req :state))
("body" . ,(oref req body))))) ("body" . ,(oref req :body)))))
;; (when labels (nconc to-update `(("labels" . ,(oref req labels) )))) ;; (when labels (nconc to-update `(("labels" . ,(oref req labels) ))))
(when milestone (when milestone
(nconc to-update `(("milestone" . ,(oref milestone number))))) (nconc to-update `(("milestone" . ,(oref milestone :number)))))
(when assignee (when assignee
(nconc to-update `(("assignee" . ,(oref assignee login) )))) (nconc to-update `(("assignee" . ,(oref assignee :login)))))
to-update)) to-update))
(defmethod gh-issues-issue-update ((api gh-issues-api) user repo id req) (defmethod gh-issues-issue-update ((api gh-issues-api) user repo id req)
@ -243,7 +243,7 @@
(defmethod gh-issues-label-update ((api gh-issues-api) user repo req) (defmethod gh-issues-label-update ((api gh-issues-api) user repo req)
(gh-api-authenticated-request (gh-api-authenticated-request
api (gh-object-reader (oref api label-cls)) "POST" api (gh-object-reader (oref api label-cls)) "POST"
(format "/repos/%s/%s/labels/%s" user repo (oref req name)) (format "/repos/%s/%s/labels/%s" user repo (oref req :name))
(gh-issues-label-req-to-update req))) (gh-issues-label-req-to-update req)))
(defmethod gh-issues-label-delete ((api gh-issues-api) user repo name) (defmethod gh-issues-label-delete ((api gh-issues-api) user repo name)
@ -286,17 +286,17 @@
(defun gh-issues--issue-id (issue-or-issue-id) (defun gh-issues--issue-id (issue-or-issue-id)
(if (eieio-object-p issue-or-issue-id) (if (eieio-object-p issue-or-issue-id)
(oref issue-or-issue-id id) (oref issue-or-issue-id :id)
issue-or-issue-id)) issue-or-issue-id))
(defun gh-issues--milestone-id (milestone-or-milestone-id) (defun gh-issues--milestone-id (milestone-or-milestone-id)
(if (eieio-object-p milestone-or-milestone-id) (if (eieio-object-p milestone-or-milestone-id)
(oref milestone-or-milestone-id id) (oref milestone-or-milestone-id :id)
milestone-or-milestone-id)) milestone-or-milestone-id))
(defun gh-issues--label-name (label-or-label-name) (defun gh-issues--label-name (label-or-label-name)
(if (eieio-object-p label-or-label-name) (if (eieio-object-p label-or-label-name)
(oref label-or-label-name name) (oref label-or-label-name :name)
label-or-label-name)) label-or-label-name))

View File

@ -44,7 +44,7 @@
(defclass gh-oauth-password-authenticator (gh-password-authenticator) (defclass gh-oauth-password-authenticator (gh-password-authenticator)
((remember :allocation :class :initform nil))) ((remember :allocation :class :initform nil)))
(defmethod constructor :static ((api gh-oauth-api) &rest args) (defmethod initialize-instance ((api gh-oauth-api) &rest args)
;; force password authentication for this API ;; force password authentication for this API
(let ((gh-api-v3-authenticator 'gh-oauth-password-authenticator)) (let ((gh-api-v3-authenticator 'gh-oauth-password-authenticator))
(call-next-method))) (call-next-method)))

View File

@ -1,4 +1,4 @@
(define-package "gh" "20160222.1811" "A GitHub library for Emacs" (define-package "gh" "20160626.1349" "A GitHub library for Emacs"
'((emacs "24.4") '((emacs "24.4")
(pcache "0.3.1") (pcache "0.3.1")
(logito "0.1"))) (logito "0.1")))

View File

@ -75,7 +75,7 @@
created-at updated-at) created-at updated-at)
comment comment
(setq url (gh-read data 'url) (setq url (gh-read data 'url)
html-url (gh-read data 'html-url) html-url (gh-read data 'html_url)
id (gh-read data 'id) id (gh-read data 'id)
body (gh-read data 'body) body (gh-read data 'body)
user (gh-object-read (or (oref comment :user) user (gh-object-read (or (oref comment :user)

View File

@ -70,13 +70,14 @@
(mirror-url :initarg :mirror-url) (mirror-url :initarg :mirror-url)
(owner :initarg :owner :initform nil) (owner :initarg :owner :initform nil)
(id :initarg :id) (id :initarg :id)
(full-name :initarg full-name) (full-name :initarg :full-name)
(language :initarg :language) (language :initarg :language)
(fork :initarg :fork) (fork :initarg :fork)
(forks :initarg :forks) (forks :initarg :forks)
(forks-count :initarg forks-count) (forks-count :initarg :forks-count)
(watchers :initarg :watchers) (watchers :initarg :watchers)
(watchers-count :initarg watchers-count) (watchers-count :initarg :watchers-count)
(stargazers-count :initarg :stargazers-count)
(size :initarg :size) (size :initarg :size)
(master-branch :initarg :master-branch) (master-branch :initarg :master-branch)
(open-issues :initarg :open-issues) (open-issues :initarg :open-issues)
@ -217,7 +218,7 @@
(defmethod gh-repos-repo-rename ((api gh-repos-api) repo-stub new-name (defmethod gh-repos-repo-rename ((api gh-repos-api) repo-stub new-name
&optional user) &optional user)
(let ((new-stub (gh-repos-repo-stub "repo" :name new-name))) (let ((new-stub (make-instance 'gh-repos-repo-stub :name new-name)))
(gh-api-authenticated-request (gh-api-authenticated-request
api (gh-object-reader (oref api repo-cls)) "PATCH" api (gh-object-reader (oref api repo-cls)) "PATCH"
(format "/repos/%s/%s" (format "/repos/%s/%s"
@ -269,7 +270,41 @@
(oref repo :name)))) (oref repo :name))))
;;; TODO gh-repos-repo-branch-commits ;;; TODO gh-repos-repo-branch-commits
;;; TODO Collaborators sub-API
;;; Collaborators sub-API
(defmethod gh-repos-collaborators-list ((api gh-repos-api) repo)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api user-cls)) "GET" (format "/repos/%s/%s/collaborators"
(oref (oref repo :owner) :login)
(oref repo :name))))
(defmethod gh-repos-collaborators-p ((api gh-repos-api) repo user)
(eq (oref (gh-api-authenticated-request
api nil "GET"
(format "/repos/%s/%s/collaborators/%s"
(oref (oref repo :owner) :login)
(oref repo :name)
user))
:http-status)
204))
(defmethod gh-repos-collaborators-add ((api gh-repos-api) repo user)
(gh-api-authenticated-request
api nil "PUT"
(format "/repos/%s/%s/collaborators/%s"
(oref (oref repo :owner) :login)
(oref repo :name)
user)))
(defmethod gh-repos-collaborators-delete ((api gh-repos-api) repo user)
(gh-api-authenticated-request
api nil "DELETE"
(format "/repos/%s/%s/collaborators/%s"
(oref (oref repo :owner) :login)
(oref repo :name)
user)))
;;; TODO Comments sub-API ;;; TODO Comments sub-API
;;; TODO Commits sub-API ;;; TODO Commits sub-API
;;; TODO Contents sub-API ;;; TODO Contents sub-API

View File

@ -0,0 +1,61 @@
;;; gh-search.el --- repository search for gh.el
;; Copyright (C) 2016 Ivan Malison
;; Author: Ivan Malison <IvanMalison@gmail.com>
;; 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:
;;
;;; Code:
(require 'gh-users)
(require 'gh-repos)
(defclass gh-search-api (gh-api-v3)
((repo-cls :allocation :class :initform gh-repos-repo)
(user-cls :allocation :class :initform gh-users-user)))
(defmacro gh-search-method-builder (method-name uri process-result-function)
`(defmethod ,method-name ((search-api gh-search-api)
query-string &optional page-limit
&rest additional-arguments)
(unless (and (stringp query-string) (> (length query-string) 1))
(error "a non-empty query string must be provided to github search"))
(gh-api-authenticated-request
search-api
(apply-partially (quote ,process-result-function) search-api)
"GET" ,uri nil
`((q . ,query-string) ,@additional-arguments) page-limit)))
(defmacro gh-search-process-method-builder (method-name class-symbol)
`(defmethod ,method-name ((search-api gh-search-api) data)
(unless (listp data)
(error "Did not recieve a list from the search query"))
(let ((items (assoc 'items data)))
(unless items
(error "Search query did not return items"))
(gh-object-list-read (oref search-api ,class-symbol) (cdr items)))))
(gh-search-process-method-builder gh-process-repo-search-result repo-cls)
(gh-search-process-method-builder gh-process-user-search-result user-cls)
(gh-search-method-builder gh-search-repos "/search/repositories"
gh-process-repo-search-result)
(gh-search-method-builder gh-search-users "/search/users"
gh-process-user-search-result)
(provide 'gh-search)
;;; gh-search.el ends here

View File

@ -141,8 +141,8 @@
(set-buffer-multibyte t) (set-buffer-multibyte t)
(destructuring-bind (req resp) req-resp (destructuring-bind (req resp) req-resp
(condition-case err (condition-case err
(progn (let ((responses-req (clone req)))
(oset resp :-req req) (oset resp :-req responses-req)
(gh-url-response-init resp (current-buffer))) (gh-url-response-init resp (current-buffer)))
(error (error
(let ((num (oref req :num-retries))) (let ((num (oref req :num-retries)))

View File

@ -3,8 +3,8 @@
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "git-commit" "git-commit.el" (22303 19285 486174 ;;;### (autoloads nil "git-commit" "git-commit.el" (22387 29368 875424
;;;;;; 926000)) ;;;;;; 490000))
;;; Generated autoloads from git-commit.el ;;; Generated autoloads from git-commit.el
(defvar global-git-commit-mode t "\ (defvar global-git-commit-mode t "\

View File

@ -1 +1 @@
(define-package "git-commit" "20160425.430" "Edit Git commit messages" '((emacs "24.4") (dash "20151021.113") (with-editor "20160408.201")) :url "https://github.com/magit/magit" :keywords '("git" "tools" "vc")) (define-package "git-commit" "20160519.950" "Edit Git commit messages" '((emacs "24.4") (dash "20151021.113") (with-editor "20160408.201")) :url "https://github.com/magit/magit" :keywords '("git" "tools" "vc"))

View File

@ -12,8 +12,8 @@
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> ;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Package-Requires: ((emacs "24.4") (dash "20151021.113") (with-editor "20160408.201")) ;; Package-Requires: ((emacs "24.4") (dash "20151021.113") (with-editor "20160408.201"))
;; Package-Version: 20160519.950
;; Keywords: git tools vc ;; Keywords: git tools vc
;; Package-Version: 20160425.430
;; Homepage: https://github.com/magit/magit ;; Homepage: https://github.com/magit/magit
;; This file is not part of GNU Emacs. ;; This file is not part of GNU Emacs.

View File

@ -3,8 +3,8 @@
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "git-gutter" "git-gutter.el" (22297 19829 459863 ;;;### (autoloads nil "git-gutter" "git-gutter.el" (22387 29368 367814
;;;;;; 402000)) ;;;;;; 765000))
;;; Generated autoloads from git-gutter.el ;;; Generated autoloads from git-gutter.el
(autoload 'git-gutter:linum-setup "git-gutter" "\ (autoload 'git-gutter:linum-setup "git-gutter" "\

View File

@ -1 +1 @@
(define-package "git-gutter" "20160409.713" "Port of Sublime Text plugin GitGutter" '((cl-lib "0.5") (emacs "24")) :url "https://github.com/syohex/emacs-git-gutter") (define-package "git-gutter" "20160610.852" "Port of Sublime Text plugin GitGutter" '((cl-lib "0.5") (emacs "24")) :url "https://github.com/syohex/emacs-git-gutter")

View File

@ -4,8 +4,8 @@
;; Author: Syohei YOSHIDA <syohex@gmail.com> ;; Author: Syohei YOSHIDA <syohex@gmail.com>
;; URL: https://github.com/syohex/emacs-git-gutter ;; URL: https://github.com/syohex/emacs-git-gutter
;; Package-Version: 20160409.713 ;; Package-Version: 20160610.852
;; Version: 0.87 ;; Version: 0.89
;; Package-Requires: ((cl-lib "0.5") (emacs "24")) ;; Package-Requires: ((cl-lib "0.5") (emacs "24"))
;; This program is free software; you can redistribute it and/or modify ;; This program is free software; you can redistribute it and/or modify
@ -170,6 +170,9 @@ gutter information of other windows."
"Ask whether commit/revert or not" "Ask whether commit/revert or not"
:type 'boolean) :type 'boolean)
(cl-defstruct git-gutter-hunk
type content start-line end-line)
(defvar git-gutter:enabled nil) (defvar git-gutter:enabled nil)
(defvar git-gutter:diffinfos nil) (defvar git-gutter:diffinfos nil)
(defvar git-gutter:has-indirect-buffers nil) (defvar git-gutter:has-indirect-buffers nil)
@ -204,8 +207,7 @@ gutter information of other windows."
(with-temp-buffer (with-temp-buffer
(when (zerop (git-gutter:execute-command "git" t "rev-parse" "--is-inside-work-tree")) (when (zerop (git-gutter:execute-command "git" t "rev-parse" "--is-inside-work-tree"))
(goto-char (point-min)) (goto-char (point-min))
(string= "true" (buffer-substring-no-properties (looking-at-p "true")))))
(point) (line-end-position)))))))
(defun git-gutter:in-repository-common-p (cmd check-subcmd repodir) (defun git-gutter:in-repository-common-p (cmd check-subcmd repodir)
(and (executable-find cmd) (and (executable-find cmd)
@ -230,9 +232,6 @@ gutter information of other windows."
1 1
(string-to-number str))) (string-to-number str)))
(defsubst git-gutter:make-diffinfo (type content start end)
(list :type type :content content :start-line start :end-line end))
(defsubst git-gutter:base-file () (defsubst git-gutter:base-file ()
(buffer-file-name (buffer-base-buffer))) (buffer-file-name (buffer-base-buffer)))
@ -265,7 +264,8 @@ gutter information of other windows."
collect collect
(let ((start (if (zerop new-line) 1 new-line)) (let ((start (if (zerop new-line) 1 new-line))
(end (if (zerop end-line) 1 end-line))) (end (if (zerop end-line) 1 end-line)))
(git-gutter:make-diffinfo type content start end)))))) (make-git-gutter-hunk
:type type :content content :start-line start :end-line end))))))
(defsubst git-gutter:window-margin () (defsubst git-gutter:window-margin ()
(or git-gutter:window-width (git-gutter:longest-sign-width))) (or git-gutter:window-width (git-gutter:longest-sign-width)))
@ -369,21 +369,15 @@ gutter information of other windows."
(let ((gutter-sep (concat sign (git-gutter:gutter-sperator)))) (let ((gutter-sep (concat sign (git-gutter:gutter-sperator))))
(propertize " " 'display `((margin left-margin) ,gutter-sep)))) (propertize " " 'display `((margin left-margin) ,gutter-sep))))
(defsubst git-gutter:select-face (type)
(cl-case type
(added 'git-gutter:added)
(modified 'git-gutter:modified)
(deleted 'git-gutter:deleted)))
(defsubst git-gutter:select-sign (type)
(cl-case type
(added git-gutter:added-sign)
(modified git-gutter:modified-sign)
(deleted git-gutter:deleted-sign)))
(defun git-gutter:propertized-sign (type) (defun git-gutter:propertized-sign (type)
(let ((sign (git-gutter:select-sign type)) (let (sign face)
(face (git-gutter:select-face type))) (cl-case type
(added (setq sign git-gutter:added-sign
face 'git-gutter:added))
(modified (setq sign git-gutter:modified-sign
face 'git-gutter:modified))
(deleted (setq sign git-gutter:deleted-sign
face 'git-gutter:deleted)))
(propertize sign 'face face))) (propertize sign 'face face)))
(defsubst git-gutter:linum-get-overlay (pos) (defsubst git-gutter:linum-get-overlay (pos)
@ -551,7 +545,7 @@ gutter information of other windows."
(git-gutter) (git-gutter)
(when (and (not git-gutter:update-timer) (> git-gutter:update-interval 0)) (when (and (not git-gutter:update-timer) (> git-gutter:update-interval 0))
(setq git-gutter:update-timer (setq git-gutter:update-timer
(run-with-idle-timer 1 git-gutter:update-interval 'git-gutter:live-update)))) (run-with-idle-timer git-gutter:update-interval t 'git-gutter:live-update))))
(when (> git-gutter:verbosity 2) (when (> git-gutter:verbosity 2)
(message "Here is not %s work tree" (git-gutter:show-backends))) (message "Here is not %s work tree" (git-gutter:show-backends)))
(git-gutter-mode -1)) (git-gutter-mode -1))
@ -590,9 +584,9 @@ gutter information of other windows."
#'forward-line) #'forward-line)
for info in diffinfos for info in diffinfos
for start-line = (plist-get info :start-line) for start-line = (git-gutter-hunk-start-line info)
for end-line = (plist-get info :end-line) for end-line = (git-gutter-hunk-end-line info)
for type = (plist-get info :type) for type = (git-gutter-hunk-type info)
for sign = (git-gutter:propertized-sign type) for sign = (git-gutter:propertized-sign type)
for points = nil for points = nil
do do
@ -645,7 +639,7 @@ gutter information of other windows."
with cmp-fn = (if is-reverse #'> #'<) with cmp-fn = (if is-reverse #'> #'<)
for diffinfo in (if is-reverse (reverse diffinfos) diffinfos) for diffinfo in (if is-reverse (reverse diffinfos) diffinfos)
for index = 0 then (1+ index) for index = 0 then (1+ index)
for start-line = (plist-get diffinfo :start-line) for start-line = (git-gutter-hunk-start-line diffinfo)
when (funcall cmp-fn current-line start-line) when (funcall cmp-fn current-line start-line)
return (if is-reverse return (if is-reverse
(1- (- (length diffinfos) index)) (1- (- (length diffinfos) index))
@ -656,8 +650,8 @@ gutter information of other windows."
(widen) (widen)
(cl-loop with current-line = (line-number-at-pos) (cl-loop with current-line = (line-number-at-pos)
for diffinfo in diffinfos for diffinfo in diffinfos
for start = (plist-get diffinfo :start-line) for start = (git-gutter-hunk-start-line diffinfo)
for end = (or (plist-get diffinfo :end-line) (1+ start)) for end = (or (git-gutter-hunk-end-line diffinfo) (1+ start))
when (and (>= current-line start) (<= current-line end)) when (and (>= current-line start) (<= current-line end))
return diffinfo return diffinfo
finally do (error "Here is not changed!!")))) finally do (error "Here is not changed!!"))))
@ -686,10 +680,10 @@ gutter information of other windows."
(defun git-gutter:do-revert-hunk (diffinfo) (defun git-gutter:do-revert-hunk (diffinfo)
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(let ((start-line (plist-get diffinfo :start-line)) (let ((start-line (git-gutter-hunk-start-line diffinfo))
(end-line (plist-get diffinfo :end-line)) (end-line (git-gutter-hunk-end-line diffinfo))
(content (plist-get diffinfo :content))) (content (git-gutter-hunk-content diffinfo)))
(cl-case (plist-get diffinfo :type) (cl-case (git-gutter-hunk-type diffinfo)
(added (git-gutter:delete-added-lines start-line end-line)) (added (git-gutter:delete-added-lines start-line end-line))
(deleted (when (git-gutter:delete-from-first-line-p start-line end-line) (deleted (when (git-gutter:delete-from-first-line-p start-line end-line)
(forward-line start-line)) (forward-line start-line))
@ -758,8 +752,8 @@ gutter information of other windows."
(file-name-directory (file-relative-name (git-gutter:base-file) root)))) (file-name-directory (file-relative-name (git-gutter:base-file) root))))
(defun git-gutter:do-stage-hunk (diff-info) (defun git-gutter:do-stage-hunk (diff-info)
(let ((content (plist-get diff-info :content)) (let ((content (git-gutter-hunk-content diff-info))
(type (plist-get diff-info :type)) (type (git-gutter-hunk-type diff-info))
(header (git-gutter:extract-hunk-header)) (header (git-gutter:extract-hunk-header))
(patch (make-temp-name "git-gutter"))) (patch (make-temp-name "git-gutter")))
(when header (when header
@ -790,8 +784,8 @@ gutter information of other windows."
(defun git-gutter:mark-hunk () (defun git-gutter:mark-hunk ()
(interactive) (interactive)
(git-gutter:awhen (git-gutter:search-here-diffinfo git-gutter:diffinfos) (git-gutter:awhen (git-gutter:search-here-diffinfo git-gutter:diffinfos)
(let ((start (git-gutter:line-point (plist-get it :start-line))) (let ((start (git-gutter:line-point (git-gutter-hunk-start-line it)))
(end (git-gutter:line-point (1+ (plist-get it :end-line))))) (end (git-gutter:line-point (1+ (git-gutter-hunk-end-line it)))))
(goto-char start) (goto-char start)
(push-mark end nil t)))) (push-mark end nil t))))
@ -800,7 +794,7 @@ gutter information of other windows."
(view-mode -1) (view-mode -1)
(setq buffer-read-only nil) (setq buffer-read-only nil)
(erase-buffer) (erase-buffer)
(insert (plist-get diffinfo :content)) (insert (git-gutter-hunk-content diffinfo))
(insert "\n") (insert "\n")
(goto-char (point-min)) (goto-char (point-min))
(diff-mode) (diff-mode)
@ -831,7 +825,7 @@ gutter information of other windows."
(if is-reverse (1- len) 0))) (if is-reverse (1- len) 0)))
(diffinfo (nth real-index diffinfos))) (diffinfo (nth real-index diffinfos)))
(goto-char (point-min)) (goto-char (point-min))
(forward-line (1- (plist-get diffinfo :start-line))) (forward-line (1- (git-gutter-hunk-start-line diffinfo)))
(when (> git-gutter:verbosity 0) (when (> git-gutter:verbosity 0)
(message "Move to %d/%d hunk" (1+ real-index) len)) (message "Move to %d/%d hunk" (1+ real-index) len))
(when (buffer-live-p (get-buffer git-gutter:popup-buffer)) (when (buffer-live-p (get-buffer git-gutter:popup-buffer))
@ -946,7 +940,7 @@ start revision."
(when git-gutter:update-timer (when git-gutter:update-timer
(error "Update timer is already running.")) (error "Update timer is already running."))
(setq git-gutter:update-timer (setq git-gutter:update-timer
(run-with-idle-timer 1 git-gutter:update-interval 'git-gutter:live-update))) (run-with-idle-timer git-gutter:update-interval t 'git-gutter:live-update)))
(defun git-gutter:cancel-update-timer () (defun git-gutter:cancel-update-timer ()
(interactive) (interactive)
@ -1032,9 +1026,9 @@ start revision."
(length git-gutter:diffinfos)) (length git-gutter:diffinfos))
(defun git-gutter:stat-hunk (hunk) (defun git-gutter:stat-hunk (hunk)
(cl-case (plist-get hunk :type) (cl-case (git-gutter-hunk-type hunk)
(modified (with-temp-buffer (modified (with-temp-buffer
(insert (plist-get hunk :content)) (insert (git-gutter-hunk-content hunk))
(goto-char (point-min)) (goto-char (point-min))
(let ((added 0) (let ((added 0)
(deleted 0)) (deleted 0))
@ -1043,8 +1037,8 @@ start revision."
((looking-at-p "\\-") (cl-incf deleted))) ((looking-at-p "\\-") (cl-incf deleted)))
(forward-line 1)) (forward-line 1))
(cons added deleted)))) (cons added deleted))))
(added (cons (- (plist-get hunk :end-line) (plist-get hunk :start-line)) 0)) (added (cons (- (git-gutter-hunk-end-line hunk) (git-gutter-hunk-start-line hunk)) 0))
(deleted (cons 0 (- (plist-get hunk :end-line) (plist-get hunk :start-line)))))) (deleted (cons 0 (- (git-gutter-hunk-end-line hunk) (git-gutter-hunk-start-line hunk))))))
(defun git-gutter:statistic () (defun git-gutter:statistic ()
"Return statistic unstaged hunks in current buffer." "Return statistic unstaged hunks in current buffer."

View File

@ -1,5 +0,0 @@
(define-package "go-mode" "20160404.2" "Major mode for the Go programming language" 'nil :url "https://github.com/dominikh/go-mode.el" :keywords
'("languages" "go"))
;; Local Variables:
;; no-byte-compile: t
;; End:

View File

@ -3,8 +3,8 @@
;;; Code: ;;; Code:
;;;### (autoloads nil "go-mode" "go-mode.el" (22297 19826 179922 ;;;### (autoloads nil "go-mode" "go-mode.el" (22387 29367 888183
;;;;;; 64000)) ;;;;;; 643000))
;;; Generated autoloads from go-mode.el ;;; Generated autoloads from go-mode.el
(autoload 'go-mode "go-mode" "\ (autoload 'go-mode "go-mode" "\
@ -96,8 +96,8 @@ Tries to look for a URL at point.
;;;*** ;;;***
;;;### (autoloads nil nil ("go-mode-pkg.el") (22297 19826 479482 ;;;### (autoloads nil nil ("go-mode-pkg.el") (22387 29367 902180
;;;;;; 139000)) ;;;;;; 904000))
;;;*** ;;;***

View File

@ -0,0 +1,5 @@
(define-package "go-mode" "20160512.110" "Major mode for the Go programming language" 'nil :url "https://github.com/dominikh/go-mode.el" :keywords
'("languages" "go"))
;; Local Variables:
;; no-byte-compile: t
;; End:

View File

@ -5,7 +5,7 @@
;; license that can be found in the LICENSE file. ;; license that can be found in the LICENSE file.
;; Author: The go-mode Authors ;; Author: The go-mode Authors
;; Version: 1.3.1 ;; Version: 1.4.0
;; Keywords: languages go ;; Keywords: languages go
;; URL: https://github.com/dominikh/go-mode.el ;; URL: https://github.com/dominikh/go-mode.el
;; ;;
@ -1329,14 +1329,14 @@ Playground URL."
(buffer-substring-no-properties start end) (buffer-substring-no-properties start end)
'utf-8)) 'utf-8))
(content-buf (url-retrieve (content-buf (url-retrieve
"http://play.golang.org/share" "https://play.golang.org/share"
(lambda (arg) (lambda (arg)
(cond (cond
((equal :error (car arg)) ((equal :error (car arg))
(signal 'go-play-error (cdr arg))) (signal 'go-play-error (cdr arg)))
(t (t
(re-search-forward "\n\n") (re-search-forward "\n\n")
(let ((url (format "http://play.golang.org/p/%s" (let ((url (format "https://play.golang.org/p/%s"
(buffer-substring (point) (point-max))))) (buffer-substring (point) (point-max)))))
(when go-play-browse-function (when go-play-browse-function
(funcall go-play-browse-function url))))))))))) (funcall go-play-browse-function url)))))))))))

View File

@ -1,9 +0,0 @@
(define-package "helm" "20160425.958" "Helm is an Emacs incremental and narrowing framework"
'((emacs "24.3")
(async "1.7")
(popup "0.5.3")
(helm-core "1.9.4"))
:url "https://emacs-helm.github.io/helm/")
;; Local Variables:
;; no-byte-compile: t
;; End:

View File

@ -104,7 +104,7 @@ Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ..
(progn (progn
(push (list source-name) helm-adaptive-history) (push (list source-name) helm-adaptive-history)
(car helm-adaptive-history)))) (car helm-adaptive-history))))
(selection (helm-get-selection)) (selection (helm-get-selection nil t))
(selection-info (progn (selection-info (progn
(setcdr source-info (setcdr source-info
(cons (cons
@ -175,47 +175,43 @@ This is a filtered candidate transformer you can use with the
(source-info (assoc source-name helm-adaptive-history))) (source-info (assoc source-name helm-adaptive-history)))
(if source-info (if source-info
(let ((usage (let ((usage
;; ... assemble a list containing the (CANIDATE . USAGE-COUNT) ;; Assemble a list containing the (CANDIDATE . USAGE-COUNT) pairs.
;; pairs (cl-loop with count = 0
(mapcar (lambda (candidate-info) for (sn . infos) in (cdr source-info)
(let ((count 0)) do (cl-loop for (pattern . score) in infos
(cl-dolist (pattern-info (cdr candidate-info)) if (not (equal pattern helm-pattern))
(if (not (equal (car pattern-info) do (cl-incf count score)
helm-pattern)) else return
(cl-incf count (cdr pattern-info)) ;; If current pattern is equal to the previously
;; used one then this candidate has priority
;; if current pattern is equal to the previously ;; (that's why its count is boosted by 10000) and
;; used one then this candidate has priority ;; it only has to compete with other candidates
;; (that's why its count is boosted by 10000) and ;; which were also selected with the same pattern.
;; it only has to compete with other candidates (setq count (+ 10000 score)))
;; which were also selected with the same pattern and collect (cons sn count) into results
(setq count (+ 10000 (cdr pattern-info))) ;; Sort the list in descending order, so candidates with highest
(cl-return))) ;; priority come first.
(cons (car candidate-info) count))) finally return (sort results (lambda (first second)
(cdr source-info)))) (> (cdr first) (cdr second)))))))
(if (and usage (consp usage)) (if (consp usage)
;; sort the list in descending order, so candidates with highest ;; Put those candidates first which have the highest usage count.
;; priorty come first (cl-loop for (info . _freq) in usage
(progn for mlinfo = (and (assq 'multiline source)
(setq usage (sort usage (lambda (first second) (replace-regexp-in-string "\n\\'" "" info))
(> (cdr first) (cdr second))))) for member = (cl-member (or mlinfo info) candidates
:test 'helm-adaptive-compare)
;; put those candidates first which have the highest usage count when member collect (car member) into sorted
(cl-loop for (info . _freq) in usage and do
for member = (cl-member info candidates (setq candidates (cl-remove (or mlinfo info) candidates
:test 'helm-adaptive-compare) :test 'helm-adaptive-compare))
when member collect (car member) into sorted finally return (append sorted candidates))
and do (message "Your `%s' is maybe corrupted or too old, \
(setq candidates (cl-remove info candidates
:test 'helm-adaptive-compare))
finally return (append sorted candidates)))
(message "Your `%s' is maybe corrupted or too old, \
you should reinitialize it with `helm-reset-adaptive-history'" you should reinitialize it with `helm-reset-adaptive-history'"
helm-adaptive-history-file) helm-adaptive-history-file)
(sit-for 1) (sit-for 1)
candidates)) candidates))
;; if there is no information stored for this source then do nothing ;; if there is no information stored for this source then do nothing
candidates))) candidates)))
;;;###autoload ;;;###autoload
(defun helm-reset-adaptive-history () (defun helm-reset-adaptive-history ()

View File

@ -3,8 +3,8 @@
;;; Code: ;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) (add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "helm-adaptive" "helm-adaptive.el" (22303 19284 ;;;### (autoloads nil "helm-adaptive" "helm-adaptive.el" (22387 29367
;;;;;; 902175 378000)) ;;;;;; 188722 114000))
;;; Generated autoloads from helm-adaptive.el ;;; Generated autoloads from helm-adaptive.el
(defvar helm-adaptive-mode nil "\ (defvar helm-adaptive-mode nil "\
@ -29,8 +29,8 @@ Useful when you have a old or corrupted `helm-adaptive-history-file'.
;;;*** ;;;***
;;;### (autoloads nil "helm-apt" "helm-apt.el" (22303 19284 870175 ;;;### (autoloads nil "helm-apt" "helm-apt.el" (22387 29367 144755
;;;;;; 403000)) ;;;;;; 961000))
;;; Generated autoloads from helm-apt.el ;;; Generated autoloads from helm-apt.el
(autoload 'helm-apt "helm-apt" "\ (autoload 'helm-apt "helm-apt" "\
@ -41,8 +41,8 @@ With a prefix arg reload cache.
;;;*** ;;;***
;;;### (autoloads nil "helm-bookmark" "helm-bookmark.el" (22303 19284 ;;;### (autoloads nil "helm-bookmark" "helm-bookmark.el" (22387 29367
;;;;;; 950175 341000)) ;;;;;; 236685 191000))
;;; Generated autoloads from helm-bookmark.el ;;; Generated autoloads from helm-bookmark.el
(autoload 'helm-bookmarks "helm-bookmark" "\ (autoload 'helm-bookmarks "helm-bookmark" "\
@ -59,8 +59,8 @@ only if external library addressbook-bookmark.el is available.
;;;*** ;;;***
;;;### (autoloads nil "helm-buffers" "helm-buffers.el" (22303 19284 ;;;### (autoloads nil "helm-buffers" "helm-buffers.el" (22387 29367
;;;;;; 854175 415000)) ;;;;;; 132765 192000))
;;; Generated autoloads from helm-buffers.el ;;; Generated autoloads from helm-buffers.el
(autoload 'helm-buffers-list "helm-buffers" "\ (autoload 'helm-buffers-list "helm-buffers" "\
@ -75,8 +75,8 @@ Preconfigured `helm' lightweight version (buffer -> recentf).
;;;*** ;;;***
;;;### (autoloads nil "helm-color" "helm-color.el" (22303 19284 930175 ;;;### (autoloads nil "helm-color" "helm-color.el" (22387 29367 220697
;;;;;; 357000)) ;;;;;; 499000))
;;; Generated autoloads from helm-color.el ;;; Generated autoloads from helm-color.el
(autoload 'helm-colors "helm-color" "\ (autoload 'helm-colors "helm-color" "\
@ -86,8 +86,8 @@ Preconfigured `helm' for color.
;;;*** ;;;***
;;;### (autoloads nil "helm-command" "helm-command.el" (22303 19284 ;;;### (autoloads nil "helm-command" "helm-command.el" (22387 29367
;;;;;; 806175 452000)) ;;;;;; 76808 270000))
;;; Generated autoloads from helm-command.el ;;; Generated autoloads from helm-command.el
(autoload 'helm-M-x "helm-command" "\ (autoload 'helm-M-x "helm-command" "\
@ -95,7 +95,9 @@ Preconfigured `helm' for Emacs commands.
It is `helm' replacement of regular `M-x' `execute-extended-command'. It is `helm' replacement of regular `M-x' `execute-extended-command'.
Unlike regular `M-x' emacs vanilla `execute-extended-command' command, Unlike regular `M-x' emacs vanilla `execute-extended-command' command,
the prefix args if needed, are passed AFTER starting `helm-M-x'. the prefix args if needed, can be passed AFTER starting `helm-M-x'.
When a prefix arg is passed BEFORE starting `helm-M-x', the first `C-u'
while in `helm-M-x' session will disable it.
You can get help on each command by persistent action. You can get help on each command by persistent action.
@ -103,8 +105,8 @@ You can get help on each command by persistent action.
;;;*** ;;;***
;;;### (autoloads nil "helm-config" "helm-config.el" (22303 19284 ;;;### (autoloads nil "helm-config" "helm-config.el" (22387 29367
;;;;;; 942175 347000)) ;;;;;; 228691 345000))
;;; Generated autoloads from helm-config.el ;;; Generated autoloads from helm-config.el
(autoload 'helm-configuration "helm-config" "\ (autoload 'helm-configuration "helm-config" "\
@ -114,8 +116,8 @@ Customize `helm'.
;;;*** ;;;***
;;;### (autoloads nil "helm-dabbrev" "helm-dabbrev.el" (22303 19284 ;;;### (autoloads nil "helm-dabbrev" "helm-dabbrev.el" (22387 29367
;;;;;; 882175 394000)) ;;;;;; 156746 731000))
;;; Generated autoloads from helm-dabbrev.el ;;; Generated autoloads from helm-dabbrev.el
(autoload 'helm-dabbrev "helm-dabbrev" "\ (autoload 'helm-dabbrev "helm-dabbrev" "\
@ -125,8 +127,8 @@ Preconfigured helm for dynamic abbreviations.
;;;*** ;;;***
;;;### (autoloads nil "helm-elisp" "helm-elisp.el" (22303 19284 934175 ;;;### (autoloads nil "helm-elisp" "helm-elisp.el" (22387 29367 224694
;;;;;; 353000)) ;;;;;; 422000))
;;; Generated autoloads from helm-elisp.el ;;; Generated autoloads from helm-elisp.el
(autoload 'helm-lisp-completion-at-point "helm-elisp" "\ (autoload 'helm-lisp-completion-at-point "helm-elisp" "\
@ -180,7 +182,7 @@ Preconfigured helm for complex command history.
;;;*** ;;;***
;;;### (autoloads nil "helm-elisp-package" "helm-elisp-package.el" ;;;### (autoloads nil "helm-elisp-package" "helm-elisp-package.el"
;;;;;; (22303 19284 810175 449000)) ;;;;;; (22387 29367 80805 193000))
;;; Generated autoloads from helm-elisp-package.el ;;; Generated autoloads from helm-elisp-package.el
(autoload 'helm-list-elisp-packages "helm-elisp-package" "\ (autoload 'helm-list-elisp-packages "helm-elisp-package" "\
@ -196,8 +198,8 @@ Same as `helm-list-elisp-packages' but don't fetch packages on remote.
;;;*** ;;;***
;;;### (autoloads nil "helm-elscreen" "helm-elscreen.el" (22303 19284 ;;;### (autoloads nil "helm-elscreen" "helm-elscreen.el" (22387 29367
;;;;;; 794175 462000)) ;;;;;; 68814 424000))
;;; Generated autoloads from helm-elscreen.el ;;; Generated autoloads from helm-elscreen.el
(autoload 'helm-elscreen "helm-elscreen" "\ (autoload 'helm-elscreen "helm-elscreen" "\
@ -212,8 +214,8 @@ Preconfigured helm to list elscreen in history order.
;;;*** ;;;***
;;;### (autoloads nil "helm-eshell" "helm-eshell.el" (22303 19284 ;;;### (autoloads nil "helm-eshell" "helm-eshell.el" (22387 29367
;;;;;; 826175 437000)) ;;;;;; 100789 808000))
;;; Generated autoloads from helm-eshell.el ;;; Generated autoloads from helm-eshell.el
(autoload 'helm-esh-pcomplete "helm-eshell" "\ (autoload 'helm-esh-pcomplete "helm-eshell" "\
@ -228,8 +230,8 @@ Preconfigured helm for eshell history.
;;;*** ;;;***
;;;### (autoloads nil "helm-eval" "helm-eval.el" (22303 19284 910175 ;;;### (autoloads nil "helm-eval" "helm-eval.el" (22387 29367 196715
;;;;;; 372000)) ;;;;;; 961000))
;;; Generated autoloads from helm-eval.el ;;; Generated autoloads from helm-eval.el
(autoload 'helm-eval-expression "helm-eval" "\ (autoload 'helm-eval-expression "helm-eval" "\
@ -249,8 +251,8 @@ Preconfigured helm for `helm-source-calculation-result'.
;;;*** ;;;***
;;;### (autoloads nil "helm-external" "helm-external.el" (22303 19284 ;;;### (autoloads nil "helm-external" "helm-external.el" (22387 29367
;;;;;; 786175 468000)) ;;;;;; 56823 655000))
;;; Generated autoloads from helm-external.el ;;; Generated autoloads from helm-external.el
(autoload 'helm-run-external-command "helm-external" "\ (autoload 'helm-run-external-command "helm-external" "\
@ -263,8 +265,8 @@ You can set your own list of commands with
;;;*** ;;;***
;;;### (autoloads nil "helm-files" "helm-files.el" (22303 19284 886175 ;;;### (autoloads nil "helm-files" "helm-files.el" (22387 29367 172734
;;;;;; 391000)) ;;;;;; 423000))
;;; Generated autoloads from helm-files.el ;;; Generated autoloads from helm-files.el
(autoload 'helm-browse-project "helm-files" "\ (autoload 'helm-browse-project "helm-files" "\
@ -291,6 +293,21 @@ and
(autoload 'helm-find "helm-files" "\ (autoload 'helm-find "helm-files" "\
Preconfigured `helm' for the find shell command. Preconfigured `helm' for the find shell command.
Recursively find files whose names are matched by all specified
globbing PATTERNs under the current directory using the external
program specified in `find-program' (usually \"find\"). Every
input PATTERN is silently wrapped into two stars: *PATTERN*.
With prefix argument, prompt for a directory to search.
When user option `helm-findutils-search-full-path' is non-nil,
match against complete paths, otherwise, against file names
without directory part.
The (possibly empty) list of globbing PATTERNs can be followed by
the separator \"*\" plus any number of additional arguments that
are passed to \"find\" literally.
\(fn ARG)" t nil) \(fn ARG)" t nil)
(autoload 'helm-find-files "helm-files" "\ (autoload 'helm-find-files "helm-files" "\
@ -322,8 +339,8 @@ Preconfigured `helm' for `recentf'.
;;;*** ;;;***
;;;### (autoloads nil "helm-font" "helm-font.el" (22303 19284 830175 ;;;### (autoloads nil "helm-font" "helm-font.el" (22387 29367 104786
;;;;;; 434000)) ;;;;;; 731000))
;;; Generated autoloads from helm-font.el ;;; Generated autoloads from helm-font.el
(autoload 'helm-select-xfont "helm-font" "\ (autoload 'helm-select-xfont "helm-font" "\
@ -338,8 +355,8 @@ Preconfigured helm for `ucs-names' math symbols.
;;;*** ;;;***
;;;### (autoloads nil "helm-grep" "helm-grep.el" (22303 19284 954175 ;;;### (autoloads nil "helm-grep" "helm-grep.el" (22387 29367 240682
;;;;;; 338000)) ;;;;;; 114000))
;;; Generated autoloads from helm-grep.el ;;; Generated autoloads from helm-grep.el
(autoload 'helm-goto-precedent-file "helm-grep" "\ (autoload 'helm-goto-precedent-file "helm-grep" "\
@ -366,8 +383,8 @@ With a prefix arg ARG git-grep the whole repository.
;;;*** ;;;***
;;;### (autoloads nil "helm-help" "helm-help.el" (22303 19284 782175 ;;;### (autoloads nil "helm-help" "helm-help.el" (22387 29367 52826
;;;;;; 471000)) ;;;;;; 733000))
;;; Generated autoloads from helm-help.el ;;; Generated autoloads from helm-help.el
(autoload 'helm-documentation "helm-help" "\ (autoload 'helm-documentation "helm-help" "\
@ -393,8 +410,8 @@ HELM-ATTRIBUTE should be a symbol.
;;;*** ;;;***
;;;### (autoloads nil "helm-id-utils" "helm-id-utils.el" (22303 19284 ;;;### (autoloads nil "helm-id-utils" "helm-id-utils.el" (22387 29367
;;;;;; 862175 409000)) ;;;;;; 140759 38000))
;;; Generated autoloads from helm-id-utils.el ;;; Generated autoloads from helm-id-utils.el
(autoload 'helm-gid "helm-id-utils" "\ (autoload 'helm-gid "helm-id-utils" "\
@ -408,8 +425,8 @@ See <https://www.gnu.org/software/idutils/>.
;;;*** ;;;***
;;;### (autoloads nil "helm-imenu" "helm-imenu.el" (22303 19284 846175 ;;;### (autoloads nil "helm-imenu" "helm-imenu.el" (22387 29367 120774
;;;;;; 421000)) ;;;;;; 423000))
;;; Generated autoloads from helm-imenu.el ;;; Generated autoloads from helm-imenu.el
(autoload 'helm-imenu "helm-imenu" "\ (autoload 'helm-imenu "helm-imenu" "\
@ -418,14 +435,16 @@ Preconfigured `helm' for `imenu'.
\(fn)" t nil) \(fn)" t nil)
(autoload 'helm-imenu-in-all-buffers "helm-imenu" "\ (autoload 'helm-imenu-in-all-buffers "helm-imenu" "\
Preconfigured helm for fetching imenu entries of all buffers. Preconfigured helm for fetching imenu entries in all buffers with similar mode as current.
A mode is similar as current if it is the same, it is derived i.e `derived-mode-p'
or it have an association in `helm-imenu-all-buffer-assoc'.
\(fn)" t nil) \(fn)" t nil)
;;;*** ;;;***
;;;### (autoloads nil "helm-info" "helm-info.el" (22303 19284 838175 ;;;### (autoloads nil "helm-info" "helm-info.el" (22387 29367 112780
;;;;;; 427000)) ;;;;;; 578000))
;;; Generated autoloads from helm-info.el ;;; Generated autoloads from helm-info.el
(autoload 'helm-info "helm-info" "\ (autoload 'helm-info "helm-info" "\
@ -441,8 +460,8 @@ With a prefix-arg insert symbol at point.
;;;*** ;;;***
;;;### (autoloads nil "helm-locate" "helm-locate.el" (22303 19284 ;;;### (autoloads nil "helm-locate" "helm-locate.el" (22387 29367
;;;;;; 790175 465000)) ;;;;;; 60820 578000))
;;; Generated autoloads from helm-locate.el ;;; Generated autoloads from helm-locate.el
(autoload 'helm-projects-find-files "helm-locate" "\ (autoload 'helm-projects-find-files "helm-locate" "\
@ -469,8 +488,8 @@ Where db_path is a filename matched by
;;;*** ;;;***
;;;### (autoloads nil "helm-man" "helm-man.el" (22303 19284 914175 ;;;### (autoloads nil "helm-man" "helm-man.el" (22387 29367 200712
;;;;;; 369000)) ;;;;;; 884000))
;;; Generated autoloads from helm-man.el ;;; Generated autoloads from helm-man.el
(autoload 'helm-man-woman "helm-man" "\ (autoload 'helm-man-woman "helm-man" "\
@ -481,8 +500,8 @@ With a prefix arg reinitialize the cache.
;;;*** ;;;***
;;;### (autoloads nil "helm-misc" "helm-misc.el" (22303 19284 898175 ;;;### (autoloads nil "helm-misc" "helm-misc.el" (22387 29367 180728
;;;;;; 381000)) ;;;;;; 268000))
;;; Generated autoloads from helm-misc.el ;;; Generated autoloads from helm-misc.el
(autoload 'helm-browse-menubar "helm-misc" "\ (autoload 'helm-browse-menubar "helm-misc" "\
@ -523,8 +542,8 @@ Preconfigured `helm' that provide completion of `comint' history.
;;;*** ;;;***
;;;### (autoloads nil "helm-mode" "helm-mode.el" (22303 19284 766175 ;;;### (autoloads nil "helm-mode" "helm-mode.el" (22387 29366 904940
;;;;;; 484000)) ;;;;;; 675000))
;;; Generated autoloads from helm-mode.el ;;; Generated autoloads from helm-mode.el
(autoload 'helm-comp-read "helm-mode" "\ (autoload 'helm-comp-read "helm-mode" "\
@ -691,8 +710,8 @@ Note: This mode is incompatible with Emacs23.
;;;*** ;;;***
;;;### (autoloads nil "helm-net" "helm-net.el" (22303 19284 926175 ;;;### (autoloads nil "helm-net" "helm-net.el" (22387 29367 216700
;;;;;; 360000)) ;;;;;; 576000))
;;; Generated autoloads from helm-net.el ;;; Generated autoloads from helm-net.el
(autoload 'helm-surfraw "helm-net" "\ (autoload 'helm-surfraw "helm-net" "\
@ -712,8 +731,8 @@ Preconfigured `helm' for Wikipedia lookup with Wikipedia suggest.
;;;*** ;;;***
;;;### (autoloads nil "helm-org" "helm-org.el" (22303 19284 958175 ;;;### (autoloads nil "helm-org" "helm-org.el" (22387 29367 244679
;;;;;; 335000)) ;;;;;; 37000))
;;; Generated autoloads from helm-org.el ;;; Generated autoloads from helm-org.el
(autoload 'helm-org-agenda-files-headings "helm-org" "\ (autoload 'helm-org-agenda-files-headings "helm-org" "\
@ -744,8 +763,8 @@ Preconfigured helm for org templates.
;;;*** ;;;***
;;;### (autoloads nil "helm-regexp" "helm-regexp.el" (22303 19284 ;;;### (autoloads nil "helm-regexp" "helm-regexp.el" (22387 29367
;;;;;; 922175 363000)) ;;;;;; 208706 730000))
;;; Generated autoloads from helm-regexp.el ;;; Generated autoloads from helm-regexp.el
(autoload 'helm-moccur-mode "helm-regexp" "\ (autoload 'helm-moccur-mode "helm-regexp" "\
@ -784,8 +803,8 @@ The prefix arg can be set before calling
;;;*** ;;;***
;;;### (autoloads nil "helm-ring" "helm-ring.el" (22303 19284 778175 ;;;### (autoloads nil "helm-ring" "helm-ring.el" (22387 29367 48829
;;;;;; 474000)) ;;;;;; 810000))
;;; Generated autoloads from helm-ring.el ;;; Generated autoloads from helm-ring.el
(defvar helm-push-mark-mode nil "\ (defvar helm-push-mark-mode nil "\
@ -842,8 +861,8 @@ This command is useful when used with persistent action.
;;;*** ;;;***
;;;### (autoloads nil "helm-semantic" "helm-semantic.el" (22303 19284 ;;;### (autoloads nil "helm-semantic" "helm-semantic.el" (22387 29367
;;;;;; 850175 418000)) ;;;;;; 128768 269000))
;;; Generated autoloads from helm-semantic.el ;;; Generated autoloads from helm-semantic.el
(autoload 'helm-semantic "helm-semantic" "\ (autoload 'helm-semantic "helm-semantic" "\
@ -865,10 +884,24 @@ Fill in the symbol at point by default.
;;;*** ;;;***
;;;### (autoloads nil "helm-sys" "helm-sys.el" (22303 19284 874175 ;;;### (autoloads nil "helm-sys" "helm-sys.el" (22387 29367 148752
;;;;;; 400000)) ;;;;;; 884000))
;;; Generated autoloads from helm-sys.el ;;; Generated autoloads from helm-sys.el
(defvar helm-top-poll-mode nil "\
Non-nil if Helm-Top-Poll mode is enabled.
See the command `helm-top-poll-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 `helm-top-poll-mode'.")
(custom-autoload 'helm-top-poll-mode "helm-sys" nil)
(autoload 'helm-top-poll-mode "helm-sys" "\
Refresh automatically helm top buffer once enabled.
\(fn &optional ARG)" t nil)
(autoload 'helm-top "helm-sys" "\ (autoload 'helm-top "helm-sys" "\
Preconfigured `helm' for top command. Preconfigured `helm' for top command.
@ -886,8 +919,8 @@ Preconfigured helm for xrandr.
;;;*** ;;;***
;;;### (autoloads nil "helm-tags" "helm-tags.el" (22303 19284 822175 ;;;### (autoloads nil "helm-tags" "helm-tags.el" (22387 29367 92795
;;;;;; 440000)) ;;;;;; 962000))
;;; Generated autoloads from helm-tags.el ;;; Generated autoloads from helm-tags.el
(autoload 'helm-etags-select "helm-tags" "\ (autoload 'helm-etags-select "helm-tags" "\
@ -906,8 +939,8 @@ This function aggregates three sources of tag files:
;;;*** ;;;***
;;;### (autoloads nil "helm-utils" "helm-utils.el" (22303 19284 798175 ;;;### (autoloads nil "helm-utils" "helm-utils.el" (22387 29367 72811
;;;;;; 459000)) ;;;;;; 347000))
;;; Generated autoloads from helm-utils.el ;;; Generated autoloads from helm-utils.el
(defvar helm-popup-tip-mode nil "\ (defvar helm-popup-tip-mode nil "\
@ -927,8 +960,8 @@ Show help-echo informations in a popup tip at end of line.
;;;*** ;;;***
;;;### (autoloads nil nil ("helm-easymenu.el" "helm-multi-match.el" ;;;### (autoloads nil nil ("helm-easymenu.el" "helm-multi-match.el"
;;;;;; "helm-pkg.el" "helm-plugin.el" "helm-types.el") (22303 19284 ;;;;;; "helm-pkg.el" "helm-plugin.el" "helm-types.el") (22387 29367
;;;;;; 973293 164000)) ;;;;;; 261328 856000))
;;;*** ;;;***

View File

@ -30,6 +30,7 @@
(declare-function ido-make-buffer-list "ido" (default)) (declare-function ido-make-buffer-list "ido" (default))
(declare-function ido-add-virtual-buffers-to-list "ido") (declare-function ido-add-virtual-buffers-to-list "ido")
(declare-function helm-comp-read "helm-mode") (declare-function helm-comp-read "helm-mode")
(declare-function helm-browse-project "helm-files")
(defgroup helm-buffers nil (defgroup helm-buffers nil
@ -153,6 +154,7 @@ Only buffer names are fuzzy matched when this is enabled,
;; So use zgrep for both as it is capable to handle non--compressed files. ;; So use zgrep for both as it is capable to handle non--compressed files.
(define-key map (kbd "M-g s") 'helm-buffer-run-zgrep) (define-key map (kbd "M-g s") 'helm-buffer-run-zgrep)
(define-key map (kbd "C-s") 'helm-buffers-run-multi-occur) (define-key map (kbd "C-s") 'helm-buffers-run-multi-occur)
(define-key map (kbd "C-x C-d") 'helm-buffers-run-browse-project)
(define-key map (kbd "C-c o") 'helm-buffer-switch-other-window) (define-key map (kbd "C-c o") 'helm-buffer-switch-other-window)
(define-key map (kbd "C-c C-o") 'helm-buffer-switch-other-frame) (define-key map (kbd "C-c C-o") 'helm-buffer-switch-other-frame)
(define-key map (kbd "C-c =") 'helm-buffer-run-ediff) (define-key map (kbd "C-c =") 'helm-buffer-run-ediff)
@ -186,6 +188,7 @@ Only buffer names are fuzzy matched when this is enabled,
(defvar helm-buffers-list-cache nil) (defvar helm-buffers-list-cache nil)
(defvar helm-buffer-max-len-mode nil) (defvar helm-buffer-max-len-mode nil)
(defvar helm-buffers-in-project-p nil)
(defun helm-buffers-list--init () (defun helm-buffers-list--init ()
;; Issue #51 Create the list before `helm-buffer' creation. ;; Issue #51 Create the list before `helm-buffer' creation.
@ -549,7 +552,7 @@ i.e same color."
collect p))) collect p)))
(if regexps (if regexps
(cl-loop for re in regexps (cl-loop for re in regexps
thereis thereis
(and buf-fname (and buf-fname
(string-match (string-match
(substring re 1) (helm-basedir buf-fname)))) (substring re 1) (helm-basedir buf-fname))))
@ -842,6 +845,18 @@ Can be used by any source that list buffers."
(helm-force-update)))) (helm-force-update))))
(put 'helm-buffers-toggle-show-hidden-buffers 'helm-only t) (put 'helm-buffers-toggle-show-hidden-buffers 'helm-only t)
(defun helm-buffers-browse-project (buf)
"Browse project from buffer."
(with-current-buffer buf
(helm-browse-project helm-current-prefix-arg)))
(defun helm-buffers-run-browse-project ()
"Run `helm-buffers-browse-project' from key."
(interactive)
(with-helm-alive-p
(if helm-buffers-in-project-p
(user-error "You are already browsing this project")
(helm-exit-and-execute-action 'helm-buffers-browse-project))))
;;; Candidate Transformers ;;; Candidate Transformers
;; ;;
@ -884,6 +899,12 @@ displayed with the `file-name-shadow' face if available."
:ff-transformer-show-only-basename nil :ff-transformer-show-only-basename nil
:truncate-lines helm-buffers-truncate-lines)) :truncate-lines helm-buffers-truncate-lines))
(defun helm-quit-and-helm-mini ()
"Drop into `helm-mini' from `helm'."
(interactive)
(with-helm-alive-p
(helm-run-after-exit 'helm-mini)))
(provide 'helm-buffers) (provide 'helm-buffers)
;; Local Variables: ;; Local Variables:

View File

@ -65,6 +65,8 @@ Show all candidates on startup when 0 (default)."
(defvar helm-M-x-input-history nil) (defvar helm-M-x-input-history nil)
(defvar helm-M-x-prefix-argument nil
"Prefix argument before calling `helm-M-x'.")
(cl-defun helm-M-x-get-major-mode-command-alist (mode-map) (cl-defun helm-M-x-get-major-mode-command-alist (mode-map)
@ -158,6 +160,28 @@ fuzzy matching is running its own sort function with a different algorithm."
(push (substring (helm-cmd--get-current-function-name) 1) results)))) (push (substring (helm-cmd--get-current-function-name) 1) results))))
results)) results))
(defvar helm-M-x-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-comp-read-map)
(define-key map (kbd "C-u") nil)
(define-key map (kbd "C-u") 'helm-M-x-universal-argument)
map))
(defun helm-M-x-universal-argument ()
"Same as `universal-argument' but for `helm-M-x'."
(interactive)
(if helm-M-x-prefix-argument
(progn (setq helm-M-x-prefix-argument nil)
(let ((inhibit-read-only t))
(with-selected-window (minibuffer-window)
(save-excursion
(goto-char (point-min))
(delete-char (- (minibuffer-prompt-width) (length "M-x "))))))
(message "Initial prefix arg disabled"))
(setq prefix-arg (list 4))
(universal-argument--mode)))
(put 'helm-M-x-universal-argument 'helm-only t)
(defun helm-M-x-read-extended-command (&optional collection history) (defun helm-M-x-read-extended-command (&optional collection history)
"Read command name to invoke in `helm-M-x'. "Read command name to invoke in `helm-M-x'.
Helm completion is not provided when executing or defining Helm completion is not provided when executing or defining
@ -187,16 +211,20 @@ than the default which is OBARRAY."
do (set-text-properties 0 (length c) nil c) do (set-text-properties 0 (length c) nil c)
and collect c)) and collect c))
(unwind-protect (unwind-protect
(let ((msg "Error: Specifying a prefix arg before calling `helm-M-x'")) (progn
(when current-prefix-arg
(ding)
(message "%s" msg)
(while (not (sit-for 1))
(discard-input))
(user-error msg))
(setq current-prefix-arg nil) (setq current-prefix-arg nil)
(helm-comp-read (helm-comp-read
"M-x " (or collection obarray) (concat (cond
((eq helm-M-x-prefix-argument '-) "- ")
((and (consp helm-M-x-prefix-argument)
(eq (car helm-M-x-prefix-argument) 4)) "C-u ")
((and (consp helm-M-x-prefix-argument)
(integerp (car helm-M-x-prefix-argument)))
(format "%d " (car helm-M-x-prefix-argument)))
((integerp helm-M-x-prefix-argument)
(format "%d " helm-M-x-prefix-argument)))
"M-x ")
(or collection obarray)
:test 'commandp :test 'commandp
:requires-pattern helm-M-x-requires-pattern :requires-pattern helm-M-x-requires-pattern
:name "Emacs Commands" :name "Emacs Commands"
@ -210,6 +238,7 @@ than the default which is OBARRAY."
:input-history 'helm-M-x-input-history :input-history 'helm-M-x-input-history
:del-input nil :del-input nil
:help-message 'helm-M-x-help-message :help-message 'helm-M-x-help-message
:keymap helm-M-x-map
:must-match t :must-match t
:fuzzy helm-M-x-fuzzy-match :fuzzy helm-M-x-fuzzy-match
:nomark t :nomark t
@ -220,15 +249,20 @@ than the default which is OBARRAY."
(setq helm--mode-line-display-prefarg nil))))) (setq helm--mode-line-display-prefarg nil)))))
;;;###autoload ;;;###autoload
(defun helm-M-x (arg &optional command-name) (defun helm-M-x (_arg &optional command-name)
"Preconfigured `helm' for Emacs commands. "Preconfigured `helm' for Emacs commands.
It is `helm' replacement of regular `M-x' `execute-extended-command'. It is `helm' replacement of regular `M-x' `execute-extended-command'.
Unlike regular `M-x' emacs vanilla `execute-extended-command' command, Unlike regular `M-x' emacs vanilla `execute-extended-command' command,
the prefix args if needed, are passed AFTER starting `helm-M-x'. the prefix args if needed, can be passed AFTER starting `helm-M-x'.
When a prefix arg is passed BEFORE starting `helm-M-x', the first `C-u'
while in `helm-M-x' session will disable it.
You can get help on each command by persistent action." You can get help on each command by persistent action."
(interactive (list current-prefix-arg (helm-M-x-read-extended-command))) (interactive
(progn
(setq helm-M-x-prefix-argument current-prefix-arg)
(list current-prefix-arg (helm-M-x-read-extended-command))))
(let ((sym-com (and (stringp command-name) (intern-soft command-name)))) (let ((sym-com (and (stringp command-name) (intern-soft command-name))))
(when sym-com (when sym-com
;; Avoid having `this-command' set to *exit-minibuffer. ;; Avoid having `this-command' set to *exit-minibuffer.
@ -237,7 +271,7 @@ You can get help on each command by persistent action."
real-this-command sym-com) real-this-command sym-com)
;; If helm-M-x is called with regular emacs completion (kmacro) ;; If helm-M-x is called with regular emacs completion (kmacro)
;; use the value of arg otherwise use helm-current-prefix-arg. ;; use the value of arg otherwise use helm-current-prefix-arg.
(let ((prefix-arg (or helm-current-prefix-arg arg))) (let ((prefix-arg (or helm-current-prefix-arg helm-M-x-prefix-argument)))
;; This ugly construct is to save history even on error. ;; This ugly construct is to save history even on error.
(unless helm-M-x-always-save-history (unless helm-M-x-always-save-history
(command-execute sym-com 'record)) (command-execute sym-com 'record))
@ -246,7 +280,7 @@ You can get help on each command by persistent action."
(delete command-name extended-command-history))) (delete command-name extended-command-history)))
(when helm-M-x-always-save-history (when helm-M-x-always-save-history
(command-execute sym-com 'record)))))) (command-execute sym-com 'record))))))
(put 'helm-M-x 'interactive-only 'command-execute)
(provide 'helm-command) (provide 'helm-command)

View File

@ -149,7 +149,10 @@
("(\\<\\(define-helm-type-attribute\\)\\>" 1 font-lock-keyword-face) ("(\\<\\(define-helm-type-attribute\\)\\>" 1 font-lock-keyword-face)
("(\\<\\(helm-multi-key-defun\\)\\>" 1 font-lock-keyword-face) ("(\\<\\(helm-multi-key-defun\\)\\>" 1 font-lock-keyword-face)
("(\\<\\(helm-while-no-input\\)\\>" 1 font-lock-keyword-face) ("(\\<\\(helm-while-no-input\\)\\>" 1 font-lock-keyword-face)
("(\\<\\(helm-aif\\)\\>" 1 font-lock-keyword-face)))) ("(\\<\\(helm-aif\\)\\>" 1 font-lock-keyword-face)
("(\\<\\(helm-awhile\\)\\>" 1 font-lock-keyword-face)
("(\\<\\(helm-acond\\)\\>" 1 font-lock-keyword-face)
("(\\<\\(helm-with-gensyms\\)\\>" 1 font-lock-keyword-face))))
;;; Load the autoload file ;;; Load the autoload file

Some files were not shown because too many files have changed in this diff Show More