Commit 5491fd10 authored by Fabián Ezequiel Gallina's avatar Fabián Ezequiel Gallina

Merge branch 'master' of

parents 028ddef7 2668ac1a
......@@ -63,6 +63,24 @@
Fix dired quoting bug with "Hit`N`Hide". Fixes Bug#19498.
* files.el (shell-quote-wildcard-pattern): Also quote "`".
2015-01-28 Stefan Monnier <>
Tighten up the tagcode used for eieio and cl-struct objects.
* loadup.el: Load cl-preloaded.
* emacs-lisp/eieio-core.el (eieio-defclass-internal): Set the function
slot of the tag symbol to :quick-object-witness-check.
(eieio-object-p): Use :quick-object-witness-check.
(eieio--generic-tagcode): Use cl--generic-struct-tag.
* emacs-lisp/cl-preloaded.el: New file.
* emacs-lisp/cl-macs.el (cl--bind-inits): Remove, unused.
(cl--transform-lambda, cl-destructuring-bind): Remove cl--bind-inits.
(cl--make-usage-args): Strip away &aux args.
(cl-case, cl-typecase, cl--parse-loop-clause): Use macroexp-let2.
(cl-the, cl-check-type): Use macroexp-let2 and cl-typep.
(cl-defstruct): Use `declare' and cl-struct-define.
* emacs-lisp/cl-generic.el (cl--generic-struct-tag): New function.
(cl--generic-struct-tagcode): Use it to tighten the tagcode.
2015-01-27 Katsumi Yamaoka <>
* emacs-lisp/cl.el (cl--function-convert):
......@@ -150,6 +168,8 @@
2015-01-26 Lars Ingebrigtsen <>
* net/shr.el (shr-make-table-1): Fix colspan typo.
(shr-make-table-1): Add comments.
(shr-make-table-1): Make colspan display more sensibly.
* net/eww.el (eww-add-bookmark): Fix prompt and clean up the code
......@@ -724,6 +724,14 @@ Can only be used from within the lexical body of a primary or around method."
(add-function :before-until cl-generic-tagcode-function
(defun cl--generic-struct-tag (name)
`(and (vectorp ,name)
(> (length ,name) 0)
(let ((tag (aref ,name 0)))
(if (eq (symbol-function tag) :quick-object-witness-check)
(defun cl--generic-struct-tagcode (type name)
(and (symbolp type)
(get type 'cl-struct-type)
......@@ -733,12 +741,19 @@ Can only be used from within the lexical body of a primary or around method."
(or (equal '(cl-tag-slot) (car (get type 'cl-struct-slots)))
(error "Can't dispatch on cl-struct %S: no tag in slot 0"
;; We could/should check the vector has length >0,
;; but really, mixing vectors and structs is a bad idea,
;; so let's not waste time trying to handle the case
;; of an empty vector.
;; BEWARE: this returns a bogus tag for non-struct vectors.
`(50 . (and (vectorp ,name) (aref ,name 0)))))
;; It's tempting to use (and (vectorp ,name) (aref ,name 0))
;; but that would suffer from some problems:
;; - the vector may have size 0.
;; - when called on an actual vector (rather than an object), we'd
;; end up returning an arbitrary value, possibly colliding with
;; other tagcode's values.
;; - it can also result in returning all kinds of irrelevant
;; values which would end up filling up the method-cache with
;; lots of irrelevant/redundant entries.
;; FIXME: We could speed this up by introducing a dedicated
;; vector type at the C level, so we could do something like
;; (and (vector-objectp ,name) (aref ,name 0))
`(50 . ,(cl--generic-struct-tag name))))
(add-function :before-until cl-generic-tag-types-function
This diff is collapsed.
;;; cl-preloaded.el --- Preloaded part of the CL library -*- lexical-binding: t; -*-
;; Copyright (C) 2015 Free Software Foundation, Inc
;; Author: Stefan Monnier <>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <>.
;;; Commentary:
;; The expectation is that structs defined with cl-defstruct do not
;; need cl-lib at run-time, but we'd like to hide the details of the
;; cl-struct metadata behind the cl-struct-define function, so we put
;; it in this pre-loaded file.
;;; Code:
(defun cl-struct-define (name docstring parent type named slots children-sym
tag print-auto)
(if (boundp children-sym)
(add-to-list children-sym tag)
(set children-sym (list tag)))
;; 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
;; to put a special witness value, to make the check easy and reliable.
(unless named (fset tag :quick-object-witness-check))
(put name 'cl-struct-slots slots)
(put name 'cl-struct-type (list type named))
(if parent (put name 'cl-struct-include parent))
(if print-auto (put name 'cl-struct-print print-auto))
(if docstring (put name 'structure-documentation docstring)))
(provide 'cl-preloaded)
;;; cl-preloaded.el ends here
......@@ -224,9 +224,9 @@ Return nil if that option doesn't exist."
(defsubst eieio-object-p (obj)
"Return non-nil if OBJ is an EIEIO object."
(and (vectorp obj)
(condition-case nil
(eq (aref (eieio--object-class-object obj) 0) 'defclass)
(error nil))))
(> (length obj) 0)
(eq (symbol-function (eieio--class-tag obj))
(defalias 'object-p 'eieio-object-p)
......@@ -539,6 +539,7 @@ See `defclass' for more information."
;; objects readable.
(tag (intern (format "eieio-class-tag--%s" cname))))
(set tag newc)
(fset tag :quick-object-witness-check)
(setf (eieio--object-class-tag cache) tag)
(let ((eieio-skip-typecheck t))
;; All type-checking has been done to our satisfaction
......@@ -1223,9 +1224,10 @@ method invocation orders of the involved classes."
;; specializer in a defmethod form.
;; So we can ignore types that are not known to denote classes.
(and (class-p type)
;; Prefer (aref ,name 0) over (eieio--class-tag ,name) so that
;; the tagcode is identical to the tagcode used for cl-struct.
`(50 . (and (vectorp ,name) (aref ,name 0)))))
;; Use the exact same code as for cl-struct, so that methods
;; that dispatch on both kinds of objects get to share this
;; part of the dispatch code.
`(50 . ,(cl--generic-struct-tag name))))
(add-function :before-until cl-generic-tag-types-function
......@@ -145,7 +145,8 @@
(file-error (load "ldefs-boot.el")))
(load "emacs-lisp/nadvice")
(load "minibuffer")
(load "emacs-lisp/cl-preloaded")
(load "minibuffer") ;After loaddefs, for define-minor-mode.
(load "abbrev") ;lisp-mode.el and simple.el use define-abbrev-table.
(load "simple")
......@@ -1628,6 +1628,8 @@ The preference is a float determined from `shr-prefer-media-type'."
(let ((trs nil)
(shr-inhibit-decoration (not fill))
(rowspans (make-vector (length widths) 0))
(colspan-remaining 0)
colspan-width colspan-count
width colspan)
(dolist (row (dom-non-text-children dom))
(when (eq (dom-tag row) 'tr)
......@@ -1659,24 +1661,39 @@ The preference is a float determined from `shr-prefer-media-type'."
(if column
(aref widths width-column)
(when (and fill
(setq colspan (dom-attr column 'colspan)))
(when (setq colspan (dom-attr column 'colspan))
(setq colspan (min (string-to-number colspan)
;; The colspan may be wrong, so
;; truncate it to the length of the
;; remaining columns.
(- (length widths) i)))
(dotimes (j (1- colspan))
(if (> (+ i 1 j) (1- (length widths)))
(setq width (aref widths (1- (length widths))))
(setq width (+ width
(aref widths (+ i 1 j))))))
(setq width-column (+ width-column (1- colspan))))
(setq width
(if (> (+ i 1 j) (1- (length widths)))
;; If we have a colspan spec that's longer
;; than the table is wide, just use the last
;; width as the width.
(aref widths (1- (length widths)))
;; Sum up the widths of the columns we're
;; spanning.
(+ width
(aref widths (+ i 1 j))))))
(setq width-column (+ width-column (1- colspan))
colspan-count colspan
colspan-remaining colspan))
(when (or column
(not fill))
(push (shr-render-td column width fill)
(let ((data (shr-render-td column width fill)))
(if (and (not fill)
(> colspan-remaining 0))
(when (= colspan-count colspan-remaining)
(setq colspan-width data))
(let ((this-width (/ colspan-width colspan-count)))
(push this-width tds)
(setq colspan-remaining (1- colspan-remaining))))
(push data tds))))
(setq i (1+ i)
width-column (1+ width-column))))
(push (nreverse tds) trs))))
......@@ -57,6 +57,10 @@
* emacs.c (syms_of_emacs) <system-configuration>: Doc fix.
2015-01-28 Stefan Monnier <>
* (lisp): Add cl-preloaded.
2015-01-27 Paul Eggert <>
Use bool for boolean in xfaces.c
......@@ -71,6 +71,7 @@ lisp = \
$(lispsource)/faces.elc \
$(lispsource)/button.elc \
$(lispsource)/startup.elc \
$(lispsource)/emacs-lisp/cl-preloaded.elc \
$(lispsource)/emacs-lisp/nadvice.elc \
$(lispsource)/minibuffer.elc \
$(lispsource)/abbrev.elc \
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment