[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] xwidget_mvp 028e24c 2/2: Merge branch 'master' into xwidge
|
From: |
Joakim Verona |
|
Subject: |
[Emacs-diffs] xwidget_mvp 028e24c 2/2: Merge branch 'master' into xwidget_mvp |
|
Date: |
Wed, 18 Feb 2015 15:31:09 +0000 |
branch: xwidget_mvp
commit 028e24c989de9f7dc511d56e35024490d0e21116
Merge: a0edaa5 81d89d8
Author: Joakim Verona <address@hidden>
Commit: Joakim Verona <address@hidden>
Merge branch 'master' into xwidget_mvp
---
ChangeLog | 5 +
configure.ac | 4 +-
lisp/ChangeLog | 122 ++++++++++++++++++++-
lisp/cedet/ChangeLog | 6 +
lisp/cedet/semantic/db-el.el | 8 +-
lisp/desktop.el | 7 +-
lisp/emacs-lisp/bytecomp.el | 14 ++--
lisp/emacs-lisp/cl-generic.el | 4 +-
lisp/emacs-lisp/cl-lib.el | 16 ---
lisp/emacs-lisp/cl-macs.el | 168 +++++++++++++++--------------
lisp/emacs-lisp/cl-preloaded.el | 30 +++++
lisp/emacs-lisp/easy-mmode.el | 25 ++++-
lisp/emacs-lisp/eieio-base.el | 2 +-
lisp/emacs-lisp/eieio-core.el | 33 +++----
lisp/emacs-lisp/eieio.el | 91 ++++++++--------
lisp/emacs-lisp/package-x.el | 2 +-
lisp/emacs-lisp/package.el | 109 ++++++++++++++-----
lisp/erc/ChangeLog | 5 +
lisp/erc/erc-spelling.el | 3 +-
lisp/files.el | 2 +-
lisp/gnus/ChangeLog | 10 ++
lisp/gnus/gnus-art.el | 3 +-
lisp/gnus/mm-decode.el | 12 ++
lisp/gnus/nnimap.el | 2 +
lisp/help-mode.el | 3 +-
lisp/net/eww.el | 8 +-
lisp/net/sasl-scram-rfc.el | 2 +-
lisp/net/tramp-sh.el | 2 +-
lisp/progmodes/python.el | 1 +
lisp/textmodes/flyspell.el | 8 +-
src/ChangeLog | 20 ++++
src/keyboard.c | 11 ++-
src/menu.c | 58 ++++++-----
src/xterm.c | 8 +-
test/ChangeLog | 5 +
test/automated/eieio-test-methodinvoke.el | 4 +-
test/automated/sasl-scram-rfc-tests.el | 2 +-
37 files changed, 552 insertions(+), 263 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index a574ac8..4365668 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2015-02-13 Jan Djärv <address@hidden>
+
+ * configure.ac: Set locallisppath to empty for NS self contained,
+ unless --enable-loadllisppath was given (Bug#19850).
+
2015-02-09 Paul Eggert <address@hidden>
* configure.ac (HAVE_LIBXML2): Add missing comma.
diff --git a/configure.ac b/configure.ac
index 7a341cd..452e4be 100644
--- a/configure.ac
+++ b/configure.ac
@@ -426,6 +426,7 @@ AC_ARG_ENABLE(ns-self-contained,
EN_NS_SELF_CONTAINED=$enableval,
EN_NS_SELF_CONTAINED=yes)
+locallisppathset=no
AC_ARG_ENABLE(locallisppath,
[AS_HELP_STRING([--enable-locallisppath=PATH],
[directories Emacs should search for lisp files specific
@@ -433,7 +434,7 @@ AC_ARG_ENABLE(locallisppath,
if test "${enableval}" = "no"; then
locallisppath=
elif test "${enableval}" != "yes"; then
- locallisppath=${enableval}
+ locallisppath=${enableval} locallisppathset=yes
fi)
AC_ARG_ENABLE(checking,
@@ -1874,6 +1875,7 @@ if test "${HAVE_NS}" = yes; then
infodir="\${ns_appresdir}/info"
mandir="\${ns_appresdir}/man"
lispdir="\${ns_appresdir}/lisp"
+ test "$locallisppathset" = no && locallisppath=""
INSTALL_ARCH_INDEP_EXTRA=
fi
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d0038f4..704ec34 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,117 @@
+2015-02-16 Kelly Dean <address@hidden>
+
+ * lisp/files.el (insert-file-contents-literally): Fix docstring typo.
+
+2015-02-16 Kelly Dean <address@hidden>
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode): Process macro
+ arguments correctly. (Bug#19685)
+ (define-minor-mode): Clarify docstring.
+ Clarify mode switch messages for minor modes. (Bug#19690)
+
+2015-02-16 Kelly Dean <address@hidden>
+
+ * emacs-lisp/package-x.el (package-upload-buffer-internal):
+ Create valid tar files. (Bug#19536)
+
+2015-02-16 Kelly Dean <address@hidden>
+
+ * desktop.el (desktop-read): Conditionally re-enable desktop autosave.
+ (Bug#19059)
+
+2015-02-16 Kelly Dean <address@hidden>
+
+ * help-mode.el (help-do-xref): Prevent duplicated display of Info
+ buffer, and prevent interference with existing buffer. (Bug#13190)
+
+2015-02-16 Fabián Ezequiel Gallina <address@hidden>
+
+ python.el: Do not deactivate mark on shell fontification. (Bug#19871)
+
+ * progmodes/python.el (python-shell-font-lock-post-command-hook):
+ Do not deactivate mark on fontification.
+
+2015-02-16 Ivan Shmakov <address@hidden>
+
+ * net/eww.el: Fix desktop support. (Bug#19226)
+ (eww-mode): Add autoload cookie.
+ (eww-restore-desktop): Use inhibit-read-only.
+
+ * net/eww.el (eww-suggest-uris): Add autoload cookie, so that
+ add-hook works correctly even if the file is not yet loaded.
+
+2015-02-16 Stefan Monnier <address@hidden>
+
+ * emacs-lisp/eieio.el (defclass): Use make-instance rather than
+ eieio-constructor.
+ (set-slot-value): Mark as obsolete.
+ (eieio-object-class-name): Improve call to eieio-class-name.
+ (eieio-slot-descriptor-name, eieio-class-slots): New functions.
+ (object-slots): Use it. Declare obsolete.
+ (eieio-constructor): Merge it with `make-instance'.
+ (initialize-instance): Use `dolist'.
+ (eieio-override-prin1, eieio-edebug-prin1-to-string):
+ Use eieio--class-print-name.
+
+ * emacs-lisp/eieio-core.el (eieio--class-print-name): New function.
+ (eieio-class-name): Make it do what the docstring claims.
+ (eieio-defclass-internal): Simplify since `prots' isn't used any more.
+ (eieio--slot-name-index): Simplify accordingly.
+ (eieio-barf-if-slot-unbound): Pass the class object rather than its
+ name to `slot-unbound'.
+
+ * emacs-lisp/eieio-base.el (make-instance): Add a method here rather
+ than on eieio-constructor.
+
+2015-02-16 Stefan Monnier <address@hidden>
+
+ * emacs-lisp/cl-macs.el (cl-defstruct): Keep type=nil by default.
+ * emacs-lisp/cl-preloaded.el (cl-struct-define): Add sanity checks
+ about relationship between `type', `named', and `slots'.
+ * emacs-lisp/cl-generic.el (cl--generic-struct-tagcode): Adjust to new
+ value of `cl-struct-type' property.
+
+2015-02-15 Jérémy Compostella <address@hidden>
+
+ * net/tramp-sh.el (tramp-remote-process-environment): Disable paging
+ with PAGER=cat. (Bug#19870)
+
+2015-02-14 Artur Malabarba <address@hidden>
+
+ * emacs-lisp/package.el (package-read-all-archive-contents):
+ Don't build the compatibility table.
+ (package-refresh-contents, package-initialize): Do build the
+ compatibility table.
+ (package--build-compatibility-table): New function.
+ (describe-package-1): Describe why a package is incompatible.
+
+2015-02-14 Stefan Monnier <address@hidden>
+
+ * emacs-lisp/cl-preloaded.el (cl-struct-define): Register as children
+ of the parent.
+ (cl--assertion-failed): New function.
+ (cl-assertion-failed): Move in from cl-lib.el.
+
+ * emacs-lisp/cl-macs.el (cl-defstruct): Don't generate code to register
+ as children of its parents.
+ (cl--make-type-test, cl--compiler-macro-typep): Remove functions.
+ (cl-typep): Reimplement using define-inline.
+ (cl-assert): Use cl--assertion-failed.
+ (cl-struct-slot-value): Use define-inline.
+
+ * emacs-lisp/cl-lib.el: Move autoloaded code to cl-preload.
+
+ * textmodes/flyspell.el (flyspell-word): Defvar (bug#19844).
+ (flyspell-generic-check-word-p): Mark as obsolete.
+
+2015-02-13 Artur Malabarba <address@hidden>
+
+ * emacs-lisp/package.el (package--compatibility-table): New var.
+ (package--add-to-compatibility-table): New function.
+ (package-read-all-archive-contents): Populate compatibility table.
+ (package--incompatible-p): Also look in dependencies.
+ (describe-package-1): Fix "incompat" handling.
+
2015-02-13 Lars Ingebrigtsen <address@hidden>
* net/rfc2104.el: Moved here from lisp/gnus.
@@ -6,8 +120,8 @@
* net/sasl-scram-rfc.el: New file.
- * net/sasl.el (sasl-mechanisms): Remove SCRAM-MD5. Add
- SCRAM-SHA-1 first.
+ * net/sasl.el (sasl-mechanisms): Remove SCRAM-MD5.
+ Add SCRAM-SHA-1 first.
(sasl-mechanism-alist): Remove SCRAM-MD5 entry. Add SCRAM-SHA-1
entry (bug#17636).
@@ -26,8 +140,8 @@
python.el: Allow killing shell buffer if process is dead. (Bug#19823)
- * progmodes/python.el (python-shell-font-lock-kill-buffer): Don't
- require a running process.
+ * progmodes/python.el (python-shell-font-lock-kill-buffer):
+ Don't require a running process.
(python-shell-font-lock-post-command-hook): Fontify only if the
shell process is running.
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog
index 6bbae7e..838a269 100644
--- a/lisp/cedet/ChangeLog
+++ b/lisp/cedet/ChangeLog
@@ -1,3 +1,9 @@
+2015-02-16 Stefan Monnier <address@hidden>
+
+ * semantic/db-el.el (semanticdb-elisp-sym->tag): Fix copy&paste error
+ (semanticdb-project-database => sym). Avoid eieio--class-public-a
+ when possible.
+
2015-02-04 Stefan Monnier <address@hidden>
Use cl-generic instead of EIEIO's defgeneric/defmethod.
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index e37b65a..b20a756 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -223,9 +223,11 @@ TOKTYPE is a hint to the type of tag desired."
(symbol-name sym)
"class"
(semantic-elisp-desymbolify
- ;; FIXME: This only gives the instance slots and ignores the
- ;; class-allocated slots.
- (eieio--class-public-a (find-class 'semanticdb-project-database)))
;; slots ;FIXME: eieio--
+ (let ((class (find-class sym)))
+ (if (fboundp 'eieio-slot-descriptor-name)
+ (mapcar #'eieio-slot-descriptor-name
+ (eieio-class-slots class))
+ (eieio--class-public-a class))))
(semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents
))
((not toktype)
diff --git a/lisp/desktop.el b/lisp/desktop.el
index c272490..b85d8b2 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -1136,7 +1136,8 @@ It returns t if a desktop file was loaded, nil otherwise."
(desktop-buffer-fail-count 0)
(owner (desktop-owner))
;; Avoid desktop saving during evaluation of desktop buffer.
- (desktop-save nil))
+ (desktop-save nil)
+ (desktop-autosave-was-enabled))
(if (and owner
(memq desktop-load-locked-desktop '(nil ask))
(or (null desktop-load-locked-desktop)
@@ -1152,6 +1153,8 @@ Using it may cause conflicts. Use it anyway? " owner)))))
;; Temporarily disable the autosave that will leave it
;; disabled when loading the desktop fails with errors,
;; thus not overwriting the desktop with broken contents.
+ (setq desktop-autosave-was-enabled
+ (memq 'desktop-auto-save-set-timer
window-configuration-change-hook))
(desktop-auto-save-disable)
;; Evaluate desktop buffer and remember when it was modified.
(load (desktop-full-file-name) t t t)
@@ -1205,7 +1208,7 @@ Using it may cause conflicts. Use it anyway? " owner)))))
(set-window-prev-buffers window nil)
(set-window-next-buffers window nil))))
(setq desktop-saved-frameset nil)
- (desktop-auto-save-enable)
+ (if desktop-autosave-was-enabled (desktop-auto-save-enable))
t))
;; No desktop file found.
(let ((default-directory desktop-dirname))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 548aaa9..e929c02 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1353,13 +1353,13 @@ extra args."
(let ((keyword-args (cdr (cdr (cdr (cdr form)))))
(name (cadr form)))
(or (not (eq (car-safe name) 'quote))
- (and (eq (car form) 'custom-declare-group)
- (equal name ''emacs))
- (plist-get keyword-args :group)
- (not (and (consp name) (eq (car name) 'quote)))
- (byte-compile-warn
- "%s for `%s' fails to specify containing group"
- (cdr (assq (car form)
+ (and (eq (car form) 'custom-declare-group)
+ (equal name ''emacs))
+ (plist-get keyword-args :group)
+ (not (and (consp name) (eq (car name) 'quote)))
+ (byte-compile-warn
+ "%s for `%s' fails to specify containing group"
+ (cdr (assq (car form)
'((custom-declare-group . defgroup)
(custom-declare-face . defface)
(custom-declare-variable . defcustom))))
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index c423286..ccd5bec 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -731,7 +731,7 @@ Can only be used from within the lexical body of a primary
or around method."
(defun cl--generic-struct-tagcode (type name)
(and (symbolp type)
(get type 'cl-struct-type)
- (or (eq 'vector (car (get type 'cl-struct-type)))
+ (or (null (car (get type 'cl-struct-type)))
(error "Can't dispatch on cl-struct %S: type is %S"
type (car (get type 'cl-struct-type))))
(or (equal '(cl-tag-slot) (car (get type 'cl-struct-slots)))
@@ -761,7 +761,7 @@ Can only be used from within the lexical body of a primary
or around method."
(let ((types (list (intern (substring (symbol-name tag) 10)))))
(while (get (car types) 'cl-struct-include)
(push (get (car types) 'cl-struct-include) types))
- (push 'cl-struct types) ;The "parent type" of all cl-structs.
+ (push 'cl-structure-object types) ;The "parent type" of all
cl-structs.
(nreverse types))))
;;; Dispatch on "system types".
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 0f53418..4b12495 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -731,22 +731,6 @@ If ALIST is non-nil, the new pairs are prepended to it."
;;; Miscellaneous.
-;;;###autoload
-(progn
- ;; The `assert' macro from the cl package signals
- ;; `cl-assertion-failed' at runtime so always define it.
- (define-error 'cl-assertion-failed (purecopy "Assertion failed"))
- ;; Make sure functions defined with cl-defsubst can be inlined even in
- ;; packages which do not require CL. We don't put an autoload cookie
- ;; directly on that function, since those cookies only go to cl-loaddefs.
- (autoload 'cl--defsubst-expand "cl-macs")
- ;; Autoload, so autoload.el and font-lock can use it even when CL
- ;; is not loaded.
- (put 'cl-defun 'doc-string-elt 3)
- (put 'cl-defmacro 'doc-string-elt 3)
- (put 'cl-defsubst 'doc-string-elt 3)
- (put 'cl-defstruct 'doc-string-elt 2))
-
(provide 'cl-lib)
(or (load "cl-loaddefs" 'noerror 'quiet)
;; When bootstrapping, cl-loaddefs hasn't been built yet!
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index eaec2c5..caaf768 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2488,19 +2488,13 @@ non-nil value, that slot cannot be set via `setf'.
(setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs))
type (car inc-type)
named (assq 'cl-tag-slot descs))
- (if (cadr inc-type) (setq tag name named t))
- (let ((incl include))
- (while incl
- (push `(cl-pushnew ',tag
- ,(intern (format "cl-struct-%s-tags" incl)))
- forms)
- (setq incl (get incl 'cl-struct-include)))))
+ (if (cadr inc-type) (setq tag name named t)))
(if type
(progn
(or (memq type '(vector list))
(error "Invalid :type specifier: %s" type))
(if named (setq tag name)))
- (setq type 'vector named 'true)))
+ (setq named 'true)))
(or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
(when (and (null predicate) named)
(setq predicate (intern (format "cl--struct-%s-p" name))))
@@ -2509,7 +2503,7 @@ non-nil value, that slot cannot be set via `setf'.
(length (memq (assq 'cl-tag-slot descs)
descs)))))
(cond
- ((eq type 'vector)
+ ((memq type '(nil vector))
`(and (vectorp cl-x)
(>= (length cl-x) ,(length descs))
(memq (aref cl-x ,pos) ,tag-symbol)))
@@ -2541,7 +2535,7 @@ non-nil value, that slot cannot be set via `setf'.
(list `(or ,pred-check
(error "%s accessing a non-%s"
',accessor ',name))))
- ,(if (eq type 'vector) `(aref cl-x ,pos)
+ ,(if (memq type '(nil vector)) `(aref cl-x ,pos)
(if (= pos 0) '(car cl-x)
`(nth ,pos cl-x))))
forms)
@@ -2599,7 +2593,7 @@ non-nil value, that slot cannot be set via `setf'.
(&cl-defs '(nil ,@descs) ,@args)
,@(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
'((declare (side-effect-free t))))
- (,type ,@make))
+ (,(or type #'vector) ,@make))
forms)))
(if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
;; Don't bother adding to cl-custom-print-functions since it's not used
@@ -2661,64 +2655,70 @@ Of course, we really can't know that for sure, so it's
just a heuristic."
(or (cdr (assq sym byte-compile-function-environment))
(cdr (assq sym byte-compile-macro-environment))))))
-(defun cl--make-type-test (val type)
- (pcase type
- ((and `(,name . ,args) (guard (get name 'cl-deftype-handler)))
- (cl--make-type-test val (apply (get name 'cl-deftype-handler)
- args)))
- (`(,(and name (or 'integer 'float 'real 'number))
- . ,(or `(,min ,max) pcase--dontcare))
- `(and ,(cl--make-type-test val name)
- ,(if (memq min '(* nil)) t
- (if (consp min) `(> ,val ,(car min))
- `(>= ,val ,min)))
- ,(if (memq max '(* nil)) t
- (if (consp max)
- `(< ,val ,(car max))
- `(<= ,val ,max)))))
- (`(,(and name (or 'and 'or 'not)) . ,args)
- (cons name (mapcar (lambda (x) (cl--make-type-test val x)) args)))
- (`(member . ,args)
- `(and (cl-member ,val ',args) t))
- (`(satisfies ,pred) `(funcall #',pred ,val))
- ((and (pred symbolp) (guard (get type 'cl-deftype-handler)))
- (cl--make-type-test val (funcall (get type 'cl-deftype-handler))))
- ((and (pred symbolp) (guard (get type 'cl-deftype-satisfies)))
- `(funcall #',(get type 'cl-deftype-satisfies) ,val))
- ((or 'nil 't) type)
- ('null `(null ,val))
- ('atom `(atom ,val))
- ('float `(floatp ,val))
- ('real `(numberp ,val))
- ('fixnum `(integerp ,val))
- ;; FIXME: Implement `base-char' and `extended-char'.
- ('character `(characterp ,val))
- ((pred symbolp)
- (let* ((name (symbol-name type))
- (namep (intern (concat name "p"))))
- (cond
- ((cl--macroexp-fboundp namep) (list namep val))
- ((cl--macroexp-fboundp
- (setq namep (intern (concat name "-p"))))
- (list namep val))
- ((cl--macroexp-fboundp type) (list type val))
- (t (error "Unknown type %S" type)))))
- (_ (error "Bad type spec: %s" type))))
-
-(defvar cl--object)
+(put 'null 'cl-deftype-satisfies #'null)
+(put 'atom 'cl-deftype-satisfies #'atom)
+(put 'real 'cl-deftype-satisfies #'numberp)
+(put 'fixnum 'cl-deftype-satisfies #'integerp)
+(put 'base-char 'cl-deftype-satisfies #'characterp)
+(put 'character 'cl-deftype-satisfies #'integerp)
+
+
;;;###autoload
-(defun cl-typep (object type) ; See compiler macro below.
- "Check that OBJECT is of type TYPE.
-TYPE is a Common Lisp-style type specifier."
- (declare (compiler-macro cl--compiler-macro-typep))
- (let ((cl--object object)) ;; Yuck!!
- (eval (cl--make-type-test 'cl--object type))))
-
-(defun cl--compiler-macro-typep (form val type)
- (if (macroexp-const-p type)
- (macroexp-let2 macroexp-copyable-p temp val
- (cl--make-type-test temp (cl--const-expr-val type)))
- form))
+(define-inline cl-typep (val type)
+ (inline-letevals (val)
+ (pcase (inline-const-val type)
+ ((and `(,name . ,args) (guard (get name 'cl-deftype-handler)))
+ (inline-quote
+ (cl-typep ,val ',(apply (get name 'cl-deftype-handler) args))))
+ (`(,(and name (or 'integer 'float 'real 'number))
+ . ,(or `(,min ,max) pcase--dontcare))
+ (inline-quote
+ (and (cl-typep ,val ',name)
+ ,(if (memq min '(* nil)) t
+ (if (consp min)
+ (inline-quote (> ,val ',(car min)))
+ (inline-quote (>= ,val ',min))))
+ ,(if (memq max '(* nil)) t
+ (if (consp max)
+ (inline-quote (< ,val ',(car max)))
+ (inline-quote (<= ,val ',max)))))))
+ (`(not ,type) (inline-quote (not (cl-typep ,val ',type))))
+ (`(,(and name (or 'and 'or)) . ,types)
+ (cond
+ ((null types) (inline-quote ',(eq name 'and)))
+ ((null (cdr types))
+ (inline-quote (cl-typep ,val ',(car types))))
+ (t
+ (let ((head (car types))
+ (rest `(,name . ,(cdr types))))
+ (cond
+ ((eq name 'and)
+ (inline-quote (and (cl-typep ,val ',head)
+ (cl-typep ,val ',rest))))
+ (t
+ (inline-quote (or (cl-typep ,val ',head)
+ (cl-typep ,val ',rest)))))))))
+ (`(member . ,args)
+ (inline-quote (and (memql ,val ',args) t)))
+ (`(satisfies ,pred) (inline-quote (funcall #',pred ,val)))
+ ((and (pred symbolp) type (guard (get type 'cl-deftype-handler)))
+ (inline-quote
+ (cl-typep ,val ',(funcall (get type 'cl-deftype-handler)))))
+ ((and (pred symbolp) type (guard (get type 'cl-deftype-satisfies)))
+ (inline-quote (funcall #',(get type 'cl-deftype-satisfies) ,val)))
+ ((and (or 'nil 't) type) (inline-quote ',type))
+ ((and (pred symbolp) type)
+ (let* ((name (symbol-name type))
+ (namep (intern (concat name "p"))))
+ (cond
+ ((cl--macroexp-fboundp namep) (inline-quote (funcall #',namep ,val)))
+ ((cl--macroexp-fboundp
+ (setq namep (intern (concat name "-p"))))
+ (inline-quote (funcall #',namep ,val)))
+ ((cl--macroexp-fboundp type) (inline-quote (funcall #',type ,val)))
+ (t (error "Unknown type %S" type)))))
+ (type (error "Bad type spec: %s" type)))))
+
;;;###autoload
(defmacro cl-check-type (form type &optional string)
@@ -2751,10 +2751,9 @@ omitted, a default message listing FORM itself is used."
(cdr form))))))
`(progn
(or ,form
- ,(if string
- `(error ,string ,@sargs ,@args)
- `(signal 'cl-assertion-failed
- (list ',form ,@sargs))))
+ (cl--assertion-failed
+ ',form ,@(if (or string sargs args)
+ `(,string (list ,@sargs) (list ,@args)))))
nil))))
;;; Compiler macros.
@@ -2962,23 +2961,26 @@ The type name can then be used in `cl-typecase',
`cl-check-type', etc."
(put ',name 'cl-deftype-handler
(cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body)))))
+(cl-deftype extended-char () `(and character (not base-char)))
+
;;; Additional functions that we can now define because we've defined
;;; `cl-defsubst' and `cl-typep'.
-(cl-defsubst cl-struct-slot-value (struct-type slot-name inst)
- ;; The use of `cl-defsubst' here gives us both a compiler-macro
- ;; and a gv-expander "for free".
+(define-inline cl-struct-slot-value (struct-type slot-name inst)
"Return the value of slot SLOT-NAME in INST of STRUCT-TYPE.
STRUCT and SLOT-NAME are symbols. INST is a structure instance."
(declare (side-effect-free t))
- (unless (cl-typep inst struct-type)
- (signal 'wrong-type-argument (list struct-type inst)))
- ;; We could use `elt', but since the byte compiler will resolve the
- ;; branch below at compile time, it's more efficient to use the
- ;; type-specific accessor.
- (if (eq (cl-struct-sequence-type struct-type) 'vector)
- (aref inst (cl-struct-slot-offset struct-type slot-name))
- (nth (cl-struct-slot-offset struct-type slot-name) inst)))
+ (inline-letevals (struct-type slot-name inst)
+ (inline-quote
+ (progn
+ (unless (cl-typep ,inst ,struct-type)
+ (signal 'wrong-type-argument (list ,struct-type ,inst)))
+ ;; We could use `elt', but since the byte compiler will resolve the
+ ;; branch below at compile time, it's more efficient to use the
+ ;; type-specific accessor.
+ (if (eq (cl-struct-sequence-type ,struct-type) 'vector)
+ (aref ,inst (cl-struct-slot-offset ,struct-type ,slot-name))
+ (nth (cl-struct-slot-offset ,struct-type ,slot-name) ,inst))))))
(run-hooks 'cl-macs-load-hook)
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index c9867b4..401d34b 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -28,11 +28,19 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defun cl-struct-define (name docstring parent type named slots children-sym
tag print-auto)
+ (cl-assert (or type (equal '(cl-tag-slot) (car slots))))
+ (cl-assert (or type (not named)))
(if (boundp children-sym)
(add-to-list children-sym tag)
(set children-sym (list tag)))
+ (let* ((parent-class parent))
+ (while parent-class
+ (add-to-list (intern (format "cl-struct-%s-tags" parent-class)) tag)
+ (setq parent-class (get parent-class 'cl-struct-include))))
;; If the cl-generic support, we need to be able to check
;; if a vector is a cl-struct object, without knowing its particular type.
;; So we use the (otherwise) unused function slots of the tag symbol
@@ -44,5 +52,27 @@
(if print-auto (put name 'cl-struct-print print-auto))
(if docstring (put name 'structure-documentation docstring)))
+;; The `assert' macro from the cl package signals
+;; `cl-assertion-failed' at runtime so always define it.
+(define-error 'cl-assertion-failed (purecopy "Assertion failed"))
+
+(defun cl--assertion-failed (form &optional string sargs args)
+ (if debug-on-error
+ (debug `(cl-assertion-failed ,form ,string ,@sargs))
+ (if string
+ (apply #'error string (append sargs args))
+ (signal 'cl-assertion-failed `(,form ,@sargs)))))
+
+;; Make sure functions defined with cl-defsubst can be inlined even in
+;; packages which do not require CL. We don't put an autoload cookie
+;; directly on that function, since those cookies only go to cl-loaddefs.
+(autoload 'cl--defsubst-expand "cl-macs")
+;; Autoload, so autoload.el and font-lock can use it even when CL
+;; is not loaded.
+(put 'cl-defun 'doc-string-elt 3)
+(put 'cl-defmacro 'doc-string-elt 3)
+(put 'cl-defsubst 'doc-string-elt 3)
+(put 'cl-defstruct 'doc-string-elt 2)
+
(provide 'cl-preloaded)
;;; cl-preloaded.el ends here
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index f7e8619..bd95a60 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -114,9 +114,12 @@ Optional KEYMAP is the default keymap bound to the mode
keymap.
BODY contains code to execute each time the mode is enabled or disabled.
It is executed after toggling the mode, and before running MODE-hook.
Before the actual body code, you can write keyword arguments, i.e.
- alternating keywords and values. These following special keywords
- are supported (other keywords are passed to `defcustom' if the minor
- mode is global):
+ alternating keywords and values. If you provide BODY, then you must
+ provide (even if just nil) INIT-VALUE, LIGHTER, and KEYMAP, or provide
+ at least one keyword argument, or both; otherwise, BODY would be
+ misinterpreted as the first omitted argument. The following special
+ keywords are supported (other keywords are passed to `defcustom' if
+ the minor mode is global):
:group GROUP Custom group name to use in all generated `defcustom' forms.
Defaults to MODE without the possible trailing \"-mode\".
@@ -159,7 +162,8 @@ For example, you could write
;; Allow skipping the first three args.
(cond
((keywordp init-value)
- (setq body `(,init-value ,lighter ,keymap ,@body)
+ (setq body (if keymap `(,init-value ,lighter ,keymap ,@body)
+ `(,init-value ,lighter))
init-value nil lighter nil keymap nil))
((keywordp lighter)
(setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
@@ -280,14 +284,23 @@ the mode if ARG is omitted or nil, and toggle it if ARG
is `toggle'.
(if (called-interactively-p 'any)
(progn
,(if (and globalp (symbolp mode))
+ ;; Unnecessary but harmless if mode set buffer-locally
`(customize-mark-as-set ',mode))
;; Avoid overwriting a message shown by the body,
;; but do overwrite previous messages.
(unless (and (current-message)
(not (equal ,last-message
(current-message))))
- (message ,(format "%s %%sabled" pretty-name)
- (if ,mode "en" "dis")))))
+ (let ((local
+ ,(if globalp
+ (if (symbolp mode)
+ `(if (local-variable-p ',mode)
+ " in current buffer"
+ "")
+ "")
+ " in current buffer")))
+ (message ,(format "%s %%sabled%%s" pretty-name)
+ (if ,mode "en" "dis") local)))))
,@(when after-hook `(,after-hook)))
(force-mode-line-update)
;; Return the new setting.
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index fcf02b9..1cc9f89 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -140,7 +140,7 @@ Multiple calls to `make-instance' will return this
object."))
A singleton is a class which will only ever have one instance."
:abstract t)
-(cl-defmethod eieio-constructor ((class (subclass eieio-singleton)) &rest
_slots)
+(cl-defmethod make-instance ((class (subclass eieio-singleton)) &rest _slots)
"Constructor for singleton CLASS.
NAME and SLOTS initialize the new object.
This constructor guarantees that no matter how many you request,
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index e71c54d..408922a 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -181,15 +181,15 @@ Currently under control of this var:
CLASS is a symbol." ;FIXME: Is it a vector or a symbol?
(and (symbolp class) (eieio--class-p (eieio--class-v class))))
+(defun eieio--class-print-name (class)
+ "Return a printed representation of CLASS."
+ (format "#<class %s>" (eieio-class-name class)))
+
(defun eieio-class-name (class)
"Return a Lisp like symbol name for CLASS."
- ;; FIXME: What's a "Lisp like symbol name"?
- ;; FIXME: CLOS returns a symbol, but the code returns a string.
- (if (eieio--class-p class) (setq class (eieio--class-symbol class)))
- (cl-check-type class class)
- ;; I think this is supposed to return a symbol, but to me CLASS is a symbol,
- ;; and I wanted a string. Arg!
- (format "#<class %s>" (symbol-name class)))
+ (setq class (eieio--class-object class))
+ (cl-check-type class eieio--class)
+ (eieio--class-symbol class))
(define-obsolete-function-alias 'class-name #'eieio-class-name "24.4")
(defalias 'eieio--class-constructor #'identity
@@ -317,7 +317,7 @@ See `defclass' for more information."
(newc (if (and oldc (not (eieio--class-default-object-cache oldc)))
;; The oldc class is a stub setup by
eieio-defclass-autoload.
;; Reuse it instead of creating a new one, so that existing
- ;; references are still valid.
+ ;; references stay valid.
oldc
(eieio--class-make cname)))
(groups nil) ;; list of groups id'd from slots
@@ -488,16 +488,10 @@ See `defclass' for more information."
;; Attach slot symbols into a hashtable, and store the index of
;; this slot as the value this table.
(let* ((cnt 0)
- (pubsyms (eieio--class-public-a newc))
- (prots (eieio--class-protection newc))
(oa (make-hash-table :test #'eq)))
- (while pubsyms
- (let ((newsym (list cnt)))
- (setf (gethash (car pubsyms) oa) newsym)
- (setq cnt (1+ cnt))
- (if (car prots) (setcdr newsym (car prots))))
- (setq pubsyms (cdr pubsyms)
- prots (cdr prots)))
+ (dolist (pubsym (eieio--class-public-a newc))
+ (setf (gethash pubsym oa) cnt)
+ (setq cnt (1+ cnt)))
(setf (eieio--class-symbol-hashtable newc) oa))
;; Set up a specialized doc string.
@@ -895,7 +889,7 @@ INSTANCE is the object being referenced. SLOTNAME is the
offending
slot. If the slot is ok, return VALUE.
Argument FN is the function calling this verifier."
(if (and (eq value eieio-unbound) (not eieio-skip-typecheck))
- (slot-unbound instance (eieio--object-class-name instance) slotname fn)
+ (slot-unbound instance (eieio--object-class-object instance) slotname fn)
value))
@@ -1029,8 +1023,7 @@ The slot is a symbol which is installed in CLASS by the
`defclass' call.
If SLOT is the value created with :initarg instead,
reverse-lookup that name, and recurse with the associated slot value."
;; Removed checks to outside this call
- (let* ((fsym (gethash slot (eieio--class-symbol-hashtable class)))
- (fsi (car fsym)))
+ (let* ((fsi (gethash slot (eieio--class-symbol-hashtable class))))
(if (integerp fsi)
(+ (eval-when-compile eieio--object-num-slots) fsi)
(let ((fn (eieio--initarg-to-attribute class slot)))
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 5260909..4f6b6d7 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -272,34 +272,9 @@ This method is obsolete."
;; but hide it so we don't trigger indefinitely.
`(,(car whole) (identity ,(car slots))
,@(cdr slots)))))))
- (apply #'eieio-constructor ',name slots))))))
+ (apply #'make-instance ',name slots))))))
-;;; CLOS style implementation of object creators.
-;;
-(defun make-instance (class &rest initargs)
- "Make a new instance of CLASS based on INITARGS.
-CLASS is a class symbol. For example:
-
- (make-instance 'foo)
-
- INITARGS is a property list with keywords based on the :initarg
-for each slot. For example:
-
- (make-instance 'foo :slot1 value1 :slotN valueN)
-
-Compatibility note:
-
-If the first element of INITARGS is a string, it is used as the
-name of the class.
-
-In EIEIO, the class' constructor requires a name for use when printing.
-`make-instance' in CLOS doesn't use names the way Emacs does, so the
-class is used as the name slot instead when INITARGS doesn't start with
-a string."
- (apply (eieio--class-constructor class) initargs))
-
-
;;; Get/Set slots in an object.
;;
(defmacro oref (obj slot)
@@ -311,6 +286,7 @@ created by the :initarg tag."
(defalias 'slot-value 'eieio-oref)
(defalias 'set-slot-value 'eieio-oset)
+(make-obsolete 'set-slot-value "use (setf (slot-value ..) ..) instead" "25.1")
(defmacro oref-default (obj slot)
"Get the default value of OBJ (maybe a class) for SLOT.
@@ -363,7 +339,7 @@ variable name of the same name as the slot."
(declare (obsolete eieio-named "25.1")))
(defun eieio-object-name (obj &optional extra)
- "Return a Lisp like symbol string for object OBJ.
+ "Return a printed representation for object OBJ.
If EXTRA, include that in the string returned to represent the symbol."
(cl-check-type obj eieio-object)
(format "#<%s %s%s>" (eieio--object-class-name obj)
@@ -402,7 +378,7 @@ If EXTRA, include that in the string returned to represent
the symbol."
(defun eieio-object-class-name (obj)
"Return a Lisp like symbol name for OBJ's class."
(cl-check-type obj eieio-object)
- (eieio-class-name (eieio--object-class-name obj)))
+ (eieio-class-name (eieio--object-class-object obj)))
(define-obsolete-function-alias
'object-class-name 'eieio-object-class-name "24.4")
@@ -463,10 +439,23 @@ The CLOS function `class-direct-subclasses' is aliased to
this function."
child (pop p)))
(if child t))))
+(defun eieio-slot-descriptor-name (slot) slot)
+
+(defun eieio-class-slots (class)
+ "Return list of slots available in instances of CLASS."
+ ;; FIXME: This only gives the instance slots and ignores the
+ ;; class-allocated slots.
+ ;; FIXME: It only gives the slot's *names* rather than actual
+ ;; slot descriptors.
+ (setq class (eieio--class-object class))
+ (cl-check-type class eieio--class)
+ (eieio--class-public-a class))
+
(defun object-slots (obj)
"Return list of slots available in OBJ."
+ (declare (obsolete eieio-class-slots "25.1"))
(cl-check-type obj eieio-object)
- (eieio--class-public-a (eieio--object-class-object obj)))
+ (eieio-class-slots (eieio--object-class-object obj)))
(defun eieio--class-slot-initarg (class slot) "Fetch from CLASS, SLOT's
:initarg."
(cl-check-type class eieio--class)
@@ -613,6 +602,9 @@ If SLOT is unbound, do nothing."
;;; Here are some CLOS items that need the CL package
;;
+;; FIXME: Shouldn't this be a more complex gv-expander which extracts the
+;; common code between oref and oset, so as to reduce the redundant work done
+;; in (push foo (oref bar baz)), like we do for the `nth' expander?
(gv-define-simple-setter eieio-oref eieio-oset)
@@ -636,20 +628,28 @@ This class is not stored in the `parent' slot of a class
vector."
(defalias 'standard-class 'eieio-default-superclass)
-(cl-defgeneric eieio-constructor (class &rest slots)
- "Default constructor for CLASS `eieio-default-superclass'.")
+(cl-defgeneric make-instance (class &rest initargs)
+ "Make a new instance of CLASS based on INITARGS.
+For example:
+
+ (make-instance 'foo)
+
+INITARGS is a property list with keywords based on the `:initarg'
+for each slot. For example:
+
+ (make-instance 'foo :slot1 value1 :slotN valueN)")
-(define-obsolete-function-alias 'constructor #'eieio-constructor "25.1")
+(define-obsolete-function-alias 'constructor #'make-instance "25.1")
-(cl-defmethod eieio-constructor
- ((class (subclass eieio-default-superclass)) &rest slots)
+(cl-defmethod make-instance
+ ((class (subclass eieio-default-superclass)) &rest slots)
"Default constructor for CLASS `eieio-default-superclass'.
-SLOTS are the initialization slots used by `shared-initialize'.
+SLOTS are the initialization slots used by `initialize-instance'.
This static method is called when an object is constructed.
It allocates the vector used to represent an EIEIO object, and then
-calls `shared-initialize' on that object."
+calls `initialize-instance' on that object."
(let* ((new-object (copy-sequence (eieio--class-default-object-cache
- (eieio--class-v class)))))
+ (eieio--class-object class)))))
(if (and slots
(let ((x (car slots)))
(or (stringp x) (null x))))
@@ -662,6 +662,7 @@ calls `shared-initialize' on that object."
;; Return the created object.
new-object))
+;; FIXME: CLOS uses "&rest INITARGS" instead.
(cl-defgeneric shared-initialize (obj slots)
"Set slots of OBJ with SLOTS which is a list of name/value pairs.
Called from the constructor routine.")
@@ -677,6 +678,7 @@ Called from the constructor routine."
(eieio-oset obj rn (car (cdr slots)))))
(setq slots (cdr (cdr slots)))))
+;; FIXME: CLOS uses "&rest INITARGS" instead.
(cl-defgeneric initialize-instance (this &optional slots)
"Construct the new object THIS based on SLOTS.")
@@ -693,9 +695,8 @@ dynamically set from SLOTS."
;; First, see if any of our defaults are `lambda', and
;; re-evaluate them and apply the value to our slots.
(let* ((this-class (eieio--object-class-object this))
- (slot (eieio--class-public-a this-class))
(defaults (eieio--class-public-d this-class)))
- (while slot
+ (dolist (slot (eieio--class-public-a this-class))
;; For each slot, see if we need to evaluate it.
;;
;; Paul Landes said in an email:
@@ -705,10 +706,9 @@ dynamically set from SLOTS."
;; > web.
(let ((dflt (eieio-default-eval-maybe (car defaults))))
(when (not (eq dflt (car defaults)))
- (eieio-oset this (car slot) dflt) ))
+ (eieio-oset this slot dflt) ))
;; Next.
- (setq slot (cdr slot)
- defaults (cdr defaults))))
+ (setq defaults (cdr defaults))))
;; Shared initialize will parse our slots for us.
(shared-initialize this slots))
@@ -742,7 +742,8 @@ Use `slot-boundp' to determine if a slot is bound or not.
In CLOS, the argument list is (CLASS OBJECT SLOT-NAME), but
EIEIO can only dispatch on the first argument, so the first two are swapped."
- (signal 'unbound-slot (list (eieio-class-name class) (eieio-object-name
object)
+ (signal 'unbound-slot (list (eieio-class-name class)
+ (eieio-object-name object)
slot-name fn)))
(cl-defgeneric clone (obj &rest params)
@@ -861,7 +862,7 @@ this object."
((consp thing)
(eieio-list-prin1 thing))
((eieio--class-p thing)
- (princ (eieio-class-name thing)))
+ (princ (eieio--class-print-name thing)))
(t (prin1 thing))))
(defun eieio-list-prin1 (list)
@@ -902,7 +903,7 @@ of `eq'."
Used as advice around `edebug-prin1-to-string', held in the
variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to
`prin1-to-string' when appropriate."
- (cond ((eieio--class-p object) (eieio-class-name object))
+ (cond ((eieio--class-p object) (eieio--class-print-name object))
((eieio-object-p object) (object-print object))
((and (listp object) (or (eieio--class-p (car object))
(eieio-object-p (car object))))
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index e0945d4..6955ce8 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -247,7 +247,7 @@ if it exists."
(concat (symbol-name pkg-name) "-readme.txt")
package-archive-upload-base)))
- (set-buffer pkg-buffer)
+ (set-buffer (if (eq file-type 'tar) tar-data-buffer pkg-buffer))
(write-region (point-min) (point-max)
(expand-file-name
(format "%s-%s.%s" pkg-name pkg-version extension)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 67e2f40..d8a4fc9 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -468,6 +468,19 @@ called via `package-initialize'. To change which packages
are
loaded and/or activated, customize `package-load-list'.")
(put 'package-alist 'risky-local-variable t)
+(defvar package--compatibility-table nil
+ "Hash table connecting package names to their compatibility.
+Each key is a symbol, the name of a package.
+
+The value is either nil, representing an incompatible package, or
+a version list, representing the highest compatible version of
+that package which is available.
+
+A package is considered incompatible if it requires an Emacs
+version higher than the one being used. To check for package
+\(in)compatibility, don't read this table directly, use
+`package--incompatible-p' which also checks dependencies.")
+
(defvar package-activated-list nil
;; FIXME: This should implicitly include all builtin packages.
"List of the names of currently activated packages.")
@@ -1675,6 +1688,12 @@ similar to an entry in `package-alist'. Save the cached
copy to
(epg-import-keys-from-file context file)
(message "Importing %s...done" (file-name-nondirectory file))))
+(defun package--build-compatibility-table ()
+ "Build `package--compatibility-table' with `package--mapc'."
+ ;; Build compat table.
+ (setq package--compatibility-table (make-hash-table :test 'eq))
+ (package--mapc #'package--add-to-compatibility-table))
+
;;;###autoload
(defun package-refresh-contents ()
"Download the ELPA archive description if needed.
@@ -1697,7 +1716,8 @@ makes them available for download."
(package--download-one-archive archive "archive-contents")
(error (message "Failed to download `%s' archive."
(car archive)))))
- (package-read-all-archive-contents))
+ (package-read-all-archive-contents)
+ (package--build-compatibility-table))
(defun package--find-non-dependencies ()
"Return a list of installed packages which are not dependencies.
@@ -1726,7 +1746,23 @@ If optional arg NO-ACTIVATE is non-nil, don't activate
packages."
(unless no-activate
(dolist (elt package-alist)
(package-activate (car elt))))
- (setq package--initialized t))
+ (setq package--initialized t)
+ ;; This uses `package--mapc' so it must be called after
+ ;; `package--initialized' is t.
+ (package--build-compatibility-table))
+
+(defun package--add-to-compatibility-table (pkg)
+ "If PKG is compatible (without dependencies), add to the compatibility table.
+PKG is a package-desc object.
+Only adds if its version is higher than what's already stored in
+the table."
+ (unless (package--incompatible-p pkg 'shallow)
+ (let* ((name (package-desc-name pkg))
+ (version (or (package-desc-version pkg) '(0)))
+ (table-version (gethash name package--compatibility-table)))
+ (when (or (not table-version)
+ (version-list-< table-version version))
+ (puthash name version package--compatibility-table)))))
;;;; Package description buffer.
@@ -1781,7 +1817,10 @@ If optional arg NO-ACTIVATE is non-nil, don't activate
packages."
(built-in (eq pkg-dir 'builtin))
(installable (and archive (not built-in)))
(status (if desc (package-desc-status desc) "orphan"))
+ (incompatible-reason (package--incompatible-p desc))
(signed (if desc (package-desc-signed desc))))
+ (when incompatible-reason
+ (setq status "incompatible"))
(prin1 name)
(princ " is ")
(princ (if (memq (aref status 0) '(?a ?e ?i ?o ?u)) "an " "a "))
@@ -1796,9 +1835,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate
packages."
(pkg-dir
(insert (propertize (if (member status '("unsigned" "dependency"))
"Installed"
- (if (equal status "incompat")
- "Incompatible"
- (capitalize status))) ;FIXME: Why
comment-face?
+ (capitalize status)) ;FIXME: Why comment-face?
'font-lock-face 'font-lock-comment-face))
(insert " in `")
;; Todo: Add button for uninstalling.
@@ -1814,6 +1851,12 @@ If optional arg NO-ACTIVATE is non-nil, don't activate
packages."
(if signed
(insert ".")
(insert " (unsigned).")))
+ (incompatible-reason
+ (insert (propertize "Incompatible" 'face font-lock-warning-face)
+ " because it depends on ")
+ (if (stringp incompatible-reason)
+ (insert "Emacs " incompatible-reason ".")
+ (insert "uninstallable packages.")))
(installable
(insert (capitalize status))
(insert " from " (format "%s" archive))
@@ -1834,19 +1877,22 @@ If optional arg NO-ACTIVATE is non-nil, don't activate
packages."
(setq reqs (if desc (package-desc-reqs desc)))
(when reqs
(insert " " (propertize "Requires" 'font-lock-face 'bold) ": ")
- (let ((first t)
- name vers text)
+ (let ((first t))
(dolist (req reqs)
- (setq name (car req)
- vers (cadr req)
- text (format "%s-%s" (symbol-name name)
- (package-version-join vers)))
- (cond (first (setq first nil))
- ((>= (+ 2 (current-column) (length text))
- (window-width))
- (insert ",\n "))
- (t (insert ", ")))
- (help-insert-xref-button text 'help-package name))
+ (let* ((name (car req))
+ (vers (cadr req))
+ (text (format "%s-%s" (symbol-name name)
+ (package-version-join vers)))
+ (reason (if (and (listp incompatible-reason)
+ (assq name incompatible-reason))
+ " (not available)" "")))
+ (cond (first (setq first nil))
+ ((>= (+ 2 (current-column) (length text) (length reason))
+ (window-width))
+ (insert ",\n "))
+ (t (insert ", ")))
+ (help-insert-xref-button text 'help-package name)
+ (insert reason)))
(insert "\n")))
(insert " " (propertize "Summary" 'font-lock-face 'bold)
": " (if desc (package-desc-summary desc)) "\n")
@@ -2059,21 +2105,32 @@ package PKG-DESC, add one. The alist is keyed with
PKG-DESC."
(defvar package--emacs-version-list (version-to-list emacs-version)
"`emacs-version', as a list.")
-(defun package--incompatible-p (pkg)
+(defun package--incompatible-p (pkg &optional shallow)
"Return non-nil if PKG has no chance of being installable.
PKG is a package-desc object.
-Return value is a string describing the reason why the package is
-incompatible.
-Currently, this only checks if PKG depends on a higher
-`emacs-version' than the one being used."
+If SHALLOW is non-nil, this only checks if PKG depends on a
+higher `emacs-version' than the one being used. Otherwise, also
+checks the viability of dependencies, according to
+`package--compatibility-table'.
+
+If PKG requires an incompatible Emacs version, the return value
+is this version (as a string).
+If PKG requires incompatible packages, the return value is a list
+of these dependencies, similar to the list returned by
+`package-desc-reqs'."
(let* ((reqs (package-desc-reqs pkg))
(version (cadr (assq 'emacs reqs))))
(if (and version (version-list-< package--emacs-version-list version))
- (format "`%s' requires Emacs %s, but current version is %s"
- (package-desc-full-name pkg)
- (package-version-join version)
- emacs-version))))
+ (package-version-join version)
+ (unless shallow
+ (let (out)
+ (dolist (dep (package-desc-reqs pkg) out)
+ (let ((dep-name (car dep)))
+ (unless (eq 'emacs dep-name)
+ (let ((cv (gethash dep-name package--compatibility-table)))
+ (when (version-list-< (or cv '(0)) (or (cadr dep) '(0)))
+ (push dep out)))))))))))
(defun package-desc-status (pkg-desc)
(let* ((name (package-desc-name pkg-desc))
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index 44971cc..4c1c843 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,3 +1,8 @@
+2015-02-14 Stefan Monnier <address@hidden>
+
+ * erc-spelling.el (erc-spelling-init):
+ Use flyspell-generic-check-word-predicate.
+
2015-01-28 Dima Kogan <address@hidden>
* erc-backend.el (define-erc-response-handler): Give hook-name
diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el
index e2ddb04..0cba956 100644
--- a/lisp/erc/erc-spelling.el
+++ b/lisp/erc/erc-spelling.el
@@ -71,7 +71,7 @@ The current buffer is given by BUFFER."
(if dicts
(cadr (car dicts))
(erc-with-server-buffer ispell-local-dictionary)))))
- (setq flyspell-generic-check-word-p 'erc-spelling-flyspell-verify)
+ (setq flyspell-generic-check-word-predicate #'erc-spelling-flyspell-verify)
(flyspell-mode 1)))
(defun erc-spelling-unhighlight-word (word)
@@ -85,6 +85,7 @@ The cadr is the beginning and the caddr is the end."
(defun erc-spelling-flyspell-verify ()
"Flyspell only the input line, nothing else."
+ ;; FIXME: Don't use `flyspell-word'!
(let ((word-data (and (boundp 'flyspell-word)
flyspell-word)))
(when word-data
diff --git a/lisp/files.el b/lisp/files.el
index 5e80cb7..8336979 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2110,7 +2110,7 @@ Do you want to revisit the file normally now? ")
(defun insert-file-contents-literally (filename &optional visit beg end
replace)
"Like `insert-file-contents', but only reads in the file literally.
A buffer may be modified in several ways after reading into the buffer,
-to Emacs features such as format decoding, character code
+due to Emacs features such as format decoding, character code
conversion, `find-file-hook', automatic uncompression, etc.
This function ensures that none of these modifications will take place."
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 67929a3..7910d74 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,13 @@
+2015-02-14 Lars Ingebrigtsen <address@hidden>
+
+ * nnimap.el (nnimap-retrieve-headers): If the server closes connection
+ during header retrieval, error out instead of interpreting the data in
+ the buffer as the only messages there. This way, we don't mark
+ articles as read on a server hangup (bug#19035).
+
+ * mm-decode.el (mm-head-p): New function.
+ (mm-display-part): Go to a blank line when inserting parts internally.
+
2015-02-13 Lars Ingebrigtsen <address@hidden>
* gnus-msg.el (gnus-msg-mail): Don't let-bind `gnus-newsgroup-name' so
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index b3121bf..8503095 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -5505,7 +5505,8 @@ If no internal viewer is available, use an external
viewer."
(gnus-mime-view-part-as-type
nil (lambda (type) (mm-inlinable-p handle type)))
(when handle
- (gnus-bind-safe-url-regexp (mm-display-part handle))))))
+ (gnus-bind-safe-url-regexp
+ (mm-display-part handle nil t))))))
(defun gnus-mime-action-on-part (&optional action)
"Do something with the MIME attachment at \(point\)."
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 3fdcdba..459c793 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -791,6 +791,14 @@ MIME-Version header before proceeding."
(autoload 'mailcap-parse-mailcaps "mailcap")
(autoload 'mailcap-mime-info "mailcap")
+(defun mm-head-p (&optional point)
+ "Return non-nil if point is in the article header."
+ (let ((point (or point (point))))
+ (save-excursion
+ (goto-char point)
+ (and (not (re-search-backward "^$" nil t))
+ (re-search-forward "^$" nil t)))))
+
(defun mm-display-part (handle &optional no-default force)
"Display the MIME part represented by HANDLE.
Returns nil if the part is removed; inline if displayed inline;
@@ -824,6 +832,10 @@ external if displayed external."
'inline)
((and (mm-inlinable-p ehandle)
(mm-inlined-p ehandle))
+ (when force
+ (if (mm-head-p)
+ (re-search-forward "^$" nil t)
+ (forward-line 1)))
(mm-display-inline handle)
'inline)
((or method
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index e7f91b7..4a9ca74 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -196,6 +196,8 @@ textual parts.")
(nnimap-article-ranges (gnus-compress-sequence articles))
(nnimap-header-parameters))
t)
+ (unless (process-live-p (get-buffer-process (current-buffer)))
+ (error "Server closed connection"))
(nnimap-transform-headers)
(nnheader-remove-cr-followed-by-lf))
(insert-buffer-substring
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 564362a..b8b129d 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -739,7 +739,8 @@ Things are set up properly so that the resulting
help-buffer has
a proper [back] button."
;; There is a reference at point. Follow it.
(let ((help-xref-following t))
- (apply function args)))
+ (apply function (if (eq function 'info)
+ (append args (list (generate-new-buffer-name
"*info*"))) args))))
;; The doc string is meant to explain what buttons do.
(defun help-follow-mouse ()
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index c401701..b7ee065 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -60,6 +60,7 @@
:group 'eww
:type 'string)
+;;;###autoload
(defcustom eww-suggest-uris
'(eww-links-at-point
url-get-url-at-point
@@ -686,6 +687,8 @@ the like."
map)
"Tool bar for `eww-mode'.")
+;; Autoload cookie needed by desktop.el.
+;;;###autoload
(define-derived-mode eww-mode special-mode "eww"
"Mode for browsing the web."
(setq-local eww-data (list :title ""))
@@ -1877,8 +1880,9 @@ Otherwise, the restored buffer will contain a prompt to
do so by using
(case eww-restore-desktop
((t auto) (eww (plist-get eww-data :url)))
((zerop (buffer-size))
- (insert (substitute-command-keys
- eww-restore-reload-prompt))))))
+ (let ((inhibit-read-only t))
+ (insert (substitute-command-keys
+ eww-restore-reload-prompt)))))))
;; .
(current-buffer)))
diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el
index 3d86da4..6c8c009 100644
--- a/lisp/net/sasl-scram-rfc.el
+++ b/lisp/net/sasl-scram-rfc.el
@@ -1,6 +1,6 @@
;;; sasl-scram-rfc.el --- SCRAM-SHA-1 module for the SASL client framework
-*- lexical-binding: t; -*-
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; Author: Magnus Henoch <address@hidden>
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 45050cd..f3fdb63 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -475,7 +475,7 @@ as given in your `~/.profile'."
,(format "TERM=%s" tramp-terminal-type)
"EMACS=t" ;; Deprecated.
,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
- "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=\"\""
+ "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=cat"
"autocorrect=" "correct=")
"List of environment variables to be set on the remote host.
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 2026609..4420faf 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -2360,6 +2360,7 @@ goes wrong and syntax highlighting in the shell gets
messed up."
(process-live-p (get-buffer-process (current-buffer))))
(let* ((input (buffer-substring-no-properties
prompt-end (point-max)))
+ (deactivate-mark nil)
(start-pos prompt-end)
(buffer-undo-list t)
(font-lock-buffer-pos nil)
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 91a43f0..ffaf7e7 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -304,8 +304,8 @@ Returns t to continue checking, nil otherwise.
Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate'
property of the major mode name.")
(make-variable-buffer-local 'flyspell-generic-check-word-predicate)
-(defvaralias 'flyspell-generic-check-word-p
- 'flyspell-generic-check-word-predicate)
+(define-obsolete-variable-alias 'flyspell-generic-check-word-p
+ 'flyspell-generic-check-word-predicate "25.1")
;;*--- mail mode -------------------------------------------------------*/
(put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
@@ -398,7 +398,7 @@ like <img alt=\"Some thing.\">."
"Turn on `flyspell-mode' for comments and strings."
(interactive)
(setq flyspell-generic-check-word-predicate
- 'flyspell-generic-progmode-verify)
+ #'flyspell-generic-progmode-verify)
(flyspell-mode 1)
(run-hooks 'flyspell-prog-mode-hook))
@@ -1040,6 +1040,8 @@ Mostly we check word delimiters."
(goto-char (1+ p)))))
r)))
+(defvar flyspell-word) ;Backward compatibility; some predicates made use of it!
+
;;*---------------------------------------------------------------------*/
;;* flyspell-word ... */
;;*---------------------------------------------------------------------*/
diff --git a/src/ChangeLog b/src/ChangeLog
index 6d246fb..8a3b534 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,23 @@
+2015-02-18 Oscar Fuentes <address@hidden>
+
+ * keyboard.c (read_char): When there is an input method function,
+ do not restore the echo area if a prefix argument is being
+ introduced. (Bug#19875)
+
+2015-02-16 Kelly Dean <address@hidden>
+
+ * src/keyboard.c (timer_check_2): Fix incorrect comment.
+
+2015-02-14 Martin Rudalics <address@hidden>
+
+ * xterm.c (x_frame_normalize_before_maximize): Fix doc-string.
+ Suggested by Alan Mackenzie <address@hidden>.
+
+2015-02-14 Eli Zaretskii <address@hidden>
+
+ * menu.c (Fx_popup_menu) [HAVE_X_WINDOWS]: Call
+ x_relative_mouse_position only for X frames. (Bug#19862)
+
2015-02-13 Paul Eggert <address@hidden>
Better support for future plugins
diff --git a/src/keyboard.c b/src/keyboard.c
index 995c03c..7a458a4 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -3095,7 +3095,14 @@ read_char (int commandflag, Lisp_Object map,
cancel_echoing ();
ok_to_echo_at_next_pause = saved_ok_to_echo;
- kset_echo_string (current_kboard, saved_echo_string);
+ /* Do not restore the echo area string when the user is
+ introducing a prefix argument. Otherwise we end with
+ repetitions of the partially introduced prefix
+ argument. (bug#19875) */
+ if (NILP (intern ("prefix-arg")))
+ {
+ kset_echo_string (current_kboard, saved_echo_string);
+ }
current_kboard->echo_after_prompt = saved_echo_after_prompt;
if (saved_immediate_echo)
echo_now ();
@@ -4448,7 +4455,7 @@ timer_check_2 (Lisp_Object timers, Lisp_Object
idle_timers)
/* Set TIMER and TIMER_DIFFERENCE
based on the next ordinary timer.
TIMER_DIFFERENCE is the distance in time from NOW to when
- this timer becomes ripe (negative if it's already ripe).
+ this timer becomes ripe.
Skip past invalid timers and timers already handled. */
if (CONSP (timers))
{
diff --git a/src/menu.c b/src/menu.c
index 5a8ea34..e925f29 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -1243,35 +1243,39 @@ no quit occurs and `x-popup-menu' returns nil. */)
/* Use the mouse's current position. */
struct frame *new_f = SELECTED_FRAME ();
#ifdef HAVE_X_WINDOWS
- /* Can't use mouse_position_hook for X since it returns
- coordinates relative to the window the mouse is in,
- we need coordinates relative to the edit widget always. */
- if (new_f != 0)
+ if (FRAME_X_P (new_f))
{
- int cur_x, cur_y;
-
- x_relative_mouse_position (new_f, &cur_x, &cur_y);
- /* cur_x/y may be negative, so use make_number. */
- x = make_number (cur_x);
- y = make_number (cur_y);
+ /* Can't use mouse_position_hook for X since it returns
+ coordinates relative to the window the mouse is in,
+ we need coordinates relative to the edit widget always. */
+ if (new_f != 0)
+ {
+ int cur_x, cur_y;
+
+ x_relative_mouse_position (new_f, &cur_x, &cur_y);
+ /* cur_x/y may be negative, so use make_number. */
+ x = make_number (cur_x);
+ y = make_number (cur_y);
+ }
+ }
+ else
+#endif /* HAVE_X_WINDOWS */
+ {
+ Lisp_Object bar_window;
+ enum scroll_bar_part part;
+ Time time;
+ void (*mouse_position_hook) (struct frame **, int,
+ Lisp_Object *,
+ enum scroll_bar_part *,
+ Lisp_Object *,
+ Lisp_Object *,
+ Time *) =
+ FRAME_TERMINAL (new_f)->mouse_position_hook;
+
+ if (mouse_position_hook)
+ (*mouse_position_hook) (&new_f, 1, &bar_window,
+ &part, &x, &y, &time);
}
-
-#else /* not HAVE_X_WINDOWS */
- Lisp_Object bar_window;
- enum scroll_bar_part part;
- Time time;
- void (*mouse_position_hook) (struct frame **, int,
- Lisp_Object *,
- enum scroll_bar_part *,
- Lisp_Object *,
- Lisp_Object *,
- Time *) =
- FRAME_TERMINAL (new_f)->mouse_position_hook;
-
- if (mouse_position_hook)
- (*mouse_position_hook) (&new_f, 1, &bar_window,
- &part, &x, &y, &time);
-#endif /* not HAVE_X_WINDOWS */
if (new_f != 0)
XSETFRAME (window, new_f);
diff --git a/src/xterm.c b/src/xterm.c
index 535500d..0213812 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -11743,9 +11743,11 @@ default is nil, which is the same as `super'. */);
DEFVAR_BOOL ("x-frame-normalize-before-maximize",
x_frame_normalize_before_maximize,
doc: /* Non-nil means normalize frame before maximizing.
-If this variable is t, Emacs asks the window manager to give the frame
-intermediately its normal size whenever changing from a full-height or
-full-width state to the fully maximized one and vice versa.
+If this variable is t, Emacs first asks the window manager to give the
+frame its normal size, and only then the final state, whenever changing
+from a full-height, full-width or full-both state to the maximized one
+or when changing from the maximized to the full-height or full-width
+state.
Set this variable only if your window manager cannot handle the
transition between the various maximization states. */);
diff --git a/test/ChangeLog b/test/ChangeLog
index 29b7c7d..87425a6 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,8 @@
+2015-02-16 Stefan Monnier <address@hidden>
+
+ * automated/eieio-test-methodinvoke.el (make-instance): Add methods
+ here rather than on eieio-constructor.
+
2015-02-13 Magnus Henoch <address@hidden>
* automated/sasl-scram-rfc-tests.el: New file.
diff --git a/test/automated/eieio-test-methodinvoke.el
b/test/automated/eieio-test-methodinvoke.el
index da5f59a..62f5603 100644
--- a/test/automated/eieio-test-methodinvoke.el
+++ b/test/automated/eieio-test-methodinvoke.el
@@ -179,12 +179,12 @@
(if (next-method-p) (call-next-method))
)
-(defmethod eieio-constructor :STATIC ((p C-base2) &rest args)
+(defmethod make-instance :STATIC ((p C-base2) &rest args)
(eieio-test-method-store :STATIC 'C-base2)
(if (next-method-p) (call-next-method))
)
-(defmethod eieio-constructor :STATIC ((p C) &rest args)
+(defmethod make-instance :STATIC ((p C) &rest args)
(eieio-test-method-store :STATIC 'C)
(call-next-method)
)
diff --git a/test/automated/sasl-scram-rfc-tests.el
b/test/automated/sasl-scram-rfc-tests.el
index c747e5f..46b139b 100644
--- a/test/automated/sasl-scram-rfc-tests.el
+++ b/test/automated/sasl-scram-rfc-tests.el
@@ -1,6 +1,6 @@
;;; sasl-scram-rfc-tests.el --- tests for SCRAM-SHA-1 -*-
lexical-binding: t; -*-
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; Author: Magnus Henoch <address@hidden>