procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs

Browse source
This commit is contained in:
Michael Albinus 2024-06-23 12:52:41 +02:00
commit 774016b275
14 changed files with 1126 additions and 574 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
configure.ac
View file

@ -4129,26 +4129,28 @@ case $with_file_notification,$NOTIFY_OBJ in
fi ;;
esac
dnl kqueue is available on BSD-like systems.
case $with_file_notification,$NOTIFY_OBJ in
kqueue,* | yes,)
EMACS_CHECK_MODULES([KQUEUE], [libkqueue])
if test "$HAVE_KQUEUE" = "yes"; then
AC_DEFINE([HAVE_KQUEUE], [1], [Define to 1 to use kqueue.])
CPPFLAGS="$CPPFLAGS -I/usr/include/kqueue"
NOTIFY_CFLAGS=$KQUEUE_CFLAGS
NOTIFY_LIBS=$KQUEUE_LIBS
NOTIFY_OBJ=kqueue.o
NOTIFY_SUMMARY="yes -lkqueue"
else
AC_SEARCH_LIBS([kqueue], [])
if test "$ac_cv_search_kqueue" != no; then
AC_DEFINE([HAVE_KQUEUE], [1], [Define to 1 to use kqueue.])
NOTIFY_OBJ=kqueue.o
NOTIFY_SUMMARY="yes (kqueue)"
fi
fi ;;
esac
AS_IF([test "$opsys" != "haiku"], [
dnl kqueue is available on BSD-like systems and Haiku, but Haiku's
dnl implementation cannot monitor filesystem activity.
case $with_file_notification,$NOTIFY_OBJ in
kqueue,* | yes,)
EMACS_CHECK_MODULES([KQUEUE], [libkqueue])
if test "$HAVE_KQUEUE" = "yes"; then
AC_DEFINE([HAVE_KQUEUE], [1], [Define to 1 to use kqueue.])
CPPFLAGS="$CPPFLAGS -I/usr/include/kqueue"
NOTIFY_CFLAGS=$KQUEUE_CFLAGS
NOTIFY_LIBS=$KQUEUE_LIBS
NOTIFY_OBJ=kqueue.o
NOTIFY_SUMMARY="yes -lkqueue"
else
AC_SEARCH_LIBS([kqueue], [])
if test "$ac_cv_search_kqueue" != no; then
AC_DEFINE([HAVE_KQUEUE], [1], [Define to 1 to use kqueue.])
NOTIFY_OBJ=kqueue.o
NOTIFY_SUMMARY="yes (kqueue)"
fi
fi ;;
esac])
dnl g_file_monitor exists since glib 2.18. G_FILE_MONITOR_EVENT_MOVED
dnl has been added in glib 2.24. It has been tested under

9
doc/emacs/trouble.texi
View file

