commit 9338b1307dfd08dff5f1c27a7202cb4412c6a502 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Sun Apr 12 09:42:12 2020 +0300 ; * etc/NEWS: NEWS followup to recent changes in hi-lock.el. diff --git a/etc/NEWS b/etc/NEWS index eefcb0a502..28c01d71f1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -259,11 +259,16 @@ regexp instead. ** Hi-Lock +--- *** Matching in 'hi-lock-mode' is case-sensitive when regexp contains upper case characters and `search-upper-case' is non-nil. 'highlight-phrase' also uses 'search-whitespace-regexp' to substitute spaces in regexp search. +--- +*** The default value of 'hi-lock-highlight-range' was enlarged. +The new default value is 2000000 (2 million). + ** Texinfo --- commit 43282a6772630275259dbc7560913c07f72eb06e Author: Paul Eggert Date: Sat Apr 11 18:35:35 2020 -0700 Remove UNSIGNED_CMP I added this macro in 2011 to fix some signedness comparison bugs. However, it’s a weird macro and the bugs can be fixed in a more-straightforward way. This helps performance slightly (0.5%) on my platform (Fedora 31 x86-64, GCC 9.3.1 with -O2). * src/casefiddle.c (do_casify_natnum): Use simple comparison instead of UNSIGNED_CMP. * src/character.h (CHAR_VALID_P, SINGLE_BYTE_CHAR_P, CHAR_STRING): * src/composite.h (COMPOSITION_ENCODE_RULE_VALID): * src/lisp.h (ASCII_CHAR_P): Now an inline function, and uses simple comparison instead of UNSIGNED_CMP. * src/dispextern.h (FACE_FROM_ID, FACE_FROM_ID_OR_NULL) (IMAGE_FROM_ID, IMAGE_OPT_FROM_ID): Move these to ... * src/frame.h (FACE_FROM_ID, FACE_FROM_ID_OR_NULL) (IMAGE_FROM_ID, IMAGE_OPT_FROM_ID): ... here, and make them inline functions that no longer use UNSIGNED_CMP. * src/keyboard.c (read_char): UNSIGNED_CMP is not needed here since XFIXNAT always returns a nonnegative value. * src/lisp.h (UNSIGNED_CMP): Remove; no longer used. diff --git a/src/casefiddle.c b/src/casefiddle.c index 1945aa15e7..5018b7bb1c 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -229,7 +229,7 @@ do_casify_natnum (struct casing_context *ctx, Lisp_Object obj) /* If the character has higher bits set above the flags, return it unchanged. It is not a real character. */ - if (UNSIGNED_CMP (ch, >, flagbits)) + if (! (0 <= ch && ch <= flagbits)) return obj; int flags = ch & flagbits; diff --git a/src/character.h b/src/character.h index 3642a54044..7639b018cb 100644 --- a/src/character.h +++ b/src/character.h @@ -80,6 +80,8 @@ enum OBJECT_REPLACEMENT_CHARACTER = 0xFFFC, }; +extern int char_string (unsigned, unsigned char *); + /* UTF-8 encodings. Use \x escapes, so they are portable to pre-C11 compilers and can be concatenated with ordinary string literals. */ #define uLSQM "\xE2\x80\x98" /* U+2018 LEFT SINGLE QUOTATION MARK */ @@ -126,7 +128,11 @@ enum #define CHARACTERP(x) (FIXNATP (x) && XFIXNAT (x) <= MAX_CHAR) /* Nonzero iff C is valid as a character code. */ -#define CHAR_VALID_P(c) UNSIGNED_CMP (c, <=, MAX_CHAR) +INLINE bool +CHAR_VALID_P (intmax_t c) +{ + return 0 <= c && c <= MAX_CHAR; +} /* Check if Lisp object X is a character or not. */ #define CHECK_CHARACTER(x) \ @@ -145,7 +151,11 @@ enum } while (false) /* Nonzero iff C is a character of code less than 0x100. */ -#define SINGLE_BYTE_CHAR_P(c) UNSIGNED_CMP (c, <, 0x100) +INLINE bool +SINGLE_BYTE_CHAR_P (intmax_t c) +{ + return 0 <= c && c < 0x100; +} /* Nonzero if character C has a printable glyph. */ #define CHAR_PRINTABLE_P(c) \ @@ -176,20 +186,32 @@ enum allocate at least MAX_MULTIBYTE_LENGTH bytes area at P in advance. Returns the length of the multibyte form. */ -#define CHAR_STRING(c, p) \ - (UNSIGNED_CMP (c, <=, MAX_1_BYTE_CHAR) \ - ? ((p)[0] = (c), \ - 1) \ - : UNSIGNED_CMP (c, <=, MAX_2_BYTE_CHAR) \ - ? ((p)[0] = (0xC0 | ((c) >> 6)), \ - (p)[1] = (0x80 | ((c) & 0x3F)), \ - 2) \ - : UNSIGNED_CMP (c, <=, MAX_3_BYTE_CHAR) \ - ? ((p)[0] = (0xE0 | ((c) >> 12)), \ - (p)[1] = (0x80 | (((c) >> 6) & 0x3F)), \ - (p)[2] = (0x80 | ((c) & 0x3F)), \ - 3) \ - : verify_expr (sizeof (c) <= sizeof (unsigned), char_string (c, p))) +INLINE int +CHAR_STRING (int c, unsigned char *p) +{ + eassume (0 <= c); + if (c <= MAX_1_BYTE_CHAR) + { + p[0] = c; + return 1; + } + if (c <= MAX_2_BYTE_CHAR) + { + p[0] = 0xC0 | (c >> 6); + p[1] = 0x80 | (c & 0x3F); + return 2; + } + if (c <= MAX_3_BYTE_CHAR) + { + p[0] = 0xE0 | (c >> 12); + p[1] = 0x80 | ((c >> 6) & 0x3F); + p[2] = 0x80 | (c & 0x3F); + return 3; + } + int len = char_string (c, p); + eassume (0 < len && len <= MAX_MULTIBYTE_LENGTH); + return len; +} /* Store multibyte form of byte B in P. The caller should allocate at least MAX_MULTIBYTE_LENGTH bytes area at P in advance. Returns the @@ -657,7 +679,6 @@ typedef enum { } unicode_category_t; extern EMACS_INT char_resolve_modifier_mask (EMACS_INT) ATTRIBUTE_CONST; -extern int char_string (unsigned, unsigned char *); extern int string_char (const unsigned char *, const unsigned char **, int *); diff --git a/src/composite.h b/src/composite.h index 62c4de40e3..239f1e531e 100644 --- a/src/composite.h +++ b/src/composite.h @@ -125,10 +125,13 @@ composition_registered_p (Lisp_Object prop) COMPOSITION_DECODE_REFS (rule_code, gref, nref); \ } while (false) -/* Nonzero if the global reference point GREF and new reference point NREF are +/* True if the global reference point GREF and new reference point NREF are valid. */ -#define COMPOSITION_ENCODE_RULE_VALID(gref, nref) \ - (UNSIGNED_CMP (gref, <, 12) && UNSIGNED_CMP (nref, <, 12)) +INLINE bool +COMPOSITION_ENCODE_RULE_VALID (int gref, int nref) +{ + return 0 <= gref && gref < 12 && 0 <= nref && nref < 12; +} /* Return encoded composition rule for the pair of global reference point GREF and new reference point NREF. Arguments must be valid. */ diff --git a/src/dispextern.h b/src/dispextern.h index 555946f84c..ae994d7f9b 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -1855,20 +1855,6 @@ struct face_cache bool_bf menu_face_changed_p : 1; }; -/* Return a non-null pointer to the cached face with ID on frame F. */ - -#define FACE_FROM_ID(F, ID) \ - (eassert (UNSIGNED_CMP (ID, <, FRAME_FACE_CACHE (F)->used)), \ - FRAME_FACE_CACHE (F)->faces_by_id[ID]) - -/* Return a pointer to the face with ID on frame F, or null if such a - face doesn't exist. */ - -#define FACE_FROM_ID_OR_NULL(F, ID) \ - (UNSIGNED_CMP (ID, <, FRAME_FACE_CACHE (F)->used) \ - ? FRAME_FACE_CACHE (F)->faces_by_id[ID] \ - : NULL) - #define FACE_EXTENSIBLE_P(F) \ (!NILP (F->lface[LFACE_EXTEND_INDEX])) @@ -3163,21 +3149,6 @@ struct image_cache ptrdiff_t refcount; }; - -/* A non-null pointer to the image with id ID on frame F. */ - -#define IMAGE_FROM_ID(F, ID) \ - (eassert (UNSIGNED_CMP (ID, <, FRAME_IMAGE_CACHE (F)->used)), \ - FRAME_IMAGE_CACHE (F)->images[ID]) - -/* Value is a pointer to the image with id ID on frame F, or null if - no image with that id exists. */ - -#define IMAGE_OPT_FROM_ID(F, ID) \ - (UNSIGNED_CMP (ID, <, FRAME_IMAGE_CACHE (F)->used) \ - ? FRAME_IMAGE_CACHE (F)->images[ID] \ - : NULL) - /* Size of bucket vector of image caches. Should be prime. */ #define IMAGE_CACHE_BUCKETS_SIZE 1001 diff --git a/src/frame.h b/src/frame.h index 641bb430d0..476bac67fa 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1450,6 +1450,49 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f) { return frame_dimension (f->bottom_divider_width); } + +/* Return a non-null pointer to the cached face with ID on frame F. */ + +INLINE struct face * +FACE_FROM_ID (struct frame *f, int id) +{ + eassert (0 <= id && id < FRAME_FACE_CACHE (f)->used); + return FRAME_FACE_CACHE (f)->faces_by_id[id]; +} + +/* Return a pointer to the face with ID on frame F, or null if such a + face doesn't exist. */ + +INLINE struct face * +FACE_FROM_ID_OR_NULL (struct frame *f, int id) +{ + int used = FRAME_FACE_CACHE (f)->used; + eassume (0 <= used); + return 0 <= id && id < used ? FRAME_FACE_CACHE (f)->faces_by_id[id] : NULL; +} + +#ifdef HAVE_WINDOW_SYSTEM + +/* A non-null pointer to the image with id ID on frame F. */ + +INLINE struct image * +IMAGE_FROM_ID (struct frame *f, int id) +{ + eassert (0 <= id && id < FRAME_IMAGE_CACHE (f)->used); + return FRAME_IMAGE_CACHE (f)->images[id]; +} + +/* Value is a pointer to the image with id ID on frame F, or null if + no image with that id exists. */ + +INLINE struct image * +IMAGE_OPT_FROM_ID (struct frame *f, int id) +{ + int used = FRAME_IMAGE_CACHE (f)->used; + eassume (0 <= used); + return 0 <= id && id < used ? FRAME_IMAGE_CACHE (f)->images[id] : NULL; +} +#endif /*********************************************************************** Conversion between canonical units and pixels diff --git a/src/keyboard.c b/src/keyboard.c index 9ce168c6dd..b4e62c3bb4 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2927,13 +2927,11 @@ read_char (int commandflag, Lisp_Object map, goto exit; if ((STRINGP (KVAR (current_kboard, Vkeyboard_translate_table)) - && UNSIGNED_CMP (XFIXNAT (c), <, - SCHARS (KVAR (current_kboard, - Vkeyboard_translate_table)))) + && XFIXNAT (c) < SCHARS (KVAR (current_kboard, + Vkeyboard_translate_table))) || (VECTORP (KVAR (current_kboard, Vkeyboard_translate_table)) - && UNSIGNED_CMP (XFIXNAT (c), <, - ASIZE (KVAR (current_kboard, - Vkeyboard_translate_table)))) + && XFIXNAT (c) < ASIZE (KVAR (current_kboard, + Vkeyboard_translate_table))) || (CHAR_TABLE_P (KVAR (current_kboard, Vkeyboard_translate_table)) && CHARACTERP (c))) { diff --git a/src/lisp.h b/src/lisp.h index c3efabaf52..706ca6b9a8 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1923,18 +1923,12 @@ memclear (void *p, ptrdiff_t nbytes) (offsetof (type, lastlispfield) + word_size < header_size \ ? 0 : (offsetof (type, lastlispfield) + word_size - header_size) / word_size) -/* Compute A OP B, using the unsigned comparison operator OP. A and B - should be integer expressions. This is not the same as - mathematical comparison; for example, UNSIGNED_CMP (0, <, -1) - returns true. For efficiency, prefer plain unsigned comparison if A - and B's sizes both fit (after integer promotion). */ -#define UNSIGNED_CMP(a, op, b) \ - (max (sizeof ((a) + 0), sizeof ((b) + 0)) <= sizeof (unsigned) \ - ? ((a) + (unsigned) 0) op ((b) + (unsigned) 0) \ - : ((a) + (uintmax_t) 0) op ((b) + (uintmax_t) 0)) - /* True iff C is an ASCII character. */ -#define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80) +INLINE bool +ASCII_CHAR_P (intmax_t c) +{ + return 0 <= c && c < 0x80; +} /* A char-table is a kind of vectorlike, with contents are like a vector but with a few other slots. For some purposes, it makes commit 7abfb6475716e3002c30d10ead0c309b4fed6992 Author: Juri Linkov Date: Sun Apr 12 02:49:55 2020 +0300 * lisp/hi-lock.el (hi-lock-highlight-range): Bump default value (bug#40224) * lisp/hi-lock.el (hi-lock-highlight-range): Change default value from 200_000 to 2_000_000. diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 41d1094f23..d5e46651a5 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -102,7 +102,7 @@ of functions `hi-lock-mode' and `hi-lock-find-patterns'." :type 'integer :group 'hi-lock) -(defcustom hi-lock-highlight-range 200000 +(defcustom hi-lock-highlight-range 2000000 "Size of area highlighted by hi-lock when font-lock not active. Font-lock is not active in buffers that do their own highlighting, such as the buffer created by `list-colors-display'. In those buffers commit 86b820752349de572bfbb306cc0d8f7cea41d0a7 Author: Juri Linkov Date: Sun Apr 12 02:45:02 2020 +0300 Implement case-insensitivity in hi-lock (bug#40337) * lisp/hi-lock.el (hi-lock-interactive-lighters): New buffer-local variable. (hi-lock-mode): Set hi-lock-interactive-lighters to nil. (hi-lock-line-face-buffer): Use case-fold-search and search-upper-case. (hi-lock-face-buffer): Add new arg LIGHTER. Use case-fold-search, search-upper-case and search-spaces-regexp. (hi-lock-face-phrase-buffer): Don't call hi-lock-process-phrase. Use case-fold-search, search-upper-case and search-whitespace-regexp. (hi-lock-face-symbol-at-point): Use case-fold-search and search-upper-case. (hi-lock-unface-buffer): Use hi-lock-interactive-lighters to get a human-readable string for completion and x-popup-menu. (hi-lock-process-phrase): Remove function. (hi-lock-set-pattern): Add new args LIGHTER, CASE-FOLD, SPACES-REGEXP. Set font-lock pattern to a search function. Add mapping from lighter or regexp to pattern to hi-lock-interactive-lighters. Let-bind case-fold-search and search-spaces-regexp in search functions. * lisp/isearch.el (isearch--highlight-regexp-or-lines): Replace ugly code with let-binding of case-fold-search, search-upper-case, search-spaces-regexp. (isearch-highlight-regexp, isearch-highlight-lines-matching-regexp): Use lambda. diff --git a/etc/NEWS b/etc/NEWS index 2ab64e4fae..eefcb0a502 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -257,6 +257,13 @@ case-insensitive matching of messages when the old behaviour is required, but the recommended solution is to use a correctly matching regexp instead. +** Hi-Lock + +*** Matching in 'hi-lock-mode' is case-sensitive when regexp contains +upper case characters and `search-upper-case' is non-nil. +'highlight-phrase' also uses 'search-whitespace-regexp' +to substitute spaces in regexp search. + ** Texinfo --- diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index de258935e1..41d1094f23 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -233,6 +233,10 @@ Instead, each hi-lock command will cycle through the faces in "Patterns provided to hi-lock by user. Should not be changed.") (put 'hi-lock-interactive-patterns 'permanent-local t) +(defvar-local hi-lock-interactive-lighters nil + "Human-readable lighters for `hi-lock-interactive-patterns'.") +(put 'hi-lock-interactive-lighters 'permanent-local t) + (define-obsolete-variable-alias 'hi-lock-face-history 'hi-lock-face-defaults "23.1") (defvar hi-lock-face-defaults @@ -403,7 +407,8 @@ versions before 22 use the following in your init file: hi-lock-file-patterns) (when hi-lock-interactive-patterns (font-lock-remove-keywords nil hi-lock-interactive-patterns) - (setq hi-lock-interactive-patterns nil)) + (setq hi-lock-interactive-patterns nil + hi-lock-interactive-lighters nil)) (when hi-lock-file-patterns (font-lock-remove-keywords nil hi-lock-file-patterns) (setq hi-lock-file-patterns nil)) @@ -434,6 +439,9 @@ of text in those lines. Interactively, prompt for REGEXP using `read-regexp', then FACE. Use the global history list for FACE. +If REGEXP contains upper case characters (excluding those preceded by `\\') +and `search-upper-case' is non-nil, the matching is case-sensitive. + Use Font lock mode, if enabled, to highlight REGEXP. Otherwise, use overlays for highlighting. If overlays are used, the highlighting will not update as you type." @@ -447,19 +455,29 @@ highlighting will not update as you type." (hi-lock-set-pattern ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ? ;; or a trailing $ in REGEXP will be interpreted correctly. - (concat "^.*\\(?:" regexp "\\).*\\(?:$\\)\n?") face)) + (concat "^.*\\(?:" regexp "\\).*\\(?:$\\)\n?") face nil nil + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search))) ;;;###autoload (defalias 'highlight-regexp 'hi-lock-face-buffer) ;;;###autoload -(defun hi-lock-face-buffer (regexp &optional face subexp) +(defun hi-lock-face-buffer (regexp &optional face subexp lighter) "Set face of each match of REGEXP to FACE. Interactively, prompt for REGEXP using `read-regexp', then FACE. Use the global history list for FACE. Limit face setting to the corresponding SUBEXP (interactively, the prefix argument) of REGEXP. If SUBEXP is omitted or nil, the entire REGEXP is highlighted. +LIGHTER is a human-readable string that can be used to select +a regexp to unhighlight by its name instead of selecting a possibly +complex regexp or closure. + +If REGEXP contains upper case characters (excluding those preceded by `\\') +and `search-upper-case' is non-nil, the matching is case-sensitive. + Use Font lock mode, if enabled, to highlight REGEXP. Otherwise, use overlays for highlighting. If overlays are used, the highlighting will not update as you type." @@ -471,7 +489,12 @@ highlighting will not update as you type." current-prefix-arg)) (or (facep face) (setq face 'hi-yellow)) (unless hi-lock-mode (hi-lock-mode 1)) - (hi-lock-set-pattern regexp face subexp)) + (hi-lock-set-pattern + regexp face subexp lighter + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search) + search-spaces-regexp)) ;;;###autoload (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer) @@ -481,9 +504,9 @@ highlighting will not update as you type." Interactively, prompt for REGEXP using `read-regexp', then FACE. Use the global history list for FACE. -When called interactively, replace whitespace in user-provided -regexp with arbitrary whitespace, and make initial lower-case -letters case-insensitive, before highlighting with `hi-lock-set-pattern'. +If REGEXP contains upper case characters (excluding those preceded by `\\') +and `search-upper-case' is non-nil, the matching is case-sensitive. +Also set `search-spaces-regexp' to the value of `search-whitespace-regexp'. Use Font lock mode, if enabled, to highlight REGEXP. Otherwise, use overlays for highlighting. If overlays are used, the @@ -491,12 +514,16 @@ highlighting will not update as you type." (interactive (list (hi-lock-regexp-okay - (hi-lock-process-phrase - (read-regexp "Phrase to highlight" 'regexp-history-last))) + (read-regexp "Phrase to highlight" 'regexp-history-last)) (hi-lock-read-face-name))) (or (facep face) (setq face 'hi-yellow)) (unless hi-lock-mode (hi-lock-mode 1)) - (hi-lock-set-pattern regexp face)) + (hi-lock-set-pattern + regexp face nil nil + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search) + search-whitespace-regexp)) ;;;###autoload (defalias 'highlight-symbol-at-point 'hi-lock-face-symbol-at-point) @@ -507,6 +534,9 @@ Uses the next face from `hi-lock-face-defaults' without prompting, unless you use a prefix argument. Uses `find-tag-default-as-symbol-regexp' to retrieve the symbol at point. +If REGEXP contains upper case characters (excluding those preceded by `\\') +and `search-upper-case' is non-nil, the matching is case-sensitive. + This uses Font lock mode if it is enabled; otherwise it uses overlays, in which case the highlighting will not update as you type." (interactive) @@ -516,7 +546,11 @@ in which case the highlighting will not update as you type." (face (hi-lock-read-face-name))) (or (facep face) (setq face 'hi-yellow)) (unless hi-lock-mode (hi-lock-mode 1)) - (hi-lock-set-pattern regexp face))) + (hi-lock-set-pattern + regexp face nil nil + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search)))) (defun hi-lock-keyword->face (keyword) (cadr (cadr (cadr keyword)))) ; Keyword looks like (REGEXP (0 'FACE) ...). @@ -586,12 +620,15 @@ then remove all hi-lock highlighting." 'keymap (cons "Select Pattern to Unhighlight" (mapcar (lambda (pattern) - (list (car pattern) - (format - "%s (%s)" (car pattern) - (hi-lock-keyword->face pattern)) - (cons nil nil) - (car pattern))) + (let ((lighter + (or (car (rassq pattern hi-lock-interactive-lighters)) + (car pattern)))) + (list lighter + (format + "%s (%s)" lighter + (hi-lock-keyword->face pattern)) + (cons nil nil) + lighter))) hi-lock-interactive-patterns)))) ;; If the user clicks outside the menu, meaning that they ;; change their mind, x-popup-menu returns nil, and @@ -602,17 +639,33 @@ then remove all hi-lock highlighting." (t ;; Un-highlighting triggered via keyboard action. (unless hi-lock-interactive-patterns - (error "No highlighting to remove")) + (user-error "No highlighting to remove")) ;; Infer the regexp to un-highlight based on cursor position. (let* ((defaults (or (hi-lock--regexps-at-point) (mapcar #'car hi-lock-interactive-patterns)))) + (setq defaults + (mapcar (lambda (default) + (or (car (rassq default + (mapcar (lambda (a) + (cons (car a) (cadr a))) + hi-lock-interactive-lighters))) + default)) + defaults)) (list (completing-read (if (null defaults) "Regexp to unhighlight: " (format "Regexp to unhighlight (default %s): " (car defaults))) - hi-lock-interactive-patterns + (mapcar (lambda (pattern) + (cons (or (car (rassq pattern hi-lock-interactive-lighters)) + (car pattern)) + (cdr pattern))) + hi-lock-interactive-patterns) nil t nil nil defaults)))))) + + (when (assoc regexp hi-lock-interactive-lighters) + (setq regexp (cadr (assoc regexp hi-lock-interactive-lighters)))) + (dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns (list (assoc regexp hi-lock-interactive-patterns)))) (when keyword @@ -629,7 +682,11 @@ then remove all hi-lock highlighting." (setq hi-lock-interactive-patterns (delq keyword hi-lock-interactive-patterns)) (remove-overlays - nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons (car keyword))) + nil nil 'hi-lock-overlay-regexp + (hi-lock--hashcons (or (car (rassq keyword hi-lock-interactive-lighters)) + (car keyword)))) + (setq hi-lock-interactive-lighters + (rassq-delete-all keyword hi-lock-interactive-lighters)) (font-lock-flush)))) ;;;###autoload @@ -641,7 +698,7 @@ Interactively added patterns are those normally specified using be found in variable `hi-lock-interactive-patterns'." (interactive) (if (null hi-lock-interactive-patterns) - (error "There are no interactive patterns")) + (user-error "There are no interactive patterns")) (let ((beg (point))) (mapc (lambda (pattern) @@ -655,25 +712,6 @@ be found in variable `hi-lock-interactive-patterns'." ;; Implementation Functions -(defun hi-lock-process-phrase (phrase) - "Convert regexp PHRASE to a regexp that matches phrases. - -Blanks in PHRASE replaced by regexp that matches arbitrary whitespace -and initial lower-case letters made case insensitive." - (let ((mod-phrase nil)) - ;; FIXME fragile; better to just bind case-fold-search? (Bug#7161) - (setq mod-phrase - (replace-regexp-in-string - "\\(^\\|\\s-\\)\\([a-z]\\)" - (lambda (m) (format "%s[%s%s]" - (match-string 1 m) - (upcase (match-string 2 m)) - (match-string 2 m))) phrase)) - ;; FIXME fragile; better to use search-spaces-regexp? - (setq mod-phrase - (replace-regexp-in-string - "\\s-+" "[ \t\n]+" mod-phrase nil t)))) - (defun hi-lock-regexp-okay (regexp) "Return REGEXP if it appears suitable for a font-lock pattern. @@ -713,19 +751,26 @@ with completion and history." (add-to-list 'hi-lock-face-defaults face t)) (intern face))) -(defun hi-lock-set-pattern (regexp face &optional subexp) +(defun hi-lock-set-pattern (regexp face &optional subexp lighter case-fold spaces-regexp) "Highlight SUBEXP of REGEXP with face FACE. If omitted or nil, SUBEXP defaults to zero, i.e. the entire -REGEXP is highlighted." +REGEXP is highlighted. LIGHTER is a human-readable string to +display instead of a regexp. Non-nil CASE-FOLD ignores case. +SPACES-REGEXP is a regexp to substitute spaces in font-lock search." ;; Hashcons the regexp, so it can be passed to remove-overlays later. (setq regexp (hi-lock--hashcons regexp)) (setq subexp (or subexp 0)) - (let ((pattern (list regexp (list subexp (list 'quote face) 'prepend))) + (let ((pattern (list (lambda (limit) + (let ((case-fold-search case-fold) + (search-spaces-regexp spaces-regexp)) + (re-search-forward regexp limit t))) + (list subexp (list 'quote face) 'prepend))) (no-matches t)) ;; Refuse to highlight a text that is already highlighted. (if (assoc regexp hi-lock-interactive-patterns) (add-to-list 'hi-lock--unused-faces (face-name face)) (push pattern hi-lock-interactive-patterns) + (push (cons (or lighter regexp) pattern) hi-lock-interactive-lighters) (if (and font-lock-mode (font-lock-specified-p major-mode)) (progn (font-lock-add-keywords nil (list pattern) t) @@ -737,7 +782,9 @@ REGEXP is highlighted." (- range-min (max 0 (- range-max (point-max)))))) (search-end (min (point-max) - (+ range-max (max 0 (- (point-min) range-min)))))) + (+ range-max (max 0 (- (point-min) range-min))))) + (case-fold-search case-fold) + (search-spaces-regexp spaces-regexp)) (save-excursion (goto-char search-start) (while (re-search-forward regexp search-end t) @@ -751,7 +798,9 @@ REGEXP is highlighted." (when no-matches (add-to-list 'hi-lock--unused-faces (face-name face)) (setq hi-lock-interactive-patterns - (cdr hi-lock-interactive-patterns))))))))) + (cdr hi-lock-interactive-patterns) + hi-lock-interactive-lighters + (cdr hi-lock-interactive-lighters))))))))) (defun hi-lock-set-file-patterns (patterns) "Replace file patterns list with PATTERNS and refontify." diff --git a/lisp/isearch.el b/lisp/isearch.el index 7625ec12b5..e13a4dda83 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2382,22 +2382,17 @@ respectively)." (funcall isearch-regexp-function isearch-string)) (isearch-regexp-function (word-search-regexp isearch-string)) (isearch-regexp isearch-string) - ((if (and (eq isearch-case-fold-search t) - search-upper-case) - (isearch-no-upper-case-p - isearch-string isearch-regexp) - isearch-case-fold-search) - ;; Turn isearch-string into a case-insensitive - ;; regexp. - (mapconcat - (lambda (c) - (let ((s (string c))) - (if (string-match "[[:alpha:]]" s) - (format "[%s%s]" (upcase s) (downcase s)) - (regexp-quote s)))) - isearch-string "")) (t (regexp-quote isearch-string))))) - (funcall hi-lock-func regexp (hi-lock-read-face-name))) + (let ((case-fold-search isearch-case-fold-search) + ;; Set `search-upper-case' to nil to not call + ;; `isearch-no-upper-case-p' in `hi-lock'. + (search-upper-case nil) + (search-spaces-regexp + (if (if isearch-regexp + isearch-regexp-lax-whitespace + isearch-lax-whitespace) + search-whitespace-regexp))) + (funcall hi-lock-func regexp (hi-lock-read-face-name) isearch-string))) (and isearch-recursive-edit (exit-recursive-edit))) (defun isearch-highlight-regexp () @@ -2405,14 +2400,18 @@ respectively)." The arguments passed to `highlight-regexp' are the regexp from the last search and the face from `hi-lock-read-face-name'." (interactive) - (isearch--highlight-regexp-or-lines 'highlight-regexp)) + (isearch--highlight-regexp-or-lines + #'(lambda (regexp face lighter) + (highlight-regexp regexp face nil lighter)))) (defun isearch-highlight-lines-matching-regexp () "Exit Isearch mode and call `highlight-lines-matching-regexp'. The arguments passed to `highlight-lines-matching-regexp' are the regexp from the last search and the face from `hi-lock-read-face-name'." (interactive) - (isearch--highlight-regexp-or-lines 'highlight-lines-matching-regexp)) + (isearch--highlight-regexp-or-lines + #'(lambda (regexp face _lighter) + (highlight-lines-matching-regexp regexp face)))) (defun isearch-delete-char () commit e7b4233d9bccf4f65c008682eef4f88d0f003d6d Author: Stefan Monnier Date: Sat Apr 11 14:01:06 2020 -0400 * etc/NEWS: Mention 'cl-font-lock-built-in-mode' diff --git a/etc/NEWS b/etc/NEWS index ef2697f485..2ab64e4fae 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -101,6 +101,10 @@ horizontal movements now stop at the edge of the board. * Changes in Specialized Modes and Packages in Emacs 28.1 +** New minor mode 'cl-font-lock-built-in-mode' for `lisp-mode' +The mode provides refined highlighting of built-in functions, types, +and variables. + ** archive-mode *** Can now modify members of 'ar' archives. *** Display of summaries unified between backends commit 38166443c06b23a6d260c7d443077fe843dfce92 Author: Stefan Monnier Date: Sat Apr 11 13:55:52 2020 -0400 * lisp/progmodes/cl-font-lock.el: Fix header and make it a minor mode Change copyright to FSF and licence to GPLv3+. Tweak Commentary (the code doesn't seem to provide the lambda prettification mentioned). (cl-font-lock-add-regexes): Remove macro. (cl-font-lock-built-in-keywords): New variable. (cl-font-lock-built-in-mode): New minor mode. diff --git a/lisp/progmodes/cl-font-lock.el b/lisp/progmodes/cl-font-lock.el index 6d6992e11c..7ef43fd449 100644 --- a/lisp/progmodes/cl-font-lock.el +++ b/lisp/progmodes/cl-font-lock.el @@ -1,52 +1,59 @@ ;;; cl-font-lock.el --- Pretty Common Lisp font locking -*- lexical-binding: t; -*- -;; Copyright (C) 2019 Yue Daian -;; Author: Yue Daian +;; Copyright (C) 2019-2020 Free Software Foundation, Inc. + +;; Author: Yue Daian ;; Maintainer: Spenser Truex ;; Created: 2019-06-16 -;; Version: 0.3.0 +;; Old-Version: 0.3.0 ;; Package-Requires: ((emacs "24.5")) ;; Keywords: lisp wp files convenience ;; URL: https://github.com/cl-font-lock/cl-font-lock ;; Homepage: https://github.com/cl-font-lock/cl-font-lock -;; This file is not part of GNU Emacs, but you want to use GNU Emacs to run it. -;; This file is very free software. - -;; This is free and unencumbered software released into the public domain. - -;; Anyone is free to copy, modify, publish, use, compile, sell, or -;; distribute this software, either in source code form or as a compiled -;; binary, for any purpose, commercial or non-commercial, and by any -;; means. -;; In jurisdictions that recognize copyright laws, the author or authors -;; of this software dedicate any and all copyright interest in the -;; software to the public domain. We make this dedication for the benefit -;; of the public at large and to the detriment of our heirs and -;; successors. We intend this dedication to be an overt act of -;; relinquishment in perpetuity of all present and future rights to this -;; software under copyright law. +;; This file is part of GNU Emacs -;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR -;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, -;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR -;; OTHER DEALINGS IN THE SOFTWARE. +;; 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. -;; For more information, please refer to . +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; 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: -;; Highlight all the symbols in the Common Lisp ANSI Standard, and prettify -;; lambda to display the greek letter. -;; +;; Highlight all the symbols in the Common Lisp ANSI Standard. ;; Adds font-lock regexes to lisp-mode. +;;;; Todo: + +;; - Integrate better into `lisp-mode' (e.g. enable it by default). +;; - Distinguish functions from macros like `pushnew'. + ;;; Code: -(require 'cl-lib) +;; The list of built-in functions and variables was actually not +;; extracted from the standard, but from SBCL with the following +;; (Common Lisp) code: + +;; (defvar *functions* nil) +;; (defvar *symbols* nil) +;; (defvar *types* nil) + +;; (let ((pack (find-package :common-lisp))) +;; (do-all-symbols (sym) +;; (cond +;; ((not (eql pack (symbol-package sym))) nil) +;; ((fboundp sym) (pushnew sym *functions*)) +;; ((find-class sym nil) (pushnew sym *types*)) +;; (t (pushnew sym *symbols*))))) + + (defvar cl-font-lock-built-in--functions '("+" "-" "/" "/=" "<" "<=" "=" ">" ">=" "*" "1-" "1+" "abs" "acons" "acos" "acosh" "add-method" "adjoin" "adjustable-array-p" "adjust-array" @@ -256,28 +263,26 @@ (defvar cl-font-lock--character-names '("newline" "space" "rubout" "page" "tab" "backspace" "return" "linefeed")) -(defmacro cl-font-lock-add-regexes (fn mode &rest symbol-face) - "Expand to more than one call to font-lock. -Argument FN is the function used to send off the regex. Commonly -`font-lock-add-keywords' or `font-lock-remove-keywords'. Argument -MODE is the mode where the regexes are sent. -Optional argument SYMBOL-FACE dotted-pair of (regex-var . font-face)." - `(progn - ,@(cl-loop for s in symbol-face - collect - `(,fn - ',mode - `((,(regexp-opt ,(car s) 'symbols) - . ,(cdr ',s))))))) +(defvar cl-font-lock-built-in-keywords + (mapcar (lambda (s) + `(,(regexp-opt (symbol-value (car s)) 'symbols) + . ,(cdr s))) + '((cl-font-lock-built-in--functions . font-lock-function-name-face) + (cl-font-lock-built-in--variables . font-lock-variable-name-face) + (cl-font-lock-built-in--types . font-lock-type-face) + (cl-font-lock-built-in--symbols . font-lock-builtin-face) + (cl-font-lock--character-names . font-lock-variable-name-face)))) -(cl-font-lock-add-regexes - font-lock-add-keywords - lisp-mode - (cl-font-lock-built-in--functions . font-lock-function-name-face) - (cl-font-lock-built-in--variables . font-lock-variable-name-face) - (cl-font-lock-built-in--types . font-lock-type-face) - (cl-font-lock-built-in--symbols . font-lock-builtin-face) - (cl-font-lock--character-names . font-lock-variable-name-face)) +;;;###autoload +(define-minor-mode cl-font-lock-built-in-mode + "Highlight built-in functions, variables, and types in `lisp-mode'." + :global t + (funcall + (if cl-font-lock-built-in-mode + #'font-lock-add-keywords + #'font-lock-remove-keywords) + 'lisp-mode + cl-font-lock-built-in-keywords)) (provide 'cl-font-lock) commit 5084fdb83e2421516f161daff37ea67d1cb63402 Author: Stefan Monnier Date: Fri Apr 10 18:27:36 2020 -0400 * lisp/progmodes/cl-font-lock.el: New file Taken from commit 1a54066611da213626ab69ea426ba3c63ece3438 of https://github.com/cl-font-lock/cl-font-lock, but with names reverted to a `cl-font-lock-` prefix. diff --git a/lisp/progmodes/cl-font-lock.el b/lisp/progmodes/cl-font-lock.el new file mode 100644 index 0000000000..6d6992e11c --- /dev/null +++ b/lisp/progmodes/cl-font-lock.el @@ -0,0 +1,284 @@ +;;; cl-font-lock.el --- Pretty Common Lisp font locking -*- lexical-binding: t; -*- +;; Copyright (C) 2019 Yue Daian +;; Author: Yue Daian +;; Maintainer: Spenser Truex +;; Created: 2019-06-16 +;; Version: 0.3.0 +;; Package-Requires: ((emacs "24.5")) +;; Keywords: lisp wp files convenience +;; URL: https://github.com/cl-font-lock/cl-font-lock +;; Homepage: https://github.com/cl-font-lock/cl-font-lock +;; This file is not part of GNU Emacs, but you want to use GNU Emacs to run it. +;; This file is very free software. + +;; This is free and unencumbered software released into the public domain. + +;; Anyone is free to copy, modify, publish, use, compile, sell, or +;; distribute this software, either in source code form or as a compiled +;; binary, for any purpose, commercial or non-commercial, and by any +;; means. + +;; In jurisdictions that recognize copyright laws, the author or authors +;; of this software dedicate any and all copyright interest in the +;; software to the public domain. We make this dedication for the benefit +;; of the public at large and to the detriment of our heirs and +;; successors. We intend this dedication to be an overt act of +;; relinquishment in perpetuity of all present and future rights to this +;; software under copyright law. + +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR +;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, +;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;; OTHER DEALINGS IN THE SOFTWARE. + +;; For more information, please refer to . + + +;;; Commentary: + +;; Highlight all the symbols in the Common Lisp ANSI Standard, and prettify +;; lambda to display the greek letter. +;; +;; Adds font-lock regexes to lisp-mode. + +;;; Code: + +(require 'cl-lib) +(defvar cl-font-lock-built-in--functions + '("+" "-" "/" "/=" "<" "<=" "=" ">" ">=" "*" "1-" "1+" "abs" "acons" "acos" + "acosh" "add-method" "adjoin" "adjustable-array-p" "adjust-array" + "allocate-instance" "alpha-char-p" "alphanumericp" "and" "append" "apply" + "apropos" "apropos-list" "aref" "arithmetic-error-operands" + "arithmetic-error-operation" "array-dimension" "array-dimensions" + "array-displacement" "array-element-type" "array-has-fill-pointer-p" + "array-in-bounds-p" "arrayp" "array-rank" "array-row-major-index" + "array-total-size" "ash" "asin" "asinh" "assoc" "assoc-if" "assoc-if-not" + "atan" "atanh" "atom" "bit" "bit-and" "bit-andc1" "bit-andc2" "bit-eqv" + "bit-ior" "bit-nand" "bit-nor" "bit-not" "bit-orc1" "bit-orc2" + "bit-vector-p" "bit-xor" "boole" "both-case-p" "boundp" + "broadcast-stream-streams" "butlast" "byte" "byte-position" "byte-size" + "call-method" "call-next-method" "car" "catch" "cdr" "ceiling" + "cell-error-name" "change-class" "char" "char/=" "char<" "char<=" "char=" + "char>" "char>=" "character" "characterp" "char-code" "char-downcase" + "char-equal" "char-greaterp" "char-int" "char-lessp" "char-name" + "char-not-equal" "char-not-greaterp" "char-not-lessp" "char-upcase" "cis" + "class-name" "class-of" "clear-input" "clear-output" "close" "clrhash" + "code-char" "coerce" "compile" "compiled-function-p" "compile-file" + "compile-file-pathname" "compiler-macro-function" "complement" "complex" + "complexp" "compute-applicable-methods" "compute-restarts" "concatenate" + "concatenated-stream-streams" "conjugate" "cons" "consp" "constantly" + "constantp" "continue" "copy-alist" "copy-list" "copy-pprint-dispatch" + "copy-readtable" "copy-seq" "copy-structure" "copy-symbol" "copy-tree" + "cos" "cosh" "count" "count-if" "count-if-not" "decf" "decode-float" + "decode-universal-time" "delete" "delete-duplicates" "delete-file" + "delete-if" "delete-if-not" "delete-package" "denominator" "deposit-field" + "describe" "describe-object" "digit-char" "digit-char-p" "directory" + "directory-namestring" "disassemble" "do-all-symbols" "documentation" + "do-external-symbols" "do-symbols" "dpb" "dribble" + "echo-stream-input-stream" "echo-stream-output-stream" "ed" "eighth" "elt" + "encode-universal-time" "endp" "enough-namestring" + "ensure-directories-exist" "ensure-generic-function" "eq" "eql" "equal" + "equalp" "eval" "evenp" "every" "exp" "export" "expt" "fboundp" "fceiling" + "fdefinition" "ffloor" "fifth" "file-author" "file-error-pathname" + "file-length" "file-namestring" "file-position" "file-string-length" + "file-write-date" "fill" "fill-pointer" "find" "find-all-symbols" + "find-class" "find-if" "find-if-not" "find-method" "find-package" + "find-restart" "find-symbol" "finish-output" "first" "float" "float-digits" + "floatp" "float-precision" "float-radix" "float-sign" "floor" "fmakunbound" + "force-output" "format" "formatter" "fourth" "fresh-line" "fround" + "ftruncate" "funcall" "function" "function-keywords" + "function-lambda-expression" "functionp" "gcd" "gensym" "gentemp" "get" + "get-decoded-time" "get-dispatch-macro-character" "getf" "gethash" + "get-internal-real-time" "get-internal-run-time" "get-macro-character" + "get-output-stream-string" "get-properties" "get-setf-expansion" + "get-universal-time" "graphic-char-p" "hash-table-count" "hash-table-p" + "hash-table-rehash-size" "hash-table-rehash-threshold" "hash-table-size" + "hash-table-test" "host-namestring" "identity" "imagpart" "import" "incf" + "initialize-instance" "input-stream-p" "inspect" "integer-decode-float" + "integer-length" "integerp" "interactive-stream-p" "intern" "intersection" + "invalid-method-error" "invoke-debugger" "invoke-restart" + "invoke-restart-interactively" "isqrt" "keywordp" "last" "lcm" "ldb" + "ldb-test" "ldiff" "length" "lisp-implementation-type" + "lisp-implementation-version" "list" "list\\*" "list-all-packages" "listen" + "list-length" "listp" "load" "load-logical-pathname-translations" + "load-time-value" "log" "logand" "logandc1" "logandc2" "logbitp" "logcount" + "logeqv" "logical-pathname" "logical-pathname-translations" "logior" + "lognand" "lognor" "lognot" "logorc1" "logorc2" "logtest" "logxor" + "long-site-name" "loop-finish" "lower-case-p" "machine-instance" + "machine-type" "machine-version" "macroexpand" "macroexpand-1" + "macro-function" "make-array" "make-array" "make-broadcast-stream" + "make-concatenated-stream" "make-condition" "make-dispatch-macro-character" + "make-echo-stream" "make-hash-table" "make-instance" + "make-instances-obsolete" "make-list" "make-load-form" + "make-load-form-saving-slots" "make-method" "make-package" "make-pathname" + "make-random-state" "make-sequence" "make-string" + "make-string-input-stream" "make-string-output-stream" "make-symbol" + "make-synonym-stream" "make-two-way-stream" "makunbound" "map" "mapc" + "mapcan" "mapcar" "mapcon" "maphash" "map-into" "mapl" "maplist" + "mask-field" "max" "member" "member-if" "member-if-not" "merge" + "merge-pathnames" "method-combination-error" "method-qualifiers" "min" + "minusp" "mismatch" "mod" "muffle-warning" "multiple-value-call" + "multiple-value-list" "multiple-value-setq" "name-char" "namestring" + "nbutlast" "nconc" "next-method-p" "nintersection" "ninth" + "no-applicable-method" "no-next-method" "not" "notany" "notevery" "nreconc" + "nreverse" "nset-difference" "nset-exclusive-or" "nstring-capitalize" + "nstring-downcase" "nstring-upcase" "nsublis" "nsubst" "nsubst-if" + "nsubst-if-not" "nsubstitute" "nsubstitute-if" "nsubstitute-if-not" "nth" + "nthcdr" "nth-value" "null" "numberp" "numerator" "nunion" "oddp" "open" + "open-stream-p" "or" "output-stream-p" "package-error-package" + "package-name" "package-nicknames" "packagep" "package-shadowing-symbols" + "package-used-by-list" "package-use-list" "pairlis" "parse-integer" + "parse-namestring" "pathname" "pathname-device" "pathname-directory" + "pathname-host" "pathname-match-p" "pathname-name" "pathnamep" + "pathname-type" "pathname-version" "peek-char" "phase" "plusp" "pop" + "position" "position-if" "position-if-not" "pprint" "pprint-dispatch" + "pprint-exit-if-list-exhausted" "pprint-fill" "pprint-indent" + "pprint-linear" "pprint-logical-block" "pprint-newline" "pprint-pop" + "pprint-tab" "pprint-tabular" "prin1" "prin1-to-string" "princ" + "princ-to-string" "print" "print-not-readable-object" "print-object" + "print-unreadable-object" "probe-file" "provide" "psetf" "psetq" "push" + "pushnew" "quote" "random" "random-state-p" "rassoc" "rassoc-if" + "rassoc-if-not" "rational" "rationalize" "rationalp" "read" "read-byte" + "read-char" "read-char-no-hang" "read-delimited-list" "read-from-string" + "read-line" "read-preserving-whitespace" "read-sequence" "readtable-case" + "readtablep" "realp" "realpart" "reduce" "reinitialize-instance" "rem" + "remf" "remhash" "remove" "remove-duplicates" "remove-if" "remove-if-not" + "remove-method" "remprop" "rename-file" "rename-package" "replace" + "require" "rest" "restart-name" "revappend" "reverse" "room" "rotatef" + "round" "row-major-aref" "rplaca" "rplacd" "sbit" "scale-float" "schar" + "search" "second" "set" "set-difference" "set-dispatch-macro-character" + "set-exclusive-or" "setf" "set-macro-character" "set-pprint-dispatch" + "setq" "set-syntax-from-char" "seventh" "shadow" "shadowing-import" + "shared-initialize" "shiftf" "short-site-name" "signum" + "simple-bit-vector-p" "simple-condition-format-arguments" + "simple-condition-format-control" "simple-string-p" "simple-vector-p" "sin" + "sinh" "sixth" "sleep" "slot-boundp" "slot-exists-p" "slot-makunbound" + "slot-missing" "slot-unbound" "slot-value" "software-type" + "software-version" "some" "sort" "special-operator-p" "sqrt" "stable-sort" + "standard-char-p" "step" "store-value" "stream-element-type" + "stream-error-stream" "stream-external-format" "streamp" "string" + "string/=" "string<" "string<=" "string=" "string>" "string>=" + "string-capitalize" "string-downcase" "string-equal" "string-greaterp" + "string-left-trim" "string-lessp" "string-not-equal" "string-not-greaterp" + "string-not-lessp" "stringp" "string-right-trim" "string-trim" + "string-upcase" "sublis" "subseq" "subsetp" "subst" "subst-if" + "subst-if-not" "substitute" "substitute-if" "substitute-if-not" "subtypep" + "svref" "sxhash" "symbol-function" "symbol-name" "symbolp" "symbol-package" + "symbol-plist" "symbol-value" "synonym-stream-symbol" "tailp" "tan" "tanh" + "tenth" "terpri" "third" "throw" "time" "trace" + "translate-logical-pathname" "translate-pathname" "tree-equal" "truename" + "truncate" "two-way-stream-input-stream" "two-way-stream-output-stream" + "type-error-datum" "type-error-expected-type" "type-of" "typep" + "unbound-slot-instance" "unexport" "unintern" "union" "unread-char" + "untrace" "unuse-package" "update-instance-for-different-class" + "update-instance-for-redefined-class" "upgraded-array-element-type" + "upgraded-complex-part-type" "upper-case-p" "use-package" + "user-homedir-pathname" "use-value" "values" "values-list" "vector" + "vectorp" "vector-pop" "vector-push" "vector-push-extend" "wild-pathname-p" + "write" "write-byte" "write-char" "write-line" "write-sequence" + "write-string" "write-to-string" "yes-or-no-p" "y-or-n-p" "zerop")) + +(defvar cl-font-lock-built-in--variables + '("//" "///" "\\*load-pathname\\*" "\\*print-pprint-dispatch\\*" + "\\*break-on-signals\\*" "\\*load-print\\*" "\\*print-pprint-dispatch\\*" + "\\*break-on-signals\\*" "\\*load-truename\\*" "\\*print-pretty\\*" + "\\*load-verbose\\*" "\\*print-radix\\*" "\\*compile-file-pathname\\*" + "\\*macroexpand-hook\\*" "\\*print-readably\\*" + "\\*compile-file-pathname\\*" "\\*modules\\*" "\\*print-right-margin\\*" + "\\*compile-file-truename\\*" "\\*package\\*" "\\*print-right-margin\\*" + "\\*compile-file-truename\\*" "\\*print-array\\*" "\\*query-io\\*" + "\\*compile-print\\*" "\\*print-base\\*" "\\*random-state\\*" + "\\*compile-verbose\\*" "\\*default-pathname-defaults\\*" + "\\*print-length\\*" "\\*readtable\\*" "\\*error-output\\*" + "\\*print-level\\*" "\\*standard-input\\*" "\\*print-case\\*" + "\\*read-base\\*" "\\*compile-verbose\\*" "\\*print-circle\\*" + "\\*print-lines\\*" "\\*standard-output\\*" "\\*features\\*" + "\\*print-miser-width\\*" "\\*read-default-float-format\\*" + "\\*debug-io\\*" "\\*print-escape\\*" "\\*read-eval\\*" + "\\*debugger-hook\\*" "\\*print-gensym\\*" "\\*read-suppress\\*" + "\\*terminal-io\\*" "\\*gensym-counter\\*" "\\*print-miser-width\\*" + "\\*trace-output\\*" "array-dimension-limit" "array-rank-limit" + "array-total-size-limit" "boole-1" "boole-2" "boole-and" "boole-andc1" + "boole-andc2" "boole-c1" "boole-c2" "boole-clr" "boole-eqv" "boole-ior" + "boole-nand" "boole-nor" "boole-orc1" "boole-orc2" "boole-set" "boole-xor" + "call-arguments-limit" "char-code-limit" "double-float-epsilon" + "double-float-negative-epsilon" "internal-time-units-per-second" + "lambda-list-keywords" "lambda-parameters-limit" + "least-negative-double-float" "least-negative-long-float" + "least-negative-normalized-double-float" + "least-negative-normalized-long-float" + "least-negative-normalized-short-float" + "least-negative-normalized-single-float" "least-negative-short-float" + "least-negative-single-float" "least-positive-double-float" + "least-positive-long-float" "least-positive-normalized-double-float" + "least-positive-normalized-long-float" + "least-positive-normalized-short-float" + "least-positive-normalized-single-float" "least-positive-short-float" + "least-positive-single-float" "long-float-epsilon" + "long-float-negative-epsilon" "most-negative-double-float" + "most-negative-fixnum" "most-negative-long-float" + "most-negative-short-float" "most-negative-single-float" + "most-positive-double-float" "most-positive-fixnum" + "most-positive-long-float" "most-positive-short-float" + "most-positive-single-float" "multiple-values-limit" "short-float-epsilon" + "short-float-negative-epsilon" "single-float-epsilon" + "single-float-negative-epsilon" "pi")) + +(defvar cl-font-lock-built-in--types + '("arithmetic-error" "array" "base-char" "base-string" "bignum" "bit-vector" + "boolean" "broadcast-stream" "built-in-class" "cell-error" "class" + "compiled-function" "concatenated-stream" "condition" "control-error" + "division-by-zero" "double-float" "echo-stream" "end-of-file" + "extended-char" "file-error" "file-stream" "fixnum" + "floating-point-inexact" "floating-point-invalid-operation" + "floating-point-overflow" "floating-point-underflow" "generic-function" + "hash-table" "integer" "keyword" "long-float" "method" "method-combination" + "number" "package" "package-error" "parse-error" "print-not-readable" + "program-error" "random-state" "ratio" "reader-error" "readtable" "real" + "restart" "sequence" "serious-condition" "short-float" "signed-byte" + "simple-array" "simple-base-string" "simple-bit-vector" "simple-condition" + "simple-error" "simple-string" "simple-type-error" "simple-vector" + "simple-warning" "single-float" "standard-char" "standard-class" + "standard-generic-function" "standard-method" "standard-object" + "storage-condition" "stream" "stream-error" "string-stream" + "structure-class" "structure-object" "style-warning" "symbol" + "synonym-stream" "two-way-stream" "type-error" "unbound-slot" + "unbound-variable" "undefined-function" "unsigned-byte" "warning")) + +(defvar cl-font-lock-built-in--symbols + '("compilation-speed" "compiler-macro" "debug" "declaration" "dynamic-extent" + "ftype" "ignorable" "ignore" "inline" "notinline" "optimize" "otherwise" + "safety" "satisfies" "space" "special" "speed" "structure" "type")) + +(defvar cl-font-lock--character-names + '("newline" "space" "rubout" "page" "tab" "backspace" "return" "linefeed")) + +(defmacro cl-font-lock-add-regexes (fn mode &rest symbol-face) + "Expand to more than one call to font-lock. +Argument FN is the function used to send off the regex. Commonly +`font-lock-add-keywords' or `font-lock-remove-keywords'. Argument +MODE is the mode where the regexes are sent. +Optional argument SYMBOL-FACE dotted-pair of (regex-var . font-face)." + `(progn + ,@(cl-loop for s in symbol-face + collect + `(,fn + ',mode + `((,(regexp-opt ,(car s) 'symbols) + . ,(cdr ',s))))))) + +(cl-font-lock-add-regexes + font-lock-add-keywords + lisp-mode + (cl-font-lock-built-in--functions . font-lock-function-name-face) + (cl-font-lock-built-in--variables . font-lock-variable-name-face) + (cl-font-lock-built-in--types . font-lock-type-face) + (cl-font-lock-built-in--symbols . font-lock-builtin-face) + (cl-font-lock--character-names . font-lock-variable-name-face)) + +(provide 'cl-font-lock) + +;;; cl-font-lock.el ends here commit a79019c16b23f40c29509b6c0bf6f79d87f18c1e Author: Mattias Engdegård Date: Tue Apr 7 10:10:04 2020 +0200 Allow ENCODE_FILE and DECODE_FILE to use no-copy conversion They already did return their argument under some circumstances; this change broadens it to further reduce allocation in common cases (bug#40407). * src/coding.c (convert_string_nocopy): New function. (decode_file_name, encode_file_name): Use convert_string_nocopy. * src/coding.h (ENCODE_FILE, DECODE_FILE): Note the nocopy semantics. diff --git a/src/coding.c b/src/coding.c index 9848f983a8..0daa390bc8 100644 --- a/src/coding.c +++ b/src/coding.c @@ -9559,10 +9559,7 @@ code_convert_string (Lisp_Object string, Lisp_Object coding_system, /* Encode or decode STRING according to CODING_SYSTEM. - Do not set Vlast_coding_system_used. - - This function is called only from macros DECODE_FILE and - ENCODE_FILE, thus we ignore character composition. */ + Do not set Vlast_coding_system_used. */ Lisp_Object code_convert_string_norecord (Lisp_Object string, Lisp_Object coding_system, @@ -10332,6 +10329,16 @@ DEFUN ("internal-decode-string-utf-8", Finternal_decode_string_utf_8, #endif /* ENABLE_UTF_8_CONVERTER_TEST */ +/* Encode or decode STRING using CODING_SYSTEM, with the possibility of + returning STRING itself if it equals the result. + Do not set Vlast_coding_system_used. */ +static Lisp_Object +convert_string_nocopy (Lisp_Object string, Lisp_Object coding_system, + bool encodep) +{ + return code_convert_string (string, coding_system, Qt, encodep, 1, 1); +} + /* Encode or decode a file name, to or from a unibyte string suitable for passing to C library functions. */ Lisp_Object @@ -10342,14 +10349,13 @@ decode_file_name (Lisp_Object fname) converts the file names either to UTF-16LE or to the system ANSI codepage internally, depending on the underlying OS; see w32.c. */ if (! NILP (Fcoding_system_p (Qutf_8))) - return code_convert_string_norecord (fname, Qutf_8, 0); + return convert_string_nocopy (fname, Qutf_8, 0); return fname; #else /* !WINDOWSNT */ if (! NILP (Vfile_name_coding_system)) - return code_convert_string_norecord (fname, Vfile_name_coding_system, 0); + return convert_string_nocopy (fname, Vfile_name_coding_system, 0); else if (! NILP (Vdefault_file_name_coding_system)) - return code_convert_string_norecord (fname, - Vdefault_file_name_coding_system, 0); + return convert_string_nocopy (fname, Vdefault_file_name_coding_system, 0); else return fname; #endif @@ -10369,14 +10375,13 @@ encode_file_name (Lisp_Object fname) converts the file names either to UTF-16LE or to the system ANSI codepage internally, depending on the underlying OS; see w32.c. */ if (! NILP (Fcoding_system_p (Qutf_8))) - return code_convert_string_norecord (fname, Qutf_8, 1); + return convert_string_nocopy (fname, Qutf_8, 1); return fname; #else /* !WINDOWSNT */ if (! NILP (Vfile_name_coding_system)) - return code_convert_string_norecord (fname, Vfile_name_coding_system, 1); + return convert_string_nocopy (fname, Vfile_name_coding_system, 1); else if (! NILP (Vdefault_file_name_coding_system)) - return code_convert_string_norecord (fname, - Vdefault_file_name_coding_system, 1); + return convert_string_nocopy (fname, Vdefault_file_name_coding_system, 1); else return fname; #endif diff --git a/src/coding.h b/src/coding.h index 91856c5702..c2a7b2a00f 100644 --- a/src/coding.h +++ b/src/coding.h @@ -642,11 +642,11 @@ struct coding_system } while (false) /* Encode the file name NAME using the specified coding system - for file names, if any. */ + for file names, if any. May return NAME itself. */ #define ENCODE_FILE(NAME) encode_file_name (NAME) /* Decode the file name NAME using the specified coding system - for file names, if any. */ + for file names, if any. May return NAME itself. */ #define DECODE_FILE(NAME) decode_file_name (NAME) /* Encode the string STR using the specified coding system commit 1988ffbaed709dfc71126efbf06644476830f07e Merge: b902d7c9d0 fd27685c1e Author: Glenn Morris Date: Sat Apr 11 07:50:12 2020 -0700 Merge from origin/emacs-27 fd27685c1e (origin/emacs-27) ; * doc/lispref/keymaps.texi (Extended M... 6057d79a4e * doc/lispref/keymaps.texi (Extended Menu Items): Tweak :k... 17a1bb5a03 Fix redisplay when scrolling under redisplay-dont-pause 90321f595c Fix face extension in pulse.el 36c42d2a30 * doc/misc/tramp.texi (Bug Reports): Avoid line breaks in ... d5750af151 Avoid assertion violation in intervals.c 18d1bc0a09 Improve documentation of 'jit-lock-contextually' 08486f4cae Speed up 'resize-mode' child frames a little f451ef9308 ; * etc/NEWS: Mention 'executing-macro' in removed vars. c49d379f17 Fix some problems with moving and resizing child frames # Conflicts: # etc/NEWS commit b902d7c9d07b2cc951fa5c789d585d65366d19d2 Author: Eli Zaretskii Date: Sat Apr 11 12:20:10 2020 +0300 ; * lisp/eshell/esh-var.el (eshell-variable-aliases-list): Fix wording. diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 70516b3b82..96838d4132 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -200,7 +200,7 @@ symbol values over environment values by setting If the value is a symbol, return the value bound to it. -If the value has any other type, signal `error'. +If the value has any other type, signal an error. Additionally, each member may specify if it should be copied to the environment of created subprocesses." commit 3275b01487826be66d4b6e2fb550549b61bb4bf7 Author: Federico Tedin Date: Sat Apr 4 12:04:11 2020 +0200 Reword documentation for eshell-variable-aliases-list * lisp/eshell/esh-var.el (eshell-variable-aliases-list): Update documentation string to avoid passive tense. diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 3093abd830..70516b3b82 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -183,24 +183,24 @@ Each member defines the name of a variable, and a Lisp value used to compute the string value that will be returned when the variable is accessed via the syntax `$NAME'. -If the value is a function, that function will be called with two -arguments: the list of the indices that was used in the reference, and -whether the user is requesting the length of the ultimate element. -For example, a reference of `$NAME[10][20]' would result in the -function for alias `NAME' being called (assuming it were aliased to a -function), and the arguments passed to this function would be the list -'(10 20)', and nil. - -If the value is a string, the value for the variable with that name in -the current environment will be returned. If no variable with that -name exists in the environment, but if a symbol with that same name -exists and has a value bound to it, then that value will be used. You -can prioritize symbol values over environment values by setting +If the value is a function, call that function with two arguments: the +list of the indices that was used in the reference, and whether the +user is requesting the length of the ultimate element. For example, a +reference of `$NAME[10][20]' would result in the function for alias +`NAME' being called (assuming it were aliased to a function), and the +arguments passed to this function would be the list '(10 20)', and +nil. + +If the value is a string, return the value for the variable with that +name in the current environment. If no variable with that name exists +in the environment, but if a symbol with that same name exists and has +a value bound to it, return its value instead. You can prioritize +symbol values over environment values by setting `eshell-prefer-lisp-variables' to t. -If the value is a symbol, the value bound to that symbol will be used. +If the value is a symbol, return the value bound to it. -If the value has any other type, `error' will be signaled. +If the value has any other type, signal `error'. Additionally, each member may specify if it should be copied to the environment of created subprocesses." commit fd27685c1e68e742abf1698573dac53743f15e48 Author: Eli Zaretskii Date: Sat Apr 11 09:40:37 2020 +0300 ; * doc/lispref/keymaps.texi (Extended Menu Items): Fix last change. diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index f3c984848e..c6a02d721f 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -2227,9 +2227,11 @@ This property specifies which key sequence is likely to be bound to the same command invoked by this menu item. If you specify a correct key sequence, that sequence will be preferred over others. -If you specify in incorrect key sequence, it has no effect; before Emacs +If you specify an incorrect key sequence, it has no effect; before Emacs displays @var{key-sequence} in the menu, it verifies that -@var{key-sequence} is really equivalent to this menu item. +@var{key-sequence} is really equivalent to this menu item. Specifying +@code{nil} for @var{key-sequence} is equivalent to the +@code{:key-sequence} attribute being absent. @item :keys @var{string} This property specifies that @var{string} is the string to display commit 6057d79a4eb4b95037068a1e9335a2418b2da5ec Author: Stefan Monnier Date: Fri Apr 10 17:04:19 2020 -0400 * doc/lispref/keymaps.texi (Extended Menu Items): Tweak :key-sequence Don't make it sound like `:key-sequence nil` is any different than the absence of `:key-sequence`. And the performance advantage of `:key-sequence` disappeared long ago. diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 259efea324..f3c984848e 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -2224,23 +2224,13 @@ set the variable so that the button you clicked on becomes selected. @item :key-sequence @var{key-sequence} This property specifies which key sequence is likely to be bound to the -same command invoked by this menu item. If you specify the right key -sequence, that makes preparing the menu for display run much faster. +same command invoked by this menu item. If you specify a correct key +sequence, that sequence will be preferred over others. -If you specify the wrong key sequence, it has no effect; before Emacs +If you specify in incorrect key sequence, it has no effect; before Emacs displays @var{key-sequence} in the menu, it verifies that @var{key-sequence} is really equivalent to this menu item. -@item :key-sequence nil -This property indicates that there is normally no key binding which is -equivalent to this menu item. Using this property saves time in -preparing the menu for display, because Emacs does not need to search -the keymaps for a keyboard equivalent for this menu item. - -However, if the user has rebound this item's definition to a key -sequence, Emacs ignores the @code{:keys} property and finds the keyboard -equivalent anyway. - @item :keys @var{string} This property specifies that @var{string} is the string to display as the keyboard equivalent for this menu item. You can use commit 17a1bb5a032025d29413d5ad9316d3d001da3166 Author: Eli Zaretskii Date: Fri Apr 10 18:30:21 2020 +0300 Fix redisplay when scrolling under redisplay-dont-pause * src/dispnew.c (update_window): Reset the window's 'must_be_updated_p' flag if the window's update was completed without interruption. This fixes redisplay glitches when 'redisplay-dont-pause' is nil, at least on MS-Windows, because 'expose_window' doesn't redraw the exposed rectangle when the window's 'must_be_updated_p' flag is set. diff --git a/src/dispnew.c b/src/dispnew.c index d79ae836c5..5b6fa51a56 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3683,6 +3683,10 @@ update_window (struct window *w, bool force_p) W->output_cursor doesn't contain the cursor location. */ gui_update_window_end (w, !paused_p, mouse_face_overwritten_p); #endif + /* If the update wasn't interrupted, this window has been + completely updated. */ + if (!paused_p) + w->must_be_updated_p = false; } else paused_p = 1; commit 90321f595c88324cccaa820add096e5d1c3deac5 Author: Eli Zaretskii Date: Thu Apr 9 19:44:55 2020 +0300 Fix face extension in pulse.el * lisp/cedet/pulse.el (pulse-reset-face): Propagate the :extend attribute of FACE to the face used for displaying the pulse. Reported by Adam Porter . diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el index 16243e16b4..8649254aed 100644 --- a/lisp/cedet/pulse.el +++ b/lisp/cedet/pulse.el @@ -161,6 +161,9 @@ Return t if there is more drift to do, nil if completed." (face-background face nil t) (face-background 'pulse-highlight-start-face) )) + (and face + (set-face-extend 'pulse-highlight-face + (face-extend-p face nil t))) (put 'pulse-highlight-face :startface (or face 'pulse-highlight-start-face)) (put 'pulse-highlight-face :iteration 0)) commit 36c42d2a30e7a02fc363b5ec3bd000530c705715 Author: Michael Albinus Date: Thu Apr 9 15:55:32 2020 +0200 * doc/misc/tramp.texi (Bug Reports): Avoid line breaks in traces. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index e48a48b5d1..9f216d339f 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3819,7 +3819,8 @@ the verbosity level to 6 (@pxref{Traces and Profiles, Traces}) in the contents of the @file{*tramp/foo*} and @file{*debug tramp/foo*} buffers with the bug report. Both buffers could contain non-@acronym{ASCII} characters which are relevant for analysis, append -the buffers as attachments to the bug report. +the buffers as attachments to the bug report. This is also needed in +order to avoid line breaks during mail transfer. @strong{Note} that a verbosity level greater than 6 is not necessary at this stage. Also note that a verbosity level of 6 or greater, the commit d5750af151853f13bf3481876d487741eebe36b7 Author: Eli Zaretskii Date: Thu Apr 9 11:21:18 2020 +0300 Avoid assertion violation in intervals.c * src/intervals.c (delete_interval): Allow negative values of LENGTH (i). This happens when delete_interval is called from set_intervals_multibyte_1, because the caller zeroes out the total_length field of the interval to be deleted. See https://lists.gnu.org/archive/html/emacs-devel/2020-04/msg00131.html for more details. See also a related old discussion at https://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00399.html. diff --git a/src/intervals.c b/src/intervals.c index a66594ceea..585ef18bd2 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -1187,7 +1187,7 @@ delete_interval (register INTERVAL i) register INTERVAL parent; ptrdiff_t amt = LENGTH (i); - eassert (amt == 0); /* Only used on zero-length intervals now. */ + eassert (amt <= 0); /* Only used on zero total-length intervals now. */ if (ROOT_INTERVAL_P (i)) { commit 18d1bc0a09db280cc1653706f7f8022786f77c94 Author: Eli Zaretskii Date: Wed Apr 8 18:33:52 2020 +0300 Improve documentation of 'jit-lock-contextually' * lisp/jit-lock.el (jit-lock-contextually): Clarify the jit-lock operation when 'jit-lock-contextually' is non-nil and non-t. * doc/lispref/modes.texi (Syntactic Font Lock) (Other Font Lock Variables): Document the relation between 'jit-lock-register', 'font-lock-keywords-only', and syntactic refontification. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index a8ddd45f89..e685391c95 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -3214,6 +3214,11 @@ The optional argument @var{contextual}, if non-@code{nil}, forces Font Lock mode to always refontify a syntactically relevant part of the buffer, and not just the modified lines. This argument can usually be omitted. + +When Font Lock is activated in a buffer, it calls this function with a +non-@code{nil} value of @var{contextual} if the value of +@code{font-lock-keywords-only} (@pxref{Syntactic Font Lock}) is +@code{nil}. @end defun @defun jit-lock-unregister function @@ -3380,7 +3385,11 @@ table in special cases. @xref{Syntax Properties}. If the value of this variable is non-@code{nil}, Font Lock does not do syntactic fontification, only search-based fontification based on @code{font-lock-keywords}. It is normally set by Font Lock mode based -on the @var{keywords-only} element in @code{font-lock-defaults}. +on the @var{keywords-only} element in @code{font-lock-defaults}. If +the value is @code{nil}, Font Lock will call @code{jit-lock-register} +(@pxref{Other Font Lock Variables}) to set up for automatic +refontification of buffer text following a modified line to reflect +the new syntactic context due to the change. @end defvar @defvar font-lock-syntax-table diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index d73cd74da0..95cc02197c 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -101,16 +101,22 @@ See also `jit-lock-stealth-nice'." (defvaralias 'jit-lock-defer-contextually 'jit-lock-contextually) (defcustom jit-lock-contextually 'syntax-driven - "If non-nil, means fontification should be syntactically true. -If nil, means fontification occurs only on those lines modified. This + "If non-nil, fontification should be syntactically true. +If nil, refontification occurs only on lines that were modified. This means where modification on a line causes syntactic change on subsequent lines, those subsequent lines are not refontified to reflect their new context. -If t, means fontification occurs on those lines modified and all -subsequent lines. This means those subsequent lines are refontified to reflect -their new syntactic context, after `jit-lock-context-time' seconds. -If any other value, e.g., `syntax-driven', means syntactically true -fontification occurs only if syntactic fontification is performed using the -buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil. +If t, fontification occurs on those lines modified and all subsequent lines. +This means those subsequent lines are refontified to reflect their new +syntactic context, after `jit-lock-context-time' seconds. +If any other value, e.g., `syntax-driven', it means refontification of +subsequent lines to reflect their new syntactic context may or may not +occur after `jit-lock-context-time', depending on the the font-lock +definitions of the buffer. Specifically, if `font-lock-keywords-only' +is nil in a buffer, which generally means the syntactic fontification +is done using the buffer mode's syntax table, the syntactic +refontification will be triggered (because in that case font-lock +calls `jit-lock-register' to set up for syntactic refontification, +and sets the buffer-local value of `jit-lock-contextually' to t). The value of this variable is used when JIT Lock mode is turned on." :type '(choice (const :tag "never" nil) commit 08486f4cae8e209cd70bd13534beff336faffd9e Author: Dmitry Gutov Date: Wed Apr 8 13:52:40 2020 +0300 Speed up 'resize-mode' child frames a little * src/gtkutil.c (xg_frame_set_char_size): Skip resizing if the target dimensions are unchanged for child frames with 'resize-mode' resize policy as well. diff --git a/src/gtkutil.c b/src/gtkutil.c index e374bdbe03..466cb42c7e 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -954,6 +954,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height) = pixelheight + FRAME_TOOLBAR_HEIGHT (f) + FRAME_MENUBAR_HEIGHT (f); int totalwidth = pixelwidth + FRAME_TOOLBAR_WIDTH (f); bool was_visible = false; + bool hide_child_frame; if (FRAME_PIXEL_HEIGHT (f) == 0) return; @@ -996,26 +997,33 @@ xg_frame_set_char_size (struct frame *f, int width, int height) gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), totalwidth, gheight); } - else if (FRAME_PARENT_FRAME (f) && FRAME_VISIBLE_P (f) - && EQ (x_gtk_resize_child_frames, Qhide)) + else if (FRAME_PARENT_FRAME (f) && FRAME_VISIBLE_P (f)) { was_visible = true; + hide_child_frame = EQ (x_gtk_resize_child_frames, Qhide); if (totalwidth != gwidth || totalheight != gheight) { frame_size_history_add (f, Qxg_frame_set_char_size_4, width, height, list2i (totalwidth, totalheight)); - block_input (); - gtk_widget_hide (FRAME_GTK_OUTER_WIDGET (f)); - unblock_input (); + + if (hide_child_frame) + { + block_input (); + gtk_widget_hide (FRAME_GTK_OUTER_WIDGET (f)); + unblock_input (); + } gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), totalwidth, totalheight); - block_input (); - gtk_widget_show_all (FRAME_GTK_OUTER_WIDGET (f)); - unblock_input (); + if (hide_child_frame) + { + block_input (); + gtk_widget_show_all (FRAME_GTK_OUTER_WIDGET (f)); + unblock_input (); + } fullscreen = Qnil; } commit f451ef9308838ee2745b89c5c5739a32b2741128 Author: Eli Zaretskii Date: Mon Apr 6 21:12:09 2020 +0300 ; * etc/NEWS: Mention 'executing-macro' in removed vars. diff --git a/etc/NEWS b/etc/NEWS index d3f27e328e..44a92ecbdd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2892,8 +2892,8 @@ fixnum for such arguments. 'desktop-buffer-misc-functions', 'desktop-buffer-modes-to-save', 'desktop-enable', 'desktop-load-default', 'dired-omit-files-p', 'disabled-command-hook', 'dungeon-mode-map', 'electric-nroff-mode', -'electric-nroff-newline', 'electric-perl-terminator', 'focus-frame', -'forward-text-line', 'generic-define-mswindows-modes', +'electric-nroff-newline', 'electric-perl-terminator', 'executing-macro', +'focus-frame', 'forward-text-line', 'generic-define-mswindows-modes', 'generic-define-unix-modes', 'generic-font-lock-defaults', 'goto-address-at-mouse', 'highlight-changes-colours', 'ibuffer-elide-long-columns', 'ibuffer-hooks', 'ibuffer-mode-hooks', commit c49d379f17bcb0ce82604def2eaa04bda00bd5ec Author: Martin Rudalics Date: Mon Apr 6 09:22:36 2020 +0200 Fix some problems with moving and resizing child frames (1) Provide new option 'x-gtk-resize-child-frames' which allows to either hide a child frame during resizing or asks GTK to resize it "immediately". This is needed because desktops like GNOME shell otherwise won't allow resizing child frames at all. (2) Do not try to synchronize the position of a child frame after moving it. Needed because the present implementation introduces a 0.5 secs delay which makes dragging child frames virtually impossible with Lucid and Motif toolkits on desktops like GNOME shell that use invisible outer frame borders. For further information see the thread starting with https://lists.gnu.org/archive/html/emacs-devel/2020-01/msg00343.html * src/frame.c (syms_of_frame): New symbol Qxg_frame_set_char_size_4. * src/gtkutil.c (xg_frame_set_char_size): Hide child frame during resizing when 'x-gtk-resize-child-frames' equals 'hide'. * src/xfns.c (x_set_parent_frame, Fx_create_frame): Set gtk_container_resize_mode to GTK_RESIZE_IMMEDIATE for child frames when'x-gtk-resize-child-frames' equals 'resize-mode'. (Fx_gtk_debug): New function to toggle interactive GTK debugging from within Emacs. (syms_of_xfns): New symbols Qhide and Qresize_mode. (x-gtk-resize-child-frames): New option that allows to resize child frames on desktops like GNOME shell (with the mutter WM) that otherwise refuse to resize them. * src/xterm.c (x_set_offset): Don't x_sync_with_move for child frames, it makes moving child frames virtually impossible with the Lucid and Motif toolkits. diff --git a/src/frame.c b/src/frame.c index ecf175f4f9..4dd8bb1804 100644 --- a/src/frame.c +++ b/src/frame.c @@ -5943,6 +5943,7 @@ syms_of_frame (void) DEFSYM (Qxg_frame_set_char_size_1, "xg-frame-set-char-size-1"); DEFSYM (Qxg_frame_set_char_size_2, "xg-frame-set-char-size-2"); DEFSYM (Qxg_frame_set_char_size_3, "xg-frame-set-char-size-3"); + DEFSYM (Qxg_frame_set_char_size_4, "xg-frame-set-char-size-4"); DEFSYM (Qx_set_window_size_1, "x-set-window-size-1"); DEFSYM (Qx_set_window_size_2, "x-set-window-size-2"); DEFSYM (Qx_set_window_size_3, "x-set-window-size-3"); diff --git a/src/gtkutil.c b/src/gtkutil.c index 5e7cf3d211..e374bdbe03 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -941,9 +941,8 @@ xg_frame_resized (struct frame *f, int pixelwidth, int pixelheight) } } -/* Resize the outer window of frame F after changing the height. - COLUMNS/ROWS is the size the edit area shall have after the resize. */ - +/** Resize the outer window of frame F. WIDTH and HEIGHT are the new + pixel sizes of F's text area. */ void xg_frame_set_char_size (struct frame *f, int width, int height) { @@ -954,6 +953,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height) int totalheight = pixelheight + FRAME_TOOLBAR_HEIGHT (f) + FRAME_MENUBAR_HEIGHT (f); int totalwidth = pixelwidth + FRAME_TOOLBAR_WIDTH (f); + bool was_visible = false; if (FRAME_PIXEL_HEIGHT (f) == 0) return; @@ -996,12 +996,35 @@ xg_frame_set_char_size (struct frame *f, int width, int height) gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), totalwidth, gheight); } + else if (FRAME_PARENT_FRAME (f) && FRAME_VISIBLE_P (f) + && EQ (x_gtk_resize_child_frames, Qhide)) + { + was_visible = true; + + if (totalwidth != gwidth || totalheight != gheight) + { + frame_size_history_add + (f, Qxg_frame_set_char_size_4, width, height, + list2i (totalwidth, totalheight)); + block_input (); + gtk_widget_hide (FRAME_GTK_OUTER_WIDGET (f)); + unblock_input (); + + gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + totalwidth, totalheight); + + block_input (); + gtk_widget_show_all (FRAME_GTK_OUTER_WIDGET (f)); + unblock_input (); + + fullscreen = Qnil; + } + } else { frame_size_history_add (f, Qxg_frame_set_char_size_3, width, height, list2i (totalwidth, totalheight)); - gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), totalwidth, totalheight); fullscreen = Qnil; @@ -1017,7 +1040,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height) size as fast as possible. For unmapped windows, we can set rows/cols. When the frame is mapped again we will (hopefully) get the correct size. */ - if (FRAME_VISIBLE_P (f)) + if (FRAME_VISIBLE_P (f) && !was_visible) { /* Must call this to flush out events */ (void)gtk_events_pending (); diff --git a/src/xfns.c b/src/xfns.c index afe1ceef81..0fc553012b 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -861,6 +861,12 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), p ? FRAME_X_WINDOW (p) : DefaultRootWindow (FRAME_X_DISPLAY (f)), f->left_pos, f->top_pos); +#ifdef USE_GTK + if (EQ (x_gtk_resize_child_frames, Qresize_mode)) + gtk_container_set_resize_mode + (GTK_CONTAINER (FRAME_GTK_OUTER_WIDGET (f)), + p ? GTK_RESIZE_IMMEDIATE : GTK_RESIZE_QUEUE); +#endif unblock_input (); fset_parent_frame (f, new_value); @@ -4084,6 +4090,11 @@ This function is an internal primitive--use `make-frame' instead. */) block_input (); XReparentWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), FRAME_X_WINDOW (p), f->left_pos, f->top_pos); +#ifdef USE_GTK + if (EQ (x_gtk_resize_child_frames, Qresize_mode)) + gtk_container_set_resize_mode + (GTK_CONTAINER (FRAME_GTK_OUTER_WIDGET (f)), GTK_RESIZE_IMMEDIATE); +#endif unblock_input (); } @@ -7742,6 +7753,22 @@ Note: Text drawn with the `x' font backend is shown with hollow boxes. */) #endif /* USE_GTK */ #endif /* USE_CAIRO */ +#ifdef USE_GTK +#ifdef HAVE_GTK3 +DEFUN ("x-gtk-debug", Fx_gtk_debug, Sx_gtk_debug, 1, 1, 0, + doc: /* Toggle interactive GTK debugging. */) + (Lisp_Object enable) +{ + gboolean enable_debug = !NILP (enable); + + block_input (); + gtk_window_set_interactive_debugging (enable_debug); + unblock_input (); + + return NILP (enable) ? Qnil : Qt; +} +#endif /* HAVE_GTK3 */ +#endif /* USE_GTK */ /*********************************************************************** Initialization @@ -7810,6 +7837,8 @@ syms_of_xfns (void) DEFSYM (Qfont_parameter, "font-parameter"); DEFSYM (Qmono, "mono"); DEFSYM (Qassq_delete_all, "assq-delete-all"); + DEFSYM (Qhide, "hide"); + DEFSYM (Qresize_mode, "resize-mode"); #ifdef USE_CAIRO DEFSYM (Qpdf, "pdf"); @@ -7986,6 +8015,28 @@ Otherwise use Emacs own tooltip implementation. When using Gtk+ tooltips, the tooltip face is not used. */); x_gtk_use_system_tooltips = true; + DEFVAR_LISP ("x-gtk-resize-child-frames", x_gtk_resize_child_frames, + doc: /* If non-nil, resize child frames specially with GTK builds. +If this is nil, resize child frames like any other frames. This is the +default and usually works with most desktops. Some desktop environments +(GNOME shell in particular when using the mutter window manager), +however, may refuse to resize a child frame when Emacs is built with +GTK3. For those environments, the two settings below are provided. + +If this equals the symbol 'hide', Emacs temporarily hides the child +frame during resizing. This approach seems to work reliably, may +however induce some flicker when the frame is made visible again. + +If this equals the symbol 'resize-mode', Emacs uses GTK's resize mode to +always trigger an immediate resize of the child frame. This method is +deprecated by GTK and may not work in future versions of that toolkit. +It also may freeze Emacs when used with other desktop environments. It +avoids, however, the unpleasent flicker induced by the hiding approach. + +This variable is considered a temporary workaround and will be hopefully +eliminated in future versions of Emacs. */); + x_gtk_resize_child_frames = Qnil; + /* Tell Emacs about this window system. */ Fprovide (Qx, Qnil); @@ -8101,4 +8152,9 @@ When using Gtk+ tooltips, the tooltip face is not used. */); defsubr (&Sx_print_frames_dialog); #endif #endif +#ifdef USE_GTK +#ifdef HAVE_GTK3 + defsubr (&Sx_gtk_debug); +#endif +#endif } diff --git a/src/xterm.c b/src/xterm.c index bda976fcbb..44396955ed 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10608,26 +10608,29 @@ x_set_offset (struct frame *f, register int xoff, register int yoff, int change_ modified_left, modified_top); #endif - x_sync_with_move (f, f->left_pos, f->top_pos, - FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN); - - /* change_gravity is non-zero when this function is called from Lisp to - programmatically move a frame. In that case, we call - x_check_expected_move to discover if we have a "Type A" or "Type B" - window manager, and, for a "Type A" window manager, adjust the position - of the frame. - - We call x_check_expected_move if a programmatic move occurred, and - either the window manager type (A/B) is unknown or it is Type A but we - need to compute the top/left offset adjustment for this frame. */ - - if (change_gravity != 0 - && !FRAME_PARENT_FRAME (f) - && (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN - || (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_A - && (FRAME_X_OUTPUT (f)->move_offset_left == 0 - && FRAME_X_OUTPUT (f)->move_offset_top == 0)))) - x_check_expected_move (f, modified_left, modified_top); + /* 'x_sync_with_move' is too costly for dragging child frames. */ + if (!FRAME_PARENT_FRAME (f)) + { + x_sync_with_move (f, f->left_pos, f->top_pos, + FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN); + + /* change_gravity is non-zero when this function is called from Lisp to + programmatically move a frame. In that case, we call + x_check_expected_move to discover if we have a "Type A" or "Type B" + window manager, and, for a "Type A" window manager, adjust the position + of the frame. + + We call x_check_expected_move if a programmatic move occurred, and + either the window manager type (A/B) is unknown or it is Type A but we + need to compute the top/left offset adjustment for this frame. */ + + if (change_gravity != 0 + && (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN + || (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_A + && (FRAME_X_OUTPUT (f)->move_offset_left == 0 + && FRAME_X_OUTPUT (f)->move_offset_top == 0)))) + x_check_expected_move (f, modified_left, modified_top); + } unblock_input (); }