summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorLars Magne Ingebrigtsen <larsi@gnus.org>2015-01-28 14:21:33 +1100
committerLars Magne Ingebrigtsen <larsi@gnus.org>2015-01-28 14:21:33 +1100
commit7f4f16b3ae6fdb59d83cfc01017668f2a564309f (patch)
tree60e4a7f23f949afaed3bc2fddd0a528aef297861 /lisp
parent1a369fc7f1ccec6954344ec1ee0211a4d24c312d (diff)
parentbe2d23e58721b7acc68c0ea654a38e5109df2aa2 (diff)
downloademacs-7f4f16b3ae6fdb59d83cfc01017668f2a564309f.tar.gz
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog84
-rw-r--r--lisp/emacs-lisp/cl-generic.el323
-rw-r--r--lisp/emacs-lisp/cl.el13
-rw-r--r--lisp/emacs-lisp/derived.el3
-rw-r--r--lisp/emacs-lisp/eieio-compat.el13
-rw-r--r--lisp/emacs-lisp/eieio-core.el2
-rw-r--r--lisp/emacs-lisp/eieio-datadebug.el16
-rw-r--r--lisp/emacs-lisp/eieio-opt.el18
-rw-r--r--lisp/emacs-lisp/eieio.el2
-rw-r--r--lisp/gnus/ChangeLog20
-rw-r--r--lisp/gnus/gnus-bcklg.el4
-rw-r--r--lisp/gnus/nnimap.el20
-rw-r--r--lisp/gnus/nnir.el123
-rw-r--r--lisp/gnus/nnmairix.el2
-rw-r--r--lisp/isearch.el2
-rw-r--r--lisp/net/eudc-bob.el3
-rw-r--r--lisp/net/eudc-export.el3
-rw-r--r--lisp/net/eudc-hotlist.el3
-rw-r--r--lisp/net/eudc-vars.el3
-rw-r--r--lisp/net/eudc.el3
-rw-r--r--lisp/net/eudcb-bbdb.el3
-rw-r--r--lisp/net/eudcb-ldap.el3
-rw-r--r--lisp/net/eudcb-mab.el2
-rw-r--r--lisp/net/eudcb-ph.el3
-rw-r--r--lisp/progmodes/python.el6
-rw-r--r--lisp/tar-mode.el115
26 files changed, 547 insertions, 245 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d17dff23a2f..b95424543f8 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,87 @@
+2015-01-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emacs-lisp/cl.el (cl--function-convert):
+ Merge cache that cl--labels-convert adds (bug#19699).
+
+2015-01-27 Ivan Shmakov <ivan@siamics.net>
+
+ * tar-mode.el: Allow for adding new archive members. (Bug#19274)
+ (tar-new-regular-file-header, tar--pad-to, tar--put-at)
+ (tar-header-serialize): New functions.
+ (tar-current-position): Split from tar-current-descriptor.
+ (tar-current-descriptor): Use it.
+ (tar-new-entry): New command.
+ (tar-mode-map): Bind it.
+
+2015-01-27 Sam Steingold <sds@gnu.org>
+
+ * progmodes/python.el (python-check-custom-command): Buffer local
+ because it usually includes the buffer name.
+ (python-check-command): Set to epylint when pyflakes is not available.
+
+2015-01-27 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/eudcb-bbdb.el, net/eudcb-ldap.el, net/eudcb-mab.el,
+ net/eudc-bob.el, net/eudcb-ph.el, net/eudc.el, net/eudc-export.el,
+ net/eudc-hotlist.el, net/eudc-vars.el: New maintainer.
+
+2015-01-27 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * isearch.el (isearch-process-search-char): Add docstring.
+
+2015-01-27 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * emacs-lisp/derived.el (define-derived-mode): Declare indent 3.
+
+2015-01-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emacs-lisp/cl.el (cl--function-convert): Run cl--labels-convert
+ for the case cl-flet or cl-labels form is wrapped with lexical-let
+ (bug#19613).
+
+2015-01-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-generic.el (cl--generic-method): New struct.
+ (cl--generic): The method-table is now a (list-of cl--generic-method).
+ (cl--generic-member-method): New function.
+ (cl-generic-define-method): Use it.
+ (cl--generic-build-combined-method, cl--generic-cache-miss):
+ Adapt to new method-table.
+ (cl--generic-no-next-method-function): Add `method' argument.
+ (cl-generic-call-method): Adapt to new method representation.
+ (cl--generic-cnm-sample, cl--generic-nnm-sample): Adjust.
+ (cl-find-method, cl-method-qualifiers): New functions.
+ (cl--generic-method-info): Adapt to new method representation.
+ Return a string for the qualifiers.
+ (cl--generic-describe):
+ * emacs-lisp/eieio-opt.el (eieio-help-class): Adjust accordingly.
+ (eieio-all-generic-functions, eieio-method-documentation):
+ Adjust to new method representation.
+
+ * emacs-lisp/eieio-compat.el (eieio--defmethod): Use cl-find-method.
+
+2015-01-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-generic.el: Add a method-combination hook.
+ (cl-generic-method-combination-function): New var.
+ (cl--generic-lambda): Remove `with-cnm' arg.
+ (cl-defmethod): Change accordingly.
+ (cl-generic-define-method): Don't check qualifiers validity.
+ Preserve all qualifiers in `method-table'.
+ (cl-generic-call-method): New function.
+ (cl--generic-nest): Remove (morph into cl-generic-call-method).
+ (cl--generic-build-combined-method): Adjust to new format of method-table
+ and use cl-generic-method-combination-function.
+ (cl--generic-standard-method-combination): New function, extracted from
+ cl--generic-build-combined-method.
+ (cl--generic-cnm-sample): Adjust to new format of method-table.
+
+ * emacs-lisp/eieio-compat.el (eieio--defmethod): Use () qualifiers
+ instead of :primary.
+
+ * emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke):
+ Remove obsolete function.
+
2015-01-26 Lars Ingebrigtsen <larsi@gnus.org>
* net/shr.el (shr-make-table-1): Fix colspan typo.
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 02a43514019..1bb70963a57 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -30,11 +30,9 @@
;; CLOS's define-method-combination is IMO overly complicated, and it suffers
;; from a significant problem: the method-combination code returns a sexp
;; that needs to be `eval'uated or compiled. IOW it requires run-time
-;; code generation.
-;; - Method and generic function objects: CLOS defines methods as objects
-;; (same for generic functions), whereas we don't offer such an abstraction.
-;; - `no-next-method' should receive the "calling method" object, but since we
-;; don't have such a thing, we pass nil instead.
+;; code generation. Given how rarely method-combinations are used,
+;; I just provided a cl-generic-method-combination-function, which
+;; people can use if they are really desperate for such functionality.
;; - In defgeneric we don't support the options:
;; declare, :method-combination, :generic-function-class, :method-class,
;; :method.
@@ -48,6 +46,8 @@
;; eieio-core adds dispatch on:
;; - class of eieio objects
;; - actual class argument, using the syntax (subclass <class>).
+;; - cl-generic-method-combination-function (i.s.o define-method-combination).
+;; - cl-generic-call-method (which replaces make-method and call-method).
;; Efficiency considerations: overall, I've made an effort to make this fairly
;; efficient for the expected case (e.g. no constant redefinition of methods).
@@ -101,6 +101,18 @@ that for all other (PRIORITY . TAGCODE) where PRIORITY ≤ N, then
"Function to get the list of types that a given \"tag\" matches.
They should be sorted from most specific to least specific.")
+(cl-defstruct (cl--generic-method
+ (:constructor nil)
+ (:constructor cl--generic-method-make
+ (specializers qualifiers uses-cnm function))
+ (:predicate nil))
+ (specializers nil :read-only t :type list)
+ (qualifiers nil :read-only t :type (list-of atom))
+ ;; USES-CNM is a boolean indicating if FUNCTION expects an extra argument
+ ;; holding the next-method.
+ (uses-cnm nil :read-only t :type boolean)
+ (function nil :read-only t :type function))
+
(cl-defstruct (cl--generic
(:constructor nil)
(:constructor cl--generic-make
@@ -114,12 +126,7 @@ They should be sorted from most specific to least specific.")
;; decide in which order to sort them.
;; The most important dispatch is last in the list (and the least is first).
(dispatches nil :type (list-of (cons natnum (list-of tagcode))))
- ;; `method-table' is a list of
- ;; ((SPECIALIZERS . QUALIFIER) USES-CNM . FUNCTION), where
- ;; USES-CNM is a boolean indicating if FUNCTION calls `cl-call-next-method'
- ;; (and hence expects an extra argument holding the next-method).
- (method-table nil :type (list-of (cons (cons (list-of type) keyword)
- (cons boolean function)))))
+ (method-table nil :type (list-of cl--generic-method)))
(defmacro cl--generic (name)
`(get ,name 'cl--generic))
@@ -232,7 +239,7 @@ This macro can only be used within the lexical scope of a cl-generic method."
(and (memq sexp vars) (not (memq sexp res)) (push sexp res))
res))
- (defun cl--generic-lambda (args body with-cnm)
+ (defun cl--generic-lambda (args body)
"Make the lambda expression for a method with ARGS and BODY."
(let ((plain-args ())
(specializers nil)
@@ -255,36 +262,34 @@ This macro can only be used within the lexical scope of a cl-generic method."
. ,(lambda () specializers))
macroexpand-all-environment)))
(require 'cl-lib) ;Needed to expand `cl-flet' and `cl-function'.
- (if (not with-cnm)
- (cons nil (macroexpand-all fun macroenv))
- ;; First macroexpand away the cl-function stuff (e.g. &key and
- ;; destructuring args, `declare' and whatnot).
- (pcase (macroexpand fun macroenv)
- (`#'(lambda ,args . ,body)
- (let* ((doc-string (and doc-string (stringp (car body)) (cdr body)
- (pop body)))
- (cnm (make-symbol "cl--cnm"))
- (nmp (make-symbol "cl--nmp"))
- (nbody (macroexpand-all
- `(cl-flet ((cl-call-next-method ,cnm)
- (cl-next-method-p ,nmp))
- ,@body)
- macroenv))
- ;; FIXME: Rather than `grep' after the fact, the
- ;; macroexpansion should directly set some flag when cnm
- ;; is used.
- ;; FIXME: Also, optimize the case where call-next-method is
- ;; only called with explicit arguments.
- (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody)))
- (cons (not (not uses-cnm))
- `#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
- ,@(if doc-string (list doc-string))
- ,(if (not (memq nmp uses-cnm))
- nbody
- `(let ((,nmp (lambda ()
- (cl--generic-isnot-nnm-p ,cnm))))
- ,nbody))))))
- (f (error "Unexpected macroexpansion result: %S" f))))))))
+ ;; First macroexpand away the cl-function stuff (e.g. &key and
+ ;; destructuring args, `declare' and whatnot).
+ (pcase (macroexpand fun macroenv)
+ (`#'(lambda ,args . ,body)
+ (let* ((doc-string (and doc-string (stringp (car body)) (cdr body)
+ (pop body)))
+ (cnm (make-symbol "cl--cnm"))
+ (nmp (make-symbol "cl--nmp"))
+ (nbody (macroexpand-all
+ `(cl-flet ((cl-call-next-method ,cnm)
+ (cl-next-method-p ,nmp))
+ ,@body)
+ macroenv))
+ ;; FIXME: Rather than `grep' after the fact, the
+ ;; macroexpansion should directly set some flag when cnm
+ ;; is used.
+ ;; FIXME: Also, optimize the case where call-next-method is
+ ;; only called with explicit arguments.
+ (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody)))
+ (cons (not (not uses-cnm))
+ `#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
+ ,@(if doc-string (list doc-string))
+ ,(if (not (memq nmp uses-cnm))
+ nbody
+ `(let ((,nmp (lambda ()
+ (cl--generic-isnot-nnm-p ,cnm))))
+ ,nbody))))))
+ (f (error "Unexpected macroexpansion result: %S" f)))))))
;;;###autoload
@@ -324,8 +329,7 @@ which case this method will be invoked when the argument is `eql' to VAL.
(while (not (listp args))
(push args qualifiers)
(setq args (pop body)))
- (pcase-let* ((with-cnm (not (memq (car qualifiers) '(:before :after))))
- (`(,uses-cnm . ,fun) (cl--generic-lambda args body with-cnm)))
+ (pcase-let* ((`(,uses-cnm . ,fun) (cl--generic-lambda args body)))
`(progn
,(when setfizer
(setq name (car setfizer))
@@ -345,19 +349,25 @@ which case this method will be invoked when the argument is `eql' to VAL.
(cl-generic-define-method ',name ',qualifiers ',args
,uses-cnm ,fun)))))
+(defun cl--generic-member-method (specializers qualifiers methods)
+ (while
+ (and methods
+ (let ((m (car methods)))
+ (not (and (equal (cl--generic-method-specializers m) specializers)
+ (equal (cl--generic-method-qualifiers m) qualifiers)))))
+ (setq methods (cdr methods))
+ methods))
+
;;;###autoload
(defun cl-generic-define-method (name qualifiers args uses-cnm function)
- (when (> (length qualifiers) 1)
- (error "We only support a single qualifier per method: %S" qualifiers))
- (unless (memq (car qualifiers) '(nil :primary :around :after :before))
- (error "Unsupported qualifier in: %S" qualifiers))
(let* ((generic (cl-generic-ensure-function name))
(mandatory (cl--generic-mandatory-args args))
(specializers
(mapcar (lambda (arg) (if (consp arg) (cadr arg) t)) mandatory))
- (key (cons specializers (or (car qualifiers) ':primary)))
+ (method (cl--generic-method-make
+ specializers qualifiers uses-cnm function))
(mt (cl--generic-method-table generic))
- (me (assoc key mt))
+ (me (cl--generic-member-method specializers qualifiers mt))
(dispatches (cl--generic-dispatches generic))
(i 0))
(dolist (specializer specializers)
@@ -372,9 +382,8 @@ which case this method will be invoked when the argument is `eql' to VAL.
(nreverse (sort (cons tagcode (cdr x))
#'car-less-than-car))))
(setq i (1+ i))))
- (if me (setcdr me (cons uses-cnm function))
- (setf (cl--generic-method-table generic)
- (cons `(,key ,uses-cnm . ,function) mt)))
+ (if me (setcar me method)
+ (setf (cl--generic-method-table generic) (cons method mt)))
(cl-pushnew `(cl-defmethod . (,(cl--generic-name generic) . ,specializers))
current-load-list :test #'equal)
(let ((gfun (cl--generic-make-function generic))
@@ -438,22 +447,19 @@ which case this method will be invoked when the argument is `eql' to VAL.
(cdr dispatch) (car dispatch))))
(funcall dispatcher generic dispatches)))))
-(defun cl--generic-nest (fun methods)
- (pcase-dolist (`(,uses-cnm . ,method) methods)
- (setq fun
- (if (not uses-cnm) method
- (let ((next fun))
- (lambda (&rest args)
- (apply method
- ;; FIXME: This sucks: passing just `next' would
- ;; be a lot more efficient than the lambda+apply
- ;; quasi-η, but we need this to implement the
- ;; "if call-next-method is called with no
- ;; arguments, then use the previous arguments".
- (lambda (&rest cnm-args)
- (apply next (or cnm-args args)))
- args))))))
- fun)
+(defvar cl-generic-method-combination-function
+ #'cl--generic-standard-method-combination
+ "Function to build the effective method.
+Called with 2 arguments: NAME and METHOD-ALIST.
+It should return an effective method, i.e. a function that expects the same
+arguments as the methods, and calls those methods in some appropriate order.
+NAME is the name (a symbol) of the corresponding generic function.
+METHOD-ALIST is a list of elements (QUALIFIERS . METHODS) where
+QUALIFIERS is a list of qualifiers, and METHODS is a list of the selected
+methods for that qualifier list.
+The METHODS lists are sorted from most generic first to most specific last.
+The function can use `cl-generic-call-method' to create functions that call those
+methods.")
(defvar cl--generic-combined-method-memoization
(make-hash-table :test #'equal :weakness 'value)
@@ -462,54 +468,82 @@ This is particularly useful when many different tags select the same set
of methods, since this table then allows us to share a single combined-method
for all those different tags in the method-cache.")
-(defun cl--generic-no-next-method-function (generic)
- (lambda (&rest args)
- ;; FIXME: CLOS passes as second arg the "calling method".
- ;; We don't currently have "method objects" like CLOS
- ;; does so we can't really do it the CLOS way.
- ;; The closest would be to pass the lambda corresponding
- ;; to the method, or maybe the ((SPECIALIZERS
- ;; . QUALIFIER) USE-CNM . FUNCTION) entry from the method
- ;; table, but the caller wouldn't be able to do much with
- ;; it anyway. So we pass nil for now.
- (apply #'cl-no-next-method generic nil args)))
-
(defun cl--generic-build-combined-method (generic-name methods)
- (let ((mets-by-qual ()))
- (dolist (qm methods)
- (push (cdr qm) (alist-get (cdar qm) mets-by-qual)))
- (cl--generic-with-memoization
- (gethash (cons generic-name mets-by-qual)
- cl--generic-combined-method-memoization)
- (cond
- ((null mets-by-qual)
- (lambda (&rest args)
- (apply #'cl-no-applicable-method generic-name args)))
- ((null (alist-get :primary mets-by-qual))
- (lambda (&rest args)
- (apply #'cl-no-primary-method generic-name args)))
- (t
- (let* ((fun (cl--generic-no-next-method-function generic-name))
- ;; We use `cdr' to drop the `uses-cnm' annotations.
- (before
- (mapcar #'cdr (reverse (alist-get :before mets-by-qual))))
- (after (mapcar #'cdr (alist-get :after mets-by-qual))))
- (setq fun (cl--generic-nest fun (alist-get :primary mets-by-qual)))
- (when (or after before)
- (let ((next fun))
- (setq fun (lambda (&rest args)
- (dolist (bf before)
- (apply bf args))
- (prog1
- (apply next args)
- (dolist (af after)
- (apply af args)))))))
- (cl--generic-nest fun (alist-get :around mets-by-qual))))))))
-
-(defconst cl--generic-nnm-sample (cl--generic-no-next-method-function 'dummy))
+ (cl--generic-with-memoization
+ (gethash (cons generic-name methods)
+ cl--generic-combined-method-memoization)
+ (let ((mets-by-qual ()))
+ (dolist (method methods)
+ (let* ((qualifiers (cl--generic-method-qualifiers method))
+ (x (assoc qualifiers mets-by-qual)))
+ ;; FIXME: sadly, alist-get only uses `assq' and we need `assoc'.
+ ;;(push (cdr qm) (alist-get qualifiers mets-by-qual)))
+ (if x
+ (push method (cdr x))
+ (push (list qualifiers method) mets-by-qual))))
+ (funcall cl-generic-method-combination-function
+ generic-name mets-by-qual))))
+
+(defun cl--generic-no-next-method-function (generic method)
+ (lambda (&rest args)
+ (apply #'cl-no-next-method generic method args)))
+
+(defun cl-generic-call-method (generic-name method &optional fun)
+ "Return a function that calls METHOD.
+FUN is the function that should be called when METHOD calls
+`call-next-method'."
+ (if (not (cl--generic-method-uses-cnm method))
+ (cl--generic-method-function method)
+ (let ((met-fun (cl--generic-method-function method))
+ (next (or fun (cl--generic-no-next-method-function
+ generic-name method))))
+ (lambda (&rest args)
+ (apply met-fun
+ ;; FIXME: This sucks: passing just `next' would
+ ;; be a lot more efficient than the lambda+apply
+ ;; quasi-η, but we need this to implement the
+ ;; "if call-next-method is called with no
+ ;; arguments, then use the previous arguments".
+ (lambda (&rest cnm-args)
+ (apply next (or cnm-args args)))
+ args)))))
+
+(defun cl--generic-standard-method-combination (generic-name mets-by-qual)
+ (dolist (x mets-by-qual)
+ (unless (member (car x) '(() (:after) (:before) (:around)))
+ (error "Unsupported qualifiers in function %S: %S" generic-name (car x))))
+ (cond
+ ((null mets-by-qual)
+ (lambda (&rest args)
+ (apply #'cl-no-applicable-method generic-name args)))
+ ((null (alist-get nil mets-by-qual))
+ (lambda (&rest args)
+ (apply #'cl-no-primary-method generic-name args)))
+ (t
+ (let* ((fun nil)
+ (ab-call (lambda (m) (cl-generic-call-method generic-name m)))
+ (before
+ (mapcar ab-call (reverse (cdr (assoc '(:before) mets-by-qual)))))
+ (after (mapcar ab-call (cdr (assoc '(:after) mets-by-qual)))))
+ (dolist (method (cdr (assoc nil mets-by-qual)))
+ (setq fun (cl-generic-call-method generic-name method fun)))
+ (when (or after before)
+ (let ((next fun))
+ (setq fun (lambda (&rest args)
+ (dolist (bf before)
+ (apply bf args))
+ (prog1
+ (apply next args)
+ (dolist (af after)
+ (apply af args)))))))
+ (dolist (method (cdr (assoc '(:around) mets-by-qual)))
+ (setq fun (cl-generic-call-method generic-name method fun)))
+ fun))))
+
+(defconst cl--generic-nnm-sample (cl--generic-no-next-method-function t t))
(defconst cl--generic-cnm-sample
(funcall (cl--generic-build-combined-method
- nil `(((specializer . :primary) t . ,#'identity)))))
+ nil (list (cl--generic-method-make () () t #'identity)))))
(defun cl--generic-isnot-nnm-p (cnm)
"Return non-nil if CNM is the function that calls `cl-no-next-method'."
@@ -540,11 +574,13 @@ for all those different tags in the method-cache.")
(defun cl--generic-cache-miss (generic dispatch-arg dispatches-left tags)
(let ((types (apply #'append (mapcar cl-generic-tag-types-function tags)))
(methods '()))
- (dolist (method-desc (cl--generic-method-table generic))
- (let* ((specializer (or (nth dispatch-arg (caar method-desc)) t))
+ (dolist (method (cl--generic-method-table generic))
+ (let* ((specializer (or (nth dispatch-arg
+ (cl--generic-method-specializers method))
+ t))
(m (member specializer types)))
(when m
- (push (cons (length m) method-desc) methods))))
+ (push (cons (length m) method) methods))))
;; Sort the methods, most specific first.
;; It would be tempting to sort them once and for all in the method-table
;; rather than here, but the order might depend on the actual argument
@@ -587,6 +623,14 @@ Can only be used from within the lexical body of a primary or around method."
(declare (obsolete "make sure there's always a next method, or catch `cl-no-next-method' instead" "25.1"))
(error "cl-next-method-p only allowed inside primary and around methods"))
+;;;###autoload
+(defun cl-find-method (generic qualifiers specializers)
+ (car (cl--generic-member-method
+ specializers qualifiers
+ (cl--generic-method-table (cl--generic generic)))))
+
+(defalias 'cl-method-qualifiers 'cl--generic-method-qualifiers)
+
;;; Add support for describe-function
(defun cl--generic-search-method (met-name)
@@ -611,22 +655,30 @@ Can only be used from within the lexical body of a primary or around method."
`(cl-defmethod . ,#'cl--generic-search-method)))
(defun cl--generic-method-info (method)
- (pcase-let ((`((,specializers . ,qualifier) ,uses-cnm . ,function) method))
- (let* ((args (help-function-arglist function 'names))
- (docstring (documentation function))
- (doconly (if docstring
- (let ((split (help-split-fundoc docstring nil)))
- (if split (cdr split) docstring))))
- (combined-args ()))
- (if uses-cnm (setq args (cdr args)))
- (dolist (specializer specializers)
- (let ((arg (if (eq '&rest (car args))
- (intern (format "arg%d" (length combined-args)))
- (pop args))))
- (push (if (eq specializer t) arg (list arg specializer))
- combined-args)))
- (setq combined-args (append (nreverse combined-args) args))
- (list qualifier combined-args doconly))))
+ (let* ((specializers (cl--generic-method-specializers method))
+ (qualifiers (cl--generic-method-qualifiers method))
+ (uses-cnm (cl--generic-method-uses-cnm method))
+ (function (cl--generic-method-function method))
+ (args (help-function-arglist function 'names))
+ (docstring (documentation function))
+ (qual-string
+ (if (null qualifiers) ""
+ (cl-assert (consp qualifiers))
+ (let ((s (prin1-to-string qualifiers)))
+ (concat (substring s 1 -1) " "))))
+ (doconly (if docstring
+ (let ((split (help-split-fundoc docstring nil)))
+ (if split (cdr split) docstring))))
+ (combined-args ()))
+ (if uses-cnm (setq args (cdr args)))
+ (dolist (specializer specializers)
+ (let ((arg (if (eq '&rest (car args))
+ (intern (format "arg%d" (length combined-args)))
+ (pop args))))
+ (push (if (eq specializer t) arg (list arg specializer))
+ combined-args)))
+ (setq combined-args (append (nreverse combined-args) args))
+ (list qual-string combined-args doconly)))
(add-hook 'help-fns-describe-function-functions #'cl--generic-describe)
(defun cl--generic-describe (function)
@@ -640,8 +692,9 @@ Can only be used from within the lexical body of a primary or around method."
(dolist (method (cl--generic-method-table generic))
(let* ((info (cl--generic-method-info method)))
;; FIXME: Add hyperlinks for the types as well.
- (insert (format "%S %S" (nth 0 info) (nth 1 info)))
- (let* ((met-name (cons function (caar method)))
+ (insert (format "%s%S" (nth 0 info) (nth 1 info)))
+ (let* ((met-name (cons function
+ (cl--generic-method-specializers method)))
(file (find-lisp-object-file-name met-name 'cl-defmethod)))
(when file
(insert " in `")
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index da3eab73fc4..1b204631fb8 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -342,6 +342,8 @@ The two cases that are handled are:
- renaming of F when it's a function defined via `cl-labels' or `labels'."
(require 'cl-macs)
(declare-function cl--expr-contains-any "cl-macs" (x y))
+ (declare-function cl--labels-convert "cl-macs" (f))
+ (defvar cl--labels-convert-cache)
(cond
;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
;; *after* handling `function', but we want to stop macroexpansion from
@@ -374,13 +376,10 @@ The two cases that are handled are:
(setq cl--function-convert-cache (cons newf res))
res))))
(t
- (let ((found (assq f macroexpand-all-environment)))
- (if (and found (ignore-errors
- (eq (cadr (cl-caddr found)) 'cl-labels-args)))
- (cadr (cl-caddr (cl-cadddr found)))
- (let ((res `(function ,f)))
- (setq cl--function-convert-cache (cons f res))
- res))))))
+ (setq cl--labels-convert-cache cl--function-convert-cache)
+ (prog1
+ (cl--labels-convert f)
+ (setq cl--function-convert-cache cl--labels-convert-cache)))))
(defmacro lexical-let (bindings &rest body)
"Like `let', but lexically scoped.
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index a250ea60d21..52da4c99eaf 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -162,7 +162,8 @@ The new mode runs the hook constructed by the function
See Info node `(elisp)Derived Modes' for more details."
(declare (debug (&define name symbolp sexp [&optional stringp]
[&rest keywordp sexp] def-body))
- (doc-string 4))
+ (doc-string 4)
+ (indent 3))
(when (and docstring (not (stringp docstring)))
;; Some trickiness, since what appears to be the docstring may really be
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
index c2dabf7f446..fcca99d79d5 100644
--- a/lisp/emacs-lisp/eieio-compat.el
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -181,7 +181,8 @@ Summary:
(lambda (generic arg &rest args) (apply code arg generic args)))
(_ code))))
(cl-generic-define-method
- method (if kind (list kind)) specializers uses-cnm
+ method (unless (memq kind '(nil :primary)) (list kind))
+ specializers uses-cnm
(if uses-cnm
(let* ((docstring (documentation code 'raw))
(args (help-function-arglist code 'preserve-names))
@@ -201,11 +202,11 @@ Summary:
;; applicable but only of the before/after kind. So if we add a :before
;; or :after, make sure there's a matching dummy primary.
(when (and (memq kind '(:before :after))
- (not (assoc (cons (mapcar (lambda (arg)
- (if (consp arg) (nth 1 arg) t))
- specializers)
- :primary)
- (cl--generic-method-table (cl--generic method)))))
+ ;; FIXME: Use `cl-find-method'?
+ (not (cl-find-method method ()
+ (mapcar (lambda (arg)
+ (if (consp arg) (nth 1 arg) t))
+ specializers))))
(cl-generic-define-method method () specializers t
(lambda (cnm &rest args)
(if (cl--generic-isnot-nnm-p cnm)
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 261138bfbf8..7492f0522ab 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -1258,7 +1258,7 @@ method invocation orders of the involved classes."
(eieio--class-precedence-list tag))))
-;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "57805f02023795a01567781e70aaf9f9")
+;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "b568ffb3c90ed5d0ae673f0051d608ee")
;;; Generated autoloads from eieio-compat.el
(autoload 'eieio--defalias "eieio-compat" "\
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el
index 6534bd0fecf..119f7cce038 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -129,22 +129,6 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
(data-debug-new-buffer (format "*%s DDEBUG*" (eieio-object-name obj)))
(data-debug-insert-object-slots obj "]"))
-;;; DEBUG FUNCTIONS
-;;
-(defun eieio-debug-methodinvoke (method class)
- "Show the method invocation order for METHOD with CLASS object."
- (interactive "aMethod: \nXClass Expression: ")
- (let* ((eieio-pre-method-execution-functions
- (lambda (l) (throw 'moose l) ))
- (data
- (catch 'moose (eieio--generic-call
- method (list class))))
- (_buf (data-debug-new-buffer "*Method Invocation*"))
- (data2 (mapcar (lambda (sym)
- (symbol-function (car sym)))
- data)))
- (data-debug-insert-thing data2 ">" "")))
-
(provide 'eieio-datadebug)
;;; eieio-datadebug.el ends here
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index a131b02ee16..8d40edf5624 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -129,9 +129,9 @@ If CLASS is actually an object, then also display current values of that object.
(insert "`")
(help-insert-xref-button (symbol-name generic) 'help-function generic)
(insert "'")
- (pcase-dolist (`(,qualifier ,args ,doc)
+ (pcase-dolist (`(,qualifiers ,args ,doc)
(eieio-method-documentation generic class))
- (insert (format " %S %S\n" qualifier args)
+ (insert (format " %s%S\n" qualifiers args)
(or doc "")))
(insert "\n\n")))))
@@ -325,10 +325,9 @@ methods for CLASS."
(and generic
(catch 'found
(if (null class) (throw 'found t))
- (pcase-dolist (`((,specializers . ,_qualifier) . ,_)
- (cl--generic-method-table generic))
+ (dolist (method (cl--generic-method-table generic))
(if (eieio--specializers-apply-to-class-p
- specializers class)
+ (cl--generic-method-specializers method) class)
(throw 'found t))))
(push symbol l)))))
l))
@@ -336,15 +335,14 @@ methods for CLASS."
(defun eieio-method-documentation (generic class)
"Return info for all methods of GENERIC applicable to CLASS.
The value returned is a list of elements of the form
-\(QUALIFIER ARGS DOC)."
+\(QUALIFIERS ARGS DOC)."
(let ((generic (cl--generic generic))
(docs ()))
(when generic
(dolist (method (cl--generic-method-table generic))
- (pcase-let ((`((,specializers . ,_qualifier) . ,_) method))
- (when (eieio--specializers-apply-to-class-p
- specializers class)
- (push (cl--generic-method-info method) docs)))))
+ (when (eieio--specializers-apply-to-class-p
+ (cl--generic-method-specializers method) class)
+ (push (cl--generic-method-info method) docs))))
docs))
;;; METHOD STATS
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 3dba8e0e7bf..91469b4b96c 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -942,7 +942,7 @@ Optional argument GROUP is the sub-group of slots to display.
;;;***
-;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "d7b8682e15aebad7dbe6384dc5ed655f")
+;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "b849f8bf1312d5ef57e53d02173e4b5a")
;;; Generated autoloads from eieio-opt.el
(autoload 'eieio-browse "eieio-opt" "\
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 7ef526b4253..7bf4a6e01d6 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,23 @@
+2015-01-27 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnir.el (nnir-imap-expr-to-imap): Check for literal+ capability in
+ IMAP.
+
+2015-01-27 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * nnir.el (nnir-run-imap): Enable non-ASCII IMAP searches.
+
+ * nnmairix.el ("nnmairix"): Declare nnmairix as virtual.
+
+ * gnus-bcklg.el (gnus-backlog-enter-article): No virtual groups should
+ be added to the backlog.
+
+2015-01-26 Trevor Murphy <trevor.m.murphy@gmail.com>
+
+ * nnimap.el (nnimap-header-parameters): Refactor and request
+ X-GM-LABELS if it's been announced.
+ (nnimap-transform-headers): Gather and output GM-LABELS.
+
2015-01-26 Peder O. Klingenberg <peder@klingenberg.no>
* mm-decode.el (mm-display-part): Make non-string methods work.
diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el
index b26f367a79b..e0c457a8829 100644
--- a/lisp/gnus/gnus-bcklg.el
+++ b/lisp/gnus/gnus-bcklg.el
@@ -61,7 +61,7 @@
(defun gnus-backlog-enter-article (group number buffer)
(when (and (numberp number)
- (not (string-match "^nnvirtual" group)))
+ (not (gnus-virtual-group-p group)))
(gnus-backlog-setup)
(let ((ident (intern (concat group ":" (int-to-string number))
gnus-backlog-hashtb))
@@ -126,7 +126,7 @@
(defun gnus-backlog-request-article (group number &optional buffer)
(when (and (numberp number)
- (not (string-match "^nnvirtual" group)))
+ (not (gnus-virtual-group-p group)))
(gnus-backlog-setup)
(let ((ident (intern (concat group ":" (int-to-string number))
gnus-backlog-hashtb))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index ced55619881..8e81abcf9c0 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -166,14 +166,21 @@ textual parts.")
(nnimap-find-process-buffer nntp-server-buffer))
(defun nnimap-header-parameters ()
- (format "(UID RFC822.SIZE BODYSTRUCTURE %s)"
- (format
+ (let (params)
+ (push "UID" params)
+ (push "RFC822.SIZE" params)
+ (when (nnimap-capability "X-GM-EXT-1")
+ (push "X-GM-LABELS" params))
+ (push "BODYSTRUCTURE" params)
+ (push (format
(if (nnimap-ver4-p)
"BODY.PEEK[HEADER.FIELDS %s]"
"RFC822.HEADER.LINES %s")
(append '(Subject From Date Message-Id
References In-Reply-To Xref)
- nnmail-extra-headers))))
+ nnmail-extra-headers))
+ params)
+ (format "%s" (nreverse params))))
(deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
(when group
@@ -197,7 +204,7 @@ textual parts.")
(defun nnimap-transform-headers ()
(goto-char (point-min))
- (let (article lines size string)
+ (let (article lines size string labels)
(block nil
(while (not (eobp))
(while (not (looking-at "\\* [0-9]+ FETCH"))
@@ -232,6 +239,9 @@ textual parts.")
t)
(match-string 1)))
(beginning-of-line)
+ (when (search-forward "X-GM-LABELS" (line-end-position) t)
+ (setq labels (ignore-errors (read (current-buffer)))))
+ (beginning-of-line)
(when (search-forward "BODYSTRUCTURE" (line-end-position) t)
(let ((structure (ignore-errors
(read (current-buffer)))))
@@ -251,6 +261,8 @@ textual parts.")
(insert (format "Chars: %s\n" size)))
(when lines
(insert (format "Lines: %s\n" lines)))
+ (when labels
+ (insert (format "X-GM-LABELS: %s\n" labels)))
;; Most servers have a blank line after the headers, but
;; Davmail doesn't.
(unless (re-search-forward "^\r$\\|^)\r?$" nil t)
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index 08ca7c7e06b..6d111e89e80 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -284,6 +284,8 @@ is `(valuefunc member)'."
(eval-when-compile
(autoload 'nnimap-buffer "nnimap")
(autoload 'nnimap-command "nnimap")
+ (autoload 'nnimap-capability "nnimap")
+ (autoload 'nnimap-wait-for-line "nnimap")
(autoload 'nnimap-change-group "nnimap")
(autoload 'nnimap-make-thread-query "nnimap")
(autoload 'gnus-registry-action "gnus-registry")
@@ -968,33 +970,52 @@ details on the language and supported extensions."
(catch 'found
(mapcar
#'(lambda (group)
- (let (artlist)
- (condition-case ()
- (when (nnimap-change-group
- (gnus-group-short-name group) server)
- (with-current-buffer (nnimap-buffer)
- (message "Searching %s..." group)
- (let ((arts 0)
- (result (nnimap-command "UID SEARCH %s"
- (if (string= criteria "")
- qstring
- (nnir-imap-make-query
- criteria qstring)))))
- (mapc
- (lambda (artnum)
- (let ((artn (string-to-number artnum)))
- (when (> artn 0)
- (push (vector group artn 100)
- artlist)
- (when (assq 'shortcut query)
- (throw 'found (list artlist)))
- (setq arts (1+ arts)))))
- (and (car result)
- (cdr (assoc "SEARCH" (cdr result)))))
- (message "Searching %s... %d matches" group arts)))
- (message "Searching %s...done" group))
- (quit nil))
- (nreverse artlist)))
+ (let (artlist)
+ (condition-case ()
+ (when (nnimap-change-group
+ (gnus-group-short-name group) server)
+ (with-current-buffer (nnimap-buffer)
+ (message "Searching %s..." group)
+ (let* ((arts 0)
+ (literal+ (nnimap-capability "LITERAL+"))
+ (search (split-string
+ (if (string= criteria "")
+ qstring
+ (nnir-imap-make-query
+ criteria qstring))
+ "\n"))
+ (coding (upcase
+ (replace-regexp-in-string
+ "-\\(unix\\|dos\\|mac\\)" ""
+ (symbol-name
+ (cdr default-process-coding-system)))))
+ call result)
+ (setq call (nnimap-send-command
+ "UID SEARCH CHARSET %s %s" coding (pop search)))
+ (while search ; Non-ascii search terms
+ (unless literal+
+ (nnimap-wait-for-line "^\\+\\(.*\\)\n"))
+ (process-send-string (get-buffer-process (current-buffer)) (pop search))
+ (process-send-string (get-buffer-process (current-buffer))
+ (if (nnimap-newlinep nnimap-object)
+ "\n"
+ "\r\n")))
+ (setq result (nnimap-get-response call))
+ (mapc
+ (lambda (artnum)
+ (let ((artn (string-to-number artnum)))
+ (when (> artn 0)
+ (push (vector group artn 100)
+ artlist)
+ (when (assq 'shortcut query)
+ (throw 'found (list artlist)))
+ (setq arts (1+ arts)))))
+ (and (car result)
+ (cdr (assoc "SEARCH" (cdr result)))))
+ (message "Searching %s... %d matches" group arts)))
+ (message "Searching %s...done" group))
+ (quit nil))
+ (nreverse artlist)))
groups))))))
(defun nnir-imap-make-query (criteria qstring)
@@ -1048,25 +1069,30 @@ In future the following will be added to the language:
(defun nnir-imap-expr-to-imap (criteria expr)
"Convert EXPR into an IMAP search expression on CRITERIA"
;; What sort of expression is this, eh?
- (cond
- ;; Simple string term
- ((stringp expr)
- (format "%s %S" criteria expr))
- ;; Trivial term: and
- ((eq expr 'and) nil)
- ;; Composite term: or expression
- ((eq (car-safe expr) 'or)
- (format "OR %s %s"
- (nnir-imap-expr-to-imap criteria (second expr))
- (nnir-imap-expr-to-imap criteria (third expr))))
- ;; Composite term: just the fax, mam
- ((eq (car-safe expr) 'not)
- (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr))))
- ;; Composite term: just expand it all.
- ((and (not (null expr)) (listp expr))
- (format "(%s)" (nnir-imap-query-to-imap criteria expr)))
- ;; Complex value, give up for now.
- (t (error "Unhandled input: %S" expr))))
+ (let ((literal+ (nnimap-capability "LITERAL+")))
+ (cond
+ ;; Simple string term
+ ((stringp expr)
+ (format "%s %S" criteria expr))
+ ;; Trivial term: and
+ ((eq expr 'and) nil)
+ ;; Composite term: or expression
+ ((eq (car-safe expr) 'or)
+ (format "OR %s %s"
+ (nnir-imap-expr-to-imap criteria (second expr))
+ (nnir-imap-expr-to-imap criteria (third expr))))
+ ;; Composite term: just the fax, mam
+ ((eq (car-safe expr) 'not)
+ (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr))))
+ ;; Composite term: non-ascii search term
+ ((numberp (car-safe expr))
+ (format "%s {%d%s}\n%s" criteria (car expr)
+ (if literal+ "+" "") (second expr)))
+ ;; Composite term: just expand it all.
+ ((and (not (null expr)) (listp expr))
+ (format "(%s)" (nnir-imap-query-to-imap criteria expr)))
+ ;; Complex value, give up for now.
+ (t (error "Unhandled input: %S" expr)))))
(defun nnir-imap-parse-query (string)
@@ -1108,6 +1134,11 @@ that the search language can then understand and use."
((eq term 'and) 'and)
;; negated term
((eq term 'not) (list 'not (nnir-imap-next-expr)))
+ ;; non-ascii search string
+ ((and (stringp term)
+ (not (= (string-bytes term)
+ (length term))))
+ (list (string-bytes term) term))
;; generic term
(t term))))
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index 5a01ce8c25c..96b40e5b845 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -417,7 +417,7 @@ Other back ends might or might not work.")
(nnoo-define-basics nnmairix)
-(gnus-declare-backend "nnmairix" 'mail 'address)
+(gnus-declare-backend "nnmairix" 'mail 'address 'virtual)
(deffoo nnmairix-open-server (server &optional definitions)
;; just set server variables
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 191ec8270eb..99ca73f9f54 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -2349,6 +2349,8 @@ With argument, add COUNT copies of the character."
(isearch-process-search-char char count))))
(defun isearch-process-search-char (char &optional count)
+ "Add CHAR to the search string, COUNT times.
+Search is updated accordingly."
;; * and ? are special in regexps when not preceded by \.
;; } and | are special in regexps when preceded by \.
;; Nothing special for + because it matches at least once.
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index 622ea72d021..f01f671de9e 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -3,7 +3,8 @@
;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
index bbdb294da7f..0e54d841d57 100644
--- a/lisp/net/eudc-export.el
+++ b/lisp/net/eudc-export.el
@@ -3,7 +3,8 @@
;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el
index b3c9a6db0d5..7416ad090eb 100644
--- a/lisp/net/eudc-hotlist.el
+++ b/lisp/net/eudc-hotlist.el
@@ -3,7 +3,8 @@
;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index 29ddf613376..36a583daa4d 100644
--- a/lisp/net/eudc-vars.el
+++ b/lisp/net/eudc-vars.el
@@ -3,7 +3,8 @@
;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 4dd80972e3f..cf5d13fce88 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -3,7 +3,8 @@
;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index 0400e5b5bb4..5be2bec0c5d 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -3,7 +3,8 @@
;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index 92972c5f99e..1d426a7b7b0 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -3,7 +3,8 @@
;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el
index 81d8f24ecb2..a11cd95b05d 100644
--- a/lisp/net/eudcb-mab.el
+++ b/lisp/net/eudcb-mab.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@newartisans.com>
-;; Maintainer: emacs-devel@gnu.org
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudcb-ph.el b/lisp/net/eudcb-ph.el
index fc6aad671c0..1897e0b08bc 100644
--- a/lisp/net/eudcb-ph.el
+++ b/lisp/net/eudcb-ph.el
@@ -3,7 +3,8 @@
;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index d298f96bc81..13ff439bef2 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -3816,7 +3816,9 @@ The skeleton will be bound to python-skeleton-NAME."
;;; Code check
(defcustom python-check-command
- "pyflakes"
+ (or (executable-find "pyflakes")
+ (executable-find "epylint")
+ "install pyflakes, pylint or something else")
"Command used to check a Python file."
:type 'string
:group 'python)
@@ -3827,7 +3829,7 @@ The skeleton will be bound to python-skeleton-NAME."
:type 'string
:group 'python)
-(defvar python-check-custom-command nil
+(defvar-local python-check-custom-command nil
"Internal use.")
(defun python-check (command)
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 1ee54515bea..6c7f7553f82 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -50,9 +50,6 @@
;;
;; o chmod should understand "a+x,og-w".
;;
-;; o It's not possible to add a NEW file to a tar archive; not that
-;; important, but still...
-;;
;; o The code is less efficient that it could be - in a lot of places, I
;; pull a 512-character string out of the buffer and parse it, when I could
;; be parsing it in place, not garbaging a string. Should redo that.
@@ -369,6 +366,80 @@ write-date, checksum, link-type, and link-name."
string)
(tar-parse-octal-integer string))
+(defun tar-new-regular-file-header (filename &optional size time)
+ "Return a Tar header for a regular file.
+The header will lack a proper checksum; use `tar-header-block-checksum'
+to compute one, or request `tar-header-serialize' to do that.
+
+Other tar-mode facilities may also require the data-start header
+field to be set to a valid value.
+
+If SIZE is not given or nil, it defaults to 0.
+If TIME is not given or nil, assume now."
+ (make-tar-header
+ nil
+ filename
+ #o644 0 0 (or size 0)
+ (or time (current-time))
+ nil ; checksum
+ nil nil
+ nil nil nil nil nil))
+
+(defun tar--pad-to (pos)
+ (make-string (+ pos (- (point)) (point-min)) 0))
+
+(defun tar--put-at (pos val &optional fmt mask)
+ (when val
+ (insert (tar--pad-to pos)
+ (if fmt
+ (format fmt (if mask (logand mask val) val))
+ val))))
+
+(defun tar-header-serialize (header &optional update-checksum)
+ "Return the serialization of a Tar HEADER as a string.
+This function calls `tar-header-block-check-checksum' to ensure the
+checksum is correct.
+
+If UPDATE-CHECKSUM is non-nil, update HEADER with the newly-computed
+checksum before doing the check."
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (let ((encoded-name
+ (encode-coding-string (tar-header-name header)
+ tar-file-name-coding-system)))
+ (unless (< (length encoded-name) 99)
+ ;; FIXME: Implement it.
+ (error "Long file name support is not implemented"))
+ (insert encoded-name))
+ (tar--put-at tar-mode-offset (tar-header-mode header) "%6o\0 " #o777777)
+ (tar--put-at tar-uid-offset (tar-header-uid header) "%6o\0 " #o777777)
+ (tar--put-at tar-gid-offset (tar-header-gid header) "%6o\0 " #o777777)
+ (tar--put-at tar-size-offset (tar-header-size header) "%11o ")
+ (insert (tar--pad-to tar-time-offset)
+ (tar-octal-time (tar-header-date header))
+ " ")
+ ;; Omit tar-header-checksum (tar-chk-offset) for now.
+ (tar--put-at tar-linkp-offset (tar-header-link-type header))
+ (tar--put-at tar-link-offset (tar-header-link-name header))
+ (when (tar-header-magic header)
+ (tar--put-at tar-magic-offset (tar-header-magic header))
+ (tar--put-at tar-uname-offset (tar-header-uname header))
+ (tar--put-at tar-gname-offset (tar-header-gname header))
+ (tar--put-at tar-dmaj-offset (tar-header-dmaj header) "%7o\0" #o7777777)
+ (tar--put-at tar-dmin-offset (tar-header-dmin header) "%7o\0" #o7777777))
+ (tar--put-at 512 "")
+ (let ((ck (tar-header-block-checksum (buffer-string))))
+ (goto-char (+ (point-min) tar-chk-offset))
+ (delete-char 8)
+ (insert (format "%6o\0 " ck))
+ (when update-checksum
+ (setf (tar-header-checksum header) ck))
+ (tar-header-block-check-checksum (buffer-string)
+ (tar-header-checksum header)
+ (tar-header-name header)))
+ ;; .
+ (buffer-string)))
+
(defun tar-header-block-checksum (string)
"Compute and return a tar-acceptable checksum for this block."
@@ -547,6 +618,7 @@ MODE should be an integer which is a file mode value."
(define-key map "p" 'tar-previous-line)
(define-key map "\^P" 'tar-previous-line)
(define-key map [up] 'tar-previous-line)
+ (define-key map "I" 'tar-new-entry)
(define-key map "R" 'tar-rename-entry)
(define-key map "u" 'tar-unflag)
(define-key map "v" 'tar-view)
@@ -731,10 +803,14 @@ tar-file's buffer."
(interactive "p")
(tar-next-line (- arg)))
+(defun tar-current-position ()
+ "Return the `tar-parse-info' index for the current line."
+ (count-lines (point-min) (line-beginning-position)))
+
(defun tar-current-descriptor (&optional noerror)
"Return the tar-descriptor of the current line, or signals an error."
;; I wish lines had plists, like in ZMACS...
- (or (nth (count-lines (point-min) (line-beginning-position))
+ (or (nth (tar-current-position)
tar-parse-info)
(if noerror
nil
@@ -948,6 +1024,37 @@ the current tar-entry."
(write-region start end to-file nil nil nil t)))
(message "Copied tar entry %s to %s" name to-file)))
+(defun tar-new-entry (filename &optional index)
+ "Insert a new empty regular file before point."
+ (interactive "*sFile name: ")
+ (let* ((buffer (current-buffer))
+ (index (or index (tar-current-position)))
+ (d-list (and (not (zerop index))
+ (nthcdr (+ -1 index) tar-parse-info)))
+ (pos (if d-list
+ (tar-header-data-end (car d-list))
+ (point-min)))
+ (new-descriptor
+ (tar-new-regular-file-header filename)))
+ ;; Update the data buffer; fill the missing descriptor fields.
+ (with-current-buffer tar-data-buffer
+ (goto-char pos)
+ (insert (tar-header-serialize new-descriptor t))
+ (setf (tar-header-data-start new-descriptor)
+ (copy-marker (point) nil)))
+ ;; Update tar-parse-info.
+ (if d-list
+ (setcdr d-list (cons new-descriptor (cdr d-list)))
+ (setq tar-parse-info (cons new-descriptor tar-parse-info)))
+ ;; Update the listing buffer.
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line index)
+ (let ((inhibit-read-only t))
+ (insert (tar-header-block-summarize new-descriptor) ?\n)))
+ ;; .
+ index))
+
(defun tar-flag-deleted (p &optional unflag)
"In Tar mode, mark this sub-file to be deleted from the tar file.
With a prefix argument, mark that many files."