commit a597969f1360b8c28fd4467018792662b698e03a (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Sun Dec 3 18:17:00 2017 -0800 allocate_vectorlike minor cleanup * src/alloc.c (allocate_vectorlike): Move a bit of code out of the critical section. Although this doesn’t really help performance, it cleans up the code a bit and should make it easier to add pointer bounds checking. diff --git a/src/alloc.c b/src/alloc.c index 49c99501f1..4f3928a482 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3317,15 +3317,14 @@ sweep_vectors (void) static struct Lisp_Vector * allocate_vectorlike (ptrdiff_t len) { - struct Lisp_Vector *p; - - MALLOC_BLOCK_INPUT; - if (len == 0) - p = XVECTOR (zero_vector); + return XVECTOR (zero_vector); else { size_t nbytes = header_size + len * word_size; + struct Lisp_Vector *p; + + MALLOC_BLOCK_INPUT; #ifdef DOUG_LEA_MALLOC if (!mmap_lisp_allowed_p ()) @@ -3355,11 +3354,11 @@ allocate_vectorlike (ptrdiff_t len) consing_since_gc += nbytes; vector_cells_consed += len; - } - MALLOC_UNBLOCK_INPUT; + MALLOC_UNBLOCK_INPUT; - return p; + return p; + } } commit c54718e0bb390b35d86e8cab7ae1a7d1da9c047c Author: Paul Eggert Date: Sun Dec 3 18:11:00 2017 -0800 Omit exprintf if modules but no X * src/doprnt.c (exprintf): Do not define if HAVE_MODULES && !(have_X_WINDOWS || USE_X_TOOLKIT), as the modules code no longer uses exprintf. diff --git a/src/doprnt.c b/src/doprnt.c index 89d7e99deb..d33c95f517 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -503,7 +503,7 @@ esprintf (char *buf, char const *format, ...) return nbytes; } -#if HAVE_MODULES || (defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT) +#if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT /* Format to buffer *BUF of positive size *BUFSIZE, reallocating *BUF and updating *BUFSIZE if the buffer is too small, and otherwise commit 1dcf8b5ec59ff714b02ccc7466c02a9e6132bcc9 Author: Paul Eggert Date: Sun Dec 3 17:58:08 2017 -0800 Pacify GCC on Ubuntu 17.10 x86-64 * src/xfns.c (x_real_pos_and_offsets): Pull out parent frame into a local, so that GCC doesn't warn about dereferencing a possibly-null pointer. diff --git a/src/xfns.c b/src/xfns.c index bbe73aa7c2..f1c7fd6f3e 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -215,8 +215,9 @@ x_real_pos_and_offsets (struct frame *f, int win_x = 0, win_y = 0, outer_x = 0, outer_y = 0; int real_x = 0, real_y = 0; bool had_errors = false; - Window win = (FRAME_PARENT_FRAME (f) - ? FRAME_X_WINDOW (FRAME_PARENT_FRAME (f)) + struct frame *parent_frame = FRAME_PARENT_FRAME (f); + Window win = (parent_frame + ? FRAME_X_WINDOW (parent_frame) : f->output_data.x->parent_desc); struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); long max_len = 400; @@ -355,8 +356,8 @@ x_real_pos_and_offsets (struct frame *f, outer_geom_cookie = xcb_get_geometry (xcb_conn, FRAME_OUTER_WINDOW (f)); - if ((dpyinfo->root_window == f->output_data.x->parent_desc) - && !FRAME_PARENT_FRAME (f)) + if (!parent_frame + && dpyinfo->root_window == f->output_data.x->parent_desc) /* Try _NET_FRAME_EXTENTS if our parent is the root window. */ prop_cookie = xcb_get_property (xcb_conn, 0, win, dpyinfo->Xatom_net_frame_extents, @@ -470,8 +471,7 @@ x_real_pos_and_offsets (struct frame *f, #endif } - if ((dpyinfo->root_window == f->output_data.x->parent_desc) - && !FRAME_PARENT_FRAME (f)) + if (!parent_frame && dpyinfo->root_window == f->output_data.x->parent_desc) { /* Try _NET_FRAME_EXTENTS if our parent is the root window. */ #ifdef USE_XCB commit 66396972ed5273516a77589c350f6ce9becd8d9f Author: Lars Ingebrigtsen Date: Sun Dec 3 23:46:52 2017 +0100 Allow shr to use data: URLs without encoding * lisp/net/shr.el (shr-image-from-data): Don't bug out on image data: URLs that have no base64 encoding like (shr-image-from-data "text/html,%3Ch1%3EHello%2C%20World!%3C%2Fh1%3E"). diff --git a/lisp/net/shr.el b/lisp/net/shr.el index ab7240c8c3..ad5d869531 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -994,7 +994,8 @@ If EXTERNAL, browse the URL using `shr-external-browser'." data) (let ((param (match-string 4 data)) (payload (url-unhex-string (match-string 5 data)))) - (when (string-match "^.*\\(;[ \t]*base64\\)$" param) + (when (and param + (string-match "^.*\\(;[ \t]*base64\\)$" param)) (setq payload (ignore-errors (base64-decode-string payload)))) payload))) commit e4f2061ebc61168f23c0d9440221cbc99864deae Author: Alan Third Date: Sun Dec 3 17:39:03 2017 +0000 Add image resizing and rotation to NS port * lisp/image.el (image--get-imagemagick-and-warn): Bypass imagemagick check when using NS. * src/nsimage.m (ns_load_image): Add rotation and resizing functionality. Move the getMetaData call to before the resize/rotation so it returns correct metadata. (EmacsImage::setSizeFromSpec, EmacsImage::rotate): New functions. * src/nsterm.h (EmacsImage): Add new function prototypes. (NSCompositingOperationCopy): Add define to older equivalent for GNUstep and pre-10.12 macOS. * configure.ac: Don't use libjpeg on Cocoa. diff --git a/configure.ac b/configure.ac index b773e3b7f0..61455a4b0f 100644 --- a/configure.ac +++ b/configure.ac @@ -3424,7 +3424,9 @@ AC_SUBST(LIBXPM) ### Use -ljpeg if available, unless '--with-jpeg=no'. HAVE_JPEG=no LIBJPEG= -if test "${with_jpeg}" != "no"; then +if test "${NS_IMPL_COCOA}" = yes; then + : # Cocoa provides its own jpeg support, so do nothing. +elif test "${with_jpeg}" != "no"; then AC_CACHE_CHECK([for jpeglib 6b or later], [emacs_cv_jpeglib], [OLD_LIBS=$LIBS @@ -3559,7 +3561,7 @@ HAVE_PNG=no LIBPNG= PNG_CFLAGS= if test "${NS_IMPL_COCOA}" = yes; then - : # Nothing to do + : # Cocoa provides its own png support, so do nothing. elif test "${with_png}" != no; then # mingw32 loads the library dynamically. if test "$opsys" = mingw32; then diff --git a/lisp/image.el b/lisp/image.el index 32df508bc8..ed32307ae2 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -976,11 +976,12 @@ default is 20%." image)) (defun image--get-imagemagick-and-warn () - (unless (fboundp 'imagemagick-types) + (unless (or (fboundp 'imagemagick-types) (featurep 'ns)) (error "Can't rescale images without ImageMagick support")) (let ((image (image--get-image))) (image-flush image) - (plist-put (cdr image) :type 'imagemagick) + (when (fboundp 'imagemagick-types) + (plist-put (cdr image) :type 'imagemagick)) image)) (defun image--change-size (factor) diff --git a/src/nsimage.m b/src/nsimage.m index 9d45b063af..52e3bae05f 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -76,8 +76,9 @@ Updated by Christian Limpach (chris@nice.ch) { EmacsImage *eImg = nil; NSSize size; - Lisp_Object lisp_index; + Lisp_Object lisp_index, lisp_rotation; unsigned int index; + double rotation; NSTRACE ("ns_load_image"); @@ -86,6 +87,9 @@ Updated by Christian Limpach (chris@nice.ch) lisp_index = Fplist_get (XCDR (img->spec), QCindex); index = INTEGERP (lisp_index) ? XFASTINT (lisp_index) : 0; + lisp_rotation = Fplist_get (XCDR (img->spec), QCrotation); + rotation = NUMBERP (lisp_rotation) ? XFLOATINT (lisp_rotation) : 0; + if (STRINGP (spec_file)) { eImg = [EmacsImage allocInitFromFile: spec_file]; @@ -113,6 +117,17 @@ Updated by Christian Limpach (chris@nice.ch) return 0; } + img->lisp_data = [eImg getMetadata]; + + if (rotation != 0) + { + EmacsImage *temp = [eImg rotate:rotation]; + [eImg release]; + eImg = temp; + } + + [eImg setSizeFromSpec:XCDR (img->spec)]; + size = [eImg size]; img->width = size.width; img->height = size.height; @@ -120,7 +135,6 @@ Updated by Christian Limpach (chris@nice.ch) /* 4) set img->pixmap = emacsimage */ img->pixmap = eImg; - img->lisp_data = [eImg getMetadata]; return 1; } @@ -510,4 +524,102 @@ - (BOOL)setFrame: (unsigned int) index return YES; } +- (void)setSizeFromSpec: (Lisp_Object) spec +{ + NSSize size = [self size]; + Lisp_Object value; + double scale = 1, aspect = size.width / size.height; + double width = -1, height = -1, max_width = -1, max_height = -1; + + value = Fplist_get (spec, QCscale); + if (NUMBERP (value)) + scale = XFLOATINT (value) ; + + value = Fplist_get (spec, QCmax_width); + if (NUMBERP (value)) + max_width = XFLOATINT (value); + + value = Fplist_get (spec, QCmax_height); + if (NUMBERP (value)) + max_height = XFLOATINT (value); + + value = Fplist_get (spec, QCwidth); + if (NUMBERP (value)) + { + width = XFLOATINT (value) * scale; + /* :width overrides :max-width. */ + max_width = -1; + } + + value = Fplist_get (spec, QCheight); + if (NUMBERP (value)) + { + height = XFLOATINT (value) * scale; + /* :height overrides :max-height. */ + max_height = -1; + } + + if (width <= 0 && height <= 0) + { + width = size.width * scale; + height = size.height * scale; + } + else if (width > 0 && height <= 0) + height = width / aspect; + else if (height > 0 && width <= 0) + width = height * aspect; + + if (max_width > 0 && width > max_width) + { + width = max_width; + height = max_width / aspect; + } + + if (max_height > 0 && height > max_height) + { + height = max_height; + width = max_height * aspect; + } + + [self setSize:NSMakeSize(width, height)]; +} + +- (instancetype)rotate: (double)rotation +{ + EmacsImage *new_image; + NSPoint new_origin; + NSSize new_size, size = [self size]; + NSRect rect = { NSZeroPoint, [self size] }; + + /* Create a bezier path of the outline of the image and do the + * rotation on it. */ + NSBezierPath *bounds_path = [NSBezierPath bezierPathWithRect:rect]; + NSAffineTransform *transform = [NSAffineTransform transform]; + [transform rotateByDegrees: rotation * -1]; + [bounds_path transformUsingAffineTransform:transform]; + + /* Now we can find out how large the rotated image needs to be. */ + new_size = [bounds_path bounds].size; + new_image = [[EmacsImage alloc] initWithSize:new_size]; + + new_origin = NSMakePoint((new_size.width - size.width)/2, + (new_size.height - size.height)/2); + + [new_image lockFocus]; + + /* Create the final transform. */ + transform = [NSAffineTransform transform]; + [transform translateXBy:new_size.width/2 yBy:new_size.height/2]; + [transform rotateByDegrees: rotation * -1]; + [transform translateXBy:-new_size.width/2 yBy:-new_size.height/2]; + + [transform concat]; + [self drawAtPoint:new_origin fromRect:NSZeroRect + operation:NSCompositingOperationCopy fraction:1]; + + [new_image unlockFocus]; + + return new_image; +} + @end diff --git a/src/nsterm.h b/src/nsterm.h index de96e0dbcb..c81bf5fb63 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -646,6 +646,8 @@ typedef id instancetype; - (NSColor *)stippleMask; - (Lisp_Object)getMetadata; - (BOOL)setFrame: (unsigned int) index; +- (void)setSizeFromSpec: (Lisp_Object) spec; +- (instancetype)rotate: (double)rotation; @end @@ -1306,6 +1308,7 @@ extern char gnustep_base_version[]; /* version tracking */ #define NSWindowStyleMaskUtilityWindow NSUtilityWindowMask #define NSAlertStyleCritical NSCriticalAlertStyle #define NSControlSizeRegular NSRegularControlSize +#define NSCompositingOperationCopy NSCompositeCopy /* And adds NSWindowStyleMask. */ #ifdef __OBJC__ commit 1cdd0e8cd801aa1d6f04ab4d8e6097a46af8c951 Author: Noam Postavsky Date: Wed Nov 22 21:59:35 2017 -0500 Disable history expansion in eshell (Bug#29157) History expansion is not so useful since interactive history commands are already provided. It can produce surprising errors when the user is not aware of the history designator syntax. * lisp/eshell/em-hist.el (eshell-hist-initialize): Don't add eshell-expand-history-references to eshell-expand-input-functions. * etc/NEWS: Announce it. diff --git a/etc/NEWS b/etc/NEWS index 6b3e7fc244..cbd50f0227 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -113,6 +113,15 @@ styles as configured by the variable 'completion-styles'. These macros are analogue to 'let' and 'let*', but create bindings that are evaluated lazily. +** Eshell + +--- +*** Expansion of history event designators is disabled by default. +To restore the old behavior, use + + (add-hook 'eshell-expand-input-functions + #'eshell-expand-history-references) + * New Modes and Packages in Emacs 27.1 diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 8084c12653..df462a7058 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -218,9 +218,6 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil." (defun eshell-hist-initialize () "Initialize the history management code for one Eshell buffer." - (add-hook 'eshell-expand-input-functions - 'eshell-expand-history-references nil t) - (when (eshell-using-module 'eshell-cmpl) (add-hook 'pcomplete-try-first-hook 'eshell-complete-history-reference nil t)) commit cfa50d30f2876ca30158082e9a91d19e804a7e09 Author: Noam Postavsky Date: Thu Nov 30 20:51:07 2017 -0500 ; Tracing for eieio-test random failure (Bug#24503) * test/Makefile.in [EMACS_HYDRA_CI]: Always show log for eieio-tests. * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (top-level): Trace cl-generic functions. (eieio-test-dump-trace): New function. (eieio-test-37-obsolete-name-in-constructor): Use it. diff --git a/test/Makefile.in b/test/Makefile.in index 17ab36f5af..ffbb065ec6 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -146,8 +146,14 @@ endif $(AM_V_ELC)$(emacs) -f batch-byte-compile $< ## Save logs, and show logs for failed tests. -WRITE_LOG = $(if $(and ${EMACS_HYDRA_CI}, $(findstring tramp, $@)), |& tee $@, > $@ 2>&1) \ - || { STAT=$$?; cat $@; exit $$STAT; } +WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; } +ifdef EMACS_HYDRA_CI +## On Hydra, always show logs for certain problematic tests. +lisp/emacs-lisp/eieio-tests/eieio-tests.log \ +lisp/net/tramp-tests.log \ +lisp/url/url-tramp-test.log \ +: WRITE_LOG = 2>&1 | tee $@ +endif ifeq ($(TEST_LOAD_EL), yes) testloadfile = $*.el diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index fbdb9896a4..454f2aaca0 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -887,15 +887,33 @@ Subclasses to override slot attributes.") (should (= (length (eieio-build-class-alist 'opt-test1 nil)) 2)) (should (= (length (eieio-build-class-alist 'opt-test1 t)) 1))) +(mapatoms (lambda (a) + (when (and (fboundp a) + (string-match "\\`cl--?generic" + (symbol-name a))) + (trace-function-background a)))) + (defclass eieio--testing () ()) (defmethod constructor :static ((_x eieio--testing) newname &rest _args) (list newname 2)) +(defun eieio-test-dump-trace () + (message "%s" (with-current-buffer "*trace-output*" + (goto-char (point-min)) + (while (re-search-forward "[\0-\010\013-\037]" nil t) + (insert (prog1 (format "\\%03o" (char-before)) + (delete-char -1)))) + (buffer-string)))) +(eieio-test-dump-trace) + (ert-deftest eieio-test-37-obsolete-name-in-constructor () ;; FIXME repeated intermittent failures on hydra (bug#24503) - (skip-unless (not (getenv "EMACS_HYDRA_CI"))) - (should (equal (eieio--testing "toto") '("toto" 2)))) + (with-current-buffer "*trace-output*" + (erase-buffer)) + (unwind-protect + (should (equal (eieio--testing "toto") '("toto" 2))) + (eieio-test-dump-trace))) (ert-deftest eieio-autoload () "Tests to see whether reftex-auc has been autoloaded" commit 6e0008890ffcfdcd0a8fc827c7108907bfb25d0a Author: Noam Postavsky Date: Sat Dec 2 19:38:36 2017 -0500 * lisp/emacs-lisp/package.el (package-read-from-string): Simplify. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 61bff5cfbc..f8b4cc888d 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -961,17 +961,12 @@ This assumes that `pkg-desc' has already been activated with (defun package-read-from-string (str) "Read a Lisp expression from STR. Signal an error if the entire string was not used." - (let* ((read-data (read-from-string str)) - (more-left - (condition-case nil - ;; The call to `ignore' suppresses a compiler warning. - (progn (ignore (read-from-string - (substring str (cdr read-data)))) - t) - (end-of-file nil)))) - (if more-left - (error "Can't read whole string") - (car read-data)))) + (pcase-let ((`(,expr . ,offset) (read-from-string str))) + (condition-case () + ;; The call to `ignore' suppresses a compiler warning. + (progn (ignore (read-from-string str offset)) + (error "Can't read whole string")) + (end-of-file expr)))) (defun package--prepare-dependencies (deps) "Turn DEPS into an acceptable list of dependencies. commit dbe410d9ad6f656069566c8d32c38f04574c1ba9 Author: Noam Postavsky Date: Fri Dec 1 08:20:29 2017 -0500 Fix faceup tests when run from elc String literals may be shared by the compiler, so the test string needs to be copied before adding properties to it. For single properties, just use a string literal with properties. * test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el (faceup-markup): Split into... (faceup-markup-basics, faceup-markup-escaping, faceup-markup-plain) (faceup-markup-plain-full-text, faceup-markup-anonymous-face) (faceup-markup-anonymous-face-2keys, faceup-markup-anonymous-nested) (faceup-markup-nested, faceup-markup-overlapping) (faceup-markup-multi-face, faceup-markup-multi-property): New tests. diff --git a/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el b/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el index 6009bfa836..fd58c1bbca 100644 --- a/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el +++ b/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el @@ -26,6 +26,7 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) (require 'faceup) (ert-deftest faceup-functions () @@ -52,163 +53,144 @@ '(a b (:y nil) (:x t))))) -(ert-deftest faceup-markup () - "Test basic `faceup' features." - ;; ---------- - ;; Basics +(ert-deftest faceup-markup-basics () (should (equal (faceup-markup-string "") "")) - (should (equal (faceup-markup-string "test") "test")) - ;; ---------- - ;; Escaping + (should (equal (faceup-markup-string "test") "test"))) + +(ert-deftest faceup-markup-escaping () (should (equal (faceup-markup-string "«") "««")) (should (equal (faceup-markup-string "«A«B«C«") "««A««B««C««")) (should (equal (faceup-markup-string "»") "«»")) - (should (equal (faceup-markup-string "»A»B»C»") "«»A«»B«»C«»")) - ;; ---------- - ;; Plain property. - ;; + (should (equal (faceup-markup-string "»A»B»C»") "«»A«»B«»C«»"))) + +(ert-deftest faceup-markup-plain () ;; UU ;; ABCDEF - (let ((s "ABCDEF")) - (set-text-properties 2 4 '(face underline) s) - (should (equal (faceup-markup-string s) "AB«U:CD»EF"))) - ;; ---------- - ;; Plain property, full text - ;; + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (face underline))) + "AB«U:CD»EF"))) + +(ert-deftest faceup-markup-plain-full-text () ;; UUUUUU ;; ABCDEF - (let ((s "ABCDEF")) - (set-text-properties 0 6 '(face underline) s) - (should (equal (faceup-markup-string s) "«U:ABCDEF»"))) - ;; ---------- - ;; Anonymous face. - ;; - ;; AA - ;; ABCDEF - (let ((s "ABCDEF")) - (set-text-properties 2 4 '(face (:underline t)) s) - (should (equal (faceup-markup-string s) "AB«:(:underline t):CD»EF"))) - ;; ---------- - ;; Anonymous face -- plist with two keys. - ;; + (should (equal (faceup-markup-string + #("ABCDEF" 0 6 (face underline))) + "«U:ABCDEF»"))) + +(ert-deftest faceup-markup-anonymous-face () ;; AA ;; ABCDEF - (let ((s "ABCDEF")) - (set-text-properties 2 4 '(face (:foo t :bar nil)) s) - (should (equal (faceup-markup-string s) - "AB«:(:foo t):«:(:bar nil):CD»»EF"))) - ;; Ditto, with plist in list. - (let ((s "ABCDEF")) - (set-text-properties 2 4 '(face ((:foo t :bar nil))) s) - (should (equal (faceup-markup-string s) - "AB«:(:foo t):«:(:bar nil):CD»»EF"))) - ;; ---------- - ;; Anonymous face -- Two plists. - ;; + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (face (:underline t)))) + "AB«:(:underline t):CD»EF"))) + +(ert-deftest faceup-markup-anonymous-face-2keys () ;; AA ;; ABCDEF - (let ((s "ABCDEF")) - (set-text-properties 2 4 '(face ((:foo t) (:bar nil))) s) - (should (equal (faceup-markup-string s) - "AB«:(:bar nil):«:(:foo t):CD»»EF"))) - ;; ---------- - ;; Anonymous face -- Nested. - ;; + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (face (:foo t :bar nil)))) + "AB«:(:foo t):«:(:bar nil):CD»»EF")) + ;; Plist in list. + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (face ((:foo t :bar nil))))) + "AB«:(:foo t):«:(:bar nil):CD»»EF")) + ;; Two plists. + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (face ((:foo t) (:bar nil))))) + "AB«:(:bar nil):«:(:foo t):CD»»EF"))) + +(ert-deftest faceup-markup-anonymous-nested () ;; AA ;; IIII ;; ABCDEF - (let ((s "ABCDEF")) - (set-text-properties 1 2 '(face ((:foo t))) s) - (set-text-properties 2 4 '(face ((:bar t) (:foo t))) s) - (set-text-properties 4 5 '(face ((:foo t))) s) - (should (equal (faceup-markup-string s) - "A«:(:foo t):B«:(:bar t):CD»E»F"))) - ;; ---------- - ;; Nested properties. - ;; + (should (equal (faceup-markup-string + #("ABCDEF" + 1 2 (face ((:foo t))) + 2 4 (face ((:bar t) (:foo t))) + 4 5 (face ((:foo t))))) + "A«:(:foo t):B«:(:bar t):CD»E»F"))) + +(ert-deftest faceup-markup-nested () ;; UU ;; IIII ;; ABCDEF - (let ((s "ABCDEF")) - (set-text-properties 1 2 '(face italic) s) - (set-text-properties 2 4 '(face (underline italic)) s) - (set-text-properties 4 5 '(face italic) s) - (should (equal (faceup-markup-string s) "A«I:B«U:CD»E»F"))) - ;; ---------- - ;; Overlapping, but not nesting, properties. - ;; + (should (equal (faceup-markup-string + #("ABCDEF" + 1 2 (face italic) + 2 4 (face (underline italic)) + 4 5 (face italic))) + "A«I:B«U:CD»E»F"))) + +(ert-deftest faceup-markup-overlapping () ;; UUU ;; III ;; ABCDEF - (let ((s "ABCDEF")) - (set-text-properties 1 2 '(face italic) s) - (set-text-properties 2 4 '(face (underline italic)) s) - (set-text-properties 4 5 '(face underline) s) - (should (equal (faceup-markup-string s) "A«I:B«U:CD»»«U:E»F"))) - ;; ---------- - ;; Overlapping, but not nesting, properties. - ;; + (should (equal (faceup-markup-string + #("ABCDEF" + 1 2 (face italic) + 2 4 (face (underline italic)) + 4 5 (face underline))) + "A«I:B«U:CD»»«U:E»F")) ;; III ;; UUU ;; ABCDEF - (let ((s "ABCDEF")) - (set-text-properties 1 2 '(face italic) s) - (set-text-properties 2 4 '(face (italic underline)) s) - (set-text-properties 4 5 '(face underline) s) - (should (equal (faceup-markup-string s) "A«I:B»«U:«I:CD»E»F"))) - ;; ---------- + (should (equal (faceup-markup-string + #("ABCDEF" + 1 2 (face italic) + 2 4 (face (italic underline)) + 4 5 (face underline))) + "A«I:B»«U:«I:CD»E»F"))) + +(ert-deftest faceup-markup-multi-face () ;; More than one face at the same location. ;; ;; The property to the front takes precedence, it is rendered as the ;; innermost parenthesis pair. - (let ((s "ABCDEF")) - (set-text-properties 2 4 '(face (underline italic)) s) - (should (equal (faceup-markup-string s) "AB«I:«U:CD»»EF"))) - (let ((s "ABCDEF")) - (set-text-properties 2 4 '(face (italic underline)) s) - (should (equal (faceup-markup-string s) "AB«U:«I:CD»»EF"))) - ;; ---------- + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (face (underline italic)))) + "AB«I:«U:CD»»EF")) + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (face (italic underline)))) + "AB«U:«I:CD»»EF")) ;; Equal ranges, full text. - (let ((s "ABCDEF")) - (set-text-properties 0 6 '(face (underline italic)) s) - (should (equal (faceup-markup-string s) "«I:«U:ABCDEF»»"))) + (should (equal (faceup-markup-string + #("ABCDEF" 0 6 (face (underline italic)))) + "«I:«U:ABCDEF»»")) ;; Ditto, with stray markup characters. - (let ((s "AB«CD»EF")) - (set-text-properties 0 8 '(face (underline italic)) s) - (should (equal (faceup-markup-string s) "«I:«U:AB««CD«»EF»»"))) + (should (equal (faceup-markup-string + #("AB«CD»EF" 0 8 (face (underline italic)))) + "«I:«U:AB««CD«»EF»»"))) - ;; ---------- - ;; Multiple properties +(ert-deftest faceup-markup-multi-property () (let ((faceup-properties '(alpha beta gamma))) ;; One property. - (let ((s "ABCDEF")) - (set-text-properties 2 4 '(alpha (a l p h a)) s) - (should (equal (faceup-markup-string s) "AB«(alpha):(a l p h a):CD»EF"))) + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (alpha (a l p h a)))) + "AB«(alpha):(a l p h a):CD»EF")) ;; Two properties, inner enclosed. - (let ((s "ABCDEFGHIJ")) - (set-text-properties 2 8 '(alpha (a l p h a)) s) - (font-lock-append-text-property 4 6 'beta '(b e t a) s) - (should (equal (faceup-markup-string s) - "AB«(alpha):(a l p h a):CD«(beta):(b e t a):EF»GH»IJ"))) + (should (equal (faceup-markup-string + (let ((s (copy-sequence "ABCDEFGHIJ"))) + (set-text-properties 2 8 '(alpha (a l p h a)) s) + (font-lock-append-text-property 4 6 'beta '(b e t a) s) + s)) + "AB«(alpha):(a l p h a):CD«(beta):(b e t a):EF»GH»IJ")) ;; Two properties, same end - (let ((s "ABCDEFGH")) - (set-text-properties 2 6 '(alpha (a)) s) - (add-text-properties 4 6 '(beta (b)) s) - (should - (equal - (faceup-markup-string s) - "AB«(alpha):(a):CD«(beta):(b):EF»»GH"))) + (should (equal (faceup-markup-string + (let ((s (copy-sequence "ABCDEFGH"))) + (set-text-properties 2 6 '(alpha (a)) s) + (add-text-properties 4 6 '(beta (b)) s) + s)) + "AB«(alpha):(a):CD«(beta):(b):EF»»GH")) ;; Two properties, overlap. - (let ((s "ABCDEFGHIJ")) - (set-text-properties 2 6 '(alpha (a)) s) - (add-text-properties 4 8 '(beta (b)) s) - (should - (equal - (faceup-markup-string s) - "AB«(alpha):(a):CD«(beta):(b):EF»»«(beta):(b):GH»IJ"))))) + (should (equal (faceup-markup-string + (let ((s (copy-sequence "ABCDEFGHIJ"))) + (set-text-properties 2 6 '(alpha (a)) s) + (add-text-properties 4 8 '(beta (b)) s) + s)) + "AB«(alpha):(a):CD«(beta):(b):EF»»«(beta):(b):GH»IJ")))) (ert-deftest faceup-clean () commit f924956ed146e985d9234c4fef04c2e7e3bffdb5 Author: Noam Postavsky Date: Sat Dec 2 23:17:05 2017 -0500 ; test/lisp/dired-aux-tests.el (with-dired-bug28834-test): Fix debug decl. diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 9316217dd2..c385b40bb2 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -45,7 +45,7 @@ ;; If YES-OR-NO is non-nil, it binds `yes-or-no-p' to ;; to avoid the prompt. (defmacro with-dired-bug28834-test (create-dirs yes-or-no &rest body) - (declare ((debug form symbolp body))) + (declare (debug (form symbolp body))) (let ((foo (make-symbol "foo"))) `(let* ((,foo (make-temp-file "foo" 'dir)) (dired-create-destination-dirs ,create-dirs))