[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp f9a1d4b 7/7: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp f9a1d4b 7/7: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Sun, 12 Apr 2020 12:13:39 -0400 (EDT) |
branch: feature/native-comp
commit f9a1d4b3f744cec00286fb211edaa0127e361061
Merge: b56de5d aed427e
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>
Merge remote-tracking branch 'savannah/master' into HEAD
---
doc/lispref/keymaps.texi | 20 +--
doc/lispref/modes.texi | 11 +-
doc/lispref/processes.texi | 6 +
doc/misc/emacs-gnutls.texi | 2 +-
doc/misc/tramp.texi | 3 +-
etc/NEWS | 25 +++
etc/NEWS.27 | 4 +-
lisp/cedet/pulse.el | 3 +
lisp/emacs-lisp/byte-run.el | 139 +++++++++-------
lisp/emacs-lisp/gv.el | 16 +-
lisp/eshell/esh-var.el | 30 ++--
lisp/hi-lock.el | 141 +++++++++++------
lisp/international/mule-conf.el | 6 +
lisp/isearch.el | 33 ++--
lisp/jit-lock.el | 22 ++-
lisp/language/chinese.el | 5 +
lisp/language/korean.el | 12 ++
lisp/net/dns.el | 30 ++--
lisp/net/gnutls.el | 8 +-
lisp/net/network-stream.el | 24 ++-
lisp/net/tramp.el | 2 +
lisp/progmodes/cl-font-lock.el | 289 ++++++++++++++++++++++++++++++++++
src/Makefile.in | 7 +-
src/casefiddle.c | 2 +-
src/character.h | 55 +++++--
src/coding.c | 63 +++++---
src/coding.h | 4 +-
src/composite.h | 9 +-
src/conf_post.h | 8 +-
src/dispextern.h | 29 ----
src/dispnew.c | 4 +
src/frame.c | 1 +
src/frame.h | 43 +++++
src/gtkutil.c | 41 ++++-
src/image.c | 5 +-
src/intervals.c | 2 +-
src/keyboard.c | 10 +-
src/lisp.h | 16 +-
src/lread.c | 8 +-
src/w32fns.c | 4 +-
src/w32proc.c | 2 +-
src/xdisp.c | 5 +-
src/xfns.c | 56 +++++++
src/xterm.c | 43 ++---
test/lisp/international/mule-tests.el | 21 +++
test/src/coding-tests.el | 37 ++++-
46 files changed, 983 insertions(+), 323 deletions(-)
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 4d51313..2c90d20 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -2227,22 +2227,14 @@ 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 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.
-
-@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.
+@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
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index f8cf457..fc68ee1 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -3215,6 +3215,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
@@ -3381,7 +3386,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/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 14cd079..735e9fd 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -2463,6 +2463,12 @@ that are mainly relevant to encrypted connections:
@item :nowait @var{boolean}
If non-@code{nil}, try to make an asynchronous connection.
+@item :coding @var{coding}
+Use this to set the coding systems used by the network process, in
+preference to binding @code{coding-system-for-read} or
+@code{coding-system-for-write}. @xref{Network Processes} for
+details.
+
@item :type @var{type}
The type of connection. Options are:
diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi
index 555a4b1..c3e6917 100644
--- a/doc/misc/emacs-gnutls.texi
+++ b/doc/misc/emacs-gnutls.texi
@@ -190,7 +190,7 @@ the connection process.
The optional @var{parameters} argument is a list of keywords and
values. The only keywords which currently have any effect are
-@code{:client-certificate} and @code{:nowait}.
+@code{:client-certificate}, @code{:nowait}, and @code{:coding}.
Passing @w{@code{:client certificate t}} triggers looking up of client
certificates matching @var{host} and @var{service} using the
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 75d2fd1..4e39728 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -3842,7 +3842,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
diff --git a/etc/NEWS b/etc/NEWS
index 1af368c..28c01d7 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
@@ -253,6 +257,18 @@ 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.
+
+---
+*** The default value of 'hi-lock-highlight-range' was enlarged.
+The new default value is 2000000 (2 million).
+
** Texinfo
---
@@ -339,6 +355,15 @@ Emacs depended on the previous behavior; if you really
want the
process' coding-system to be nil, use 'set-process-coding-system'
after the process has been created, or pass in ":coding '(nil nil)".
++++
+** 'open-network-stream' now accepts a :coding argument.
+This allows specifying the coding systems used by a network process
+for encoding and decoding without having to bind
+coding-system-for-{read,write} or call 'set-process-coding-system'.
+
++++
+** 'open-gnutls-stream' now also accepts a :coding argument.
+
* Changes in Emacs 28.1 on Non-Free Operating Systems
diff --git a/etc/NEWS.27 b/etc/NEWS.27
index d3f27e3..44a92ec 100644
--- a/etc/NEWS.27
+++ b/etc/NEWS.27
@@ -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',
diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el
index 16243e1..8649254 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))
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 6a49c60..fa769ad 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -82,65 +82,84 @@ The return value of this function is not used."
;; We define macro-declaration-alist here because it is needed to
;; handle declarations in macro definitions and this is the first file
-;; loaded by loadup.el that uses declarations in macros.
+;; loaded by loadup.el that uses declarations in macros. We specify
+;; the values as named aliases so that `describe-variable' prints
+;; something useful; cf. Bug#40491. We can only use backquotes inside
+;; the lambdas and not for those properties that are used by functions
+;; loaded before backquote.el.
+
+(defalias 'byte-run--set-advertised-calling-convention
+ #'(lambda (f _args arglist when)
+ (list 'set-advertised-calling-convention
+ (list 'quote f) (list 'quote arglist) (list 'quote when))))
+
+(defalias 'byte-run--set-obsolete
+ #'(lambda (f _args new-name when)
+ (list 'make-obsolete
+ (list 'quote f) (list 'quote new-name) (list 'quote when))))
+
+(defalias 'byte-run--set-interactive-only
+ #'(lambda (f _args instead)
+ (list 'function-put (list 'quote f)
+ ''interactive-only (list 'quote instead))))
+
+(defalias 'byte-run--set-pure
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''pure (list 'quote val))))
+
+(defalias 'byte-run--set-side-effect-free
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''side-effect-free (list 'quote val))))
+
+(defalias 'byte-run--set-compiler-macro
+ #'(lambda (f args compiler-function)
+ (if (not (eq (car-safe compiler-function) 'lambda))
+ `(eval-and-compile
+ (function-put ',f 'compiler-macro #',compiler-function))
+ (let ((cfname (intern (concat (symbol-name f) "--anon-cmacro")))
+ ;; Avoid cadr/cddr so we can use `compiler-macro' before
+ ;; defining cadr/cddr.
+ (data (cdr compiler-function)))
+ `(progn
+ (eval-and-compile
+ (function-put ',f 'compiler-macro #',cfname))
+ ;; Don't autoload the compiler-macro itself, since the
+ ;; macroexpander will find this file via `f's autoload,
+ ;; if needed.
+ :autoload-end
+ (eval-and-compile
+ (defun ,cfname (,@(car data) ,@args)
+ ,@(cdr data))))))))
+
+(defalias 'byte-run--set-doc-string
+ #'(lambda (f _args pos)
+ (list 'function-put (list 'quote f)
+ ''doc-string-elt (list 'quote pos))))
+
+(defalias 'byte-run--set-indent
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''lisp-indent-function (list 'quote val))))
;; Add any new entries to info node `(elisp)Declare Form'.
(defvar defun-declarations-alist
(list
- ;; We can only use backquotes inside the lambdas and not for those
- ;; properties that are used by functions loaded before backquote.el.
(list 'advertised-calling-convention
- #'(lambda (f _args arglist when)
- (list 'set-advertised-calling-convention
- (list 'quote f) (list 'quote arglist) (list 'quote when))))
- (list 'obsolete
- #'(lambda (f _args new-name when)
- (list 'make-obsolete
- (list 'quote f) (list 'quote new-name) (list 'quote when))))
- (list 'interactive-only
- #'(lambda (f _args instead)
- (list 'function-put (list 'quote f)
- ''interactive-only (list 'quote instead))))
+ #'byte-run--set-advertised-calling-convention)
+ (list 'obsolete #'byte-run--set-obsolete)
+ (list 'interactive-only #'byte-run--set-interactive-only)
;; FIXME: Merge `pure' and `side-effect-free'.
- (list 'pure
- #'(lambda (f _args val)
- (list 'function-put (list 'quote f)
- ''pure (list 'quote val)))
+ (list 'pure #'byte-run--set-pure
"If non-nil, the compiler can replace calls with their return value.
This may shift errors from run-time to compile-time.")
- (list 'side-effect-free
- #'(lambda (f _args val)
- (list 'function-put (list 'quote f)
- ''side-effect-free (list 'quote val)))
+ (list 'side-effect-free #'byte-run--set-side-effect-free
"If non-nil, calls can be ignored if their value is unused.
If `error-free', drop calls even if `byte-compile-delete-errors' is nil.")
- (list 'compiler-macro
- #'(lambda (f args compiler-function)
- (if (not (eq (car-safe compiler-function) 'lambda))
- `(eval-and-compile
- (function-put ',f 'compiler-macro #',compiler-function))
- (let ((cfname (intern (concat (symbol-name f) "--anon-cmacro")))
- ;; Avoid cadr/cddr so we can use `compiler-macro' before
- ;; defining cadr/cddr.
- (data (cdr compiler-function)))
- `(progn
- (eval-and-compile
- (function-put ',f 'compiler-macro #',cfname))
- ;; Don't autoload the compiler-macro itself, since the
- ;; macroexpander will find this file via `f's autoload,
- ;; if needed.
- :autoload-end
- (eval-and-compile
- (defun ,cfname (,@(car data) ,@args)
- ,@(cdr data))))))))
- (list 'doc-string
- #'(lambda (f _args pos)
- (list 'function-put (list 'quote f)
- ''doc-string-elt (list 'quote pos))))
- (list 'indent
- #'(lambda (f _args val)
- (list 'function-put (list 'quote f)
- ''lisp-indent-function (list 'quote val)))))
+ (list 'compiler-macro #'byte-run--set-compiler-macro)
+ (list 'doc-string #'byte-run--set-doc-string)
+ (list 'indent #'byte-run--set-indent))
"List associating function properties to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is
a function. For each (PROP . VALUES) in a function's declaration,
@@ -150,18 +169,22 @@ to set this property.
This is used by `declare'.")
+(defalias 'byte-run--set-debug
+ #'(lambda (name _args spec)
+ (list 'progn :autoload-end
+ (list 'put (list 'quote name)
+ ''edebug-form-spec (list 'quote spec)))))
+
+(defalias 'byte-run--set-no-font-lock-keyword
+ #'(lambda (name _args val)
+ (list 'function-put (list 'quote name)
+ ''no-font-lock-keyword (list 'quote val))))
+
(defvar macro-declarations-alist
(cons
- (list 'debug
- #'(lambda (name _args spec)
- (list 'progn :autoload-end
- (list 'put (list 'quote name)
- ''edebug-form-spec (list 'quote spec)))))
+ (list 'debug #'byte-run--set-debug)
(cons
- (list 'no-font-lock-keyword
- #'(lambda (name _args val)
- (list 'function-put (list 'quote name)
- ''no-font-lock-keyword (list 'quote val))))
+ (list 'no-font-lock-keyword #'byte-run--set-no-font-lock-keyword)
defun-declarations-alist))
"List associating properties of macros to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is a function.
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index b43e53b..3ab4929 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -166,15 +166,25 @@ arguments as NAME. DO is a function as defined in
`gv-get'."
;; (`(expand ,expander) `(gv-define-expand ,name ,expander))
(_ (message "Unknown %s declaration %S" symbol handler) nil))))
+;; Additions for `declare'. We specify the values as named aliases so
+;; that `describe-variable' prints something useful; cf. Bug#40491.
+
+;;;###autoload
+(defsubst gv--expander-defun-declaration (&rest args)
+ (apply #'gv--defun-declaration 'gv-expander args))
+
+;;;###autoload
+(defsubst gv--setter-defun-declaration (&rest args)
+ (apply #'gv--defun-declaration 'gv-setter args))
+
;;;###autoload
(or (assq 'gv-expander defun-declarations-alist)
- (let ((x `(gv-expander
- ,(apply-partially #'gv--defun-declaration 'gv-expander))))
+ (let ((x (list 'gv-expander #'gv--expander-defun-declaration)))
(push x macro-declarations-alist)
(push x defun-declarations-alist)))
;;;###autoload
(or (assq 'gv-setter defun-declarations-alist)
- (push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter))
+ (push (list 'gv-setter #'gv--setter-defun-declaration)
defun-declarations-alist))
;; (defmacro gv-define-expand (name expander)
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 3093abd..96838d4 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 an error.
Additionally, each member may specify if it should be copied to the
environment of created subprocesses."
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index de25893..d5e4665 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
@@ -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/international/mule-conf.el b/lisp/international/mule-conf.el
index e6e6135..edda79b 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1517,6 +1517,10 @@ for decoding and encoding files, process I/O, etc."
:charset-list '(unicode)
:pre-write-conversion 'utf-7-pre-write-conversion
:post-read-conversion 'utf-7-post-read-conversion)
+;; FIXME: 'define-coding-system' automatically sets :ascii-compatible-p,
+;; to any encoding whose :coding-type is 'utf-8', but UTF-7 is not ASCII
+;; compatible, so we override that here (bug#40407).
+(coding-system-put 'utf-7 :ascii-compatible-p nil)
(define-coding-system 'utf-7-imap
"UTF-7 encoding of Unicode, IMAP version (RFC 2060)"
@@ -1525,6 +1529,8 @@ for decoding and encoding files, process I/O, etc."
:charset-list '(unicode)
:pre-write-conversion 'utf-7-imap-pre-write-conversion
:post-read-conversion 'utf-7-imap-post-read-conversion)
+;; See comment for utf-7 above.
+(coding-system-put 'utf-7-imap :ascii-compatible-p nil)
;; Use us-ascii for terminal output if some other coding system is not
;; specified explicitly.
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 7625ec1..e13a4dd 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 ()
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 9cdb108..c0c9cac 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -96,16 +96,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)
diff --git a/lisp/language/chinese.el b/lisp/language/chinese.el
index bc6969c..4389db9 100644
--- a/lisp/language/chinese.el
+++ b/lisp/language/chinese.el
@@ -103,6 +103,11 @@
(define-coding-system-alias 'hz-gb-2312 'chinese-hz)
(define-coding-system-alias 'hz 'chinese-hz)
+;; FIXME: 'define-coding-system' automatically sets :ascii-compatible-p,
+;; to any encoding whose :coding-type is 'utf-8', but UTF-7 is not ASCII
+;; compatible, so we override that here (bug#40407).
+(coding-system-put 'chinese-hz :ascii-compatible-p nil)
+
(set-language-info-alist
"Chinese-GB" '((charset chinese-gb2312 chinese-sisheng)
(iso639-language . zh)
diff --git a/lisp/language/korean.el b/lisp/language/korean.el
index 210d0fa..7e75815 100644
--- a/lisp/language/korean.el
+++ b/lisp/language/korean.el
@@ -84,6 +84,18 @@ and the following key bindings are available within Korean
input methods:
F9, Hangul_Hanja: hangul-to-hanja-conversion")
))
+;; For auto-composing conjoining jamo.
+(let* ((choseong "[\u1100-\u115F\uA960-\uA97C]")
+ (jungseong "[\u1160-\u11A7\uD7B0-\uD7C6]")
+ (jongseong "[\u11A8-\u11FF\uD7CB-\uD7FB]?")
+ (pattern (concat choseong jungseong jongseong)))
+ (set-char-table-range composition-function-table
+ '(#x1100 . #x115F)
+ (list (vector pattern 0 'font-shape-gstring)))
+ (set-char-table-range composition-function-table
+ '(#xA960 . #xA97C)
+ (list (vector pattern 0 'font-shape-gstring))))
+
(provide 'korean)
;;; korean.el ends here
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index 177df4e..53ea0b1 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -138,7 +138,7 @@ updated. Set this variable to t to disable the check.")
(defun dns-write (spec &optional tcp-p)
"Write a DNS packet according to SPEC.
-If TCP-P, the first two bytes of the package with be the length field."
+If TCP-P, the first two bytes of the packet will be the length field."
(with-temp-buffer
(set-buffer-multibyte nil)
(dns-write-bytes (dns-get 'id spec) 2)
@@ -189,13 +189,15 @@ If TCP-P, the first two bytes of the package with be the
length field."
(dns-write-bytes (buffer-size) 2))
(buffer-string)))
-(defun dns-read (packet)
+(defun dns-read (packet &optional tcp-p)
(with-temp-buffer
(set-buffer-multibyte nil)
(let ((spec nil)
queries answers authorities additionals)
(insert packet)
- (goto-char (point-min))
+ ;; When using TCP we have a 2 byte length field to ignore.
+ (goto-char (+ (point-min)
+ (if tcp-p 2 0)))
(push (list 'id (dns-read-bytes 2)) spec)
(let ((byte (dns-read-bytes 1)))
(push (list 'response-p (if (zerop (logand byte (ash 1 7))) nil t))
@@ -407,23 +409,25 @@ If REVERSEP, look up an IP address."
nil)
(with-temp-buffer
(set-buffer-multibyte nil)
- (let ((process (condition-case ()
- (dns-make-network-process (car dns-servers))
- (error
- (message
- "dns: Got an error while trying to talk to %s"
- (car dns-servers))
- nil)))
+ (let* ((process (condition-case ()
+ (dns-make-network-process (car dns-servers))
+ (error
+ (message
+ "dns: Got an error while trying to talk to %s"
+ (car dns-servers))
+ nil)))
(step 100)
(times (* dns-timeout 1000))
- (id (random 65000)))
+ (id (random 65000))
+ (tcp-p (and process (not (process-contact process :type)))))
(when process
(process-send-string
process
(dns-write `((id ,id)
(opcode query)
(queries ((,name (type ,type))))
- (recursion-desired-p t))))
+ (recursion-desired-p t))
+ tcp-p))
(while (and (zerop (buffer-size))
(> times 0))
(let ((step-sec (/ step 1000.0)))
@@ -436,7 +440,7 @@ If REVERSEP, look up an IP address."
(when (and (>= (buffer-size) 2)
;; We had a time-out.
(> times 0))
- (let ((result (dns-read (buffer-string))))
+ (let ((result (dns-read (buffer-string) tcp-p)))
(if fullp
result
(let ((answer (car (dns-get 'answers result))))
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 459156e..cd86b4d 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -169,8 +169,9 @@ Third arg HOST is the name of the host to connect to, or
its IP address.
Fourth arg SERVICE is the name of the service desired, or an integer
specifying a port number to connect to.
Fifth arg PARAMETERS is an optional list of keyword/value pairs.
-Only :client-certificate and :nowait keywords are recognized, and
-have the same meaning as for `open-network-stream'.
+Only :client-certificate, :nowait, and :coding keywords are
+recognized, and have the same meaning as for
+`open-network-stream'.
For historical reasons PARAMETERS can also be a symbol, which is
interpreted the same as passing a list containing :nowait and the
value of that symbol.
@@ -208,7 +209,8 @@ trust and key files, and priority string."
(gnutls-boot-parameters
:type 'gnutls-x509pki
:keylist keylist
- :hostname (puny-encode-domain host)))))))
+ :hostname (puny-encode-domain host))))
+ :coding (plist-get parameters :coding))))
(if nowait
process
(gnutls-negotiate :process process
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index e99d7a3..1d5cf38 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -113,6 +113,10 @@ values:
`ssl' -- Equivalent to `tls'.
`shell' -- A shell connection.
+:coding is a symbol or a cons used to specify the coding systems
+used to decode and encode the data which the process reads and
+writes. See `make-network-process' for details.
+
:return-list specifies this function's return value.
If omitted or nil, return a process object. A non-nil means to
return (PROC . PROPS), where PROC is a process object and PROPS
@@ -189,7 +193,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
:host (puny-encode-domain host) :service service
:nowait (plist-get parameters :nowait)
:tls-parameters
- (plist-get parameters :tls-parameters))
+ (plist-get parameters :tls-parameters)
+ :coding (plist-get parameters :coding))
(let ((work-buffer (or buffer
(generate-new-buffer " *stream buffer*")))
(fun (cond ((and (eq type 'plain)
@@ -249,7 +254,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(stream (make-network-process :name name :buffer buffer
:host (puny-encode-domain host)
:service service
- :nowait (plist-get parameters :nowait))))
+ :nowait (plist-get parameters :nowait)
+ :coding (plist-get parameters :coding))))
(when (plist-get parameters :warn-unless-encrypted)
(setq stream (nsm-verify-connection stream host service nil t)))
(list stream
@@ -270,7 +276,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE)
(stream (make-network-process :name name :buffer buffer
:host (puny-encode-domain host)
- :service service))
+ :service service
+ :coding (plist-get parameters :coding)))
(greeting (and (not (plist-get parameters :nogreeting))
(network-stream-get-response stream start eoc)))
(capabilities (network-stream-command stream capability-command
@@ -350,7 +357,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(setq stream
(make-network-process :name name :buffer buffer
:host (puny-encode-domain host)
- :service service))
+ :service service
+ :coding (plist-get parameters
:coding)))
(network-stream-get-response stream start eoc)))
(unless (process-live-p stream)
(error "Unable to negotiate a TLS connection with %s/%s"
@@ -453,6 +461,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(let* ((capability-command (plist-get parameters :capability-command))
(eoc (plist-get parameters :end-of-command))
(start (with-current-buffer buffer (point)))
+ (coding (plist-get parameters :coding))
(stream (let ((process-connection-type nil))
(start-process name buffer shell-file-name
shell-command-switch
@@ -461,6 +470,13 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(format-spec-make
?s host
?p service))))))
+ (when coding (if (consp coding)
+ (set-process-coding-system stream
+ (car coding)
+ (cdr coding))
+ (set-process-coding-system stream
+ coding
+ coding)))
(list stream
(network-stream-get-response stream start eoc)
(network-stream-command stream capability-command
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index e30f27f..a16085d 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4074,6 +4074,8 @@ The terminal type can be configured with
`tramp-terminal-type'."
(defun tramp-action-process-alive (proc _vec)
"Check, whether a process has finished."
(unless (process-live-p proc)
+ ;; There might be pending output.
+ (while (tramp-accept-process-output proc 0))
(throw 'tramp-action 'process-died)))
(defun tramp-action-out-of-band (proc vec)
diff --git a/lisp/progmodes/cl-font-lock.el b/lisp/progmodes/cl-font-lock.el
new file mode 100644
index 0000000..7ef43fd
--- /dev/null
+++ b/lisp/progmodes/cl-font-lock.el
@@ -0,0 +1,289 @@
+;;; cl-font-lock.el --- Pretty Common Lisp font locking -*- lexical-binding:
t; -*-
+;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+;; Author: Yue Daian <address@hidden>
+;; Maintainer: Spenser Truex <address@hidden>
+;; Created: 2019-06-16
+;; 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 part of GNU Emacs
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; 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:
+
+;; 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"
+ "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"))
+
+(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))))
+
+;;;###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)
+
+;;; cl-font-lock.el ends here
diff --git a/src/Makefile.in b/src/Makefile.in
index 7f86e96..63f909a 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -381,14 +381,11 @@ endif
# Flags that might be in WARN_CFLAGS but are not valid for Objective C.
NON_OBJC_CFLAGS = -Wignored-attributes -Wignored-qualifiers -Wopenmp-simd
-# Cajole GCC into inlining key ops even if it wouldn't normally.
-KEY_OPS_CFLAGS = $(if $(filter -Og,$(CFLAGS)),-DDEFINE_KEY_OPS_AS_MACROS)
-
# -Demacs makes some files produce the correct version for use in Emacs.
# MYCPPFLAGS is for by-hand Emacs-specific overrides, e.g.,
# "make MYCPPFLAGS='-DDBUS_DEBUG'".
-EMACS_CFLAGS = -Demacs $(KEY_OPS_CFLAGS) $(MYCPPFLAGS) \
- -I. -I$(srcdir) -I$(lib) -I$(top_srcdir)/lib \
+EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \
+ -I$(lib) -I$(top_srcdir)/lib \
$(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \
$(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \
$(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \
diff --git a/src/casefiddle.c b/src/casefiddle.c
index 1945aa1..5018b7b 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 3642a54..7639b01 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/coding.c b/src/coding.c
index 49c1e62..0daa390 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -9302,7 +9302,10 @@ is nil. */)
for (tail = coding_system_list; CONSP (tail); tail = XCDR (tail))
{
elt = XCAR (tail);
- attrs = AREF (CODING_SYSTEM_SPEC (elt), 0);
+ Lisp_Object spec = CODING_SYSTEM_SPEC (elt);
+ if (!VECTORP (spec))
+ xsignal1 (Qcoding_system_error, elt);
+ attrs = AREF (spec, 0);
ASET (attrs, coding_attr_trans_tbl,
get_translation_table (attrs, 1, NULL));
list = Fcons (list2 (elt, attrs), list);
@@ -9471,13 +9474,13 @@ not fully specified.) */)
return code_convert_region (start, end, coding_system, destination, 1, 0);
}
-/* Whether a string only contains chars in the 0..127 range. */
+/* Whether STRING only contains chars in the 0..127 range. */
static bool
-string_ascii_p (Lisp_Object str)
+string_ascii_p (Lisp_Object string)
{
- ptrdiff_t nbytes = SBYTES (str);
+ ptrdiff_t nbytes = SBYTES (string);
for (ptrdiff_t i = 0; i < nbytes; i++)
- if (SREF (str, i) > 127)
+ if (SREF (string, i) > 127)
return false;
return true;
}
@@ -9516,16 +9519,23 @@ code_convert_string (Lisp_Object string, Lisp_Object
coding_system,
if (EQ (dst_object, Qt))
{
/* Fast path for ASCII-only input and an ASCII-compatible coding:
- act as identity. */
+ act as identity if no EOL conversion is needed. */
Lisp_Object attrs = CODING_ID_ATTRS (coding.id);
if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs))
&& (STRING_MULTIBYTE (string)
- ? (chars == bytes) : string_ascii_p (string)))
- return (nocopy
- ? string
- : (encodep
- ? make_unibyte_string (SSDATA (string), bytes)
- : make_multibyte_string (SSDATA (string), bytes, bytes)));
+ ? (chars == bytes) : string_ascii_p (string))
+ && (EQ (CODING_ID_EOL_TYPE (coding.id), Qunix)
+ || inhibit_eol_conversion
+ || ! memchr (SDATA (string), encodep ? '\n' : '\r', bytes)))
+ {
+ if (! norecord)
+ Vlast_coding_system_used = coding_system;
+ return (nocopy
+ ? string
+ : (encodep
+ ? make_unibyte_string (SSDATA (string), bytes)
+ : make_multibyte_string (SSDATA (string), bytes, bytes)));
+ }
}
else if (BUFFERP (dst_object))
{
@@ -9549,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,
@@ -10322,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
@@ -10332,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
@@ -10359,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 91856c5..c2a7b2a 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
diff --git a/src/composite.h b/src/composite.h
index 62c4de4..239f1e5 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/conf_post.h b/src/conf_post.h
index eb8fb18..79fb4cf 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -432,15 +432,13 @@ extern int emacs_setenv_TZ (char const *);
#else
-/* Use 'static' instead of 'extern inline' because 'static' typically
- has better performance for Emacs. Do not use the 'inline' keyword,
- as modern compilers inline automatically. ATTRIBUTE_UNUSED
- pacifies gcc -Wunused-function. */
+/* Use 'static inline' instead of 'extern inline' because 'static inline'
+ has much better performance for Emacs when compiled with 'gcc -Og'. */
# ifndef INLINE
# define INLINE EXTERN_INLINE
# endif
-# define EXTERN_INLINE static ATTRIBUTE_UNUSED
+# define EXTERN_INLINE static inline
# define INLINE_HEADER_BEGIN
# define INLINE_HEADER_END
diff --git a/src/dispextern.h b/src/dispextern.h
index 555946f..ae994d7 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/dispnew.c b/src/dispnew.c
index d79ae83..5b6fa51 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;
diff --git a/src/frame.c b/src/frame.c
index 884de2f..c871e4f 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -5930,6 +5930,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/frame.h b/src/frame.h
index 641bb43..476bac6 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/gtkutil.c b/src/gtkutil.c
index 338c603..681f86f 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,8 @@ 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;
+ bool hide_child_frame;
if (FRAME_PIXEL_HEIGHT (f) == 0)
return;
@@ -996,12 +997,42 @@ 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))
+ {
+ 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));
+
+ 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);
+
+ if (hide_child_frame)
+ {
+ 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 +1048,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/image.c b/src/image.c
index 65d5925..c98ca29 100644
--- a/src/image.c
+++ b/src/image.c
@@ -4572,8 +4572,9 @@ xpm_scan (const char **s, const char *end, const char
**beg, ptrdiff_t *len)
while (*s < end)
{
/* Skip white-space. */
- while (*s < end && (c = *(*s)++, c_isspace (c)))
- ;
+ do
+ c = *(*s)++;
+ while (c_isspace (c) && *s < end);
/* gnus-pointer.xpm uses '-' in its identifier.
sb-dir-plus.xpm uses '+' in its identifier. */
diff --git a/src/intervals.c b/src/intervals.c
index 594d892..d4a734c 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))
{
diff --git a/src/keyboard.c b/src/keyboard.c
index 9ce168c..b4e62c3 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 5456b9c..77c8749 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1925,18 +1925,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
diff --git a/src/lread.c b/src/lread.c
index b2f4371..2b1ac93 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1030,7 +1030,13 @@ load_error_handler (Lisp_Object data)
static void
load_warn_unescaped_character_literals (Lisp_Object file)
{
- Lisp_Object warning = call0 (Qbyte_run_unescaped_character_literals_warning);
+ Lisp_Object function
+ = Fsymbol_function (Qbyte_run_unescaped_character_literals_warning);
+ /* If byte-run.el is being loaded,
+ `byte-run--unescaped-character-literals-warning' isn't yet
+ defined. Since it'll be byte-compiled later, ignore potential
+ unescaped character literals. */
+ Lisp_Object warning = NILP (function) ? Qnil : call0 (function);
if (!NILP (warning))
{
AUTO_STRING (format, "Loading `%s': %s");
diff --git a/src/w32fns.c b/src/w32fns.c
index 9bb4e27..8d714f0 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -8258,7 +8258,6 @@ a ShowWindow flag:
/* Encode filename, current directory and parameters. */
current_dir = GUI_ENCODE_FILE (current_dir);
document = GUI_ENCODE_FILE (document);
- doc_w = GUI_SDATA (document);
if (STRINGP (parameters))
{
parameters = GUI_ENCODE_SYSTEM (parameters);
@@ -8269,6 +8268,7 @@ a ShowWindow flag:
operation = GUI_ENCODE_SYSTEM (operation);
ops_w = GUI_SDATA (operation);
}
+ doc_w = GUI_SDATA (document);
result = (intptr_t) ShellExecuteW (NULL, ops_w, doc_w, params_w,
GUI_SDATA (current_dir),
(FIXNUMP (show_flag)
@@ -8353,7 +8353,7 @@ a ShowWindow flag:
handler = Ffind_file_name_handler (absdoc, Qfile_exists_p);
if (NILP (handler))
{
- Lisp_Object absdoc_encoded = ENCODE_FILE (absdoc);
+ Lisp_Object absdoc_encoded = Fcopy_sequence (ENCODE_FILE (absdoc));
if (faccessat (AT_FDCWD, SSDATA (absdoc_encoded), F_OK, AT_EACCESS) == 0)
{
diff --git a/src/w32proc.c b/src/w32proc.c
index de33726..16e32e4 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -3231,7 +3231,7 @@ such programs cannot be invoked by Emacs anyway. */)
char *progname, progname_a[MAX_PATH];
program = Fexpand_file_name (program, Qnil);
- encoded_progname = ENCODE_FILE (program);
+ encoded_progname = Fcopy_sequence (ENCODE_FILE (program));
progname = SSDATA (encoded_progname);
unixtodos_filename (progname);
filename_to_ansi (progname, progname_a);
diff --git a/src/xdisp.c b/src/xdisp.c
index cbdef7a..193cc37 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -3218,7 +3218,10 @@ init_iterator (struct it *it, struct window *w,
with a left box line. */
face = FACE_FROM_ID_OR_NULL (it->f, remapped_base_face_id);
if (face && face->box != FACE_NO_BOX)
- it->start_of_box_run_p = true;
+ {
+ it->face_box_p = true;
+ it->start_of_box_run_p = true;
+ }
}
/* If a buffer position was specified, set the iterator there,
diff --git a/src/xfns.c b/src/xfns.c
index ebe51b7..10e1b5e 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);
@@ -4078,6 +4084,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 ();
}
@@ -7734,6 +7745,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
@@ -7802,6 +7829,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");
@@ -7978,6 +8007,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);
@@ -8093,4 +8144,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 bd9688f..ae5dad9 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -10613,26 +10613,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 ();
}
diff --git a/test/lisp/international/mule-tests.el
b/test/lisp/international/mule-tests.el
index 91e3c22..5f8e653 100644
--- a/test/lisp/international/mule-tests.el
+++ b/test/lisp/international/mule-tests.el
@@ -48,6 +48,27 @@
(append (kbd "C-x RET c u t f - 8 RET C-u C-u c a b
RET") nil)))
(read-string "prompt:")))))
+(ert-deftest mule-utf-7 ()
+ ;; utf-7 and utf-7-imap are not ASCII-compatible.
+ (should-not (coding-system-get 'utf-7 :ascii-compatible-p))
+ (should-not (coding-system-get 'utf-7-imap :ascii-compatible-p))
+ ;; Invariant ASCII subset.
+ (let ((s (apply #'string (append (number-sequence #x20 #x25)
+ (number-sequence #x27 #x7e)))))
+ (should (equal (encode-coding-string s 'utf-7-imap) s))
+ (should (equal (decode-coding-string s 'utf-7-imap) s)))
+ ;; Escaped ampersand.
+ (should (equal (encode-coding-string "a&bcd" 'utf-7-imap) "a&-bcd"))
+ (should (equal (decode-coding-string "a&-bcd" 'utf-7-imap) "a&bcd"))
+ ;; Ability to encode Unicode.
+ (should (equal (check-coding-systems-region "あ" nil '(utf-7-imap)) nil))
+ (should (equal (encode-coding-string "あ" 'utf-7-imap) "&MEI-"))
+ (should (equal (decode-coding-string "&MEI-" 'utf-7-imap) "あ")))
+
+(ert-deftest mule-hz ()
+ ;; The chinese-hz encoding is not ASCII compatible.
+ (should-not (coding-system-get 'chinese-hz :ascii-compatible-p)))
+
;; Stop "Local Variables" above causing confusion when visiting this file.
diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el
index 93e6709..a741e23 100644
--- a/test/src/coding-tests.el
+++ b/test/src/coding-tests.el
@@ -388,12 +388,47 @@
(let* ((uni (apply #'string (number-sequence 0 127)))
(multi (string-to-multibyte uni)))
(dolist (s (list uni multi))
- (dolist (coding '(us-ascii iso-latin-1 utf-8))
+ ;; Encodings without EOL conversion.
+ (dolist (coding '(us-ascii-unix iso-latin-1-unix utf-8-unix))
(should-not (eq (decode-coding-string s coding nil) s))
(should-not (eq (encode-coding-string s coding nil) s))
(should (eq (decode-coding-string s coding t) s))
+ (should (eq (encode-coding-string s coding t) s))
+ (should (eq last-coding-system-used coding)))
+
+ ;; With EOL conversion inhibited.
+ (let ((inhibit-eol-conversion t))
+ (dolist (coding '(us-ascii iso-latin-1 utf-8))
+ (should-not (eq (decode-coding-string s coding nil) s))
+ (should-not (eq (encode-coding-string s coding nil) s))
+ (should (eq (decode-coding-string s coding t) s))
+ (should (eq (encode-coding-string s coding t) s))))))
+
+ ;; Check identity decoding with EOL conversion for ASCII except CR.
+ (let* ((uni (apply #'string (delq ?\r (number-sequence 0 127))))
+ (multi (string-to-multibyte uni)))
+ (dolist (s (list uni multi))
+ (dolist (coding '(us-ascii-dos iso-latin-1-dos utf-8-dos mac-roman-mac))
+ (should-not (eq (decode-coding-string s coding nil) s))
+ (should (eq (decode-coding-string s coding t) s)))))
+
+ ;; Check identity encoding with EOL conversion for ASCII except LF.
+ (let* ((uni (apply #'string (delq ?\n (number-sequence 0 127))))
+ (multi (string-to-multibyte uni)))
+ (dolist (s (list uni multi))
+ (dolist (coding '(us-ascii-dos iso-latin-1-dos utf-8-dos mac-roman-mac))
+ (should-not (eq (encode-coding-string s coding nil) s))
(should (eq (encode-coding-string s coding t) s))))))
+
+(ert-deftest coding-check-coding-systems-region ()
+ (should (equal (check-coding-systems-region "aå" nil '(utf-8))
+ nil))
+ (should (equal (check-coding-systems-region "aåbγc" nil
+ '(utf-8 iso-latin-1 us-ascii))
+ '((iso-latin-1 3) (us-ascii 1 3))))
+ (should-error (check-coding-systems-region "å" nil '(bad-coding-system))))
+
;; Local Variables:
;; byte-compile-warnings: (not obsolete)
;; End:
- feature/native-comp updated (4abb8c8 -> f9a1d4b), Andrea Corallo, 2020/04/12
- feature/native-comp d85b803 2/7: * src/comp.c (native-comp-unit-set-file): New function., Andrea Corallo, 2020/04/12
- feature/native-comp 62f9569 1/7: * src/comp.c (native-comp-unit-file): Better parameter name., Andrea Corallo, 2020/04/12
- feature/native-comp f4156b4 3/7: Implement position independent dump., Andrea Corallo, 2020/04/12
- feature/native-comp 3dd6cf8 5/7: Implement working make install for native build., Andrea Corallo, 2020/04/12
- feature/native-comp b56de5d 6/7: * src/pdumper.c (dump_do_dump_relocation): Optimize native dump load., Andrea Corallo, 2020/04/12
- feature/native-comp 7f5d1e9 4/7: Set invocation variables during dump load., Andrea Corallo, 2020/04/12
- feature/native-comp f9a1d4b 7/7: Merge remote-tracking branch 'savannah/master' into HEAD,
Andrea Corallo <=