[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] xwidget 5c1d2b0 1/5: merge master
|
From: |
Joakim Verona |
|
Subject: |
[Emacs-diffs] xwidget 5c1d2b0 1/5: merge master |
|
Date: |
Sun, 25 Jan 2015 20:20:09 +0000 |
branch: xwidget
commit 5c1d2b0f06ddb1f6b520b2446ce9e207e5bfc315
Merge: d6ada5a 7f4e7dd
Author: Joakim Verona <address@hidden>
Commit: Joakim Verona <address@hidden>
merge master
---
etc/ChangeLog | 5 +++
etc/NEWS | 5 +++
lib-src/ChangeLog | 6 +++
lib-src/Makefile.in | 16 ++++----
lisp/ChangeLog | 38 +++++++++++++++++++++
lisp/emacs-lisp/bytecomp.el | 4 +-
lisp/emacs-lisp/cl-generic.el | 5 ++-
lisp/erc/ChangeLog | 5 +++
lisp/erc/erc-dcc.el | 3 +-
lisp/ffap.el | 4 +-
lisp/files.el | 2 +-
lisp/help.el | 2 +-
lisp/net/ange-ftp.el | 6 ++--
lisp/progmodes/etags.el | 4 +-
lisp/progmodes/xref.el | 73 +++++++++++++++++++++++------------------
lisp/url/ChangeLog | 6 +++
lisp/url/url-dav.el | 6 ++--
src/ChangeLog | 18 ++++++++++
src/alloc.c | 7 +---
src/callint.c | 3 +-
src/coding.c | 2 +-
src/dispnew.c | 10 +----
src/eval.c | 7 ++--
src/fileio.c | 40 ++++++-----------------
src/fns.c | 4 +-
src/font.c | 4 +-
src/lisp.h | 10 +++--
src/xdisp.c | 8 +----
test/automated/eieio-tests.el | 2 +-
29 files changed, 182 insertions(+), 123 deletions(-)
diff --git a/etc/ChangeLog b/etc/ChangeLog
index 7b64dfb..47f61f4 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,8 @@
+2015-01-22 Paul Eggert <address@hidden>
+
+ Don't downcase system diagnostics' first letters
+ * NEWS: Document this.
+
2015-01-16 Artur Malabarba <address@hidden>
* NEWS: Document installing packages from directories.
diff --git a/etc/NEWS b/etc/NEWS
index 120d8b9..db47033 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -538,6 +538,11 @@ position list returned for such events is now nil.
These slots used to hold key-shortcut data, but have been obsolete since
Emacs-21.
+** Emacs no longer downcases the first letter of a system diagnostic
+when signaling a file error. For example, it now reports "Permission
+denied" instead of "permission denied". The old behavior was problematic
+in languages like German where downcasing rules depend on grammar.
+
* Lisp Changes in Emacs 25.1
diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog
index b67038f..c2aedb0 100644
--- a/lib-src/ChangeLog
+++ b/lib-src/ChangeLog
@@ -1,3 +1,9 @@
+2015-01-22 Ulrich Müller <address@hidden>
+
+ * Makefile.in ($(DESTDIR)${archlibdir}): Don't fail if the chown
+ or chgrp command is unsuccessful; the 'update-game-score' program
+ has a fallback for this at runtime.
+
2015-01-21 Ulrich Müller <address@hidden>
* update-game-score.c: Allow the program to run sgid instead
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index 2997f1b..a0bf5ba 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -265,15 +265,15 @@ $(DESTDIR)${archlibdir}: all
touch "$(DESTDIR)${gamedir}/snake-scores"; \
touch "$(DESTDIR)${gamedir}/tetris-scores"
ifneq ($(gameuser),)
- chown ${gameuser} "$(DESTDIR)${archlibdir}/update-game-score${EXEEXT}"
- chmod u+s,go-r "$(DESTDIR)${archlibdir}/update-game-score${EXEEXT}"
- chown ${gameuser} "$(DESTDIR)${gamedir}"
- chmod u=rwx,g=rx,o=rx "$(DESTDIR)${gamedir}"
+ -if chown ${gameuser}
"$(DESTDIR)${archlibdir}/update-game-score${EXEEXT}" && chmod u+s,go-r
"$(DESTDIR)${archlibdir}/update-game-score${EXEEXT}"; then \
+ chown ${gameuser} "$(DESTDIR)${gamedir}"; \
+ chmod u=rwx,g=rx,o=rx "$(DESTDIR)${gamedir}"; \
+ fi
else ifneq ($(gamegroup),)
- chgrp ${gamegroup} "$(DESTDIR)${archlibdir}/update-game-score${EXEEXT}"
- chmod g+s,o-r "$(DESTDIR)${archlibdir}/update-game-score${EXEEXT}"
- chgrp ${gamegroup} "$(DESTDIR)${gamedir}"
- chmod u=rwx,g=rwx,o=rx "$(DESTDIR)${gamedir}"
+ -if chgrp ${gamegroup}
"$(DESTDIR)${archlibdir}/update-game-score${EXEEXT}" && chmod g+s,o-r
"$(DESTDIR)${archlibdir}/update-game-score${EXEEXT}"; then \
+ chgrp ${gamegroup} "$(DESTDIR)${gamedir}"; \
+ chmod u=rwx,g=rwx,o=rx "$(DESTDIR)${gamedir}"; \
+ fi
endif
exp_archlibdir=`cd "$(DESTDIR)${archlibdir}" && /bin/pwd`; \
if [ "$$exp_archlibdir" != "`cd ${srcdir} && /bin/pwd`" ]; then \
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7aa66bf..5cceb19 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,41 @@
+2015-01-22 Paul Eggert <address@hidden>
+
+ Don't downcase system diagnostics' first letters
+ * emacs-lisp/bytecomp.el (byte-compile-file):
+ * ffap.el (find-file-at-point):
+ * files.el (insert-file-1):
+ * net/ange-ftp.el (ange-ftp-barf-if-not-directory)
+ (ange-ftp-copy-file-internal):
+ * progmodes/etags.el (visit-tags-table):
+ Keep diagnostics consistent with system's.
+ * ffap.el (ffap-machine-p):
+ Ignore case while comparing diagnostics.
+
+2015-01-22 Stefan Monnier <address@hidden>
+
+ * help.el (help-make-usage): Don't turn a "_" arg into an empty-string
+ arg (bug#19645).
+ * emacs-lisp/cl-generic.el (cl--generic-lambda): Don't confuse a string
+ body with a docstring.
+
+2015-01-22 Dmitry Gutov <address@hidden>
+
+ * progmodes/xref.el (xref-location-marker, xref-location-group):
+ Use `cl-defgeneric' and `cl-defmethod' instead of the EIEIO
+ counterparts.
+
+ * progmodes/etags.el (xref-location-marker): Same.
+
+ * progmodes/xref.el (xref--current): Rename from `xref--selected'.
+ (xref--inhibit-mark-current): Rename from
+ `xref--inhibit-mark-selected'. Update the usages.
+ (xref-quit): Reword the docstring. Kill buffers after quitting
+ windows instead of before.
+ (xref--insert-xrefs): Tweak help-echo.
+ (xref--read-identifier-history, xref--read-pattern-history):
+ New variables.
+ (xref--read-identifier, xref-find-apropos): Use them.
+
2015-01-21 Ulrich Müller <address@hidden>
* play/gamegrid.el (gamegrid-add-score-with-update-game-score):
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 8440570..2bd8d07 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1863,8 +1863,8 @@ The value is non-nil if there were no errors, nil if
errors."
(signal 'file-error
(list "Opening output file"
(if (file-exists-p target-file)
- "cannot overwrite file"
- "directory not writable or nonexistent")
+ "Cannot overwrite file"
+ "Directory not writable or nonexistent")
target-file)))
(kill-buffer (current-buffer)))
(if (and byte-compile-generate-call-tree
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 8dee9a3..f214faf 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -228,7 +228,8 @@ This macro can only be used within the lexical scope of a
cl-generic method."
"Make the lambda expression for a method with ARGS and BODY."
(let ((plain-args ())
(specializers nil)
- (doc-string (if (stringp (car-safe body)) (pop body)))
+ (doc-string (if (and (stringp (car-safe body)) (cdr body))
+ (pop body)))
(mandatory t))
(dolist (arg args)
(push (pcase arg
@@ -252,7 +253,7 @@ This macro can only be used within the lexical scope of a
cl-generic method."
;; destructuring args, `declare' and whatnot).
(pcase (macroexpand fun macroenv)
(`#'(lambda ,args . ,body)
- (let* ((doc-string (and doc-string (stringp (car body))
+ (let* ((doc-string (and doc-string (stringp (car body)) (cdr body)
(pop body)))
(cnm (make-symbol "cl--cnm"))
(nmp (make-symbol "cl--nmp"))
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index 1b54fb6..28ac7d3 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,3 +1,8 @@
+2015-01-22 Paul Eggert <address@hidden>
+
+ Don't downcase system diagnostics' first letters
+ * erc-dcc.el (erc-dcc-server): Ignore case while comparing diagnostics.
+
2014-11-23 Michael Albinus <address@hidden>
* erc-desktop-notifications.el (erc-notifications-bus):
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 9d52c3b..182f1e0 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -379,7 +379,7 @@ created subprocess, or nil."
(set-process-filter-multibyte process nil)))))
(file-error
(unless (and (string= "Cannot bind server socket" (nth 1 err))
- (string= "address already in use" (nth 2 err)))
+ (string= "address already in use" (downcase (nth 2
err))))
(signal (car err) (cdr err)))
(setq port (1+ port))
(unless (< port upper)
@@ -1264,4 +1264,3 @@ other client."
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
-
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 1b8ea60..350a6bd 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -476,7 +476,7 @@ Returned values:
;; (file-error "connection failed" "address already in use"
;; "ftp.uu.net" "ffap-machine-p")
((equal mesg "connection failed")
- (if (equal (nth 2 error) "permission denied")
+ (if (string= (downcase (nth 2 error)) "permission denied")
nil ; host does not exist
;; Other errors mean the host exists:
(nth 2 error)))
@@ -1439,7 +1439,7 @@ and the functions `ffap-file-at-point' and
`ffap-url-at-point'."
(expand-file-name filename)))
;; User does not want to find a non-existent file:
((signal 'file-error (list "Opening file buffer"
- "no such file or directory"
+ "No such file or directory"
filename)))))))
;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}.
diff --git a/lisp/files.el b/lisp/files.el
index e9632ed..ed1943d 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2128,7 +2128,7 @@ This function ensures that none of these modifications
will take place."
(defun insert-file-1 (filename insert-func)
(if (file-directory-p filename)
- (signal 'file-error (list "Opening input file" "file is a directory"
+ (signal 'file-error (list "Opening input file" "Is a directory"
filename)))
;; Check whether the file is uncommonly large
(abort-if-file-too-large (nth 7 (file-attributes filename)) "insert"
filename)
diff --git a/lisp/help.el b/lisp/help.el
index 39ec6be..bf72425 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1445,7 +1445,7 @@ the same names as used in the original source code, when
possible."
(let ((name (symbol-name arg)))
(cond
((string-match "\\`&" name) arg)
- ((string-match "\\`_" name)
+ ((string-match "\\`_." name)
(intern (upcase (substring name 1))))
(t (intern (upcase name)))))))
arglist)))
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 17db6e7..52153ad 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -1536,8 +1536,8 @@ then kill the related FTP process."
(signal 'file-error
(list "Opening directory"
(if (file-exists-p directory)
- "not a directory"
- "no such file or directory")
+ "Not a directory"
+ "No such file or directory")
directory))))
;;;; ------------------------------------------------------------
@@ -3664,7 +3664,7 @@ so return the size on the remote host exactly. See RFC
3659."
(or (file-exists-p filename)
(signal 'file-error
- (list "Copy file" "no such file or directory" filename)))
+ (list "Copy file" "No such file or directory" filename)))
;; canonicalize newname if a directory.
(if (file-directory-p newname)
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index dc3380d..b470352 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -308,7 +308,7 @@ file the tag was in."
(save-excursion
(or (visit-tags-table-buffer file)
(signal 'file-error (list "Visiting tags table"
- "file does not exist"
+ "No such file or directory"
file)))
;; Set FILE to the expanded name.
(setq file tags-file-name)))
@@ -2122,7 +2122,7 @@ for \\[find-tag] (which see)."
(make-instance 'xref-etags-location :tag-info tag-info
:file (expand-file-name file)))
-(defmethod xref-location-marker ((l xref-etags-location))
+(cl-defmethod xref-location-marker ((l xref-etags-location))
(with-slots (tag-info file) l
(let ((buffer (find-file-noselect file)))
(with-current-buffer buffer
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index ee81250..55405b6 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -66,10 +66,10 @@
;; If a backend decides to subclass xref-location it can provide
;; methods for some of the following functions:
-(defgeneric xref-location-marker (location)
+(cl-defgeneric xref-location-marker (location)
"Return the marker for LOCATION.")
-(defgeneric xref-location-group (location)
+(cl-defgeneric xref-location-group (location)
"Return a string used to group a set of locations.
This is typically the filename.")
@@ -88,7 +88,7 @@ Line numbers start from 1 and columns from 0.")
"Create and return a new xref-file-location."
(make-instance 'xref-file-location :file file :line line :column column))
-(defmethod xref-location-marker ((l xref-file-location))
+(cl-defmethod xref-location-marker ((l xref-file-location))
(with-slots (file line column) l
(with-current-buffer
(or (get-file-buffer file)
@@ -102,7 +102,7 @@ Line numbers start from 1 and columns from 0.")
(move-to-column column)
(point-marker))))))
-(defmethod xref-location-group ((l xref-file-location))
+(cl-defmethod xref-location-group ((l xref-file-location))
(oref l :file))
(defclass xref-buffer-location (xref-location)
@@ -113,12 +113,12 @@ Line numbers start from 1 and columns from 0.")
"Create and return a new xref-buffer-location."
(make-instance 'xref-buffer-location :buffer buffer :position position))
-(defmethod xref-location-marker ((l xref-buffer-location))
+(cl-defmethod xref-location-marker ((l xref-buffer-location))
(with-slots (buffer position) l
(let ((m (make-marker)))
(move-marker m position buffer))))
-(defmethod xref-location-group ((l xref-buffer-location))
+(cl-defmethod xref-location-group ((l xref-buffer-location))
(with-slots (buffer) l
(or (buffer-file-name buffer)
(format "(buffer %s)" (buffer-name buffer)))))
@@ -134,10 +134,10 @@ actual location is not known.")
"Create and return a new xref-bogus-location."
(make-instance 'xref-bogus-location :message message))
-(defmethod xref-location-marker ((l xref-bogus-location))
+(cl-defmethod xref-location-marker ((l xref-bogus-location))
(user-error "%s" (oref l :message)))
-(defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
+(cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
;; This should be in elisp-mode.el, but it's preloaded, and we can't
;; preload defclass and defmethod (at least, not yet).
@@ -151,7 +151,7 @@ actual location is not known.")
(defun xref-make-elisp-location (symbol type file)
(make-instance 'xref-elisp-location :symbol symbol :type type :file file))
-(defmethod xref-location-marker ((l xref-elisp-location))
+(cl-defmethod xref-location-marker ((l xref-elisp-location))
(with-slots (symbol type file) l
(let ((buffer-point
(pcase type
@@ -342,15 +342,15 @@ WINDOW controls how the buffer is displayed:
(defvar-local xref--temporary-buffers nil
"List of buffers created by xref code.")
-(defvar-local xref--selected nil
- "t if the current buffer has ever been selected.
+(defvar-local xref--current nil
+ "Non-nil if this buffer was once current, except while displaying xrefs.
Used for temporary buffers.")
-(defvar xref--inhibit-mark-selected nil)
+(defvar xref--inhibit-mark-current nil)
(defun xref--mark-selected ()
- (unless xref--inhibit-mark-selected
- (setq xref--selected t))
+ (unless xref--inhibit-mark-current
+ (setq xref--current t))
(remove-hook 'buffer-list-update-hook #'xref--mark-selected t))
(defun xref--save-to-history (buf win)
@@ -375,7 +375,7 @@ Used for temporary buffers.")
(condition-case err
(let ((xref-buf (current-buffer))
(bl (buffer-list))
- (xref--inhibit-mark-selected t))
+ (xref--inhibit-mark-current t))
(xref--goto-location location)
(let ((buf (current-buffer)))
(unless (memq buf bl)
@@ -438,29 +438,28 @@ Used for temporary buffers.")
(setq buffer-read-only t))
(defun xref-quit (&optional kill)
- "Perform cleanup, then quit the current window.
-The cleanup consists of burying all temporarily displayed
-buffers, and if KILL is non-nil, of killing all buffers that were
-created in the process of showing xrefs.
-
-Exceptions are made for buffers switched to by the user in the
-meantime, and other window configuration changes. These are
-preserved."
+ "Bury temporarily displayed buffers, then quit the current window.
+
+If KILL is non-nil, kill all buffers that were created in the
+process of showing xrefs, and also kill the current buffer.
+
+The buffers that the user has otherwise interacted with in the
+meantime are preserved."
(interactive "P")
(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)))
(when kill
- (let ((xref--inhibit-mark-selected t)
+ (let ((xref--inhibit-mark-current t)
kill-buffer-query-functions)
(dolist (buf xref--temporary-buffers)
- (unless (buffer-local-value 'xref--selected buf)
+ (unless (buffer-local-value 'xref--current buf)
(kill-buffer buf)))
(setq xref--temporary-buffers nil)))
- (pcase-dolist (`(,buf . ,win) history)
- (when (and (window-live-p win)
- (eq buf (window-buffer win)))
- (quit-window nil win)))
(quit-window kill window)))
(defconst xref-buffer-name "*xref*"
@@ -496,7 +495,9 @@ GROUP is a string for decoration purposes and XREF is an
'face 'font-lock-keyword-face
'mouse-face 'highlight
'keymap xref--button-map
- 'help-echo "mouse-2: display in another window,
RET or mouse-1: navigate")
+ 'help-echo
+ (concat "mouse-2: display in another window, "
+ "RET or mouse-1: follow reference"))
description))
(when (or more1 more2)
(insert "\n")))))
@@ -535,6 +536,10 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
(defvar xref-show-xrefs-function 'xref--show-xref-buffer
"Function to display a list of xrefs.")
+(defvar xref--read-identifier-history nil)
+
+(defvar xref--read-pattern-history nil)
+
(defun xref--show-xrefs (input kind arg window)
(let* ((bl (buffer-list))
(xrefs (funcall xref-find-function kind arg))
@@ -557,7 +562,8 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
(cond ((or current-prefix-arg (not id))
(completing-read prompt
(funcall xref-identifier-completion-table-function)
- nil t id))
+ nil t id
+ 'xref--read-identifier-history))
(t id))))
@@ -593,12 +599,15 @@ With prefix argument, prompt for the identifier."
(interactive (list (xref--read-identifier "Find references of: ")))
(xref--show-xrefs identifier 'references identifier nil))
+(declare-function apropos-parse-pattern "apropos" (pattern))
+
;;;###autoload
(defun xref-find-apropos (pattern)
"Find all meaningful symbols that match PATTERN.
The argument has the same meaning as in `apropos'."
(interactive (list (read-from-minibuffer
- "Search for pattern (word list or regexp): ")))
+ "Search for pattern (word list or regexp): "
+ nil nil nil 'xref--read-pattern-history)))
(require 'apropos)
(xref--show-xrefs pattern 'apropos
(apropos-parse-pattern
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 1f5ece0..920d692 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,9 @@
+2015-01-22 Paul Eggert <address@hidden>
+
+ Don't downcase system diagnostics' first letters
+ * url-dav.el (url-dav-delete-directory, url-dav-delete-file)
+ (url-dav-directory-files): Keep diagnostics consistent with system's.
+
2014-12-12 Lars Magne Ingebrigtsen <address@hidden>
* url-http.el (url-http-parse-headers): `gnutls-available-p' is
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el
index 65747e9..61ca088 100644
--- a/lisp/url/url-dav.el
+++ b/lisp/url/url-dav.el
@@ -741,7 +741,7 @@ files in the collection as well."
(if (and (not recursive)
(/= (length props) 1))
(signal 'file-error (list "Removing directory"
- "directory not empty" url)))))
+ "Directory not empty" url)))))
(mapc (lambda (result)
(setq status (plist-get (cdr result) 'DAV:status))
@@ -760,7 +760,7 @@ files in the collection as well."
url lock-token
(setq props (url-dav-get-properties url))
(if (eq (plist-get (cdar props) 'DAV:resourcetype)
'DAV:collection)
- (signal 'file-error (list "Removing old name" "is a
collection" url)))))
+ (signal 'file-error (list "Removing old name" "Is a
collection" url)))))
(mapc (lambda (result)
(setq status (plist-get (cdr result) 'DAV:status))
@@ -787,7 +787,7 @@ If NOSORT is non-nil, the list is not sorted--its order is
unpredictable.
(when (and (= (length properties) 1)
(not (url-dav-file-directory-p url)))
- (signal 'file-error (list "Opening directory" "not a directory" url)))
+ (signal 'file-error (list "Opening directory" "Not a directory" url)))
(while properties
(setq child-props (pop properties)
diff --git a/src/ChangeLog b/src/ChangeLog
index e5e4fe9..8f23dd3 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,21 @@
+2015-01-22 Paul Eggert <address@hidden>
+
+ Don't downcase system diagnostics' first letters
+ * fileio.c (report_file_errno): Don't downcase, and simplify.
+ Fixes: bug#19642
+
+ Isolate NIL_IS_ZERO-assuming code better
+ Suggested by Stefan Monnier in:
+ http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00588.html
+ * alloc.c (allocate_pseudovector):
+ Use memclear, not memsetnil, to remove a 'verify'.
+ * callint.c (Fcall_interactively):
+ * dispnew.c (realloc_glyph_pool):
+ * xdisp.c (init_iterator):
+ Use memclear, not memset, to remove a 'verify'.
+ * lisp.h (memclear): Rename from memsetnil, and take a byte
+ count rather than a word count. All callers changed.
+
2015-01-20 Paul Eggert <address@hidden>
Undo port to hypothetical nonzero Qnil case
diff --git a/src/alloc.c b/src/alloc.c
index bf0456c..571b2b0 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3174,11 +3174,8 @@ allocate_pseudovector (int memlen, int lisplen,
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.
- Since Qnil == 0, we can memset Lisp and non-Lisp data at one go. */
- verify (NIL_IS_ZERO);
- memsetnil (v->contents, zerolen);
-
+ /* Only the first LISPLEN slots will be traced normally by the GC. */
+ memclear (v->contents, zerolen * word_size);
XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen);
return v;
}
diff --git a/src/callint.c b/src/callint.c
index 3a595b5..165d374 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -509,8 +509,7 @@ invoke it. If KEYS is omitted or nil, the return value of
visargs = args + nargs;
varies = (signed char *) (visargs + nargs);
- verify (NIL_IS_ZERO);
- memset (args, 0, nargs * (2 * word_size + 1));
+ memclear (args, nargs * (2 * word_size + 1));
GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
gcpro3.nvars = nargs;
diff --git a/src/coding.c b/src/coding.c
index b95c0a5..43ebbe0 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -11273,7 +11273,7 @@ internal character representation. */);
{
Lisp_Object args[coding_arg_undecided_max];
- memsetnil (args, ARRAYELTS (args));
+ memclear (args, sizeof args);
Lisp_Object plist[16];
plist[0] = intern_c_string (":name");
diff --git a/src/dispnew.c b/src/dispnew.c
index 8c48ae0..e614cee 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -1343,14 +1343,8 @@ 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);
-
- /* Redisplay relies on nil as the object of special glyphs
- (truncation and continuation glyphs and also blanks used to
- extend each line on a TTY), so verify that memset does this. */
- verify (NIL_IS_ZERO);
-
- memset (pool->glyphs + old_nglyphs, 0,
- (pool->nglyphs - old_nglyphs) * sizeof *pool->glyphs);
+ memclear (pool->glyphs + old_nglyphs,
+ (pool->nglyphs - old_nglyphs) * sizeof *pool->glyphs);
}
/* Remember the number of rows and columns because (a) we use them
diff --git a/src/eval.c b/src/eval.c
index ddf6535..e649c15 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2299,7 +2299,8 @@ 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);
- memsetnil (funcall_args + numargs + 1, XSUBR (fun)->max_args - numargs);
+ memclear (funcall_args + numargs + 1,
+ (XSUBR (fun)->max_args - numargs) * word_size);
funcall_nargs = 1 + XSUBR (fun)->max_args;
}
else
@@ -2693,8 +2694,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);
- memsetnil (internal_args + numargs,
- XSUBR (fun)->max_args - numargs);
+ memclear (internal_args + numargs,
+ (XSUBR (fun)->max_args - numargs) * word_size);
}
else
internal_args = args + 1;
diff --git a/src/fileio.c b/src/fileio.c
index ff6720d..d0fd08a 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -186,37 +186,17 @@ void
report_file_errno (char const *string, Lisp_Object name, int errorno)
{
Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
- Lisp_Object errstring;
- char *str;
-
synchronize_system_messages_locale ();
- str = strerror (errorno);
- errstring = code_convert_string_norecord (build_unibyte_string (str),
- Vlocale_coding_system, 0);
-
- while (1)
- switch (errorno)
- {
- case EEXIST:
- xsignal (Qfile_already_exists, Fcons (errstring, data));
- break;
- default:
- /* System error messages are capitalized. Downcase the initial
- unless it is followed by a slash. (The slash case caters to
- error messages that begin with "I/O" or, in German, "E/A".) */
- if (STRING_MULTIBYTE (errstring)
- && ! EQ (Faref (errstring, make_number (1)), make_number ('/')))
- {
- int c;
-
- str = SSDATA (errstring);
- c = STRING_CHAR ((unsigned char *) str);
- Faset (errstring, make_number (0), make_number (downcase (c)));
- }
-
- xsignal (Qfile_error,
- Fcons (build_string (string), Fcons (errstring, data)));
- }
+ char *str = strerror (errorno);
+ Lisp_Object errstring
+ = code_convert_string_norecord (build_unibyte_string (str),
+ Vlocale_coding_system, 0);
+ Lisp_Object errdata = Fcons (errstring, data);
+
+ if (errorno == EEXIST)
+ xsignal (Qfile_already_exists, errdata);
+ else
+ xsignal (Qfile_error, Fcons (build_string (string), errdata));
}
/* Signal a file-access failure that set errno. STRING describes the
diff --git a/src/fns.c b/src/fns.c
index d177294..a4b2e6d 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2524,7 +2524,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object
fn, Lisp_Object seq)
if (vals)
{
/* Don't let vals contain any garbage when GC happens. */
- memsetnil (vals, leni);
+ memclear (vals, leni * word_size);
GCPRO3 (dummy, fn, seq);
gcpro1.var = vals;
@@ -3700,7 +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);
- memsetnil (v->contents + old_size, new_size - old_size);
+ memclear (v->contents + old_size, incr * word_size);
XSETVECTOR (vec, v);
return vec;
}
diff --git a/src/font.c b/src/font.c
index 190b33a..d05742c 100644
--- a/src/font.c
+++ b/src/font.c
@@ -989,14 +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;
- memsetnil (field + j, range[i].from - j);
+ memclear (field + j, (range[i].from - j) * word_size);
j = range[i].from;
}
field[j++] = tmp[i];
}
if (! NILP (tmp[n - 1]) && j < XLFD_REGISTRY_INDEX)
return -1;
- memsetnil (field + j, XLFD_LAST_INDEX - j);
+ memclear (field + j, (XLFD_LAST_INDEX - j) * word_size);
if (INTEGERP (field[XLFD_ENCODING_INDEX]))
field[XLFD_ENCODING_INDEX]
= Fintern (Fnumber_to_string (field[XLFD_ENCODING_INDEX]), Qnil);
diff --git a/src/lisp.h b/src/lisp.h
index f1e6945..76a9ed8 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1513,13 +1513,15 @@ gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object
val)
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 N entries to nil. */
+/* Clear the object addressed by P, with size NBYTES, so that all its
+ bytes are zero and all its Lisp values are nil. */
INLINE void
-memsetnil (Lisp_Object *v, ptrdiff_t n)
+memclear (void *p, ptrdiff_t nbytes)
{
- eassert (0 <= n);
+ eassert (0 <= nbytes);
verify (NIL_IS_ZERO);
- memset (v, 0, n * sizeof *v);
+ /* Since Qnil is zero, memset suffices. */
+ memset (p, 0, nbytes);
}
/* If a struct is made to look like a vector, this macro returns the length
diff --git a/src/xdisp.c b/src/xdisp.c
index 5e57e05..280be6b 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -2752,13 +2752,7 @@ init_iterator (struct it *it, struct window *w,
row = MATRIX_HEADER_LINE_ROW (w->desired_matrix);
}
- /* Clear IT. */
-
- /* The code assumes it->object and other Lisp_Object components are
- set to nil, so verify that memset does this. */
- verify (NIL_IS_ZERO);
- memset (it, 0, sizeof *it);
-
+ memclear (it, sizeof *it);
it->current.overlay_string_index = -1;
it->current.dpvec_index = -1;
it->base_face_id = remapped_base_face_id;
diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el
index e0120b4..847aefd 100644
--- a/test/automated/eieio-tests.el
+++ b/test/automated/eieio-tests.el
@@ -655,7 +655,7 @@ Do not override for `prot-2'."
(oref eitest-p1 slot-1)
(oref eitest-p2 slot-1)
;; Accessing protected slot out of context used to fail, but we dropped this
- ;; feature, since it was underused and noone noticed that the check was
+ ;; feature, since it was underused and no one noticed that the check was
;; incorrect (much too loose).
;;PROTECTED (should-error (oref eitest-p1 slot-2) :type 'invalid-slot-name)
;; Access protected slot in method