[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 3cc0438 2/2: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 3cc0438 2/2: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Fri, 3 Apr 2020 08:51:29 -0400 (EDT) |
branch: feature/native-comp
commit 3cc0438629843e7dbd3bda8bbcf6578b2e7f6200
Merge: 63af801 f28166d
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>
Merge remote-tracking branch 'savannah/master' into HEAD
---
configure.ac | 16 ++---
doc/lispref/display.texi | 21 +++---
doc/lispref/windows.texi | 10 +++
doc/misc/tramp.texi | 8 +++
etc/NEWS | 17 ++++-
etc/compilation.txt | 14 ++++
lisp/calc/calc-macs.el | 5 +-
lisp/calc/calc.el | 1 +
lisp/cedet/ede.el | 4 +-
lisp/cus-face.el | 16 +++--
lisp/desktop.el | 2 +-
lisp/dired-aux.el | 62 +++++++++++++++++
lisp/dired.el | 74 ++++++++++----------
lisp/eshell/em-dirs.el | 5 ++
lisp/eshell/esh-var.el | 23 +++++--
lisp/fileloop.el | 28 ++++----
lisp/files.el | 30 +++++----
lisp/image/image-converter.el | 4 ++
lisp/ldefs-boot.el | 92 ++++++++++++++++---------
lisp/minibuffer.el | 126 ++++++++++++++++++-----------------
lisp/net/trampver.el | 2 +
lisp/progmodes/compile.el | 26 +++++++-
lisp/url/url-cookie.el | 2 +-
lisp/vc/vc-dir.el | 45 ++++++++++++-
lisp/vc/vc.el | 40 +++--------
lisp/window.el | 16 ++++-
src/alloc.c | 106 +++++++----------------------
src/buffer.c | 66 +++++++-----------
src/buffer.h | 12 ----
src/decompress.c | 6 +-
src/dispextern.h | 17 +++--
src/nsfont.m | 7 +-
src/nsterm.m | 56 ++++++++--------
src/pdumper.c | 4 +-
src/w32term.c | 59 ++++++++--------
src/xdisp.c | 123 +++++++++++++++-------------------
src/xfaces.c | 39 ++++++++---
src/xterm.c | 115 +++++++++++++++-----------------
test/lisp/calc/calc-tests.el | 11 +++
test/lisp/eshell/eshell-tests.el | 7 ++
test/lisp/net/tramp-tests.el | 6 +-
test/lisp/progmodes/compile-tests.el | 7 +-
42 files changed, 754 insertions(+), 576 deletions(-)
diff --git a/configure.ac b/configure.ac
index e8f4601..49b972a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1247,18 +1247,12 @@ emacs_cv_ln_s_fileonly='cp -p'
dnl On MinGW, ensure we will call the MSYS /bin/ln.exe, not some
dnl random program in the current directory.
if (echo >conf$$.file) 2>/dev/null; then
- if ln -s conf$$.file conf$$ 2>/dev/null; then
- if test "$opsys" = "mingw32"; then
- emacs_cv_ln_s_fileonly='/bin/ln -s'
- else
- emacs_cv_ln_s_fileonly='ln -s'
- fi
+ if test "$opsys" = "mingw32"; then
+ emacs_cv_ln_s_fileonly=/bin/ln
+ elif ln -s conf$$.file conf$$ 2>/dev/null; then
+ emacs_cv_ln_s_fileonly='ln -s'
elif ln conf$$.file conf$$ 2>/dev/null; then
- if test "$opsys" = "mingw32"; then
- emacs_cv_ln_s_fileonly=/bin/ln
- else
- emacs_cv_ln_s_fileonly=ln
- fi
+ emacs_cv_ln_s_fileonly=ln
fi
fi
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 2b25d60..132a3c8 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -1318,12 +1318,6 @@ the buffer specified by @var{buffer-or-name} current for
running
@var{body}.
@end defmac
-@defmac with-displayed-buffer-window buffer-or-name action quit-function &rest
body
-This macro is like @code{with-current-buffer-window} but unlike that
-displays the buffer specified by @var{buffer-or-name} @emph{before}
-running @var{body}.
-@end defmac
-
A window showing a temporary buffer can be fitted to the size of that
buffer using the following mode:
@@ -2450,12 +2444,15 @@ Draw a box with lines of width 1, in the foreground
color.
@item @var{color}
Draw a box with lines of width 1, in color @var{color}.
-@item @code{(:line-width @var{width} :color @var{color} :style @var{style})}
-This way you can explicitly specify all aspects of the box. The value
-@var{width} specifies the width of the lines to draw; it defaults to
-1. A negative width @minus{}@var{n} means to draw a line of width @var{n}
-whose top and bottom parts occupy the space of the underlying text,
-thus avoiding any increase in the character height.
+@item @code{(:line-width (@var{vwidth} . @var{hwidth}) :color @var{color}
:style @var{style})}
+This way you can explicitly specify all aspects of the box. The values
+@var{vwidth} and @var{hwidth} specifies respectively the width of the
+vertical and horizontal lines to draw; they default to (1 . 1).
+A negative horizontal or vertical width @minus{}@var{n} means to draw a line
+of width @var{n} that occupies the space of the underlying text, thus
+avoiding any increase in the character height or width. For simplification
+the width could be specified with only a single number @var{n} instead
+of a list, such case is equivalent to @code{((abs @var{n}) . @var{n})}.
The value @var{color} specifies the color to draw with. The default is
the foreground color of the face for simple boxes, and the background
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index d0791d4..af2f3ac 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -3048,6 +3048,16 @@ since there is no guarantee that an arbitrary caller of
@code{display-buffer} will be able to handle the case that no window
will display the buffer. @code{display-buffer-no-window} is the only
action function that cares about this entry.
+
+@vindex body-function@r{, a buffer display action alist entry}
+@item body-function
+The value must be a function taking one argument (a displayed window).
+This function can be used to fill the displayed window's body with
+some contents that might depend on dimensions of the displayed window.
+It is called @emph{after} the buffer is displayed, and @emph{before}
+the entries @code{window-height}, @code{window-width} and
+@code{preserve-size} are applied that could resize the window to fit
+it to the inserted contents.
@end table
By convention, the entries @code{window-height}, @code{window-width}
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 61cf373..75d2fd1 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -3776,6 +3776,14 @@ It is even possible to access file archives in file
archives, as
@end group
@end lisp
+@vindex tramp-archive-enabled
+In order to disable file archives, you could add the following form to
+your init file:
+
+@lisp
+(customize-set-variable 'tramp-archive-enabled nil)
+@end lisp
+
@node Bug Reports
@chapter Reporting Bugs and Problems
diff --git a/etc/NEWS b/etc/NEWS
index 4b477e5..7e578f8 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -108,13 +108,16 @@ Mark mode, then Dired commands operate only on files in
the active
region. The values 'file' and 'line' of this user option define the
details of marking the file at the end of the region.
-*** State changing VC operations are supported in 'dired-mode' on files
-(but still not on directories).
+*** State changing VC operations are supported in Dired on files and
+directories with the help of new command 'dired-vc-next-action'.
** Change Logs and VC
*** New command 'vc-dir-root' uses the root directory without asking.
+*** New commands 'vc-dir-mark-registered-files' (bound to '* r') and
+'vc-dir-mark-unregistered-files'.
+
** Gnus
---
@@ -161,6 +164,12 @@ functions accessible to the user through the existing
single function hook
Modes should use the new hook instead of this user option to register
their backends.
+** Eshell
+
+---
+*** Environment variable INSIDE_EMACS is now copied to subprocesses.
+Its value equals the result of evaluating '(format "%s,eshell" emacs-version)'.
+
** Tramp
+++
@@ -266,6 +275,10 @@ It was used to allow loading Lisp libraries compiled by
XEmacs, a
modified version of Emacs which is no longer actively maintained.
This is no longer supported, and setting this variable has no effect.
++++
+** The macro 'with-displayed-buffer-window' is now obsolete.
+Use macro 'with-current-buffer-window' with action alist entry 'body-function'.
+
* Lisp Changes in Emacs 28.1
diff --git a/etc/compilation.txt b/etc/compilation.txt
index ebce6a1..8f7e290 100644
--- a/etc/compilation.txt
+++ b/etc/compilation.txt
@@ -237,6 +237,20 @@ Register 6 contains wrong type
==1332== by 0x8008621: main (vtest.c:180)
+* javac Java compiler
+
+symbol: javac
+
+Should also work when compiling Java with Gradle. We use the position
+of "^" in the third line as column number because no explicit value is
+present.
+
+Test.java:5: error: ';' expected
+ foo foo
+ ^
+1 error
+
+
* IBM jikes
symbols: jikes-file jikes-line
diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el
index e73d108..257d369 100644
--- a/lisp/calc/calc-macs.el
+++ b/lisp/calc/calc-macs.el
@@ -161,8 +161,9 @@
hms date mod var))))
(defsubst Math-num-integerp (a)
- (or (not (consp a))
- (and (eq (car a) 'float)
+ (or (integerp a)
+ (and (consp a)
+ (eq (car a) 'float)
(>= (nth 2 a) 0))))
(defsubst Math-equal-int (a b)
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 4b2a938..4e4fb67 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -2927,6 +2927,7 @@ the United States."
+(defvar math-comp-selected)
(defvar calc-selection-cache-entry)
;;; Format the number A as a string. [X N; X Z] [Public]
(defun math-format-stack-value (entry)
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index c203687..8c33611 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -470,7 +470,7 @@ To be used in hook functions."
;; Emacs 21 has no buffer file name for directory edits.
;; so we need to add these hacks in.
(eq major-mode 'dired-mode)
- (eq major-mode 'vc-dired-mode))
+ (eq major-mode 'vc-dir-mode))
(ede-minor-mode 1)))
(define-minor-mode ede-minor-mode
@@ -481,7 +481,7 @@ controlled project, then this mode is activated
automatically
provided `global-ede-mode' is enabled."
:group 'ede
(cond ((or (eq major-mode 'dired-mode)
- (eq major-mode 'vc-dired-mode))
+ (eq major-mode 'vc-dir-mode))
(ede-dired-minor-mode (if ede-minor-mode 1 -1)))
(ede-minor-mode
(if (not ede-constructing)
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index ed4cf04..cc766aa 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -166,9 +166,11 @@
:help-echo "Control box around text."
(const :tag "Off" nil)
(list :tag "Box"
- :value (:line-width 2 :color "grey75" :style released-button)
- (const :format "" :value :line-width)
- (integer :tag "Width")
+ :value (:line-width (2 . 2) :color "grey75" :style
released-button)
+ (const :format "" :value :line-width)
+ (cons :tag "Width" :extra-offset 2
+ (integer :tag "Vertical")
+ (integer :tag "Horizontal"))
(const :format "" :value :color)
(choice :tag "Color" (const :tag "*" nil) color)
(const :format "" :value :style)
@@ -181,15 +183,19 @@
(and real-value
(let ((lwidth
(or (and (consp real-value)
- (plist-get real-value :line-width))
+ (if (listp (cdr real-value))
+ (plist-get real-value :line-width)
+ real-value))
(and (integerp real-value) real-value)
- 1))
+ '(1 . 1)))
(color
(or (and (consp real-value) (plist-get real-value :color))
(and (stringp real-value) real-value)
nil))
(style
(and (consp real-value) (plist-get real-value :style))))
+ (if (integerp lwidth)
+ (setq lwidth (cons (abs lwidth) lwidth)))
(list :line-width lwidth :color color :style style))))
;; filter to make customized-value suitable for storing
(lambda (cus-value)
diff --git a/lisp/desktop.el b/lisp/desktop.el
index de601a4..9d117c6 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -534,7 +534,7 @@ can guess how to load the mode's definition.")
'((defining-kbd-macro nil)
(isearch-mode nil)
(vc-mode nil)
- (vc-dired-mode nil)
+ (vc-dir-mode nil)
(erc-track-minor-mode nil)
(savehist-mode nil))
"Table mapping minor mode variables to minor mode functions.
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 6f50a3d..60a352d 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -3050,6 +3050,68 @@ instead."
(backward-delete-char 1))
(message "%s" (buffer-string)))))
+
+;;; Version control from dired
+
+(declare-function vc-dir-unmark-all-files "vc-dir")
+(declare-function vc-dir-mark-files "vc-dir")
+
+;;;###autoload
+(defun dired-vc-next-action (verbose)
+ "Do the next version control operation on marked files/directories.
+When only files are marked then call `vc-next-action' with the
+same value of the VERBOSE argument.
+When also directories are marked then call `vc-dir' and mark
+the same files/directories in the VC-Dir buffer that were marked
+in the Dired buffer."
+ (interactive "P")
+ (let* ((marked-files
+ (dired-get-marked-files nil nil nil nil t))
+ (mark-files
+ (when (cl-some #'file-directory-p marked-files)
+ ;; Fix deficiency of Dired by adding slash to dirs
+ (mapcar (lambda (file)
+ (if (file-directory-p file)
+ (file-name-as-directory file)
+ file))
+ marked-files))))
+ (if mark-files
+ (let ((transient-hook (make-symbol "vc-dir-mark-files")))
+ (fset transient-hook
+ (lambda ()
+ (remove-hook 'vc-dir-refresh-hook transient-hook t)
+ (vc-dir-unmark-all-files t)
+ (vc-dir-mark-files mark-files)))
+ (vc-dir-root)
+ (add-hook 'vc-dir-refresh-hook transient-hook nil t))
+ (vc-next-action verbose))))
+
+(declare-function vc-compatible-state "vc")
+
+(defun dired-vc-deduce-fileset (&optional state-model-only-files
not-state-changing)
+ (let ((backend (vc-responsible-backend default-directory))
+ (files (dired-get-marked-files nil nil nil nil t))
+ only-files-list
+ state
+ model)
+ (when (and (not not-state-changing) (cl-some #'file-directory-p files))
+ (user-error "State changing VC operations on directories supported only
in `vc-dir'"))
+
+ (when state-model-only-files
+ (setq only-files-list (mapcar (lambda (file) (cons file (vc-state
file))) files))
+ (setq state (cdar only-files-list))
+ ;; Check that all files are in a consistent state, since we use that
+ ;; state to decide which operation to perform.
+ (dolist (crt (cdr only-files-list))
+ (unless (vc-compatible-state (cdr crt) state)
+ (error "When applying VC operations to multiple files, the files are
required\nto be in similar VC states.\n%s in state %s clashes with %s in state
%s"
+ (car crt) (cdr crt) (caar only-files-list) state)))
+ (setq only-files-list (mapcar 'car only-files-list))
+ (when (and state (not (eq state 'unregistered)))
+ (setq model (vc-checkout-model backend only-files-list))))
+ (list backend files only-files-list state model)))
+
+
(provide 'dired-aux)
;; Local Variables:
diff --git a/lisp/dired.el b/lisp/dired.el
index 41bbf9f..62e232b 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1208,15 +1208,11 @@ wildcards, erases the buffer, and builds the
subdir-alist anew
;; default-directory and dired-actual-switches must be buffer-local
;; and initialized by now.
- (let (dirname
- ;; This makes read-in much faster.
- ;; In particular, it prevents the font lock hook from running
- ;; until the directory is all read in.
- (inhibit-modification-hooks t))
- (if (consp dired-directory)
- (setq dirname (car dired-directory))
- (setq dirname dired-directory))
- (setq dirname (expand-file-name dirname))
+ (let ((dirname
+ (expand-file-name
+ (if (consp dired-directory)
+ (car dired-directory)
+ dired-directory))))
(save-excursion
;; This hook which may want to modify dired-actual-switches
;; based on dired-directory, e.g. with ange-ftp to a SysV host
@@ -1226,17 +1222,25 @@ wildcards, erases the buffer, and builds the
subdir-alist anew
(setq buffer-undo-list nil))
(setq-local file-name-coding-system
(or coding-system-for-read file-name-coding-system))
- (let ((inhibit-read-only t)
- ;; Don't make undo entries for readin.
- (buffer-undo-list t))
- (widen)
- (erase-buffer)
- (dired-readin-insert))
- (goto-char (point-min))
- ;; Must first make alist buffer local and set it to nil because
- ;; dired-build-subdir-alist will call dired-clear-alist first
- (setq-local dired-subdir-alist nil)
- (dired-build-subdir-alist)
+ (widen)
+ ;; We used to bind `inhibit-modification-hooks' to try and speed up
+ ;; execution, in particular, to prevent the font-lock hook from running
+ ;; until the directory is all read in.
+ ;; It's not clear why font-lock would be a significant issue
+ ;; here, but I used `combine-change-calls' which should provide the
+ ;; same performance advantages without the problem of breaking
+ ;; users of after/before-change-functions.
+ (combine-change-calls (point-min) (point-max)
+ (let ((inhibit-read-only t)
+ ;; Don't make undo entries for readin.
+ (buffer-undo-list t))
+ (erase-buffer)
+ (dired-readin-insert))
+ (goto-char (point-min))
+ ;; Must first make alist buffer local and set it to nil because
+ ;; dired-build-subdir-alist will call dired-clear-alist first
+ (setq-local dired-subdir-alist nil)
+ (dired-build-subdir-alist))
(let ((attributes (file-attributes dirname)))
(if (eq (car attributes) t)
(set-visited-file-modtime (file-attribute-modification-time
@@ -1870,6 +1874,7 @@ Do so according to the former subdir alist
OLD-SUBDIR-ALIST."
(define-key map "\177" 'dired-unmark-backward)
(define-key map [remap undo] 'dired-undo)
(define-key map [remap advertised-undo] 'dired-undo)
+ (define-key map [remap vc-next-action] 'dired-vc-next-action)
;; thumbnail manipulation (image-dired)
(define-key map "\C-td" 'image-dired-display-thumbs)
(define-key map "\C-tt" 'image-dired-tag-files)
@@ -3520,26 +3525,27 @@ argument or confirmation)."
;; Mark *Marked Files* window as softly-dedicated, to prevent
;; other buffers e.g. *Completions* from reusing it (bug#17554).
(display-buffer-mark-dedicated 'soft))
- (with-displayed-buffer-window
+ (with-current-buffer-window
buffer
- (cons 'display-buffer-below-selected
- '((window-height . fit-window-to-buffer)
- (preserve-size . (nil . t))))
+ `(display-buffer-below-selected
+ (window-height . fit-window-to-buffer)
+ (preserve-size . (nil . t))
+ (body-function
+ . ,#'(lambda (_window)
+ ;; Handle (t FILE) just like (FILE), here. That value is
+ ;; used (only in some cases), to mean just one file that was
+ ;; marked, rather than the current line file.
+ (dired-format-columns-of-files
+ (if (eq (car files) t) (cdr files) files))
+ (remove-text-properties (point-min) (point-max)
+ '(mouse-face nil help-echo nil))
+ (setq tab-line-exclude nil))))
#'(lambda (window _value)
(with-selected-window window
(unwind-protect
(apply function args)
(when (window-live-p window)
- (quit-restore-window window 'kill)))))
- ;; Handle (t FILE) just like (FILE), here. That value is
- ;; used (only in some cases), to mean just one file that was
- ;; marked, rather than the current line file.
- (with-current-buffer buffer
- (dired-format-columns-of-files
- (if (eq (car files) t) (cdr files) files))
- (remove-text-properties (point-min) (point-max)
- '(mouse-face nil help-echo nil))
- (setq tab-line-exclude nil))))))
+ (quit-restore-window window 'kill)))))))))
(defun dired-format-columns-of-files (files)
(let ((beg (point)))
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index 1949e5d..51df6fa 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -168,6 +168,9 @@ Thus, this does not include the current directory.")
(defvar eshell-last-dir-ring nil
"The last directory that Eshell was in.")
+(defconst eshell-inside-emacs (format "%s,eshell" emacs-version)
+ "Value for the `INSIDE_EMACS' environment variable.")
+
;;; Functions:
(defun eshell-dirs-initialize () ;Called from `eshell-mode' via intern-soft!
@@ -191,6 +194,8 @@ Thus, this does not include the current directory.")
(unless (ring-empty-p eshell-last-dir-ring)
(expand-file-name
(ring-ref eshell-last-dir-ring 0))))
+ t)
+ ("INSIDE_EMACS" eshell-inside-emacs
t))))
(when eshell-cd-on-directory
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 327a1de..3093abd 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -179,10 +179,9 @@ if they are quoted with a backslash."
(eshell-apply-indices eshell-command-arguments
indices)))))
"This list provides aliasing for variable references.
-It is very similar in concept to what `eshell-user-aliases-list' does
-for commands. Each member of this defines the name of a command,
-and the Lisp value to return for that variable if it is accessed
-via the syntax `$NAME'.
+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
@@ -190,7 +189,21 @@ 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."
+'(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
+`eshell-prefer-lisp-variables' to t.
+
+If the value is a symbol, the value bound to that symbol will be used.
+
+If the value has any other type, `error' will be signaled.
+
+Additionally, each member may specify if it should be copied to the
+environment of created subprocesses."
:type '(repeat (list string sexp
(choice (const :tag "Copy to environment" t)
(const :tag "Use only in Eshell" nil)))))
diff --git a/lisp/fileloop.el b/lisp/fileloop.el
index 543963f..8f49116 100644
--- a/lisp/fileloop.el
+++ b/lisp/fileloop.el
@@ -200,18 +200,22 @@ the default setting of `case-fold-search'.
DELIMITED if non-nil means replace only word-delimited matches."
;; FIXME: Not sure how the delimited-flag interacts with the regexp-flag in
;; `perform-replace', so I just try to mimic the old code.
- (fileloop-initialize
- files
- (lambda ()
- (let ((case-fold-search
- (if (memql case-fold '(nil t)) case-fold case-fold-search)))
- (if (re-search-forward from nil t)
- ;; When we find a match, move back
- ;; to the beginning of it so perform-replace
- ;; will see it.
- (goto-char (match-beginning 0)))))
- (lambda ()
- (perform-replace from to t t delimited nil multi-query-replace-map))))
+ (let ((mstart (make-hash-table :test 'eq)))
+ (fileloop-initialize
+ files
+ (lambda ()
+ (let ((case-fold-search
+ (if (memql case-fold '(nil t)) case-fold case-fold-search)))
+ (when (re-search-forward from nil t)
+ ;; When we find a match, save its beginning for
+ ;; `perform-replace' (we used to just set point, but this
+ ;; is unreliable in the face of
+ ;; `switch-to-buffer-preserve-window-point').
+ (puthash (current-buffer) (match-beginning 0) mstart))))
+ (lambda ()
+ (perform-replace from to t t delimited nil multi-query-replace-map
+ (gethash (current-buffer) mstart (point-min))
+ (point-max))))))
(provide 'fileloop)
;;; fileloop.el ends here
diff --git a/lisp/files.el b/lisp/files.el
index 8ce0187..55a0958 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -819,23 +819,25 @@ The path separator is colon in GNU and GNU-like systems."
(defun directory-files-recursively (dir regexp
&optional include-directories predicate
follow-symlinks)
- "Return list of all files under DIR that have file names matching REGEXP.
+ "Return list of all files under directory DIR whose names match REGEXP.
This function works recursively. Files are returned in \"depth
first\" order, and files from each directory are sorted in
alphabetical order. Each file name appears in the returned list
in its absolute form.
-Optional argument INCLUDE-DIRECTORIES non-nil means also include
-in the output directories whose names match REGEXP.
+By default, the returned list excludes directories, but if
+optional argument INCLUDE-DIRECTORIES is non-nil, they are
+included.
PREDICATE can be either nil (which means that all subdirectories
-are descended into), t (which means that subdirectories that
+of DIR are descended into), t (which means that subdirectories that
can't be read are ignored), or a function (which is called with
-the name of the subdirectory and should return non-nil if the
+the name of each subdirectory, and should return non-nil if the
subdirectory is to be descended into).
-If FOLLOW-SYMLINKS, symbolic links that point to directories are
-followed. Note that this can lead to infinite recursion."
+If FOLLOW-SYMLINKS is non-nil, symbolic links that point to
+directories are followed. Note that this can lead to infinite
+recursion."
(let* ((result nil)
(files nil)
(dir (directory-file-name dir))
@@ -7253,10 +7255,15 @@ if any returns nil. If `confirm-kill-emacs' is
non-nil, calls it."
(setq active t))
(setq processes (cdr processes)))
(or (not active)
- (with-displayed-buffer-window
+ (with-current-buffer-window
(get-buffer-create "*Process List*")
- '(display-buffer--maybe-at-bottom
- (dedicated . t))
+ `(display-buffer--maybe-at-bottom
+ (dedicated . t)
+ (window-height . fit-window-to-buffer)
+ (preserve-size . (nil . t))
+ (body-function
+ . ,#'(lambda (_window)
+ (list-processes t))))
#'(lambda (window _value)
(with-selected-window window
(unwind-protect
@@ -7264,8 +7271,7 @@ if any returns nil. If `confirm-kill-emacs' is non-nil,
calls it."
(setq confirm nil)
(yes-or-no-p "Active processes exist; kill them
and exit anyway? "))
(when (window-live-p window)
- (quit-restore-window window 'kill)))))
- (list-processes t)))))
+ (quit-restore-window window 'kill)))))))))
;; Query the user for other things, perhaps.
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
(or (null confirm)
diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el
index ae3d959..b694052 100644
--- a/lisp/image/image-converter.el
+++ b/lisp/image/image-converter.el
@@ -57,6 +57,10 @@ is a string, it should be a MIME format string like
;; Find an installed image converter.
(unless image-converter
(image-converter--find-converter))
+ ;; When image-converter was customized
+ (if (and image-converter (not image-converter-regexp))
+ (when-let ((formats (image-converter--probe image-converter)))
+ (setq image-converter-regexp (concat "\\." (regexp-opt formats)
"\\'"))))
(and image-converter
(or (and (not data-p)
(string-match image-converter-regexp source))
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index 8776e9b..10dc78d 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -4480,7 +4480,6 @@ Returns non-nil if any false statements are found.
;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (0 0 0
;;;;;; 0))
;;; Generated autoloads from emacs-lisp/checkdoc.el
-(push (purecopy '(checkdoc 0 6 2)) package--builtin-versions)
(put 'checkdoc-force-docstrings-flag 'safe-local-variable #'booleanp)
(put 'checkdoc-force-history-flag 'safe-local-variable #'booleanp)
(put 'checkdoc-permit-comma-termination-flag 'safe-local-variable #'booleanp)
@@ -5492,7 +5491,9 @@ doesn't have enough contents to decide, this is identical
to
See also `conf-space-mode', `conf-colon-mode', `conf-javaprop-mode',
`conf-ppd-mode' and `conf-xdefaults-mode'.
-\\{conf-mode-map}" t nil)
+\\{conf-mode-map}
+
+\(fn)" t nil)
(autoload 'conf-unix-mode "conf-mode" "\
Conf Mode starter for Unix style Conf files.
@@ -6469,7 +6470,6 @@ Mode used for cvs status output.
;;;### (autoloads nil "cwarn" "progmodes/cwarn.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cwarn.el
-(push (purecopy '(cwarn 1 3 1)) package--builtin-versions)
(autoload 'cwarn-mode "cwarn" "\
Minor mode that highlights suspicious C and C++ constructions.
@@ -14250,6 +14250,10 @@ DELAY is a string, giving the length of the time.
Possible values are:
* hh:mm for a specific time. Use 24h format. If it is later than this
time, then the deadline is tomorrow, else today.
+The value of `message-draft-headers' determines which headers are
+generated when the article is delayed. Remaining headers are
+generated when the article is sent.
+
\(fn DELAY)" t nil)
(autoload 'gnus-delay-send-queue "gnus-delay" "\
@@ -15727,6 +15731,21 @@ keymap value.
\(fn KEYMAP)" t nil)
+(autoload 'describe-mode "help-fns" "\
+Display documentation of current major mode and minor modes.
+A brief summary of the minor modes comes first, followed by the
+major mode description. This is followed by detailed
+descriptions of the minor modes, each on a separate page.
+
+For this to work correctly for a minor mode, the mode's indicator
+variable (listed in `minor-mode-alist') must also be a function
+whose documentation describes the minor mode.
+
+If called from Lisp with a non-nil BUFFER argument, display
+documentation for the major and minor modes of that buffer.
+
+\(fn &optional BUFFER)" t nil)
+
(autoload 'doc-file-to-man "help-fns" "\
Produce an nroff buffer containing the doc-strings from the DOC file.
@@ -16403,7 +16422,6 @@ See `highlight-changes-mode' for more information on
Highlight-Changes mode.
;;;### (autoloads nil "hippie-exp" "hippie-exp.el" (0 0 0 0))
;;; Generated autoloads from hippie-exp.el
-(push (purecopy '(hippie-exp 1 6)) package--builtin-versions)
(defvar hippie-expand-try-functions-list '(try-complete-file-name-partially
try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line
try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill
try-complete-lisp-symbol-partially try-complete-lisp-symbol) "\
The list of expansion functions tried in order by `hippie-expand'.
@@ -16825,7 +16843,6 @@ If optional arg OTHER-WINDOW is non-nil, then use
another window.
;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (0 0 0
;;;;;; 0))
;;; Generated autoloads from calendar/icalendar.el
-(push (purecopy '(icalendar 0 19)) package--builtin-versions)
(autoload 'icalendar-export-file "icalendar" "\
Export diary file to iCalendar format.
@@ -19518,7 +19535,6 @@ generations (this defaults to 1).
;;;### (autoloads nil "linum" "linum.el" (0 0 0 0))
;;; Generated autoloads from linum.el
-(push (purecopy '(linum 0 9 24)) package--builtin-versions)
(autoload 'linum-mode "linum" "\
Toggle display of line numbers in the left margin (Linum mode).
@@ -20424,7 +20440,6 @@ Default bookmark handler for Man buffers.
;;;### (autoloads nil "master" "master.el" (0 0 0 0))
;;; Generated autoloads from master.el
-(push (purecopy '(master 1 0 2)) package--builtin-versions)
(autoload 'master-mode "master" "\
Toggle Master mode.
@@ -24582,7 +24597,7 @@ Mark the installed package as selected by adding it to
When called from Lisp and optional argument DONT-SELECT is
non-nil, install the package but do not add it to
-`package-select-packages'.
+`package-selected-packages'.
If PKG is a `package-desc' and it is already installed, don't try
to install it but still mark it as selected.
@@ -26151,14 +26166,16 @@ recognized." t nil)
(autoload 'project-search "project" "\
Search for REGEXP in all the files of the project.
Stops when a match is found.
-To continue searching for next match, use command \\[fileloop-continue].
+To continue searching for the next match, use the
+command \\[fileloop-continue].
\(fn REGEXP)" t nil)
(autoload 'project-query-replace-regexp "project" "\
-Search for REGEXP in all the files of the project.
-Stops when a match is found.
-To continue searching for next match, use command \\[fileloop-continue].
+Query-replace REGEXP in all the files of the project.
+Stops when a match is found and prompts for whether to replace it.
+If you exit the query-replace, you can later continue the query-replace
+loop using the command \\[fileloop-continue].
\(fn FROM TO)" t nil)
@@ -27476,7 +27493,6 @@ This means the number of non-shy regexp grouping
constructs
;;;### (autoloads nil "remember" "textmodes/remember.el" (0 0 0 0))
;;; Generated autoloads from textmodes/remember.el
-(push (purecopy '(remember 2 0)) package--builtin-versions)
(autoload 'remember "remember" "\
Remember an arbitrary piece of data.
@@ -27528,7 +27544,6 @@ to turn the *scratch* buffer into your notes buffer.
;;;### (autoloads nil "repeat" "repeat.el" (0 0 0 0))
;;; Generated autoloads from repeat.el
-(push (purecopy '(repeat 0 51)) package--builtin-versions)
(autoload 'repeat "repeat" "\
Repeat most recently executed command.
@@ -28403,7 +28418,6 @@ Major mode for editing Ruby code.
;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (0 0 0 0))
;;; Generated autoloads from ruler-mode.el
-(push (purecopy '(ruler-mode 1 6)) package--builtin-versions)
(defvar ruler-mode nil "\
Non-nil if Ruler mode is enabled.
@@ -30585,7 +30599,9 @@ enable the mode if ARG is omitted or nil, and toggle it
if ARG is
(autoload 'smerge-start-session "smerge-mode" "\
Turn on `smerge-mode' and move point to first conflict marker.
-If no conflict maker is found, turn off `smerge-mode'." t nil)
+If no conflict maker is found, turn off `smerge-mode'.
+
+\(fn &optional INTERACTIVELY)" t nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"smerge-mode" '("smerge-")))
@@ -32669,16 +32685,17 @@ WHERE is provided the cell and table at that location
is reported.
(autoload 'table-generate-source "table" "\
Generate source of the current table in the specified language.
LANGUAGE is a symbol that specifies the language to describe the
-structure of the table. It must be either `html', `latex' or `cals'.
-The resulted source text is inserted into DEST-BUFFER and the buffer
-object is returned. When DEST-BUFFER is omitted or nil the default
-buffer specified in `table-dest-buffer-name' is used. In this case
-the content of the default buffer is erased prior to the generation.
-When DEST-BUFFER is non-nil it is expected to be either a destination
-buffer or a name of the destination buffer. In this case the
-generated result is inserted at the current point in the destination
-buffer and the previously existing contents in the buffer are
-untouched.
+structure of the table. It must be either `html', `latex', `cals',
+`wiki', or `mediawiki'.
+The function inserts the resulting source text into DEST-BUFFER, and
+returns the buffer object. When DEST-BUFFER is omitted or nil, the
+function uses the default buffer specified in `table-dest-buffer-name'.
+In this case, the function erases the default buffer prior to the
+source generation.
+When DEST-BUFFER is non-nil, it should be either a destination
+buffer or a name of the destination buffer. In that case, the
+function inserts the generated result at point in the destination
+buffer, and leaves the previous contents of the buffer untouched.
References used for this implementation:
@@ -33239,7 +33256,7 @@ Should show the queue(s) that \\[tex-print] puts jobs
on.")
(custom-autoload 'tex-show-queue-command "tex-mode" t)
-(defvar tex-default-mode 'latex-mode "\
+(defvar tex-default-mode #'latex-mode "\
Mode to enter for a new file that might be either TeX or LaTeX.
This variable is used when it can't be determined whether the file
is plain TeX or LaTeX or what because the file contains no commands.
@@ -33259,11 +33276,14 @@ String inserted by typing \\[tex-insert-quote] to
close a quotation.")
(autoload 'tex-mode "tex-mode" "\
Major mode for editing files of input for TeX, LaTeX, or SliTeX.
+This is the shared parent mode of several submodes.
Tries to determine (by looking at the beginning of the file) whether
this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode',
-`latex-mode', or `slitex-mode', respectively. If it cannot be determined,
+`latex-mode', or `slitex-mode', accordingly. If it cannot be determined,
such as if there are no commands in the file, the value of `tex-default-mode'
-says which mode to use." t nil)
+says which mode to use.
+
+\(fn)" t nil)
(defalias 'TeX-mode 'tex-mode)
@@ -36093,7 +36113,7 @@ with its diffs (if the underlying VCS supports that).
\(fn &optional LIMIT REVISION)" t nil)
(autoload 'vc-print-branch-log "vc" "\
-Show the change log for BRANCH in a window.
+Show the change log for BRANCH root in a window.
\(fn BRANCH)" t nil)
@@ -36317,6 +36337,11 @@ Name of the format file in a .bzr directory.")
;;;### (autoloads nil "vc-dir" "vc/vc-dir.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-dir.el
+(autoload 'vc-dir-root "vc-dir" "\
+Run `vc-dir' in the repository root directory without prompt.
+If the default directory of the current buffer is
+not under version control, prompt for a directory." t nil)
+
(autoload 'vc-dir "vc-dir" "\
Show the VC status for \"interesting\" files in and below DIR.
This allows you to mark files and perform VC operations on them.
@@ -37745,7 +37770,6 @@ this is equivalent to `display-warning', using
;;;### (autoloads nil "wdired" "wdired.el" (0 0 0 0))
;;; Generated autoloads from wdired.el
-(push (purecopy '(wdired 2 0)) package--builtin-versions)
(autoload 'wdired-change-to-wdired-mode "wdired" "\
Put a Dired buffer in Writable Dired (WDired) mode.
@@ -38344,6 +38368,11 @@ Display the next buffer in the same window.
\(fn &optional ARG)" t nil)
+(autoload 'windmove-display-new-frame "windmove" "\
+Display the next buffer in a new frame.
+
+\(fn &optional ARG)" t nil)
+
(autoload 'windmove-display-new-tab "windmove" "\
Display the next buffer in a new tab.
@@ -38456,7 +38485,6 @@ you can press `C-c <right>' (calling `winner-redo').
;;;### (autoloads nil "woman" "woman.el" (0 0 0 0))
;;; Generated autoloads from woman.el
-(push (purecopy '(woman 0 551)) package--builtin-versions)
(defvar woman-locale nil "\
String specifying a manual page locale, or nil.
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 7f5b597..3c8202c 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1968,12 +1968,13 @@ variables.")
(plist-get completion-extra-properties
:annotation-function)
completion-annotate-function))
+ (mainbuf (current-buffer))
;; If the *Completions* buffer is shown in a new
;; window, mark it as softly-dedicated, so bury-buffer in
;; minibuffer-hide-completions will know whether to
;; delete the window or not.
(display-buffer-mark-dedicated 'soft))
- (with-displayed-buffer-window
+ (with-current-buffer-window
"*Completions*"
;; This is a copy of `display-buffer-fallback-action'
;; where `display-buffer-use-some-window' is replaced
@@ -1987,66 +1988,69 @@ variables.")
,(if (eq (selected-window) (minibuffer-window))
'display-buffer-at-bottom
'display-buffer-below-selected))
- ,(if temp-buffer-resize-mode
- '(window-height . resize-temp-buffer-window)
- '(window-height . fit-window-to-buffer))
- ,(when temp-buffer-resize-mode
- '(preserve-size . (nil . t))))
- nil
- ;; Remove the base-size tail because `sort' requires a properly
- ;; nil-terminated list.
- (when last (setcdr last nil))
- (setq completions
- ;; FIXME: This function is for the output of all-completions,
- ;; not completion-all-completions. Often it's the same, but
- ;; not always.
- (let ((sort-fun (completion-metadata-get
- all-md 'display-sort-function)))
- (if sort-fun
- (funcall sort-fun completions)
- (sort completions 'string-lessp))))
- (when afun
- (setq completions
- (mapcar (lambda (s)
- (let ((ann (funcall afun s)))
- (if ann (list s ann) s)))
- completions)))
-
- (with-current-buffer standard-output
- (set (make-local-variable 'completion-base-position)
- (list (+ start base-size)
- ;; FIXME: We should pay attention to completion
- ;; boundaries here, but currently
- ;; completion-all-completions does not give us the
- ;; necessary information.
- end))
- (set (make-local-variable 'completion-list-insert-choice-function)
- (let ((ctable minibuffer-completion-table)
- (cpred minibuffer-completion-predicate)
- (cprops completion-extra-properties))
- (lambda (start end choice)
- (unless (or (zerop (length prefix))
- (equal prefix
- (buffer-substring-no-properties
- (max (point-min)
- (- start (length prefix)))
- start)))
- (message "*Completions* out of date"))
- ;; FIXME: Use `md' to do quoting&terminator here.
- (completion--replace start end choice)
- (let* ((minibuffer-completion-table ctable)
- (minibuffer-completion-predicate cpred)
- (completion-extra-properties cprops)
- (result (concat prefix choice))
- (bounds (completion-boundaries
- result ctable cpred "")))
- ;; If the completion introduces a new field, then
- ;; completion is not finished.
- (completion--done result
- (if (eq (car bounds) (length result))
- 'exact 'finished)))))))
-
- (display-completion-list completions))))
+ ,(if temp-buffer-resize-mode
+ '(window-height . resize-temp-buffer-window)
+ '(window-height . fit-window-to-buffer))
+ ,(when temp-buffer-resize-mode
+ '(preserve-size . (nil . t)))
+ (body-function
+ . ,#'(lambda (_window)
+ (with-current-buffer mainbuf
+ ;; Remove the base-size tail because `sort' requires a
properly
+ ;; nil-terminated list.
+ (when last (setcdr last nil))
+ (setq completions
+ ;; FIXME: This function is for the output of
all-completions,
+ ;; not completion-all-completions. Often it's the
same, but
+ ;; not always.
+ (let ((sort-fun (completion-metadata-get
+ all-md 'display-sort-function)))
+ (if sort-fun
+ (funcall sort-fun completions)
+ (sort completions 'string-lessp))))
+ (when afun
+ (setq completions
+ (mapcar (lambda (s)
+ (let ((ann (funcall afun s)))
+ (if ann (list s ann) s)))
+ completions)))
+
+ (with-current-buffer standard-output
+ (set (make-local-variable 'completion-base-position)
+ (list (+ start base-size)
+ ;; FIXME: We should pay attention to
completion
+ ;; boundaries here, but currently
+ ;; completion-all-completions does not give
us the
+ ;; necessary information.
+ end))
+ (set (make-local-variable
'completion-list-insert-choice-function)
+ (let ((ctable minibuffer-completion-table)
+ (cpred minibuffer-completion-predicate)
+ (cprops completion-extra-properties))
+ (lambda (start end choice)
+ (unless (or (zerop (length prefix))
+ (equal prefix
+
(buffer-substring-no-properties
+ (max (point-min)
+ (- start (length
prefix)))
+ start)))
+ (message "*Completions* out of date"))
+ ;; FIXME: Use `md' to do quoting&terminator
here.
+ (completion--replace start end choice)
+ (let* ((minibuffer-completion-table ctable)
+ (minibuffer-completion-predicate cpred)
+ (completion-extra-properties cprops)
+ (result (concat prefix choice))
+ (bounds (completion-boundaries
+ result ctable cpred "")))
+ ;; If the completion introduces a new
field, then
+ ;; completion is not finished.
+ (completion--done result
+ (if (eq (car bounds)
(length result))
+ 'exact
'finished)))))))
+
+ (display-completion-list completions)))))
+ nil)))
nil))
(defun minibuffer-hide-completions ()
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 0a92e0d..8d21133 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -48,6 +48,7 @@
;; Suppress message from `emacs-repository-get-branch'. We must
;; also handle out-of-tree builds.
(let ((inhibit-message t)
+ (debug-on-error nil)
(dir (or (locate-dominating-file (locate-library "tramp") ".git")
source-directory)))
;; `emacs-repository-get-branch' has been introduced with Emacs 27.1.
@@ -61,6 +62,7 @@
;; Suppress message from `emacs-repository-get-version'. We must
;; also handle out-of-tree builds.
(let ((inhibit-message t)
+ (debug-on-error nil)
(dir (or (locate-dominating-file (locate-library "tramp") ".git")
source-directory)))
(and (stringp dir) (file-directory-p dir)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index e5878b2..a76a3c4 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -265,6 +265,20 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
(java
"^\\(?:[ \t]+at \\|==[0-9]+==
+\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))
+ (javac
+ ,(concat
+ ;; line1
+ "^\\(\\(?:[A-Za-z]:\\)?[^:\n]+\\):" ;file
+ "\\([0-9]+\\): " ;line
+ "\\(warning: \\)?.*\n" ;type (optional) and message
+ ;; line2: source line containing error
+ ".*\n"
+ ;; line3: single "^" under error position in line2
+ " *\\^$")
+ 1 2
+ ,(lambda () (1- (current-column)))
+ (3))
+
(jikes-file
"^\\(?:Found\\|Issued\\) .* compiling \"\\(.+\\)\":$" 1 nil nil 0)
@@ -1466,9 +1480,15 @@ to `compilation-error-regexp-alist' if RULES is nil."
nil) ;; Not anchored or anchored but already allows empty spaces.
(t (setq pat (concat "^\\(?: \\)?" (substring pat 1)))))
- (if (consp file) (setq fmt (cdr file) file (car file)))
- (if (consp line) (setq end-line (cdr line) line (car line)))
- (if (consp col) (setq end-col (cdr col) col (car col)))
+ (if (and (consp file) (not (functionp file)))
+ (setq fmt (cdr file)
+ file (car file)))
+ (if (and (consp line) (not (functionp line)))
+ (setq end-line (cdr line)
+ line (car line)))
+ (if (and (consp col) (not (functionp col)))
+ (setq end-col (cdr col)
+ col (car col)))
(unless (or (null (nth 5 item)) (integerp (nth 5 item)))
(error "HYPERLINK should be an integer: %s" (nth 5 item)))
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 7ab9a2f..bee3a6b 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -319,7 +319,7 @@ i.e. 1970-1-1) are loaded as expiring one year from now
instead."
(pop untrusted)))
(and trusted untrusted
;; Choose the more specific match.
- (set (if (> trusted untrusted) 'untrusted 'trusted) nil))
+ (if (> trusted untrusted) (setq untrusted nil) (setq trusted nil)))
(cond
(untrusted
;; The site was explicitly marked as untrusted by the user.
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index b760e17..0c9e656 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -147,6 +147,12 @@ See `run-hooks'."
'(menu-item "Unmark Previous " vc-dir-unmark-file-up
:help "Move to the previous line and unmark the file"))
+ (define-key map [mark-unregistered]
+ '(menu-item "Mark Unregistered" vc-dir-mark-unregistered-files
+ :help "Mark all files in the unregistered state"))
+ (define-key map [mark-registered]
+ '(menu-item "Mark Registered" vc-dir-mark-registered-files
+ :help "Mark all files in the state edited, added or
removed"))
(define-key map [mark-all]
'(menu-item "Mark All" vc-dir-mark-all-files
:help "Mark all files that are in the same state as the
current file\
@@ -310,6 +316,10 @@ See `run-hooks'."
(define-key branch-map "l" 'vc-print-branch-log)
(define-key branch-map "s" 'vc-retrieve-tag))
+ (let ((mark-map (make-sparse-keymap)))
+ (define-key map "*" mark-map)
+ (define-key mark-map "r" 'vc-dir-mark-registered-files))
+
;; Hook up the menu.
(define-key map [menu-bar vc-dir-mode]
`(menu-item
@@ -696,6 +706,38 @@ share the same state."
(vc-dir-mark-file crt)))
(setq crt (ewoc-next vc-ewoc crt))))))))
+(defun vc-dir-mark-files (mark-files)
+ "Mark files specified by file names in the argument MARK-FILES.
+MARK-FILES should be a list of absolute filenames."
+ (ewoc-map
+ (lambda (filearg)
+ (when (member (expand-file-name (vc-dir-fileinfo->name filearg))
+ mark-files)
+ (setf (vc-dir-fileinfo->marked filearg) t)
+ t))
+ vc-ewoc))
+
+(defun vc-dir-mark-state-files (states)
+ "Mark files that are in the state specified by the list in STATES."
+ (unless (listp states)
+ (setq states (list states)))
+ (ewoc-map
+ (lambda (filearg)
+ (when (memq (vc-dir-fileinfo->state filearg) states)
+ (setf (vc-dir-fileinfo->marked filearg) t)
+ t))
+ vc-ewoc))
+
+(defun vc-dir-mark-registered-files ()
+ "Mark files that are in one of registered state: edited, added or removed."
+ (interactive)
+ (vc-dir-mark-state-files '(edited added removed)))
+
+(defun vc-dir-mark-unregistered-files ()
+ "Mark files that are in unregistered state."
+ (interactive)
+ (vc-dir-mark-state-files 'unregistered))
+
(defun vc-dir-unmark-file ()
;; Unmark the current file and move to the next line.
(let* ((crt (ewoc-locate vc-ewoc))
@@ -1193,7 +1235,8 @@ Throw an error if another update process is in progress."
(if remaining
(vc-dir-refresh-files
(mapcar 'vc-dir-fileinfo->name remaining))
- (setq mode-line-process nil))))))))))))
+ (setq mode-line-process nil)
+ (run-hooks 'vc-dir-refresh-hook))))))))))))
(defun vc-dir-show-fileentry (file)
"Insert an entry for a specific file into the current *VC-dir* listing.
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 607fb37..d4323d5 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1006,12 +1006,18 @@ Within directories, only files already under version
control are noticed."
(declare-function vc-dir-current-file "vc-dir" ())
(declare-function vc-dir-deduce-fileset "vc-dir" (&optional
state-model-only-files))
+(declare-function dired-vc-deduce-fileset "dired-aux" (&optional
state-model-only-files not-state-changing))
-(defun vc-deduce-fileset (&optional observer allow-unregistered
+(defun vc-deduce-fileset (&optional not-state-changing
+ allow-unregistered
state-model-only-files)
"Deduce a set of files and a backend to which to apply an operation.
Return (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL).
+NOT-STATE-CHANGING if non-nil, means that the operation
+requesting the fileset doesn't intend to change VC state,
+such as printing the log or showing the diff.
+
If we're in VC-dir mode, FILESET is the list of marked files,
or the directory if no files are marked.
Otherwise, if in a buffer visiting a version-controlled file,
@@ -1025,14 +1031,12 @@ the FILESET-ONLY-FILES STATE and MODEL info.
Otherwise, that
part may be skipped.
BEWARE: this function may change the current buffer."
- ;; FIXME: OBSERVER is unused. The name is not intuitive and is not
- ;; documented. It's set to t when called from diff and print-log.
(let (backend)
(cond
((derived-mode-p 'vc-dir-mode)
(vc-dir-deduce-fileset state-model-only-files))
((derived-mode-p 'dired-mode)
- (vc-dired-deduce-fileset state-model-only-files observer))
+ (dired-vc-deduce-fileset state-model-only-files not-state-changing))
((setq backend (vc-backend buffer-file-name))
(if state-model-only-files
(list backend (list buffer-file-name)
@@ -1048,7 +1052,7 @@ BEWARE: this function may change the current buffer."
(derived-mode-p 'dired-mode)))))
(progn ;FIXME: Why not `with-current-buffer'? --Stef.
(set-buffer vc-parent-buffer)
- (vc-deduce-fileset observer allow-unregistered state-model-only-files)))
+ (vc-deduce-fileset not-state-changing allow-unregistered
state-model-only-files)))
((and (derived-mode-p 'log-view-mode)
(setq backend (vc-responsible-backend default-directory)))
(list backend nil))
@@ -1065,32 +1069,6 @@ BEWARE: this function may change the current buffer."
(list buffer-file-name))))
(t (error "File is not under version control")))))
-(declare-function dired-get-marked-files "dired"
- (&optional localp arg filter distinguish-one-marked error))
-
-(defun vc-dired-deduce-fileset (&optional state-model-only-files observer)
- (let ((backend (vc-responsible-backend default-directory))
- (files (dired-get-marked-files nil nil nil nil t))
- only-files-list
- state
- model)
- (when (and (not observer) (cl-some #'file-directory-p files))
- (error "State changing VC operations on directories not supported in
`dired-mode'"))
-
- (when state-model-only-files
- (setq only-files-list (mapcar (lambda (file) (cons file (vc-state
file))) files))
- (setq state (cdar only-files-list))
- ;; Check that all files are in a consistent state, since we use that
- ;; state to decide which operation to perform.
- (dolist (crt (cdr only-files-list))
- (unless (vc-compatible-state (cdr crt) state)
- (error "When applying VC operations to multiple files, the files are
required\nto be in similar VC states.\n%s in state %s clashes with %s in state
%s"
- (car crt) (cdr crt) (caar only-files-list) state)))
- (setq only-files-list (mapcar 'car only-files-list))
- (when (and state (not (eq state 'unregistered)))
- (setq model (vc-checkout-model backend only-files-list))))
- (list backend files only-files-list state model)))
-
(defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file."
(cond
diff --git a/lisp/window.el b/lisp/window.el
index b54f163..8512a0e 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -226,7 +226,9 @@ BODY."
"Show a buffer BUFFER-OR-NAME and evaluate BODY in that buffer.
This construct is like `with-current-buffer-window' but unlike that,
displays the buffer specified by BUFFER-OR-NAME before running BODY."
- (declare (debug t) (indent 3))
+ (declare (debug t) (indent 3)
+ (obsolete "use `with-current-buffer-window' with action alist entry
`body-function'."
+ "28.1"))
(let ((buffer (make-symbol "buffer"))
(window (make-symbol "window"))
(value (make-symbol "value")))
@@ -7070,6 +7072,12 @@ Return WINDOW if BUFFER and WINDOW are live."
(set-window-dedicated-p window display-buffer-mark-dedicated))))
(when (memq type '(window frame tab))
(set-window-prev-buffers window nil))
+
+ (when (functionp (cdr (assq 'body-function alist)))
+ (let ((inhibit-read-only t)
+ (inhibit-modification-hooks t))
+ (funcall (cdr (assq 'body-function alist)) window)))
+
(let ((quit-restore (window-parameter window 'quit-restore))
(height (cdr (assq 'window-height alist)))
(width (cdr (assq 'window-width alist)))
@@ -7397,6 +7405,12 @@ Action alist entries are:
parameters to give the chosen window.
`allow-no-window' -- A non-nil value means that `display-buffer'
may not display the buffer and return nil immediately.
+ `body-function' -- A function called with one argument - the
+ displayed window. It is called after the buffer is
+ displayed, and before `window-height', `window-width'
+ and `preserve-size' are applied. The function is supposed
+ to fill the window body with some contents that might depend
+ on dimensions of the displayed window.
The entries `window-height', `window-width' and `preserve-size'
are applied only when the window used for displaying the buffer
diff --git a/src/alloc.c b/src/alloc.c
index db0646c..147e018 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -432,7 +432,6 @@ inline static void set_interval_marked (INTERVAL i);
enum mem_type
{
MEM_TYPE_NON_LISP,
- MEM_TYPE_BUFFER,
MEM_TYPE_CONS,
MEM_TYPE_STRING,
MEM_TYPE_SYMBOL,
@@ -3339,12 +3338,10 @@ allocate_pseudovector (int memlen, int lisplen,
struct buffer *
allocate_buffer (void)
{
- struct buffer *b = lisp_malloc (sizeof *b, false, MEM_TYPE_BUFFER);
-
+ struct buffer *b
+ = ALLOCATE_PSEUDOVECTOR (struct buffer, cursor_in_non_selected_windows_,
+ PVEC_BUFFER);
BUFFER_PVEC_INIT (b);
- /* Put B on the chain of all buffers including killed ones. */
- b->next = all_buffers;
- all_buffers = b;
/* Note that the rest fields of B are not initialized. */
return b;
}
@@ -4604,40 +4601,6 @@ live_vector_p (struct mem_node *m, void *p)
return !NILP (live_vector_holding (m, p));
}
-/* If P is a pointer into a valid buffer object, return the buffer.
- Otherwise, return nil. M is a pointer to the mem_block for P.
- If IGNORE_KILLED is non-zero, treat killed buffers as invalid. */
-
-static Lisp_Object
-live_buffer_holding (struct mem_node *m, void *p, bool ignore_killed)
-{
- /* P must point into the block, and the buffer must not
- have been killed unless ALL-BUFFERS is true. */
- if (m->type == MEM_TYPE_BUFFER)
- {
- struct buffer *b = m->start;
- char *cb = m->start;
- char *cp = p;
- ptrdiff_t offset = cp - cb;
- if (0 <= offset && offset < sizeof *b
- && !(ignore_killed && NILP (b->name_)))
- {
- Lisp_Object obj;
- XSETBUFFER (obj, b);
- return obj;
- }
- }
- return Qnil;
-}
-
-/* If P is a pointer into a live (valid and not killed) buffer object,
- return non-zero. */
-static bool
-live_buffer_p (struct mem_node *m, void *p)
-{
- return !NILP (live_buffer_holding (m, p, true));
-}
-
/* Mark OBJ if we can prove it's a Lisp_Object. */
static void
@@ -4692,8 +4655,7 @@ mark_maybe_object (Lisp_Object obj)
break;
case Lisp_Vectorlike:
- mark_p = (EQ (obj, live_vector_holding (m, po))
- || EQ (obj, live_buffer_holding (m, po, false)));
+ mark_p = (EQ (obj, live_vector_holding (m, po)));
break;
default:
@@ -4762,10 +4724,6 @@ mark_maybe_pointer (void *p)
/* Nothing to do; not a pointer to Lisp memory. */
break;
- case MEM_TYPE_BUFFER:
- obj = live_buffer_holding (m, p, false);
- break;
-
case MEM_TYPE_CONS:
obj = live_cons_holding (m, p);
break;
@@ -5165,9 +5123,6 @@ valid_lisp_object_p (Lisp_Object obj)
case MEM_TYPE_SPARE:
return 0;
- case MEM_TYPE_BUFFER:
- return live_buffer_p (m, p) ? 1 : 2;
-
case MEM_TYPE_CONS:
return live_cons_p (m, p);
@@ -5984,7 +5939,7 @@ maybe_garbage_collect (void)
void
garbage_collect (void)
{
- struct buffer *nextb;
+ Lisp_Object tail, buffer;
char stack_top_variable;
bool message_p;
ptrdiff_t count = SPECPDL_INDEX ();
@@ -6000,8 +5955,8 @@ garbage_collect (void)
/* Don't keep undo information around forever.
Do this early on, so it is no problem if the user quits. */
- FOR_EACH_BUFFER (nextb)
- compact_buffer (nextb);
+ FOR_EACH_LIVE_BUFFER (tail, buffer)
+ compact_buffer (XBUFFER (buffer));
byte_ct tot_before = (profiler_memory_running
? total_bytes_of_live_objects ()
@@ -6091,8 +6046,9 @@ garbage_collect (void)
compact_font_caches ();
- FOR_EACH_BUFFER (nextb)
+ FOR_EACH_LIVE_BUFFER (tail, buffer)
{
+ struct buffer *nextb = XBUFFER (buffer);
if (!EQ (BVAR (nextb, undo_list), Qt))
bset_undo_list (nextb, compact_undo_list (BVAR (nextb, undo_list)));
/* Now that we have stripped the elements that need not be
@@ -6357,7 +6313,12 @@ mark_buffer (struct buffer *buffer)
/* For now, we just don't mark the undo_list. It's done later in
a special way just before the sweep phase, and after stripping
- some of its elements that are not needed any more. */
+ some of its elements that are not needed any more.
+ Note: this later processing is only done for live buffers, so
+ for dead buffers, the undo_list should be nil (set by Fkill_buffer),
+ but just to be on the safe side, we mark it here. */
+ if (!BUFFER_LIVE_P (buffer))
+ mark_object (BVAR (buffer, undo_list));
mark_overlay (buffer->overlays_before);
mark_overlay (buffer->overlays_after);
@@ -6621,23 +6582,12 @@ mark_object (Lisp_Object arg)
= PSEUDOVECTOR_TYPE (ptr);
if (pvectype != PVEC_SUBR &&
- pvectype != PVEC_BUFFER &&
!main_thread_p (po))
CHECK_LIVE (live_vector_p);
switch (pvectype)
{
case PVEC_BUFFER:
-#if GC_CHECK_MARKED_OBJECTS
- {
- struct buffer *b;
- FOR_EACH_BUFFER (b)
- if (b == po)
- break;
- if (b == NULL)
- emacs_abort ();
- }
-#endif /* GC_CHECK_MARKED_OBJECTS */
mark_buffer ((struct buffer *) ptr);
break;
@@ -7126,25 +7076,17 @@ NO_INLINE /* For better stack traces */
static void
sweep_buffers (void)
{
- struct buffer *buffer, **bprev = &all_buffers;
+ Lisp_Object tail, buf;
gcstat.total_buffers = 0;
- for (buffer = all_buffers; buffer; buffer = *bprev)
- if (!vectorlike_marked_p (&buffer->header))
- {
- *bprev = buffer->next;
- lisp_free (buffer);
- }
- else
- {
- if (!pdumper_object_p (buffer))
- XUNMARK_VECTOR (buffer);
- /* Do not use buffer_(set|get)_intervals here. */
- buffer->text->intervals = balance_intervals (buffer->text->intervals);
- unchain_dead_markers (buffer);
- gcstat.total_buffers++;
- bprev = &buffer->next;
- }
+ FOR_EACH_LIVE_BUFFER (tail, buf)
+ {
+ struct buffer *buffer = XBUFFER (buf);
+ /* Do not use buffer_(set|get)_intervals here. */
+ buffer->text->intervals = balance_intervals (buffer->text->intervals);
+ unchain_dead_markers (buffer);
+ gcstat.total_buffers++;
+ }
}
/* Sweep: find all structures not marked, and free them. */
diff --git a/src/buffer.c b/src/buffer.c
index 70598a7..d8842a6 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -51,11 +51,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "w32heap.h" /* for mmap_* */
#endif
-/* First buffer in chain of all buffers (in reverse order of creation).
- Threaded through ->header.next.buffer. */
-
-struct buffer *all_buffers;
-
/* This structure holds the default values of the buffer-local variables
defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
The default value occupies the same slot in this structure
@@ -1786,15 +1781,11 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
ask questions or their hooks get errors. */
if (!b->base_buffer && b->indirections > 0)
{
- struct buffer *other;
+ Lisp_Object tail, other;
- FOR_EACH_BUFFER (other)
- if (other->base_buffer == b)
- {
- Lisp_Object buf;
- XSETBUFFER (buf, other);
- Fkill_buffer (buf);
- }
+ FOR_EACH_LIVE_BUFFER (tail, other)
+ if (XBUFFER (other)->base_buffer == b)
+ Fkill_buffer (other);
/* Exit if we now have killed the base buffer (Bug#11665). */
if (!BUFFER_LIVE_P (b))
@@ -1849,6 +1840,9 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
tem = Vinhibit_quit;
Vinhibit_quit = Qt;
+ /* Once the buffer is removed from Vbuffer_alist, its undo_list field is
+ not traced by the GC in the same way. So set it to nil early. */
+ bset_undo_list (b, Qnil);
/* Remove the buffer from the list of all buffers. */
Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
/* If replace_buffer_in_windows didn't do its job fix that now. */
@@ -1963,7 +1957,6 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
}
bset_width_table (b, Qnil);
unblock_input ();
- bset_undo_list (b, Qnil);
/* Run buffer-list-update-hook. */
if (!NILP (Vrun_hooks) && !b->inhibit_buffer_hooks)
@@ -2351,10 +2344,10 @@ results, see Info node `(elisp)Swapping Text'. */)
error ("Cannot swap indirect buffers's text");
{ /* This is probably harder to make work. */
- struct buffer *other;
- FOR_EACH_BUFFER (other)
- if (other->base_buffer == other_buffer
- || other->base_buffer == current_buffer)
+ Lisp_Object tail, other;
+ FOR_EACH_LIVE_BUFFER (tail, other)
+ if (XBUFFER (other)->base_buffer == other_buffer
+ || XBUFFER (other)->base_buffer == current_buffer)
error ("One of the buffers to swap has indirect buffers");
}
@@ -2502,7 +2495,7 @@ current buffer is cleared. */)
(Lisp_Object flag)
{
struct Lisp_Marker *tail, *markers;
- struct buffer *other;
+ Lisp_Object btail, other;
ptrdiff_t begv, zv;
bool narrowed = (BEG != BEGV || Z != ZV);
bool modified_p = !NILP (Fbuffer_modified_p (Qnil));
@@ -2755,13 +2748,16 @@ current buffer is cleared. */)
/* Copy this buffer's new multibyte status
into all of its indirect buffers. */
- FOR_EACH_BUFFER (other)
- if (other->base_buffer == current_buffer && BUFFER_LIVE_P (other))
- {
- BVAR (other, enable_multibyte_characters)
- = BVAR (current_buffer, enable_multibyte_characters);
- other->prevent_redisplay_optimizations_p = 1;
- }
+ FOR_EACH_LIVE_BUFFER (btail, other)
+ {
+ struct buffer *o = XBUFFER (other);
+ if (o->base_buffer == current_buffer && BUFFER_LIVE_P (o))
+ {
+ BVAR (o, enable_multibyte_characters)
+ = BVAR (current_buffer, enable_multibyte_characters);
+ o->prevent_redisplay_optimizations_p = true;
+ }
+ }
/* Restore the modifiedness of the buffer. */
if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
@@ -5327,8 +5323,6 @@ init_buffer_once (void)
Vbuffer_alist = Qnil;
current_buffer = 0;
pdumper_remember_lv_ptr_raw (¤t_buffer, Lisp_Vectorlike);
- all_buffers = 0;
- pdumper_remember_lv_ptr_raw (&all_buffers, Lisp_Vectorlike);
QSFundamental = build_pure_c_string ("Fundamental");
@@ -5359,7 +5353,7 @@ init_buffer (void)
#ifdef USE_MMAP_FOR_BUFFERS
if (dumped_with_unexec_p ())
{
- struct buffer *b;
+ Lisp_Object tail, buffer;
#ifndef WINDOWSNT
/* These must be reset in the dumped Emacs, to avoid stale
@@ -5381,23 +5375,13 @@ init_buffer (void)
" *code-conversion-work*". They are created by
init_buffer_once and init_window_once (which are not called
in the dumped Emacs), and by the first call to coding.c routines. */
- FOR_EACH_BUFFER (b)
+ FOR_EACH_LIVE_BUFFER (tail, buffer)
{
+ struct buffer *b = XBUFFER (buffer);
b->text->beg = NULL;
enlarge_buffer_text (b, 0);
}
}
- else
- {
- struct buffer *b;
-
- /* Only buffers with allocated buffer text should be present at
- this point in temacs. */
- FOR_EACH_BUFFER (b)
- {
- eassert (b->text->beg != NULL);
- }
- }
#endif /* USE_MMAP_FOR_BUFFERS */
AUTO_STRING (scratch, "*scratch*");
diff --git a/src/buffer.h b/src/buffer.h
index 31f497e..abb1294 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -570,9 +570,6 @@ struct buffer
In an indirect buffer, this is the own_text field of another buffer. */
struct buffer_text *text;
- /* Next buffer, in chain of all buffers, including killed ones. */
- struct buffer *next;
-
/* Char position of point in buffer. */
ptrdiff_t pt;
@@ -1104,15 +1101,6 @@ BUFFER_CHECK_INDIRECTION (struct buffer *b)
}
}
-/* Chain of all buffers, including killed ones. */
-
-extern struct buffer *all_buffers;
-
-/* Used to iterate over the chain above. */
-
-#define FOR_EACH_BUFFER(b) \
- for ((b) = all_buffers; (b); (b) = (b)->next)
-
/* This structure holds the default values of the buffer-local variables
that have special slots in each buffer.
The default value occupies the same slot in this structure
diff --git a/src/decompress.c b/src/decompress.c
index 5d24638..8e8f244 100644
--- a/src/decompress.c
+++ b/src/decompress.c
@@ -87,7 +87,7 @@ unwind_decompress (void *ddata)
0);
update_compositions (data->start, data->start, CHECK_HEAD);
/* "Balance" the before-change-functions call, which would
- otherwise be left "hanging". */
+ otherwise be left "hanging". */
signal_after_change (data->orig, data->start - data->orig,
data->start - data->orig);
}
@@ -159,7 +159,7 @@ This function can be called only in unibyte buffers. */)
istart = XFIXNUM (start);
iend = XFIXNUM (end);
- /* Do the following before manipulating the gap. */
+ /* Do the following before manipulating the gap. */
modify_text (istart, iend);
move_gap_both (iend, iend);
@@ -224,7 +224,7 @@ This function can be called only in unibyte buffers. */)
unwind_data.start = 0;
/* Delete the compressed data. */
- del_range_2 (istart, istart, /* byte and char offsets are the same. */
+ del_range_2 (istart, istart, /* byte and char offsets are the same */
iend, iend, 0);
signal_after_change (istart, iend - istart, unwind_data.nbytes);
diff --git a/src/dispextern.h b/src/dispextern.h
index 08380f1..555946f 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1693,12 +1693,17 @@ struct face
int fontset;
/* Non-zero means characters in this face have a box of that
- thickness around them. If this value is negative, its absolute
- value indicates the thickness, and the horizontal (top and
- bottom) borders of box are drawn inside of the character glyphs'
- area. The vertical (left and right) borders of the box are drawn
- in the same way as when this value is positive. */
- int box_line_width;
+ thickness around them. Vertical (left and right) and horizontal
+ (top and bottom) borders size can be set separatedly using an
+ associated list of two ints in the form
+ (vertical_size . horizontal_size). In case one of the value is
+ negative, its absolute value indicates the thickness, and the
+ borders of box are drawn inside of the character glyphs' area
+ potentially over the glyph itself but the glyph drawing size is
+ not increase. If a (signed) int N is use instead of a list, it
+ is the same as setting ( abs(N) . N ) values. */
+ int box_vertical_line_width;
+ int box_horizontal_line_width;
/* Type of box drawn. A value of FACE_NO_BOX means no box is drawn
around text in this face. A value of FACE_SIMPLE_BOX means a box
diff --git a/src/nsfont.m b/src/nsfont.m
index 9bec369..e41a698 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -1043,7 +1043,7 @@ nsfont_draw (struct glyph_string *s, int from, int to,
int x, int y,
r.origin.x = s->x;
if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p)
- r.origin.x += abs (s->face->box_line_width);
+ r.origin.x += max (s->face->box_vertical_line_width, 0);
r.origin.y = s->y;
r.size.height = FONT_HEIGHT (font);
@@ -1105,7 +1105,7 @@ nsfont_draw (struct glyph_string *s, int from, int to,
int x, int y,
{
NSRect br = r;
int fibw = FRAME_INTERNAL_BORDER_WIDTH (s->f);
- int mbox_line_width = max (s->face->box_line_width, 0);
+ int mbox_line_width = max (s->face->box_vertical_line_width, 0);
if (s->row->full_width_p)
{
@@ -1129,9 +1129,10 @@ nsfont_draw (struct glyph_string *s, int from, int to,
int x, int y,
}
else
{
- int correction = abs (s->face->box_line_width)+1;
+ int correction = abs (s->face->box_horizontal_line_width)+1;
br.origin.y += correction;
br.size.height -= 2*correction;
+ correction = abs (s->face->box_vertical_line_width)+1;
br.origin.x += correction;
br.size.width -= 2*correction;
}
diff --git a/src/nsterm.m b/src/nsterm.m
index 04fc051..3ce2233 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -3639,8 +3639,8 @@ ns_draw_text_decoration (struct glyph_string *s, struct
face *face,
}
static void
-ns_draw_box (NSRect r, CGFloat thickness, NSColor *col,
- char left_p, char right_p)
+ns_draw_box (NSRect r, CGFloat hthickness, CGFloat vthickness,
+ NSColor *col, char left_p, char right_p)
/* --------------------------------------------------------------------------
Draw an unfilled rect inside r, optionally leaving left and/or right open.
Note we can't just use an NSDrawRect command, because of the possibility
@@ -3651,28 +3651,28 @@ ns_draw_box (NSRect r, CGFloat thickness, NSColor *col,
[col set];
/* top, bottom */
- s.size.height = thickness;
+ s.size.height = hthickness;
NSRectFill (s);
- s.origin.y += r.size.height - thickness;
+ s.origin.y += r.size.height - hthickness;
NSRectFill (s);
s.size.height = r.size.height;
s.origin.y = r.origin.y;
/* left, right (optional) */
- s.size.width = thickness;
+ s.size.width = vthickness;
if (left_p)
NSRectFill (s);
if (right_p)
{
- s.origin.x += r.size.width - thickness;
+ s.origin.x += r.size.width - vthickness;
NSRectFill (s);
}
}
static void
-ns_draw_relief (NSRect r, int thickness, char raised_p,
+ns_draw_relief (NSRect r, int hthickness, int vthickness, char raised_p,
char top_p, char bottom_p, char left_p, char right_p,
struct glyph_string *s)
/* --------------------------------------------------------------------------
@@ -3722,27 +3722,27 @@ ns_draw_relief (NSRect r, int thickness, char raised_p,
/* TODO: mitering. Using NSBezierPath doesn't work because of color switch.
*/
/* top */
- sr.size.height = thickness;
+ sr.size.height = hthickness;
if (top_p) NSRectFill (sr);
/* left */
sr.size.height = r.size.height;
- sr.size.width = thickness;
+ sr.size.width = vthickness;
if (left_p) NSRectFill (sr);
[(raised_p ? darkCol : lightCol) set];
/* bottom */
sr.size.width = r.size.width;
- sr.size.height = thickness;
- sr.origin.y += r.size.height - thickness;
+ sr.size.height = hthickness;
+ sr.origin.y += r.size.height - hthickness;
if (bottom_p) NSRectFill (sr);
/* right */
sr.size.height = r.size.height;
sr.origin.y = r.origin.y;
- sr.size.width = thickness;
- sr.origin.x += r.size.width - thickness;
+ sr.size.width = vthickness;
+ sr.origin.x += r.size.width - vthickness;
if (right_p) NSRectFill (sr);
}
@@ -3758,7 +3758,7 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s)
char left_p, right_p;
struct glyph *last_glyph;
NSRect r;
- int thickness;
+ int hthickness, vthickness;
struct face *face;
if (s->hl == DRAW_MOUSE_FACE)
@@ -3771,7 +3771,8 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s)
else
face = s->face;
- thickness = face->box_line_width;
+ vthickness = face->box_vertical_line_width;
+ hthickness = face->box_horizontal_line_width;
NSTRACE ("ns_dumpglyphs_box_or_relief");
@@ -3796,14 +3797,15 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s)
/* TODO: Sometimes box_color is 0 and this seems wrong; should investigate.
*/
if (s->face->box == FACE_SIMPLE_BOX && s->face->box_color)
{
- ns_draw_box (r, abs (thickness),
+ ns_draw_box (r, abs (hthickness), abs (vthickness),
ns_lookup_indexed_color (face->box_color, s->f),
- left_p, right_p);
+ left_p, right_p);
}
else
{
- ns_draw_relief (r, abs (thickness), s->face->box == FACE_RAISED_BOX,
- 1, 1, left_p, right_p, s);
+ ns_draw_relief (r, abs (hthickness), abs (vthickness),
+ s->face->box == FACE_RAISED_BOX,
+ 1, 1, left_p, right_p, s);
}
}
@@ -3819,7 +3821,7 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s,
char force_p)
if (!s->background_filled_p/* || s->hl == DRAW_MOUSE_FACE*/)
{
- int box_line_width = max (s->face->box_line_width, 0);
+ int box_line_width = max (s->face->box_horizontal_line_width, 0);
if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width
/* When xdisp.c ignores FONT_HEIGHT, we cannot trust font
dimensions, since the actual glyphs might be much
@@ -3870,7 +3872,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
--------------------------------------------------------------------------
*/
{
EmacsImage *img = s->img->pixmap;
- int box_line_vwidth = max (s->face->box_line_width, 0);
+ int box_line_vwidth = max (s->face->box_horizontal_line_width, 0);
int x = s->x, y = s->ybase - image_ascent (s->img, s->face, &s->slice);
int bg_x, bg_y, bg_height;
int th;
@@ -3883,7 +3885,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p && s->slice.x == 0)
- x += abs (s->face->box_line_width);
+ x += max (s->face->box_vertical_line_width, 0);
bg_x = x;
bg_y = s->slice.y == 0 ? s->y : s->y + box_line_vwidth;
@@ -4003,7 +4005,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
r.origin.y = y - th;
r.size.width = s->slice.width + 2*th-1;
r.size.height = s->slice.height + 2*th-1;
- ns_draw_relief (r, th, raised_p,
+ ns_draw_relief (r, th, th, raised_p,
s->slice.y == 0,
s->slice.y + s->slice.height == s->img->height,
s->slice.x == 0,
@@ -4017,7 +4019,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
{
int thickness = abs (s->img->relief);
if (thickness == 0) thickness = 1;
- ns_draw_box (br, thickness, FRAME_CURSOR_COLOR (s->f), 1, 1);
+ ns_draw_box (br, thickness, thickness, FRAME_CURSOR_COLOR (s->f), 1, 1);
}
}
@@ -4100,7 +4102,7 @@ ns_draw_glyph_string_foreground (struct glyph_string *s)
of S to the right of that box line. */
if (s->face && s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -4126,7 +4128,7 @@ ns_draw_composite_glyph_string_foreground (struct
glyph_string *s)
of S to the right of that box line. */
if (s->face && s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -4142,7 +4144,7 @@ ns_draw_composite_glyph_string_foreground (struct
glyph_string *s)
if (s->cmp_from == 0)
{
NSRect r = NSMakeRect (s->x, s->y, s->width-1, s->height -1);
- ns_draw_box (r, 1, FRAME_CURSOR_COLOR (s->f), 1, 1);
+ ns_draw_box (r, 1, 1, FRAME_CURSOR_COLOR (s->f), 1, 1);
}
}
else if (! s->first_glyph->u.cmp.automatic)
diff --git a/src/pdumper.c b/src/pdumper.c
index 55f95fd..03c3168 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2786,7 +2786,7 @@ dump_hash_table (struct dump_context *ctx,
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
-#if CHECK_STRUCTS && !defined HASH_buffer_375A10F5E5
+#if CHECK_STRUCTS && !defined HASH_buffer_5DC36DBD42
# error "buffer changed. See CHECK_STRUCTS comment in config.h."
#endif
struct buffer munged_buffer = *in_buffer;
@@ -2862,8 +2862,6 @@ dump_buffer (struct dump_context *ctx, const struct
buffer *in_buffer)
ctx->obj_offset + dump_offsetof (struct buffer, text),
base_offset + dump_offsetof (struct buffer, own_text));
- dump_field_lv_rawptr (ctx, out, buffer, &buffer->next,
- Lisp_Vectorlike, WEIGHT_NORMAL);
DUMP_FIELD_COPY (out, buffer, pt);
DUMP_FIELD_COPY (out, buffer, pt_byte);
DUMP_FIELD_COPY (out, buffer, begv);
diff --git a/src/w32term.c b/src/w32term.c
index 76cf6bd..5fa77d5 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -888,10 +888,10 @@ static void w32_draw_image_foreground_1 (struct
glyph_string *, HBITMAP);
static void w32_clear_glyph_string_rect (struct glyph_string *, int,
int, int, int);
static void w32_draw_relief_rect (struct frame *, int, int, int, int,
- int, int, int, int, int, int,
+ int, int, int, int, int, int, int,
RECT *);
static void w32_draw_box_rect (struct glyph_string *, int, int, int, int,
- int, bool, bool, RECT *);
+ int, int, bool, bool, RECT *);
/* Set S->gc to a suitable GC for drawing glyph string S in cursor
@@ -1160,7 +1160,7 @@ w32_draw_glyph_string_background (struct glyph_string *s,
bool force_p)
shouldn't be drawn in the first place. */
if (!s->background_filled_p)
{
- int box_line_width = max (s->face->box_line_width, 0);
+ int box_line_width = max (s->face->box_horizontal_line_width, 0);
#if 0 /* TODO: stipple */
if (s->stippled_p)
@@ -1206,7 +1206,7 @@ w32_draw_glyph_string_foreground (struct glyph_string *s)
of S to the right of that box line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -1264,7 +1264,7 @@ w32_draw_composite_glyph_string_foreground (struct
glyph_string *s)
of S to the right of that box line. */
if (s->face && s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -1361,7 +1361,7 @@ w32_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
of S to the right of that box line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -1617,7 +1617,7 @@ w32_setup_relief_colors (struct glyph_string *s)
static void
w32_draw_relief_rect (struct frame *f,
int left_x, int top_y, int right_x, int bottom_y,
- int width, int raised_p,
+ int hwidth, int vwidth, int raised_p,
int top_p, int bot_p, int left_p, int right_p,
RECT *clip_rect)
{
@@ -1634,14 +1634,14 @@ w32_draw_relief_rect (struct frame *f,
/* Top. */
if (top_p)
- for (i = 0; i < width; ++i)
+ for (i = 0; i < hwidth; ++i)
w32_fill_area (f, hdc, gc.foreground,
left_x + i * left_p, top_y + i,
right_x - left_x - i * (left_p + right_p ) + 1, 1);
/* Left. */
if (left_p)
- for (i = 0; i < width; ++i)
+ for (i = 0; i < vwidth; ++i)
w32_fill_area (f, hdc, gc.foreground,
left_x + i, top_y + (i + 1) * top_p, 1,
bottom_y - top_y - (i + 1) * (bot_p + top_p) + 1);
@@ -1653,14 +1653,14 @@ w32_draw_relief_rect (struct frame *f,
/* Bottom. */
if (bot_p)
- for (i = 0; i < width; ++i)
+ for (i = 0; i < hwidth; ++i)
w32_fill_area (f, hdc, gc.foreground,
left_x + i * left_p, bottom_y - i,
right_x - left_x - i * (left_p + right_p) + 1, 1);
/* Right. */
if (right_p)
- for (i = 0; i < width; ++i)
+ for (i = 0; i < vwidth; ++i)
w32_fill_area (f, hdc, gc.foreground,
right_x - i, top_y + (i + 1) * top_p, 1,
bottom_y - top_y - (i + 1) * (bot_p + top_p) + 1);
@@ -1680,31 +1680,31 @@ w32_draw_relief_rect (struct frame *f,
static void
w32_draw_box_rect (struct glyph_string *s,
- int left_x, int top_y, int right_x, int bottom_y, int width,
- bool left_p, bool right_p, RECT *clip_rect)
+ int left_x, int top_y, int right_x, int bottom_y, int hwidth,
+ int vwidth, bool left_p, bool right_p, RECT *clip_rect)
{
w32_set_clip_rectangle (s->hdc, clip_rect);
/* Top. */
w32_fill_area (s->f, s->hdc, s->face->box_color,
- left_x, top_y, right_x - left_x + 1, width);
+ left_x, top_y, right_x - left_x + 1, hwidth);
/* Left. */
if (left_p)
{
w32_fill_area (s->f, s->hdc, s->face->box_color,
- left_x, top_y, width, bottom_y - top_y + 1);
+ left_x, top_y, vwidth, bottom_y - top_y + 1);
}
/* Bottom. */
w32_fill_area (s->f, s->hdc, s->face->box_color,
- left_x, bottom_y - width + 1, right_x - left_x + 1, width);
+ left_x, bottom_y - hwidth + 1, right_x - left_x + 1, hwidth);
/* Right. */
if (right_p)
{
w32_fill_area (s->f, s->hdc, s->face->box_color,
- right_x - width + 1, top_y, width, bottom_y - top_y + 1);
+ right_x - vwidth + 1, top_y, vwidth, bottom_y - top_y +
1);
}
w32_set_clip_rectangle (s->hdc, NULL);
@@ -1716,7 +1716,7 @@ w32_draw_box_rect (struct glyph_string *s,
static void
w32_draw_glyph_string_box (struct glyph_string *s)
{
- int width, left_x, right_x, top_y, bottom_y, last_x;
+ int hwidth, vwidth, left_x, right_x, top_y, bottom_y, last_x;
bool left_p, right_p, raised_p;
struct glyph *last_glyph;
RECT clip_rect;
@@ -1730,7 +1730,8 @@ w32_draw_glyph_string_box (struct glyph_string *s)
? s->first_glyph
: s->first_glyph + s->nchars - 1);
- width = eabs (s->face->box_line_width);
+ vwidth = eabs (s->face->box_vertical_line_width);
+ hwidth = eabs (s->face->box_horizontal_line_width);
raised_p = s->face->box == FACE_RAISED_BOX;
left_x = s->x;
right_x = ((s->row->full_width_p && s->extends_to_end_of_line_p
@@ -1751,13 +1752,13 @@ w32_draw_glyph_string_box (struct glyph_string *s)
get_glyph_string_clip_rect (s, &clip_rect);
if (s->face->box == FACE_SIMPLE_BOX)
- w32_draw_box_rect (s, left_x, top_y, right_x, bottom_y, width,
- left_p, right_p, &clip_rect);
+ w32_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth,
+ vwidth, left_p, right_p, &clip_rect);
else
{
w32_setup_relief_colors (s);
- w32_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y,
- width, raised_p, 1, 1, left_p, right_p,
&clip_rect);
+ w32_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y, hwidth,
+ vwidth, raised_p, 1, 1, left_p, right_p,
&clip_rect);
}
}
@@ -1795,7 +1796,7 @@ w32_draw_image_foreground (struct glyph_string *s)
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
- x += eabs (s->face->box_line_width);
+ x += max (s->face->box_vertical_line_width, 0);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
@@ -1982,7 +1983,7 @@ w32_draw_image_relief (struct glyph_string *s)
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
- x += eabs (s->face->box_line_width);
+ x += max (s->face->box_vertical_line_width, 0);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
@@ -2034,7 +2035,7 @@ w32_draw_image_relief (struct glyph_string *s)
w32_setup_relief_colors (s);
get_glyph_string_clip_rect (s, &r);
- w32_draw_relief_rect (s->f, x, y, x1, y1, thick, raised_p,
+ w32_draw_relief_rect (s->f, x, y, x1, y1, thick, thick, raised_p,
top_p, bot_p, left_p, right_p, &r);
}
@@ -2054,7 +2055,7 @@ w32_draw_image_foreground_1 (struct glyph_string *s,
HBITMAP pixmap)
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
- x += eabs (s->face->box_line_width);
+ x += max (s->face->box_vertical_line_width, 0);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
@@ -2167,8 +2168,8 @@ static void
w32_draw_image_glyph_string (struct glyph_string *s)
{
int x, y;
- int box_line_hwidth = eabs (s->face->box_line_width);
- int box_line_vwidth = max (s->face->box_line_width, 0);
+ int box_line_hwidth = max (s->face->box_vertical_line_width, 0);
+ int box_line_vwidth = max (s->face->box_horizontal_line_width, 0);
int height, width;
HBITMAP pixmap = 0;
diff --git a/src/xdisp.c b/src/xdisp.c
index 61c798c..cbdef7a 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -2061,8 +2061,8 @@ estimate_mode_line_height (struct frame *f, enum face_id
face_id)
{
if (face->font)
height = normal_char_height (face->font, -1);
- if (face->box_line_width > 0)
- height += 2 * face->box_line_width;
+ if (face->box_horizontal_line_width > 0)
+ height += 2 * face->box_horizontal_line_width;
}
}
@@ -28900,18 +28900,21 @@ produce_image_glyph (struct it *it)
if (face->box != FACE_NO_BOX)
{
- if (face->box_line_width > 0)
+ if (face->box_horizontal_line_width > 0)
{
if (slice.y == 0)
- it->ascent += face->box_line_width;
+ it->ascent += face->box_horizontal_line_width;
if (slice.y + slice.height == img->height)
- it->descent += face->box_line_width;
+ it->descent += face->box_horizontal_line_width;
}
- if (it->start_of_box_run_p && slice.x == 0)
- it->pixel_width += eabs (face->box_line_width);
- if (it->end_of_box_run_p && slice.x + slice.width == img->width)
- it->pixel_width += eabs (face->box_line_width);
+ if (face->box_vertical_line_width > 0)
+ {
+ if (it->start_of_box_run_p && slice.x == 0)
+ it->pixel_width += face->box_vertical_line_width;
+ if (it->end_of_box_run_p && slice.x + slice.width == img->width)
+ it->pixel_width += face->box_vertical_line_width;
+ }
}
take_vertical_position_into_account (it);
@@ -29009,15 +29012,18 @@ produce_xwidget_glyph (struct it *it)
if (face->box != FACE_NO_BOX)
{
- if (face->box_line_width > 0)
+ if (face->box_horizontal_line_width > 0)
{
- it->ascent += face->box_line_width;
- it->descent += face->box_line_width;
+ it->ascent += face->box_horizontal_line_width;
+ it->descent += face->box_horizontal_line_width;
}
- if (it->start_of_box_run_p)
- it->pixel_width += eabs (face->box_line_width);
- it->pixel_width += eabs (face->box_line_width);
+ if (face->box_vertical_line_width > 0)
+ {
+ if (it->start_of_box_run_p)
+ it->pixel_width += face->box_vertical_line_width;
+ it->pixel_width += face->box_vertical_line_width;
+ }
}
take_vertical_position_into_account (it);
@@ -29780,6 +29786,31 @@ produce_glyphless_glyph (struct it *it, bool
for_no_font, Lisp_Object acronym)
}
+/* If face has a box, add the box thickness to the character
+ height. If character has a box line to the left and/or
+ right, add the box line width to the character's width. */
+#define IT_APPLY_FACE_BOX(it, face) \
+ do { \
+ if (face->box != FACE_NO_BOX) \
+ { \
+ int thick = face->box_horizontal_line_width; \
+ if (thick > 0) \
+ { \
+ it->ascent += thick; \
+ it->descent += thick; \
+ } \
+ \
+ thick = face->box_vertical_line_width; \
+ if (thick > 0) \
+ { \
+ if (it->start_of_box_run_p) \
+ it->pixel_width += thick; \
+ if (it->end_of_box_run_p) \
+ it->pixel_width += thick; \
+ } \
+ } \
+ } while (false)
+
/* RIF:
Produce glyphs/get display metrics for the display element IT is
loaded with. See the description of struct it in dispextern.h
@@ -29895,26 +29926,7 @@ gui_produce_glyphs (struct it *it)
if (stretched_p)
it->pixel_width *= XFLOATINT (it->space_width);
- /* If face has a box, add the box thickness to the character
- height. If character has a box line to the left and/or
- right, add the box line width to the character's width. */
- if (face->box != FACE_NO_BOX)
- {
- int thick = face->box_line_width;
-
- if (thick > 0)
- {
- it->ascent += thick;
- it->descent += thick;
- }
- else
- thick = -thick;
-
- if (it->start_of_box_run_p)
- it->pixel_width += thick;
- if (it->end_of_box_run_p)
- it->pixel_width += thick;
- }
+ IT_APPLY_FACE_BOX(it, face);
/* If face has an overline, add the height of the overline
(1 pixel) and a 1 pixel margin to the character height. */
@@ -30029,10 +30041,10 @@ gui_produce_glyphs (struct it *it)
if ((it->max_ascent > 0 || it->max_descent > 0)
&& face->box != FACE_NO_BOX
- && face->box_line_width > 0)
+ && face->box_horizontal_line_width > 0)
{
- it->ascent += face->box_line_width;
- it->descent += face->box_line_width;
+ it->ascent += face->box_horizontal_line_width;
+ it->descent += face->box_horizontal_line_width;
}
if (!NILP (height)
&& XFIXNUM (height) > it->ascent + it->descent)
@@ -30439,23 +30451,7 @@ gui_produce_glyphs (struct it *it)
it->pixel_width = cmp->pixel_width;
it->ascent = it->phys_ascent = cmp->ascent;
it->descent = it->phys_descent = cmp->descent;
- if (face->box != FACE_NO_BOX)
- {
- int thick = face->box_line_width;
-
- if (thick > 0)
- {
- it->ascent += thick;
- it->descent += thick;
- }
- else
- thick = - thick;
-
- if (it->start_of_box_run_p)
- it->pixel_width += thick;
- if (it->end_of_box_run_p)
- it->pixel_width += thick;
- }
+ IT_APPLY_FACE_BOX(it, face);
/* If face has an overline, add the height of the overline
(1 pixel) and a 1 pixel margin to the character height. */
@@ -30489,23 +30485,8 @@ gui_produce_glyphs (struct it *it)
it->glyph_row->contains_overlapping_glyphs_p = true;
it->ascent = it->phys_ascent = metrics.ascent;
it->descent = it->phys_descent = metrics.descent;
- if (face->box != FACE_NO_BOX)
- {
- int thick = face->box_line_width;
+ IT_APPLY_FACE_BOX(it, face);
- if (thick > 0)
- {
- it->ascent += thick;
- it->descent += thick;
- }
- else
- thick = - thick;
-
- if (it->start_of_box_run_p)
- it->pixel_width += thick;
- if (it->end_of_box_run_p)
- it->pixel_width += thick;
- }
/* If face has an overline, add the height of the overline
(1 pixel) and a 1 pixel margin to the character height. */
if (face->overline_p)
diff --git a/src/xfaces.c b/src/xfaces.c
index 91a7a85..bab142a 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -3128,6 +3128,8 @@ FRAME 0 means change the face on all frames, and change
the default
valid_p = XFIXNUM (value) != 0;
else if (STRINGP (value))
valid_p = SCHARS (value) > 0;
+ else if (CONSP (value) && FIXNUMP (XCAR (value)) && FIXNUMP (XCDR
(value)))
+ valid_p = true;
else if (CONSP (value))
{
Lisp_Object tem;
@@ -3146,7 +3148,9 @@ FRAME 0 means change the face on all frames, and change
the default
if (EQ (k, QCline_width))
{
- if (!FIXNUMP (v) || XFIXNUM (v) == 0)
+ if ((!CONSP(v) || !FIXNUMP (XCAR (v)) || XFIXNUM (XCAR (v))
== 0
+ || !FIXNUMP (XCDR (v)) || XFIXNUM (XCDR (v))
== 0)
+ && (!FIXNUMP (v) || XFIXNUM (v) == 0))
break;
}
else if (EQ (k, QCcolor))
@@ -5815,7 +5819,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object
attrs[LFACE_VECTOR_SIZE]
face->box_color = load_color (f, face, attrs[LFACE_BOX_INDEX],
LFACE_BOX_INDEX);
face->box = FACE_SIMPLE_BOX;
- face->box_line_width = 1;
+ face->box_vertical_line_width = face->box_horizontal_line_width = 1;
}
else if (FIXNUMP (box))
{
@@ -5823,9 +5827,19 @@ realize_gui_face (struct face_cache *cache, Lisp_Object
attrs[LFACE_VECTOR_SIZE]
face. */
eassert (XFIXNUM (box) != 0);
face->box = FACE_SIMPLE_BOX;
- face->box_line_width = XFIXNUM (box);
+ face->box_vertical_line_width = eabs(XFIXNUM (box));
+ face->box_horizontal_line_width = XFIXNUM (box);
+ face->box_color = face->foreground;
+ face->box_color_defaulted_p = true;
+ }
+ else if (CONSP (box) && FIXNUMP (XCAR (box)) && FIXNUMP (XCDR (box)))
+ {
+ /* `(VWIDTH . HWIDTH)'. */
+ face->box = FACE_SIMPLE_BOX;
face->box_color = face->foreground;
face->box_color_defaulted_p = true;
+ face->box_vertical_line_width = XFIXNUM (XCAR (box));
+ face->box_horizontal_line_width = XFIXNUM (XCDR (box));
}
else if (CONSP (box))
{
@@ -5834,7 +5848,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object
attrs[LFACE_VECTOR_SIZE]
face->box = FACE_SIMPLE_BOX;
face->box_color = face->foreground;
face->box_color_defaulted_p = true;
- face->box_line_width = 1;
+ face->box_vertical_line_width = face->box_horizontal_line_width = 1;
while (CONSP (box))
{
@@ -5850,8 +5864,14 @@ realize_gui_face (struct face_cache *cache, Lisp_Object
attrs[LFACE_VECTOR_SIZE]
if (EQ (keyword, QCline_width))
{
- if (FIXNUMP (value) && XFIXNUM (value) != 0)
- face->box_line_width = XFIXNUM (value);
+ if (CONSP (value) && FIXNUMP (XCAR (value)) && FIXNUMP (XCDR
(value))) {
+ face->box_vertical_line_width = XFIXNUM (XCAR (value));
+ face->box_horizontal_line_width = XFIXNUM (XCDR (value));
+ }
+ else if (FIXNUMP (value) && XFIXNUM (value) != 0) {
+ face->box_vertical_line_width = eabs (XFIXNUM (value));
+ face->box_horizontal_line_width = XFIXNUM (value);
+ }
}
else if (EQ (keyword, QCcolor))
{
@@ -6953,10 +6973,13 @@ could define a face `my-mode-default', and then in the
mode setup
function, do:
(set (make-local-variable \\='face-remapping-alist)
- \\='((default my-mode-default)))).
+ (copy-tree \\='((default my-mode-default)))).
You probably want to use the face-remap package included in Emacs
-instead of manipulating face-remapping-alist directly.
+instead of manipulating face-remapping-alist directly. Note that many
+of the functions in that package modify the list destructively, so make
+sure you set it to a fresh value (for instance, use `copy-tree' as in
+the example above) before modifying.
Because Emacs normally only redraws screen areas when the underlying
buffer contents change, you may need to call `redraw-display' after
diff --git a/src/xterm.c b/src/xterm.c
index d7d992c..fc68c77 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -1754,7 +1754,7 @@ x_draw_glyph_string_background (struct glyph_string *s,
bool force_p)
shouldn't be drawn in the first place. */
if (!s->background_filled_p)
{
- int box_line_width = max (s->face->box_line_width, 0);
+ int box_line_width = max (s->face->box_horizontal_line_width, 0);
if (s->stippled_p)
{
@@ -1799,7 +1799,7 @@ x_draw_glyph_string_foreground (struct glyph_string *s)
of S to the right of that box line. */
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -1849,7 +1849,7 @@ x_draw_glyph_string_foreground (struct glyph_string *s)
if (!(s->for_overlaps
|| (s->background_filled_p && s->hl != DRAW_CURSOR)))
{
- int box_line_width = max (s->face->box_line_width, 0);
+ int box_line_width = max (s->face->box_horizontal_line_width, 0);
if (s->stippled_p)
{
@@ -1893,7 +1893,7 @@ x_draw_composite_glyph_string_foreground (struct
glyph_string *s)
of S to the right of that box line. */
if (s->face && s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -2004,7 +2004,7 @@ x_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
of S to the right of that box line. */
if (s->face && s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
- x = s->x + eabs (s->face->box_line_width);
+ x = s->x + max (s->face->box_vertical_line_width, 0);
else
x = s->x;
@@ -2769,7 +2769,7 @@ x_setup_relief_colors (struct glyph_string *s)
static void
x_draw_relief_rect (struct frame *f,
int left_x, int top_y, int right_x, int bottom_y,
- int width, bool raised_p, bool top_p, bool bot_p,
+ int hwidth, int vwidth, bool raised_p, bool top_p, bool
bot_p,
bool left_p, bool right_p,
XRectangle *clip_rect)
{
@@ -2794,7 +2794,7 @@ x_draw_relief_rect (struct frame *f,
if (left_p)
{
x_fill_rectangle (f, top_left_gc, left_x, top_y,
- width, bottom_y + 1 - top_y);
+ vwidth, bottom_y + 1 - top_y);
if (top_p)
corners |= 1 << CORNER_TOP_LEFT;
if (bot_p)
@@ -2802,8 +2802,8 @@ x_draw_relief_rect (struct frame *f,
}
if (right_p)
{
- x_fill_rectangle (f, bottom_right_gc, right_x + 1 - width, top_y,
- width, bottom_y + 1 - top_y);
+ x_fill_rectangle (f, bottom_right_gc, right_x + 1 - vwidth, top_y,
+ vwidth, bottom_y + 1 - top_y);
if (top_p)
corners |= 1 << CORNER_TOP_RIGHT;
if (bot_p)
@@ -2813,25 +2813,25 @@ x_draw_relief_rect (struct frame *f,
{
if (!right_p)
x_fill_rectangle (f, top_left_gc, left_x, top_y,
- right_x + 1 - left_x, width);
+ right_x + 1 - left_x, hwidth);
else
x_fill_trapezoid_for_relief (f, top_left_gc, left_x, top_y,
- right_x + 1 - left_x, width, 1);
+ right_x + 1 - left_x, hwidth, 1);
}
if (bot_p)
{
if (!left_p)
- x_fill_rectangle (f, bottom_right_gc, left_x, bottom_y + 1 - width,
- right_x + 1 - left_x, width);
+ x_fill_rectangle (f, bottom_right_gc, left_x, bottom_y + 1 - hwidth,
+ right_x + 1 - left_x, hwidth);
else
x_fill_trapezoid_for_relief (f, bottom_right_gc,
- left_x, bottom_y + 1 - width,
- right_x + 1 - left_x, width, 0);
+ left_x, bottom_y + 1 - hwidth,
+ right_x + 1 - left_x, hwidth, 0);
}
- if (left_p && width != 1)
+ if (left_p && vwidth > 1)
x_fill_rectangle (f, bottom_right_gc, left_x, top_y,
1, bottom_y + 1 - top_y);
- if (top_p && width != 1)
+ if (top_p && hwidth > 1)
x_fill_rectangle (f, bottom_right_gc, left_x, top_y,
right_x + 1 - left_x, 1);
if (corners)
@@ -2865,12 +2865,12 @@ x_draw_relief_rect (struct frame *f,
/* Top. */
if (top_p)
{
- if (width == 1)
+ if (hwidth == 1)
XDrawLine (dpy, drawable, gc,
left_x + left_p, top_y,
right_x + !right_p, top_y);
- for (i = 1; i < width; ++i)
+ for (i = 1; i < hwidth; ++i)
XDrawLine (dpy, drawable, gc,
left_x + i * left_p, top_y + i,
right_x + 1 - i * right_p, top_y + i);
@@ -2879,13 +2879,10 @@ x_draw_relief_rect (struct frame *f,
/* Left. */
if (left_p)
{
- if (width == 1)
+ if (vwidth == 1)
XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y);
- x_clear_area(f, left_x, top_y, 1, 1);
- x_clear_area(f, left_x, bottom_y, 1, 1);
-
- for (i = (width > 1 ? 1 : 0); i < width; ++i)
+ for (i = 1; i < vwidth; ++i)
XDrawLine (dpy, drawable, gc,
left_x + i, top_y + (i + 1) * top_p,
left_x + i, bottom_y + 1 - (i + 1) * bot_p);
@@ -2898,26 +2895,25 @@ x_draw_relief_rect (struct frame *f,
gc = f->output_data.x->white_relief.gc;
XSetClipRectangles (dpy, gc, 0, 0, clip_rect, 1, Unsorted);
- if (width > 1)
- {
- /* Outermost top line. */
- if (top_p)
- XDrawLine (dpy, drawable, gc,
- left_x + left_p, top_y,
- right_x + !right_p, top_y);
+ /* Outermost top line. */
+ if (top_p && hwidth > 1)
+ XDrawLine (dpy, drawable, gc,
+ left_x + left_p, top_y,
+ right_x + !right_p, top_y);
- /* Outermost left line. */
- if (left_p)
- XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y);
- }
+ /* Outermost left line. */
+ if (left_p && vwidth > 1)
+ XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y);
/* Bottom. */
if (bot_p)
{
- XDrawLine (dpy, drawable, gc,
- left_x + left_p, bottom_y,
- right_x + !right_p, bottom_y);
- for (i = 1; i < width; ++i)
+ if (hwidth >= 1)
+ XDrawLine (dpy, drawable, gc,
+ left_x + left_p, bottom_y,
+ right_x + !right_p, bottom_y);
+
+ for (i = 1; i < hwidth; ++i)
XDrawLine (dpy, drawable, gc,
left_x + i * left_p, bottom_y - i,
right_x + 1 - i * right_p, bottom_y - i);
@@ -2926,9 +2922,7 @@ x_draw_relief_rect (struct frame *f,
/* Right. */
if (right_p)
{
- x_clear_area(f, right_x, top_y, 1, 1);
- x_clear_area(f, right_x, bottom_y, 1, 1);
- for (i = 0; i < width; ++i)
+ for (i = 0; i < vwidth; ++i)
XDrawLine (dpy, drawable, gc,
right_x - i, top_y + (i + 1) * top_p,
right_x - i, bottom_y + 1 - (i + 1) * bot_p);
@@ -2949,8 +2943,8 @@ x_draw_relief_rect (struct frame *f,
static void
x_draw_box_rect (struct glyph_string *s,
- int left_x, int top_y, int right_x, int bottom_y, int width,
- bool left_p, bool right_p, XRectangle *clip_rect)
+ int left_x, int top_y, int right_x, int bottom_y, int hwidth,
+ int vwidth, bool left_p, bool right_p, XRectangle *clip_rect)
{
Display *display = FRAME_X_DISPLAY (s->f);
XGCValues xgcv;
@@ -2961,21 +2955,21 @@ x_draw_box_rect (struct glyph_string *s,
/* Top. */
x_fill_rectangle (s->f, s->gc,
- left_x, top_y, right_x - left_x + 1, width);
+ left_x, top_y, right_x - left_x + 1, hwidth);
/* Left. */
if (left_p)
x_fill_rectangle (s->f, s->gc,
- left_x, top_y, width, bottom_y - top_y + 1);
+ left_x, top_y, vwidth, bottom_y - top_y + 1);
/* Bottom. */
x_fill_rectangle (s->f, s->gc,
- left_x, bottom_y - width + 1, right_x - left_x + 1, width);
+ left_x, bottom_y - hwidth + 1, right_x - left_x + 1, hwidth);
/* Right. */
if (right_p)
x_fill_rectangle (s->f, s->gc,
- right_x - width + 1, top_y, width, bottom_y - top_y + 1);
+ right_x - vwidth + 1, top_y, vwidth, bottom_y - top_y + 1);
XSetForeground (display, s->gc, xgcv.foreground);
x_reset_clip_rectangles (s->f, s->gc);
@@ -2987,7 +2981,7 @@ x_draw_box_rect (struct glyph_string *s,
static void
x_draw_glyph_string_box (struct glyph_string *s)
{
- int width, left_x, right_x, top_y, bottom_y, last_x;
+ int hwidth, vwidth, left_x, right_x, top_y, bottom_y, last_x;
bool raised_p, left_p, right_p;
struct glyph *last_glyph;
XRectangle clip_rect;
@@ -3001,7 +2995,8 @@ x_draw_glyph_string_box (struct glyph_string *s)
? s->first_glyph
: s->first_glyph + s->nchars - 1);
- width = eabs (s->face->box_line_width);
+ vwidth = eabs (s->face->box_vertical_line_width);
+ hwidth = eabs (s->face->box_horizontal_line_width);
raised_p = s->face->box == FACE_RAISED_BOX;
left_x = s->x;
right_x = (s->row->full_width_p && s->extends_to_end_of_line_p
@@ -3022,13 +3017,13 @@ x_draw_glyph_string_box (struct glyph_string *s)
get_glyph_string_clip_rect (s, &clip_rect);
if (s->face->box == FACE_SIMPLE_BOX)
- x_draw_box_rect (s, left_x, top_y, right_x, bottom_y, width,
- left_p, right_p, &clip_rect);
+ x_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth,
+ vwidth, left_p, right_p, &clip_rect);
else
{
x_setup_relief_colors (s);
- x_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y,
- width, raised_p, true, true, left_p, right_p,
+ x_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y, hwidth,
+ vwidth, raised_p, true, true, left_p, right_p,
&clip_rect);
}
}
@@ -3086,7 +3081,7 @@ x_draw_image_foreground (struct glyph_string *s)
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
- x += eabs (s->face->box_line_width);
+ x += max (s->face->box_vertical_line_width, 0);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
@@ -3205,7 +3200,7 @@ x_draw_image_relief (struct glyph_string *s)
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
- x += eabs (s->face->box_line_width);
+ x += max (s->face->box_vertical_line_width, 0);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
@@ -3273,7 +3268,7 @@ x_draw_image_relief (struct glyph_string *s)
x_setup_relief_colors (s);
get_glyph_string_clip_rect (s, &r);
- x_draw_relief_rect (s->f, x, y, x1, y1, thick, raised_p,
+ x_draw_relief_rect (s->f, x, y, x1, y1, thick, thick, raised_p,
top_p, bot_p, left_p, right_p, &r);
}
@@ -3292,7 +3287,7 @@ x_draw_image_foreground_1 (struct glyph_string *s, Pixmap
pixmap)
if (s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p
&& s->slice.x == 0)
- x += eabs (s->face->box_line_width);
+ x += max (s->face->box_vertical_line_width, 0);
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
@@ -3394,8 +3389,8 @@ x_draw_glyph_string_bg_rect (struct glyph_string *s, int
x, int y, int w, int h)
static void
x_draw_image_glyph_string (struct glyph_string *s)
{
- int box_line_hwidth = eabs (s->face->box_line_width);
- int box_line_vwidth = max (s->face->box_line_width, 0);
+ int box_line_hwidth = max (s->face->box_vertical_line_width, 0);
+ int box_line_vwidth = max (s->face->box_horizontal_line_width, 0);
int height;
#ifndef USE_CAIRO
Display *display = FRAME_X_DISPLAY (s->f);
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index 784b404..6db5426 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -334,6 +334,17 @@ An existing calc stack is reused, otherwise a new one is
created."
(should (equal tos '(- (* 2 (var x var-x)) 4)))
(should (equal trail "pdiv 2 * x - 4\nprem 8 * x + 1\n"))))))
+(ert-deftest calc-Math-integerp ()
+ (should (Math-integerp -7))
+ (should (Math-integerp (ash 1 65)))
+ (should-not (Math-integerp '(float 1 0)))
+ (should-not (Math-integerp nil))
+
+ (should (Math-num-integerp -7))
+ (should (Math-num-integerp (ash 1 65)))
+ (should (Math-num-integerp '(float 1 0)))
+ (should-not (Math-num-integerp nil)))
+
(provide 'calc-tests)
;;; calc-tests.el ends here
diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el
index 026818a..ce8d728 100644
--- a/test/lisp/eshell/eshell-tests.el
+++ b/test/lisp/eshell/eshell-tests.el
@@ -169,6 +169,13 @@ e.g. \"{(+ 1 2)} 3\" => 3"
(eshell-command-result-p "+ 1 2; + $_ 4"
"3\n6\n")))
+(ert-deftest eshell-test/inside-emacs-var ()
+ "Test presence of \"INSIDE_EMACS\" in subprocesses"
+ (with-temp-eshell
+ (eshell-command-result-p "env"
+ (format "INSIDE_EMACS=%s,eshell"
+ emacs-version))))
+
(ert-deftest eshell-test/escape-nonspecial ()
"Test that \"\\c\" and \"c\" are equivalent when \"c\" is not a
special character."
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index e6c6b28..7722219 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4252,6 +4252,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(ert-deftest tramp-test29-start-file-process ()
"Check `start-file-process'."
+ :expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed)
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
@@ -4325,12 +4326,14 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(ert-deftest tramp-test30-make-process ()
"Check `make-process'."
+ :expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed)
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
;; `make-process' supports file name handlers since Emacs 27.
(skip-unless (tramp--test-emacs27-p))
+ (tramp--test-instrument-test-case 10
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name1 (tramp--test-make-temp-name nil quoted))
@@ -4491,7 +4494,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-process proc))
- (ignore-errors (delete-file tmpfile)))))))
+ (ignore-errors (delete-file tmpfile))))))))
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
@@ -4741,6 +4744,7 @@ INPUT, if non-nil, is a string sent to the process."
;; This test is inspired by Bug#23952.
(ert-deftest tramp-test33-environment-variables ()
"Check that remote processes set / unset environment variables properly."
+ :expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed)
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
diff --git a/test/lisp/progmodes/compile-tests.el
b/test/lisp/progmodes/compile-tests.el
index 7596256..cd73649 100644
--- a/test/lisp/progmodes/compile-tests.el
+++ b/test/lisp/progmodes/compile-tests.el
@@ -176,6 +176,9 @@
13 nil 217 "../src/Lib/System.cpp")
("==1332== by 0x8008621: main (vtest.c:180)"
13 nil 180 "vtest.c")
+ ;; javac
+ ("/src/Test.java:5: ';' expected\n foo foo\n ^\n" 1
15 5 "/src/Test.java" 2)
+ ("e:\\src\\Test.java:7: warning: ';' expected\n foo foo\n ^\n"
1 10 7 "e:\\src\\Test.java" 1)
;; jikes-file jikes-line
("Found 2 semantic errors compiling \"../javax/swing/BorderFactory.java\":"
1 nil nil "../javax/swing/BorderFactory.java")
@@ -431,8 +434,8 @@ The test data is in `compile-tests--test-regexps-data'."
(compilation-num-warnings-found 0)
(compilation-num-infos-found 0))
(mapc #'compile--test-error-line compile-tests--test-regexps-data)
- (should (eq compilation-num-errors-found 93))
- (should (eq compilation-num-warnings-found 36))
+ (should (eq compilation-num-errors-found 94))
+ (should (eq compilation-num-warnings-found 37))
(should (eq compilation-num-infos-found 26)))))
(ert-deftest compile-test-grep-regexps ()