@item
@vindex gnus-ignored-from-addresses
-The @code{gnus-ignored-from-addresses} variable says when the @samp{%f}
-summary line spec returns the @code{To}, @code{Newsreader} or
-@code{From} header. If this regexp matches the contents of the
-@code{From} header, the value of the @code{To} or @code{Newsreader}
-headers are used instead.
+The @code{gnus-ignored-from-addresses} variable says when the
+@samp{%f} summary line spec returns the @code{To}, @code{Newsreader}
+or @code{From} header. The variable may be a regexp or a predicate
+function. If this matches the contents of the @code{From}
+header, the value of the @code{To} or @code{Newsreader} headers are
+used instead.
To distinguish regular articles from those where the @code{From} field
has been swapped, a string is prefixed to the @code{To} or
this, and Emacs supports it, then the images will be rescaled down to
fit these criteria.
+ @item gnus-article-show-cursor
+ @vindex gnus-article-show-cursor
+ If non-@code{nil}, display the cursor in the article buffer even when
+ the article buffer isn't the current buffer.
@end table
To use this, make sure that you have @code{w3m} and @code{curl}
When you add a new item, use the appropriate mark if you are sure it applies,
otherwise leave it unmarked.
+\f
+* Installation Changes in Emacs 25.2
+
+\f
+* Startup Changes in Emacs 25.2
+
+\f
+* Changes in Emacs 25.2
+
++++
+** The networking code has been reworked so that it's more
+asynchronous than it was (when specifying :nowait t in
+`make-network-process'). How asynchronous it is varies based on the
+capabilities of the system, but on a typical GNU/Linux system the DNS
+resolution, the connection, and (for TLS streams) the TLS negotiation
+are all done without blocking the main Emacs thread. To get
+asynchronous TLS, the TLS boot parameters have to be passed in (see
+the manual for details).
+
+Certain process oriented functions (like `process-datagram-address')
+will block until socket setup has been performed. The recommended way
+to deal with asynchronous sockets is to avoid interacting with them
+until they have changed status to "run". This is most easily done
+from a process sentinel.
+
+** It is possible to disable attempted recovery on fatal signals
+
+Two new variables allow to disable attempts to recover from stack
+overflow and to avoid automatic auto-save when Emacs is delivered a
+fatal signal. `attempt-stack-overflow-recovery', if set to `nil',
+will disable attempts to recover from C stack overflows; Emacs will
+then crash as with any other fatal signal.
+`attempt-orderly-shutdown-on-fatal-signal', if set to `nil', will
+disable attempts to auto-save the session and shut down in an orderly
+fashion when Emacs receives a fatal signal; instead, Emacs will
+terminate immediately. Both variables are non-`nil' by default.
+These variables are for users who would like to avoid the small
+probability of data corruption due to techniques Emacs uses to recover
+in these situations.
+
+\f
+* Editing Changes in Emacs 25.2
+
+\f
+* Changes in Specialized Modes and Packages in Emacs 25.2
+
+** eww
+
++++
+*** A new `s' command for switching to another eww buffer via the minibuffer.
+
++++
+** The commands that add ChangeLog entries now prefer a VCS root directory
+for the ChangeLog file, if none already exists. Customize
+`change-log-directory-files' to nil for the old behavior.
+
+---
+** Support for non-string values of `time-stamp-format' has been removed.
+
+** Tramp
+
++++
+*** New connection method "sg", which allows to edit files under
+different group ID.
+
++++
+*** New connection method "doas" for OpenBSD hosts.
+
+\f
+* New Modes and Packages in Emacs 25.2
+
+\f
+* Incompatible Lisp Changes in Emacs 25.2
+
+\f
+* Lisp Changes in Emacs 25.2
+
+** New var syntax-ppss-table to control the syntax-table used in syntax-ppss
+
+** Autoload files can be generated without timestamps,
+by setting `autoload-timestamps' to nil.
+
+\f
+* Changes in Emacs 25.2 on Non-Free Operating Systems
+
\f
* Installation Changes in Emacs 25.1
by default, and must be enabled by using the `--with-modules' option
at configure time.
++++
+** A second dir-local file (.dir-locals-2.el) is now accepted.
+See the variable `dir-locals-file-2' for more information.
+
+++
** Network security (TLS/SSL certificate validity and the like) is
added via the new Network Security Manager (NSM) and controlled via
the `network-security-level' variable.
+---
+** International domain names (IDNA) are now encoded via the new
+puny.el library, so that one can visit web sites like
+"http://méxico.icom.museum".
+
+++
** C-h l now also lists the commands that were run.
+** The new M-s M-w key binding uses eww to search the web for the
+text in the region.
+
+++
-** x-select-enable-clipboard is renamed select-enable-clipboard
-and x-select-enable-primary is renamed select-enable-primary.
+** The new `timer-list' command lists all active timers in a buffer
+where you can cancel them with the `c' command.
+
+** M-x suggests shorthands and ignores obsolete commands for completion.
+** x-select-enable-clipboard is renamed select-enable-clipboard.
+x-select-enable-primary and renamed select-enable-primary.
Additionally they both now apply to all systems (OSX, GNUstep, Windows, you
name it), with the proviso that on some systems (e.g. Windows)
select-enable-primary is ineffective since the system doesn't
** The option `even-window-heights' has been renamed to
`even-window-sizes' and now handles window widths as well.
++++
+** New function `read-multiple-choice' use to prompt for
+multiple-choice questions, with a handy way to display help texts.
+
+++
** terpri gets an optional arg ENSURE to conditionally output a newline.
hiding character but the default `.' can be used by let-binding the
variable `read-hide-char'.
-+++
-** The Emacs pseudo-random number generator can be securely seeded.
-On system where Emacs can access the system entropy or some other
-cryptographically secure random stream, it now uses that when `random'
-is called with its argument `t'. This allows cryptographically strong
-random values; in particular, the Emacs server now uses this facility
-to produce its authentication key.
-
---
** New input methods: `tamil-dvorak' and `programmer-dvorak'.
`erc-network-hide-list' and `erc-channel-hide-list' will only hide the
specified message types for the respective specified targets.
+*** New variable `erc-default-port-tls' used to connect to TLS IRC
+servers.
+
---
*** Reconnection is now asynchronous.
** Search and Replace
- +++
- *** New user option `search-default-mode'
- specifies the default mode for I-search.
-
+++
*** `isearch' and `query-replace' can now perform character folding in matches.
Isearch does that by default, while `query-replace' will do that if
those composed of multiple characters, as well as many other symbols
like ℀, ℁, ⒜, and ⓐ.
+ Character folding is enabled by customizing `search-default-mode' to
+ the value `character-fold-to-regexp'. If you want to turn character
+ folding off, customize the value of `search-default-mode' to the `nil'
+ value. You can also toggle character folding in the middle of a
+ search by typing `M-s ''.
+
+ +++
+ *** New user option `search-default-mode'.
+ This option specifies the default mode for Isearch. The default
+ value, `character-fold-to-regexp' specifies that Isearch should fold
+ characters when searching.
+
+++
*** New function `character-fold-to-regexp' can be used
by searching commands to produce a regexp matching anything that
whether to use variable-pitch fonts or not. The user can also
customize the `shr-use-fonts' variable.
++++
+*** A new command `C' (`eww-toggle-colors') can be used to toggle
+whether to use the HTML-specified colors or not. The user can also
+customize the `shr-use-colors' variable.
+
+++
*** A new command `R' (`eww-readable') will try do identify the main
textual parts of a web page and display only that, leaving menus and
the like off the page.
+---
+*** Images that are being loaded are now marked with grey
+"placeholder" images of the size specified by the HTML. They are then
+replaced by the real images asynchronously, which will also now
+respect width/height HTML specs (unless they specify widths/heights
+bigger than the current window).
+
---
*** You can now use several eww buffers in parallel by renaming eww
buffers you want to keep separate.
*** text/html messages that contain inline image parts will be
transformed into multipart/related messages before sending.
+---
+*** The `message-valid-fqdn-regexp' variable has been removed, since
+there are now top-level domains added all the time. Message will no
+longer warn about sending emails to top-level domains it hasn't heard
+about.
+
+*** `message-beginning-of-line' (bound to C-a) understands folded headers.
+In `visual-line-mode' it will look for the true beginning of a header
+while in non-`visual-line-mode' it will move the point to the indented
+header’s value.
+
+++
** In Show Paren Mode, a parenthesis can be highlighted when point
stands inside it, and certain parens can be highlighted when point is
** If gpg2 exists on the system, it is now used as the default value
of `epg-gpg-program' (instead of gpg).
+** Images
+
++++
+*** Images are automatically scaled before displaying based on the
+`image-scaling-factor' variable (if Emacs supports scaling the images
+in question).
+
++++
+*** Images inserted with `insert-image' and related functions get a
+keymap put into the text properties (or overlays) that span the
+image. This keymap binds keystrokes for manipulating size and
+rotation, as well as saving the image to a file.
+
++++
+*** A new library for creating and manipulating SVG images has been
+added. See the "SVG Images" section in the lispref manual for
+details.
+
++++
+*** New setf-able function to access and set image parameters is
+provided: `image-property'.
+
+
** Lisp mode
---
---
** New js.el option `js-indent-first-init'.
+It was renamed from `js-indent-first-initialiser', to avoid issues
+with American vs British spelling.
** Info
plist will contain a :peer element that has the output of
`gnutls-peer-status' (if Emacs is built with GnuTLS support).
++++
+*** The new function `url-cookie-delete-cookie' can be used to
+programmatically delete all cookies, or cookies from a specific
+domain.
+
** Tramp
+++
`dired-compress-files-alist' variable.
+++
+*** `W' is now bound to `browse-url-of-dired-file', and is useful for
+viewing HTML files and the like.
+
*** New user interface for the `A' and `Q' commands.
These keys, now bound to `dired-do-find-regexp' and
`dired-do-find-regexp-and-replace', work similarly to `xref-find-apropos'
minibuffer instead of a graphical dialog, depending on whether the gpg
command is called from Emacs (i.e., INSIDE_EMACS environment variable
is set). This feature requires newer versions of GnuPG (2.1.5 or
- later) and Pinentry (0.9.5 or later).
+ later) and Pinentry (0.9.5 or later). To use this feature, add
+ "allow-emacs-pinentry" to "~/.gnupg/gpg-agent.conf" and reload the
+ configuration with "gpgconf --reload gpg-agent".
+++
** cl-generic.el provides CLOS-style multiple-dispatch generic functions.
Removed font-lock-beginning-of-syntax-function and the SYNTAX-BEGIN
slot in font-lock-defaults.
-+++
-** The new implementation of Subword mode affects word movement everywhere.
-When Subword mode is turned on, `forward-word', `backward-word', and
-everything that uses them will move by sub-words, effectively
-overriding the buffer's syntax table. Lisp programs that shouldn't be
-affected by Subword mode should call the new functions
-`forward-word-strictly' and `backward-word-strictly' instead.
-
+++
** `package-initialize' now sets `package-enable-at-startup' to nil if
called during startup. Users who call this function in their init
systems and for MS-Windows, for other systems they fall back to their
counterparts `string-lessp' and `string-equal'.
++++
+** The new function `string-version-lessp' compares strings by
+interpreting consecutive runs of numerical characters as numbers, and
+compares their numerical values. According to this predicate,
+"foo2.png" is smaller than "foo12.png".
+
---
*** The ls-lisp package uses `string-collate-lessp' to sort file names.
The effect is that, on systems that use ls-lisp for Dired, the default
(require 'tabulated-list)
(require 'macroexp)
+(require 'url-handlers)
(defgroup package nil
"Manager for Emacs Lisp packages."
(defvar package--downloads-in-progress nil
"List of in-progress asynchronous downloads.")
- (declare-function epg-check-configuration "epg-config"
- (config &optional minimum-version))
- (declare-function epg-configuration "epg-config" ())
+ (declare-function epg-find-configuration "epg-config"
+ (protocol &optional force))
(declare-function epg-import-keys-from-file "epg" (context keys))
;;;###autoload
(let ((default-keyring (expand-file-name "package-keyring.gpg"
data-directory))
(inhibit-message async))
+ (if (get 'package-check-signature 'saved-value)
+ (when package-check-signature
+ (epg-find-configuration 'OpenPGP))
+ (setq package-check-signature
+ (if (epg-find-configuration 'OpenPGP)
+ 'allow-unsigned)))
(when (and package-check-signature (file-exists-p default-keyring))
(condition-case-unless-debug error
- (progn
- (epg-check-configuration (epg-configuration))
- (package-import-keyring default-keyring))
+ (package-import-keyring default-keyring)
(error (message "Cannot import default keyring: %S" (cdr error))))))
(package--download-and-read-archives async))
;; Fixme: This isn't the right thing for mixed graphical and non-graphical
;; frames in a session.
(defcustom gnus-article-x-face-command
- (if (featurep 'xemacs)
- (if (or (gnus-image-type-available-p 'xface)
- (gnus-image-type-available-p 'pbm))
- 'gnus-display-x-face-in-from
- "{ echo \
+ (if (gnus-image-type-available-p 'pbm)
+ 'gnus-display-x-face-in-from
+ "{ echo \
'/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\
-; uncompface; } | icontopbm | ee -")
- (if (gnus-image-type-available-p 'pbm)
- 'gnus-display-x-face-in-from
- "{ echo \
-'/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\
-; uncompface; } | icontopbm | display -"))
+; uncompface; } | icontopbm | display -")
"*String or function to be executed to display an X-Face header.
If it is a string, the command will be executed in a sub-shell
asynchronously. The compressed face will be piped to this command."
Example: (_/*word*/_)."
:group 'gnus-article-emphasis)
-(defface gnus-emphasis-strikethru (if (featurep 'xemacs)
- '((t (:strikethru t)))
- '((t (:strike-through t))))
+(defface gnus-emphasis-strikethru '((t (:strike-through t)))
"Face used for displaying strike-through text (-word-)."
:group 'gnus-article-emphasis)
(item :tag "never" nil)
(sexp :tag "once" :format "%t\n" :value t)))
+ (defcustom gnus-article-show-cursor nil
+ "If non-nil, show the cursor in the Article buffer even when not selected."
+ :version "25.1"
+ :group 'gnus-article
+ :type 'bool)
+
(defcustom gnus-saved-headers gnus-visible-headers
"Headers to keep if `gnus-save-all-headers' is nil.
If `gnus-save-all-headers' is non-nil, this variable will be ignored.
:type 'hook
:group 'gnus-article-various)
-(when (featurep 'xemacs)
- ;; Extracted from gnus-xmas-define in order to preserve user settings
- (when (fboundp 'turn-off-scroll-in-place)
- (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
- ;; Extracted from gnus-xmas-redefine in order to preserve user settings
- (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
-
(defcustom gnus-article-menu-hook nil
"*Hook run after the creation of the article mode menu."
:type 'hook
(item :tag "skip" nil)
(face :value default)))))
-(defcustom gnus-face-properties-alist (if (featurep 'xemacs)
- '((xface . (:face gnus-x-face)))
- '((pbm . (:face gnus-x-face))
- (png . nil)))
+(defcustom gnus-face-properties-alist '((pbm . (:face gnus-x-face))
+ (png . nil))
"Alist of image types and properties applied to Face and X-Face images.
Here are examples:
See the manual for the valid properties for various image types.
Currently, `pbm' is used for X-Face images and `png' is used for Face
-images in Emacs. Only the `:face' property is effective on the `xface'
-image type in XEmacs if it is built with the libcompface library."
+images in Emacs."
:version "23.1" ;; No Gnus
:group 'gnus-article-headers
:type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
(defcustom gnus-treat-display-x-face
(and (not noninteractive)
(gnus-image-type-available-p 'xbm)
- (if (featurep 'xemacs)
- (featurep 'xface)
- (condition-case nil
- (and (string-match "^0x" (shell-command-to-string "uncompface"))
- (executable-find "icontopbm"))
- ;; shell-command-to-string may signal an error, e.g. if
- ;; shell-file-name is not found.
- (error nil)))
+ (condition-case nil
+ (and (string-match "^0x" (shell-command-to-string "uncompface"))
+ (executable-find "icontopbm"))
+ ;; shell-command-to-string may signal an error, e.g. if
+ ;; shell-file-name is not found.
+ (error nil))
'head)
"Display X-Face headers.
Valid values are nil and `head'.
(- gnus-article-normalized-header-length column)
? )))
((> column gnus-article-normalized-header-length)
- (gnus-put-text-property
+ (put-text-property
(progn
(forward-char gnus-article-normalized-header-length)
(point))
"Translate many Unicode characters into their ASCII equivalents."
(interactive)
(require 'org-entities)
- (let ((table (make-char-table (if (featurep 'xemacs) 'generic))))
+ (let ((table (make-char-table nil)))
(dolist (elem org-entities)
(when (and (listp elem)
(= (length (nth 6 elem)) 1))
- (if (featurep 'xemacs)
- (put-char-table (aref (nth 6 elem) 0) (nth 4 elem) table)
- (set-char-table-range table (aref (nth 6 elem) 0) (nth 4 elem)))))
+ (set-char-table-range table (aref (nth 6 elem) 0) (nth 4 elem))))
(save-excursion
(when (article-goto-body)
(let ((inhibit-read-only t)
replace props)
(while (not (eobp))
- (if (not (setq replace (if (featurep 'xemacs)
- (get-char-table (following-char) table)
- (aref table (following-char)))))
+ (if (not (setq replace (aref table (following-char))))
(forward-char 1)
(if (prog1
(setq props (text-properties-at (point)))
(setq truncate-lines nil))
((numberp arg)
(setq truncate-lines t)))
- ;; In versions of Emacs 22 (CVS) before 2006-05-26,
- ;; `toggle-truncate-lines' needs an argument.
(toggle-truncate-lines)))
(defun gnus-article-treat-body-boundary ()
(goto-char (point-max))
(let ((start (point)))
(insert "X-Boundary: ")
- (gnus-add-text-properties start (point) gnus-hidden-properties)
+ (add-text-properties start (point) gnus-hidden-properties)
(insert (let (str (max (window-width)))
- (if (featurep 'xemacs)
- (setq max (1- max)))
(while (>= max (length str))
(setq str (concat str gnus-body-boundary-delimiter)))
(substring str 0 max))
"\n")
- (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
+ (put-text-property start (point) 'gnus-decoration 'header)))))
(defun article-fill-long-lines ()
"Fill lines that are wider than the window width."
;; The command is a string, so we interpret the command
;; as a, well, command, and fork it off.
(let ((process-connection-type nil))
- (gnus-set-process-query-on-exit-flag
+ (set-process-query-on-exit-flag
(start-process
"article-x-face" nil shell-file-name
shell-command-switch gnus-article-x-face-command)
ctl (and ct (mail-header-parse-content-type ct))
charset (cond
(prompt
- (mm-read-coding-system "Charset to decode: "))
+ (read-coding-system "Charset to decode: "))
(ctl
(mail-content-type-get ctl 'charset)))
format (and ctl (mail-content-type-get ctl 'format)))
(if (stringp charset)
(setq charset (intern (downcase charset)))))))
(if read-charset
- (setq charset (mm-read-coding-system "Charset: " charset)))
+ (setq charset (read-coding-system "Charset: " charset)))
(unless charset
(setq charset gnus-newsgroup-charset))
(when (or force
(if (stringp charset)
(setq charset (intern (downcase charset)))))))
(if read-charset
- (setq charset (mm-read-coding-system "Charset: " charset)))
+ (setq charset (read-coding-system "Charset: " charset)))
(unless charset
(setq charset gnus-newsgroup-charset))
(when (or force
(save-restriction
(narrow-to-region (point) (point-max))
(base64-decode-region (point-min) (point-max))
- (mm-decode-coding-region
+ (decode-coding-region
(point-min) (point-max)
(mm-charset-to-coding-system charset nil t)))))))
-(eval-when-compile
- (require 'rfc1843))
+(declare-function rfc1843-decode-region "rfc1843" (from to))
(defun article-decode-HZ ()
"Translate a HZ-encoded article."
(while (re-search-forward
"\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
(replace-match "\\1\\3" t)))
- (when (gmm-called-interactively-p 'any)
+ (when (called-interactively-p 'any)
(gnus-treat-article nil))))
(defun article-wash-html ()
(cond ((file-directory-p file)
(when (or (not (eq how 'file))
(gnus-y-or-n-p
- (gnus-format-message
+ (format-message
"Delete temporary HTML file(s) in directory `%s'? "
(file-name-as-directory file))))
(gnus-delete-directory file)))
<img[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\""
nil t)
(unless cid-dir
- (setq cid-dir (mm-make-temp-file "cid" t))
+ (setq cid-dir (make-temp-file "cid" t))
(add-to-list 'gnus-article-browse-html-temp-list cid-dir))
(setq file nil
content nil)
(replace-match cid-file nil nil nil 1))))
(unless content (setq content (buffer-string))))
(when (or charset header (not file))
- (setq tmp-file (mm-make-temp-file
+ (setq tmp-file (make-temp-file
;; Do we need to care for 8.3 filenames?
"mm-" nil ".html")))
;; Add a meta html tag to specify charset and a header.
;; charset specified in parts might be different.
(if (eq charset 'gnus-decoded)
(setq charset 'utf-8
- eheader (mm-encode-coding-string (buffer-string)
- charset)
+ eheader (encode-coding-string (buffer-string)
+ charset)
title (when title
- (mm-encode-coding-string title charset))
- body (mm-encode-coding-string content charset))
+ (encode-coding-string title charset))
+ body (encode-coding-string content charset))
(setq hcharset (mm-find-mime-charset-region (point-min)
(point-max)))
(cond ((= (length hcharset) 1)
(mm-charset-to-coding-system charset
nil t))
(if (eq coding body)
- (setq eheader (mm-encode-coding-string
+ (setq eheader (encode-coding-string
(buffer-string) coding)
title (when title
- (mm-encode-coding-string
+ (encode-coding-string
title coding))
body content)
(setq charset 'utf-8
- eheader (mm-encode-coding-string
+ eheader (encode-coding-string
(buffer-string) charset)
title (when title
- (mm-encode-coding-string
+ (encode-coding-string
title charset))
- body (mm-encode-coding-string
- (mm-decode-coding-string
+ body (encode-coding-string
+ (decode-coding-string
content body)
charset))))
(setq charset hcharset
- eheader (mm-encode-coding-string
+ eheader (encode-coding-string
(buffer-string) coding)
title (when title
- (mm-encode-coding-string
+ (encode-coding-string
title coding))
body content))
- (setq eheader (mm-string-as-unibyte (buffer-string))
+ (setq eheader (string-as-unibyte (buffer-string))
body content)))
(erase-buffer)
(mm-disable-multibyte)
(charset
(mm-with-unibyte-buffer
(insert (if (eq charset 'gnus-decoded)
- (mm-encode-coding-string content
- (setq charset 'utf-8))
+ (encode-coding-string content
+ (setq charset 'utf-8))
content))
(if (or (mm-add-meta-html-tag handle charset)
(not file))
(setq command
(if (and (eq command 'default) default)
default
- (gnus-read-shell-command "Shell command on this article: "
- default))))
+ (read-shell-command "Shell command on this article: " default))))
(when (string-equal command "")
(if default
(setq command default)
(put-text-property (match-end 0) (point-max)
'face eface)))))))))
-(autoload 'canlock-verify "canlock" nil t) ;; for XEmacs.
-
(defun article-verify-cancel-lock ()
"Verify Cancel-Lock header."
(interactive)
'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
(defvar gnus-article-send-map)
-
(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map)
- "W" gnus-article-wide-reply-with-original)
-(if (featurep 'xemacs)
- (set-keymap-default-binding gnus-article-send-map
- 'gnus-article-read-summary-send-keys)
- (define-key gnus-article-send-map [t] 'gnus-article-read-summary-send-keys))
+ "W" gnus-article-wide-reply-with-original
+ [t] 'gnus-article-read-summary-send-keys)
(defun gnus-article-make-menu-bar ()
(unless (boundp 'gnus-article-commands-menu)
(make-local-variable 'gnus-article-ignored-charsets)
(set (make-local-variable 'bookmark-make-record-function)
'gnus-summary-bookmark-make-record)
- ;; Prevent Emacs 22 from displaying non-break space with `nobreak-space'
- ;; face.
+ ;; Prevent Emacs from displaying non-break space with
+ ;; `nobreak-space' face.
(set (make-local-variable 'nobreak-char-display) nil)
;; Enable `gnus-article-remove-images' to delete images shr.el renders.
(set (make-local-variable 'shr-put-image-function) 'gnus-shr-put-image)
- (setq cursor-in-non-selected-windows nil)
+ (unless gnus-article-show-cursor
+ (setq cursor-in-non-selected-windows nil))
(gnus-set-default-directory)
(buffer-disable-undo)
(setq buffer-read-only t
(defun gnus-article-stop-animations ()
(dolist (timer (and (boundp 'timer-list)
timer-list))
- (when (eq (gnus-timer--function timer) 'image-animate-timeout)
+ (when (eq (timer--function timer) 'image-animate-timeout)
(cancel-timer timer))))
(defun gnus-stop-downloads ()
(gnus-article-setup-buffer)
(set-buffer gnus-article-buffer)
;; Deactivate active regions.
- (when (and (boundp 'transient-mark-mode)
- transient-mark-mode)
+ (when transient-mark-mode
(setq mark-active nil))
(if (not (setq result (let ((inhibit-read-only t))
(gnus-request-article-this-buffer
(defvar gnus-mime-button-map
(let ((map (make-sparse-keymap)))
- (define-key map gnus-mouse-2 'gnus-article-push-button)
- (define-key map gnus-down-mouse-3 'gnus-mime-button-menu)
+ (define-key map [mouse-2] 'gnus-article-push-button)
+ (define-key map [down-mouse-3] 'gnus-mime-button-menu)
(dolist (c gnus-mime-button-commands)
(define-key map (cadr c) (car c)))
map))
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl)
(set (make-local-variable 'mml-buffer-list) mbl1))
- (gnus-make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
`(lambda (no-highlight)
(let ((mail-parse-charset (or gnus-article-charset
((numberp arg)
(setq charset (or (cdr (assq arg
gnus-summary-show-article-charset-alist))
- (mm-read-coding-system "Charset: ")))))
+ (read-coding-system "Charset: ")))))
(switch-to-buffer (generate-new-buffer filename))
(if (or coding-system
(and charset
(not (eq coding-system 'ascii))))
(progn
(mm-enable-multibyte)
- (insert (mm-decode-coding-string contents coding-system))
- (setq buffer-file-coding-system
- (if (boundp 'last-coding-system-used)
- (symbol-value 'last-coding-system-used)
- coding-system)))
+ (insert (decode-coding-string contents coding-system))
+ (setq buffer-file-coding-system last-coding-system-used))
(mm-disable-multibyte)
(insert contents)
(setq buffer-file-coding-system mm-binary-coding-system))
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(contents (and handle (mm-get-part handle)))
- (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory)))
+ (file (make-temp-file (expand-file-name "mm." mm-tmp-directory)))
(printer (mailcap-mime-info (mm-handle-media-type handle) "print")))
(when contents
(if printer
(let ((displayed-p (mm-handle-displayed-p handle)))
(gnus-insert-mime-button handle (get-text-property btn 'gnus-part)
(list displayed-p))
- (if (featurep 'emacs)
- (delete-region
- (point)
- (next-single-property-change (point) 'gnus-data nil (point-max)))
- (let* ((end (next-single-property-change (point) 'gnus-data))
- (annots (annotations-at (or end (point-max)))))
- (delete-region (point)
- (if end
- (if annots (1+ end) end)
- (point-max)))
- (dolist (annot annots)
- (set-extent-endpoints annot (point) (point)))))
+ (delete-region
+ (point)
+ (next-single-property-change (point) 'gnus-data nil (point-max)))
(setq start (point))
(if (search-backward "\n\n" nil t)
(progn
(or (cdr (assq
arg
gnus-summary-show-article-charset-alist))
- (mm-read-coding-system "Charset: "))))
+ (read-coding-system "Charset: "))))
(if (mm-handle-undisplayer handle)
(mm-remove-part handle)))
(gnus-mime-set-charset-parameters handle charset)
window
(setq window (selected-window))
;; Article may be displayed in the other frame.
- (gnus-select-frame-set-input-focus
+ (select-frame-set-input-focus
(prog1
frame
(setq frame (selected-frame))))))
(get-text-property (point) 'gnus-data))))
(set-marker overlay-arrow-position nil)
(unless gnus-auto-select-part
- (gnus-select-frame-set-input-focus frame)
+ (select-frame-set-input-focus frame)
(select-window window))))
t))
(if gnus-inhibit-mime-unbuttonizing
;; Toggle the button appearance between `[button]...' and `[button]'.
(let ((displayed-p (mm-handle-displayed-p handle)))
(gnus-insert-mime-button handle id (list displayed-p))
- (if (featurep 'emacs)
- (delete-region
- (point)
- (next-single-property-change (point) 'gnus-data nil (point-max)))
- (let* ((end (next-single-property-change (point) 'gnus-data))
- (annots (annotations-at (or end (point-max)))))
- (delete-region (point)
- (if end
- (if annots (1+ end) end)
- (point-max)))
- (dolist (annot annots)
- (set-extent-endpoints annot (point) (point)))))
+ (delete-region
+ (point)
+ (next-single-property-change (point) 'gnus-data nil (point-max)))
(setq start (point))
(if (search-backward "\n\n" nil t)
(progn
:button-keymap gnus-mime-button-map
:help-echo
(lambda (widget)
- ;; Needed to properly clear the message due to a bug in
- ;; wid-edit (XEmacs only).
- (if (boundp 'help-echo-owns-message)
- (setq help-echo-owns-message t))
(format
"%S: %s the MIME part; %S: more options"
- (aref gnus-mouse-2 0)
+ 'mouse-2
(if (mm-handle-displayed-p (widget-get widget :mime-handle))
"hide" "show")
- (aref gnus-down-mouse-3 0))))))
+ 'down-mouse-3)))))
(defun gnus-widget-press-button (elems _el)
(goto-char (widget-get elems :from))
(defun gnus-article-insert-newline ()
"Insert a newline, but mark it as undeletable."
- (gnus-put-text-property
- (point) (progn (insert "\n") (point)) 'gnus-undeletable t))
+ (put-text-property (point) (progn (insert "\n") (point)) 'gnus-undeletable t))
(defun gnus-mime-display-alternative (handles &optional preferred ibegend id)
(let* ((preferred (or preferred (mm-preferred-alternative handles)))
(not preferred)
(not (gnus-unbuttonized-mime-type-p
"multipart/alternative")))
- (gnus-add-text-properties
+ (add-text-properties
(setq from (point))
(progn
(insert (format "%d. " id))
(gnus-mime-display-alternative
',ihandles ',not-pref ',begend ,id))
keymap ,gnus-mime-button-map
- ,gnus-mouse-face-prop ,gnus-article-mouse-face
+ mouse-face ,gnus-article-mouse-face
face ,gnus-article-button-face
gnus-part ,id
article-type multipart
rear-nonsticky t))
(widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button
- :button-keymap gnus-widget-button-keymap)
+ :action 'gnus-widget-press-button)
;; Do the handles
(while (setq handle (pop handles))
- (gnus-add-text-properties
+ (add-text-properties
(setq from (point))
(progn
(insert (format "(%c) %-18s"
(gnus-mime-display-alternative
',ihandles ',handle ',begend ,id))
keymap ,gnus-mime-button-map
- ,gnus-mouse-face-prop ,gnus-article-mouse-face
+ mouse-face ,gnus-article-mouse-face
face ,gnus-article-button-face
gnus-part ,id
gnus-data ,handle
rear-nonsticky t))
(widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button
- :button-keymap gnus-widget-button-keymap)
+ :action 'gnus-widget-press-button)
(insert " "))
(insert "\n\n"))
(when preferred
(not (with-current-buffer gnus-summary-buffer
gnus-have-all-headers)))
(not gnus-inhibit-hiding))
- (gnus-article-hide-headers)))
+ (article-hide-headers)))
(declare-function shr-put-image "shr" (data alt &optional flags))
(when coding
;; If the coding system is not suitable to encode the text,
;; ask a user for a proper one.
- (when (fboundp 'select-safe-coding-system)
- (setq coding (coding-system-base
- (save-window-excursion
- (select-safe-coding-system (point-min) (point-max)
- coding))))
- (setq coding-system-for-write
- (or (cdr (assq coding '((mule-utf-8 . utf-8))))
- coding)))
+ (setq coding (coding-system-base
+ (save-window-excursion
+ (select-safe-coding-system (point-min) (point-max)
+ coding))))
+ (setq coding-system-for-write
+ (or (cdr (assq coding '((mule-utf-8 . utf-8))))
+ coding))
(goto-char (point-min))
;; Add the coding cookie.
(insert (format "X-Gnus-Coding-System: -*- coding: %s; -*-\n\n"
(interactive)
(when (gnus-article-next-page)
(goto-char (point-min))
- (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))))
+ (gnus-article-read-summary-keys nil ?n)))
(defun gnus-article-goto-prev-page ()
"Show the previous page of the article."
(interactive)
(if (save-restriction (widen) (bobp)) ;; Real beginning-of-buffer?
- (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
+ (gnus-article-read-summary-keys nil ?p)
(gnus-article-prev-page nil)))
;; This is cleaner but currently breaks `gnus-pick-mode':
If end of article, return non-nil. Otherwise return nil.
Argument LINES specifies lines to be scrolled up."
(interactive "p")
- (move-to-window-line (if (featurep 'xemacs) -1 (- -1 scroll-margin)))
+ (move-to-window-line (- -1 scroll-margin))
(if (and (not (and gnus-article-over-scroll
(> (count-lines (window-start) (point-max))
- (if (featurep 'xemacs)
- (or lines (1- (window-height)))
- (+ (or lines (1- (window-height))) scroll-margin)))))
+ (+ (or lines (1- (window-height))) scroll-margin))))
(save-excursion
(end-of-line)
(and (pos-visible-in-window-p) ;Not continuation line.
(defun gnus-article-beginning-of-window ()
"Move point to the beginning of the window.
-In Emacs, the point is placed at the line number which `scroll-margin'
+The point is placed at the line number which `scroll-margin'
specifies."
- (if (featurep 'xemacs)
- (move-to-window-line 0)
- ;; There is an obscure bug in Emacs that makes it impossible to
- ;; scroll past big pictures in the article buffer. Try to fix
- ;; this by adding a sanity check by counting the lines visible.
- (when (> (count-lines (window-start) (window-end)) 30)
- (move-to-window-line
- (min (max 0 scroll-margin)
- (max 1 (- (window-height)
- (if mode-line-format 1 0)
- (if header-line-format 1 0)
- 2)))))))
+ ;; There is an obscure bug in Emacs that makes it impossible to
+ ;; scroll past big pictures in the article buffer. Try to fix
+ ;; this by adding a sanity check by counting the lines visible.
+ (when (> (count-lines (window-start) (window-end)) 30)
+ (move-to-window-line
+ (min (max 0 scroll-margin)
+ (max 1 (- (window-height)
+ (if mode-line-format 1 0)
+ (if header-line-format 1 0)
+ 2))))))
(defvar scroll-in-place)
(goto-char (point-max))
(recenter (if gnus-article-over-scroll
(if lines
- (max (if (featurep 'xemacs)
- lines
- (+ lines scroll-margin))
- 3)
+ (max (+ lines scroll-margin) 3)
(- (window-height) 2))
-1)))
(prog1
(let (gnus-pick-mode)
(setq unread-command-events (nconc unread-command-events
(list (or key last-command-event)))
- keys (if (featurep 'xemacs)
- (events-to-keys (read-key-sequence nil t))
- (read-key-sequence nil t)))))
+ keys (read-key-sequence nil t))))
(message "")
(article 1.0)))))))
(gnus-configure-windows 'article))
(setq win (get-buffer-window summary-buffer 'visible)))
- (gnus-select-frame-set-input-focus (window-frame win))
+ (select-frame-set-input-focus (window-frame win))
(select-window win))))
(setq in-buffer (current-buffer))
;; We disable the pick minor mode commands.
(defun gnus-article-read-summary-send-keys ()
(interactive)
- (let ((unread-command-events (list (gnus-character-to-event ?S))))
+ (let ((unread-command-events (list ?S)))
(gnus-article-read-summary-keys)))
(defun gnus-article-describe-key (key)
"Display documentation of the function invoked by KEY.
KEY is a string or a vector."
- (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs.
+ (interactive (list (let ((cursor-in-echo-area t))
(read-key-sequence "Describe key: "))))
(gnus-article-check-buffer)
(if (memq (key-binding key t) '(gnus-article-read-summary-keys
gnus-article-read-summary-send-keys))
(with-current-buffer gnus-article-current-summary
(setq unread-command-events
- (if (featurep 'xemacs)
- (append key unread-command-events)
- (nconc
- (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
- (list 'meta (- x 128))
- x))
- key)
- unread-command-events)))
+ (nconc
+ (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
+ (list 'meta (- x 128))
+ x))
+ key)
+ unread-command-events))
(let ((cursor-in-echo-area t)
gnus-pick-mode)
(describe-key (read-key-sequence nil t))))
(defun gnus-article-describe-key-briefly (key &optional insert)
"Display documentation of the function invoked by KEY.
KEY is a string or a vector."
- (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs.
+ (interactive (list (let ((cursor-in-echo-area t))
(read-key-sequence "Describe key: "))
current-prefix-arg))
(gnus-article-check-buffer)
gnus-article-read-summary-send-keys))
(with-current-buffer gnus-article-current-summary
(setq unread-command-events
- (if (featurep 'xemacs)
- (append key unread-command-events)
- (nconc
- (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
- (list 'meta (- x 128))
- x))
- key)
- unread-command-events)))
+ (nconc
+ (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
+ (list 'meta (- x 128))
+ x))
+ key)
+ unread-command-events))
(let ((cursor-in-echo-area t)
gnus-pick-mode)
(describe-key-briefly (read-key-sequence nil t) insert)))
(interactive)
(let ((article (cdr gnus-article-current))
contents)
- (if (not (gnus-region-active-p))
+ (if (not (and transient-mark-mode mark-active))
(with-current-buffer gnus-summary-buffer
(gnus-summary-reply (list (list article)) wide))
(setq contents (buffer-substring (point) (mark t)))
;; Deactivate active regions.
- (when (and (boundp 'transient-mark-mode)
- transient-mark-mode)
+ (when transient-mark-mode
(setq mark-active nil))
(with-current-buffer gnus-summary-buffer
(gnus-summary-reply
(interactive)
(let ((article (cdr gnus-article-current))
contents)
- (if (not (gnus-region-active-p))
+ (if (not (and transient-mark-mode mark-active))
(with-current-buffer gnus-summary-buffer
(gnus-summary-followup (list (list article))))
(setq contents (buffer-substring (point) (mark t)))
;; Deactivate active regions.
- (when (and (boundp 'transient-mark-mode)
- transient-mark-mode)
+ (when transient-mark-mode
(setq mark-active nil))
(with-current-buffer gnus-summary-buffer
(gnus-summary-followup
hidden.
If given a prefix, show the hidden text instead."
(interactive (append (gnus-article-hidden-arg) (list 'force)))
- (gnus-article-hide-headers arg)
- (gnus-article-hide-list-identifiers arg)
- (gnus-article-hide-citation-maybe arg force)
- (gnus-article-hide-signature arg))
+ (gnus-with-article-buffer
+ (article-hide-headers arg)
+ (article-hide-list-identifiers)
+ (gnus-article-hide-citation-maybe arg force)
+ (article-hide-signature arg)))
(defun gnus-check-group-server ()
;; Make sure the connection to the server is alive.
;; equivalent of string-make-multibyte which amount to decoding
;; with locale-coding-system, causing failure of
;; subsequent decoding.
- (insert (mm-string-to-multibyte
+ (insert (string-to-multibyte
(with-current-buffer gnus-original-article-buffer
(buffer-substring (point-min) (point-max)))))
'article)
(when (and (not force)
(gnus-group-read-only-p))
(error "The current newsgroup does not support article editing"))
- (gnus-article-date-original)
+ (gnus-with-article-buffer
+ (article-date-original))
(gnus-article-edit-article
'ignore
`(lambda (no-highlight)
"\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|"
"nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)"
"\\(//[-a-z0-9_.]+:[0-9]*\\)?"
- (if (string-match "[[:digit:]]" "1") ;; Support POSIX?
- (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
- (punct "!?:;.,"))
- (concat
- "\\(?:"
- ;; Match paired parentheses, e.g. in Wikipedia URLs:
- ;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com
- "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)"
- "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?"
- "\\|"
- "[" chars punct "]+" "[" chars "]"
- "\\)"))
- (concat ;; XEmacs 21.4 doesn't support POSIX.
- "\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+"
- "\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)"))
+ (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
+ (punct "!?:;.,"))
+ (concat
+ "\\(?:"
+ ;; Match paired parentheses, e.g. in Wikipedia URLs:
+ ;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com
+ "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)"
+ "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?"
+ "\\|"
+ "[" chars punct "]+" "[" chars "]"
+ "\\)"))
"\\)")
"Regular expression that matches URLs."
:version "24.4"
:group 'gnus-article-buttons
:type 'regexp)
-(defcustom gnus-button-valid-fqdn-regexp
- message-valid-fqdn-regexp
+(defcustom gnus-button-valid-fqdn-regexp "\\([-A-Za-z0-9]+\\.\\)+[A-Za-z]+"
"Regular expression that matches a valid FQDN."
- :version "22.1"
+ :version "25.2"
:group 'gnus-article-buttons
:type 'regexp)
(list gnus-button-mid-or-mail-heuristic-alist)
(result 0) rate regexp lpartlen elem)
(setq lpartlen
- (length (gnus-replace-in-string mid-or-mail "^\\(.*\\)@.*$" "\\1")))
+ (length (replace-regexp-in-string "^\\(.*\\)@.*$" "\\1" mid-or-mail)))
(gnus-message 8 "`%s', length of local part=`%s'." mid-or-mail lpartlen)
;; Certain special cases...
(when (string-match
(setq guessed
;; get rid of surrounding angles...
(funcall pref
- (gnus-replace-in-string mid-or-mail "^<\\|>$" "")))
+ (replace-regexp-in-string "^<\\|>$" "" mid-or-mail)))
(if (or (eq 'mid guessed) (eq 'mail guessed))
(setq pref guessed)
(setq pref 'ask)))
"Call `describe-function' when pushing the corresponding URL button."
(describe-function
(intern
- (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))))
+ (replace-regexp-in-string gnus-button-handle-describe-prefix "" url))))
(defun gnus-button-handle-describe-variable (url)
"Call `describe-variable' when pushing the corresponding URL button."
(describe-variable
(intern
- (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))))
+ (replace-regexp-in-string gnus-button-handle-describe-prefix "" url))))
(defun gnus-button-handle-symbol (url)
"Display help on variable or function.
(defun gnus-button-handle-describe-key (url)
"Call `describe-key' when pushing the corresponding URL button."
(let* ((key-string
- (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))
+ (replace-regexp-in-string gnus-button-handle-describe-prefix "" url))
(keys (ignore-errors (eval `(kbd ,key-string)))))
(if keys
(describe-key keys)
(defun gnus-button-handle-apropos (url)
"Call `apropos' when pushing the corresponding URL button."
- (apropos (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
+ (apropos (replace-regexp-in-string gnus-button-handle-describe-prefix "" url)))
(defun gnus-button-handle-apropos-command (url)
"Call `apropos' when pushing the corresponding URL button."
(apropos-command
- (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
+ (replace-regexp-in-string gnus-button-handle-describe-prefix "" url)))
(defun gnus-button-handle-apropos-variable (url)
"Call `apropos' when pushing the corresponding URL button."
- (funcall
- (if (fboundp 'apropos-variable) 'apropos-variable 'apropos)
- (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
+ (apropos-variable
+ (replace-regexp-in-string gnus-button-handle-describe-prefix "" url)))
(defun gnus-button-handle-apropos-documentation (url)
"Call `apropos' when pushing the corresponding URL button."
- (funcall
- (if (fboundp 'apropos-documentation) 'apropos-documentation 'apropos)
- (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
+ (apropos-documentation
+ (replace-regexp-in-string gnus-button-handle-describe-prefix "" url)))
(defun gnus-button-handle-library (url)
"Call `locate-library' when pushing the corresponding URL button."
(gnus-message 9 "url=`%s'" url)
(let* ((lib (locate-library url))
- (file (gnus-replace-in-string (or lib "") "\\.elc" ".el")))
+ (file (replace-regexp-in-string "\\.elc" ".el" (or lib ""))))
(if (not lib)
(gnus-message 1 "Cannot locale library `%s'." url)
(find-file-read-only file))))
(when (and header-face
(not (memq (point) hpoints)))
(push (point) hpoints)
- (gnus-put-text-property from (point) 'face header-face))
+ (put-text-property from (point) 'face header-face))
(when (and field-face
(not (memq (setq from (point)) fpoints)))
(push from fpoints)
(if (re-search-forward "^[^ \t]" nil t)
(forward-char -2)
(goto-char (point-max)))
- (gnus-put-text-property from (point) 'face field-face)))))))
+ (put-text-property from (point) 'face field-face)))))))
(defun gnus-article-highlight-signature ()
"Highlight the signature in an article.
(gnus-article-extend-url-button from start end))
(gnus-article-add-button start end
'gnus-button-push (list from entry))
- (gnus-put-text-property
+ (put-text-property
start end
'gnus-string (buffer-substring-no-properties
start end))))))))))
(when gnus-article-button-face
(overlay-put (make-overlay from to nil t)
'face gnus-article-button-face))
- (gnus-add-text-properties
+ (add-text-properties
from to
(nconc (and gnus-article-mouse-face
- (list gnus-mouse-face-prop gnus-article-mouse-face))
+ (list 'mouse-face gnus-article-mouse-face))
(list 'gnus-callback fun)
(and data (list 'gnus-data data))))
(widget-convert-button 'link from to :action 'gnus-widget-press-button
:help-echo (or text "Follow the link")
- :keymap gnus-url-button-map
- :button-keymap gnus-widget-button-keymap))
+ :keymap gnus-url-button-map))
(defun gnus-article-copy-string ()
"Copy the string in the button to the kill ring."
"Fetch a man page."
(gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
(when (eq gnus-button-man-handler 'woman)
- (setq url (gnus-replace-in-string url "([1-9][X1a-z]*).*\\'" "")))
+ (setq url (replace-regexp-in-string "([1-9][X1a-z]*).*\\'" "" url)))
(gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
(funcall gnus-button-man-handler url))
(defun gnus-button-handle-info-url (url)
"Fetch an info URL."
- (setq url (mm-subst-char-in-string ?+ ?\ url))
+ (setq url (subst-char-in-string ?+ ?\ url))
(cond
((string-match "^\\([^:/]+\\)?/\\(.*\\)" url)
(gnus-info-find-node
")" (gnus-url-unhex-string (match-string 2 url)))))
((string-match "([^)\"]+)[^\"]+" url)
(setq url
- (gnus-replace-in-string
- (gnus-replace-in-string url "[\n\t ]+" " ") "\"" ""))
+ (replace-regexp-in-string
+ "\"" "" (replace-regexp-in-string "[\n\t ]+" " " url)))
(gnus-info-find-node url))
(t (error "Can't parse %s" url))))
(defun gnus-button-handle-info-url-gnome (url)
"Fetch GNOME style info URL."
- (setq url (mm-subst-char-in-string ?_ ?\ url))
+ (setq url (subst-char-in-string ?_ ?\ url))
(if (string-match "\\([^#]+\\)#?\\(.*\\)" url)
(gnus-info-find-node
(concat "("
(if (fboundp func)
(funcall func)
(message-position-on-field (caar args)))
- (insert (gnus-replace-in-string
- (mapconcat 'identity (reverse (cdar args)) ", ")
- "\r\n" "\n" t))
+ (insert (replace-regexp-in-string
+ "\r\n" "\n"
+ (mapconcat 'identity (reverse (cdar args)) ", ") nil t))
(setq args (cdr args)))
(if subject
(message-goto-body)
(defvar gnus-prev-page-map
(let ((map (make-sparse-keymap)))
- (define-key map gnus-mouse-2 'gnus-button-prev-page)
+ (define-key map [mouse-2] 'gnus-button-prev-page)
(define-key map "\r" 'gnus-button-prev-page)
map))
(defvar gnus-next-page-map
(let ((map (make-sparse-keymap)))
- (define-key map gnus-mouse-2 'gnus-button-next-page)
+ (define-key map [mouse-2] 'gnus-button-next-page)
(define-key map "\r" 'gnus-button-next-page)
map))
(defvar gnus-mime-security-button-map
(let ((map (make-sparse-keymap)))
- (define-key map gnus-mouse-2 'gnus-article-push-button)
- (define-key map gnus-down-mouse-3 'gnus-mime-security-button-menu)
+ (define-key map [mouse-2] 'gnus-article-push-button)
+ (define-key map [down-mouse-3] 'gnus-mime-security-button-menu)
(dolist (c gnus-mime-security-button-commands)
(define-key map (cadr c) (car c)))
map))
:button-keymap gnus-mime-security-button-map
:help-echo
(lambda (_widget)
- ;; Needed to properly clear the message due to a bug in
- ;; wid-edit (XEmacs only).
- (when (boundp 'help-echo-owns-message)
- (setq help-echo-owns-message t))
(format
"%S: show detail; %S: more options"
- (aref gnus-mouse-2 0)
- (aref gnus-down-mouse-3 0))))))
+ 'mouse-2
+ 'down-mouse-3)))))
(defun gnus-mime-display-security (handle)
(save-restriction
(interactive)
(gnus-mime-security-run-function 'mm-pipe-part))
-(gnus-ems-redefine)
-
(provide 'gnus-art)
(run-hooks 'gnus-art-load-hook)
(substring-no-properties lib-name 0 -1)
lib-name)
file-name))
- ;; The next three forms are from `find-source-lisp-file'.
(src-file (locate-library file-name t nil 'readable)))
(and src-file (file-readable-p src-file) src-file))))))
(buffer-file-name buffer)))
(dir-locals-find-file
(buffer-file-name buffer))))
- (dir-file t))
+ (is-directory nil))
(princ (substitute-command-keys
" This variable's value is directory-local"))
- (if (null file)
- (princ ".\n")
- (princ ", set ")
- (if (consp file) ; result from cache
- ;; If the cache element has an mtime, we
- ;; assume it came from a file.
- (if (nth 2 file)
- (setq file (expand-file-name
- dir-locals-file (car file)))
- ;; Otherwise, assume it was set directly.
- (setq file (car file)
- dir-file nil)))
- (princ (substitute-command-keys
- (if dir-file
- "by the file\n `"
- "for the directory\n `")))
+ (when (consp file) ; result from cache
+ ;; If the cache element has an mtime, we
+ ;; assume it came from a file.
+ (if (nth 2 file)
+ ;; (car file) is a directory.
+ (setq file (dir-locals--all-files (car file)))
+ ;; Otherwise, assume it was set directly.
+ (setq file (car file)
+ is-directory t)))
+ (if (null file)
+ (princ ".\n")
+ (princ ", set ")
+ (princ (substitute-command-keys
+ (cond
+ (is-directory "for the directory\n `")
+ ;; Many files matched.
+ ((and (consp file) (cdr file))
+ (setq file (file-name-directory (car file)))
+ (format "by one of the\n %s files in the directory\n `"
+ dir-locals-file))
+ (t (setq file (car file))
+ "by the file\n `"))))
(with-current-buffer standard-output
(insert-text-button
file 'type 'help-dir-local-var-def
- 'help-args (list variable file)))
+ 'help-args (list variable file)))
(princ (substitute-command-keys "'.\n"))))
(princ (substitute-command-keys
" This variable's value is file-local.\n"))))
(require 'url-queue)
(require 'url-util) ; for url-get-url-at-point
(require 'mm-url)
+(require 'puny)
(eval-when-compile (require 'subr-x)) ;; for string-trim
(defgroup eww nil
"When this regex is found in the URL, it's not a keyword but an address.")
(defvar eww-link-keymap
- (let ((map (copy-keymap shr-map)))
+ (let ((map (copy-keymap shr-image-map)))
(define-key map "\r" 'eww-follow-link)
map))
(current-buffer)
(get-buffer-create "*eww*")))
(eww-setup-buffer)
+ ;; Check whether the domain only uses "Highly Restricted" Unicode
+ ;; IDNA characters. If not, transform to punycode to indicate that
+ ;; there may be funny business going on.
+ (let ((parsed (url-generic-parse-url url)))
+ (unless (puny-highly-restrictive-domain-p (url-host parsed))
+ (setf (url-host parsed) (puny-encode-domain (url-host parsed)))
+ (setq url (url-recreate-url parsed))))
(plist-put eww-data :url url)
(plist-put eww-data :title "")
(eww-update-header-line-format)
(condition-case nil
(decode-coding-region (point) (point-max) encode)
(coding-system-error nil))
+ (save-excursion
+ ;; Remove CRLF before parsing.
+ (while (re-search-forward "\r$" nil t)
+ (replace-match "" t t)))
(libxml-parse-html-region (point) (point-max))))))
(source (and (null document)
(buffer-substring (point) (point-max)))))
(shr-target-id (url-target (url-generic-parse-url url)))
(shr-external-rendering-functions
(append
+ shr-external-rendering-functions
'((title . eww-tag-title)
(form . eww-tag-form)
(input . eww-tag-input)
+ (button . eww-form-submit)
(textarea . eww-tag-textarea)
(select . eww-tag-select)
(link . eww-tag-link)
(define-key map "R" 'eww-readable)
(define-key map "H" 'eww-list-histories)
(define-key map "E" 'eww-set-character-encoding)
+ (define-key map "s" 'eww-switch-to-buffer)
(define-key map "S" 'eww-list-buffers)
(define-key map "F" 'eww-toggle-fonts)
+ (define-key map [(meta C)] 'eww-toggle-colors)
(define-key map "b" 'eww-add-bookmark)
(define-key map "B" 'eww-list-bookmarks)
["View page source" eww-view-source]
["Copy page URL" eww-copy-page-url t]
["List histories" eww-list-histories t]
+ ["Switch to buffer" eww-switch-to-buffer t]
["List buffers" eww-list-buffers t]
["Add bookmark" eww-add-bookmark t]
["List bookmarks" eww-list-bookmarks t]
["List cookies" url-cookie-list t]
+ ["Toggle fonts" eww-toggle-fonts t]
+ ["Toggle colors" eww-toggle-colors t]
["Character Encoding" eww-set-character-encoding]))
map))
(eww-reload nil 'utf-8)
(eww-reload nil charset)))
+(defun eww-switch-to-buffer ()
+ "Prompt for an EWW buffer to display in the selected window."
+ (interactive)
+ (let ((completion-extra-properties
+ '(:annotation-function (lambda (buf)
+ (with-current-buffer buf
+ (format " %s" (eww-current-url)))))))
+ (pop-to-buffer-same-window
+ (read-buffer "Switch to EWW buffer: "
+ (cl-loop for buf in (nreverse (buffer-list))
+ if (with-current-buffer buf (derived-mode-p 'eww-mode))
+ return buf)
+ t
+ (lambda (bufn)
+ (with-current-buffer
+ (if (consp bufn) (cdr bufn) (get-buffer bufn))
+ (derived-mode-p 'eww-mode)))))))
+
(defun eww-toggle-fonts ()
"Toggle whether to use monospaced or font-enabled layouts."
(interactive)
- (message "Fonts are now %s"
- (if (setq shr-use-fonts (not shr-use-fonts))
- "on"
- "off"))
- (eww-reload))
+ (setq shr-use-fonts (not shr-use-fonts))
+ (eww-reload)
+ (message "Proportional fonts are now %s"
+ (if shr-use-fonts "on" "off")))
+(defun eww-toggle-colors ()
+ "Toggle whether to use HTML-specified colors or not."
+ (interactive)
+ (message "Colors are now %s"
+ (if (setq shr-use-colors (not shr-use-colors))
+ "on"
+ "off"))
+ (eww-reload))
+
;;; Bookmarks code
(defvar eww-bookmarks nil)
;; pair element into an open paren element. Doing that would mean that the
;; new open paren wouldn't have the required preceding paren pair element.
;;
- ;; This function is called from c-after-change.
+ ;; This function is called from c-before-change.
;; The caches of non-literals:
;; Note that we use "<=" for the possibility of the second char of a two-char
;; below `here'. To maintain its consistency, we may need to insert a new
;; brace pair.
(let ((here-bol (c-point 'bol here))
- too-high-pa ; recorded {/(/[ next above here, or nil.
+ too-high-pa ; recorded {/(/[ next above or just below here, or nil.
dropped-cons ; was the last removed element a brace pair?
pa)
;; The easy bit - knock over-the-top bits off `c-state-cache'.
;; Do we need to add in an earlier brace pair, having lopped one off?
(if (and dropped-cons
- (< too-high-pa (+ here c-state-cache-too-far)))
+ (<= too-high-pa here))
(c-append-lower-brace-pair-to-state-cache too-high-pa here here-bol))
(setq c-state-cache-good-pos (or (c-state-cache-after-top-paren)
(c-state-get-min-scan-pos)))))
(when (or (looking-at "extends")
(looking-at "super"))
- (forward-word-strictly)
+ (forward-word)
(c-forward-syntactic-ws)
(let ((c-promote-possible-types t)
(c-record-found-types t))
(c-backward-syntactic-ws))
(c-back-over-list-of-member-inits)
(and (eq (char-before) ?:)
- (save-excursion
- (c-backward-token-2)
- (not (looking-at c-:$-multichar-token-regexp)))
(c-just-after-func-arglist-p))))
(while (and (not (and level-plausible
(c-backward-syntactic-ws)
(c-back-over-list-of-member-inits)
(and (eq (char-before) ?:)
- (save-excursion
- (c-backward-token-2)
- (not (looking-at c-:$-multichar-token-regexp)))
(c-just-after-func-arglist-p)))))
(and at-top-level level-plausible)))
(defcustom time-stamp-format "%:y-%02m-%02d %02H:%02M:%02S %u"
"Format of the string inserted by \\[time-stamp].
-The value may be a string or a list. Lists are supported only for
-backward compatibility; see variable `time-stamp-old-format-warn'.
-
-A string is used verbatim except for character sequences beginning
+This is a string, used verbatim except for character sequences beginning
with %, as follows. The values of non-numeric formatted items depend
on the locale setting recorded in `system-time-locale' and
`locale-coding-system'. The examples here are for the default
:group 'time-stamp
:version "19.29")
-(defcustom time-stamp-old-format-warn 'ask
- "Action if `time-stamp-format' is an old-style list.
-If `error', the format is not used. If `ask', the user is queried about
-using the time-stamp-format. If `warn', a warning is displayed.
-If nil, no notification is given."
- :type '(choice (const :tag "Don't use the format" error)
- (const ask)
- (const warn)
- (const :tag "No notification" nil))
- :group 'time-stamp)
-
(defcustom time-stamp-time-zone nil
"The time zone to be used by \\[time-stamp].
- Its format is that of the ZONE argument of the `format-time-string' function,"
+ Its format is that of the ZONE argument of the `format-time-string' function."
:type '(choice (const :tag "Emacs local time" nil)
(const :tag "Universal Time" t)
(const :tag "system wall clock time" wall)
"Generate the new string to be inserted by \\[time-stamp].
Optionally use format TS-FORMAT instead of `time-stamp-format' to
format the string."
- (or ts-format
- (setq ts-format time-stamp-format))
- (if (stringp ts-format)
- (time-stamp--format (time-stamp-string-preprocess ts-format) nil)
- ;; handle version 1 compatibility
- (cond ((or (eq time-stamp-old-format-warn 'error)
- (and (eq time-stamp-old-format-warn 'ask)
- (not (y-or-n-p "Use non-string time-stamp-format? "))))
- (message "Warning: no time-stamp: time-stamp-format not a string")
- (sit-for 1)
- nil)
- (t
- (cond ((eq time-stamp-old-format-warn 'warn)
- (message "Obsolescent time-stamp-format type; should be string")
- (sit-for 1)))
- (time-stamp-fconcat ts-format " ")))))
+ (if (stringp (or ts-format (setq ts-format time-stamp-format)))
+ (time-stamp--format (time-stamp-string-preprocess ts-format) nil)))
+
(defconst time-stamp-no-file "(no file)"
"String to use when the buffer is not associated with a file.")
+;;; FIXME This comment was written in 1996!
;;; time-stamp is transitioning to using the new, expanded capabilities
;;; of format-time-string. During the process, this function implements
;;; intermediate, compatible formats and complains about old, soon to
mail-host-address)
(system-name)))
-;;; the rest of this file is for version 1 compatibility
-
-(defun time-stamp-fconcat (list sep)
- "Similar to (mapconcat \\='funcall LIST SEP) but LIST allows literals.
-If an element of LIST is a symbol, it is funcalled to get the string to use;
-the separator SEP is used between two strings obtained by funcalling a
-symbol. Otherwise the element itself is inserted; no separator is used
-around literals."
- (let ((return-string "")
- (insert-sep-p nil))
- (while list
- (cond ((symbolp (car list))
- (if insert-sep-p
- (setq return-string (concat return-string sep)))
- (setq return-string (concat return-string (funcall (car list))))
- (setq insert-sep-p t))
- (t
- (setq return-string (concat return-string (car list)))
- (setq insert-sep-p nil)))
- (setq list (cdr list)))
- return-string))
-
(provide 'time-stamp)
;;; time-stamp.el ends here
}
#endif
-
#if defined HAVE_INOTIFY || defined HAVE_KQUEUE || defined HAVE_GFILENOTIFY
case FILE_NOTIFY_EVENT:
{
is used. Note that [Enter] is not echoed by dos. */
cursor_to (SELECTED_FRAME (), 0, 0);
#endif
+
+ write_stdout ("Emacs is resuming after an emergency escape.\n");
+
/* It doesn't work to autosave while GC is in progress;
the code used for auto-saving doesn't cope with the mark bit. */
if (!gc_in_progress)
DEFVAR_LISP ("disable-point-adjustment", Vdisable_point_adjustment,
doc: /* If non-nil, suppress point adjustment after executing a command.
- After a command is executed, if point is moved into a region that has
- special properties (e.g. composition, display), we adjust point to
- the boundary of the region. But, when a command sets this variable to
- non-nil, we suppress the point adjustment.
+ After a command is executed, if point moved into a region that has
+ special properties (e.g. composition, display), Emacs adjusts point to
+ the boundary of the region. But when a command binds this variable to
+ non-nil, this point adjustment is suppressed.
This variable is set to nil before reading a command, and is checked
just after executing the command. */);
DEFVAR_LISP ("global-disable-point-adjustment",
Vglobal_disable_point_adjustment,
- doc: /* If non-nil, always suppress point adjustment.
+ doc: /* If non-nil, always suppress point adjustments.
- The default value is nil, in which case, point adjustment are
+ The default value is nil, in which case point adjustments are
suppressed only after special commands that set
`disable-point-adjustment' (which see) to non-nil. */);
Vglobal_disable_point_adjustment = Qnil;
variable are `sigusr1' and `sigusr2'. */);
Vdebug_on_event = intern_c_string ("sigusr2");
+ DEFVAR_BOOL ("attempt-stack-overflow-recovery",
+ attempt_stack_overflow_recovery,
+ doc: /* If non-nil, attempt to recover from C stack
+overflow. This recovery is unsafe and may lead to deadlocks or data
+corruption, but it usually works and may preserve modified buffers
+that would otherwise be lost. If nil, treat stack overflow like any
+other kind of crash. */);
+ attempt_stack_overflow_recovery = true;
+
+ DEFVAR_BOOL ("attempt-orderly-shutdown-on-fatal-signal",
+ attempt_orderly_shutdown_on_fatal_signal,
+ doc: /* If non-nil, attempt to perform an orderly
+shutdown when Emacs receives a fatal signal (e.g., a crash).
+This cleanup is unsafe and may lead to deadlocks or data corruption,
+but it usually works and may preserve modified buffers that would
+otherwise be lost. If nil, crash immediately in response to fatal
+signals. */);
+ attempt_orderly_shutdown_on_fatal_signal = true;
+
/* Create the initial keyboard. Qt means 'unset'. */
initial_kboard = allocate_kboard (Qt);
}
(defvar file-notify--test-tmpfile nil)
(defvar file-notify--test-tmpfile1 nil)
(defvar file-notify--test-desc nil)
+ (defvar file-notify--test-desc1 nil)
+ (defvar file-notify--test-desc2 nil)
(defvar file-notify--test-results nil)
(defvar file-notify--test-event nil)
(defvar file-notify--test-events nil)
(defun file-notify--test-cleanup ()
"Cleanup after a test."
(file-notify-rm-watch file-notify--test-desc)
+ (file-notify-rm-watch file-notify--test-desc1)
+ (file-notify-rm-watch file-notify--test-desc2)
(ignore-errors
(delete-file (file-newest-backup file-notify--test-tmpfile)))
(setq file-notify--test-tmpfile nil
file-notify--test-tmpfile1 nil
file-notify--test-desc nil
+ file-notify--test-desc1 nil
+ file-notify--test-desc2 nil
file-notify--test-results nil
file-notify--test-events nil)
(when file-notify--test-event
(should (equal (car file-notify--test-event) file-notify--test-desc))
;; Check the file name.
(should
- (or (string-equal (file-notify--event-file-name file-notify--test-event)
- file-notify--test-tmpfile)
- (string-equal (file-notify--event-file-name file-notify--test-event)
- file-notify--test-tmpfile1)
- (string-equal (file-notify--event-file-name file-notify--test-event)
- temporary-file-directory)))
+ (string-prefix-p
+ (file-notify--event-watched-file file-notify--test-event)
+ (file-notify--event-file-name file-notify--test-event)))
;; Check the second file name if exists.
(when (eq (nth 1 file-notify--test-event) 'renamed)
(should
- (or (string-equal (file-notify--event-file1-name file-notify--test-event)
- file-notify--test-tmpfile1)
- (string-equal (file-notify--event-file1-name file-notify--test-event)
- temporary-file-directory)))))
+ (string-prefix-p
+ (file-notify--event-watched-file file-notify--test-event)
+ (file-notify--event-file1-name file-notify--test-event)))))
(defun file-notify--test-event-handler (event)
"Run a test over FILE-NOTIFY--TEST-EVENT.
(unless (string-match
(regexp-quote ".#")
(file-notify--event-file-name file-notify--test-event))
- ;;(message "file-notify--test-event-handler %S" file-notify--test-event)
+ ;;(message "file-notify--test-event-handler result: %s event: %S"
+ ;;(null (ert-test-failed-p result)) file-notify--test-event)
(setq file-notify--test-events
(append file-notify--test-events `(,file-notify--test-event))
file-notify--test-results
events, which represent different possible results. Don't wait
longer than timeout seconds for the events to be delivered."
(declare (indent 1))
- (let ((outer (make-symbol "outer")))
- `(let* ((,outer file-notify--test-events)
- (events (if (consp (car ,events)) ,events (list ,events)))
- (max-length (apply 'max (mapcar 'length events)))
- create-lockfiles)
- ;; Flush pending events.
- (file-notify--wait-for-events
- (file-notify--test-timeout)
- (input-pending-p))
- (let (file-notify--test-events)
- ,@body
- (file-notify--wait-for-events
- ;; More events need more time. Use some fudge factor.
- (* (ceiling max-length 100) (file-notify--test-timeout))
- (= max-length (length file-notify--test-events)))
- ;; One of the possible results shall match.
- (should (file-notify--test-with-events-check events))
- (setq ,outer (append ,outer file-notify--test-events)))
- (setq file-notify--test-events ,outer))))
+ `(let* ((events (if (consp (car ,events)) ,events (list ,events)))
+ (max-length (apply 'max (mapcar 'length events)))
+ create-lockfiles)
+ ;; Flush pending events.
+ (file-notify--wait-for-events
+ (file-notify--test-timeout)
+ (input-pending-p))
+ (setq file-notify--test-events nil
+ file-notify--test-results nil)
+ ,@body
+ (file-notify--wait-for-events
+ ;; More events need more time. Use some fudge factor.
+ (* (ceiling max-length 100) (file-notify--test-timeout))
+ (= max-length (length file-notify--test-events)))
+ ;; Check the result sequence just to make sure that all events
+ ;; are as expected.
+ (dolist (result file-notify--test-results)
+ (when (ert-test-failed-p result)
+ (ert-fail
+ (cadr (ert-test-result-with-condition-condition result)))))
+ ;; One of the possible event sequences shall match.
+ (should (file-notify--test-with-events-check events))))
(ert-deftest file-notify-test02-events ()
"Check file creation/change/removal notifications."
"another text" nil file-notify--test-tmpfile nil 'no-message)
(read-event nil nil file-notify--test-read-event-timeout)
(delete-file file-notify--test-tmpfile))
- ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
- (let (file-notify--test-events)
- (file-notify-rm-watch file-notify--test-desc)))
+ (file-notify-rm-watch file-notify--test-desc))
;; Check file change and deletion.
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
"another text" nil file-notify--test-tmpfile nil 'no-message)
(read-event nil nil file-notify--test-read-event-timeout)
(delete-file file-notify--test-tmpfile))
- ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
- (let (file-notify--test-events)
- (file-notify-rm-watch file-notify--test-desc))
+ (file-notify-rm-watch file-notify--test-desc)
;; Check file creation, change and deletion when watching a
;; directory. There must be a `stopped' event when deleting
"any text" nil file-notify--test-tmpfile nil 'no-message)
(read-event nil nil file-notify--test-read-event-timeout)
(delete-directory temporary-file-directory 'recursive))
- ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
- (let (file-notify--test-events)
- (file-notify-rm-watch file-notify--test-desc)))
+ (file-notify-rm-watch file-notify--test-desc))
;; Check copy of files inside a directory.
(let ((temporary-file-directory
(set-file-times file-notify--test-tmpfile '(0 0))
(read-event nil nil file-notify--test-read-event-timeout)
(delete-directory temporary-file-directory 'recursive))
- ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
- (let (file-notify--test-events)
- (file-notify-rm-watch file-notify--test-desc)))
+ (file-notify-rm-watch file-notify--test-desc))
;; Check rename of files inside a directory.
(let ((temporary-file-directory
;; After the rename, we won't get events anymore.
(read-event nil nil file-notify--test-read-event-timeout)
(delete-directory temporary-file-directory 'recursive))
- ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
- (let (file-notify--test-events)
- (file-notify-rm-watch file-notify--test-desc)))
+ (file-notify-rm-watch file-notify--test-desc))
;; Check attribute change. Does not work for cygwin.
(unless (eq system-type 'cygwin)
(set-file-times file-notify--test-tmpfile '(0 0))
(read-event nil nil file-notify--test-read-event-timeout)
(delete-file file-notify--test-tmpfile))
- ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
- (let (file-notify--test-events)
- (file-notify-rm-watch file-notify--test-desc)))
-
- ;; Check the global sequence again just to make sure that
- ;; `file-notify--test-events' has been set correctly.
- (should file-notify--test-results)
- (dolist (result file-notify--test-results)
- (when (ert-test-failed-p result)
- (ert-fail
- (cadr (ert-test-result-with-condition-condition result))))))
+ (file-notify-rm-watch file-notify--test-desc)))
;; Cleanup.
(file-notify--test-cleanup)))
(dotimes (i n)
;; It matters which direction we rename, at least for
;; kqueue. This backend parses directories in alphabetic
- ;; order (x%d before y%d). So we rename both directions.
+ ;; order (x%d before y%d). So we rename into both directions.
(if (zerop (mod i 2))
(progn
(push (expand-file-name (format "x%d" i)) source-file-list)
((or (string-equal (file-notify--test-library) "w32notify")
(file-remote-p temporary-file-directory))
'(changed changed))
+ ;; gfilenotify raises one or two `changed' events
+ ;; randomly, no chance to test. So we accept both cases.
+ ((string-equal "gfilenotify" (file-notify--test-library))
+ '((changed)
+ (changed changed)))
(t '(changed)))
;; There shouldn't be any problem, because the file is kept.
(with-temp-buffer
(file-notify--deftest-remote file-notify-test07-backup
"Check that backup keeps file notification for remote files.")
+ (ert-deftest file-notify-test08-watched-file-in-watched-dir ()
+ "Watches a directory and a file in that directory separately.
+ Checks that the callbacks are only called with events with
+ descriptors that were issued when registering the watches. This
+ test caters for the situation in bug#22736 where the callback for
+ the directory received events for the file with the descriptor of
+ the file watch."
+ :tags '(:expensive-test)
+ (skip-unless (file-notify--test-local-enabled))
+
+ ;; A directory to be watched.
+ (should
+ (setq file-notify--test-tmpfile
+ (make-temp-file "file-notify-test-parent" t)))
+ ;; A file to be watched.
+ (should
+ (setq file-notify--test-tmpfile1
+ (let ((temporary-file-directory file-notify--test-tmpfile))
+ (file-notify--test-make-temp-name))))
+ (write-region "any text" nil file-notify--test-tmpfile1 nil 'no-message)
+ (unwind-protect
+ (cl-flet (;; Directory monitor.
+ (dir-callback (event)
+ (let ((file-notify--test-desc file-notify--test-desc1))
+ (file-notify--test-event-handler event)))
+ ;; File monitor.
+ (file-callback (event)
+ (let ((file-notify--test-desc file-notify--test-desc2))
+ (file-notify--test-event-handler event))))
+ (should
+ (setq file-notify--test-desc1
+ (file-notify-add-watch
+ file-notify--test-tmpfile
+ '(change) #'dir-callback)))
+ (should
+ (setq file-notify--test-desc2
+ (file-notify-add-watch
+ file-notify--test-tmpfile1
+ '(change) #'file-callback)))
+ (should (file-notify-valid-p file-notify--test-desc1))
+ (should (file-notify-valid-p file-notify--test-desc2))
+ (should-not (equal file-notify--test-desc1 file-notify--test-desc2))
+ ;; gfilenotify raises one or two `changed' events randomly in
+ ;; the file monitor, no chance to test.
+ (unless (string-equal "gfilenotify" (file-notify--test-library))
+ (let ((n 100) events)
+ ;; Compute the expected events.
+ (dotimes (_i (/ n 2))
+ (setq events
+ (append
+ (append
+ ;; Directory monitor and file monitor.
+ (cond
+ ;; In the remote case, there are two `changed'
+ ;; events.
+ ((file-remote-p temporary-file-directory)
+ '(changed changed changed changed))
+ ;; The directory monitor in kqueue does not
+ ;; raise any `changed' event. Just the file
+ ;; monitor event is received.
+ ((string-equal (file-notify--test-library) "kqueue")
+ '(changed))
+ ;; Otherwise, both monitors report the
+ ;; `changed' event.
+ (t '(changed changed)))
+ ;; Just the directory monitor.
+ (cond
+ ;; In kqueue, there is an additional `changed'
+ ;; event. Why?
+ ((string-equal (file-notify--test-library) "kqueue")
+ '(changed created changed))
+ (t '(created changed))))
+ events)))
+
+ ;; Run the test.
+ (file-notify--test-with-events events
+ (dotimes (i n)
+ (read-event nil nil file-notify--test-read-event-timeout)
+ (if (zerop (mod i 2))
+ (write-region
+ "any text" nil file-notify--test-tmpfile1 t 'no-message)
+ (let ((temporary-file-directory file-notify--test-tmpfile))
+ (write-region
+ "any text" nil
+ (file-notify--test-make-temp-name) nil 'no-message)))))))
+
+ ;; If we delete the file, the directory monitor shall still be
+ ;; active. We receive the `deleted' event from both the
+ ;; directory and the file monitor. The `stopped' event is
+ ;; from the file monitor. It's undecided in which order the
+ ;; the directory and the file monitor are triggered.
+ (file-notify--test-with-events
+ '((deleted deleted stopped)
+ (deleted stopped deleted))
+ (delete-file file-notify--test-tmpfile1))
+ (should (file-notify-valid-p file-notify--test-desc1))
+ (should-not (file-notify-valid-p file-notify--test-desc2))
+
+ ;; Now we delete the directory.
+ (file-notify--test-with-events
+ (cond
+ ;; In kqueue, just one `deleted' event for the directory
+ ;; is received.
+ ((string-equal (file-notify--test-library) "kqueue")
+ '(deleted stopped))
+ (t (append
+ ;; The directory monitor raises a `deleted' event for
+ ;; every file contained in the directory, we must
+ ;; count them.
+ (make-list
+ (length
+ (directory-files
+ file-notify--test-tmpfile nil
+ directory-files-no-dot-files-regexp 'nosort))
+ 'deleted)
+ ;; The events of the directory itself.
+ '(deleted stopped))))
+ (delete-directory file-notify--test-tmpfile 'recursive))
+ (should-not (file-notify-valid-p file-notify--test-desc1))
+ (should-not (file-notify-valid-p file-notify--test-desc2)))
+
+ ;; Cleanup.
+ (file-notify--test-cleanup)))
+
+ (file-notify--deftest-remote file-notify-test08-watched-file-in-watched-dir
+ "Check `file-notify-test08-watched-file-in-watched-dir' for remote files.")
+
(defun file-notify-test-all (&optional interactive)
"Run all tests for \\[file-notify]."
(interactive "p")