------------------------------------------------------------ revno: 116996 committer: Daniel Colascione branch nick: trunk timestamp: Sun 2014-04-20 07:46:13 -0700 message: unbreak the build diff: === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2014-04-20 02:34:22 +0000 +++ lisp/emacs-lisp/cl-macs.el 2014-04-20 14:46:13 +0000 @@ -2624,66 +2624,6 @@ (error "struct %s has no slot %s" struct-type slot-name))) (put 'cl-struct-slot-offset 'side-effect-free t) -(defun 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." - (unless (cl-typep inst struct-type) - (signal 'wrong-type-argument (list struct-type inst))) - (elt inst (cl-struct-slot-offset struct-type slot-name))) -(put 'cl-struct-slot-value 'side-effect-free t) - -(defun cl-struct-set-slot-value (struct-type slot-name inst value) - "Set the value of slot SLOT-NAME in INST of STRUCT-TYPE. -STRUCT and SLOT-NAME are symbols. INST is a structure instance. -VALUE is the value to which to set the given slot. Return -VALUE." - (unless (cl-typep inst struct-type) - (signal 'wrong-type-argument (list struct-type inst))) - (setf (elt inst (cl-struct-slot-offset struct-type slot-name)) value)) - -(defsetf cl-struct-slot-value cl-struct-set-slot-value) - -(cl-define-compiler-macro cl-struct-slot-value - (&whole orig struct-type slot-name inst) - (or (let* ((macenv macroexpand-all-environment) - (struct-type (cl--const-expr-val struct-type macenv)) - (slot-name (cl--const-expr-val slot-name macenv))) - (and struct-type (symbolp struct-type) - slot-name (symbolp slot-name) - (assq slot-name (cl-struct-slot-info struct-type)) - (let ((idx (cl-struct-slot-offset struct-type slot-name))) - (cl-ecase (cl-struct-sequence-type struct-type) - (vector `(aref (cl-the ,struct-type ,inst) ,idx)) - (list `(nth ,idx (cl-the ,struct-type ,inst))))))) - orig)) - -(cl-define-compiler-macro cl-struct-set-slot-value - (&whole orig struct-type slot-name inst value) - (or (let* ((macenv macroexpand-all-environment) - (struct-type (cl--const-expr-val struct-type macenv)) - (slot-name (cl--const-expr-val slot-name macenv))) - (and struct-type (symbolp struct-type) - slot-name (symbolp slot-name) - (assq slot-name (cl-struct-slot-info struct-type)) - (let ((idx (cl-struct-slot-offset struct-type slot-name))) - (cl-ecase (cl-struct-sequence-type struct-type) - (vector `(setf (aref (cl-the ,struct-type ,inst) ,idx) - ,value)) - (list `(setf (nth ,idx (cl-the ,struct-type ,inst)) - ,value)))))) - orig)) - -;;; Types and assertions. - -;;;###autoload -(defmacro cl-deftype (name arglist &rest body) - "Define NAME as a new data type. -The type name can then be used in `cl-typecase', `cl-check-type', etc." - (declare (debug cl-defmacro) (doc-string 3)) - `(cl-eval-when (compile load eval) - (put ',name 'cl-deftype-handler - (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body))))) - (defvar byte-compile-function-environment) (defvar byte-compile-macro-environment) @@ -2985,6 +2925,68 @@ '(eql cl-list* cl-subst cl-acons cl-equalp cl-random-state-p copy-tree cl-sublis)) +;;; Types and assertions. + +;;;###autoload +(defmacro cl-deftype (name arglist &rest body) + "Define NAME as a new data type. +The type name can then be used in `cl-typecase', `cl-check-type', etc." + (declare (debug cl-defmacro) (doc-string 3)) + `(cl-eval-when (compile load eval) + (put ',name 'cl-deftype-handler + (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body))))) + +;;; Additional functions that we can now define because we've defined +;;; `cl-define-compiler-macro' and `cl-typep'. + +(defun 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." + (unless (cl-typep inst struct-type) + (signal 'wrong-type-argument (list struct-type inst))) + (elt inst (cl-struct-slot-offset struct-type slot-name))) +(put 'cl-struct-slot-value 'side-effect-free t) + +(defun cl-struct-set-slot-value (struct-type slot-name inst value) + "Set the value of slot SLOT-NAME in INST of STRUCT-TYPE. +STRUCT and SLOT-NAME are symbols. INST is a structure instance. +VALUE is the value to which to set the given slot. Return +VALUE." + (unless (cl-typep inst struct-type) + (signal 'wrong-type-argument (list struct-type inst))) + (setf (elt inst (cl-struct-slot-offset struct-type slot-name)) value)) + +(gv-define-simple-setter cl-struct-slot-value cl-struct-set-slot-value) + +(cl-define-compiler-macro cl-struct-slot-value + (&whole orig struct-type slot-name inst) + (or (let* ((macenv macroexpand-all-environment) + (struct-type (cl--const-expr-val struct-type macenv)) + (slot-name (cl--const-expr-val slot-name macenv))) + (and struct-type (symbolp struct-type) + slot-name (symbolp slot-name) + (assq slot-name (cl-struct-slot-info struct-type)) + (let ((idx (cl-struct-slot-offset struct-type slot-name))) + (cl-ecase (cl-struct-sequence-type struct-type) + (vector `(aref (cl-the ,struct-type ,inst) ,idx)) + (list `(nth ,idx (cl-the ,struct-type ,inst))))))) + orig)) + +(cl-define-compiler-macro cl-struct-set-slot-value + (&whole orig struct-type slot-name inst value) + (or (let* ((macenv macroexpand-all-environment) + (struct-type (cl--const-expr-val struct-type macenv)) + (slot-name (cl--const-expr-val slot-name macenv))) + (and struct-type (symbolp struct-type) + slot-name (symbolp slot-name) + (assq slot-name (cl-struct-slot-info struct-type)) + (let ((idx (cl-struct-slot-offset struct-type slot-name))) + (cl-ecase (cl-struct-sequence-type struct-type) + (vector `(setf (aref (cl-the ,struct-type ,inst) ,idx) + ,value)) + (list `(setf (nth ,idx (cl-the ,struct-type ,inst)) + ,value)))))) + orig)) (run-hooks 'cl-macs-load-hook) ------------------------------------------------------------ revno: 116995 [merge] committer: Daniel Colascione branch nick: trunk timestamp: Sat 2014-04-19 19:51:17 -0700 message: cl-lib defstruct introspection diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2014-04-17 01:35:20 +0000 +++ doc/misc/ChangeLog 2014-04-20 02:50:36 +0000 @@ -1,3 +1,7 @@ +2014-04-20 Daniel Colascione + + * cl.texi (Declarations): Document changes to `cl-the' and defstruct functions. + 2014-04-17 Paul Eggert * Makefile.in (infoclean): Be consistent about reporting failures. === modified file 'doc/misc/cl.texi' --- doc/misc/cl.texi 2014-02-03 07:26:59 +0000 +++ doc/misc/cl.texi 2014-04-20 02:50:36 +0000 @@ -2627,10 +2627,10 @@ @end defmac @defmac cl-the type form -Type information provided by @code{cl-the} is ignored in this package; -in other words, @code{(cl-the @var{type} @var{form})} is equivalent to -@var{form}. Future byte-compiler optimizations may make use of this -information. +@code{cl-the} returns the value of @code{form}, first checking (if +optimization settings permit) that it is of type @code{type}. Future +byte-compiler optimizations may also make use of this information to +improve runtime efficiency. For example, @code{mapcar} can map over both lists and arrays. It is hard for the compiler to expand @code{mapcar} into an in-line loop @@ -4247,6 +4247,51 @@ Except as noted, the @code{cl-defstruct} facility of this package is entirely compatible with that of Common Lisp. +The @code{cl-defstruct} package also provides a few structure +introspection functions. + +@defun cl-struct-sequence-type struct-type +This function returns the underlying data structure for +@code{struct-type}, which is a symbol. It returns @code{vector} or +@code{list}, or @code{nil} if @code{struct-type} is not actually a +structure. +@end defun + +@defun cl-struct-slot-info struct-type +This function returns a list of slot descriptors for structure +@code{struct-type}. Each entry in the list is @code{(name . opts)}, +where @code{name} is the name of the slot and @code{opts} is the list +of slot options given to @code{defstruct}. Dummy entries represent +the slots used for the struct name and that are skipped to implement +@code{:initial-offset}. +@end defun + +@defun cl-struct-slot-offset struct-type slot-name +Return the offset of slot @code{slot-name} in @code{struct-type}. The +returned zero-based slot index is relative to the start of the +structure data type and is adjusted for any structure name and +:initial-offset slots. Signal error if struct @code{struct-type} does +not contain @code{slot-name}. +@end defun + +@defun cl-struct-slot-value struct-type slot-name inst +Return the value of slot @code{slot-name} in @code{inst} of +@code{struct-type}. @code{struct} and @code{slot-name} are symbols. +@code{inst} is a structure instance. This routine is also a +@code{setf} place. @code{cl-struct-slot-value} uses +@code{cl-struct-slot-offset} internally and can signal the same +errors. +@end defun + +@defun cl-struct-set-slot-value struct-type slot-name inst value +Set the value of slot @code{slot-name} in @code{inst} of +@code{struct-type}. @code{struct} and @code{slot-name} are symbols. +@code{inst} is a structure instance. @code{value} is the value to +which to set the given slot. Return @code{value}. +@code{cl-struct-slot-value} uses @code{cl-struct-set-slot-offset} +internally and can signal the same errors. +@end defun + @node Assertions @chapter Assertions and Errors === modified file 'etc/ChangeLog' --- etc/ChangeLog 2014-04-17 07:54:23 +0000 +++ etc/ChangeLog 2014-04-20 02:50:36 +0000 @@ -1,3 +1,7 @@ +2014-04-20 Daniel Colascione + + * NEWS: Mention new struct functions and changes to `cl-the'. + 2014-04-17 Daniel Colascione * NEWS: Mention bracketed paste support. === modified file 'etc/NEWS' --- etc/NEWS 2014-04-17 07:54:23 +0000 +++ etc/NEWS 2014-04-20 02:50:36 +0000 @@ -90,6 +90,8 @@ ** deactivate-mark is now buffer-local. +** cl-the now asserts that its argument is of the given type. + * Lisp Changes in Emacs 24.5 @@ -97,6 +99,9 @@ ** You can specify a function's interactive-only property via `declare'. However you specify it, the property affects `describe-function' output. +** You can access the slots of structures using `cl-struct-slot-value' + and `cl-struct-set-slot-value'. + * Changes in Emacs 24.5 on Non-Free Operating Systems === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-19 20:32:05 +0000 +++ lisp/ChangeLog 2014-04-20 02:34:22 +0000 @@ -1,3 +1,16 @@ +2014-04-20 Daniel Colascione + + * emacs-lisp/cl-macs.el (cl-the): Make `cl-the' assert its type + argument. + (cl--const-expr-val): cl--const-expr-val should macroexpand its + argument in case we're inside a symbol-macrolet. + (cl--do-arglist, cl--compiler-macro-typep) + (cl--compiler-macro-member, cl--compiler-macro-assoc): Pass macro + environment to `cl--const-expr-val'. + (cl-struct-sequence-type,cl-struct-slot-info) + (cl-struct-slot-offset, cl-struct-slot-value) + (cl-struct-set-slot-value): New functions. + 2014-04-19 Stefan Monnier * progmodes/sh-script.el (sh-smie--sh-keyword-p): Handle variable === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2014-03-26 15:57:13 +0000 +++ lisp/emacs-lisp/cl-macs.el 2014-04-20 02:34:22 +0000 @@ -134,8 +134,15 @@ ((symbolp x) (and (memq x '(nil t)) t)) (t t))) -(defun cl--const-expr-val (x) - (and (macroexp-const-p x) (if (consp x) (nth 1 x) x))) +(defun cl--const-expr-val (x &optional environment default) + "Return the value of X known at compile-time. +If X is not known at compile time, return DEFAULT. Before +testing whether X is known at compile time, macroexpand it in +ENVIRONMENT." + (let ((x (macroexpand-all x environment))) + (if (macroexp-const-p x) + (if (consp x) (nth 1 x) x) + default))) (defun cl--expr-contains (x y) "Count number of times X refers to Y. Return nil for 0 times." @@ -519,7 +526,8 @@ look `(or ,look ,(if (eq (cl--const-expr-p def) t) - `'(nil ,(cl--const-expr-val def)) + `'(nil ,(cl--const-expr-val + def macroexpand-all-environment)) `(list nil ,def)))))))) (push karg keys))))) (setq keys (nreverse keys)) @@ -2057,10 +2065,21 @@ (declare (debug t)) (cons 'progn body)) ;;;###autoload -(defmacro cl-the (_type form) - "At present this ignores TYPE and is simply equivalent to FORM." +(defmacro cl-the (type form) + "Return FORM. If type-checking is enabled, assert that it is of TYPE." (declare (indent 1) (debug (cl-type-spec form))) - form) + (if (not (or (not (cl--compiling-file)) + (< cl--optimize-speed 3) + (= cl--optimize-safety 3))) + form + (let* ((temp (if (cl--simple-expr-p form 3) + form (make-symbol "--cl-var--"))) + (body `(progn (unless ,(cl--make-type-test temp type) + (signal 'wrong-type-argument + (list ',type ,temp ',form))) + ,temp))) + (if (eq temp form) body + `(let ((,temp ,form)) ,body))))) (defvar cl--proclaim-history t) ; for future compilers (defvar cl--declare-stack t) ; for future compilers @@ -2577,6 +2596,83 @@ forms) `(progn ,@(nreverse (cons `',name forms))))) +(defun cl-struct-sequence-type (struct-type) + "Return the sequence used to build STRUCT-TYPE. +STRUCT-TYPE is a symbol naming a struct type. Return 'vector or +'list, or nil if STRUCT-TYPE is not a struct type. " + (car (get struct-type 'cl-struct-type))) +(put 'cl-struct-sequence-type 'side-effect-free t) + +(defun cl-struct-slot-info (struct-type) + "Return a list of slot names of struct STRUCT-TYPE. +Each entry is a list (SLOT-NAME . OPTS), where SLOT-NAME is a +slot name symbol and OPTS is a list of slot options given to +`cl-defstruct'. Dummy slots that represent the struct name and +slots skipped by :initial-offset may appear in the list." + (get struct-type 'cl-struct-slots)) +(put 'cl-struct-slot-info 'side-effect-free t) + +(defun cl-struct-slot-offset (struct-type slot-name) + "Return the offset of slot SLOT-NAME in STRUCT-TYPE. +The returned zero-based slot index is relative to the start of +the structure data type and is adjusted for any structure name +and :initial-offset slots. Signal error if struct STRUCT-TYPE +does not contain SLOT-NAME." + (or (cl-position slot-name + (cl-struct-slot-info struct-type) + :key #'car :test #'eq) + (error "struct %s has no slot %s" struct-type slot-name))) +(put 'cl-struct-slot-offset 'side-effect-free t) + +(defun 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." + (unless (cl-typep inst struct-type) + (signal 'wrong-type-argument (list struct-type inst))) + (elt inst (cl-struct-slot-offset struct-type slot-name))) +(put 'cl-struct-slot-value 'side-effect-free t) + +(defun cl-struct-set-slot-value (struct-type slot-name inst value) + "Set the value of slot SLOT-NAME in INST of STRUCT-TYPE. +STRUCT and SLOT-NAME are symbols. INST is a structure instance. +VALUE is the value to which to set the given slot. Return +VALUE." + (unless (cl-typep inst struct-type) + (signal 'wrong-type-argument (list struct-type inst))) + (setf (elt inst (cl-struct-slot-offset struct-type slot-name)) value)) + +(defsetf cl-struct-slot-value cl-struct-set-slot-value) + +(cl-define-compiler-macro cl-struct-slot-value + (&whole orig struct-type slot-name inst) + (or (let* ((macenv macroexpand-all-environment) + (struct-type (cl--const-expr-val struct-type macenv)) + (slot-name (cl--const-expr-val slot-name macenv))) + (and struct-type (symbolp struct-type) + slot-name (symbolp slot-name) + (assq slot-name (cl-struct-slot-info struct-type)) + (let ((idx (cl-struct-slot-offset struct-type slot-name))) + (cl-ecase (cl-struct-sequence-type struct-type) + (vector `(aref (cl-the ,struct-type ,inst) ,idx)) + (list `(nth ,idx (cl-the ,struct-type ,inst))))))) + orig)) + +(cl-define-compiler-macro cl-struct-set-slot-value + (&whole orig struct-type slot-name inst value) + (or (let* ((macenv macroexpand-all-environment) + (struct-type (cl--const-expr-val struct-type macenv)) + (slot-name (cl--const-expr-val slot-name macenv))) + (and struct-type (symbolp struct-type) + slot-name (symbolp slot-name) + (assq slot-name (cl-struct-slot-info struct-type)) + (let ((idx (cl-struct-slot-offset struct-type slot-name))) + (cl-ecase (cl-struct-sequence-type struct-type) + (vector `(setf (aref (cl-the ,struct-type ,inst) ,idx) + ,value)) + (list `(setf (nth ,idx (cl-the ,struct-type ,inst)) + ,value)))))) + orig)) + ;;; Types and assertions. ;;;###autoload @@ -2653,7 +2749,8 @@ (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))) + (cl--make-type-test temp (cl--const-expr-val + type macroexpand-all-environment))) form)) ;;;###autoload @@ -2829,7 +2926,8 @@ (defun cl--compiler-macro-member (form a list &rest keys) (let ((test (and (= (length keys) 2) (eq (car keys) :test) - (cl--const-expr-val (nth 1 keys))))) + (cl--const-expr-val (nth 1 keys) + macroexpand-all-environment)))) (cond ((eq test 'eq) `(memq ,a ,list)) ((eq test 'equal) `(member ,a ,list)) ((or (null keys) (eq test 'eql)) `(memql ,a ,list)) @@ -2837,11 +2935,12 @@ (defun cl--compiler-macro-assoc (form a list &rest keys) (let ((test (and (= (length keys) 2) (eq (car keys) :test) - (cl--const-expr-val (nth 1 keys))))) + (cl--const-expr-val (nth 1 keys) + macroexpand-all-environment)))) (cond ((eq test 'eq) `(assq ,a ,list)) ((eq test 'equal) `(assoc ,a ,list)) ((and (macroexp-const-p a) (or (null keys) (eq test 'eql))) - (if (floatp (cl--const-expr-val a)) + (if (floatp (cl--const-expr-val a macroexpand-all-environment)) `(assoc ,a ,list) `(assq ,a ,list))) (t form)))) === modified file 'test/ChangeLog' --- test/ChangeLog 2014-04-19 20:32:05 +0000 +++ test/ChangeLog 2014-04-20 02:34:22 +0000 @@ -1,3 +1,7 @@ +2014-04-20 Daniel Colascione + + * automated/cl-lib.el (cl-lib-struct-accessors,cl-the): New tests. + 2014-04-19 Michael Albinus * automated/tramp-tests.el (tramp--test-check-files): Extend test. === modified file 'test/automated/cl-lib.el' --- test/automated/cl-lib.el 2014-03-23 06:02:36 +0000 +++ test/automated/cl-lib.el 2014-04-20 02:34:22 +0000 @@ -201,4 +201,23 @@ :b :a :a 42) '(42 :a)))) +(ert-deftest cl-lib-struct-accessors () + (cl-defstruct mystruct (abc :readonly t) def) + (let ((x (make-mystruct :abc 1 :def 2))) + (should (eql (cl-struct-slot-value 'mystruct 'abc x) 1)) + (should (eql (cl-struct-slot-value 'mystruct 'def x) 2)) + (cl-struct-set-slot-value 'mystruct 'def x -1) + (should (eql (cl-struct-slot-value 'mystruct 'def x) -1)) + (should (eql (cl-struct-slot-offset 'mystruct 'abc) 1)) + (should-error (cl-struct-slot-offset 'mystruct 'marypoppins)) + (should (equal (cl-struct-slot-info 'mystruct) + '((cl-tag-slot) (abc :readonly t) (def)))))) + +(ert-deftest cl-the () + (should (eql (the integer 42) 42)) + (should-error (the integer "abc")) + (let ((sideffect 0)) + (should (= (the integer (incf sideffect)) 1)) + (should (= sideffect 1)))) + ;;; cl-lib.el ends here ------------------------------------------------------------ revno: 116994 committer: Paul Eggert branch nick: trunk timestamp: Sat 2014-04-19 15:19:54 -0700 message: * configure.ac: Add comment explaining why HAVE_GLIB is different. diff: === modified file 'configure.ac' --- configure.ac 2014-04-19 17:45:20 +0000 +++ configure.ac 2014-04-19 22:19:54 +0000 @@ -3806,6 +3806,13 @@ AC_CHECK_FUNCS(snprintf) +dnl Check for glib. This differs from other library checks in that +dnl Emacs need not link to glib unless some other library is already +dnl linking to glib. Although glib provides no facilities that Emacs +dnl needs for its own purposes, when glib is present Emacs needs to +dnl use primitives like g_main_context_query to avoid clashing with +dnl glib at a low level. +dnl dnl Check this late, since it depends on $GTK_CFLAGS etc. XGSELOBJ= OLDCFLAGS="$CFLAGS" ------------------------------------------------------------ revno: 116993 [merge] committer: Daniel Colascione branch nick: trunk timestamp: Sat 2014-04-19 13:32:05 -0700 message: Merge from emacs-24; up to r116985 diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-18 23:36:51 +0000 +++ lisp/ChangeLog 2014-04-19 20:32:05 +0000 @@ -1,3 +1,8 @@ +2014-04-19 Stefan Monnier + + * progmodes/sh-script.el (sh-smie--sh-keyword-p): Handle variable + assignments such as "case=hello" (bug#17297). + 2014-04-18 Michael Albinus * net/tramp.el (tramp-run-real-handler, tramp-file-name-handler): === modified file 'lisp/progmodes/sh-script.el' --- lisp/progmodes/sh-script.el 2014-03-05 19:02:55 +0000 +++ lisp/progmodes/sh-script.el 2014-04-19 17:14:27 +0000 @@ -1832,9 +1832,10 @@ (defun sh-smie--sh-keyword-p (tok) "Non-nil if TOK (at which we're looking) really is a keyword." - (if (equal tok "in") - (sh-smie--sh-keyword-in-p) - (sh-smie--keyword-p))) + (cond + ((looking-at "[[:alnum:]_]+=") nil) + ((equal tok "in") (sh-smie--sh-keyword-in-p)) + (t (sh-smie--keyword-p)))) (defun sh-smie-sh-forward-token () (if (and (looking-at "[ \t]*\\(?:#\\|\\(\\s|\\)\\|$\\)") === modified file 'src/ChangeLog' --- src/ChangeLog 2014-04-18 23:36:51 +0000 +++ src/ChangeLog 2014-04-19 20:32:05 +0000 @@ -1,3 +1,9 @@ +2014-04-19 Stefan Monnier + + * intervals.c (rotate_right, rotate_left): Fix up length computation. + Also change identifiers to match the comments, and add more assertions + (bug#16234). + 2014-04-18 Paul Eggert * emacs.c (close_output_streams): Don't clear and restore errno. === modified file 'src/intervals.c' --- src/intervals.c 2014-01-21 02:28:57 +0000 +++ src/intervals.c 2014-04-19 18:13:26 +0000 @@ -332,39 +332,43 @@ */ static INTERVAL -rotate_right (INTERVAL interval) +rotate_right (INTERVAL A) { - INTERVAL i; - INTERVAL B = interval->left; - ptrdiff_t old_total = interval->total_length; + INTERVAL B = A->left; + INTERVAL c = B->right; + ptrdiff_t old_total = A->total_length; + + eassert (old_total > 0); + eassert (old_total + > TOTAL_LENGTH (B) + TOTAL_LENGTH (A->right)); + eassert (TOTAL_LENGTH (B) + > TOTAL_LENGTH (B->left) + TOTAL_LENGTH (c)); /* Deal with any Parent of A; make it point to B. */ - if (! ROOT_INTERVAL_P (interval)) + if (! ROOT_INTERVAL_P (A)) { - if (AM_LEFT_CHILD (interval)) - set_interval_left (INTERVAL_PARENT (interval), B); + if (AM_LEFT_CHILD (A)) + set_interval_left (INTERVAL_PARENT (A), B); else - set_interval_right (INTERVAL_PARENT (interval), B); + set_interval_right (INTERVAL_PARENT (A), B); } - copy_interval_parent (B, interval); - - /* Make B the parent of A */ - i = B->right; - set_interval_right (B, interval); - set_interval_parent (interval, B); - - /* Make A point to c */ - set_interval_left (interval, i); - if (i) - set_interval_parent (i, interval); + copy_interval_parent (B, A); + + /* Make B the parent of A. */ + set_interval_right (B, A); + set_interval_parent (A, B); + + /* Make A point to c. */ + set_interval_left (A, c); + if (c) + set_interval_parent (c, A); /* A's total length is decreased by the length of B and its left child. */ - interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval); - eassert (TOTAL_LENGTH (interval) >= 0); + A->total_length -= B->total_length - TOTAL_LENGTH (c); + eassert (TOTAL_LENGTH (A) > 0); /* B must have the same total length of A. */ B->total_length = old_total; - eassert (TOTAL_LENGTH (B) >= 0); return B; } @@ -379,39 +383,43 @@ */ static INTERVAL -rotate_left (INTERVAL interval) +rotate_left (INTERVAL A) { - INTERVAL i; - INTERVAL B = interval->right; - ptrdiff_t old_total = interval->total_length; + INTERVAL B = A->right; + INTERVAL c = B->left; + ptrdiff_t old_total = A->total_length; + + eassert (old_total > 0); + eassert (old_total + > TOTAL_LENGTH (B) + TOTAL_LENGTH (A->left)); + eassert (TOTAL_LENGTH (B) + > TOTAL_LENGTH (B->right) + TOTAL_LENGTH (c)); /* Deal with any parent of A; make it point to B. */ - if (! ROOT_INTERVAL_P (interval)) + if (! ROOT_INTERVAL_P (A)) { - if (AM_LEFT_CHILD (interval)) - set_interval_left (INTERVAL_PARENT (interval), B); + if (AM_LEFT_CHILD (A)) + set_interval_left (INTERVAL_PARENT (A), B); else - set_interval_right (INTERVAL_PARENT (interval), B); + set_interval_right (INTERVAL_PARENT (A), B); } - copy_interval_parent (B, interval); - - /* Make B the parent of A */ - i = B->left; - set_interval_left (B, interval); - set_interval_parent (interval, B); - - /* Make A point to c */ - set_interval_right (interval, i); - if (i) - set_interval_parent (i, interval); + copy_interval_parent (B, A); + + /* Make B the parent of A. */ + set_interval_left (B, A); + set_interval_parent (A, B); + + /* Make A point to c. */ + set_interval_right (A, c); + if (c) + set_interval_parent (c, A); /* A's total length is decreased by the length of B and its right child. */ - interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval); - eassert (TOTAL_LENGTH (interval) >= 0); + A->total_length -= B->total_length - TOTAL_LENGTH (c); + eassert (TOTAL_LENGTH (A) > 0); /* B must have the same total length of A. */ B->total_length = old_total; - eassert (TOTAL_LENGTH (B) >= 0); return B; } === modified file 'test/ChangeLog' --- test/ChangeLog 2014-04-18 23:36:51 +0000 +++ test/ChangeLog 2014-04-19 20:32:05 +0000 @@ -1,3 +1,8 @@ +2014-04-19 Michael Albinus + + * automated/tramp-tests.el (tramp--test-check-files): Extend test. + (tramp-test31-utf8): Let-bind also `file-name-coding-system'. + 2014-04-18 Michael Albinus * automated/tramp-tests.el (tramp-copy-size-limit): Set to nil. === modified file 'test/automated/tramp-tests.el' --- test/automated/tramp-tests.el 2014-04-18 18:58:13 +0000 +++ test/automated/tramp-tests.el 2014-04-19 14:14:26 +0000 @@ -1418,23 +1418,37 @@ (defun tramp--test-check-files (&rest files) "Runs a simple but comprehensive test over every file in FILES." - (let ((tmp-name (tramp--test-make-temp-name))) + (let ((tmp-name1 (tramp--test-make-temp-name)) + (tmp-name2 (tramp--test-make-temp-name 'local))) (unwind-protect (progn - (make-directory tmp-name) + (make-directory tmp-name1) + (make-directory tmp-name2) (dolist (elt files) - (let ((file (expand-file-name elt tmp-name))) - (write-region elt nil file) - (should (file-exists-p file)) + (let ((file1 (expand-file-name elt tmp-name1)) + (file2 (expand-file-name elt tmp-name2))) + (write-region elt nil file1) + (should (file-exists-p file1)) ;; Check file contents. (with-temp-buffer - (insert-file-contents file) - (should (string-equal (buffer-string) elt))))) + (insert-file-contents file1) + (should (string-equal (buffer-string) elt))) + ;; Copy file both directions. + (copy-file file1 tmp-name2) + (should (file-exists-p file2)) + (delete-file file1) + (should-not (file-exists-p file1)) + (copy-file file2 tmp-name1) + (should (file-exists-p file1)))) ;; Check file names. (should (equal (directory-files - tmp-name nil directory-files-no-dot-files-regexp) - (sort files 'string-lessp)))) - (ignore-errors (delete-directory tmp-name 'recursive))))) + tmp-name1 nil directory-files-no-dot-files-regexp) + (sort (copy-sequence files) 'string-lessp))) + (should (equal (directory-files + tmp-name2 nil directory-files-no-dot-files-regexp) + (sort (copy-sequence files) 'string-lessp)))) + (ignore-errors (delete-directory tmp-name1 'recursive)) + (ignore-errors (delete-directory tmp-name2 'recursive))))) ;; This test is inspired by Bug#17238. (ert-deftest tramp-test30-special-characters () @@ -1463,11 +1477,12 @@ (skip-unless (tramp--test-enabled)) (let ((coding-system-for-read 'utf-8) - (coding-system-for-write 'utf-8)) - (tramp--test-check-files - "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت" - "银河系漫游指南系列" - "Автостопом по гала́ктике"))) + (coding-system-for-write 'utf-8) + (file-name-coding-system 'utf-8)) + (tramp--test-check-files + "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت" + "银河系漫游指南系列" + "Автостопом по гала́ктике"))) ;; This test is inspired by Bug#16928. (ert-deftest tramp-test32-asynchronous-requests () ------------------------------------------------------------ revno: 116992 fixes bug: http://debbugs.gnu.org/17289 committer: Paul Eggert branch nick: trunk timestamp: Sat 2014-04-19 10:45:20 -0700 message: Link to glib-using libraries when checking for glib. * configure.ac (XGSELOBJ): Include GTK_LIBS, RSVG_LIBS, etc. when testing whether Glib is linked in. Similarly for CFLAGS. diff: === modified file 'ChangeLog' --- ChangeLog 2014-04-17 06:40:25 +0000 +++ ChangeLog 2014-04-19 17:45:20 +0000 @@ -1,3 +1,9 @@ +2014-04-19 Paul Eggert + + Link to glib-using libraries when checking for glib (Bug#17289). + * configure.ac (XGSELOBJ): Include GTK_LIBS, RSVG_LIBS, etc. + when testing whether Glib is linked in. Similarly for CFLAGS. + 2014-04-17 Paul Eggert * GNUmakefile: Speed up 'make bootstrap' in fresh checkout. === modified file 'configure.ac' --- configure.ac 2014-04-16 19:43:46 +0000 +++ configure.ac 2014-04-19 17:45:20 +0000 @@ -3806,11 +3806,12 @@ AC_CHECK_FUNCS(snprintf) -dnl Check this late. It depends on what other libraries (lrsvg, Gtk+ etc) -dnl Emacs uses. +dnl Check this late, since it depends on $GTK_CFLAGS etc. XGSELOBJ= OLDCFLAGS="$CFLAGS" OLDLIBS="$LIBS" +CFLAGS="$CFLAGS $GTK_CFLAGS $RSVG_CFLAGS $DBUS_CFLAGS $SETTINGS_CFLAGS" +LIBS="$LIBS $GTK_LIBS $RSVG_LIBS $DBUS_LIBS $SETTINGS_LIBS" CFLAGS="$CFLAGS $GFILENOTIFY_CFLAGS" LIBS="$LIBS $GFILENOTIFY_LIBS" AC_MSG_CHECKING([whether GLib is linked in]) ------------------------------------------------------------ revno: 116991 [merge] committer: Juanma Barranquero branch nick: trunk timestamp: Sat 2014-04-19 01:36:51 +0200 message: Merge from emacs-24; up to r116982 diff: === modified file 'admin/ChangeLog' --- admin/ChangeLog 2014-04-11 06:51:49 +0000 +++ admin/ChangeLog 2014-04-18 23:36:51 +0000 @@ -1,3 +1,9 @@ +2014-04-18 Paul Eggert + + * notes/bzr: Update instructions for merging from gnulib. + Remove obsolete note about tramp.el and tramp-sh.el. + Change "emacs-23" to "emacs-24". + 2014-04-11 Glenn Morris * grammars/Makefile.in (EMACSDATA, EMACSDOC, EMACSPATH): Unexport. === modified file 'admin/notes/bzr' --- admin/notes/bzr 2014-01-10 10:43:18 +0000 +++ admin/notes/bzr 2014-04-17 21:20:51 +0000 @@ -3,9 +3,9 @@ * Install changes only on one branch, let them get merged elsewhere if needed. In particular, install bug-fixes only on the release branch (if there is one) and let them get synced to the trunk; do not install them by -hand on the trunk as well. E.g. if there is an active "emacs-23" branch -and you have a bug-fix appropriate for the next Emacs-23.x release, -install it only on the emacs-23 branch, not on the trunk as well. +hand on the trunk as well. E.g. if there is an active "emacs-24" branch +and you have a bug-fix appropriate for the next emacs-24.x release, +install it only on the emacs-24 branch, not on the trunk as well. Installing things manually into more than one branch makes merges more difficult. @@ -18,7 +18,7 @@ and branch yourself (when committing the branch change, indicate in the commit log that it should not be merged to the trunk; see below). -* Backporting a bug-fix from the trunk to a branch (e.g. "emacs-23"). +* Backporting a bug-fix from the trunk to a branch (e.g. "emacs-24"). Indicate in the commit log that there is no need to merge the commit to the trunk. Anything that matches `bzrmerge-skip-regexp' will do; eg start the commit message with "Backport:". This is helpful for the @@ -49,7 +49,7 @@ * Installing changes from gnulib Some of the files in Emacs are copied from gnulib. To synchronize these files from the version of gnulib that you have checked out into -a sibling directory of your branch, type "make sync-from-gnulib"; this +a sibling directory of your branch, type "admin/merge-gnulib"; this will check out the latest version of gnulib if there is no sibling directory already. It is a good idea to run "bzr status" afterwards, so that if a gnulib module added a file, you can record the new file @@ -57,17 +57,12 @@ usual way. To change the set of gnulib modules, change the GNULIB_MODULES -variable in the top-level Makefile.in, and then run: - - ./config.status - make sync-from-gnulib - bzr status - -The last command will mention files that may need to be added using -"bzr add". If you remove a gnulib module, or if a gnulib module +variable in admin/merge-gnulib before running it. + +If you remove a gnulib module, or if a gnulib module removes a file, then remove the corresponding files by hand. -* How to merge changes from emacs-23 to trunk +* How to merge changes from emacs-24 to trunk The following description uses bound branches, presumably it works in a similar way with unbound ones. @@ -90,7 +85,7 @@ Maybe the default Emacs behavior without this plugin is better, though, it's not clear yet. -1) Get clean, up-to-date copies of the emacs-23 and trunk branches. +1) Get clean, up-to-date copies of the emacs-24 and trunk branches. Check for any uncommitted changes with bzr status. 2) M-x cd /path/to/trunk @@ -102,7 +97,7 @@ 3) load admin/bzrmerge.el -4) M-x bzrmerge RET /path/to/emacs-23 RET +4) M-x bzrmerge RET /path/to/emacs-24 RET It will prompt about revisions that should be skipped, based on the regexp in bzrmerge-missing. If there are more revisions that you know @@ -119,7 +114,7 @@ Before committing, check bzr status and bzr diff output. If you have run bzrmerge enough times, the "pending merge tip" in bzr -status should be the last revision from the emacs-23 branch, and +status should be the last revision from the emacs-24 branch, and bzr status -v should show all the revisions you expect to merge. (Note that it will also show "skipped" revisions. This is expected, @@ -141,18 +136,13 @@ Notes: -1) A lot that was in tramp.el in emacs-23 has moved to tramp-sh.el in -the trunk. If you end up with a conflict in tramp.el, the changes may -need to go to tramp-sh.el instead. Remember to update the file name in -the ChangeLog. - -2) If a file is modified in emacs-23, and deleted in the trunk, you +1) If a file is modified in emacs-24, and deleted in the trunk, you get a "contents conflict". Assuming the changes don't need to be in the trunk at all, use `bzr resolve path/to/file --take-this' to keep the trunk version. Prior to bzr 2.2.3, this may fail. You can just delete the .OTHER etc files by hand and use bzr resolve path/to/file. -3) Conflicts in autoload md5sums in comments. Strictly speaking, the +2) Conflicts in autoload md5sums in comments. Strictly speaking, the right thing to do is merge everything else, resolve the conflict by choosing either the trunk or branch version, then run `make -C lisp autoloads' to update the md5sums to the correct trunk value before === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-04-17 07:54:23 +0000 +++ lisp/ChangeLog 2014-04-18 23:36:51 +0000 @@ -1,3 +1,20 @@ +2014-04-18 Michael Albinus + + * net/tramp.el (tramp-run-real-handler, tramp-file-name-handler): + Do not autoload. + (tramp-file-name-handler, tramp-completion-file-name-handler): + Revert patch from 2014-04-10, it isn't necessary anymore. + (tramp-autoload-file-name-handler) + (tramp-register-autoload-file-name-handlers): New defuns. + (top): Autoload call of `tramp-register-autoload-file-name-handlers'. + (tramp-register-file-name-handlers): Remove also + `tramp-autoload-file-name-handler' from `file-name-handler-list'. + Do not autoload its invocation, but eval it after loading of 'tramp. + + * net/tramp-adb.el (tramp-unload-hook): Unload `tramp-adb'. + + * net/tramp-compat.el (tramp-unload-hook): Unload `tramp-loaddefs'. + 2014-04-17 Daniel Colascione Add support for bracketed paste mode; add infrastructure for === modified file 'lisp/net/tramp-adb.el' --- lisp/net/tramp-adb.el 2014-02-28 08:41:24 +0000 +++ lisp/net/tramp-adb.el 2014-04-18 18:57:04 +0000 @@ -1183,5 +1183,9 @@ (read (current-buffer))) ":" 'omit-nulls)))))))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-adb 'force))) + (provide 'tramp-adb) ;;; tramp-adb.el ends here === modified file 'lisp/net/tramp-compat.el' --- lisp/net/tramp-compat.el 2014-01-01 07:43:34 +0000 +++ lisp/net/tramp-compat.el 2014-04-18 18:57:04 +0000 @@ -587,6 +587,7 @@ (add-hook 'tramp-unload-hook (lambda () + (unload-feature 'tramp-loaddefs 'force) (unload-feature 'tramp-compat 'force))) (provide 'tramp-compat) === modified file 'lisp/net/tramp.el' --- lisp/net/tramp.el 2014-04-10 07:17:40 +0000 +++ lisp/net/tramp.el 2014-04-18 18:57:04 +0000 @@ -1943,8 +1943,7 @@ (add-to-list 'result (cons (regexp-quote tmpname) (cdr elt)) 'append))))) -;;;###autoload -(progn (defun tramp-run-real-handler (operation args) +(defun tramp-run-real-handler (operation args) "Invoke normal file name handler for OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." @@ -1958,7 +1957,7 @@ ,(and (eq inhibit-file-name-operation operation) inhibit-file-name-handlers))) (inhibit-file-name-operation operation)) - (apply operation args)))) + (apply operation args))) ;;;###autoload (progn (defun tramp-completion-run-real-handler (operation args) @@ -2100,22 +2099,12 @@ (tramp-compat-condition-case-unless-debug ,var ,bodyform ,@handlers))) ;; Main function. -;;;###autoload (defun tramp-file-name-handler (operation &rest args) "Invoke Tramp file name handler. Falls back to normal file name handler if no Tramp file name handler exists." (if tramp-mode (save-match-data - (let* ((default-directory - ;; Some packages set the default directory to a - ;; remote path, before tramp.el has been loaded. - ;; This results in recursive loading. Therefore, we - ;; set `default-directory' to a local path. `args' - ;; could also be remote when loading tramp.el, but - ;; that would be such perverse we don't care about. - (if load-in-progress - temporary-file-directory default-directory)) - (filename + (let* ((filename (tramp-replace-environment-variables (apply 'tramp-file-name-for-operation operation args))) (completion (tramp-completion-mode-p)) @@ -2227,11 +2216,8 @@ "Invoke Tramp file name completion handler. Falls back to normal file name handler if no Tramp file name handler exists." ;; We bind `directory-sep-char' here for XEmacs on Windows, which - ;; would otherwise use backslash. For `default-directory', see - ;; comment in `tramp-file-name-handler'. + ;; would otherwise use backslash. (let ((directory-sep-char ?/) - (default-directory - (if load-in-progress temporary-file-directory default-directory)) (fn (assoc operation tramp-completion-file-name-handler-alist))) (if (and ;; When `tramp-mode' is not enabled, we don't do anything. @@ -2255,15 +2241,43 @@ (tramp-completion-run-real-handler operation args))))) ;;;###autoload -(progn (defun tramp-register-file-name-handlers () +(progn (defun tramp-autoload-file-name-handler (operation &rest args) + "Load Tramp file name handler, and perform OPERATION." + ;; Avoid recursive loading of tramp.el. + (let ((default-directory temporary-file-directory)) + (load "tramp" nil t)) + (apply operation args))) + +;; `tramp-autoload-file-name-handler' must be registered before +;; evaluation of site-start and init files, because there might exist +;; remote files already, f.e. files kept via recentf-mode. We cannot +;; autoload `tramp-file-name-handler', because it would result in +;; recursive loading of tramp.el when `default-directory' is set to +;; remote. +;;;###autoload +(progn (defun tramp-register-autoload-file-name-handlers () + "Add Tramp file name handlers to `file-name-handler-alist' during autoload." + (add-to-list 'file-name-handler-alist + (cons tramp-file-name-regexp + 'tramp-autoload-file-name-handler)) + (put 'tramp-autoload-file-name-handler 'safe-magic t) + (add-to-list 'file-name-handler-alist + (cons tramp-completion-file-name-regexp + 'tramp-completion-file-name-handler)) + (put 'tramp-completion-file-name-handler 'safe-magic t))) + +;;;###autoload +(tramp-register-autoload-file-name-handlers) + +(defun tramp-register-file-name-handlers () "Add Tramp file name handlers to `file-name-handler-alist'." ;; Remove autoloaded handlers from file name handler alist. Useful, ;; if `tramp-syntax' has been changed. - (let ((a1 (rassq 'tramp-file-name-handler file-name-handler-alist))) - (setq file-name-handler-alist (delq a1 file-name-handler-alist))) - (let ((a1 (rassq - 'tramp-completion-file-name-handler file-name-handler-alist))) - (setq file-name-handler-alist (delq a1 file-name-handler-alist))) + (dolist (fnh '(tramp-file-name-handler + tramp-completion-file-name-handler + tramp-autoload-file-name-handler)) + (let ((a1 (rassq fnh file-name-handler-alist))) + (setq file-name-handler-alist (delq a1 file-name-handler-alist)))) ;; Add the handlers. (add-to-list 'file-name-handler-alist (cons tramp-file-name-regexp 'tramp-file-name-handler)) @@ -2278,13 +2292,9 @@ (let ((entry (rassoc fnh file-name-handler-alist))) (when entry (setq file-name-handler-alist - (cons entry (delete entry file-name-handler-alist)))))))) + (cons entry (delete entry file-name-handler-alist))))))) -;; `tramp-file-name-handler' must be registered before evaluation of -;; site-start and init files, because there might exist remote files -;; already, f.e. files kept via recentf-mode. -;;;###autoload -(tramp-register-file-name-handlers) +(eval-after-load 'tramp (tramp-register-file-name-handlers)) (defun tramp-exists-file-name-handler (operation &rest args) "Check, whether OPERATION runs a file name handler." === modified file 'src/ChangeLog' --- src/ChangeLog 2014-04-17 14:59:22 +0000 +++ src/ChangeLog 2014-04-18 23:36:51 +0000 @@ -1,3 +1,22 @@ +2014-04-18 Paul Eggert + + * emacs.c (close_output_streams): Don't clear and restore errno. + +2014-04-18 Jan Djärv + + * xterm.c (x_make_frame_visible): Prevent endless loop when frame + never becomes visible, i.e. using XMonad (Bug#17237). + +2014-04-18 Eli Zaretskii + + * xdisp.c (insert_left_trunc_glyphs): Ensure the left truncation + glyph is written to TEXT_AREA of the temporary glyph_row. (Bug#17288) + (Fline_pixel_height): Don't assume that the current buffer and the + selected window's buffer are one and the same. (Bug#17281) + + * insdel.c (invalidate_buffer_caches): Invalidate the bidi + paragraph-start cache before the newline cache. (Bug#17269) + 2014-04-17 Paul Eggert * term.c (tty_send_additional_strings): No need to fflush here, @@ -23,6 +42,7 @@ 2014-04-16 Eli Zaretskii + Fix the MSDOS build. * unexcoff.c [MSDOS]: Include libc/atexit.h. (copy_text_and_data): Zero out the atexit chain pointer before dumping Emacs. === modified file 'src/emacs.c' --- src/emacs.c 2014-04-16 19:43:46 +0000 +++ src/emacs.c 2014-04-18 23:36:51 +0000 @@ -690,11 +690,6 @@ static void close_output_streams (void) { - int err = errno; - - /* close_stream checks errno, so make sure it doesn't inherit some - random value. */ - errno = 0; if (close_stream (stdout) != 0) { emacs_perror ("Write error to standard output"); @@ -703,8 +698,6 @@ if (close_stream (stderr) != 0) _exit (EXIT_FAILURE); - - errno = err; } /* ARGSUSED */ === modified file 'src/insdel.c' --- src/insdel.c 2014-04-16 19:43:46 +0000 +++ src/insdel.c 2014-04-18 23:36:51 +0000 @@ -1849,14 +1849,9 @@ need to consider the caches of their base buffer. */ if (buf->base_buffer) buf = buf->base_buffer; - if (buf->newline_cache) - invalidate_region_cache (buf, - buf->newline_cache, - start - BUF_BEG (buf), BUF_Z (buf) - end); - if (buf->width_run_cache) - invalidate_region_cache (buf, - buf->width_run_cache, - start - BUF_BEG (buf), BUF_Z (buf) - end); + /* The bidi_paragraph_cache must be invalidated first, because doing + so might need to use the newline_cache (via find_newline_no_quit, + see below). */ if (buf->bidi_paragraph_cache) { if (start != end @@ -1880,13 +1875,20 @@ &start_byte); set_buffer_internal (old); } - if (line_beg > BUF_BEG (buf)) - start = line_beg - 1; + start = line_beg - (line_beg > BUF_BEG (buf)); } invalidate_region_cache (buf, buf->bidi_paragraph_cache, start - BUF_BEG (buf), BUF_Z (buf) - end); } + if (buf->newline_cache) + invalidate_region_cache (buf, + buf->newline_cache, + start - BUF_BEG (buf), BUF_Z (buf) - end); + if (buf->width_run_cache) + invalidate_region_cache (buf, + buf->width_run_cache, + start - BUF_BEG (buf), BUF_Z (buf) - end); } /* These macros work with an argument named `preserve_ptr' === modified file 'src/xdisp.c' --- src/xdisp.c 2014-04-12 19:24:17 +0000 +++ src/xdisp.c 2014-04-18 23:36:51 +0000 @@ -1262,12 +1262,23 @@ struct it it; struct text_pos pt; struct window *w = XWINDOW (selected_window); + struct buffer *old_buffer = NULL; + Lisp_Object result; + if (XBUFFER (w->contents) != current_buffer) + { + old_buffer = current_buffer; + set_buffer_internal_1 (XBUFFER (w->contents)); + } SET_TEXT_POS (pt, PT, PT_BYTE); start_display (&it, w, pt); it.vpos = it.current_y = 0; last_height = 0; - return make_number (line_bottom_y (&it)); + result = make_number (line_bottom_y (&it)); + if (old_buffer) + set_buffer_internal_1 (old_buffer); + + return result; } /* Return the default pixel height of text lines in window W. The @@ -18677,6 +18688,7 @@ truncate_it.current_x = 0; truncate_it.face_id = DEFAULT_FACE_ID; truncate_it.glyph_row = &scratch_glyph_row; + truncate_it.area = TEXT_AREA; truncate_it.glyph_row->used[TEXT_AREA] = 0; CHARPOS (truncate_it.position) = BYTEPOS (truncate_it.position) = -1; truncate_it.object = make_number (0); === modified file 'src/xterm.c' --- src/xterm.c 2014-04-05 19:30:36 +0000 +++ src/xterm.c 2014-04-18 23:36:51 +0000 @@ -8900,6 +8900,7 @@ x_make_frame_visible (struct frame *f) { int original_top, original_left; + int tries = 0; block_input (); @@ -9007,7 +9008,13 @@ /* Force processing of queued events. */ x_sync (f); - /* This hack is still in use at least for Cygwin. See + /* If on another desktop, the deiconify/map may be ignored and the + frame never becomes visible. XMonad does this. + Prevent an endless loop. */ + if (FRAME_ICONIFIED_P (f) && ++tries > 100) + break; + + /* This hack is still in use at least for Cygwin. See http://lists.gnu.org/archive/html/emacs-devel/2013-12/msg00351.html. Machines that do polling rather than SIGIO have been === modified file 'test/ChangeLog' --- test/ChangeLog 2014-04-11 06:51:49 +0000 +++ test/ChangeLog 2014-04-18 23:36:51 +0000 @@ -1,3 +1,18 @@ +2014-04-18 Michael Albinus + + * automated/tramp-tests.el (tramp-copy-size-limit): Set to nil. + (tramp--test-make-temp-name): Optional argument LOCAL. + (tramp--instrument-test-case): Show messages. Catch also `quit'. + (tramp-test10-write-region): No special test for out-of-band copy + needed anymore. + (tramp-test11-copy-file, tramp-test12-rename-file) + (tramp-test21-file-links): Extend tests. + (tramp-test20-file-modes): More robust check for user "root". + (tramp--test-check-files): New defun. + (tramp-test30-special-characters, tramp-test33-recursive-load) + (tramp-test34-unload): New tests. + (tramp-test31-utf8, tramp-test32-asynchronous-requests): Rename. + 2014-04-11 Glenn Morris * automated/Makefile.in (EMACSDATA, EMACSDOC, EMACSPATH): Unexport. === modified file 'test/automated/tramp-tests.el' --- test/automated/tramp-tests.el 2014-03-07 14:11:37 +0000 +++ test/automated/tramp-tests.el 2014-04-18 18:58:13 +0000 @@ -56,6 +56,7 @@ (setq password-cache-expiry nil tramp-verbose 0 + tramp-copy-size-limit nil tramp-message-show-message nil) ;; Disable interactive passwords in batch mode. @@ -92,10 +93,11 @@ ;; Return result. (cdr tramp--test-enabled-checked)) -(defun tramp--test-make-temp-name () +(defun tramp--test-make-temp-name (&optional local) "Create a temporary file name for test." (expand-file-name - (make-temp-name "tramp-test") tramp-test-temporary-file-directory)) + (make-temp-name "tramp-test") + (if local temporary-file-directory tramp-test-temporary-file-directory))) (defmacro tramp--instrument-test-case (verbose &rest body) "Run BODY with `tramp-verbose' equal VERBOSE. @@ -103,12 +105,17 @@ eval properly in `should', `should-not' or `should-error'." (declare (indent 1) (debug (natnump body))) `(let ((tramp-verbose ,verbose) + (tramp-message-show-message t) (tramp-debug-on-error t)) (condition-case err - (progn ,@body) + ;; In general, we cannot use a timeout here: this would + ;; prevent traces when the test runs into an error. +; (with-timeout (10 (ert-fail "`tramp--instrument-test-case' timed out")) + (progn + ,@body) (ert-test-skipped (signal (car err) (cdr err))) - (error + ((error quit) (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil (with-current-buffer (tramp-get-connection-buffer v) (message "%s" (buffer-string))) @@ -662,15 +669,7 @@ (write-region 3 5 tmp-name)) (with-temp-buffer (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "34"))) - ;; Trigger out-of-band copy. - (let ((string "")) - (while (<= (length string) tramp-copy-size-limit) - (setq string (concat string (md5 string)))) - (write-region string nil tmp-name) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) string))))) + (should (string-equal (buffer-string) "34")))) (ignore-errors (delete-file tmp-name))))) (ert-deftest tramp-test11-copy-file () @@ -678,7 +677,12 @@ (skip-unless (tramp--test-enabled)) (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name))) + (tmp-name2 (tramp--test-make-temp-name)) + (tmp-name3 (tramp--test-make-temp-name)) + (tmp-name4 (tramp--test-make-temp-name 'local)) + (tmp-name5 (tramp--test-make-temp-name 'local))) + + ;; Copy on remote side. (unwind-protect (progn (write-region "foo" nil tmp-name1) @@ -686,17 +690,69 @@ (should (file-exists-p tmp-name2)) (with-temp-buffer (insert-file-contents tmp-name2) - (should (string-equal (buffer-string) "foo")))) - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))))) + (should (string-equal (buffer-string) "foo"))) + (should-error (copy-file tmp-name1 tmp-name2)) + (copy-file tmp-name1 tmp-name2 'ok) + (make-directory tmp-name3) + (copy-file tmp-name1 tmp-name3) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name2)) + (ignore-errors (delete-directory tmp-name3 'recursive))) + + ;; Copy from remote side to local side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (copy-file tmp-name1 tmp-name4) + (should (file-exists-p tmp-name4)) + (with-temp-buffer + (insert-file-contents tmp-name4) + (should (string-equal (buffer-string) "foo"))) + (should-error (copy-file tmp-name1 tmp-name4)) + (copy-file tmp-name1 tmp-name4 'ok) + (make-directory tmp-name5) + (copy-file tmp-name1 tmp-name5) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name4)) + (ignore-errors (delete-directory tmp-name5 'recursive))) + + ;; Copy from local side to remote side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name4 nil 'nomessage) + (copy-file tmp-name4 tmp-name1) + (should (file-exists-p tmp-name1)) + (with-temp-buffer + (insert-file-contents tmp-name1) + (should (string-equal (buffer-string) "foo"))) + (should-error (copy-file tmp-name4 tmp-name1)) + (copy-file tmp-name4 tmp-name1 'ok) + (make-directory tmp-name3) + (copy-file tmp-name4 tmp-name3) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name4)) + (ignore-errors (delete-directory tmp-name3 'recursive))))) (ert-deftest tramp-test12-rename-file () "Check `rename-file'." (skip-unless (tramp--test-enabled)) (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name))) + (tmp-name2 (tramp--test-make-temp-name)) + (tmp-name3 (tramp--test-make-temp-name)) + (tmp-name4 (tramp--test-make-temp-name 'local)) + (tmp-name5 (tramp--test-make-temp-name 'local))) + + ;; Rename on remote side. (unwind-protect (progn (write-region "foo" nil tmp-name1) @@ -705,8 +761,71 @@ (should (file-exists-p tmp-name2)) (with-temp-buffer (insert-file-contents tmp-name2) - (should (string-equal (buffer-string) "foo")))) - (ignore-errors (delete-file tmp-name2))))) + (should (string-equal (buffer-string) "foo"))) + (write-region "foo" nil tmp-name1) + (should-error (rename-file tmp-name1 tmp-name2)) + (rename-file tmp-name1 tmp-name2 'ok) + (should-not (file-exists-p tmp-name1)) + (write-region "foo" nil tmp-name1) + (make-directory tmp-name3) + (rename-file tmp-name1 tmp-name3) + (should-not (file-exists-p tmp-name1)) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name2)) + (ignore-errors (delete-directory tmp-name3 'recursive))) + + ;; Rename from remote side to local side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (rename-file tmp-name1 tmp-name4) + (should-not (file-exists-p tmp-name1)) + (should (file-exists-p tmp-name4)) + (with-temp-buffer + (insert-file-contents tmp-name4) + (should (string-equal (buffer-string) "foo"))) + (write-region "foo" nil tmp-name1) + (should-error (rename-file tmp-name1 tmp-name4)) + (rename-file tmp-name1 tmp-name4 'ok) + (should-not (file-exists-p tmp-name1)) + (write-region "foo" nil tmp-name1) + (make-directory tmp-name5) + (rename-file tmp-name1 tmp-name5) + (should-not (file-exists-p tmp-name1)) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name4)) + (ignore-errors (delete-directory tmp-name5 'recursive))) + + ;; Rename from local side to remote side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name4 nil 'nomessage) + (rename-file tmp-name4 tmp-name1) + (should-not (file-exists-p tmp-name4)) + (should (file-exists-p tmp-name1)) + (with-temp-buffer + (insert-file-contents tmp-name1) + (should (string-equal (buffer-string) "foo"))) + (write-region "foo" nil tmp-name4 nil 'nomessage) + (should-error (rename-file tmp-name4 tmp-name1)) + (rename-file tmp-name4 tmp-name1 'ok) + (should-not (file-exists-p tmp-name4)) + (write-region "foo" nil tmp-name4 nil 'nomessage) + (make-directory tmp-name3) + (rename-file tmp-name4 tmp-name3) + (should-not (file-exists-p tmp-name4)) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name4)) + (ignore-errors (delete-directory tmp-name3 'recursive))))) (ert-deftest tramp-test13-make-directory () "Check `make-directory'. @@ -930,7 +1049,7 @@ (should (= (file-modes tmp-name) #o444)) (should-not (file-executable-p tmp-name)) ;; A file is always writable for user "root". - (when (not (string-equal (file-remote-p tmp-name 'user) "root")) + (unless (zerop (nth 2 (file-attributes tmp-name))) (should-not (file-writable-p tmp-name)))) (ignore-errors (delete-file tmp-name))))) @@ -941,7 +1060,7 @@ (let ((tmp-name1 (tramp--test-make-temp-name)) (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (make-temp-name "tramp-"))) + (tmp-name3 (tramp--test-make-temp-name 'local))) (unwind-protect (progn (write-region "foo" nil tmp-name1) @@ -988,16 +1107,18 @@ (should (file-symlink-p tmp-name2)) (should-not (string-equal tmp-name2 (file-truename tmp-name2))) (should - (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))) + (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) + (should (file-equal-p tmp-name1 tmp-name2))) (ignore-errors (delete-file tmp-name1) (delete-file tmp-name2))) ;; `file-truename' shall preserve trailing link of directories. - (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory)) - (dir2 (file-name-as-directory dir1))) - (should (string-equal (file-truename dir1) (expand-file-name dir1))) - (should (string-equal (file-truename dir2) (expand-file-name dir2)))))) + (unless (file-symlink-p tramp-test-temporary-file-directory) + (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory)) + (dir2 (file-name-as-directory dir1))) + (should (string-equal (file-truename dir1) (expand-file-name dir1))) + (should (string-equal (file-truename dir2) (expand-file-name dir2))))))) (ert-deftest tramp-test22-file-times () "Check `set-file-times' and `file-newer-than-file-p'." @@ -1295,35 +1416,61 @@ (ignore-errors (delete-directory tmp-name1 'recursive))))) -(ert-deftest tramp-test30-utf8 () - "Check UTF8 encoding in file names and file contents." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name)) - (coding-system-for-read 'utf-8) - (coding-system-for-write 'utf-8) - (arabic "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت") - (chinese "银河系漫游指南系列") - (russian "Автостопом по гала́ктике")) +(defun tramp--test-check-files (&rest files) + "Runs a simple but comprehensive test over every file in FILES." + (let ((tmp-name (tramp--test-make-temp-name))) (unwind-protect (progn (make-directory tmp-name) - (dolist (lang `(,arabic ,chinese ,russian)) - (let ((file (expand-file-name lang tmp-name))) - (write-region lang nil file) + (dolist (elt files) + (let ((file (expand-file-name elt tmp-name))) + (write-region elt nil file) (should (file-exists-p file)) ;; Check file contents. (with-temp-buffer (insert-file-contents file) - (should (string-equal (buffer-string) lang))))) + (should (string-equal (buffer-string) elt))))) ;; Check file names. (should (equal (directory-files tmp-name nil directory-files-no-dot-files-regexp) - (sort `(,arabic ,chinese ,russian) 'string-lessp)))) + (sort files 'string-lessp)))) (ignore-errors (delete-directory tmp-name 'recursive))))) +;; This test is inspired by Bug#17238. +(ert-deftest tramp-test30-special-characters () + "Check special characters in file names." + (skip-unless (tramp--test-enabled)) + + ;; Newlines and slashes in file names are not supported. So we don't test. + (tramp--test-check-files + " foo bar\tbaz " + "$foo$bar$$baz$" + "-foo-bar-baz-" + "%foo%bar%baz%" + "&foo&bar&baz&" + "?foo?bar?baz?" + "*foo*bar*baz*" + "'foo\"bar'baz\"" + "\\foo\\bar\\baz\\" + "#foo#bar#baz#" + "!foo|bar!baz|" + ":foo;bar:baz;" + "bar" + "(foo)bar(baz)")) + +(ert-deftest tramp-test31-utf8 () + "Check UTF8 encoding in file names and file contents." + (skip-unless (tramp--test-enabled)) + + (let ((coding-system-for-read 'utf-8) + (coding-system-for-write 'utf-8)) + (tramp--test-check-files + "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت" + "银河系漫游指南系列" + "Автостопом по гала́ктике"))) + ;; This test is inspired by Bug#16928. -(ert-deftest tramp-test31-asynchronous-requests () +(ert-deftest tramp-test32-asynchronous-requests () "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." @@ -1412,6 +1559,62 @@ (dolist (buf buffers) (ignore-errors (kill-buffer buf))))))) +(ert-deftest tramp-test33-recursive-load () + "Check that Tramp does not fail due to recursive load." + (skip-unless (tramp--test-enabled)) + + (dolist (code + (list + (format + "(expand-file-name %S))" + tramp-test-temporary-file-directory) + (format + "(let ((default-directory %S)) (expand-file-name %S))" + tramp-test-temporary-file-directory + temporary-file-directory))) + (should-not + (string-match + "Recursive load" + (shell-command-to-string + (format + "%s -batch -Q -L %s --eval %s" + (expand-file-name invocation-name invocation-directory) + (mapconcat 'shell-quote-argument load-path " -L ") + (shell-quote-argument code))))))) + +(ert-deftest tramp-test34-unload () + "Check that Tramp and its subpackages unload completely. +Since it unloads Tramp, it shall be the last test to run." + ;; Mark as failed until all symbols are unbound. + :expected-result (if (featurep 'tramp) :failed :passed) + (when (featurep 'tramp) + (unload-feature 'tramp 'force) + ;; No Tramp feature must be left. + (should-not (featurep 'tramp)) + (should-not (all-completions "tramp" (delq 'tramp-tests features))) + ;; `file-name-handler-alist' must be clean. + (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist))) + ;; There shouldn't be left a bound symbol. We do not regard our + ;; test symbols, and the Tramp unload hooks. + (mapatoms + (lambda (x) + (and (or (boundp x) (functionp x)) + (string-match "^tramp" (symbol-name x)) + (not (string-match "^tramp--?test" (symbol-name x))) + (not (string-match "unload-hook$" (symbol-name x))) + (ert-fail (format "`%s' still bound" x))))) +; (progn (message "`%s' still bound" x))))) + ;; There shouldn't be left a hook function containing a Tramp + ;; function. We do not regard the Tramp unload hooks. + (mapatoms + (lambda (x) + (and (boundp x) + (string-match "-hooks?$" (symbol-name x)) + (not (string-match "unload-hook$" (symbol-name x))) + (consp (symbol-value x)) + (ignore-errors (all-completions "tramp" (symbol-value x))) + (ert-fail (format "Hook `%s' still contains Tramp function" x))))))) + ;; TODO: ;; * dired-compress-file @@ -1426,8 +1629,11 @@ ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). ;; * Fix `tramp-test28-shell-command' on MS Windows (nasty plink message). -;; * Fix `tramp-test30-utf8' on MS Windows. Seems to be in `directory-files'. -;; * Fix Bug#16928. Set expected error of `tramp-test31-asynchronous-requests'. +;; * Fix `tramp-test31-utf8' for MS Windows and `nc'/`telnet' (when +;; target is a dumb busybox). Seems to be in `directory-files'. +;; * Fix Bug#16928. Set expected error of `tramp-test32-asynchronous-requests'. +;; * Fix `tramp-test34-unload' (Not all symbols are unbound). Set +;; expected error. (defun tramp-test-all (&optional interactive) "Run all tests for \\[tramp]." ------------------------------------------------------------ Use --include-merged or -n0 to see merged revisions.