@ -1540,10 +1540,11 @@ to the FSF@. For the reasons behind this, see
@url{https://www.gnu.org/licenses/why-assign.html}.
Copyright assignment is a simple process. Residents of many countries
can do it entirely electronically. We can help you get started,
including sending you the forms you should fill, and answer any
questions you may have (or point you to the people with the answers),
at the @email{emacs-devel@@gnu.org} mailing list.
can do it entirely electronically. To get started, follow the
instructions in the file @file{etc/copyright-assign.txt} in the Emacs
distribution. We can answer any questions you may have (or point you to
the people with the answers) at the @email{emacs-devel@@gnu.org} mailing
list.
(Please note: general discussion about why some GNU projects ask
for a copyright assignment is off-topic for emacs-devel.

16
etc/TODO
View file

@ -11,12 +11,16 @@ it best. Also to check that it hasn't been done already, since we
don't always remember to update this file! It is best to consult
the latest version of this file in the Emacs source code repository.
Since Emacs is an FSF-copyrighted package, please be prepared to sign
legal papers to transfer the copyright on your work to the FSF.
Copyright assignment is a simple process. Residents of some countries
can do it entirely electronically. We can help you get started, and
answer any questions you may have (or point you to the people with the
answers), at the emacs-devel@gnu.org mailing list.
Generally speaking, for non-trivial contributions to GNU Emacs and
packages stored in GNU ELPA, we require that the copyright be assigned
to the FSF. For the reasons behind this, see:
https://www.gnu.org/licenses/why-assign.html
Copyright assignment is a simple process. Residents of many countries
can do it entirely electronically. To get started, follow the
instructions in the file etc/copyright-assign.txt in the Emacs
distribution. We can answer any questions you may have (or point you to
the people with the answers) at the emacs-devel@gnu.org mailing list.
For more information about getting involved, see the CONTRIBUTE file.

36
etc/copyright-assign.txt Normal file
View file

@ -0,0 +1,36 @@
Please email the following information to assign@gnu.org, and we
will send you the assignment form for your past and future changes.
Please use your full legal name (in ASCII characters) as the subject
line of the message.
----------------------------------------------------------------------
REQUEST: SEND FORM FOR PAST AND FUTURE CHANGES
[What is the name of the program or package you're contributing to?]
Emacs
[Did you copy any files or text written by someone else in these changes?
Even if that material is free software, we need to know about it.]
[Do you have an employer who might have a basis to claim to own
your changes? Do you attend a school which might make such a claim?]
[For the copyright registration, what country are you a citizen of?]
[What year were you born?]
[Please write your email address here.]
[Please write your postal address here.]
[Which files have you changed so far, and which new files have you written
so far?]

1321
etc/publicsuffix.txt
View file

File diff suppressed because it is too large Load diff

BIN
leim/SKK-DIC/SKK-JISYO.L
View file

Binary file not shown.

94
lisp/net/shr.el
View file

@ -282,6 +282,14 @@ temporarily blinks with this face."
"Face used for <mark> elements."
:version "29.1")
(defface shr-sliced-image
'((t :underline nil :overline nil))
"Face used for sliced images.
This face should remove any unsightly decorations from sliced images.
Otherwise, decorations like underlines from links would normally show on
every slice."
:version "30.1")
(defcustom shr-inhibit-images nil
"If non-nil, inhibit loading images."
:version "28.1"
@ -600,38 +608,34 @@ the URL of the image to the kill buffer instead."
t))))
(defun shr-zoom-image ()
"Toggle the image size.
The size will be rotated between the default size, the original
size, and full-buffer size."
"Cycle the image size.
The size will cycle through the default size, the original size, and
full-buffer size."
(interactive)
(let ((url (get-text-property (point) 'image-url))
(size (get-text-property (point) 'image-size))
(buffer-read-only nil))
(let ((url (get-text-property (point) 'image-url)))
(if (not url)
(message "No image under point")
;; Delete the old picture.
(while (get-text-property (point) 'image-url)
(forward-char -1))
(forward-char 1)
(let ((start (point)))
(while (get-text-property (point) 'image-url)
(forward-char 1))
(forward-char -1)
(put-text-property start (point) 'display nil)
(when (> (- (point) start) 2)
(delete-region start (1- (point)))))
(message "Inserting %s..." url)
(url-retrieve url #'shr-image-fetched
(list (current-buffer) (1- (point)) (point-marker)
(list (cons 'size
(cond ((or (eq size 'default)
(null size))
'original)
((eq size 'original)
'full)
((eq size 'full)
'default)))))
t))))
(let* ((end (or (next-single-property-change (point) 'image-url)
(point-max)))
(start (or (previous-single-property-change end 'image-url)
(point-min)))
(size (get-text-property (point) 'image-size))
(next-size (cond ((or (eq size 'default)
(null size))
'original)
((eq size 'original)
'full)
((eq size 'full)
'default)))
(buffer-read-only nil))
;; Delete the old picture.
(put-text-property start end 'display nil)
(message "Inserting %s..." url)
(url-retrieve url #'shr-image-fetched
`(,(current-buffer) ,start
,(set-marker (make-marker) end)
((size . ,next-size)))
t)))))
;;; Utility functions.
@ -1070,6 +1074,7 @@ the mouse click event."
;; We don't want to record these changes.
(buffer-undo-list t)
(inhibit-read-only t))
(remove-overlays start end)
(delete-region start end)
(goto-char start)
(funcall shr-put-image-function data alt flags)
@ -1144,7 +1149,8 @@ element is the data blob and the second element is the content-type."
;; putting any space after inline images.
;; ALT may be nil when visiting image URLs in eww
;; (bug#67764).
(setq alt (if alt (string-trim alt) "*"))
(setq alt (string-trim (or alt "")))
(when (length= alt 0) (setq alt "*"))
;; When inserting big-ish pictures, put them at the
;; beginning of the line.
(let ((inline (shr--inline-image-p image)))
@ -1153,7 +1159,16 @@ element is the data blob and the second element is the content-type."
(insert "\n"))
(let ((image-pos (point)))
(if (eq size 'original)
(insert-sliced-image image alt nil 20 1)
;; Normally, we try to keep the buffer text the same
;; by preserving ALT. With a sliced image, we have to
;; repeat the text for each line, so we can't do that.
;; Just use "*" for the string to insert instead.
(progn
(insert-sliced-image image "*" nil 20 1)
(let ((overlay (make-overlay start (point))))
;; Avoid displaying unsightly decorations on the
;; image slices.
(overlay-put overlay 'face 'shr-sliced-image)))
(insert-image image alt))
(put-text-property start (point) 'image-size size)
(when (and (not inline) shr-max-inline-image-size)
@ -1854,17 +1869,12 @@ The preference is a float determined from `shr-prefer-media-type'."
(let ((file (url-cache-create-filename url)))
(when (file-exists-p file)
(delete-file file))))
(when (image-type-available-p 'svg)
(insert-image
(shr-make-placeholder-image dom)
(or (string-trim alt) "")))
;; Paradoxically this space causes shr not to insert spaces after
;; inline images. Since the image is temporary it seem like there
;; should be no downside to not inserting it but since I don't
;; understand the code well and for the sake of backward compatibility
;; we preserve it unless user has set `shr-max-inline-image-size'.
(unless shr-max-inline-image-size
(insert " "))
(if (image-type-available-p 'svg)
(insert-image
(shr-make-placeholder-image dom)
(or (string-trim alt) ""))
;; No SVG support. Just use a space as our placeholder.
(insert " "))
(url-queue-retrieve
url #'shr-image-fetched
(list (current-buffer) start (set-marker (make-marker) (point))

5
lisp/progmodes/c-ts-mode.el
View file

@ -572,7 +572,7 @@ MODE is either `c' or `cpp'."
"not" "not_eq" "operator" "or"
"or_eq" "override" "private" "protected"
"public" "requires" "template" "throw"
"try" "typename" "using" "virtual"
"try" "typename" "using"
"xor" "xor_eq"))
(append '("auto") c-keywords))))
@ -635,7 +635,8 @@ MODE is either `c' or `cpp'."
`([,@(c-ts-mode--keywords mode)] @font-lock-keyword-face
,@(when (eq mode 'cpp)
'((auto) @font-lock-keyword-face
(this) @font-lock-keyword-face)))
(this) @font-lock-keyword-face
(virtual) @font-lock-keyword-face)))
:language mode
:feature 'operator

46
lisp/progmodes/php-ts-mode.el
View file

@ -121,6 +121,16 @@ By default should have same value as `html-ts-mode-indent-offset'."
:type 'integer
:safe 'integerp)
(defcustom php-ts-mode-css-fontify-colors t
"Whether CSS colors should be fontified using the color as the background.
If non-nil, text representing a CSS color will be fontified
such that its background is the color itself.
Works like `css--fontify-region'."
:tag "PHP colors the CSS properties values."
:version "30.1"
:type 'boolean
:safe 'booleanp)
(defcustom php-ts-mode-php-executable (or (executable-find "php") "/usr/bin/php")
"The location of PHP executable."
:tag "PHP Executable"
@ -999,6 +1009,26 @@ characters of the current line."
'((variable_name (name) @font-lock-variable-name-face)))
"Tree-sitter font-lock settings for phpdoc.")
(defun php-ts-mode--colorize-css-value (node override start end &rest _)
"Colorize CSS property value like `css--fontify-region'.
For NODE, OVERRIDE, START, and END, see `treesit-font-lock-rules'."
(if (and php-ts-mode-css-fontify-colors
(string-equal "plain_value" (treesit-node-type node)))
(let ((color (css--compute-color start (treesit-node-text node t))))
(when color
(treesit-fontify-with-override
(treesit-node-start node) (treesit-node-end node)
(list 'face
(list :background color
:foreground (readable-foreground-color
color)
:box '(:line-width -1)))
override start end)))
(treesit-fontify-with-override
(treesit-node-start node) (treesit-node-end node)
'font-lock-variable-name-face
override start end)))
(defun php-ts-mode--fontify-error (node override start end &rest _)
"Fontify the error nodes.
For NODE, OVERRIDE, START, and END, see `treesit-font-lock-rules'."
@ -1232,7 +1262,7 @@ Depends on `c-ts-common-comment-setup'."
["Start built-in webserver" php-ts-mode-run-php-webserver
:help "Run the built-in PHP webserver"]
"--"
["Customize" (lambda () (interactive) (customize-group "php-ts"))]))
["Customize" (lambda () (interactive) (customize-group "php-ts-mode"))]))
(defvar php-ts-mode--feature-list
'((;; common
@ -1393,12 +1423,20 @@ Depends on `c-ts-common-comment-setup'."
("Constant" "\\`const_element\\'" nil nil)))
;; Font-lock.
(setq-local treesit-font-lock-settings (php-ts-mode--font-lock-settings))
(setq-local treesit-font-lock-settings
(append treesit-font-lock-settings
(append (php-ts-mode--font-lock-settings)
php-ts-mode--custom-html-font-lock-settings
js--treesit-font-lock-settings
css--treesit-settings
(append
;; Rule for coloring CSS property values.
;; Placed before `css--treesit-settings'
;; to win against the same rule contained therein.
(treesit-font-lock-rules
:language 'css
:override t
:feature 'variable
'((plain_value) @php-ts-mode--colorize-css-value))
css--treesit-settings)
php-ts-mode--phpdoc-font-lock-settings))
(setq-local treesit-font-lock-feature-list php-ts-mode--feature-list)

9
lisp/window.el
View file

@ -9171,9 +9171,14 @@ Return the buffer switched to."
(pop-to-buffer buffer norecord)))
(t
(when switch-to-buffer-obey-display-actions
(let ((selected-window (selected-window)))
(let* ((selected-window (selected-window))
(old-window-buffer (window-buffer selected-window)))
(pop-to-buffer-same-window buffer norecord)
(when (eq (selected-window) selected-window)
;; Do not ask for setting start and point when showing the
;; same buffer in the old selected window (Bug#71616).
(when (and (eq (selected-window) selected-window)
(not (eq (window-buffer selected-window)
old-window-buffer)))
(setq set-window-start-and-point t))))
(when set-window-start-and-point

13
src/fileio.c
View file

@ -6531,7 +6531,18 @@ If the underlying system call fails, value is nil. */)
|| defined STAT_STATFS4 || defined STAT_STATVFS \
|| defined STAT_STATVFS64
struct fs_usage u;
if (get_fs_usage (SSDATA (ENCODE_FILE (filename)), NULL, &u) != 0)
const char *name;
name = SSDATA (ENCODE_FILE (filename));
#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
/* With special directories, this information is unavailable. */
if (android_is_special_directory (name, "/assets")
|| android_is_special_directory (name, "/content"))
return Qnil;
#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
if (get_fs_usage (name, NULL, &u) != 0)
return errno == ENOSYS ? Qnil : file_attribute_errno (filename, errno);
return list3 (blocks_to_bytes (u.fsu_blocksize, u.fsu_blocks, false),
blocks_to_bytes (u.fsu_blocksize, u.fsu_bfree, false),

37
src/kqueue.c
View file

@ -444,23 +444,29 @@ only when the upper directory of the renamed file is watched. */)
if (! NILP (Fmember (Qrevoke, flags))) fflags |= NOTE_REVOKE;
/* Register event. */
EV_SET (&kev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR,
EV_SET (&kev, fd, EVFILT_VNODE, (EV_ADD
#ifdef EV_ENABLE
| EV_ENABLE
#endif /* EV_ENABLE */
| EV_CLEAR),
fflags, 0, NULL);
if (kevent (kqueuefd, &kev, 1, NULL, 0, NULL) < 0) {
emacs_close (fd);
report_file_error ("Cannot watch file", file);
}
if (kevent (kqueuefd, &kev, 1, NULL, 0, NULL) < 0)
{
emacs_close (fd);
report_file_error ("Cannot watch file", file);
}
/* Store watch object in watch list. */
Lisp_Object watch_descriptor = make_fixnum (fd);
if (NILP (Ffile_directory_p (file)))
watch_object = list4 (watch_descriptor, file, flags, callback);
else {
dir_list = directory_files_internal (file, Qnil, Qnil, Qnil, true, Qnil,
Qnil);
watch_object = list5 (watch_descriptor, file, flags, callback, dir_list);
}
else
{
dir_list = directory_files_internal (file, Qnil, Qnil, Qnil, true, Qnil,
Qnil);
watch_object = list5 (watch_descriptor, file, flags, callback, dir_list);
}
watch_list = Fcons (watch_object, watch_list);
return watch_descriptor;
@ -486,11 +492,12 @@ WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'. */)
/* Remove watch descriptor from watch list. */
watch_list = Fdelq (watch_object, watch_list);
if (NILP (watch_list) && (kqueuefd >= 0)) {
delete_read_fd (kqueuefd);
emacs_close (kqueuefd);
kqueuefd = -1;
}
if (NILP (watch_list) && (kqueuefd >= 0))
{
delete_read_fd (kqueuefd);
emacs_close (kqueuefd);
kqueuefd = -1;
}
return Qt;
}

8
src/timefns.c
View file

@ -414,9 +414,11 @@ decode_float_time (double t, struct lisp_time *result)
else
{
int scale = double_integer_scale (t);
/* FIXME: `double_integer_scale` often returns values that are
"pessimistic" (i.e. larger than necessary), so 3.5 gets converted
to (7881299347898368 . 2251799813685248) rather than (7 . 2).
/* Because SCALE treats trailing zeros in T as significant,
on typical platforms with IEEE floating point
(time-convert 3.5 t) yields (7881299347898368 . 2251799813685248),
a precision of 2**-51 s, not (7 . 2), a precision of 0.5 s.
Although numerically correct, this generates largish integers.
On 64bit systems, this should not matter very much, tho. */
eassume (scale < flt_radix_power_size);

64
test/lisp/net/shr-tests.el
View file

@ -29,6 +29,22 @@
(declare-function libxml-parse-html-region "xml.c")
(defvar shr-test--max-wait-time 5
"The maximum amount of time to wait for a condition to resolve, in seconds.
See `shr-test-wait-for'.")
(defun shr-test-wait-for (predicate &optional message)
"Wait until PREDICATE returns non-nil.
If this takes longer than `shr-test--max-wait-time', raise an error.
MESSAGE is an optional message to use if this times out."
(let ((start (current-time))
(message (or message "timed out waiting for condition")))
(while (not (funcall predicate))
(when (> (float-time (time-since start))
shr-test--max-wait-time)
(error message))
(sit-for 0.1))))
(defun shr-test--rendering-check (name &optional context)
"Render NAME.html and compare it to NAME.txt.
Raise a test failure if the rendered buffer does not match NAME.txt.
@ -68,6 +84,8 @@ validate for the NAME testcase.
The `rendering' testcase will test NAME once without altering any
settings, then once more for each (OPTION . VALUE) pair.")
;;; Tests:
(ert-deftest rendering ()
(skip-unless (fboundp 'libxml-parse-html-region))
(dolist (file (directory-files (ert-resource-directory) nil "\\.html\\'"))
@ -114,6 +132,52 @@ settings, then once more for each (OPTION . VALUE) pair.")
(should (equal (shr--parse-srcset "https://example.org/1,2\n\n 10w , https://example.org/2 20w ")
'(("https://example.org/2" 20) ("https://example.org/1,2" 10)))))
(ert-deftest shr-test/zoom-image ()
"Test that `shr-zoom-image' properly replaces the original image."
(let ((image (expand-file-name "data/image/blank-100x200.png"
(getenv "EMACS_TEST_DIRECTORY"))))
(dolist (alt '(nil "" "nothing to see here"))
(with-temp-buffer
(ert-info ((format "image with alt=%S" alt))
(let ((attrs (if alt (format " alt=\"%s\"" alt) "")))
(insert (format "<img src=\"file://%s\" %s" image attrs)))
(cl-letf* (;; Pretend we're a graphical display.
((symbol-function 'display-graphic-p) #'always)
((symbol-function 'url-queue-retrieve)
(lambda (&rest args)
(apply #'run-at-time 0 nil #'url-retrieve args)))
(put-image-calls 0)
(shr-put-image-function
(lambda (&rest args)
(cl-incf put-image-calls)
(apply #'shr-put-image args)))
(shr-width 80)
(shr-use-fonts nil)
(shr-image-animate nil)
(inhibit-message t)
(dom (libxml-parse-html-region (point-min) (point-max))))
;; Render the document.
(erase-buffer)
(shr-insert-document dom)
(shr-test-wait-for (lambda () (= put-image-calls 1)))
;; Now zoom the image.
(goto-char (point-min))
(shr-zoom-image)
(shr-test-wait-for (lambda () (= put-image-calls 2)))
;; Check that we got a sliced image.
(let ((slice-count 0))
(goto-char (point-min))
(while (< (point) (point-max))
(when-let ((display (get-text-property (point) 'display)))
;; If this is nil, we found a non-sliced image, but we
;; should have replaced that!
(should (assq 'slice display))
(cl-incf slice-count))
(goto-char (or (next-single-property-change (point) 'display)
(point-max))))
;; Make sure we actually saw a slice.
(should (> slice-count 1)))))))))
(require 'shr)
;;; shr-tests.el ends here