[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] xwidget fee879f: Merge branch 'master' into xwidget
|
From: |
Joakim Verona |
|
Subject: |
[Emacs-diffs] xwidget fee879f: Merge branch 'master' into xwidget |
|
Date: |
Mon, 19 Jan 2015 23:55:04 +0000 |
branch: xwidget
commit fee879f0a00bbe3f3389509874ee30a9cbc24cd4
Merge: 395a90f fb6462f
Author: Joakim Verona <address@hidden>
Commit: Joakim Verona <address@hidden>
Merge branch 'master' into xwidget
---
etc/NEWS | 2 +
lisp/ChangeLog | 79 +++++++++-
lisp/cus-dep.el | 3 +-
lisp/emacs-lisp/cl-generic.el | 27 +++-
lisp/emacs-lisp/eieio-core.el | 25 +++
lisp/emacs-lisp/eieio-generic.el | 2 +-
lisp/emacs-lisp/eieio.el | 11 ++
lisp/emacs-lisp/package.el | 14 +-
lisp/ido.el | 233 ++++++++++++++---------------
lisp/progmodes/xref.el | 56 +++++---
src/ChangeLog | 36 +++++
src/alloc.c | 6 +-
src/callint.c | 10 +-
src/coding.c | 9 +-
src/dispnew.c | 12 ++
src/eval.c | 11 +-
src/fileio.c | 17 +--
src/fns.c | 13 +-
src/font.c | 7 +-
src/fringe.c | 7 +-
src/lisp.h | 24 +++-
src/xdisp.c | 3 +
test/ChangeLog | 13 ++
test/automated/Makefile.in | 4 +-
test/automated/cl-generic-tests.el | 31 +++--
test/automated/eieio-test-methodinvoke.el | 7 +-
26 files changed, 442 insertions(+), 220 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index be283bb..4551c9c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -203,6 +203,8 @@ the old behavior -- *shell* buffer displays in current
window -- use
** EIEIO
*** The `:protection' slot option is not obeyed any more.
+*** The `newname' argument to constructors is optional&deprecated.
+If you need your objects to be named, do it by inheriting from `eieio-named'.
*** The <class>-list-p and <class>-child-p functions are declared obsolete.
*** The <class> variables are declared obsolete.
*** The <initarg> variables are declared obsolete.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 680adc7..b1a3a73 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,74 @@
+2015-01-19 Dmitry Gutov <address@hidden>
+
+ * ido.el: Update Customization instructions.
+
+2015-01-19 Jonas Bernoulli <address@hidden>
+
+ Define Ido keymaps once (bug#17000).
+ * ido.el (ido-common-completion-map)
+ (ido-file-dir-completion-map)
+ (ido-file-completion-map, ido-buffer-completion-map): Set up key
+ bindings when each variable is defined.
+ (ido-completion-map): Move definition.
+ (ido-init-completion-maps): Noop.
+ (ido-common-initialization): Don't call it.
+ (ido-setup-completion-map): Improve doc-string, cleanup.
+
+2015-01-19 Ivan Shmakov <address@hidden>
+
+ * cus-dep.el (custom-make-dependencies): Ensure that
+ default-directory is interpreted as a directory (see bug#19140.)
+
+2015-01-19 Dmitry Gutov <address@hidden>
+
+ * progmodes/xref.el (xref--display-position):
+ Set `other-window-scroll-buffer'.
+ (xref-goto-xref): Use `user-error'.
+
+2015-01-19 Dmitry Gutov <address@hidden>
+
+ * progmodes/xref.el (xref--display-history): New variable.
+ (xref--window-configuration): Remove.
+ (xref--save-to-history): New function.
+ (xref--display-position): Use it. Add new argument.
+ (xref--restore-window-configuration): Remove.
+ (xref--show-location, xref-show-location-at-point): Update
+ accordingly.
+ (xref--xref-buffer-mode): Don't use `pre-command-hook'.
+ (xref--quit): New command.
+ (xref-goto-xref): Use it.
+ (xref--xref-buffer-mode-map): Bind `q' to it.
+
+2015-01-18 Dmitry Gutov <address@hidden>
+
+ * progmodes/xref.el (xref-goto-xref): Perform the jump even inside
+ indentation or at eol.
+
+2015-01-18 Stefan Monnier <address@hidden>
+
+ * emacs-lisp/eieio-core.el: Add `subclass' specializer for cl-generic.
+ (eieio--generic-subclass-tagcode, eieio--generic-subclass-tag-types):
+ New functions.
+ (cl-generic-tagcode-function, cl-generic-tag-types-function): Use them.
+
+ * emacs-lisp/eieio.el (defclass): Add obsolescence warning for the
+ `newname' argument.
+
+ * emacs-lisp/cl-generic.el (cl-generic-define-method): Correctly handle
+ introduction of a new dispatch argument.
+ (cl--generic-cache-miss): Handle dispatch on an argument which was not
+ considered as dispatchable for this method.
+ (cl-defmethod): Warn when adding a method to an obsolete generic
function.
+ (cl--generic-lambda): Make sure it works if cl-lib is not yet loaded.
+
+ * emacs-lisp/eieio-generic.el (eieio--defgeneric-init-form): Use
autoloadp.
+
+2015-01-18 Artur Malabarba <address@hidden>
+
+ * emacs-lisp/package.el (package--append-to-alist): Rename from
+ `package--add-to-alist'
+ Updated docstring due to new name.
+
2015-01-18 Leo Liu <address@hidden>
* emacs-lisp/cl-extra.el (cl-subseq): Use seq-subseq and fix
@@ -132,8 +203,8 @@
2015-01-16 Artur Malabarba <address@hidden>
* emacs-lisp/package.el (package--read-pkg-desc):
- New function. Read a `define-package' form in current buffer. Return
- the pkg-desc, with desc-kind set to KIND.
+ New function. Read a `define-package' form in current buffer.
+ Return the pkg-desc, with desc-kind set to KIND.
(package-dir-info): New function. Find package information for a
directory. The return result is a `package-desc'.
(package-install-from-buffer): Install packages from dired buffer.
@@ -856,8 +927,8 @@
2014-12-27 Eli Zaretskii <address@hidden>
* language/misc-lang.el (composition-function-table): Add Syriac
- characters and also ZWJ/ZWNJ. See
- http://lists.gnu.org/archive/html/help-gnu-emacs/2014-12/msg00248.html
+ characters and also ZWJ/ZWNJ.
+ See
http://lists.gnu.org/archive/html/help-gnu-emacs/2014-12/msg00248.html
for the details.
2014-12-27 Fabián Ezequiel Gallina <address@hidden>
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index 453b15d..b8a9eb8 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -62,7 +62,8 @@ Usage: emacs -batch -l ./cus-dep.el -f
custom-make-dependencies DIRS"
(while (setq subdir (pop command-line-args-left))
(message "Directory %s" subdir)
(let ((files (directory-files subdir nil "\\`[^=.].*\\.el\\'"))
- (default-directory (expand-file-name subdir))
+ (default-directory
+ (file-name-as-directory (expand-file-name subdir)))
(preloaded (concat "\\`\\(\\./+\\)?"
(regexp-opt preloaded-file-list t)
"\\.el\\'")))
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 819e2e9..544f1fa 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -212,13 +212,13 @@ This macro can only be used within the lexical scope of a
cl-generic method."
(macroenv (cons `(cl-generic-current-method-specializers
. ,(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)
- (require 'cl-lib) ;Needed to expand `cl-flet'.
(let* ((doc-string (and doc-string (stringp (car body))
(pop body)))
(cnm (make-symbol "cl--cnm"))
@@ -287,6 +287,13 @@ which case this method will be invoked when the argument
is `eql' to VAL.
(cadr name))))
(setq name setter)
code))
+ ,(and (get name 'byte-obsolete-info)
+ (or (not (fboundp 'byte-compile-warning-enabled-p))
+ (byte-compile-warning-enabled-p 'obsolete))
+ (let* ((obsolete (get name 'byte-obsolete-info)))
+ (macroexp--warn-and-return
+ (macroexp--obsolete-warning name obsolete "generic function")
+ nil)))
(cl-generic-define-method ',name ',qualifiers ',args
,uses-cnm ,fun)))))
@@ -308,13 +315,14 @@ which case this method will be invoked when the argument
is `eql' to VAL.
(dolist (specializer specializers)
(let* ((tagcode (funcall cl-generic-tagcode-function specializer 'arg))
(x (assq i dispatches)))
- (if (not x)
- (setf (cl--generic-dispatches generic)
- (setq dispatches (cons (list i tagcode) dispatches)))
- (unless (member tagcode (cdr x))
- (setf (cdr x)
- (nreverse (sort (cons tagcode (cdr x))
- #'car-less-than-car)))))
+ (unless x
+ (setq x (list i (funcall cl-generic-tagcode-function t 'arg)))
+ (setf (cl--generic-dispatches generic)
+ (setq dispatches (cons x dispatches))))
+ (unless (member tagcode (cdr x))
+ (setf (cdr x)
+ (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)
@@ -478,7 +486,8 @@ for all those different tags in the method-cache.")
(let ((types (apply #'append (mapcar cl-generic-tag-types-function tags)))
(methods '()))
(dolist (method-desc (cl--generic-method-table generic))
- (let ((m (member (nth dispatch-arg (caar method-desc)) types)))
+ (let* ((specializer (or (nth dispatch-arg (caar method-desc)) t))
+ (m (member specializer types)))
(when m
(push (cons (length m) method-desc) methods))))
;; Sort the methods, most specific first.
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index a82e887..e4221e4 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -1227,6 +1227,8 @@ method invocation orders of the involved classes."
(require 'cl-generic)
+;;;; General support to dispatch based on the type of the argument.
+
(add-function :before-until cl-generic-tagcode-function
#'eieio--generic-tagcode)
(defun eieio--generic-tagcode (type name)
@@ -1246,6 +1248,29 @@ method invocation orders of the involved classes."
(mapcar #'eieio--class-symbol
(eieio--class-precedence-list (symbol-value tag)))))
+;;;; Dispatch for arguments which are classes.
+
+;; Since EIEIO does not support metaclasses, users can't easily use the
+;; "dispatch on argument type" for class arguments. That's why EIEIO's
+;; `defmethod' added the :static qualifier. For cl-generic, such a qualifier
+;; would not make much sense (e.g. to which argument should it apply?).
+;; Instead, we add a new "subclass" specializer.
+
+(add-function :before-until cl-generic-tagcode-function
+ #'eieio--generic-subclass-tagcode)
+(defun eieio--generic-subclass-tagcode (type name)
+ (when (eq 'subclass (car-safe type))
+ `(60 . (and (symbolp ,name) (eieio--class-v ,name)))))
+
+(add-function :before-until cl-generic-tag-types-function
+ #'eieio--generic-subclass-tag-types)
+(defun eieio--generic-subclass-tag-types (tag)
+ (when (eieio--class-p tag)
+ (mapcar (lambda (class)
+ `(subclass
+ ,(if (symbolp class) class (eieio--class-symbol class))))
+ (eieio--class-precedence-list tag))))
+
;;; Backward compatibility functions
;; To support .elc files compiled for older versions of EIEIO.
diff --git a/lisp/emacs-lisp/eieio-generic.el b/lisp/emacs-lisp/eieio-generic.el
index 27a5849..74ecefe 100644
--- a/lisp/emacs-lisp/eieio-generic.el
+++ b/lisp/emacs-lisp/eieio-generic.el
@@ -110,7 +110,7 @@ Methods with only primary implementations are executed in
an optimized way."
(cond
((or (not (fboundp method))
- (eq 'autoload (car-safe (symbol-function method))))
+ (autoloadp (symbol-function method)))
;; Make sure the method tables are installed.
(eieio--mt-install method)
;; Construct the actual body of this function.
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index c5597b8..0c85d90 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -276,6 +276,17 @@ and reference them using the function `class-option'."
`(defun ,name (&rest slots)
,(format "Create a new object with name NAME of class type %S."
name)
+ (declare (compiler-macro
+ (lambda (whole)
+ (if (not (stringp (car slots)))
+ whole
+ (macroexp--warn-and-return
+ (format "Obsolete name arg %S to constructor %S"
+ (car slots) (car whole))
+ ;; Keep the name arg, for backward compatibility,
+ ;; but hide it so we don't trigger indefinitely.
+ `(,(car whole) (identity ,(car slots))
+ ,@(cdr slots)))))))
(apply #'eieio-constructor ',name slots))))))
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 4be3b58..0f094b5 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1154,13 +1154,15 @@ Also, add the originating archive to the `package-desc'
structure."
(when (not (and pinned-to-archive
(not (equal (cdr pinned-to-archive) archive))))
(setq package-archive-contents
- (package--add-to-alist pkg-desc package-archive-contents)))))
+ (package--append-to-alist pkg-desc package-archive-contents)))))
-(defun package--add-to-alist (pkg-desc alist)
- "Add PKG-DESC to ALIST.
+(defun package--append-to-alist (pkg-desc alist)
+ "Append an entry for PKG-DESC to the start of ALIST and return it.
+This entry takes the form (`package-desc-name' PKG-DESC).
-Packages are grouped by name. The package descriptions are sorted
-by version number."
+If ALIST already has an entry with this name, destructively add
+PKG-DESC to the cdr of this entry instead, sorted by version
+number."
(let* ((name (package-desc-name pkg-desc))
(priority-version (package-desc-priority-version pkg-desc))
(existing-packages (assq name alist)))
@@ -2100,7 +2102,7 @@ If optional arg BUTTON is non-nil, describe its
associated package."
(cond ((member status '("installed" "unsigned"))
(push pkg-desc installed))
((member status '("available" "new"))
- (setq available (package--add-to-alist pkg-desc available))))))
+ (setq available (package--append-to-alist pkg-desc
available))))))
;; Loop through list of installed packages, finding upgrades.
(dolist (pkg-desc installed)
(let* ((name (package-desc-name pkg-desc))
diff --git a/lisp/ido.el b/lisp/ido.el
index 2321b57..1f4e3fa 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -208,13 +208,13 @@
;;
;; Customize the Ido group to change the Ido functionality.
;;
-;; To modify the keybindings, use the ido-setup-hook. For example:
-;;(add-hook 'ido-setup-hook 'ido-my-keys)
+;; To modify the keybindings, use `define-key' on
+;; `ido-common-completion-map' or one of the specialized keymaps:
+;; `ido-file-dir-completion-map', `ido-file-completion-map' or
+;; `ido-buffer-completion-map'.
;;
-;;(defun ido-my-keys ()
-;; "Add my keybindings for ido."
-;; (define-key ido-completion-map " " 'ido-next-match)
-;; )
+;; (with-eval-after-load 'ido
+;; (define-key ido-common-completion-map " " 'ido-next-match))
;; Seeing all the matching buffers or files
;; ----------------------------------------
@@ -323,8 +323,8 @@
(defvar recentf-list)
-;;; User Variables
-;;
+;;;; Options
+
;; These are some things you might want to change.
(defun ido-fractionp (n)
@@ -978,25 +978,90 @@ The fallback command is passed as an argument to the
functions."
:type 'hook
:group 'ido)
-;;; Internal Variables
-
-;; Persistent variables
-
-(defvar ido-completion-map nil
- "Currently active keymap for Ido commands.")
+;;;; Keymaps
-(defvar ido-common-completion-map nil
+(defvar ido-common-completion-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map "\C-a" 'ido-toggle-ignore)
+ (define-key map "\C-c" 'ido-toggle-case)
+ (define-key map "\C-e" 'ido-edit-input)
+ (define-key map "\t" 'ido-complete)
+ (define-key map " " 'ido-complete-space)
+ (define-key map "\C-j" 'ido-select-text)
+ (define-key map "\C-m" 'ido-exit-minibuffer)
+ (define-key map "\C-p" 'ido-toggle-prefix)
+ (define-key map "\C-r" 'ido-prev-match)
+ (define-key map "\C-s" 'ido-next-match)
+ (define-key map [?\C-.] 'ido-next-match)
+ (define-key map [?\C-,] 'ido-prev-match)
+ (define-key map "\C-t" 'ido-toggle-regexp)
+ (define-key map "\C-z" 'ido-undo-merge-work-directory)
+ (define-key map [(control ?\s)] 'ido-restrict-to-matches)
+ (define-key map [(meta ?\s)] 'ido-take-first-match)
+ (define-key map [(control ?@)] 'ido-restrict-to-matches)
+ (define-key map [right] 'ido-next-match)
+ (define-key map [left] 'ido-prev-match)
+ (define-key map "?" 'ido-completion-help)
+ (define-key map "\C-b" 'ido-magic-backward-char)
+ (define-key map "\C-f" 'ido-magic-forward-char)
+ (define-key map "\C-d" 'ido-magic-delete-char)
+ map)
"Keymap for all Ido commands.")
-(defvar ido-file-completion-map nil
- "Keymap for Ido file commands.")
-
-(defvar ido-file-dir-completion-map nil
+(defvar ido-file-dir-completion-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map ido-common-completion-map)
+ (define-key map "\C-x\C-b" 'ido-enter-switch-buffer)
+ (define-key map "\C-x\C-f" 'ido-fallback-command)
+ (define-key map "\C-x\C-d" 'ido-enter-dired)
+ (define-key map [down] 'ido-next-match-dir)
+ (define-key map [up] 'ido-prev-match-dir)
+ (define-key map [(meta up)] 'ido-prev-work-directory)
+ (define-key map [(meta down)] 'ido-next-work-directory)
+ (define-key map [backspace] 'ido-delete-backward-updir)
+ (define-key map "\d" 'ido-delete-backward-updir)
+ (define-key map [remap delete-backward-char] 'ido-delete-backward-updir) ;
BS
+ (define-key map [remap backward-kill-word]
'ido-delete-backward-word-updir) ; M-DEL
+ (define-key map [(control backspace)] 'ido-up-directory)
+ (define-key map "\C-l" 'ido-reread-directory)
+ (define-key map [(meta ?d)] 'ido-wide-find-dir-or-delete-dir)
+ (define-key map [(meta ?b)] 'ido-push-dir)
+ (define-key map [(meta ?v)] 'ido-push-dir-first)
+ (define-key map [(meta ?f)] 'ido-wide-find-file-or-pop-dir)
+ (define-key map [(meta ?k)] 'ido-forget-work-directory)
+ (define-key map [(meta ?m)] 'ido-make-directory)
+ (define-key map [(meta ?n)] 'ido-next-work-directory)
+ (define-key map [(meta ?o)] 'ido-prev-work-file)
+ (define-key map [(meta control ?o)] 'ido-next-work-file)
+ (define-key map [(meta ?p)] 'ido-prev-work-directory)
+ (define-key map [(meta ?s)] 'ido-merge-work-directories)
+ map)
"Keymap for Ido file and directory commands.")
-(defvar ido-buffer-completion-map nil
+(defvar ido-file-completion-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map ido-file-dir-completion-map)
+ (define-key map "\C-k" 'ido-delete-file-at-head)
+ (define-key map "\C-o" 'ido-copy-current-word)
+ (define-key map "\C-w" 'ido-copy-current-file-name)
+ (define-key map [(meta ?l)] 'ido-toggle-literal)
+ map)
+ "Keymap for Ido file commands.")
+
+(defvar ido-buffer-completion-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map ido-common-completion-map)
+ (define-key map "\C-x\C-f" 'ido-enter-find-file)
+ (define-key map "\C-x\C-b" 'ido-fallback-command)
+ (define-key map "\C-k" 'ido-kill-buffer-at-head)
+ (define-key map [?\C-\S-b] 'ido-bury-buffer-at-head)
+ (define-key map "\C-o" 'ido-toggle-virtual-buffers)
+ map)
"Keymap for Ido buffer commands.")
+;;;; Persistent variables
+
(defvar ido-file-history nil
"History of files selected using `ido-find-file'.")
@@ -1027,7 +1092,10 @@ Each element in the list is of the form (DIR (MTIME)
FILE...).")
Intended to be let-bound by functions which call Ido repeatedly.
Should never be set permanently.")
-;; Temporary storage
+;;;; Temporary storage
+
+(defvar ido-completion-map nil
+ "Currently active keymap for Ido commands.")
(defvar ido-eoinput 1
"Point where minibuffer input ends and completion info begins.
@@ -1086,13 +1154,14 @@ Value is an integer which is number of chars to right
of prompt.")
This is a copy of `recentf-list', pared down and with faces applied.
Only used if `ido-use-virtual-buffers' is non-nil.")
-;;; Variables with dynamic bindings.
-;;; Declared here to keep the byte compiler quiet.
+;;;; Variables with dynamic bindings.
+
+;; These are declared here to keep the byte compiler quiet.
;; Stores the current ido item type ('file, 'dir, 'buffer, or 'list).
(defvar ido-cur-item)
-;;; Stores the current default item
+;; Stores the current default item.
(defvar ido-default-item)
;; Stores the current list of items that will be searched through.
@@ -1502,7 +1571,6 @@ Removes badly formatted data and ignored directories."
(ido-save-history))
(defun ido-common-initialization ()
- (ido-init-completion-maps)
(add-hook 'minibuffer-setup-hook 'ido-minibuffer-setup)
(add-hook 'choose-completion-string-functions 'ido-choose-completion-string))
@@ -1596,120 +1664,51 @@ This function also adds a hook to the minibuffer."
;;; IDO KEYMAP
-(defun ido-init-completion-maps ()
- "Set up the completion keymaps used by Ido."
-
- ;; Common map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-a" 'ido-toggle-ignore)
- (define-key map "\C-c" 'ido-toggle-case)
- (define-key map "\C-e" 'ido-edit-input)
- (define-key map "\t" 'ido-complete)
- (define-key map " " 'ido-complete-space)
- (define-key map "\C-j" 'ido-select-text)
- (define-key map "\C-m" 'ido-exit-minibuffer)
- (define-key map "\C-p" 'ido-toggle-prefix)
- (define-key map "\C-r" 'ido-prev-match)
- (define-key map "\C-s" 'ido-next-match)
- (define-key map [?\C-.] 'ido-next-match)
- (define-key map [?\C-,] 'ido-prev-match)
- (define-key map "\C-t" 'ido-toggle-regexp)
- (define-key map "\C-z" 'ido-undo-merge-work-directory)
- (define-key map [(control ?\s)] 'ido-restrict-to-matches)
- (define-key map [(meta ?\s)] 'ido-take-first-match)
- (define-key map [(control ?@)] 'ido-restrict-to-matches)
- (define-key map [right] 'ido-next-match)
- (define-key map [left] 'ido-prev-match)
- (define-key map "?" 'ido-completion-help)
- ;; Magic commands.
- (define-key map "\C-b" 'ido-magic-backward-char)
- (define-key map "\C-f" 'ido-magic-forward-char)
- (define-key map "\C-d" 'ido-magic-delete-char)
- (set-keymap-parent map minibuffer-local-map)
- (setq ido-common-completion-map map))
-
- ;; File and directory map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-x\C-b" 'ido-enter-switch-buffer)
- (define-key map "\C-x\C-f" 'ido-fallback-command)
- (define-key map "\C-x\C-d" 'ido-enter-dired)
- (define-key map [down] 'ido-next-match-dir)
- (define-key map [up] 'ido-prev-match-dir)
- (define-key map [(meta up)] 'ido-prev-work-directory)
- (define-key map [(meta down)] 'ido-next-work-directory)
- (define-key map [backspace] 'ido-delete-backward-updir)
- (define-key map "\d" 'ido-delete-backward-updir)
- (define-key map [remap delete-backward-char] 'ido-delete-backward-updir) ;
BS
- (define-key map [remap backward-kill-word]
'ido-delete-backward-word-updir) ; M-DEL
- (define-key map [(control backspace)] 'ido-up-directory)
- (define-key map "\C-l" 'ido-reread-directory)
- (define-key map [(meta ?d)] 'ido-wide-find-dir-or-delete-dir)
- (define-key map [(meta ?b)] 'ido-push-dir)
- (define-key map [(meta ?v)] 'ido-push-dir-first)
- (define-key map [(meta ?f)] 'ido-wide-find-file-or-pop-dir)
- (define-key map [(meta ?k)] 'ido-forget-work-directory)
- (define-key map [(meta ?m)] 'ido-make-directory)
- (define-key map [(meta ?n)] 'ido-next-work-directory)
- (define-key map [(meta ?o)] 'ido-prev-work-file)
- (define-key map [(meta control ?o)] 'ido-next-work-file)
- (define-key map [(meta ?p)] 'ido-prev-work-directory)
- (define-key map [(meta ?s)] 'ido-merge-work-directories)
- (set-keymap-parent map ido-common-completion-map)
- (setq ido-file-dir-completion-map map))
+(defalias 'ido-init-completion-maps 'ignore "")
+(make-obsolete 'ido-init-completion-maps "it does nothing." "25.1")
- ;; File only map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-k" 'ido-delete-file-at-head)
- (define-key map "\C-o" 'ido-copy-current-word)
- (define-key map "\C-w" 'ido-copy-current-file-name)
- (define-key map [(meta ?l)] 'ido-toggle-literal)
- (set-keymap-parent map ido-file-dir-completion-map)
- (setq ido-file-completion-map map))
+(defun ido-setup-completion-map ()
+ "Set up the completion keymap used by Ido.
- ;; Buffer map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-x\C-f" 'ido-enter-find-file)
- (define-key map "\C-x\C-b" 'ido-fallback-command)
- (define-key map "\C-k" 'ido-kill-buffer-at-head)
- (define-key map [?\C-\S-b] 'ido-bury-buffer-at-head)
- (define-key map "\C-o" 'ido-toggle-virtual-buffers)
- (set-keymap-parent map ido-common-completion-map)
- (setq ido-buffer-completion-map map)))
+Create a keymap, bind `ido-completion-map' to it, and depending
+on what is being completed (`ido-cur-item') set its parent keymap
+to one of:
+ `ido-common-completion-map'
+ `ido-file-dir-completion-map'
+ `ido-file-completion-map'
+ `ido-buffer-completion-map'
-(defun ido-setup-completion-map ()
- "Set up the keymap for Ido."
-
+If option `ido-context-switch-command' is non-nil or `viper-mode'
+is enabled then some keybindings are changed in the keymap."
;; generated every time so that it can inherit new functions.
(let ((map (make-sparse-keymap))
(viper-p (if (boundp 'viper-mode) viper-mode)))
-
(when viper-p
(define-key map [remap viper-intercept-ESC-key] 'ignore))
-
- (cond
- ((memq ido-cur-item '(file dir))
+ (pcase ido-cur-item
+ ((or `file `dir)
(when ido-context-switch-command
(define-key map "\C-x\C-b" ido-context-switch-command)
(define-key map "\C-x\C-d" 'ignore))
(when viper-p
- (define-key map [remap viper-backward-char] 'ido-delete-backward-updir)
- (define-key map [remap viper-del-backward-char-in-insert]
'ido-delete-backward-updir)
- (define-key map [remap viper-delete-backward-word]
'ido-delete-backward-word-updir))
+ (define-key map [remap viper-backward-char]
+ 'ido-delete-backward-updir)
+ (define-key map [remap viper-del-backward-char-in-insert]
+ 'ido-delete-backward-updir)
+ (define-key map [remap viper-delete-backward-word]
+ 'ido-delete-backward-word-updir))
(set-keymap-parent map
(if (eq ido-cur-item 'file)
ido-file-completion-map
ido-file-dir-completion-map)))
-
- ((eq ido-cur-item 'buffer)
+ (`buffer
(when ido-context-switch-command
(define-key map "\C-x\C-f" ido-context-switch-command))
(set-keymap-parent map ido-buffer-completion-map))
-
- (t
+ (_
(set-keymap-parent map ido-common-completion-map)))
-
(setq ido-completion-map map)))
(defun ido-final-slash (dir &optional fix-it)
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 7f77d21..12123c8 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -51,6 +51,7 @@
(require 'cl-lib)
(require 'eieio)
(require 'ring)
+(require 'pcase)
(defgroup xref nil "Cross-referencing commands"
:group 'tools)
@@ -333,19 +334,32 @@ WINDOW controls how the buffer is displayed:
;; The xref buffer is used to display a set of xrefs.
-(defvar-local xref--window-configuration nil)
+(defvar-local xref--display-history nil
+ "List of pairs (BUFFER . WINDOW), for temporarily displayed buffers.")
-(defun xref--display-position (pos other-window recenter-arg)
- ;; show the location, but don't hijack focus.
+(defun xref--save-to-history (buf win)
+ (let ((restore (window-parameter win 'quit-restore)))
+ ;; Save the new entry if the window displayed another buffer
+ ;; previously.
+ (when (and restore (not (eq (car restore) 'same)))
+ (push (cons buf win) xref--display-history))))
+
+(defun xref--display-position (pos other-window recenter-arg xref-buf)
+ ;; Show the location, but don't hijack focus.
(with-selected-window (display-buffer (current-buffer) other-window)
(goto-char pos)
- (recenter recenter-arg)))
+ (recenter recenter-arg)
+ (let ((buf (current-buffer))
+ (win (selected-window)))
+ (with-current-buffer xref-buf
+ (setq-local other-window-scroll-buffer buf)
+ (xref--save-to-history buf win)))))
(defun xref--show-location (location)
(condition-case err
- (progn
+ (let ((xref-buf (current-buffer)))
(xref--goto-location location)
- (xref--display-position (point) t 1))
+ (xref--display-position (point) t 1 xref-buf))
(user-error (message (error-message-string err)))))
(defun xref-show-location-at-point ()
@@ -353,14 +367,8 @@ WINDOW controls how the buffer is displayed:
(interactive)
(let ((loc (xref--location-at-point)))
(when loc
- (setq xref--window-configuration (current-window-configuration))
(xref--show-location loc))))
-(defun xref--restore-window-configuration ()
- (when xref--window-configuration
- (set-window-configuration xref--window-configuration)
- (setq xref--window-configuration nil)))
-
(defun xref-next-line ()
"Move to the next xref and display its source in the other window."
(interactive)
@@ -379,21 +387,21 @@ WINDOW controls how the buffer is displayed:
(defvar-local xref--window nil)
(defun xref-goto-xref ()
- "Jump to the xref at point and bury the xref buffer."
+ "Jump to the xref on the current line and bury the xref buffer."
(interactive)
+ (back-to-indentation)
(let ((loc (or (xref--location-at-point)
- (error "No reference at point")))
+ (user-error "No reference at point")))
(window xref--window))
- (quit-window)
+ (xref--quit)
(xref--pop-to-location loc window)))
(define-derived-mode xref--xref-buffer-mode fundamental-mode "XREF"
"Mode for displaying cross-references."
- (setq buffer-read-only t)
- (add-hook 'pre-command-hook #'xref--restore-window-configuration nil t))
+ (setq buffer-read-only t))
(let ((map xref--xref-buffer-mode-map))
- (define-key map (kbd "q") #'quit-window)
+ (define-key map (kbd "q") #'xref--quit)
(define-key map (kbd "n") #'xref-next-line)
(define-key map (kbd "p") #'xref-prev-line)
(define-key map (kbd "RET") #'xref-goto-xref)
@@ -403,6 +411,18 @@ WINDOW controls how the buffer is displayed:
(define-key map (kbd ".") #'xref-next-line)
(define-key map (kbd ",") #'xref-prev-line))
+(defun xref--quit ()
+ "Quit all windows in `xref--display-history', then quit current window."
+ (interactive)
+ (let ((window (selected-window))
+ (history xref--display-history))
+ (setq xref--display-history nil)
+ (pcase-dolist (`(,buf . ,win) history)
+ (when (and (window-live-p win)
+ (eq buf (window-buffer win)))
+ (quit-window nil win)))
+ (quit-window nil window)))
+
(defconst xref-buffer-name "*xref*"
"The name of the buffer to show xrefs.")
diff --git a/src/ChangeLog b/src/ChangeLog
index 16e2fa1..f6a5f38 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,39 @@
+2015-01-19 Eli Zaretskii <address@hidden>
+
+ * dispnew.c (adjust_glyph_matrix, realloc_glyph_pool): Verify that
+ Qnil is represented as zero, before using that to initialize parts
+ of the glyph structure.
+
+ * xdisp.c (init_iterator): Verify that Qnil is represented as
+ zero, before using that to initialize parts of the iterator
+ structure.
+
+2015-01-19 Paul Eggert <address@hidden>
+
+ Prefer memset to repeatedly assigning Qnil
+ * alloc.c (allocate_pseudovector): Catch more bogus values.
+ * alloc.c (allocate_pseudovector):
+ * callint.c (Fcall_interactively):
+ * coding.c (syms_of_coding):
+ * fringe.c (init_fringe):
+ Verify that Qnil == 0.
+ * callint.c (Fcall_interactively):
+ * eval.c (Fapply, Ffuncall):
+ * fns.c (mapcar1, larger_vector):
+ * font.c (font_expand_wildcards):
+ * fringe.c (init_fringe):
+ Prefer memset to assigning zeros by hand.
+ * callint.c (Fcall_interactively):
+ Remove duplicate assignment of Qnil to args[i].
+ * coding.c (syms_of_coding):
+ Prefer LISP_INITIALLY_ZERO to assigning zeros by hand.
+ * fileio.c (Ffile_selinux_context):
+ Rewrite to avoid need for Lisp_Object array.
+ * lisp.h (XLI_BUILTIN_LISPSYM): New macro.
+ (DEFINE_LISP_SYMBOL_END): Use it.
+ (NIL_IS_ZERO): New constant.
+ (memsetnil): New function.
+
2015-01-16 Dmitry Antipov <address@hidden>
Tune pseudovector allocation assuming Qnil == 0.
diff --git a/src/alloc.c b/src/alloc.c
index 22a15b4..2c7b02f 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3169,12 +3169,14 @@ allocate_pseudovector (int memlen, int lisplen,
struct Lisp_Vector *v = allocate_vectorlike (memlen);
/* Catch bogus values. */
- eassert (tag <= PVEC_FONT);
+ eassert (0 <= tag && tag <= PVEC_FONT);
+ eassert (0 <= lisplen && lisplen <= zerolen && zerolen <= memlen);
eassert (memlen - lisplen <= (1 << PSEUDOVECTOR_REST_BITS) - 1);
eassert (lisplen <= (1 << PSEUDOVECTOR_SIZE_BITS) - 1);
- /* Only the first lisplen slots will be traced normally by the GC.
+ /* Only the first LISPLEN slots will be traced normally by the GC.
But since Qnil == 0, we can memset Lisp_Object slots as well. */
+ verify (NIL_IS_ZERO);
memset (v->contents, 0, zerolen * word_size);
XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen);
diff --git a/src/callint.c b/src/callint.c
index dd238b9..3a595b5 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -509,12 +509,8 @@ invoke it. If KEYS is omitted or nil, the return value of
visargs = args + nargs;
varies = (signed char *) (visargs + nargs);
- for (i = 0; i < nargs; i++)
- {
- args[i] = Qnil;
- visargs[i] = Qnil;
- varies[i] = 0;
- }
+ verify (NIL_IS_ZERO);
+ memset (args, 0, nargs * (2 * word_size + 1));
GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
gcpro3.nvars = nargs;
@@ -781,7 +777,7 @@ invoke it. If KEYS is omitted or nil, the return value of
argument if no prefix. */
if (NILP (prefix_arg))
{
- args[i] = Qnil;
+ /* args[i] = Qnil; */
varies[i] = -1;
}
else
diff --git a/src/coding.c b/src/coding.c
index b11143a..77cea77 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -11272,13 +11272,10 @@ internal character representation. */);
Vtranslation_table_for_input = Qnil;
{
- Lisp_Object args[coding_arg_undecided_max];
- Lisp_Object plist[16];
- int i;
-
- for (i = 0; i < coding_arg_undecided_max; i++)
- args[i] = Qnil;
+ verify (NIL_IS_ZERO);
+ Lisp_Object args[coding_arg_undecided_max] = { LISP_INITIALLY_ZERO, };
+ Lisp_Object plist[16];
plist[0] = intern_c_string (":name");
plist[1] = args[coding_arg_name] = Qno_conversion;
plist[2] = intern_c_string (":mnemonic");
diff --git a/src/dispnew.c b/src/dispnew.c
index bfa06bd..abfdde6 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -417,6 +417,12 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix
*matrix, int x, int y
new_rows = dim.height - matrix->rows_allocated;
matrix->rows = xpalloc (matrix->rows, &matrix->rows_allocated,
new_rows, INT_MAX, sizeof *matrix->rows);
+ /* As a side effect, this sets the object of each glyph in the
+ row to nil, so verify we will indeed get that. Redisplay
+ relies on the object of special glyphs (truncation and
+ continuation glyps and also blanks used to extend each line
+ on a TTY) to be nil. */
+ verify (NIL_IS_ZERO);
memset (matrix->rows + old_alloc, 0,
(matrix->rows_allocated - old_alloc) * sizeof *matrix->rows);
}
@@ -1343,6 +1349,12 @@ realloc_glyph_pool (struct glyph_pool *pool, struct dim
matrix_dim)
ptrdiff_t old_nglyphs = pool->nglyphs;
pool->glyphs = xpalloc (pool->glyphs, &pool->nglyphs,
needed - old_nglyphs, -1, sizeof *pool->glyphs);
+ /* As a side effect, this sets the object of each glyph to nil,
+ so verify we will indeed get that. Redisplay relies on the
+ object of special glyphs (truncation and continuation glyps
+ and also blanks used to extend each line on a TTY) to be
+ nil. */
+ verify (NIL_IS_ZERO);
memset (pool->glyphs + old_nglyphs, 0,
(pool->nglyphs - old_nglyphs) * sizeof *pool->glyphs);
}
diff --git a/src/eval.c b/src/eval.c
index 5cadb1b..ddf6535 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2299,8 +2299,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
/* Avoid making funcall cons up a yet another new vector of arguments
by explicitly supplying nil's for optional values. */
SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args);
- for (i = numargs; i < XSUBR (fun)->max_args; /* nothing */)
- funcall_args[++i] = Qnil;
+ memsetnil (funcall_args + numargs + 1, XSUBR (fun)->max_args - numargs);
funcall_nargs = 1 + XSUBR (fun)->max_args;
}
else
@@ -2638,8 +2637,8 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
ptrdiff_t numargs = nargs - 1;
Lisp_Object lisp_numargs;
Lisp_Object val;
- register Lisp_Object *internal_args;
- ptrdiff_t i, count;
+ Lisp_Object *internal_args;
+ ptrdiff_t count;
QUIT;
@@ -2694,8 +2693,8 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
eassert (XSUBR (fun)->max_args <= ARRAYELTS (internal_argbuf));
internal_args = internal_argbuf;
memcpy (internal_args, args + 1, numargs * word_size);
- for (i = numargs; i < XSUBR (fun)->max_args; i++)
- internal_args[i] = Qnil;
+ memsetnil (internal_args + numargs,
+ XSUBR (fun)->max_args - numargs);
}
else
internal_args = args + 1;
diff --git a/src/fileio.c b/src/fileio.c
index dc67a00..ff6720d 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -2812,7 +2812,8 @@ or if SELinux is disabled, or if Emacs lacks SELinux
support. */)
(Lisp_Object filename)
{
Lisp_Object absname;
- Lisp_Object values[4];
+ Lisp_Object user = Qnil, role = Qnil, type = Qnil, range = Qnil;
+
Lisp_Object handler;
#if HAVE_LIBSELINUX
security_context_t con;
@@ -2830,10 +2831,6 @@ or if SELinux is disabled, or if Emacs lacks SELinux
support. */)
absname = ENCODE_FILE (absname);
- values[0] = Qnil;
- values[1] = Qnil;
- values[2] = Qnil;
- values[3] = Qnil;
#if HAVE_LIBSELINUX
if (is_selinux_enabled ())
{
@@ -2842,20 +2839,20 @@ or if SELinux is disabled, or if Emacs lacks SELinux
support. */)
{
context = context_new (con);
if (context_user_get (context))
- values[0] = build_string (context_user_get (context));
+ user = build_string (context_user_get (context));
if (context_role_get (context))
- values[1] = build_string (context_role_get (context));
+ role = build_string (context_role_get (context));
if (context_type_get (context))
- values[2] = build_string (context_type_get (context));
+ type = build_string (context_type_get (context));
if (context_range_get (context))
- values[3] = build_string (context_range_get (context));
+ range = build_string (context_range_get (context));
context_free (context);
freecon (con);
}
}
#endif
- return Flist (ARRAYELTS (values), values);
+ return list4 (user, role, type, range);
}
DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
diff --git a/src/fns.c b/src/fns.c
index ca3d98b..d177294 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2517,16 +2517,14 @@ usage: (nconc &rest LISTS) */)
static void
mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
{
- register Lisp_Object tail;
- Lisp_Object dummy;
- register EMACS_INT i;
+ Lisp_Object tail, dummy;
+ EMACS_INT i;
struct gcpro gcpro1, gcpro2, gcpro3;
if (vals)
{
/* Don't let vals contain any garbage when GC happens. */
- for (i = 0; i < leni; i++)
- vals[i] = Qnil;
+ memsetnil (vals, leni);
GCPRO3 (dummy, fn, seq);
gcpro1.var = vals;
@@ -3688,7 +3686,7 @@ Lisp_Object
larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
{
struct Lisp_Vector *v;
- ptrdiff_t i, incr, incr_max, old_size, new_size;
+ ptrdiff_t incr, incr_max, old_size, new_size;
ptrdiff_t C_language_max = min (PTRDIFF_MAX, SIZE_MAX) / sizeof *v->contents;
ptrdiff_t n_max = (0 <= nitems_max && nitems_max < C_language_max
? nitems_max : C_language_max);
@@ -3702,8 +3700,7 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min,
ptrdiff_t nitems_max)
new_size = old_size + incr;
v = allocate_vector (new_size);
memcpy (v->contents, XVECTOR (vec)->contents, old_size * sizeof
*v->contents);
- for (i = old_size; i < new_size; ++i)
- v->contents[i] = Qnil;
+ memsetnil (v->contents + old_size, new_size - old_size);
XSETVECTOR (vec, v);
return vec;
}
diff --git a/src/font.c b/src/font.c
index 56a2782..190b33a 100644
--- a/src/font.c
+++ b/src/font.c
@@ -989,15 +989,14 @@ font_expand_wildcards (Lisp_Object *field, int n)
if (i == 0 || ! NILP (tmp[i - 1]))
/* None of TMP[X] corresponds to Jth field. */
return -1;
- for (; j < range[i].from; j++)
- field[j] = Qnil;
+ memsetnil (field + j, range[i].from - j);
+ j = range[i].from;
}
field[j++] = tmp[i];
}
if (! NILP (tmp[n - 1]) && j < XLFD_REGISTRY_INDEX)
return -1;
- for (; j < XLFD_LAST_INDEX; j++)
- field[j] = Qnil;
+ memsetnil (field + j, XLFD_LAST_INDEX - j);
if (INTEGERP (field[XLFD_ENCODING_INDEX]))
field[XLFD_ENCODING_INDEX]
= Fintern (Fnumber_to_string (field[XLFD_ENCODING_INDEX]), Qnil);
diff --git a/src/fringe.c b/src/fringe.c
index c7262d1..464379d 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -1723,15 +1723,12 @@ init_fringe_once (void)
void
init_fringe (void)
{
- int i;
-
max_fringe_bitmaps = MAX_STANDARD_FRINGE_BITMAPS + 20;
fringe_bitmaps = xzalloc (max_fringe_bitmaps * sizeof *fringe_bitmaps);
- fringe_faces = xmalloc (max_fringe_bitmaps * sizeof *fringe_faces);
- for (i = 0; i < max_fringe_bitmaps; i++)
- fringe_faces[i] = Qnil;
+ verify (NIL_IS_ZERO);
+ fringe_faces = xzalloc (max_fringe_bitmaps * sizeof *fringe_faces);
}
#ifdef HAVE_NTGUI
diff --git a/src/lisp.h b/src/lisp.h
index e94e39a..65e6c62 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -732,14 +732,18 @@ struct Lisp_Symbol
TAG_PTR (Lisp_Symbol, \
((uintptr_t) (offset) >> (USE_LSB_TAG ? 0 : GCTYPEBITS)))
+/* XLI_BUILTIN_LISPSYM (iQwhatever) is equivalent to
+ XLI (builtin_lisp_symbol (Qwhatever)),
+ except the former expands to an integer constant expression. */
+#define XLI_BUILTIN_LISPSYM(iname) TAG_SYMOFFSET ((iname) * sizeof *lispsym)
+
/* Declare extern constants for Lisp symbols. These can be helpful
when using a debugger like GDB, on older platforms where the debug
format does not represent C macros. */
#define DEFINE_LISP_SYMBOL_BEGIN(name) \
- DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name)
+ DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name)
#define DEFINE_LISP_SYMBOL_END(name) \
- DEFINE_GDB_SYMBOL_END (LISP_INITIALLY (TAG_SYMOFFSET (i##name \
- * sizeof *lispsym)))
+ DEFINE_GDB_SYMBOL_END (LISP_INITIALLY (XLI_BUILTIN_LISPSYM (i##name)))
#include "globals.h"
@@ -1504,6 +1508,20 @@ gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object
val)
XVECTOR (array)->contents[idx] = val;
}
+/* True, since Qnil's representation is zero. Every place in the code
+ that assumes Qnil is zero should verify (NIL_IS_ZERO), to make it easy
+ to find such assumptions later if we change Qnil to be nonzero. */
+enum { NIL_IS_ZERO = XLI_BUILTIN_LISPSYM (iQnil) == 0 };
+
+/* Set a Lisp_Object array V's SIZE entries to nil. */
+INLINE void
+memsetnil (Lisp_Object *v, ptrdiff_t size)
+{
+ eassert (0 <= size);
+ verify (NIL_IS_ZERO);
+ memset (v, 0, size * sizeof *v);
+}
+
/* If a struct is made to look like a vector, this macro returns the length
of the shortest vector that would hold that struct. */
diff --git a/src/xdisp.c b/src/xdisp.c
index fcc0809..208c124 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -2753,6 +2753,9 @@ init_iterator (struct it *it, struct window *w,
}
/* Clear IT. */
+ /* As a side effect, this sets it->object to nil, so verify we will
+ indeed get that. */
+ verify (NIL_IS_ZERO);
memset (it, 0, sizeof *it);
it->current.overlay_string_index = -1;
it->current.dpvec_index = -1;
diff --git a/test/ChangeLog b/test/ChangeLog
index 15baf86..4b9e7a9 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,8 +1,21 @@
+2015-01-18 Stefan Monnier <address@hidden>
+
+ * automated/Makefile.in (EMACS_EXTRAOPT): New var.
+ (EMACSOPT): Use it.
+
+ * automated/cl-generic-tests.el (cl-generic-test-10-weird): New test.
+ Rename other tests to preserve ordering.
+
2015-01-18 Leo Liu <address@hidden>
* automated/seq-tests.el (test-seq-subseq): Add more tests.
(Bug#19434)
+2015-01-18 Stefan Monnier <address@hidden>
+
+ * automated/eieio-test-methodinvoke.el (eieio-test-cl-generic-1):
+ Test `subclass' specializer.
+
2015-01-17 Stefan Monnier <address@hidden>
* automated/eieio-tests.el
diff --git a/test/automated/Makefile.in b/test/automated/Makefile.in
index 7243e8a..faf0b3d 100644
--- a/test/automated/Makefile.in
+++ b/test/automated/Makefile.in
@@ -39,10 +39,12 @@ SEPCHAR = @SEPCHAR@
# directory, we can use emacs --chdir.
EMACS = ../../src/emacs
+EMACS_EXTRAOPT=
+
# Command line flags for Emacs.
# Apparently MSYS bash would convert "-L :" to "-L ;" anyway,
# but we might as well be explicit.
-EMACSOPT = -batch --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)"
+EMACSOPT = -batch --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)"
$(EMACS_EXTRAOPT)
# Prevent any settings in the user environment causing problems.
unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS
diff --git a/test/automated/cl-generic-tests.el
b/test/automated/cl-generic-tests.el
index 46397fb..1c01d9b 100644
--- a/test/automated/cl-generic-tests.el
+++ b/test/automated/cl-generic-tests.el
@@ -29,12 +29,12 @@
(cl-defgeneric cl--generic-1 (x y))
(cl-defgeneric (setf cl--generic-1) (v y z) "My generic doc.")
-(ert-deftest cl-generic-test-0 ()
+(ert-deftest cl-generic-test-00 ()
(cl-defgeneric cl--generic-1 (x y))
(cl-defmethod cl--generic-1 ((x t) y) (cons x y))
(should (equal (cl--generic-1 'a 'b) '(a . b))))
-(ert-deftest cl-generic-test-1-eql ()
+(ert-deftest cl-generic-test-01-eql ()
(cl-defgeneric cl--generic-1 (x y))
(cl-defmethod cl--generic-1 ((x t) y) (cons x y))
(cl-defmethod cl--generic-1 ((_x (eql 4)) _y)
@@ -53,7 +53,7 @@
(cl-defstruct (cl-generic-struct-child11 (:include cl-generic-struct-child1))
d)
(cl-defstruct (cl-generic-struct-child2 (:include cl-generic-struct-parent)) e)
-(ert-deftest cl-generic-test-2-struct ()
+(ert-deftest cl-generic-test-02-struct ()
(cl-defgeneric cl--generic-1 (x y) "My doc.")
(cl-defmethod cl--generic-1 ((x t) y) "Doc 1." (cons x y))
(cl-defmethod cl--generic-1 ((_x cl-generic-struct-parent) y)
@@ -73,7 +73,7 @@
(should (equal (cl--generic-1 (make-cl-generic-struct-child11) nil)
'("child11" "around""child1" "parent" a))))
-(ert-deftest cl-generic-test-3-setf ()
+(ert-deftest cl-generic-test-03-setf ()
(cl-defmethod (setf cl--generic-1) (v (y t) z) (list v y z))
(cl-defmethod (setf cl--generic-1) (v (_y (eql 4)) z) (list v "four" z))
(should (equal (setf (cl--generic-1 'a 'b) 'v) '(v a b)))
@@ -85,7 +85,7 @@
'(v a b)))
(should (equal x '(3 2 1)))))
-(ert-deftest cl-generic-test-4-overlapping-tagcodes ()
+(ert-deftest cl-generic-test-04-overlapping-tagcodes ()
(cl-defgeneric cl--generic-1 (x y) "My doc.")
(cl-defmethod cl--generic-1 ((y t) z) (list y z))
(cl-defmethod cl--generic-1 ((_y (eql 4)) _z)
@@ -98,7 +98,7 @@
(should (equal (cl--generic-1 1 'b) '("integer" "number" 1 b)))
(should (equal (cl--generic-1 4 'b) '("four" "integer" "number" 4 b))))
-(ert-deftest cl-generic-test-5-alias ()
+(ert-deftest cl-generic-test-05-alias ()
(cl-defgeneric cl--generic-1 (x y) "My doc.")
(defalias 'cl--generic-2 #'cl--generic-1)
(cl-defmethod cl--generic-1 ((y t) z) (list y z))
@@ -106,7 +106,7 @@
(cons "four" (cl-call-next-method)))
(should (equal (cl--generic-1 4 'b) '("four" 4 b))))
-(ert-deftest cl-generic-test-6-multiple-dispatch ()
+(ert-deftest cl-generic-test-06-multiple-dispatch ()
(cl-defgeneric cl--generic-1 (x y) "My doc.")
(cl-defmethod cl--generic-1 (x y) (list x y))
(cl-defmethod cl--generic-1 (_x (_y integer))
@@ -117,7 +117,7 @@
(cons "x&y-int" (cl-call-next-method)))
(should (equal (cl--generic-1 1 2) '("x&y-int" "x-int" "y-int" 1 2))))
-(ert-deftest cl-generic-test-7-apo ()
+(ert-deftest cl-generic-test-07-apo ()
(cl-defgeneric cl--generic-1 (x y)
(:documentation "My doc.") (:argument-precedence-order y x))
(cl-defmethod cl--generic-1 (x y) (list x y))
@@ -129,7 +129,7 @@
(cons "x&y-int" (cl-call-next-method)))
(should (equal (cl--generic-1 1 2) '("x&y-int" "y-int" "x-int" 1 2))))
-(ert-deftest cl-generic-test-8-after/before ()
+(ert-deftest cl-generic-test-08-after/before ()
(let ((log ()))
(cl-defgeneric cl--generic-1 (x y))
(cl-defmethod cl--generic-1 ((_x t) y) (cons y log))
@@ -144,7 +144,7 @@
(defun cl--generic-test-advice (&rest args) (cons "advice" (apply args)))
-(ert-deftest cl-generic-test-9-advice ()
+(ert-deftest cl-generic-test-09-advice ()
(cl-defgeneric cl--generic-1 (x y) "My doc.")
(cl-defmethod cl--generic-1 (x y) (list x y))
(advice-add 'cl--generic-1 :around #'cl--generic-test-advice)
@@ -155,5 +155,16 @@
(advice-remove 'cl--generic-1 #'cl--generic-test-advice)
(should (equal (cl--generic-1 4 5) '("integer" 4 5))))
+(ert-deftest cl-generic-test-10-weird ()
+ (cl-defgeneric cl--generic-1 (x &rest r) "My doc.")
+ (cl-defmethod cl--generic-1 (x &rest r) (cons x r))
+ ;; This kind of definition is not valid according to CLHS, but it does show
+ ;; up in EIEIO's tests for no-next-method, so we should either
+ ;; detect it and signal an error or do something meaningful with it.
+ (cl-defmethod cl--generic-1 (x (y integer) &rest r)
+ `("integer" ,y ,x ,@r))
+ (should (equal (cl--generic-1 'a 'b) '(a b)))
+ (should (equal (cl--generic-1 1 2) '("integer" 2 1))))
+
(provide 'cl-generic-tests)
;;; cl-generic-tests.el ends here
diff --git a/test/automated/eieio-test-methodinvoke.el
b/test/automated/eieio-test-methodinvoke.el
index b6d60b8..3918fb9 100644
--- a/test/automated/eieio-test-methodinvoke.el
+++ b/test/automated/eieio-test-methodinvoke.el
@@ -388,10 +388,13 @@
(cons "CNM-0" (cl-call-next-method 7 y)))
(cl-defmethod eieio-test--1 ((_x CNM-1-1) _y)
(cons "CNM-1-1" (cl-call-next-method)))
- (cl-defmethod eieio-test--1 ((_x CNM-1-2) y)
+ (cl-defmethod eieio-test--1 ((_x CNM-1-2) _y)
(cons "CNM-1-2" (cl-call-next-method)))
+ (cl-defmethod eieio-test--1 ((_x (subclass CNM-1-2)) _y)
+ (cons "subclass CNM-1-2" (cl-call-next-method)))
(should (equal (eieio-test--1 4 5) '(4 5)))
(should (equal (eieio-test--1 (make-instance 'CNM-0) 5)
'("CNM-0" 7 5)))
(should (equal (eieio-test--1 (make-instance 'CNM-2) 5)
- '("CNM-1-1" "CNM-1-2" "CNM-0" 7 5))))
+ '("CNM-1-1" "CNM-1-2" "CNM-0" 7 5)))
+ (should (equal (eieio-test--1 'CNM-2 6) '("subclass CNM-1-2" CNM-2 6))))