[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/ns/draw-to-bitmap d12e7b4 5/5: Merge remote-tracking branch 'ori
|
From: |
Alan Third |
|
Subject: |
scratch/ns/draw-to-bitmap d12e7b4 5/5: Merge remote-tracking branch 'origin/master' into scratch/ns/draw-to-bitmap |
|
Date: |
Mon, 11 Nov 2019 13:00:57 -0500 (EST) |
branch: scratch/ns/draw-to-bitmap
commit d12e7b4849bfd83ea6cf700dc69d79a7af69ede2
Merge: 046a84d a79e96f
Author: Alan Third <address@hidden>
Commit: Alan Third <address@hidden>
Merge remote-tracking branch 'origin/master' into scratch/ns/draw-to-bitmap
---
admin/notes/git-workflow | 11 +-
doc/lispref/display.texi | 19 +-
doc/lispref/numbers.texi | 3 +-
doc/lispref/os.texi | 77 +++++++
doc/lispref/package.texi | 35 ----
doc/lispref/positions.texi | 5 +-
doc/lispref/tips.texi | 9 +-
doc/misc/cl.texi | 26 ++-
doc/misc/eww.texi | 10 +-
doc/misc/gnus.texi | 28 +--
etc/NEWS | 55 +++++
etc/NEWS.25 | 5 +
etc/themes/tango-dark-theme.el | 1 +
lisp/bindings.el | 10 +-
lisp/buff-menu.el | 3 +-
lisp/button.el | 32 ++-
lisp/calc/calc-forms.el | 14 +-
lisp/calendar/appt.el | 5 +-
lisp/calendar/cal-dst.el | 5 +-
lisp/calendar/calendar.el | 4 +-
lisp/calendar/icalendar.el | 18 +-
lisp/calendar/iso8601.el | 356 ++++++++++++++++++++++++++++++++
lisp/calendar/parse-time.el | 74 +------
lisp/calendar/time-date.el | 195 ++++++++++++++++-
lisp/calendar/timeclock.el | 6 +-
lisp/char-fold.el | 27 ++-
lisp/descr-text.el | 2 -
lisp/dired.el | 2 +-
lisp/emacs-lisp/bytecomp.el | 7 +-
lisp/emacs-lisp/cl-macs.el | 17 +-
lisp/emacs-lisp/derived.el | 41 ++--
lisp/emacs-lisp/let-alist.el | 4 +-
lisp/emacs-lisp/package-x.el | 13 +-
lisp/emacs-lisp/package.el | 78 +++----
lisp/emacs-lisp/timer.el | 7 +-
lisp/eshell/em-ls.el | 14 +-
lisp/eshell/esh-util.el | 2 +-
lisp/filenotify.el | 53 ++---
lisp/gnus/gnus-art.el | 129 ++++--------
lisp/gnus/gnus-demon.el | 35 ++--
lisp/gnus/gnus-gravatar.el | 3 +-
lisp/gnus/gnus-html.el | 36 ++--
lisp/gnus/gnus-icalendar.el | 5 +-
lisp/gnus/gnus-sum.el | 34 +--
lisp/gnus/gnus-util.el | 14 +-
lisp/gnus/message.el | 97 ++++-----
lisp/gnus/mm-decode.el | 39 +---
lisp/gnus/nndiary.el | 32 +--
lisp/gnus/nnimap.el | 2 +-
lisp/gnus/nnrss.el | 51 ++---
lisp/iimage.el | 14 +-
lisp/image.el | 2 +-
lisp/image/gravatar.el | 35 +++-
lisp/info.el | 11 +-
lisp/mail/sendmail.el | 100 ++++-----
lisp/mh-e/mh-search.el | 2 +-
lisp/mh-e/mh-speed.el | 2 +-
lisp/net/browse-url.el | 319 +++++++++++++++-------------
lisp/net/eww.el | 12 +-
lisp/net/newst-backend.el | 66 +-----
lisp/net/pop3.el | 4 +-
lisp/net/rcirc.el | 3 +
lisp/net/shr.el | 42 ++--
lisp/net/tramp-sh.el | 3 +-
lisp/proced.el | 8 +-
lisp/profiler.el | 3 +
lisp/progmodes/compile.el | 5 +-
lisp/progmodes/etags.el | 17 +-
lisp/progmodes/grep.el | 7 +-
lisp/progmodes/prog-mode.el | 6 +-
lisp/progmodes/vhdl-mode.el | 48 ++---
lisp/ses.el | 5 +-
lisp/simple.el | 26 +++
lisp/term.el | 131 +++++-------
lisp/textmodes/ispell.el | 19 +-
lisp/url/url-dav.el | 67 +-----
lisp/vc/ediff-mult.el | 13 +-
lisp/view.el | 4 +-
lisp/window.el | 2 +-
src/casefiddle.c | 2 +-
src/eval.c | 2 +-
src/lread.c | 31 +--
src/process.c | 15 +-
src/timefns.c | 6 +
test/lisp/calendar/icalendar-tests.el | 26 +++
test/lisp/calendar/iso8601-tests.el | 291 ++++++++++++++++++++++++++
test/lisp/calendar/time-date-tests.el | 115 +++++++++++
test/lisp/char-fold-tests.el | 90 ++++----
test/lisp/emacs-lisp/let-alist-tests.el | 5 +
test/lisp/filenotify-tests.el | 125 ++++++-----
test/lisp/gnus/nnrss-tests.el | 29 +++
test/lisp/progmodes/flymake-tests.el | 6 +-
test/src/process-tests.el | 29 +++
93 files changed, 2276 insertions(+), 1222 deletions(-)
diff --git a/admin/notes/git-workflow b/admin/notes/git-workflow
index 5465786..28b6f91 100644
--- a/admin/notes/git-workflow
+++ b/admin/notes/git-workflow
@@ -1,7 +1,3 @@
-(This is a draft. The method here won't actually work yet, because
-neither git-new-workdir nor merge-changelog are in the Emacs
-distribution yet.)
-
Setting up and using git for normal, simple bugfixing
=====================================================
@@ -24,10 +20,9 @@ the current master and the emacs-26 branch.
mkdir ~/emacs
cd ~/emacs
git clone <membername>@git.sv.gnu.org:/srv/git/emacs.git master
-(cd master; git config push.default current)
-./master/admin/git-new-workdir master emacs-26
-cd emacs-26
-git checkout emacs-26
+cd master
+git config push.default current
+git worktree add ../emacs-26 emacs-26
You now have both branches conveniently accessible, and you can do
"git pull" in them once in a while to keep updated.
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 3c91092..42f838b 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -2523,6 +2523,11 @@ face name. In the vast majority of cases, this is not
necessary; the
usual procedure is to define a face with @code{defface}, and then use
its name directly.
+@cindex face (non-removability of)
+Note that once you have defined a face (usually with @code{defface}),
+you cannot later undefine this face safely, except by restarting
+Emacs.
+
@defmac defface face spec doc [keyword value]@dots{}
This macro declares @var{face} as a named face whose default face spec
is given by @var{spec}. You should not quote the symbol @var{face},
@@ -6473,7 +6478,9 @@ that is the value of that property, passing it the single
argument
@var{button}). If @var{use-mouse-action} is non-@code{nil}, try to
invoke the button's @code{mouse-action} property instead of
@code{action}; if the button has no @code{mouse-action} property, use
-@code{action} as normal.
+@code{action} as normal. If the @code{button-data} property is
+present in @var{button}, use that as the argument for the
+@code{action} function instead of @var{button}.
@end defun
@defun button-label button
@@ -6541,14 +6548,16 @@ event's position is used. If there's no button at
@var{pos}, do
nothing and return @code{nil}, otherwise return @code{t}.
@end deffn
-@deffn Command forward-button n &optional wrap display-message
+@deffn Command forward-button n &optional wrap display-message no-error
Move to the @var{n}th next button, or @var{n}th previous button if
@var{n} is negative. If @var{n} is zero, move to the start of any
button at point. If @var{wrap} is non-@code{nil}, moving past either
end of the buffer continues from the other end. If
@var{display-message} is non-@code{nil}, the button's help-echo string
is displayed. Any button with a non-@code{nil} @code{skip} property
-is skipped over. Returns the button found.
+is skipped over. Returns the button found, and signals an error if no
+buttons can be found. If @var{no-error} in non-@code{nil}, return nil
+instead of signalling the error.
@end deffn
@deffn Command backward-button n &optional wrap display-message
@@ -6558,7 +6567,9 @@ button at point. If @var{wrap} is non-@code{nil}, moving
past either
end of the buffer continues from the other end. If
@var{display-message} is non-@code{nil}, the button's help-echo string
is displayed. Any button with a non-@code{nil} @code{skip} property
-is skipped over. Returns the button found.
+is skipped over. Returns the button found, and signals an error if no
+buttons can be found. If @var{no-error} in non-@code{nil}, return nil
+instead of signalling the error.
@end deffn
@defun next-button pos &optional count-current
diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index cae8bab..0c71387 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -1072,7 +1072,8 @@ result is 0, which is an identity element for this
operation. If
@defun lognot integer
This function returns the bitwise complement of its argument: the @var{n}th
bit is one in the result if, and only if, the @var{n}th bit is zero in
-@var{integer}, and vice-versa.
+@var{integer}, and vice-versa. The result equals @minus{}1 @minus{}
+@var{integer}.
@example
(lognot 5)
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index fef954e..b344483 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1466,6 +1466,60 @@ seconds east of Greenwich.
@strong{Common Lisp Note:} Common Lisp has different meanings for
@var{dow} and @var{utcoff}.
+
+To access (or alter) the elements in the time value, the
+@code{decoded-time-second}, @code{decoded-time-minute},
+@code{decoded-time-hour}, @code{decoded-time-day},
+@code{decoded-time-month}, @code{decoded-time-year},
+@code{decoded-time-weekday}, @code{decoded-time-dst} and
+@code{decoded-time-zone} accessors can be used.
+
+For instance, to increase the year in a decoded time, you could say:
+
+@lisp
+(setf (decoded-time-year decoded-time)
+ (+ (decoded-time-year decoded-time) 4))
+@end lisp
+
+Also see the following function.
+
+@end defun
+
+@defun decoded-time-add time delta
+This function takes a decoded time structure and adds @var{delta}
+(also a decoded time structure) to it. Elements in @var{delta} that
+are @code{nil} are ignored.
+
+For instance, if you want ``same time next month'', you
+could say:
+
+@lisp
+(let ((time (decode-time))
+ (delta (make-decoded-time :month 2)))
+ (encode-time (decoded-time-add time delta)))
+@end lisp
+
+If this date doesn't exist (if you're running this on January 31st,
+for instance), then the date will be shifted back until you get a
+valid date (which will be February 28th or 29th, depending).
+
+Fields are added in a most to least significant order, so if the
+adjustment described above happens, it happens before adding days,
+hours, minutes or seconds.
+
+The values in @var{delta} can be negative to subtract values instead.
+
+The return value is a decoded time structure.
+@end defun
+
+@defun make-decoded-time &key second minute hour day month year dst zone
+Return a decoded time structure with only the given keywords filled
+out, leaving the rest @code{nil}. For instance, to get a structure
+that represents ``two months'', you could say:
+
+@lisp
+(make-decoded-time :month 2)
+@end lisp
@end defun
@defun encode-time &optional time form &rest obsolescent-arguments
@@ -1568,6 +1622,19 @@ ISO 8601 string, like ``Fri, 25 Mar 2016 16:24:56
+0100'' or
less well-formed time strings as well.
@end defun
+@vindex ISO 8601 date/time strings
+@defun iso8601-parse string
+For a more strict function (that will error out upon invalid input),
+this function can be used instead. It's able to parse all variants of
+the ISO 8601 standard, so in addition to the formats mentioned above,
+it also parses things like ``1998W45-3'' (week number) and
+``1998-245'' (ordinal day number). To parse durations, there's
+@code{iso8601-parse-duration}, and to parse intervals, there's
+@code{iso8601-parse-interval}. All these functions return decoded
+time structures, except the final one, which returns three of them
+(the start, the end, and the duration).
+@end defun
+
@defun format-time-string format-string &optional time zone
This function converts @var{time} (or the current time, if
@@ -1867,6 +1934,16 @@ This returns the day number within the year
corresponding to @var{time-value}.
This function returns @code{t} if @var{year} is a leap year.
@end defun
+@defun date-days-in-month year month
+Return the number of days in @var{month} in @var{year}. For instance,
+there's 29 days in February 2004.
+@end defun
+
+@defun date-ordinal-to-time year ordinal
+Return the date of @var{ordinal} in @var{year} as a decoded time
+structure. For instance, the 120th day in 2004 is April 29th.
+@end defun
+
@node Timers
@section Timers for Delayed Execution
@cindex timers
diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi
index 7244efb..a2f4f55 100644
--- a/doc/lispref/package.texi
+++ b/doc/lispref/package.texi
@@ -321,41 +321,6 @@ reachable via HTTP, this directory must be accessible to a
web server;
by default; type @kbd{M-x load-library @key{RET} package-x @key{RET}} to
load it, or add @code{(require 'package-x)} to your init file.
@xref{Lisp Libraries,, Lisp Libraries, emacs, The GNU Emacs Manual}.
-Once loaded, you can make use of the following:
-
-@defopt package-archive-upload-base
-The value of this variable is the base location of a package archive,
-as a directory name. The commands in the @code{package-x} library
-will use this base location.
-
-The directory name should be absolute. You may specify a remote name,
-such as @file{/ssh:foo@@example.com:/var/www/packages/}, if the
-package archive is on a different machine. @xref{Remote Files,,
-Remote Files, emacs, The GNU Emacs Manual}.
-@end defopt
-
-@deffn Command package-upload-file filename
-This command prompts for @var{filename}, a file name, and uploads that
-file to @code{package-archive-upload-base}. The file must be either a
-simple package (a @file{.el} file) or a multi-file package (a
-@file{.tar} file); otherwise, an error is raised. The package
-attributes are automatically extracted, and the archive's contents
-list is updated with this information.
-
-If @code{package-archive-upload-base} does not specify a valid
-directory, the function prompts interactively for one. If the
-directory does not exist, it is created. The directory need not have
-any initial contents (i.e., you can use this command to populate an
-initially empty archive).
-@end deffn
-
-@deffn Command package-upload-buffer
-This command is similar to @code{package-upload-file}, but instead of
-prompting for a package file, it uploads the contents of the current
-buffer. The current buffer must be visiting a simple package (a
-@file{.el} file) or a multi-file package (a @file{.tar} file);
-otherwise, an error is raised.
-@end deffn
@noindent
After you create an archive, remember that it is not accessible in the
diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi
index 7707793..7e51557 100644
--- a/doc/lispref/positions.texi
+++ b/doc/lispref/positions.texi
@@ -794,11 +794,14 @@ on a line that starts with a match for this regular
expression,
followed by a character with open-parenthesis syntax.
@end defopt
+@cindex \( in strings
@defopt open-paren-in-column-0-is-defun-start
If this variable's value is non-@code{nil}, an open parenthesis in
column 0 is considered to be the start of a defun. If it is
@code{nil}, an open parenthesis in column 0 has no special meaning.
-The default is @code{t}.
+The default is @code{t}. If a string literal happens to have a
+parenthesis in column 0, escape it with a backslash to avoid a false
+positive.
@end defopt
@defvar beginning-of-defun-function
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi
index 30f2c98..01e9a3a 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -916,13 +916,16 @@ is discouraged.
When commenting out entire functions, use two semicolons.
@item ;;;;
-Comments that start with four semicolons, @samp{;;;;}, should be aligned
-to the left margin and are used for headings of major sections of a
-program. For example:
+Comments that start with four (or more) semicolons, @samp{;;;;},
+should be aligned to the left margin and are used for headings of
+major sections of a program. For example:
@smallexample
;;;; The kill ring
@end smallexample
+
+If you wish to have sub-headings under these heading, use more
+semicolons to nest these sub-headings.
@end table
@noindent
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index a919760..afe8f01 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -24,7 +24,7 @@ modify this GNU manual.''
@dircategory Emacs lisp libraries
@direntry
-* CL: (cl). Partial Common Lisp support for Emacs Lisp.
+* CL-Lib: (cl). Partial Common Lisp support for Emacs Lisp.
@end direntry
@finalout
@@ -4036,12 +4036,6 @@ is either a slot symbol or a list of the form
@samp{(@var{slot-name}
is a Lisp form that is evaluated any time an instance of the
structure type is created without specifying that slot's value.
-Common Lisp defines several slot options, but the only one
-implemented in this package is @code{:read-only}. A non-@code{nil}
-value for this option means the slot should not be @code{setf}-able;
-the slot's value is determined when the object is created and does
-not change afterward.
-
@example
(cl-defstruct person
(name nil :read-only t)
@@ -4049,7 +4043,23 @@ not change afterward.
(sex 'unknown))
@end example
-Any slot options other than @code{:read-only} are ignored.
+@var{slot-options} is a list of keyword-value pairs, where the
+following keywords can be used:
+
+@table @code
+@item :read-only
+A non-nil value means the slot should not be @code{setf}-able;
+the slot's value is determined when the object is created and does
+not change afterward.
+
+@item :type
+The expected type of the values held in this slot.
+
+@item :documentation
+A documentation string describing the slot.
+@end table
+
+Other slot options are currently ignored.
For obscure historical reasons, structure options take a different
form than slot options. A structure option is either a keyword
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index 8dc58e8..63f676e 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -187,7 +187,7 @@ switch EWW buffers through a minibuffer prompt, press
@kbd{s}
(@code{eww-switch-to-buffer}).
@findex eww-browse-with-external-browser
-@vindex shr-external-browser
+@vindex browse-url-secondary-browser-function
@vindex eww-use-external-browser-for-content-type
@kindex &
@cindex External Browser
@@ -197,10 +197,10 @@ or are not implemented (E.g., JavaScript). If you have
trouble
viewing a website with EWW then hit @kbd{&}
(@code{eww-browse-with-external-browser}) inside the EWW buffer to
open the website in the external browser specified by
-@code{shr-external-browser}. Some content types, such as video or
-audio content, do not make sense to display in GNU Emacs at all. You
-can tell EWW to open specific content automatically in an external
-browser by customizing
+@code{browse-url-secondary-browser-function}. Some content types,
+such as video or audio content, do not make sense to display in GNU
+Emacs at all. You can tell EWW to open specific content automatically
+in an external browser by customizing
@code{eww-use-external-browser-for-content-type}.
@node Advanced
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 3968fa5..dcba47a 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -10164,7 +10164,7 @@ do so.
@findex gnus-summary-browse-url
Scan the article buffer for links, and offer them to the user for
browsing with @code{browse-url}. With a prefix argument, browse with
-@code{shr-external-browser} instead.
+@code{browse-url-secondary-browser-function} instead.
@end table
@@ -23505,11 +23505,11 @@ XEmacs. Here are examples:
(png . (:relief -2))))
@end lisp
-@pxref{Image Descriptors, ,Image Descriptors, elisp, The Emacs Lisp
-Reference Manual} for the valid properties for various image types.
-Currently, @code{pbm} is used for X-Face images and @code{png} is used
-for Face images in Emacs. Only the @code{:face} property is effective
-on the @code{xface} image type in XEmacs if it is built with the
+@xref{Image Descriptors,,, elisp, The Emacs Lisp Reference Manual},
+for the valid properties for various image types. Currently,
+@code{pbm} is used for X-Face images and @code{png} is used for Face
+images in Emacs. Only the @code{:face} property is effective on the
+@code{xface} image type in XEmacs if it is built with the
@samp{libcompface} library.
@end table
@@ -23780,21 +23780,25 @@ The following variables offer control over how things
are displayed.
@item gnus-gravatar-size
@vindex gnus-gravatar-size
The size in pixels of gravatars. Gravatars are always square, so one
-number for the size is enough.
+number for the size is enough. If @code{nil}, this defaults to the
+value of @code{gravatar-size}.
@item gnus-gravatar-properties
@vindex gnus-gravatar-properties
-List of image properties applied to Gravatar images.
+List of image properties applied to Gravatar images (@pxref{Image
+Descriptors,,, elisp, The Emacs Lisp Reference Manual}).
@item gnus-gravatar-too-ugly
@vindex gnus-gravatar-too-ugly
-Regexp that matches mail addresses or names of people of which avatars
-should not be displayed, or @code{nil}. It default to the value of
-@code{gnus-article-x-face-too-ugly} (@pxref{X-Face}).
+Regexp that matches mail addresses or names of people whose avatars
+should not be displayed, or @code{nil} to display all avatars. It
+defaults to the value of @code{gnus-article-x-face-too-ugly}
+(@pxref{X-Face}).
@end table
-If you want to see them in the From field, set:
+If you want to see gravatars in the From field, set:
+
@lisp
(setq gnus-treat-from-gravatar 'head)
@end lisp
diff --git a/etc/NEWS b/etc/NEWS
index cccb801..e1ac4eb 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -535,6 +535,9 @@ be functions.
*** 'cl-defstruct' has a new ':noinline' argument to prevent inlining
its functions.
++++
+*** 'cl-defstruct' slots accept a ':documentation' property
+
---
*** 'cl-values-list' will now signal an error if its argument isn't a list.
@@ -765,6 +768,12 @@ start of a sentence or at '(point-min)', else '@ref'.
It now treats the optional 2nd argument to mean that the URL should be
shown in the currently selected window.
+*** A new function, 'browse-url-add-buttons' can be used to add clickable
+links to most ordinary special-mode buffers that display text that
+have URLs embedded. 'browse-url-button-regexp' controls what's
+considered a button.
+
+*** A new variable, 'browse-url-secondary-browser-function', has been added.
** Comint
+++
@@ -1000,6 +1009,14 @@ offers them to the user to open with 'browse-url'.
This option controls whether and how to use Gnus search groups as
'path:' search terms to 'notmuch'.
+---
++++ The buttons in the Gnus article buffer were formerly widgets
+(i.e., buttons from widget.el). This has now changed, and they are
+now buttons (from button.el), and commands like 'TAB' now search for
+buttons instead of widgets. There should be no user-visible changes,
+but out-of-tree code that relied on widgets being present might now
+fail.
+
** erc
---
@@ -1037,6 +1054,10 @@ has been executed.
If set, shr will not render tags with attribute 'aria-hidden="true"'.
This attribute is meant to tell screen readers to ignore a tag.
++++
+*** 'shr-external-browser' has been made into an obsolete alias
+of 'browse-url-secondary-browser-function'.
+
---
*** 'shr-tag-ol' now respects the ordered list 'start' attribute.
@@ -1955,6 +1976,12 @@ valid event type.
* Lisp Changes in Emacs 27.1
++++
+** Buttons (created with 'make-button' and related functions) can
+now use the 'button-data' property. If present, the data in this
+property will be passed on to the 'action' function instead of the
+button itself in 'button-activate'.
+
** 'defcustom' now takes a ':local' keyword that can be either t or
'permanent', which mean that the variable should be automatically
buffer-local. 'permanent' also sets the variable's 'permanent-local'
@@ -2046,6 +2073,15 @@ TICKS is an integer and HZ is a positive integer
denoting a clock
frequency. The old 'encode-time' API is still supported.
+++
+*** A new package to parse ISO 8601 time, date, durations and
+intervals has been added. The main function to use is
+'iso8601-parse', but there's also 'iso8601-parse-date',
+'iso8601-parse-time', 'iso8601-parse-duration' and
+'iso8601-parse-interval'. All these functions return decoded time
+structures, except the final one, which returns three of them (start,
+end and duration).
+
++++
*** 'time-add', 'time-subtract', and 'time-less-p' now accept
infinities and NaNs too, and propagate them or return nil like
floating-point operators do.
@@ -2059,6 +2095,25 @@ that acts like the '0' flag but also puts a '+' before
nonnegative
years containing more than four digits. This is for compatibility
with POSIX.1-2017.
++++
+*** To access (or alter) the elements a decoded time value, the
+'decoded-time-second', 'decoded-time-minute', 'decoded-time-hour',
+'decoded-time-day', 'decoded-time-month', 'decoded-time-year',
+'decoded-time-weekday', 'decoded-time-dst' and 'decoded-time-zone'
+accessors can be used.
+
+*** The new functions 'date-days-in-month' (which will say how many
+days there are in a month in a specific year), 'date-ordinal-to-time'
+(that computes the date of an ordinal day), 'decoded-time-add' for
+doing computations on a decoded time structure), 'make-decoded-time'
+(for making a decoded time structure with only the given keywords
+filled out), and 'encoded-time-set-defaults' (which fills in nil
+elements as if it's midnight January 1st, 1970) have been added.
+
+*** The new function `time-zone-format' has been added to format
+Emacs time zones (which are in seconds) according to many standards
+(i.e., "+01:00").
+
** 'define-minor-mode' automatically documents the meaning of ARG.
+++
diff --git a/etc/NEWS.25 b/etc/NEWS.25
index 98aec3c..d45f1dd 100644
--- a/etc/NEWS.25
+++ b/etc/NEWS.25
@@ -452,6 +452,11 @@ specified message types for the respective specified
targets.
*** Nick completion is now case-insensitive again after inadvertently
being made case-sensitive in Emacs 24.2.
+** Rcirc
+
+*** Rcirc now supports automatic reconnection.
+Set new user option 'rcirc-reconnect-delay' to non-zero to enable it.
+
** MPC
*** New commands, key binds, and menu items.
diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el
index bd99790..87a5048 100644
--- a/etc/themes/tango-dark-theme.el
+++ b/etc/themes/tango-dark-theme.el
@@ -57,6 +57,7 @@ Semantic, and Ansi-Color faces are included.")
(,class
(:foreground ,alum-1 :background "black"))))
`(cursor ((,class (:background ,butter-1))))
+ `(header-line ((,class (:background "#666"))))
;; Highlighting faces
`(fringe ((,class (:background ,alum-7))))
`(highlight ((,class (:foreground ,alum-6 :background ,butter-2))))
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 5205d49..0be1458 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -644,6 +644,11 @@ Switch to the most recently selected buffer other than the
current one."
(let ((indicator (car (nth 4 (car (cdr event))))))
(describe-minor-mode-from-indicator indicator)))
+(defvar mode-line-defining-kbd-macro (propertize " Def" 'face
'font-lock-warning-face)
+ "String displayed in the mode line in keyboard macro recording mode.")
+;;;###autoload
+(put 'mode-line-defining-kbd-macro 'risky-local-variable t)
+
(defvar minor-mode-alist nil "\
Alist saying how to show minor modes in the mode line.
Each element looks like (VARIABLE STRING);
@@ -653,13 +658,14 @@ Actually, STRING need not be a string; any mode-line
construct is
okay. See `mode-line-format'.")
;;;###autoload
(put 'minor-mode-alist 'risky-local-variable t)
-;; Don't use purecopy here--some people want to change these strings.
+;; Don't use purecopy here--some people want to change these strings,
+;; also string properties are lost when put into pure space.
(setq minor-mode-alist
'((abbrev-mode " Abbrev")
(overwrite-mode overwrite-mode)
(auto-fill-function " Fill")
;; not really a minor mode...
- (defining-kbd-macro " Def")))
+ (defining-kbd-macro mode-line-defining-kbd-macro)))
;; These variables are used by autoloadable packages.
;; They are defined here so that they do not get overridden
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 6406a59..3cea186 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -703,7 +703,8 @@ means list those buffers and no others."
(defun Buffer-menu--pretty-file-name (file)
(cond (file
(abbreviate-file-name file))
- ((bound-and-true-p list-buffers-directory))
+ ((bound-and-true-p list-buffers-directory)
+ (abbreviate-file-name list-buffers-directory))
(t "")))
;;; buff-menu.el ends here
diff --git a/lisp/button.el b/lisp/button.el
index 921e84d..ca6f0d3 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -235,15 +235,19 @@ The action can either be a marker or a function. If it's
a
marker then goto it. Otherwise if it is a function then it is
called with BUTTON as only argument. BUTTON is either an
overlay, a buffer position, or (for buttons in the mode-line or
-header-line) a string."
+header-line) a string.
+
+If BUTTON has a `button-data' value, call the function with this
+value instad of BUTTON."
(let ((action (or (and use-mouse-action (button-get button 'mouse-action))
- (button-get button 'action))))
+ (button-get button 'action)))
+ (data (button-get button 'button-data)))
(if (markerp action)
(save-selected-window
(select-window (display-buffer (marker-buffer action)))
(goto-char action)
(recenter 0))
- (funcall action button))))
+ (funcall action (or data button)))))
(defun button-label (button)
"Return BUTTON's text label."
@@ -324,6 +328,10 @@ using `make-text-button'. Note, however, that if there is
an existing
face property at the site of the button, the button face may not be visible.
You may want to use `make-button' in that case.
+If the property `button-data' is present, it will later be used
+as the argument for the `action' callback function instead of the
+default argument, which is the button itself.
+
BEG can also be a string, in which case it is made into a button.
Also see `insert-text-button'."
@@ -462,13 +470,17 @@ return t."
(button-activate button use-mouse-action)
t))))
-(defun forward-button (n &optional wrap display-message)
+(defun forward-button (n &optional wrap display-message no-error)
"Move to the Nth next button, or Nth previous button if N is negative.
If N is 0, move to the start of any button at point.
If WRAP is non-nil, moving past either end of the buffer continues from the
other end.
If DISPLAY-MESSAGE is non-nil, the button's help-echo string is displayed.
Any button with a non-nil `skip' property is skipped over.
+
+If NO-ERROR, return nil if no further buttons could be found
+instead of erroring out.
+
Returns the button found."
(interactive "p\nd\nd")
(let (button)
@@ -497,22 +509,28 @@ Returns the button found."
(unless (button-get button 'skip)
(setq n (1- n)))))))
(if (null button)
- (user-error (if wrap "No buttons!" "No more buttons"))
+ (if no-error
+ nil
+ (user-error (if wrap "No buttons!" "No more buttons")))
(let ((msg (and display-message (button-get button 'help-echo))))
(when msg
(message "%s" msg)))
button)))
-(defun backward-button (n &optional wrap display-message)
+(defun backward-button (n &optional wrap display-message no-error)
"Move to the Nth previous button, or Nth next button if N is negative.
If N is 0, move to the start of any button at point.
If WRAP is non-nil, moving past either end of the buffer continues from the
other end.
If DISPLAY-MESSAGE is non-nil, the button's help-echo string is displayed.
Any button with a non-nil `skip' property is skipped over.
+
+If NO-ERROR, return nil if no further buttons could be found
+instead of erroring out.
+
Returns the button found."
(interactive "p\nd\nd")
- (forward-button (- n) wrap display-message))
+ (forward-button (- n) wrap display-message no-error))
(provide 'button)
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index eb1a824..bdfc0e4 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -41,7 +41,9 @@
(calc-enter-result 0 "time"
(list 'mod
(list 'hms
- (nth 2 time) (nth 1 time) (nth 0 time))
+ (decoded-time-hour time)
+ (decoded-time-minute time)
+ (decoded-time-second time))
(list 'hms 24 0 0))))))
(defun calc-to-hms (arg)
@@ -523,7 +525,7 @@ in the Gregorian calendar and the remaining part determines
the time."
(defun math-this-year ()
- (nth 5 (decode-time)))
+ (decoded-time-year (decode-time)))
(defun math-leap-year-p (year &optional julian)
"Non-nil if YEAR is a leap year.
@@ -1341,8 +1343,12 @@ as measured in the integer number of days before
December 31, 1 BC (Gregorian)."
(defun calcFunc-now (&optional zone)
(let ((date (let ((now (decode-time)))
(list 'date (math-dt-to-date
- (list (nth 5 now) (nth 4 now) (nth 3 now)
- (nth 2 now) (nth 1 now) (nth 0 now)))))))
+ (list (decoded-time-year now)
+ (decoded-time-month now)
+ (decoded-time-day now)
+ (decoded-time-hour now)
+ (decoded-time-minute now)
+ (decoded-time-second now)))))))
(if zone
(math-add date (math-div (math-sub (calcFunc-tzone nil date)
(calcFunc-tzone zone date))
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index b7aa212..944054e 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -325,7 +325,7 @@ displayed in a window:
(prev-appt-display-count appt-display-count)
;; Convert current time to minutes after midnight (12.01am = 1).
(now (decode-time))
- (now-mins (+ (* 60 (nth 2 now)) (nth 1 now)))
+ (now-mins (+ (* 60 (decoded-time-hour now)) (decoded-time-minute
now)))
appt-mins appt-warn-time min-to-app min-list string-list)
(save-excursion ; FIXME ?
;; At first check in any day, update appointments to today's list.
@@ -647,7 +647,8 @@ Any appointments made with `appt-add' are not affected by
this function."
;; Convert current time to minutes after midnight (12:01am = 1),
;; and remove elements in the list that are in the past.
(let* ((now (decode-time))
- (now-mins (+ (* 60 (nth 2 now)) (nth 1 now))))
+ (now-mins (+ (* 60 (decoded-time-hour now))
+ (decoded-time-minute now))))
(while (and appt-time-msg-list
(< (caar (car appt-time-msg-list)) now-mins))
(setq appt-time-msg-list (cdr appt-time-msg-list)))))))
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index e0126a6..510cd68 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -259,7 +259,7 @@ for `calendar-current-time-zone'."
(car t2-date-sec) t1-utc-diff))
(t1-time (/ (cdr t1-date-sec) 60))
(t2-time (/ (cdr t2-date-sec) 60)))
- (if (nth 7 (decode-time t1))
+ (if (decoded-time-dst (decode-time t1))
(list (/ t0-utc-diff 60) (/ (- t1-utc-diff t0-utc-diff) 60)
t0-name t1-name t1-rules t2-rules t1-time t2-time)
(list (/ t1-utc-diff 60) (/ (- t0-utc-diff t1-utc-diff) 60)
@@ -291,7 +291,8 @@ the current year."
(condition-case nil
(encode-time 1 0 0 1 1 year)
(error
- (encode-time 1 0 0 1 1 (nth 5 (decode-time))))))
+ (encode-time 1 0 0 1 1
+ (decoded-time-year (decode-time))))))
f (nth 4 e)
e (list year f (nth 5 e))
calendar-dst-transition-cache
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 1e988c2..14604a6 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1871,7 +1871,9 @@ the STRINGS are just concatenated and the result
truncated."
"Return the current date in a list (month day year).
Optional integer OFFSET is a number of days from the current date."
(let* ((now (decode-time))
- (now (list (nth 4 now) (nth 3 now) (nth 5 now))))
+ (now (list (decoded-time-month now)
+ (decoded-time-day now)
+ (decoded-time-year now))))
(if (zerop (or offset 0))
now
(calendar-gregorian-from-absolute
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 17316dd..cf3315b 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -721,12 +721,12 @@ Both times must be given in decoded form. One of these
times must be
valid (year > 1900 or something)."
;; FIXME: does this function exist already?
(decode-time (encode-time
- (+ (nth 0 time1) (nth 0 time2))
- (+ (nth 1 time1) (nth 1 time2))
- (+ (nth 2 time1) (nth 2 time2))
- (+ (nth 3 time1) (nth 3 time2))
- (+ (nth 4 time1) (nth 4 time2))
- (+ (nth 5 time1) (nth 5 time2))
+ (+ (decoded-time-second time1) (decoded-time-second time2))
+ (+ (decoded-time-minute time1) (decoded-time-minute time2))
+ (+ (decoded-time-hour time1) (decoded-time-hour time2))
+ (+ (decoded-time-day time1) (decoded-time-day time2))
+ (+ (decoded-time-month time1) (decoded-time-month time2))
+ (+ (decoded-time-year time1) (decoded-time-year time2))
nil
nil
;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME?
@@ -1623,9 +1623,9 @@ enumeration, given as a Lisp time value -- used for test
purposes."
(lambda (offset)
(let* ((day (decode-time (time-add now
(* 60 60 24 offset))))
- (d (nth 3 day))
- (m (nth 4 day))
- (y (nth 5 day))
+ (d (decoded-time-day day))
+ (m (decoded-time-month day))
+ (y (decoded-time-year day))
(se (diary-sexp-entry p1 p2 (list m d y)))
(see (cond ((stringp se) se)
((consp se) (cdr se))
diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el
new file mode 100644
index 0000000..c69156c
--- /dev/null
+++ b/lisp/calendar/iso8601.el
@@ -0,0 +1,356 @@
+;;; iso8601.el --- parse ISO 8601 date/time strings -*- lexical-binding:t -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; Keywords: dates
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; ISO8601 times basically look like 1985-04-01T15:23:49... Or so
+;; you'd think. This is what everybody means when they say "ISO8601",
+;; but it's in reality a quite large collection of syntaxes, including
+;; week numbers, ordinal dates, durations and intervals. This package
+;; has functions for parsing them all.
+;;
+;; The interface functions are `iso8601-parse', `iso8601-parse-date',
+;; `iso8601-parse-time', `iso8601-parse-zone',
+;; `iso8601-parse-duration' and `iso8601-parse-interval'. They all
+;; return decoded time objects, except the last one, which returns a
+;; list of three of them.
+;;
+;; (iso8601-parse-interval "P1Y2M10DT2H30M/2008W32T153000-01")
+;; '((0 0 13 24 5 2007 nil nil -3600)
+;; (0 30 15 3 8 2008 nil nil -3600)
+;; (0 30 2 10 2 1 nil nil nil))
+;;
+;;
+;; The standard can be found at:
+;;
+;;
http://www.loc.gov/standards/datetime/iso-tc154-wg5_n0038_iso_wd_8601-1_2016-02-16.pdf
+;;
+;; The Wikipedia page on the standard is also informative:
+;;
+;; https://en.wikipedia.org/wiki/ISO_8601
+;;
+;; RFC3339 defines the subset that everybody thinks of as "ISO8601".
+
+;;; Code:
+
+(require 'time-date)
+(require 'cl-lib)
+
+(defun iso8601--concat-regexps (regexps)
+ (mapconcat (lambda (regexp)
+ (concat "\\(?:"
+ (replace-regexp-in-string "(" "(?:" regexp)
+ "\\)"))
+ regexps "\\|"))
+
+(defconst iso8601--year-match
+ "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)")
+(defconst iso8601--full-date-match
+ "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)-?\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)")
+(defconst iso8601--without-day-match
+ "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)")
+(defconst iso8601--outdated-date-match
+ "--\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)")
+(defconst iso8601--week-date-match
+ "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)-?W\\([0-9][0-9]\\)-?\\([0-9]\\)?")
+(defconst iso8601--ordinal-date-match
+ "\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)-?\\([0-9][0-9][0-9]\\)")
+(defconst iso8601--date-match
+ (iso8601--concat-regexps
+ (list iso8601--year-match
+ iso8601--full-date-match
+ iso8601--without-day-match
+ iso8601--outdated-date-match
+ iso8601--week-date-match
+ iso8601--ordinal-date-match)))
+
+(defconst iso8601--time-match
+
"\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?:?\\([0-9][0-9]\\)?\\.?\\([0-9][0-9][0-9]\\)?")
+
+(defconst iso8601--zone-match
+ "\\(Z\\|\\([-+]\\)\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?\\)")
+
+(defconst iso8601--full-time-match
+ (concat "\\(" (replace-regexp-in-string "(" "(?:" iso8601--time-match) "\\)"
+ "\\(" iso8601--zone-match "\\)?"))
+
+(defconst iso8601--combined-match
+ (concat "\\(" iso8601--date-match "\\)"
+ "\\(?:T\\("
+ (replace-regexp-in-string "(" "(?:" iso8601--time-match)
+ "\\)"
+ "\\(" iso8601--zone-match "\\)?\\)?"))
+
+(defconst iso8601--duration-full-match
+
"P\\([0-9]+Y\\)?\\([0-9]+M\\)?\\([0-9]+D\\)?\\(T\\([0-9]+H\\)?\\([0-9]+M\\)?\\([0-9]+S\\)?\\)?")
+(defconst iso8601--duration-week-match
+ "P\\([0-9]+\\)W")
+(defconst iso8601--duration-combined-match
+ (concat "P" iso8601--combined-match))
+(defconst iso8601--duration-match
+ (iso8601--concat-regexps
+ (list iso8601--duration-full-match
+ iso8601--duration-week-match
+ iso8601--duration-combined-match)))
+
+(defun iso8601-parse (string)
+ "Parse an ISO 8601 date/time string and return a `decoded-time' structure.
+
+The ISO 8601 date/time strings look like \"2008-03-02T13:47:30\",
+but shorter, incomplete strings like \"2008-03-02\" are valid, as
+well as variants like \"2008W32\" (week number) and
+\"2008-234\" (ordinal day number)."
+ (if (not (iso8601-valid-p string))
+ (signal 'wrong-type-argument string)
+ (let* ((date-string (match-string 1 string))
+ (time-string (match-string 2 string))
+ (zone-string (match-string 3 string))
+ (date (iso8601-parse-date date-string)))
+ ;; The time portion is optional.
+ (when time-string
+ (let ((time (iso8601-parse-time time-string)))
+ (setf (decoded-time-hour date) (decoded-time-hour time))
+ (setf (decoded-time-minute date) (decoded-time-minute time))
+ (setf (decoded-time-second date) (decoded-time-second time))))
+ ;; The time zone is optional.
+ (when zone-string
+ (setf (decoded-time-zone date)
+ ;; The time zone in decoded times are in seconds.
+ (* (iso8601-parse-zone zone-string) 60)))
+ date)))
+
+(defun iso8601-parse-date (string)
+ "Parse STRING (which should be on ISO 8601 format) and return a time value."
+ (cond
+ ;; Just a year: [-+]YYYY.
+ ((iso8601--match iso8601--year-match string)
+ (iso8601--decoded-time
+ :year (iso8601--adjust-year (match-string 1 string)
+ (match-string 2 string))))
+ ;; Calendar dates: YYYY-MM-DD and variants.
+ ((iso8601--match iso8601--full-date-match string)
+ (iso8601--decoded-time
+ :year (iso8601--adjust-year (match-string 1 string)
+ (match-string 2 string))
+ :month (match-string 3 string)
+ :day (match-string 4 string)))
+ ;; Calendar date without day: YYYY-MM.
+ ((iso8601--match iso8601--without-day-match string)
+ (iso8601--decoded-time
+ :year (iso8601--adjust-year (match-string 1 string)
+ (match-string 2 string))
+ :month (match-string 3 string)))
+ ;; Outdated date without year: --MM-DD
+ ((iso8601--match iso8601--outdated-date-match string)
+ (iso8601--decoded-time
+ :month (match-string 1 string)
+ :day (match-string 2 string)))
+ ;; Week dates: YYYY-Www-D
+ ((iso8601--match iso8601--week-date-match string)
+ (let* ((year (iso8601--adjust-year (match-string 1 string)
+ (match-string 2 string)))
+ (week (string-to-number (match-string 3 string)))
+ (day-of-week (and (match-string 4 string)
+ (string-to-number (match-string 4 string))))
+ (jan-start (decoded-time-weekday
+ (decode-time
+ (iso8601--encode-time
+ (iso8601--decoded-time :year year
+ :month 1
+ :day 4)))))
+ (correction (+ (if (zerop jan-start) 7 jan-start)
+ 3))
+ (ordinal (+ (* week 7) (or day-of-week 0) (- correction))))
+ (cond
+ ;; Monday 29 December 2008 is written "2009-W01-1".
+ ((< ordinal 1)
+ (setq year (1- year)
+ ordinal (+ ordinal (if (date-leap-year-p year)
+ 366 365))))
+ ;; Sunday 3 January 2010 is written "2009-W53-7".
+ ((> ordinal (if (date-leap-year-p year)
+ 366 365))
+ (setq ordinal (- ordinal (if (date-leap-year-p year)
+ 366 365))
+ year (1+ year))))
+ (let ((month-day (date-ordinal-to-time year ordinal)))
+ (iso8601--decoded-time :year year
+ :month (decoded-time-month month-day)
+ :day (decoded-time-day month-day)))))
+ ;; Ordinal dates: YYYY-DDD
+ ((iso8601--match iso8601--ordinal-date-match string)
+ (let* ((year (iso8601--adjust-year (match-string 1 string)
+ (match-string 2 string)))
+ (ordinal (string-to-number (match-string 3 string)))
+ (month-day (date-ordinal-to-time year ordinal)))
+ (iso8601--decoded-time :year year
+ :month (decoded-time-month month-day)
+ :day (decoded-time-day month-day))))
+ (t
+ (signal 'wrong-type-argument string))))
+
+(defun iso8601--adjust-year (sign year)
+ (save-match-data
+ (let ((year (if (stringp year)
+ (string-to-number year)
+ year)))
+ (if (string= sign "-")
+ ;; -0001 is 2 BCE.
+ (1- (- year))
+ year))))
+
+(defun iso8601-parse-time (string)
+ "Parse STRING, which should be an ISO 8601 time string, and return a time
value."
+ (if (not (iso8601--match iso8601--full-time-match string))
+ (signal 'wrong-type-argument string)
+ (let ((time (match-string 1 string))
+ (zone (match-string 2 string)))
+ (if (not (iso8601--match iso8601--time-match time))
+ (signal 'wrong-type-argument string)
+ (let ((hour (string-to-number (match-string 1 time)))
+ (minute (and (match-string 2 time)
+ (string-to-number (match-string 2 time))))
+ (second (and (match-string 3 time)
+ (string-to-number (match-string 3 time))))
+ ;; Hm...
+ (_millisecond (and (match-string 4 time)
+ (string-to-number (match-string 4 time)))))
+ (iso8601--decoded-time :hour hour
+ :minute (or minute 0)
+ :second (or second 0)
+ :zone (and zone
+ (* 60 (iso8601-parse-zone
+ zone)))))))))
+
+(defun iso8601-parse-zone (string)
+ "Parse STRING, which should be an ISO 8601 time zone.
+Return the number of minutes."
+ (if (not (iso8601--match iso8601--zone-match string))
+ (signal 'wrong-type-argument string)
+ (if (match-string 2 string)
+ ;; HH:MM-ish.
+ (let ((hour (string-to-number (match-string 3 string)))
+ (minute (and (match-string 4 string)
+ (string-to-number (match-string 4 string)))))
+ (* (if (equal (match-string 2 string) "-")
+ -1
+ 1)
+ (+ (* hour 60)
+ (or minute 0))))
+ ;; "Z".
+ 0)))
+
+(defun iso8601-valid-p (string)
+ "Say whether STRING is a valid ISO 8601 representation."
+ (iso8601--match iso8601--combined-match string))
+
+(defun iso8601-parse-duration (string)
+ "Parse ISO 8601 durations on the form P3Y6M4DT12H30M5S."
+ (cond
+ ((and (iso8601--match iso8601--duration-full-match string)
+ ;; Just a "P" isn't valid; there has to be at least one
+ ;; element, like P1M.
+ (> (length (match-string 0 string)) 2))
+ (iso8601--decoded-time :year (or (match-string 1 string) 0)
+ :month (or (match-string 2 string) 0)
+ :day (or (match-string 3 string) 0)
+ :hour (or (match-string 5 string) 0)
+ :minute (or (match-string 6 string) 0)
+ :second (or (match-string 7 string) 0)))
+ ;; PnW: Weeks.
+ ((iso8601--match iso8601--duration-week-match string)
+ (let ((weeks (string-to-number (match-string 1 string))))
+ ;; Does this make sense? Hm...
+ (iso8601--decoded-time :day (* weeks 7))))
+ ;; P<date>T<time>
+ ((iso8601--match iso8601--duration-combined-match string)
+ (iso8601-parse (substring string 1)))
+ (t
+ (signal 'wrong-type-argument string))))
+
+(defun iso8601-parse-interval (string)
+ "Parse ISO 8601 intervals."
+ (let ((bits (split-string string "/"))
+ start end duration)
+ (if (not (= (length bits) 2))
+ (signal 'wrong-type-argument string)
+ ;; The intervals may be an explicit start/end times, or either a
+ ;; start or an end, and an accompanying duration.
+ (cond
+ ((and (string-match "\\`P" (car bits))
+ (iso8601-valid-p (cadr bits)))
+ (setq duration (iso8601-parse-duration (car bits))
+ end (iso8601-parse (cadr bits))))
+ ((and (string-match "\\`P" (cadr bits))
+ (iso8601-valid-p (car bits)))
+ (setq duration (iso8601-parse-duration (cadr bits))
+ start (iso8601-parse (car bits))))
+ ((and (iso8601-valid-p (car bits))
+ (iso8601-valid-p (cadr bits)))
+ (setq start (iso8601-parse (car bits))
+ end (iso8601-parse (cadr bits))))
+ (t
+ (signal 'wrong-type-argument string))))
+ (unless end
+ (setq end (decoded-time-add start duration)))
+ (unless start
+ (setq start (decoded-time-add end
+ ;; We negate the duration so that
+ ;; we get a subtraction.
+ (mapcar (lambda (elem)
+ (if (numberp elem)
+ (- elem)
+ elem))
+ duration))))
+ (list start end
+ (or duration
+ (decode-time (time-subtract (iso8601--encode-time end)
+ (iso8601--encode-time start))
+ (or (decoded-time-zone end) 0))))))
+
+(defun iso8601--match (regexp string)
+ (string-match (concat "\\`" regexp "\\'") string))
+
+(defun iso8601--value (elem &optional default)
+ (if (stringp elem)
+ (string-to-number elem)
+ (or elem default)))
+
+(cl-defun iso8601--decoded-time (&key second minute hour
+ day month year
+ dst zone)
+ (list (iso8601--value second)
+ (iso8601--value minute)
+ (iso8601--value hour)
+ (iso8601--value day)
+ (iso8601--value month)
+ (iso8601--value year)
+ nil
+ dst
+ zone))
+
+(defun iso8601--encode-time (time)
+ "Like `encode-time', but fill in nil values in TIME."
+ (encode-time (decoded-time-set-defaults (copy-sequence time))))
+
+(provide 'iso8601)
+
+;;; iso8601.el ends here
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index 68d6ce0..e28df97 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -36,6 +36,8 @@
;;; Code:
(require 'cl-lib)
+(require 'iso8601)
+(eval-when-compile (require 'subr-x))
;; Byte-compiler warnings
(defvar parse-time-elt)
@@ -193,75 +195,17 @@ unknown DST value is returned as -1."
(setf (nth (pop slots) time) new-val))))))))
time))
-(defconst parse-time-iso8601-regexp
- (let* ((dash "-?")
- (colon ":?")
- (4digit "\\([0-9][0-9][0-9][0-9]\\)")
- (2digit "\\([0-9][0-9]\\)")
- (date-fullyear 4digit)
- (date-month 2digit)
- (date-mday 2digit)
- (time-hour 2digit)
- (time-minute 2digit)
- (time-second 2digit)
- (time-secfrac "\\(\\.[0-9]+\\)?")
- (time-numoffset (concat "\\([-+]\\)" time-hour ":?" time-minute "?"))
- (partial-time (concat time-hour colon time-minute colon time-second
- time-secfrac))
- (full-date (concat date-fullyear dash date-month dash date-mday)))
- (list (concat "^" full-date)
- (concat "T" partial-time)
- (concat "\\(Z\\|" time-numoffset "\\)")))
- "List of regular expressions matching ISO 8601 dates.
-1st regular expression matches the date.
-2nd regular expression matches the time.
-3rd regular expression matches the (optional) timezone specification.")
-
(defun parse-iso8601-time-string (date-string)
"Parse an ISO 8601 time string, such as 2016-12-01T23:35:06-05:00.
If DATE-STRING cannot be parsed, it falls back to
`parse-time-string'."
- (let* ((date-re (nth 0 parse-time-iso8601-regexp))
- (time-re (nth 1 parse-time-iso8601-regexp))
- (tz-re (nth 2 parse-time-iso8601-regexp))
- re-start
- time seconds minute hour
- day month year day-of-week (dst -1) tz)
- ;; We need to populate 'time' with
- ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
-
- ;; Nobody else handles iso8601 correctly, let's do it ourselves.
- (when (string-match date-re date-string re-start)
- (setq year (string-to-number (match-string 1 date-string))
- month (string-to-number (match-string 2 date-string))
- day (string-to-number (match-string 3 date-string))
- re-start (match-end 0))
- (when (string-match time-re date-string re-start)
- (setq hour (string-to-number (match-string 1 date-string))
- minute (string-to-number (match-string 2 date-string))
- seconds (string-to-number (match-string 3 date-string))
- re-start (match-end 0))
- (when (string-match tz-re date-string re-start)
- (setq dst nil)
- (setq tz (if (string= "Z" (match-string 1 date-string))
- 0 ;; UTC timezone indicated by Z
- (let ((tz (+
- (* 3600
- (string-to-number
- (match-string 3 date-string)))
- (* 60
- (string-to-number
- (or (match-string 4 date-string) "0"))))))
- (if (string= "-" (match-string 2 date-string))
- (- tz) tz)))))
- (setq time (list seconds minute hour day month year day-of-week dst
tz))))
-
- ;; Fall back to having `parse-time-string' do fancy things for us.
- (when (not time)
- (setq time (parse-time-string date-string)))
-
- (and time
- (encode-time time))))
+ (when-let ((time
+ (if (iso8601-valid-p date-string)
+ (decoded-time-set-defaults (iso8601-parse date-string))
+ ;; Fall back to having `parse-time-string' do fancy
+ ;; things for us.
+ (parse-time-string date-string))))
+ (encode-time time)))
(provide 'parse-time)
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 2c0280c..b94bf52 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -36,6 +36,9 @@
;;; Code:
+(require 'cl-lib)
+(require 'subr-x)
+
(defmacro with-decoded-time-value (varlist &rest body)
"Decode a time value and bind it according to VARLIST, then eval BODY.
@@ -234,7 +237,7 @@ DATE1 and DATE2 should be date-time strings."
TIME should be a time value.
The Gregorian date Sunday, December 31, 1bce is imaginary."
(let* ((tim (decode-time time))
- (year (nth 5 tim)))
+ (year (decoded-time-year tim)))
(+ (time-date--day-in-year tim) ; Days this year
(* 365 (1- year)) ; + Days in prior years
(/ (1- year) 4) ; + Julian leap years
@@ -349,6 +352,196 @@ is output until the first non-zero unit is encountered."
(<= (car here) delay)))
(concat (format "%.2f" (/ delay (car (cddr here)))) (cadr
here))))))
+(defun time-zone-format (seconds &optional short)
+ "Format SECONDS as a valid time zone string.
+For instance, 3600 is \"+01:00\".
+If SHORT, the colon isn't included."
+ (format "%s%02d%s%02d"
+ (if (< seconds 0)
+ "-"
+ "+")
+ (/ (abs seconds) 3600)
+ (if short
+ ""
+ ":")
+ (mod (abs seconds) 3600)))
+
+(defun date-days-in-month (year month)
+ "The number of days in MONTH in YEAR."
+ (if (= month 2)
+ (if (date-leap-year-p year)
+ 29
+ 28)
+ (if (memq month '(1 3 5 7 8 10 12))
+ 31
+ 30)))
+
+(defun date-ordinal-to-time (year ordinal)
+ "Convert a YEAR/ORDINAL to the equivalent `decoded-time' structure.
+ORDINAL is the number of days since the start of the year, with
+January 1st being 1."
+ (let ((month 1))
+ (while (> ordinal (date-days-in-month year month))
+ (setq ordinal (- ordinal (date-days-in-month year month))
+ month (1+ month)))
+ (list nil nil nil ordinal month year nil nil nil)))
+
+(defun decoded-time-add (time delta)
+ "Add DELTA to TIME, both of which are `decoded-time' structures.
+TIME should represent a time, while DELTA should only have
+non-nil integers for the values that should be altered.
+
+For instance, if you want to \"add two months\" to TIME, then
+leave all other fields but the month field in DELTA nil, and make
+the month field 2. The values in DELTA can be negative.
+
+If applying a month/year delta leaves the time spec invalid, it
+is decreased to be valid (\"add one month\" to January 31st 2019
+will yield a result of February 28th 2019 and \"add one year\" to
+February 29th 2020 will result in February 28th 2021).
+
+Fields are added in a most to least significant order, so if the
+adjustment described above happens, it happens before adding
+days, hours, minutes or seconds.
+
+When changing the time bits in TIME (i.e., second/minute/hour),
+changes in daylight saving time are not taken into account."
+ (let ((time (copy-sequence time))
+ seconds)
+ ;; Years are simple.
+ (when (decoded-time-year delta)
+ (cl-incf (decoded-time-year time) (decoded-time-year delta)))
+
+ ;; Months are pretty simple.
+ (when (decoded-time-month delta)
+ (let ((new (+ (decoded-time-month time) (decoded-time-month delta))))
+ (setf (decoded-time-month time) (mod new 12))
+ (cl-incf (decoded-time-year time) (/ new 12))))
+
+ ;; Adjust for month length (as described in the doc string).
+ (setf (decoded-time-day time)
+ (min (date-days-in-month (decoded-time-year time)
+ (decoded-time-month time))
+ (decoded-time-day time)))
+
+ ;; Days are iterative.
+ (when-let* ((days (decoded-time-day delta)))
+ (let ((increase (> days 0))
+ (days (abs days)))
+ (while (> days 0)
+ (decoded-time--alter-day time increase)
+ (cl-decf days))))
+
+ ;; Do the time part, which is pretty simple (except for leap
+ ;; seconds, I guess).
+ (setq seconds (+ (* (or (decoded-time-hour delta) 0) 3600)
+ (* (or (decoded-time-minute delta) 0) 60)
+ (or (decoded-time-second delta) 0)))
+
+ ;; Time zone adjustments are basically the same as time adjustments.
+ (setq seconds (+ seconds (or (decoded-time-zone delta) 0)))
+
+ (cond
+ ((> seconds 0)
+ (decoded-time--alter-second time seconds t))
+ ((< seconds 0)
+ (decoded-time--alter-second time (abs seconds) nil)))
+
+ time))
+
+(defun decoded-time--alter-month (time increase)
+ "Increase or decrease the month in TIME by 1."
+ (if increase
+ (progn
+ (cl-incf (decoded-time-month time))
+ (when (> (decoded-time-month time) 12)
+ (setf (decoded-time-month time) 1)
+ (cl-incf (decoded-time-year time))))
+ (cl-decf (decoded-time-month time))
+ (when (zerop (decoded-time-month time))
+ (setf (decoded-time-month time) 12)
+ (cl-decf (decoded-time-year time)))))
+
+(defun decoded-time--alter-day (time increase)
+ "Increase or decrease the day in TIME by 1."
+ (if increase
+ (progn
+ (cl-incf (decoded-time-day time))
+ (when (> (decoded-time-day time)
+ (date-days-in-month (decoded-time-year time)
+ (decoded-time-month time)))
+ (setf (decoded-time-day time) 1)
+ (decoded-time--alter-month time t)))
+ (cl-decf (decoded-time-day time))
+ (when (zerop (decoded-time-day time))
+ (decoded-time--alter-month time nil)
+ (setf (decoded-time-day time)
+ (date-days-in-month (decoded-time-year time)
+ (decoded-time-month time))))))
+
+(defun decoded-time--alter-second (time seconds increase)
+ "Increase or decrease the time in TIME by SECONDS."
+ (let ((old (+ (* (or (decoded-time-hour time) 0) 3600)
+ (* (or (decoded-time-minute time) 0) 60)
+ (or (decoded-time-second time) 0))))
+
+ (if increase
+ (progn
+ (setq old (+ old seconds))
+ (setf (decoded-time-second time) (% old 60)
+ (decoded-time-minute time) (% (/ old 60) 60)
+ (decoded-time-hour time) (% (/ old 3600) 24))
+ ;; Hm... DST...
+ (let ((days (/ old (* 60 60 24))))
+ (while (> days 0)
+ (decoded-time--alter-day time t)
+ (cl-decf days))))
+ (setq old (abs (- old seconds)))
+ (setf (decoded-time-second time) (% old 60)
+ (decoded-time-minute time) (% (/ old 60) 60)
+ (decoded-time-hour time) (% (/ old 3600) 24))
+ ;; Hm... DST...
+ (let ((days (/ old (* 60 60 24))))
+ (while (> days 0)
+ (decoded-time--alter-day time nil)
+ (cl-decf days))))))
+
+(cl-defun make-decoded-time (&key second minute hour
+ day month year
+ dst zone)
+ "Return a `decoded-time' structure with only the keywords given filled out."
+ (list second minute hour day month year nil dst zone))
+
+(defun decoded-time-set-defaults (time &optional default-zone)
+ "Set any nil values in `decoded-time' TIME to default values.
+The default value is based on January 1st, 1970 at midnight.
+
+TIME is modified and returned."
+ (unless (decoded-time-second time)
+ (setf (decoded-time-second time) 0))
+ (unless (decoded-time-minute time)
+ (setf (decoded-time-minute time) 0))
+ (unless (decoded-time-hour time)
+ (setf (decoded-time-hour time) 0))
+
+ (unless (decoded-time-day time)
+ (setf (decoded-time-day time) 1))
+ (unless (decoded-time-month time)
+ (setf (decoded-time-month time) 1))
+ (unless (decoded-time-year time)
+ (setf (decoded-time-year time) 0))
+
+ ;; When we don't have a time zone and we don't have a DST, then mark
+ ;; it as unknown.
+ (when (and (not (decoded-time-zone time))
+ (not (decoded-time-dst time)))
+ (setf (decoded-time-dst time) -1))
+
+ (when (and (not (decoded-time-zone time))
+ default-zone)
+ (setf (decoded-time-zone time) 0))
+ time)
+
(provide 'time-date)
;;; time-date.el ends here
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index 3735115..60586e7 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -1139,9 +1139,9 @@ discrepancy, today's discrepancy, and the time worked
today."
"Given a time within a day, return 0:0:0 within that day.
If optional argument TIME is non-nil, use that instead of the current time."
(let ((decoded (decode-time time)))
- (setcar (nthcdr 0 decoded) 0)
- (setcar (nthcdr 1 decoded) 0)
- (setcar (nthcdr 2 decoded) 0)
+ (setf (decoded-time-second decoded) 0)
+ (setf (decoded-time-minute decoded) 0)
+ (setf (decoded-time-hour decoded) 0)
(encode-time decoded)))
(defun timeclock-mean (l)
diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index f379229..d8d2ebc 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -27,16 +27,24 @@
(defconst char-fold--default-include
'((?\" "＂" "“" "”" "”" "„" "⹂" "〞" "‟" "‟" "❞" "❝" "❠" "“" "„" "〝" "〟" "🙷"
"🙶" "🙸" "«" "»")
(?' "❟" "❛" "❜" "‘" "’" "‚" "‛" "‚" "" "❮" "❯" "‹" "›")
- (?` "❛" "‘" "‛" "" "❮" "‹")))
- (defconst char-fold--default-exclude nil)
+ (?` "❛" "‘" "‛" "" "❮" "‹")
+ (?ß "ss") ;; de
+ (?ι "ΐ") ;; el for (?ΐ "ΐ") decomposition
+ (?υ "ΰ") ;; el for (?ΰ "ΰ") decomposition
+ ))
+ (defconst char-fold--default-exclude
+ '(
+ (?и "й") ;; ru
+ ))
(defconst char-fold--default-symmetric nil)
- (defconst char-fold--previous (list char-fold--default-include
- char-fold--default-exclude
- char-fold--default-symmetric)))
+ (defvar char-fold--previous
+ (list char-fold--default-include
+ char-fold--default-exclude
+ char-fold--default-symmetric)))
(eval-and-compile
- (defun char-fold-make-table ()
+ (defun char-fold--make-table ()
(let* ((equiv (make-char-table 'char-fold-table))
(equiv-multi (make-char-table 'char-fold-table))
(table (unicode-property-table-internal 'decomposition)))
@@ -196,7 +204,7 @@
(defconst char-fold-table
(eval-when-compile
- (char-fold-make-table))
+ (char-fold--make-table))
"Used for folding characters of the same group during search.
This is a char-table with the `char-fold-table' subtype.
@@ -221,14 +229,15 @@ Exceptionally for the space character (32), ALIST is
ignored.")
(defun char-fold-update-table ()
+ "Update char-fold-table only when one of the options changes its value."
(let ((new (list (or (bound-and-true-p char-fold-include)
char-fold--default-include)
(or (bound-and-true-p char-fold-exclude)
char-fold--default-exclude)
(or (bound-and-true-p char-fold-symmetric)
- char-fold--default-symmetric))))
+ char-fold--default-symmetric))))
(unless (equal char-fold--previous new)
- (setq char-fold-table (char-fold-make-table)
+ (setq char-fold-table (char-fold--make-table)
char-fold--previous new))))
(defcustom char-fold-include char-fold--default-include
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 8be2b94..ba53aeb 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -88,8 +88,6 @@ into help buttons that call `describe-text-category' or
(insert-text-button
(format "%S" value)
'type 'help-face 'help-args (list value)))
- ((widgetp value)
- (describe-text-widget value))
(t
(describe-text-sexp value))))
(insert "\n")))
diff --git a/lisp/dired.el b/lisp/dired.el
index 738d5fc..d47393b 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -3326,7 +3326,7 @@ or \"* [3 files]\"."
(defun dired-pop-to-buffer (buf)
"Pop up buffer BUF in a way suitable for Dired."
- (declare (obsolete nil "24.3"))
+ (declare (obsolete pop-to-buffer "24.3"))
(let ((split-window-preferred-function
(lambda (window)
(or (and (let ((split-height-threshold 0))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c3687c2..6dcd4c6 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1037,9 +1037,10 @@ If STR is something like \"Buffer foo.el\", return
#<buffer foo.el>
we go into emacs-lisp-compilation-mode.")
(defcustom emacs-lisp-compilation-search-path '(nil)
- "Search path for byte-compile error messages.
-Elements should be directory names, not file names of directories.
-The value nil as an element means to try the default directory."
+ "Directories to search for files named in byte-compile error messages.
+Value should be a list of directory names, not file names of
+directories. The value nil as an element means the byte-compile
+message buffer `default-directory'."
:version "27.1"
:type '(repeat (choice (const :tag "Default" nil)
(string :tag "Directory"))))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 8b9224b..1ae7266 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2722,8 +2722,10 @@ node `(cl)Structures' for the description of the options.
Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where
SDEFAULT is the default value of that slot and SOPTIONS are keyword-value
pairs for that slot.
-Currently, only one keyword is supported, `:read-only'. If this has a
-non-nil value, that slot cannot be set via `setf'.
+Supported keywords for slots are:
+- `:read-only': If this has a non-nil value, that slot cannot be set via
`setf'.
+- `:documentation': this is a docstring describing the slot.
+- `:type': the type of the field; currently unused.
\(fn NAME &optional DOCSTRING &rest SLOTS)"
(declare (doc-string 2) (indent 1)
@@ -2902,14 +2904,17 @@ non-nil value, that slot cannot be set via `setf'.
defaults))
(if (assq slot descp)
(error "Duplicate slots named %s in %s" slot name))
- (let ((accessor (intern (format "%s%s" conc-name slot))))
+ (let ((accessor (intern (format "%s%s" conc-name slot)))
+ (default-value (pop desc))
+ (doc (plist-get desc :documentation)))
(push slot slots)
- (push (pop desc) defaults)
+ (push default-value defaults)
;; The arg "cl-x" is referenced by name in eg pred-form
;; and pred-check, so changing it is not straightforward.
(push `(,defsym ,accessor (cl-x)
- ,(format "Access slot \"%s\" of `%s' struct CL-X."
- slot name)
+ ,(format "Access slot \"%s\" of `%s' struct CL-X.%s"
+ slot name
+ (if doc (concat "\n" doc) ""))
(declare (side-effect-free t))
,@(and pred-check
(list `(or ,pred-check
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index dc867d6..a6578e3 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -113,9 +113,9 @@
;;;###autoload
(defmacro define-derived-mode (child parent name &optional docstring &rest
body)
- "Create a new mode as a variant of an existing mode.
+ "Create a new mode CHILD which is a variant of an existing mode PARENT.
-The arguments to this command are as follow:
+The arguments are as follows:
CHILD: the name of the command for the derived mode.
PARENT: the name of the command for the parent mode (e.g. `text-mode')
@@ -123,25 +123,28 @@ PARENT: the name of the command for the parent mode
(e.g. `text-mode')
NAME: a string which will appear in the status line (e.g. \"Hypertext\")
DOCSTRING: an optional documentation string--if you do not supply one,
the function will attempt to invent something useful.
-KEYWORDS: optional keywords.
+KEYWORD-ARGS:
+ optional arguments in the form of pairs of keyword and value.
+ The following keyword arguments are currently supported:
+
+ :group GROUP
+ Declare the customization group that corresponds
+ to this mode. The command `customize-mode' uses this.
+ :syntax-table TABLE
+ Use TABLE instead of the default (CHILD-syntax-table).
+ A nil value means to simply use the same syntax-table
+ as the parent.
+ :abbrev-table TABLE
+ Use TABLE instead of the default (CHILD-abbrev-table).
+ A nil value means to simply use the same abbrev-table
+ as the parent.
+ :after-hook FORM
+ A single lisp form which is evaluated after the mode
+ hooks have been run. It should not be quoted.
+
BODY: forms to execute just before running the
hooks for the new mode. Do not use `interactive' here.
-The following keywords are currently supported:
-
-:group GROUP
- Declare the customization group that corresponds to this mode.
- The command `customize-mode' uses this.
-:syntax-table TABLE
- Use TABLE instead of the default (CHILD-syntax-table).
- A nil value means to simply use the same syntax-table as the parent.
-:abbrev-table TABLE
- Use TABLE instead of the default (CHILD-abbrev-table).
- A nil value means to simply use the same abbrev-table as the parent.
-:after-hook FORM
- A single lisp form which is evaluated after the mode hooks have been
- run. It should not be quoted.
-
Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
(define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")
@@ -165,7 +168,7 @@ The new mode runs the hook constructed by the function
See Info node `(elisp)Derived Modes' for more details.
-\(fn CHILD PARENT NAME [DOCSTRING] [KEYWORDS...] &rest BODY)"
+\(fn CHILD PARENT NAME [DOCSTRING] [KEYWORD-ARGS...] &rest BODY)"
(declare (debug (&define name symbolp sexp [&optional stringp]
[&rest keywordp sexp] def-body))
(doc-string 4)
diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el
index dc54342..8831965 100644
--- a/lisp/emacs-lisp/let-alist.el
+++ b/lisp/emacs-lisp/let-alist.el
@@ -4,7 +4,7 @@
;; Author: Artur Malabarba <address@hidden>
;; Package-Requires: ((emacs "24.1"))
-;; Version: 1.0.5
+;; Version: 1.0.6
;; Keywords: extensions lisp
;; Prefix: let-alist
;; Separator: -
@@ -75,6 +75,8 @@ symbol, and each cdr is the same symbol without the `.'."
;; Return the cons cell inside a list, so it can be appended
;; with other results in the clause below.
(list (cons data (intern (replace-match "" nil nil name)))))))
+ ((vectorp data)
+ (apply #'nconc (mapcar #'let-alist--deep-dot-search data)))
((not (consp data)) nil)
((eq (car data) 'let-alist)
;; For nested ‘let-alist’ forms, ignore symbols appearing in the
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index a84c63d..e26b6b9 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -47,6 +47,8 @@
(defcustom package-archive-upload-base "/path/to/archive"
"The base location of the archive to which packages are uploaded.
+The commands in the package-x library will use this as base
+location.
This should be an absolute directory name. If the archive is on
another machine, you may specify a remote name in the usual way,
e.g. \"/ssh:address@hidden:/var/www/packages/\".
@@ -273,7 +275,9 @@ if it exists."
(defun package-upload-buffer ()
"Upload the current buffer as a single-file Emacs Lisp package.
If `package-archive-upload-base' does not specify a valid upload
-destination, prompt for one."
+destination, prompt for one.
+Signal an error if the current buffer is not visiting a simple
+package (a \".el\" file)."
(interactive)
(save-excursion
(save-restriction
@@ -287,8 +291,13 @@ destination, prompt for one."
Interactively, prompt for FILE. The package is considered a
single-file package if FILE ends in \".el\", and a multi-file
package if FILE ends in \".tar\".
+Automatically extract package attributes and update the archive's
+contents list with this information.
If `package-archive-upload-base' does not specify a valid upload
-destination, prompt for one."
+destination, prompt for one. If the directory does not exist, it
+is created. The directory need not have any initial contents
+\(i.e., you can use this command to populate an initially empty
+archive)."
(interactive "fPackage file name: ")
(with-temp-buffer
(insert-file-contents file)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 15f0f93..e7e0bd1 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -151,6 +151,7 @@
(require 'tabulated-list)
(require 'macroexp)
(require 'url-handlers)
+(require 'browse-url)
(defgroup package nil
"Manager for Emacs Lisp packages."
@@ -2504,44 +2505,47 @@ The description is read from the installed package
files."
(insert "\n")
- (if built-in
- ;; For built-in packages, get the description from the
- ;; Commentary header.
- (let ((fn (locate-file (format "%s.el" name) load-path
- load-file-rep-suffixes))
- (opoint (point)))
- (insert (or (lm-commentary fn) ""))
- (save-excursion
- (goto-char opoint)
- (when (re-search-forward "^;;; Commentary:\n" nil t)
- (replace-match ""))
- (while (re-search-forward "^\\(;+ ?\\)" nil t)
- (replace-match ""))))
-
- (if (package-installed-p desc)
- ;; For installed packages, get the description from the
- ;; installed files.
- (insert (package--get-description desc))
-
- ;; For non-built-in, non-installed packages, get description from
- ;; the archive.
- (let* ((basename (format "%s-readme.txt" name))
- readme-string)
-
- (package--with-response-buffer (package-archive-base desc)
- :file basename :noerror t
+ (let ((start-of-description (point)))
+ (if built-in
+ ;; For built-in packages, get the description from the
+ ;; Commentary header.
+ (let ((fn (locate-file (format "%s.el" name) load-path
+ load-file-rep-suffixes))
+ (opoint (point)))
+ (insert (or (lm-commentary fn) ""))
(save-excursion
- (goto-char (point-max))
- (unless (bolp)
- (insert ?\n)))
- (cl-assert (not enable-multibyte-characters))
- (setq readme-string
- ;; The readme.txt files are defined to contain utf-8 text.
- (decode-coding-region (point-min) (point-max) 'utf-8 t))
- t)
- (insert (or readme-string
- "This package does not provide a description.")))
- ))))
+ (goto-char opoint)
+ (when (re-search-forward "^;;; Commentary:\n" nil t)
+ (replace-match ""))
+ (while (re-search-forward "^\\(;+ ?\\)" nil t)
+ (replace-match ""))))
+
+ (if (package-installed-p desc)
+ ;; For installed packages, get the description from the
+ ;; installed files.
+ (insert (package--get-description desc))
+
+ ;; For non-built-in, non-installed packages, get description from
+ ;; the archive.
+ (let* ((basename (format "%s-readme.txt" name))
+ readme-string)
+
+ (package--with-response-buffer (package-archive-base desc)
+ :file basename :noerror t
+ (save-excursion
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert ?\n)))
+ (cl-assert (not enable-multibyte-characters))
+ (setq readme-string
+ ;; The readme.txt files are defined to contain utf-8 text.
+ (decode-coding-region (point-min) (point-max) 'utf-8 t))
+ t)
+ (insert (or readme-string
+ "This package does not provide a description.")))))
+ ;; Make URLs in the description into links.
+ (goto-char start-of-description)
+ (browse-url-add-buttons))))
(defun package-install-button-action (button)
(let ((pkg-desc (button-get button 'package-desc)))
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 22ccc35..400f00a 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -375,8 +375,11 @@ This function returns a timer object which you can use in
(now (decode-time)))
(if (>= hhmm 0)
(setq time
- (encode-time 0 (% hhmm 100) (/ hhmm 100) (nth 3 now)
- (nth 4 now) (nth 5 now) (nth 8 now)))))))
+ (encode-time 0 (% hhmm 100) (/ hhmm 100)
+ (decoded-time-day now)
+ (decoded-time-month now)
+ (decoded-time-year now)
+ (decoded-time-zone now)))))))
(or (consp time)
(error "Invalid time format"))
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 89969d3..b1aab79 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -525,12 +525,14 @@ whose cdr is the list of file attributes."
" " (format-time-string
(concat
eshell-ls-date-format " "
- (if (= (nth 5 (decode-time))
- (nth 5 (decode-time
- (nth (cond
- ((eq sort-method 'by-atime) 4)
- ((eq sort-method 'by-ctime) 6)
- (t 5)) attrs))))
+ (if (= (decoded-time-year (decode-time))
+ (decoded-time-year
+ (decode-time
+ (nth (cond
+ ((eq sort-method 'by-atime) 4)
+ ((eq sort-method 'by-ctime) 6)
+ (t 5))
+ attrs))))
"%H:%M"
" %Y")) (nth (cond
((eq sort-method 'by-atime) 4)
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index fe8eb35..4835e63 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -654,7 +654,7 @@ If NOSORT is non-nil, the list is not sorted--its order is
unpredictable.
(match-string 6))))
(if (nth 0 moment)
(setcar (nthcdr 5 moment)
- (nth 5 (decode-time)))
+ (decoded-time-year (decode-time)))
(setcar (nthcdr 0 moment) 0)
(setcar (nthcdr 1 moment) 0)
(setcar (nthcdr 2 moment) 0))
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index e5dc353..89bcf6b 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -48,6 +48,8 @@ could use another implementation.")
(:constructor nil)
(:constructor
file-notify--watch-make (directory filename callback)))
+ "The internal struct for bookkeeping watched files or directories.
+Used in `file-notify-descriptors'."
;; Watched directory.
directory
;; Watched relative filename, nil if watching the directory.
@@ -67,13 +69,13 @@ could use another implementation.")
"Hash table for registered file notification descriptors.
A key in this hash table is the descriptor as returned from
`inotify', `kqueue', `gfilenotify', `w32notify' or a file name
-handler. The value in the hash table is `file-notify--watch'
+handler. The value in the hash table is a `file-notify--watch'
struct.")
(defun file-notify--rm-descriptor (descriptor)
"Remove DESCRIPTOR from `file-notify-descriptors'.
DESCRIPTOR should be an object returned by `file-notify-add-watch'.
-If it is registered in `file-notify-descriptors', a stopped event is sent."
+If it is registered in `file-notify-descriptors', a `stopped' event is sent."
(when-let* ((watch (gethash descriptor file-notify-descriptors)))
(let ((callback (file-notify--watch-callback watch)))
;; Make sure this is the last time the callback is invoked.
@@ -85,25 +87,26 @@ If it is registered in `file-notify-descriptors', a stopped
event is sent."
`(,descriptor stopped ,(file-notify--watch-absolute-filename
watch)))
(remhash descriptor file-notify-descriptors)))))
-;; This function is used by `inotify', `kqueue', `gfilenotify' and
-;; `w32notify' events.
-;;;###autoload
-(defun file-notify-handle-event (event)
- "Handle file system monitoring event.
-If EVENT is a filewatch event, call its callback. It has the format
-
- (file-notify (DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE]) CALLBACK)
+(cl-defstruct (file-notify (:type list) :named)
+ "A file system monitoring event, coming from the backends."
+ -event -callback)
+;; This function is used by `inotify', `kqueue', `gfilenotify',
+;; `w32notify' and remote file system handlers. Usually, we call the
+;; argument `event' for such handlers. But in the following, `event'
+;; means a part of the argument only, so we call the argument `object'.
+;;;###autoload
+(defun file-notify-handle-event (object)
+ "Handle a file system monitoring event, coming from backends.
+If OBJECT is a filewatch event, call its callback.
Otherwise, signal a `file-notify-error'."
(interactive "e")
(when file-notify-debug
- (message "file-notify-handle-event %S" event))
- (if (and (consp event)
- (eq (car event) 'file-notify)
- (>= (length event) 3))
- (funcall (nth 2 event) (nth 1 event))
+ (message "file-notify-handle-event %S" object))
+ (if (file-notify-p object)
+ (funcall (file-notify--callback object) (file-notify--event object))
(signal 'file-notify-error
- (cons "Not a valid file-notify event" event))))
+ (cons "Not a valid file-notify-event" object))))
(cl-defstruct (file-notify--rename
(:constructor nil)
@@ -113,7 +116,7 @@ Otherwise, signal a `file-notify-error'."
(defvar file-notify--pending-rename nil
"A pending rename event awaiting the destination file name.
-It is nil or a `file-notify--rename' where the cookie can be nil.")
+It is nil or a `file-notify--rename' defstruct where the cookie can be nil.")
(defun file-notify--expand-file-name (watch file)
"Full file name of FILE reported for WATCH."
@@ -284,13 +287,13 @@ DESC is the back-end descriptor. ACTIONS is a list of:
(setq action 'deleted)))
((eq action 'stopped)
(file-notify-rm-watch desc)
- (setq actions nil)
- (setq action nil))
+ (setq actions nil
+ action nil))
;; Make the event pending.
((eq action 'renamed-from)
(setq file-notify--pending-rename
- (file-notify--rename-make watch desc file file1-or-cookie))
- (setq action nil))
+ (file-notify--rename-make watch desc file file1-or-cookie)
+ action nil))
;; Look for pending event.
((eq action 'renamed-to)
(if file-notify--pending-rename
@@ -301,16 +304,16 @@ DESC is the back-end descriptor. ACTIONS is a list of:
file-notify--pending-rename))
(from-file (file-notify--rename-from-file
file-notify--pending-rename)))
- (setq file1 file)
- (setq file from-file)
+ (setq file1 file
+ file from-file)
;; If the source is handled by another watch, we
;; must fire the rename event there as well.
(when (and (not (equal desc pending-desc))
callback)
(funcall callback
(list pending-desc 'renamed file file1)))
- (setq file-notify--pending-rename nil)
- (setq action 'renamed))
+ (setq file-notify--pending-rename nil
+ action 'renamed))
(setq action 'created))))
(when action
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 65e1c81..8f5a313 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -3598,22 +3598,22 @@ possible values."
(let ((dtime (decode-time time)))
(concat
"Date: the "
- (number-to-string (nth 3 dtime))
- (let ((digit (% (nth 3 dtime) 10)))
+ (number-to-string (decoded-time-day dtime))
+ (let ((digit (% (decoded-time-day dtime) 10)))
(cond
- ((memq (nth 3 dtime) '(11 12 13)) "th")
+ ((memq (decoded-time-day dtime) '(11 12 13)) "th")
((= digit 1) "st")
((= digit 2) "nd")
((= digit 3) "rd")
(t "th")))
" of "
- (nth (1- (nth 4 dtime)) gnus-english-month-names)
+ (nth (1- (decoded-time-month dtime)) gnus-english-month-names)
" "
- (number-to-string (nth 5 dtime))
+ (number-to-string (decoded-time-year dtime))
" at "
- (format "%02d" (nth 2 dtime))
+ (format "%02d" (decoded-time-hour dtime))
":"
- (format "%02d" (nth 1 dtime)))))))
+ (format "%02d" (decoded-time-minute dtime)))))))
(foo
(format "Date: %s (from Gnus)" date))))
@@ -4381,7 +4381,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
;;; Gnus article mode
;;;
-(set-keymap-parent gnus-article-mode-map widget-keymap)
+(set-keymap-parent gnus-article-mode-map button-buffer-map)
(gnus-define-keys gnus-article-mode-map
" " gnus-article-goto-next-page
@@ -4874,6 +4874,7 @@ General format specifiers can also be used. See Info node
(defvar gnus-mime-button-map
(let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'gnus-article-push-button)
(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)
@@ -4888,7 +4889,9 @@ General format specifiers can also be used. See Info node
gnus-mime-button-commands)))
(defvar gnus-url-button-commands
- '((gnus-article-copy-string "u" "Copy URL to kill ring")))
+ '((gnus-article-copy-string "u" "Copy URL to kill ring")
+ (push-button "\r" "Push the button")
+ (push-button [mouse-2] "Push the button")))
(defvar gnus-url-button-map
(let ((map (make-sparse-keymap)))
@@ -5849,26 +5852,12 @@ all parts."
;; Exclude a newline.
(1- (point))
(point)))
- (when gnus-article-button-face
- (overlay-put (make-overlay b e nil t)
- 'face gnus-article-button-face))
- (widget-convert-button
- 'link b e
- :mime-handle handle
- :action 'gnus-widget-press-button
- :button-keymap gnus-mime-button-map
- :help-echo
- (lambda (widget)
- (format
- "%S: %s the MIME part; %S: more options"
- 'mouse-2
- (if (mm-handle-displayed-p (widget-get widget :mime-handle))
- "hide" "show")
- 'down-mouse-3)))))
-
-(defun gnus-widget-press-button (elems _el)
- (goto-char (widget-get elems :from))
- (gnus-article-press-button))
+ (make-text-button
+ b e
+ 'keymap gnus-mime-button-map
+ 'face gnus-article-button-face
+ 'help-echo
+ "mouse-2: toggle the MIME part; down-mouse-3: more options")))
(defvar gnus-displaying-mime nil)
@@ -6151,10 +6140,9 @@ If nil, don't show those extra buttons."
mouse-face ,gnus-article-mouse-face
face ,gnus-article-button-face
gnus-part ,id
+ button t
article-type multipart
rear-nonsticky t))
- (widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button)
;; Do the handles
(while (setq handle (pop handles))
(add-text-properties
@@ -6175,10 +6163,9 @@ If nil, don't show those extra buttons."
mouse-face ,gnus-article-mouse-face
face ,gnus-article-button-face
gnus-part ,id
+ button t
gnus-data ,handle
rear-nonsticky t))
- (widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button)
(insert " "))
(insert "\n\n"))
(when preferred
@@ -7343,27 +7330,9 @@ groups."
;; Written by Per Abrahamsen <address@hidden>.
-;;; Internal Variables:
-
-(defcustom gnus-button-url-regexp
- (concat
- "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|"
- "nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)"
- "\\(//[-a-z0-9_.]+:[0-9]*\\)?"
- (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
- (punct "!?:;.,"))
- (concat
- "\\(?:"
- ;; Match paired parentheses, e.g. in Wikipedia URLs:
- ;; http://thread.gmane.org/address@hidden
- "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)"
- "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?"
- "\\|"
- "[" chars punct "]+" "[" chars "]"
- "\\)"))
- "\\)")
+(defcustom gnus-button-url-regexp browse-url-button-regexp
"Regular expression that matches URLs."
- :version "24.4"
+ :version "27.1"
:group 'gnus-article-buttons
:type 'regexp)
@@ -7770,7 +7739,7 @@ positives are possible."
1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
;; Raw URLs.
(gnus-button-url-regexp
- 0 (>= gnus-button-browse-level 0) browse-url 0)
+ 0 (>= gnus-button-browse-level 0) browse-url-button-open-url 0)
;; man pages
("\\b\\([a-z][a-z]+([1-9])\\)\\W"
0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
@@ -8043,7 +8012,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
(match-beginning 1))
points)))))
(match-beginning 2)))
- (let (gnus-article-mouse-face widget-mouse-face)
+ (let (gnus-article-mouse-face)
(while points
(gnus-article-add-button (pop points) (pop points)
'gnus-button-push
@@ -8092,18 +8061,19 @@ url is put as the `gnus-button-url' overlay property on
the button."
(defun gnus-article-add-button (from to fun &optional data text)
"Create a button between FROM and TO with callback FUN and data DATA."
- (when gnus-article-button-face
- (overlay-put (make-overlay from to nil t)
- 'face gnus-article-button-face))
(add-text-properties
from to
(nconc (and gnus-article-mouse-face
(list 'mouse-face gnus-article-mouse-face))
- (list 'gnus-callback fun)
+ (list 'gnus-callback fun
+ 'button-data data
+ 'action fun
+ 'keymap gnus-url-button-map
+ 'category t
+ 'button t)
(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))
+ (when gnus-article-button-face
+ (add-face-text-property from to gnus-article-button-face t)))
(defun gnus-article-copy-string ()
"Copy the string in the button to the kill ring."
@@ -8431,13 +8401,8 @@ url is put as the `gnus-button-url' overlay property on
the button."
;; Exclude a newline.
(1- (point))
(point)))
- (when gnus-article-button-face
- (overlay-put (make-overlay b e nil t)
- 'face gnus-article-button-face))
- (widget-convert-button
- 'link b e
- :action 'gnus-button-prev-page
- :button-keymap gnus-prev-page-map)))
+ (make-text-button b e 'keymap gnus-prev-page-map
+ 'face gnus-article-button-face)))
(defun gnus-button-next-page (&optional _args _more-args)
"Go to the next page."
@@ -8467,13 +8432,8 @@ url is put as the `gnus-button-url' overlay property on
the button."
;; Exclude a newline.
(1- (point))
(point)))
- (when gnus-article-button-face
- (overlay-put (make-overlay b e nil t)
- 'face gnus-article-button-face))
- (widget-convert-button
- 'link b e
- :action 'gnus-button-next-page
- :button-keymap gnus-next-page-map)))
+ (make-text-button b e 'keymap gnus-next-page-map
+ 'face gnus-article-button-face)))
(defun gnus-article-button-next-page (_arg)
"Go to the next page."
@@ -8726,6 +8686,7 @@ For example:
(defvar gnus-mime-security-button-map
(let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'gnus-article-push-button)
(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)
@@ -8861,20 +8822,8 @@ For example:
;; Exclude a newline.
(1- (point))
(point)))
- (when gnus-article-button-face
- (overlay-put (make-overlay b e nil t)
- 'face gnus-article-button-face))
- (widget-convert-button
- 'link b e
- :mime-handle handle
- :action 'gnus-widget-press-button
- :button-keymap gnus-mime-security-button-map
- :help-echo
- (lambda (_widget)
- (format
- "%S: show detail; %S: more options"
- 'mouse-2
- 'down-mouse-3)))))
+ (make-text-button b e 'keymap gnus-mime-security-button-map
+ 'face gnus-article-button-face)))
(defun gnus-mime-display-security (handle)
(save-restriction
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index cb70d95..b26aaa1 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -176,22 +176,25 @@ marked with SPECIAL."
(thenHour (elt thenParts 2))
(thenMin (elt thenParts 1))
;; convert time as elements into number of seconds since EPOCH.
- (then (encode-time 0
- thenMin
- thenHour
- ;; If THEN is earlier than NOW, make it
- ;; same time tomorrow. Doc for encode-time
- ;; says that this is OK.
- (+ (elt nowParts 3)
- (if (or (< thenHour (elt nowParts 2))
- (and (= thenHour (elt nowParts 2))
- (<= thenMin (elt nowParts 1))))
- 1 0))
- (elt nowParts 4)
- (elt nowParts 5)
- (elt nowParts 6)
- (elt nowParts 7)
- (elt nowParts 8)))
+ (then (encode-time
+ 0
+ thenMin
+ thenHour
+ ;; If THEN is earlier than NOW, make it
+ ;; same time tomorrow. Doc for encode-time
+ ;; says that this is OK.
+ (+ (decoded-time-day nowParts)
+ (if (or (< thenHour (decoded-time-hour nowParts))
+ (and (= thenHour
+ (decoded-time-hour nowParts))
+ (<= thenMin
+ (decoded-time-minute nowParts))))
+ 1 0))
+ (decoded-time-month nowParts)
+ (decoded-time-year nowParts)
+ (decoded-time-weekday nowParts)
+ (decoded-time-dst nowParts)
+ (decoded-time-zone nowParts)))
(diff (float-time (time-subtract then now))))
;; Return number of timesteps in the number of seconds.
(round diff gnus-demon-timestep)))
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index d271a52..19cbf52 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -46,7 +46,8 @@ If nil, default to `gravatar-size'."
:group 'gnus-gravatar)
(defcustom gnus-gravatar-too-ugly gnus-article-x-face-too-ugly
- "Regexp matching posters whose avatar shouldn't be shown automatically."
+ "Regexp matching posters whose avatar shouldn't be shown automatically.
+If nil, show all avatars."
:type '(choice regexp (const nil))
:version "24.1"
:group 'gnus-gravatar)
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index f36c389..92d760f 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -84,7 +84,7 @@ fit these criteria."
(define-key map "i" 'gnus-html-browse-image)
(define-key map "\r" 'gnus-html-browse-url)
(define-key map "u" 'gnus-article-copy-string)
- (define-key map [tab] 'widget-forward)
+ (define-key map [tab] 'button-forward)
map))
(defun gnus-html-encode-url (url)
@@ -180,12 +180,10 @@ fit these criteria."
'image-displayer `(lambda (url start end)
(gnus-html-display-image url start end
,alt-text))
+ 'help-echo alt-text
+ 'button t
+ 'keymap gnus-html-image-map
'gnus-image (list url start end alt-text)))
- (widget-convert-button
- 'url-link start (point)
- :help-echo alt-text
- :keymap gnus-html-image-map
- url)
(if (string-match "\\`cid:" url)
;; URLs with cid: have their content stashed in other
;; parts of the MIME structure, so just insert them
@@ -207,21 +205,15 @@ fit these criteria."
(delete-region start end))
"*")
'cid))
- (widget-convert-button
- 'link start end
- :action 'gnus-html-insert-image
- :help-echo url
- :keymap gnus-html-image-map
- :button-keymap gnus-html-image-map)))
+ (make-text-button start end
+ 'help-echo url
+ 'keymap gnus-html-image-map)))
;; Normal, external URL.
(if (or inhibit-images
(gnus-html-image-url-blocked-p url blocked-images))
- (widget-convert-button
- 'link start end
- :action 'gnus-html-insert-image
- :help-echo url
- :keymap gnus-html-image-map
- :button-keymap gnus-html-image-map)
+ (make-text-button start end
+ 'help-echo url
+ 'keymap gnus-html-image-map)
;; Non-blocked url
(let ((width
(when (string-match "width=\"?\\([0-9]+\\)" parameters)
@@ -444,11 +436,9 @@ Return a string with image data."
(let ((image (gnus-rescale-image image
(gnus-html-maximum-image-size))))
(delete-region start end)
(gnus-put-image image alt-text 'external)
- (widget-convert-button
- 'url-link start (point)
- :help-echo alt-text
- :keymap gnus-html-displayed-image-map
- url)
+ (make-text-button start (point)
+ 'help-echo alt-text
+ 'keymap gnus-html-displayed-image-map)
(put-text-property start (point) 'gnus-alt-text alt-text)
(when url
(add-text-properties
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 402e233..529cafe 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -777,9 +777,8 @@ These will be used to retrieve the RSVP information from
ical events."
,callback
keymap ,gnus-mime-button-map
face ,gnus-article-button-face
- gnus-data ,data))
- (widget-convert-button 'link start (point)
- :action 'gnus-widget-press-button)))
+ button t
+ gnus-data ,data))))
(defun gnus-icalendar-send-buffer-by-mail (buffer-name subject)
(let ((message-signature nil))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index b239890..73f0eb3 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -9410,7 +9410,9 @@ Obeys the standard process/prefix convention."
(t
(error "Couldn't select virtual nndoc group")))))
-(defun gnus-summary-widget-forward (arg)
+(define-obsolete-function-alias 'gnus-summary-widget-forward
+ #'gnus-summary-button-forward "27.1")
+(defun gnus-summary-button-forward (arg)
"Move point to the next field or button in the article.
With optional ARG, move across that many fields."
(interactive "p")
@@ -9420,9 +9422,11 @@ With optional ARG, move across that many fields."
(error "No article window found"))))
(select-window win)
(select-frame-set-input-focus (window-frame win))
- (widget-forward arg)))
+ (forward-button arg)))
-(defun gnus-summary-widget-backward (arg)
+(define-obsolete-function-alias 'gnus-summary-widget-backward
+ #'gnus-summary-button-backward "27.1")
+(defun gnus-summary-button-backward (arg)
"Move point to the previous field or button in the article.
With optional ARG, move across that many fields."
(interactive "p")
@@ -9432,30 +9436,28 @@ With optional ARG, move across that many fields."
(error "No article window found"))))
(select-window win)
(select-frame-set-input-focus (window-frame win))
- (unless (widget-at (point))
+ (unless (button-at (point))
(goto-char (point-max)))
- (widget-backward arg)))
+ (backward-button arg)))
(defcustom gnus-collect-urls-primary-text "Link"
- "The widget text for the default link in `gnus-summary-browse-url'."
+ "The button text for the default link in `gnus-summary-browse-url'."
:version "27.1"
:type 'string
:group 'gnus-article-various)
(defun gnus-collect-urls ()
"Return the list of URLs in the buffer after (point).
-The 1st element is the widget named by `gnus-collect-urls-primary-text'."
+The 1st element is the button named by `gnus-collect-urls-primary-text'."
(let ((pt (point)) urls primary)
- (while (progn (widget-move 1 t) ; no echo
- ;; `widget-move' wraps around to top of buffer.
- (> (point) pt))
+ (while (forward-button 1 nil nil t)
(setq pt (point))
- (when-let ((w (widget-at pt))
- (u (or (widget-value w)
+ (when-let ((w (button-at pt))
+ (u (or (button-get w 'shr-url)
(get-text-property pt 'gnus-string))))
(when (string-match-p "\\`[[:alpha:]]+://" u)
(if (and gnus-collect-urls-primary-text (null primary)
- (string= gnus-collect-urls-primary-text (widget-text w)))
+ (string= gnus-collect-urls-primary-text (button-label w)))
(setq primary u)
(push u urls)))))
(setq urls (nreverse urls))
@@ -9478,7 +9480,7 @@ The 1st element is the widget named by
`gnus-collect-urls-primary-text'."
"Scan the current article body for links, and offer to browse them.
Links are opened using `browse-url' unless a prefix argument is
-given: Then `shr-external-browser' is used instead.
+given: Then `browse-url-secondary-browser-function' is used instead.
If only one link is found, browse that directly, otherwise use
completion to select a link. The first link marked in the
@@ -9489,7 +9491,7 @@ default."
(gnus-summary-select-article)
(gnus-with-article-buffer
(article-goto-body)
- ;; Back up a char, in case body starts with a widget.
+ ;; Back up a char, in case body starts with a button.
(backward-char)
(setq urls (gnus-collect-urls))
(setq target
@@ -9502,7 +9504,7 @@ default."
(car urls)))))
(if target
(if external
- (funcall shr-external-browser target)
+ (funcall browse-url-secondary-browser-function target)
(browse-url target))
(message "No URLs found.")))))
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 31421cc..9ccdb83 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -359,20 +359,26 @@ Symbols are also allowed; their print names are used
instead."
(defun gnus-seconds-today ()
"Return the number of seconds passed today."
(let ((now (decode-time)))
- (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600))))
+ (+ (decoded-time-second now)
+ (* (decoded-time-minute now) 60)
+ (* (decoded-time-hour now) 3600))))
(defun gnus-seconds-month ()
"Return the number of seconds passed this month."
(let ((now (decode-time)))
- (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
- (* (- (car (nthcdr 3 now)) 1) 3600 24))))
+ (+ (decoded-time-second now)
+ (* (decoded-time-minute now) 60)
+ (* (decoded-time-hour now) 3600)
+ (* (- (decoded-time-day now) 1) 3600 24))))
(defun gnus-seconds-year ()
"Return the number of seconds passed this year."
(let* ((current (current-time))
(now (decode-time current))
(days (format-time-string "%j" current)))
- (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
+ (+ (decoded-time-second now)
+ (* (decoded-time-minute now) 60)
+ (* (decoded-time-hour now) 3600)
(* (- (string-to-number days) 1) 3600 24))))
(defmacro gnus-date-get-time (date)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 3f190ed..30c5f7c 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -666,30 +666,29 @@ variable should be a regexp or a list of regexps."
(defun message-send-mail-function ()
"Return suitable value for the variable `message-send-mail-function'."
- (cond ((and (require 'sendmail)
- (boundp 'sendmail-program)
- sendmail-program
- (executable-find sendmail-program))
- 'message-send-mail-with-sendmail)
- ((and (locate-library "smtpmail")
- (boundp 'smtpmail-default-smtp-server)
- smtpmail-default-smtp-server)
- 'message-smtpmail-send-it)
- ((locate-library "mailclient")
- 'message-send-mail-with-mailclient)
+ (declare (obsolete nil "27.1"))
+ (require 'sendmail)
+ (defvar sendmail-program)
+ (cond ((executable-find sendmail-program)
+ #'message-send-mail-with-sendmail)
+ ((bound-and-true-p 'smtpmail-default-smtp-server)
+ #'message-smtpmail-send-it)
(t
- (error "Don't know how to send mail. Please customize
`message-send-mail-function'"))))
+ #'message-send-mail-with-mailclient)))
(defun message-default-send-mail-function ()
- (cond ((eq send-mail-function 'smtpmail-send-it) 'message-smtpmail-send-it)
- ((eq send-mail-function 'feedmail-send-it) 'feedmail-send-it)
- ((eq send-mail-function 'sendmail-query-once) 'sendmail-query-once)
- ((eq send-mail-function 'mailclient-send-it)
- 'message-send-mail-with-mailclient)
- (t (message-send-mail-function))))
+ (cond ((eq send-mail-function #'feedmail-send-it) #'feedmail-send-it)
+ ((eq send-mail-function #'sendmail-query-once) #'sendmail-query-once)
+ ((eq send-mail-function #'sendmail-send-it)
+ #'message-send-mail-with-sendmail)
+ (t #'message-use-send-mail-function)))
+
+(defun message--default-send-mail-function ()
+ "Use the setting of `send-mail-function' if applicable."
+ (funcall (message-default-send-mail-function)))
;; Useful to set in site-init.el
-(defcustom message-send-mail-function (message-default-send-mail-function)
+(defcustom message-send-mail-function #'message--default-send-mail-function
"Function to call to send the current buffer as mail.
The headers should be delimited by a line whose contents match the
variable `mail-header-separator'.
@@ -702,7 +701,9 @@ default is system dependent and determined by the function
`message-send-mail-function'.
See also `send-mail-function'."
- :type '(radio (function-item message-send-mail-with-sendmail)
+ :type '(radio (function-item message--default-send-mail-function
+ :tag "Use send-mail-function")
+ (function-item message-send-mail-with-sendmail)
(function-item message-send-mail-with-mh)
(function-item message-send-mail-with-qmail)
(function-item message-smtpmail-send-it)
@@ -712,8 +713,8 @@ See also `send-mail-function'."
:tag "Use Mailclient package")
(function :tag "Other"))
:group 'message-sending
- :version "23.2"
- :initialize 'custom-initialize-default
+ :version "27.1"
+ :initialize #'custom-initialize-default
:link '(custom-manual "(message)Mail Variables")
:group 'message-mail)
@@ -834,7 +835,10 @@ symbol `never', the posting is not allowed. If it is the
symbol
(const never)
(const ask)))
-(defcustom message-sendmail-f-is-evil nil
+(defcustom message-sendmail-f-is-evil
+ (if (boundp 'mail-specify-envelope-from)
+ (not mail-specify-envelope-from)
+ nil)
"Non-nil means don't add \"-f username\" to the sendmail command line.
Doing so would be even more evil than leaving it out."
:group 'message-sending
@@ -1920,10 +1924,10 @@ You must have the \"hashcash\" binary installed, see
`hashcash-path'."
"Ask QUESTION, displaying remaining args in a temporary buffer if SHOW."
`(message-talkative-question 'y-or-n-p ,question ,show ,@text))
-(defmacro message-delete-line (&optional n)
+(defsubst message-delete-line (&optional n)
"Delete the current line (and the next N lines)."
- `(delete-region (progn (beginning-of-line) (point))
- (progn (forward-line ,(or n 1)) (point))))
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line (or n 1)) (point))))
(defun message-mark-active-p ()
"Non-nil means the mark and region are currently active in this buffer."
@@ -2039,13 +2043,11 @@ see `message-narrow-to-headers-or-head'."
(defmacro message-with-reply-buffer (&rest forms)
"Evaluate FORMS in the reply buffer, if it exists."
+ (declare (indent 0) (debug t))
`(when (buffer-live-p message-reply-buffer)
(with-current-buffer message-reply-buffer
,@forms)))
-(put 'message-with-reply-buffer 'lisp-indent-function 0)
-(put 'message-with-reply-buffer 'edebug-form-spec '(body))
-
(defun message-fetch-reply-field (header)
"Fetch field HEADER from the message we're replying to."
(message-with-reply-buffer
@@ -4174,13 +4176,11 @@ It should typically alter the sending method in some
way or other."
(defmacro message-check (type &rest forms)
"Eval FORMS if TYPE is to be checked."
+ (declare (indent 1) (debug t))
`(or (message-check-element ,type)
(save-excursion
,@forms)))
-(put 'message-check 'lisp-indent-function 1)
-(put 'message-check 'edebug-form-spec '(form body))
-
(defun message-text-with-property (prop &optional start end reverse)
"Return a list of start and end positions where the text has PROP.
START and END bound the search, they default to `point-min' and
@@ -4818,24 +4818,25 @@ to find out how to use this."
;; Pass it on to mh.
(mh-send-letter)))
+(defun message-use-send-mail-function ()
+ (run-hooks 'message-send-mail-hook)
+ (funcall send-mail-function))
+
(defun message-smtpmail-send-it ()
"Send the prepared message buffer with `smtpmail-send-it'.
The only difference from `smtpmail-send-it' is that this command
evaluates `message-send-mail-hook' just before sending a message.
It is useful if your ISP requires the POP-before-SMTP
authentication. See the Gnus manual for details."
+ (declare (obsolete message-use-send-mail-function "27.1"))
(run-hooks 'message-send-mail-hook)
- ;; Change header-delimiter to be what smtpmail expects.
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"))
- (replace-match "\n"))
(smtpmail-send-it))
(defun message-send-mail-with-mailclient ()
"Send the prepared message buffer with `mailclient-send-it'.
The only difference from `mailclient-send-it' is that this
command evaluates `message-send-mail-hook' just before sending a message."
+ (declare (obsolete message-use-send-mail-function "27.1"))
(run-hooks 'message-send-mail-hook)
(mailclient-send-it))
@@ -5325,7 +5326,7 @@ Otherwise, generate and save a value for
`canlock-password' first."
(message-check 'new-text
(or
(not message-checksum)
- (not (eq (message-checksum) message-checksum))
+ (not (equal (message-checksum) message-checksum))
(if (message-gnksa-enable-p 'quoted-text-only)
(y-or-n-p
"It looks like no new text has been added. Really post? ")
@@ -5509,8 +5510,8 @@ If NOW, use that time instead."
In posting styles use `(\"Expires\" (make-expires-date 30))'."
(let* ((cur (decode-time))
- (nday (+ days (nth 3 cur))))
- (setf (nth 3 cur) nday)
+ (nday (+ days (decoded-time-day cur))))
+ (setf (decoded-time-day cur) nday)
(message-make-date (encode-time cur))))
(defun message-make-message-id ()
@@ -7815,8 +7816,8 @@ Pre-defined symbols include `message-tool-bar-gnome' and
(repeat :tag "User defined list" gmm-tool-bar-item)
(symbol))
:version "23.1" ;; No Gnus
- :initialize 'custom-initialize-default
- :set 'message-tool-bar-update
+ :initialize #'custom-initialize-default
+ :set #'message-tool-bar-update
:group 'message)
(defcustom message-tool-bar-gnome
@@ -7840,8 +7841,8 @@ Pre-defined symbols include `message-tool-bar-gnome' and
See `gmm-tool-bar-from-list' for details on the format of the list."
:type '(repeat gmm-tool-bar-item)
:version "23.1" ;; No Gnus
- :initialize 'custom-initialize-default
- :set 'message-tool-bar-update
+ :initialize #'custom-initialize-default
+ :set #'message-tool-bar-update
:group 'message)
(defcustom message-tool-bar-retro
@@ -7860,8 +7861,8 @@ See `gmm-tool-bar-from-list' for details on the format of
the list."
See `gmm-tool-bar-from-list' for details on the format of the list."
:type '(repeat gmm-tool-bar-item)
:version "23.1" ;; No Gnus
- :initialize 'custom-initialize-default
- :set 'message-tool-bar-update
+ :initialize #'custom-initialize-default
+ :set #'message-tool-bar-update
:group 'message)
(defcustom message-tool-bar-zap-list
@@ -7873,8 +7874,8 @@ These items are not displayed on the message mode tool
bar.
See `gmm-tool-bar-from-list' for the format of the list."
:type 'gmm-tool-bar-zap-list
:version "23.1" ;; No Gnus
- :initialize 'custom-initialize-default
- :set 'message-tool-bar-update
+ :initialize #'custom-initialize-default
+ :set #'message-tool-bar-update
:group 'message)
(defvar image-load-path)
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 85aa694..cba9633 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -896,11 +896,11 @@ external if displayed external."
(buffer-live-p gnus-summary-buffer))
(when attachment-filename
(with-current-buffer mm
- (rename-buffer (format "*mm* %s"
attachment-filename) t)))
+ (rename-buffer
+ (format "*mm* %s" attachment-filename) t)))
;; So that we pop back to the right place, sort of.
(switch-to-buffer gnus-summary-buffer)
(switch-to-buffer mm))
- (delete-other-windows)
(funcall method))
(mm-save-part handle))
(when (and (not non-viewer)
@@ -1829,7 +1829,6 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t)
(shr-insert-document document)
(unless (bobp)
(insert "\n"))
- (mm-convert-shr-links)
(mm-handle-set-undisplayer
handle
(let ((min (point-min-marker))
@@ -1838,40 +1837,6 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil
t)
(let ((inhibit-read-only t))
(delete-region min max))))))))
-(defvar shr-image-map)
-(defvar shr-map)
-(autoload 'widget-convert-button "wid-edit")
-(defvar widget-keymap)
-
-(defun mm-convert-shr-links ()
- (let ((start (point-min))
- end keymap)
- (while (and start
- (< start (point-max)))
- (when (setq start (text-property-not-all start (point-max) 'shr-url nil))
- (setq end (next-single-property-change start 'shr-url nil (point-max)))
- (widget-convert-button
- 'url-link start end
- :help-echo (get-text-property start 'help-echo)
- :keymap (setq keymap (copy-keymap
- (if (mm-images-in-region-p start end)
- shr-image-map
- shr-map)))
- (get-text-property start 'shr-url))
- ;; Mask keys that launch `widget-button-click'.
- ;; Those bindings are provided by `widget-keymap'
- ;; that is a parent of `gnus-article-mode-map'.
- (dolist (key (where-is-internal 'widget-button-click widget-keymap))
- (unless (lookup-key keymap key)
- (define-key keymap key #'ignore)))
- ;; Avoid `shr-next-link' and `shr-previous-link' in `keymap' so
- ;; TAB and M-TAB run `widget-forward' and `widget-backward' instead.
- (substitute-key-definition 'shr-next-link nil keymap)
- (substitute-key-definition 'shr-previous-link nil keymap)
- (dolist (overlay (overlays-at start))
- (overlay-put overlay 'face nil))
- (setq start end)))))
-
(defun mm-handle-filename (handle)
"Return filename of HANDLE if any."
(or (mail-content-type-get (mm-handle-type handle)
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index f8ec222..2ad0634 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -1264,12 +1264,12 @@ all. This may very well take some time.")
(date-elts (decode-time date))
;; ### NOTE: out-of-range values are accepted by encode-time. This
;; makes our life easier.
- (monday (- (nth 3 date-elts)
+ (monday (- (decoded-time-day date-elts)
(if nndiary-week-starts-on-monday
- (if (zerop (nth 6 date-elts))
+ (if (zerop (decoded-time-weekday date-elts))
6
- (- (nth 6 date-elts) 1))
- (nth 6 date-elts))))
+ (- (decoded-time-weekday date-elts) 1))
+ (decoded-time-weekday date-elts))))
reminder res)
;; remove the DOW and DST entries
(setcdr (nthcdr 5 date-elts) (nthcdr 8 date-elts))
@@ -1343,9 +1343,10 @@ all. This may very well take some time.")
;; have to know which day is the 1st one for this month.
;; Maybe there's simpler, but decode-time(encode-time) will
;; give us the answer.
- (let ((first (nth 6 (decode-time
- (encode-time 0 0 0 1 month year
- time-zone))))
+ (let ((first (decoded-time-weekday
+ (decode-time
+ (encode-time 0 0 0 1 month year
+ time-zone))))
(max (cond ((= month 2)
(if (date-leap-year-p year) 29 28))
((<= month 7)
@@ -1390,11 +1391,11 @@ all. This may very well take some time.")
;; If there's no next occurrence, returns the last one (if any) which is then
;; in the past.
(let* ((today (decode-time now))
- (this-minute (nth 1 today))
- (this-hour (nth 2 today))
- (this-day (nth 3 today))
- (this-month (nth 4 today))
- (this-year (nth 5 today))
+ (this-minute (decoded-time-minute today))
+ (this-hour (decoded-time-hour today))
+ (this-day (decoded-time-day today))
+ (this-month (decoded-time-month today))
+ (this-year (decoded-time-year today))
(minute-list (sort (nndiary-flatten (nth 0 sched) 0 59) '<))
(hour-list (sort (nndiary-flatten (nth 1 sched) 0 23) '<))
(dom-list (nth 2 sched))
@@ -1445,9 +1446,10 @@ all. This may very well take some time.")
;; have to know which day is the 1st one for this month.
;; Maybe there's simpler, but decode-time(encode-time) will
;; give us the answer.
- (let ((first (nth 6 (decode-time
- (encode-time 0 0 0 1 month year
- time-zone))))
+ (let ((first (decoded-time-weekday
+ (decode-time
+ (encode-time 0 0 0 1 month year
+ time-zone))))
(max (cond ((= month 2)
(if (date-leap-year-p year) 29 28))
((<= month 7)
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 99a6104..c6eaa54 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1100,7 +1100,7 @@ textual parts.")
(format-time-string
(format "%%d-%s-%%Y"
(upcase
- (car (rassoc (nth 4 (decode-time cutoff))
+ (car (rassoc (decoded-time-month (decode-time cutoff))
parse-time-months))))
cutoff))))
(and (car result)
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 0bfecb2..f2c86ee 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -36,6 +36,7 @@
(require 'rfc2231)
(require 'mm-url)
(require 'rfc2047)
+(require 'iso8601)
(require 'mml)
(require 'xml)
@@ -468,49 +469,25 @@ which RSS 2.0 allows."
(not (string-match "\\`[A-Z+-]" zone)))
(setq zone nil))))
;; ISO 8601
- ((string-match
- (eval-when-compile
- (concat
- ;; 1. year
- "\\(199[0-9]\\|20[0-9][0-9]\\)"
- "\\(?:-"
- ;; 2. month
- "\\([01][0-9]\\)"
- "\\(?:-"
- ;; 3. day
- "\\([0-3][0-9]\\)"
- "\\)?\\)?\\(?:T"
- ;; 4. hh:mm
- "\\([012][0-9]:[0-5][0-9]\\)"
- "\\(?:"
- ;; 5. :ss
- "\\(:[0-5][0-9]\\)"
- "\\(?:\\.[0-9]+\\)?\\)?\\)?"
- ;; 6+7,8,9. zone
- "\\(?:\\(?:\\([+-][012][0-9]\\):\\([0-5][0-9]\\)\\)"
- "\\|\\([+-][012][0-9][0-5][0-9]\\)"
- "\\|\\(Z\\)\\)?"))
- date)
- (setq year (string-to-number (match-string 1 date))
- month (string-to-number (or (match-string 2 date) "1"))
- day (string-to-number (or (match-string 3 date) "1"))
- time (if (match-beginning 5)
- (substring date (match-beginning 4) (match-end 5))
- (concat (or (match-string 4 date) "00:00") ":00"))
- zone (cond ((match-beginning 6)
- (concat (match-string 6 date)
- (match-string 7 date)))
- ((match-beginning 9) ;; Z
- "+0000")
- (t ;; nil if zone is not provided.
- (match-string 8 date))))))
+ ((iso8601-valid-p date)
+ (let ((decoded (decoded-time-set-defaults (iso8601-parse date))))
+ (setq year (decoded-time-year decoded)
+ month (decoded-time-month decoded)
+ day (decoded-time-day decoded)
+ time (format "%02d:%02d:%02d"
+ (decoded-time-hour decoded)
+ (decoded-time-minute decoded)
+ (decoded-time-second decoded))
+ zone (if (equal (decoded-time-zone decoded) "Z")
+ 0
+ (decoded-time-zone decoded))))))
(if month
(progn
(setq cts (current-time-string (encode-time 0 0 0 day month year)))
(format "%s, %02d %s %04d %s%s"
(substring cts 0 3) day (substring cts 4 7) year time
(if zone
- (concat " " zone)
+ (concat " " (time-zone-format zone t))
"")))
(message-make-date given))))
diff --git a/lisp/iimage.el b/lisp/iimage.el
index 39ee1fb..3b50064 100644
--- a/lisp/iimage.el
+++ b/lisp/iimage.el
@@ -116,6 +116,7 @@ Examples of image filename patterns to match:
(defun iimage-mode-buffer (arg)
"Display images if ARG is non-nil, undisplay them otherwise."
(let ((image-path (cons default-directory iimage-mode-image-search-path))
+ (edges (window-inside-pixel-edges (get-buffer-window)))
file)
(with-silent-modifications
(save-excursion
@@ -128,10 +129,15 @@ Examples of image filename patterns to match:
;; remove them either (we may leave some of ours, and we
;; may remove other packages's display properties).
(if arg
- (add-text-properties (match-beginning 0) (match-end 0)
- `(display ,(create-image file)
- modification-hooks
- (iimage-modification-hook)))
+ (add-text-properties
+ (match-beginning 0) (match-end 0)
+ `(display
+ ,(create-image file nil nil
+ :max-width (- (nth 2 edges) (nth 0 edges))
+ :max-height (- (nth 3 edges) (nth 1 edges)))
+ keymap ,image-map
+ modification-hooks
+ (iimage-modification-hook)))
(remove-text-properties (match-beginning 0) (match-end 0)
'(display modification-hooks))))))))))
diff --git a/lisp/image.el b/lisp/image.el
index c3e2865..b36a513 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -549,7 +549,7 @@ height of the image; integer values are taken as pixel
values."
`(display ,(if slice
(list (cons 'slice slice) image)
image)
- rear-nonsticky (display)
+ rear-nonsticky t
keymap ,image-map))))
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index 91da840..9a1ec3b 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -40,18 +40,35 @@
;; FIXME a time value is not the nicest format for a custom variable.
(defcustom gravatar-cache-ttl (days-to-time 30)
- "Time to live for gravatar cache entries."
+ "Time to live for gravatar cache entries.
+If a requested gravatar has been cached for longer than this, it
+is retrieved anew."
:type '(repeat integer)
:group 'gravatar)
-;; FIXME Doc is tautological. What are the options?
(defcustom gravatar-rating "g"
- "Default rating for gravatar."
+ "Most explicit Gravatar rating level to allow.
+Some gravatars are rated according to how suitable they are for
+different audiences. The supported rating levels are, in order
+of increasing explicitness, the following:
+
+\"g\" - Suitable for any audience.
+\"pg\" - May contain rude gestures, provocatively dressed
+ individuals, mild profanity, or mild violence.
+\"r\" - May contain harsh profanity, intense violence, nudity,
+ or hard drug use.
+\"x\" - May contain hardcore sexual imagery or extremely
+ disturbing violence.
+
+Each level covers itself as well as all less explicit levels.
+For example, setting this variable to \"pg\" will allow gravatars
+rated either \"g\" or \"pg\"."
:type 'string
:group 'gravatar)
(defcustom gravatar-size 32
- "Default size in pixels for gravatars."
+ "Gravatar size in pixels to request.
+Valid sizes range from 1 to 2048 inclusive."
:type 'integer
:group 'gravatar)
@@ -100,8 +117,10 @@ If no image available, return 'error."
;;;###autoload
(defun gravatar-retrieve (mail-address cb &optional cbargs)
- "Retrieve MAIL-ADDRESS gravatar and call CB on retrieval.
-You can provide a list of argument to pass to CB in CBARGS."
+ "Asynchronously retrieve a gravatar for MAIL-ADDRESS.
+When finished, call CB as (apply CB GRAVATAR CBARGS),
+where GRAVATAR is either an image descriptor, or the symbol
+`error' if the retrieval failed."
(let ((url (gravatar-build-url mail-address)))
(if (gravatar-cache-expired url)
(let ((args (list url
@@ -120,7 +139,9 @@ You can provide a list of argument to pass to CB in CBARGS."
;;;###autoload
(defun gravatar-retrieve-synchronously (mail-address)
- "Retrieve MAIL-ADDRESS gravatar and returns it."
+ "Synchronously retrieve a gravatar for MAIL-ADDRESS.
+Value is either an image descriptor, or the symbol `error' if the
+retrieval failed."
(let ((url (gravatar-build-url mail-address)))
(if (gravatar-cache-expired url)
(with-current-buffer (url-retrieve-synchronously url)
diff --git a/lisp/info.el b/lisp/info.el
index 3203c5f..cc18ea1 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -2452,11 +2452,12 @@ Table of contents is created from the tree structure of
menus."
"Insert table of contents with references to nodes."
(let ((section "Top"))
(while nodes
- (let ((node (assoc (car nodes) node-list)))
- (unless (member (nth 2 node) (list nil section))
- (insert (setq section (nth 2 node)) "\n"))
- (insert (make-string level ?\t))
- (insert "*Note " (car nodes) ":: \n")
+ (let ((node (assoc (car nodes) node-list))
+ (indentation (make-string level ?\t)))
+ (when (and (not (member (nth 2 node) (list nil section)))
+ (not (equal (nth 1 node) (nth 2 node))))
+ (insert indentation (setq section (nth 2 node)) "\n"))
+ (insert indentation "*Note " (car nodes) ":: \n")
(Info-toc-insert (nth 3 node) node-list (1+ level) curr-file)
(setq nodes (cdr nodes))))))
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 291efab..1da33a4 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -39,7 +39,6 @@
(defcustom mail-setup-with-from t
"Non-nil means insert `From:' field when setting up the message."
:type 'boolean
- :group 'sendmail
:version "22.1")
(defcustom sendmail-program
@@ -51,7 +50,6 @@
(t "sendmail")))
"Program used to send messages."
:version "24.1" ; add executable-find, remove fakemail
- :group 'mail
:type 'file)
;;;###autoload
@@ -72,8 +70,7 @@ Otherwise, most addresses look like `angles', but they look
like
(const parens)
(const angles)
(const default))
- :version "27.1"
- :group 'sendmail)
+ :version "27.1")
(make-obsolete-variable
'mail-from-style
"only the `angles' value is valid according to RFC2822." "27.1" 'set)
@@ -89,8 +86,7 @@ privileged operation. This variable affects sendmail and
smtpmail -- if you use feedmail to send mail, see instead the
variable `feedmail-deduce-envelope-from'."
:version "21.1"
- :type 'boolean
- :group 'sendmail)
+ :type 'boolean)
(defcustom mail-envelope-from nil
"If non-nil, designate the envelope-from address when sending mail.
@@ -102,16 +98,14 @@ being sent is used), or nil (in which case the value of
:version "21.1"
:type '(choice (string :tag "From-name")
(const :tag "Use From: header from message" header)
- (const :tag "Use `user-mail-address'" nil))
- :group 'sendmail)
+ (const :tag "Use `user-mail-address'" nil)))
;;;###autoload
(defcustom mail-self-blind nil
"Non-nil means insert Bcc to self in messages to be sent.
This is done when the message is initialized,
so you can remove or alter the Bcc field to override the default."
- :type 'boolean
- :group 'sendmail)
+ :type 'boolean)
;;;###autoload
(defcustom mail-interactive t
@@ -122,8 +116,7 @@ so you can remove or alter the Bcc field to override the
default."
"Non-nil means when sending a message wait for and display errors.
Otherwise, let mailer send back a message to report errors."
:type 'boolean
- :version "23.1" ; changed from nil to t
- :group 'sendmail)
+ :version "23.1") ; changed from nil to t
(defcustom mail-yank-ignored-headers
(concat "^"
@@ -138,7 +131,6 @@ Otherwise, let mailer send back a message to report errors."
":")
"Delete these headers from old message when it's inserted in a reply."
:type 'regexp
- :group 'sendmail
:version "23.1")
;; Useful to set in site-init.el
@@ -147,7 +139,7 @@ Otherwise, let mailer send back a message to report errors."
;; Assume smtpmail is the preferred choice if it's already configured.
(if (and (boundp 'smtpmail-smtp-server)
smtpmail-smtp-server)
- 'smtpmail-send-it 'sendmail-query-once)
+ #'smtpmail-send-it #'sendmail-query-once)
"Function to call to send the current buffer as mail.
The headers should be delimited by a line which is
not a valid RFC 822 (or later) header or continuation line,
@@ -160,14 +152,12 @@ This is used by the default mail-sending commands. See
also
(function-item feedmail-send-it :tag "Use Feedmail package")
(function-item mailclient-send-it :tag "Use Mailclient package")
function)
- :version "24.1"
- :group 'sendmail)
+ :version "24.1")
;;;###autoload
(defcustom mail-header-separator (purecopy "--text follows this line--")
"Line used to separate headers from text in messages being composed."
- :type 'string
- :group 'sendmail)
+ :type 'string)
;; Set up mail-header-separator for use as a category text property.
(put 'mail-header-separator 'rear-nonsticky '(category))
@@ -183,16 +173,14 @@ This is used by the default mail-sending commands. See
also
"Name of file to write all outgoing messages in, or nil for none.
This is normally an mbox file, but for backwards compatibility may also
be a Babyl file."
- :type '(choice file (const nil))
- :group 'sendmail)
+ :type '(choice file (const nil)))
;;;###autoload
(defcustom mail-default-reply-to nil
"Address to insert as default Reply-To field of outgoing messages.
If nil, it will be initialized from the REPLYTO environment variable
when you first send mail."
- :type '(choice (const nil) string)
- :group 'sendmail)
+ :type '(choice (const nil) string))
(defcustom mail-alias-file nil
"If non-nil, the name of a file to use instead of the sendmail default.
@@ -201,8 +189,7 @@ feature from that of defining aliases in `.mailrc' to be
expanded in Emacs.
This variable has no effect unless your system uses sendmail as its mailer.
The default file is defined in sendmail's configuration file, e.g.
`/etc/aliases'."
- :type '(choice (const :tag "Sendmail default" nil) file)
- :group 'sendmail)
+ :type '(choice (const :tag "Sendmail default" nil) file))
;;;###autoload
(defcustom mail-personal-alias-file (purecopy "~/.mailrc")
@@ -210,15 +197,13 @@ The default file is defined in sendmail's configuration
file, e.g.
This file typically should be in same format as the `.mailrc' file used by
the `Mail' or `mailx' program.
This file need not actually exist."
- :type '(choice (const nil) file)
- :group 'sendmail)
+ :type '(choice (const nil) file))
;;;###autoload
(defcustom mail-setup-hook nil
"Normal hook, run each time a new outgoing message is initialized."
:type 'hook
- :options '(fortune-to-signature spook mail-abbrevs-setup)
- :group 'sendmail)
+ :options '(fortune-to-signature spook mail-abbrevs-setup))
;;;###autoload
(defvar mail-aliases t
@@ -236,15 +221,13 @@ The alias definitions in the file have this form:
(defcustom mail-yank-prefix "> "
"Prefix insert on lines of yanked message being replied to.
If this is nil, use indentation, as specified by `mail-indentation-spaces'."
- :type '(choice (const nil) string)
- :group 'sendmail)
+ :type '(choice (const nil) string))
;;;###autoload
(defcustom mail-indentation-spaces 3
"Number of spaces to insert at the beginning of each cited line.
Used by `mail-yank-original' via `mail-indent-citation'."
- :type 'integer
- :group 'sendmail)
+ :type 'integer)
;;;###autoload
(defcustom mail-citation-hook nil
@@ -257,8 +240,7 @@ in the cited portion of the message.
If this hook is entirely empty (nil), a default action is taken
instead of no action."
- :type 'hook
- :group 'sendmail)
+ :type 'hook)
(defvar mail-citation-header nil
"While running `mail-citation-hook', this variable holds the message header.
@@ -273,7 +255,6 @@ It should match whatever sort of citation prefixes you want
to handle,
with whitespace before and after; it should also match just whitespace.
The default value matches citations like `foo-bar>' plus whitespace."
:type 'regexp
- :group 'sendmail
:version "24.1")
(defvar mail-abbrevs-loaded nil)
@@ -380,15 +361,13 @@ and should insert whatever you want to insert."
:type '(choice (const :tag "None" nil)
(const :tag "Use `.signature' file" t)
(string :tag "String to insert")
- (sexp :tag "Expression to evaluate"))
- :group 'sendmail)
+ (sexp :tag "Expression to evaluate")))
(put 'mail-signature 'risky-local-variable t)
;;;###autoload
(defcustom mail-signature-file (purecopy "~/.signature")
"File containing the text inserted at end of mail buffer."
- :type 'file
- :group 'sendmail)
+ :type 'file)
;;;###autoload
(defcustom mail-default-directory (purecopy "~/")
@@ -398,7 +377,6 @@ This directory is used for auto-save files of Mail mode
buffers.
Note that Message mode does not use this variable; it auto-saves
in `message-auto-save-directory'."
:type '(directory :tag "Directory")
- :group 'sendmail
:version "22.1")
(defvar mail-reply-action nil)
@@ -411,16 +389,14 @@ in `message-auto-save-directory'."
"A string containing header lines, to be inserted in outgoing messages.
It can contain newlines, and should end in one. It is inserted
before you edit the message, so you can edit or delete the lines."
- :type '(choice (const nil) string)
- :group 'sendmail)
+ :type '(choice (const nil) string))
(defcustom mail-bury-selects-summary t
"If non-nil, try to show Rmail summary buffer after returning from mail.
The functions \\[mail-send-on-exit] or \\[mail-dont-send] select
the Rmail summary buffer before returning, if it exists and this variable
is non-nil."
- :type 'boolean
- :group 'sendmail)
+ :type 'boolean)
(defcustom mail-send-nonascii 'mime
"Specify whether to allow sending non-ASCII characters in mail.
@@ -430,14 +406,12 @@ If t, that means do allow it. nil means don't allow it.
The default is `mime'.
Including non-ASCII characters in a mail message can be problematical
for the recipient, who may not know how to decode them properly."
- :type '(choice (const t) (const nil) (const query) (const mime))
- :group 'sendmail)
+ :type '(choice (const t) (const nil) (const query) (const mime)))
(defcustom mail-use-dsn nil
"Ask MTA for notification of failed, delayed or successful delivery.
Note that only some MTAs (currently only recent versions of Sendmail)
support Delivery Status Notification."
- :group 'sendmail
:type '(repeat (radio (const :tag "Failure" failure)
(const :tag "Delay" delay)
(const :tag "Success" success)))
@@ -506,7 +480,7 @@ This also saves the value of `send-mail-function' via
Customize."
;; If send-mail-function is already setup, we're incorrectly called
;; a second time, probably because someone's using an old value
;; of send-mail-function.
- (if (not (eq send-mail-function 'sendmail-query-once))
+ (if (not (eq send-mail-function #'sendmail-query-once))
(funcall send-mail-function)
(let ((function (sendmail-query-user-about-smtp)))
(funcall function)
@@ -571,8 +545,8 @@ This also saves the value of `send-mail-function' via
Customize."
;;;###autoload
(define-mail-user-agent 'sendmail-user-agent
- 'sendmail-user-agent-compose
- 'mail-send-and-exit)
+ #'sendmail-user-agent-compose
+ #'mail-send-and-exit)
;;;###autoload
(defun sendmail-user-agent-compose (&optional to subject other-headers
@@ -687,7 +661,6 @@ This also saves the value of `send-mail-function' via
Customize."
"Hook run by Mail mode.
When composing a mail, this runs immediately after creating, or
switching to, the `*mail*' buffer. See also `mail-setup-hook'."
- :group 'sendmail
:type 'hook
:options '(footnote-mode))
@@ -724,10 +697,8 @@ Turning on Mail mode runs the normal hooks
`text-mode-hook' and
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(mail-font-lock-keywords t t))
(make-local-variable 'paragraph-separate)
- (make-local-variable 'normal-auto-fill-function)
- (setq normal-auto-fill-function 'mail-mode-auto-fill)
- (make-local-variable 'fill-paragraph-function)
- (setq fill-paragraph-function 'mail-mode-fill-paragraph)
+ (setq-local normal-auto-fill-function #'mail-mode-auto-fill)
+ (setq-local fill-paragraph-function #'mail-mode-fill-paragraph)
;; Allow using comment commands to add/remove quoting (this only does
;; anything if mail-yank-prefix is set to a non-nil value).
(set (make-local-variable 'comment-start) mail-yank-prefix)
@@ -880,16 +851,14 @@ Prefix arg means don't delete this window."
(defcustom mail-send-hook nil
"Hook run just before sending a message."
:type 'hook
- :options '(flyspell-mode-off)
- :group 'sendmail)
+ :options '(flyspell-mode-off))
;;;###autoload
(defcustom mail-mailing-lists nil
"List of mailing list addresses the user is subscribed to.
The variable is used to trigger insertion of the \"Mail-Followup-To\"
header when sending a message to a mailing list."
- :type '(repeat string)
- :group 'sendmail)
+ :type '(repeat string))
(declare-function mml-to-mime "mml" ())
@@ -938,7 +907,7 @@ the user from the mailer."
(push e l)))
(split-string new-header-values
",[[:space:]]+" t))
- (mapconcat 'identity l ", "))
+ (mapconcat #'identity l ", "))
"\n"))
;; Add Mail-Reply-To if none yet
(unless (mail-fetch-field "mail-reply-to")
@@ -1185,6 +1154,9 @@ Return non-nil if and only if some part of the header is
encoded."
This is a suitable value for `send-mail-function'. It sends using the
external program defined by `sendmail-program'."
(require 'mail-utils)
+ ;; FIXME: A lot of the work done here seems out-of-place (e.g. it should
+ ;; happen regardless of the method used to send, whether via SMTP of
+ ;; /usr/bin/sendmail or anything else).
(let ((errbuf (if mail-interactive
(generate-new-buffer " sendmail errors")
0))
@@ -1222,6 +1194,8 @@ external program defined by `sendmail-program'."
(expand-mail-aliases (point-min) delimline))
(goto-char (point-min))
;; Ignore any blank lines in the header
+ ;; FIXME: mail-header-end should have stopped at an empty line,
+ ;; so the regexp below should never match before delimline!
(while (and (re-search-forward "\n\n\n*" delimline t)
(< (point) delimline))
(replace-match "\n"))
@@ -1346,11 +1320,11 @@ external program defined by `sendmail-program'."
'("-t")
)
(if mail-use-dsn
- (list "-N" (mapconcat 'symbol-name
+ (list "-N" (mapconcat #'symbol-name
mail-use-dsn ",")))
)
)
- (exit-value (apply 'call-process-region args)))
+ (exit-value (apply #'call-process-region args)))
(cond ((or (null exit-value) (eq 0 exit-value)))
((numberp exit-value)
(setq error t)
@@ -1818,7 +1792,7 @@ If the current line has `mail-yank-prefix', insert it on
the new line."
(or (bolp) (newline))
(goto-char start))))
-(define-obsolete-function-alias 'mail-attach-file 'mail-insert-file "24.1")
+(define-obsolete-function-alias 'mail-attach-file #'mail-insert-file "24.1")
(declare-function mml-attach-file "mml"
(file &optional type description disposition))
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index c017bae..ca74b2e 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -717,7 +717,7 @@ parsed."
((equal token "and") (push 'and op-stack))
((equal token ")")
(multiple-value-setq (op-stack operand-stack)
- (values-list (mh-index-evaluate op-stack operand-stack)))
+ (cl-values-list (mh-index-evaluate op-stack operand-stack)))
(when (eq (car op-stack) 'not)
(setq op-stack (cdr op-stack))
(push `(not ,(pop operand-stack)) operand-stack))
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 3e89d1b..fc661c8 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -452,7 +452,7 @@ be handled next."
(substring output position line-end))
mh-speed-partial-line "")
(multiple-value-setq (folder unseen total)
- (values-list
+ (cl-values-list
(mh-parse-flist-output-line line mh-speed-current-folder)))
(when (and folder unseen total
(let ((old-pair (gethash folder mh-speed-flists-cache)))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index aa31e25..6382e66 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -131,9 +131,36 @@
:group 'external
:group 'comm)
+(defvar browse-url--browser-defcustom-type
+ '(choice
+ (function-item :tag "Emacs W3" :value browse-url-w3)
+ (function-item :tag "eww" :value eww-browse-url)
+ (function-item :tag "Mozilla" :value browse-url-mozilla)
+ (function-item :tag "Firefox" :value browse-url-firefox)
+ (function-item :tag "Google Chrome" :value browse-url-chrome)
+ (function-item :tag "Chromium" :value browse-url-chromium)
+ (function-item :tag "Epiphany" :value browse-url-epiphany)
+ (function-item :tag "Conkeror" :value browse-url-conkeror)
+ (function-item :tag "Text browser in an xterm window"
+ :value browse-url-text-xterm)
+ (function-item :tag "Text browser in an Emacs window"
+ :value browse-url-text-emacs)
+ (function-item :tag "KDE" :value browse-url-kde)
+ (function-item :tag "Elinks" :value browse-url-elinks)
+ (function-item :tag "Specified by `Browse Url Generic Program'"
+ :value browse-url-generic)
+ (function-item :tag "Default Windows browser"
+ :value browse-url-default-windows-browser)
+ (function-item :tag "Default macOS browser"
+ :value browse-url-default-macosx-browser)
+ (function-item :tag "Default browser"
+ :value browse-url-default-browser)
+ (function :tag "Your own function")
+ (alist :tag "Regexp/function association list"
+ :key-type regexp :value-type function)))
+
;;;###autoload
-(defcustom browse-url-browser-function
- 'browse-url-default-browser
+(defcustom browse-url-browser-function 'browse-url-default-browser
"Function to display the current buffer in a WWW browser.
This is used by the `browse-url-at-point', `browse-url-at-mouse', and
`browse-url-of-file' commands.
@@ -143,34 +170,17 @@ If the value is not a function it should be a list of
pairs
associated with the first REGEXP which matches the current URL. The
function is passed the URL and any other args of `browse-url'. The last
regexp should probably be \".\" to specify a default browser."
- :type '(choice
- (function-item :tag "Emacs W3" :value browse-url-w3)
- (function-item :tag "eww" :value eww-browse-url)
- (function-item :tag "Mozilla" :value browse-url-mozilla)
- (function-item :tag "Firefox" :value browse-url-firefox)
- (function-item :tag "Google Chrome" :value browse-url-chrome)
- (function-item :tag "Chromium" :value browse-url-chromium)
- (function-item :tag "Epiphany" :value browse-url-epiphany)
- (function-item :tag "Conkeror" :value browse-url-conkeror)
- (function-item :tag "Text browser in an xterm window"
- :value browse-url-text-xterm)
- (function-item :tag "Text browser in an Emacs window"
- :value browse-url-text-emacs)
- (function-item :tag "KDE" :value browse-url-kde)
- (function-item :tag "Elinks" :value browse-url-elinks)
- (function-item :tag "Specified by `Browse Url Generic Program'"
- :value browse-url-generic)
- (function-item :tag "Default Windows browser"
- :value browse-url-default-windows-browser)
- (function-item :tag "Default macOS browser"
- :value browse-url-default-macosx-browser)
- (function-item :tag "Default browser"
- :value browse-url-default-browser)
- (function :tag "Your own function")
- (alist :tag "Regexp/function association list"
- :key-type regexp :value-type function))
- :version "24.1"
- :group 'browse-url)
+ :type browse-url--browser-defcustom-type
+ :version "24.1")
+
+(defcustom browse-url-secondary-browser-function 'browse-url-default-browser
+ "Function used to launch an alternative browser.
+This should usually be an external browser (that is, not eww or
+w3m), used as the secondary browser choice, and is typically used
+when giving a prefix argument to the URL-opening command (in
+those modes that support this (for instance, eww/shr)."
+ :version "27.1"
+ :type browse-url--browser-defcustom-type)
(defcustom browse-url-mailto-function 'browse-url-mail
"Function to display mailto: links.
@@ -181,8 +191,7 @@ be used instead."
:type '(choice
(function-item :tag "Emacs Mail" :value browse-url-mail)
(function-item :tag "None" nil))
- :version "24.1"
- :group 'browse-url)
+ :version "24.1")
(defcustom browse-url-man-function 'browse-url-man
"Function to display man: links."
@@ -190,8 +199,28 @@ be used instead."
(function-item :tag "Emacs Man" :value browse-url-man)
(const :tag "None" nil)
(function :tag "Other function"))
- :version "26.1"
- :group 'browse-url)
+ :version "26.1")
+
+(defcustom browse-url-button-regexp
+ (concat
+ "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|"
+ "nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)"
+ "\\(//[-a-z0-9_.]+:[0-9]*\\)?"
+ (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
+ (punct "!?:;.,"))
+ (concat
+ "\\(?:"
+ ;; Match paired parentheses, e.g. in Wikipedia URLs:
+ ;; http://thread.gmane.org/address@hidden
+ "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)"
+ "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?"
+ "\\|"
+ "[" chars punct "]+" "[" chars "]"
+ "\\)"))
+ "\\)")
+ "Regular expression that matches URLs."
+ :version "27.1"
+ :type 'regexp)
(defcustom browse-url-netscape-program "netscape"
;; Info about netscape-remote from Karl Berry.
@@ -202,15 +231,13 @@ The free program `netscape-remote' from
up very much quicker than `netscape'. Reported to compile on a GNU
system, given vroot.h from the same directory, with cc flags
-DSTANDALONE -L/usr/X11R6/lib -lXmu -lX11."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(make-obsolete-variable 'browse-url-netscape-program nil "25.1")
(defcustom browse-url-netscape-arguments nil
"A list of strings to pass to Netscape as arguments."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-netscape-arguments nil "25.1")
@@ -218,33 +245,27 @@ system, given vroot.h from the same directory, with cc
flags
"A list of strings to pass to Netscape when it starts up.
Defaults to the value of `browse-url-netscape-arguments' at the time
`browse-url' is loaded."
- :type '(repeat (string :tag "Argument"))
-
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-netscape-startup-arguments nil "25.1")
(defcustom browse-url-browser-display nil
"The X display for running the browser, if not same as Emacs's."
- :type '(choice string (const :tag "Default" nil))
- :group 'browse-url)
+ :type '(choice string (const :tag "Default" nil)))
(defcustom browse-url-mozilla-program "mozilla"
"The name by which to invoke Mozilla."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(defcustom browse-url-mozilla-arguments nil
"A list of strings to pass to Mozilla as arguments."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-mozilla-startup-arguments browse-url-mozilla-arguments
"A list of strings to pass to Mozilla when it starts up.
Defaults to the value of `browse-url-mozilla-arguments' at the time
`browse-url' is loaded."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-firefox-program
(let ((candidates '("icecat" "iceweasel" "firefox")))
@@ -252,20 +273,17 @@ Defaults to the value of `browse-url-mozilla-arguments'
at the time
(setq candidates (cdr candidates)))
(or (car candidates) "firefox"))
"The name by which to invoke Firefox or a variant of it."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(defcustom browse-url-firefox-arguments nil
"A list of strings to pass to Firefox (or variant) as arguments."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-firefox-startup-arguments browse-url-firefox-arguments
"A list of strings to pass to Firefox (or variant) when it starts up.
Defaults to the value of `browse-url-firefox-arguments' at the time
`browse-url' is loaded."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-firefox-startup-arguments
"it no longer has any effect." "24.5")
@@ -277,14 +295,12 @@ Defaults to the value of `browse-url-firefox-arguments'
at the time
(or (car candidates) "chromium"))
"The name by which to invoke the Chrome browser."
:type 'string
- :version "25.1"
- :group 'browse-url)
+ :version "25.1")
(defcustom browse-url-chrome-arguments nil
"A list of strings to pass to Google Chrome as arguments."
:type '(repeat (string :tag "Argument"))
- :version "25.1"
- :group 'browse-url)
+ :version "25.1")
(defcustom browse-url-chromium-program
(let ((candidates '("chromium" "chromium-browser")))
@@ -293,26 +309,22 @@ Defaults to the value of `browse-url-firefox-arguments'
at the time
(or (car candidates) "chromium"))
"The name by which to invoke Chromium."
:type 'string
- :version "24.1"
- :group 'browse-url)
+ :version "24.1")
(defcustom browse-url-chromium-arguments nil
"A list of strings to pass to Chromium as arguments."
:type '(repeat (string :tag "Argument"))
- :version "24.1"
- :group 'browse-url)
+ :version "24.1")
(defcustom browse-url-galeon-program "galeon"
"The name by which to invoke Galeon."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(make-obsolete-variable 'browse-url-galeon-program nil "25.1")
(defcustom browse-url-galeon-arguments nil
"A list of strings to pass to Galeon as arguments."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-galeon-arguments nil "25.1")
@@ -320,27 +332,23 @@ Defaults to the value of `browse-url-firefox-arguments'
at the time
"A list of strings to pass to Galeon when it starts up.
Defaults to the value of `browse-url-galeon-arguments' at the time
`browse-url' is loaded."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-galeon-startup-arguments nil "25.1")
(defcustom browse-url-epiphany-program "epiphany"
"The name by which to invoke Epiphany."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(defcustom browse-url-epiphany-arguments nil
"A list of strings to pass to Epiphany as arguments."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-epiphany-startup-arguments browse-url-epiphany-arguments
"A list of strings to pass to Epiphany when it starts up.
Defaults to the value of `browse-url-epiphany-arguments' at the time
`browse-url' is loaded."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
;; GNOME means of invoking either Mozilla or Netscape.
(defvar browse-url-gnome-moz-program "gnome-moz-remote")
@@ -350,8 +358,7 @@ Defaults to the value of `browse-url-epiphany-arguments' at
the time
(defcustom browse-url-gnome-moz-arguments '()
"A list of strings passed to the GNOME mozilla viewer as arguments."
:version "21.1"
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-gnome-moz-arguments nil "25.1")
@@ -359,30 +366,26 @@ Defaults to the value of `browse-url-epiphany-arguments'
at the time
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
`browse-url-mozilla' is asked to open it in a new window."
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(defcustom browse-url-firefox-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
`browse-url-firefox' is asked to open it in a new window."
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(defcustom browse-url-conkeror-new-window-is-buffer nil
"Whether to open up new windows in a buffer or a new window.
If non-nil, then open the URL in a new buffer rather than a new window if
`browse-url-conkeror' is asked to open it in a new window."
:version "25.1"
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(defcustom browse-url-galeon-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
`browse-url-galeon' is asked to open it in a new window."
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(make-obsolete-variable 'browse-url-galeon-new-window-is-tab nil "25.1")
@@ -390,16 +393,14 @@ If non-nil, then open the URL in a new tab rather than a
new window if
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
`browse-url-epiphany' is asked to open it in a new window."
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(defcustom browse-url-netscape-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new
window if `browse-url-netscape' is asked to open it in a new
window."
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(make-obsolete-variable 'browse-url-netscape-new-window-is-tab nil "25.1")
@@ -407,42 +408,36 @@ window."
"Non-nil means always open a new browser window with appropriate browsers.
Passing an interactive argument to \\[browse-url], or specific browser
commands reverses the effect of this variable."
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(defcustom browse-url-mosaic-program "xmosaic"
"The name by which to invoke Mosaic (or mMosaic)."
:type 'string
- :version "20.3"
- :group 'browse-url)
+ :version "20.3")
(make-obsolete-variable 'browse-url-mosaic-program nil "25.1")
(defcustom browse-url-mosaic-arguments nil
"A list of strings to pass to Mosaic as arguments."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-mosaic-arguments nil "25.1")
(defcustom browse-url-mosaic-pidfile "~/.mosaicpid"
"The name of the pidfile created by Mosaic."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(make-obsolete-variable 'browse-url-mosaic-pidfile nil "25.1")
(defcustom browse-url-conkeror-program "conkeror"
"The name by which to invoke Conkeror."
:type 'string
- :version "25.1"
- :group 'browse-url)
+ :version "25.1")
(defcustom browse-url-conkeror-arguments nil
"A list of strings to pass to Conkeror as arguments."
:version "25.1"
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-filename-alist
`(("^/\\(ftp@\\|anonymous@\\)?\\([^:/]+\\):/*" . "ftp://\\2/";)
@@ -473,26 +468,22 @@ address to an HTTP URL:
:type '(repeat (cons :format "%v"
(regexp :tag "Regexp")
(string :tag "Replacement")))
- :version "25.1"
- :group 'browse-url)
+ :version "25.1")
(defcustom browse-url-save-file nil
"If non-nil, save the buffer before displaying its file.
Used by the `browse-url-of-file' command."
- :type 'boolean
- :group 'browse-url)
+ :type 'boolean)
(defcustom browse-url-of-file-hook nil
"Hook run after `browse-url-of-file' has asked a browser to load a file."
- :type 'hook
- :group 'browse-url)
+ :type 'hook)
(defcustom browse-url-CCI-port 3003
"Port to access XMosaic via CCI.
This can be any number between 1024 and 65535 but must correspond to
the value set in the browser."
- :type 'integer
- :group 'browse-url)
+ :type 'integer)
(make-obsolete-variable 'browse-url-CCI-port nil "25.1")
@@ -500,8 +491,7 @@ the value set in the browser."
"Host to access XMosaic via CCI.
This should be the host name of the machine running XMosaic with CCI
enabled. The port number should be set in `browse-url-CCI-port'."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(make-obsolete-variable 'browse-url-CCI-host nil "25.1")
@@ -511,57 +501,48 @@ enabled. The port number should be set in
`browse-url-CCI-port'."
(defcustom browse-url-xterm-program "xterm"
"The name of the terminal emulator used by `browse-url-text-xterm'.
This might, for instance, be a separate color version of xterm."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(defcustom browse-url-xterm-args nil
"A list of strings defining options for `browse-url-xterm-program'.
These might set its size, for instance."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-gnudoit-program "gnudoit"
"The name of the `gnudoit' program used by `browse-url-w3-gnudoit'."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(defcustom browse-url-gnudoit-args '("-q")
"A list of strings defining options for `browse-url-gnudoit-program'.
These might set the port, for instance."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-generic-program nil
"The name of the browser program used by `browse-url-generic'."
- :type '(choice string (const :tag "None" nil))
- :group 'browse-url)
+ :type '(choice string (const :tag "None" nil)))
(defcustom browse-url-generic-args nil
"A list of strings defining options for `browse-url-generic-program'."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-temp-dir temporary-file-directory
"The name of a directory for browse-url's temporary files.
Such files are generated by functions like `browse-url-of-region'.
You might want to set this to somewhere with restricted read permissions
for privacy's sake."
- :type 'string
- :group 'browse-url)
+ :type 'string)
(defcustom browse-url-netscape-version 3
"The version of Netscape you are using.
This affects how URL reloading is done; the mechanism changed
incompatibly at version 4."
- :type 'number
- :group 'browse-url)
+ :type 'number)
(make-obsolete-variable 'browse-url-netscape-version nil "25.1")
(defcustom browse-url-text-browser "lynx"
"The name of the text browser to invoke."
:type 'string
- :group 'browse-url
:version "23.1")
(defcustom browse-url-text-emacs-args (and (not window-system)
@@ -572,8 +553,7 @@ The default is none in a window system, otherwise
`-show_cursor' to
indicate the position of the current link in the absence of
highlighting, assuming the normal default for showing the cursor."
:type '(repeat (string :tag "Argument"))
- :version "23.1"
- :group 'browse-url)
+ :version "23.1")
(defcustom browse-url-text-input-field 'avoid
"Action on selecting an existing text browser buffer at an input field.
@@ -586,36 +566,30 @@ down (this *won't* always work)."
:type '(choice (const :tag "Move to try to avoid field" :value avoid)
(const :tag "Disregard" :value nil)
(const :tag "Warn, don't emit URL" :value warn))
- :version "23.1"
- :group 'browse-url)
+ :version "23.1")
(defcustom browse-url-text-input-attempts 10
"How many times to try to move down from a series of text browser input
fields."
:type 'integer
- :version "23.1"
- :group 'browse-url)
+ :version "23.1")
(defcustom browse-url-text-input-delay 0.2
"Seconds to wait for a text browser between moves down from an input field."
:type 'number
- :version "23.1"
- :group 'browse-url)
+ :version "23.1")
(defcustom browse-url-kde-program "kfmclient"
"The name by which to invoke the KDE web browser."
:type 'string
- :version "21.1"
- :group 'browse-url)
+ :version "21.1")
(defcustom browse-url-kde-args '("openURL")
"A list of strings defining options for `browse-url-kde-program'."
- :type '(repeat (string :tag "Argument"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Argument")))
(defcustom browse-url-elinks-wrapper '("xterm" "-e")
"Wrapper command prepended to the Elinks command-line."
- :type '(repeat (string :tag "Wrapper"))
- :group 'browse-url)
+ :type '(repeat (string :tag "Wrapper")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL encoding
@@ -1673,6 +1647,67 @@ from `browse-url-elinks-wrapper'."
(error "Unrecognized exit-code %d of process `elinks'"
exit-status))))
+;;; Adding buttons to a buffer to call `browse-url' when you hit them.
+
+(defvar browse-url-button-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'browse-url-button-open)
+ (define-key map [mouse-2] 'browse-url-button-open)
+ (define-key map "w" 'browse-url-button-copy)
+ map)
+ "The keymap used for browse-url buttons.")
+
+(defface browse-url-button
+ '((t :inherit link))
+ "Face for browse-url buttons (i.e., links)."
+ :version "27.1")
+
+(defun browse-url-add-buttons ()
+ "Add clickable buttons to the text following point in the current buffer.
+Everything that matches `browse-url-button-regexp' will be made
+clickable and will use `browse-url' to open the URLs in question."
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (while (re-search-forward browse-url-button-regexp nil t)
+ (add-text-properties (match-beginning 0)
+ (match-end 0)
+ `(help-echo "Open the URL under point"
+ keymap ,browse-url-button-map
+ face browse-url-button
+ button t
+ category browse-url
+ browse-url-data ,(match-string
0)))))))
+
+(defun browse-url-button-open (&optional external mouse-event)
+ "Follow the link under point using `browse-url'.
+If EXTERNAL (the prefix if used interactively), open with the
+external browser instead of the default one."
+ (interactive (list current-prefix-arg last-nonmenu-event))
+ (mouse-set-point mouse-event)
+ (let ((url (get-text-property (point) 'browse-url-data)))
+ (unless url
+ (error "No URL under point"))
+ (if external
+ (funcall browse-url-secondary-browser-function url)
+ (browse-url url))))
+
+(defun browse-url-button-open-url (url)
+ "Open URL using `browse-url'.
+If `current-prefix-arg' is non-nil, use
+`browse-url-secondary-browser-function' instead."
+ (if current-prefix-arg
+ (funcall browse-url-secondary-browser-function url)
+ (browse-url url)))
+
+(defun browse-url-button-copy ()
+ "Copy the URL under point"
+ (interactive)
+ (let ((url (get-text-property (point) 'browse-url-data)))
+ (unless url
+ (error "No URL under point"))
+ (kill-new url)
+ (message "Copied %s" url)))
+
(provide 'browse-url)
;;; browse-url.el ends here
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 206f9cf..77e6cec 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1501,13 +1501,17 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(defun eww-browse-with-external-browser (&optional url)
"Browse the current URL with an external browser.
-The browser to used is specified by the `shr-external-browser' variable."
+The browser to used is specified by the
+`browse-url-secondary-browser-function' variable."
(interactive)
- (funcall shr-external-browser (or url (plist-get eww-data :url))))
+ (funcall browse-url-secondary-browser-function
+ (or url (plist-get eww-data :url))))
(defun eww-follow-link (&optional external mouse-event)
"Browse the URL under point.
-If EXTERNAL is single prefix, browse the URL using `shr-external-browser'.
+If EXTERNAL is single prefix, browse the URL using
+`browse-url-secondary-browser-function'.
+
If EXTERNAL is double prefix, browse in new buffer."
(interactive (list current-prefix-arg last-nonmenu-event))
(mouse-set-point mouse-event)
@@ -1518,7 +1522,7 @@ If EXTERNAL is double prefix, browse in new buffer."
((string-match "^mailto:"; url)
(browse-url-mail url))
((and (consp external) (<= (car external) 4))
- (funcall shr-external-browser url)
+ (funcall browse-url-secondary-browser-function url)
(shr--blink-link))
;; This is a #target url in the same page as the current one.
((and (url-target (url-generic-parse-url url))
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index e356a0e..1fb7fe0 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -37,6 +37,7 @@
(require 'derived)
(require 'xml)
(require 'url-parse)
+(require 'iso8601)
;; Silence warnings
(defvar w3-mode-map)
@@ -1594,61 +1595,16 @@ This function calls `message' with arguments STRING and
ARGS, if
;;(not (current-message))
(apply 'message string args)))
-(defun newsticker--decode-iso8601-date (iso8601-string)
- "Return ISO8601-STRING in format like `decode-time'.
-Converts from ISO-8601 to Emacs representation.
-Examples:
-2004-09-17T05:09:49.001+00:00
-2004-09-17T05:09:49+00:00
-2004-09-17T05:09+00:00
-2004-09-17T05:09:49
-2004-09-17T05:09
-2004-09-17
-2004-09
-2004"
- (if iso8601-string
- (when (string-match
- (concat
- "^ *\\([0-9]\\{4\\}\\)" ;year
- "\\(-\\([0-9]\\{2\\}\\)" ;month
- "\\(-\\([0-9]\\{2\\}\\)" ;day
- "\\(T"
- "\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)" ;hour:minute
- "\\(:\\([0-9]\\{2\\}\\)\\(\\.[0-9]+\\)?\\)?" ;second
- ;timezone
- "\\(\\([-+Z]\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)?"
- "\\)?\\)?\\)? *$")
- iso8601-string)
- (let ((year (read (match-string 1 iso8601-string)))
- (month (read (or (match-string 3 iso8601-string)
- "1")))
- (day (read (or (match-string 5 iso8601-string)
- "1")))
- (hour (read (or (match-string 7 iso8601-string)
- "0")))
- (minute (read (or (match-string 8 iso8601-string)
- "0")))
- (second (read (or (match-string 10 iso8601-string)
- "0")))
- (sign (match-string 13 iso8601-string))
- (offset-hour (read (or (match-string 15 iso8601-string)
- "0")))
- (offset-minute (read (or (match-string 16 iso8601-string)
- "0"))))
- (cond ((string= sign "+")
- (setq hour (- hour offset-hour))
- (setq minute (- minute offset-minute)))
- ((string= sign "-")
- (setq hour (+ hour offset-hour))
- (setq minute (+ minute offset-minute))))
- ;; if UTC subtract current-time-zone offset
- ;;(setq second (+ (car (current-time-zone)) second)))
-
- (condition-case nil
- (encode-time second minute hour day month year t)
- (error
- (message "Cannot decode \"%s\"" iso8601-string)
- nil))))
+(defun newsticker--decode-iso8601-date (string)
+ "Return ISO8601-STRING in format like `encode-time'.
+Converts from ISO-8601 to Emacs representation. If no time zone
+is present, this fuction defaults to universal time."
+ (if string
+ (condition-case nil
+ (encode-time (decoded-time-set-defaults (iso8601-parse string) 0))
+ (wrong-type-argument
+ (message "Cannot decode \"%s\"" string)
+ nil))
nil))
(defun newsticker--decode-rfc822-date (rfc822-string)
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el
index 599e230..ddb4139 100644
--- a/lisp/net/pop3.el
+++ b/lisp/net/pop3.el
@@ -611,14 +611,14 @@ Return the response string if optional second argument is
non-nil."
If NOW, use that time instead."
(require 'parse-time)
(let* ((now (or now (current-time)))
- (zone (nth 8 (decode-time now))))
+ (zone (decoded-time-zone (decode-time now))))
(when (< zone 0)
(setq zone (- zone)))
(concat
(format-time-string "%d" now)
;; The month name of the %b spec is locale-specific. Pfff.
(format " %s "
- (capitalize (car (rassoc (nth 4 (decode-time now))
+ (capitalize (car (rassoc (decoded-time-month (decode-time now))
parse-time-months))))
(format-time-string "%Y %H:%M:%S %z" now))))
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 24084c8..5722582 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -44,6 +44,7 @@
(require 'cl-lib)
(require 'ring)
(require 'time-date)
+(eval-when-compile (require 'subr-x))
(defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version))
@@ -1181,6 +1182,8 @@ with it."
rcirc-log-directory)
(rcirc-log-write))
(rcirc-clean-up-buffer "Killed buffer")
+ (when-let ((process (get-buffer-process (current-buffer))))
+ (delete-process process))
(when (and rcirc-buffer-alist ;; it's a server buffer
rcirc-kill-channel-buffers)
(dolist (channel rcirc-buffer-alist)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 98b09ab..fbd1a9b 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -53,53 +53,44 @@ width and height of the window. If they are larger than
this,
and Emacs supports it, then the images will be rescaled down to
fit these criteria."
:version "24.1"
- :group 'shr
:type 'float)
(defcustom shr-blocked-images nil
"Images that have URLs matching this regexp will be blocked."
:version "24.1"
- :group 'shr
:type '(choice (const nil) regexp))
(defcustom shr-use-fonts t
"If non-nil, use proportional fonts for text."
:version "25.1"
- :group 'shr
:type 'boolean)
(defcustom shr-discard-aria-hidden nil
"If non-nil, don't render tags with `aria-hidden=\"true\"'.
This attribute is meant to tell screen readers to ignore a tag."
:version "27.1"
- :group 'shr
:type 'boolean)
(defcustom shr-use-colors t
"If non-nil, respect color specifications in the HTML."
:version "26.1"
- :group 'shr
:type 'boolean)
(defcustom shr-table-horizontal-line nil
"Character used to draw horizontal table lines.
If nil, don't draw horizontal table lines."
- :group 'shr
:type '(choice (const nil) character))
(defcustom shr-table-vertical-line ?\s
"Character used to draw vertical table lines."
- :group 'shr
:type 'character)
(defcustom shr-table-corner ?\s
"Character used to draw table corners."
- :group 'shr
:type 'character)
(defcustom shr-hr-line ?-
"Character used to draw hr lines."
- :group 'shr
:type 'character)
(defcustom shr-width nil
@@ -110,8 +101,7 @@ If `shr-use-fonts' is set, the mean character width is used
to
compute the pixel width, which is used instead."
:version "25.1"
:type '(choice (integer :tag "Fixed width in characters")
- (const :tag "Use the width of the window" nil))
- :group 'shr)
+ (const :tag "Use the width of the window" nil)))
(defcustom shr-bullet "* "
"Bullet used for unordered lists.
@@ -119,19 +109,14 @@ Alternative suggestions are:
- \" \"
- \" \""
:version "24.4"
- :type 'string
- :group 'shr)
+ :type 'string)
-(defcustom shr-external-browser 'browse-url-default-browser
- "Function used to launch an external browser."
- :version "24.4"
- :group 'shr
- :type 'function)
+(define-obsolete-variable-alias 'shr-external-browser
+ 'browse-url-secondary-browser-function "27.1")
(defcustom shr-image-animate t
"Non nil means that images that can be animated will be."
:version "24.4"
- :group 'shr
:type 'boolean)
(defvar shr-content-function nil
@@ -144,28 +129,24 @@ cid: URL as the argument.")
(defface shr-strike-through '((t :strike-through t))
"Face for <s> elements."
- :version "24.1"
- :group 'shr)
+ :version "24.1")
(defface shr-link
'((t :inherit link))
"Face for link elements."
- :version "24.1"
- :group 'shr)
+ :version "24.1")
(defface shr-selected-link
'((t :inherit shr-link :background "red"))
"Temporary face for externally visited link elements.
When a link is visited with an external browser, the link
temporarily blinks with this face."
- :version "27.1"
- :group 'shr)
+ :version "27.1")
(defface shr-abbreviation
'((t :inherit underline :underline (:style wave)))
"Face for <abbr> elements."
- :version "27.1"
- :group 'shr)
+ :version "27.1")
(defvar shr-inhibit-images nil
"If non-nil, inhibit loading images.")
@@ -973,7 +954,7 @@ size, and full-buffer size."
(defun shr-browse-url (&optional external mouse-event)
"Browse the URL at point using `browse-url'.
If EXTERNAL is non-nil (interactively, the prefix argument), browse
-the URL using `shr-external-browser'.
+the URL using `browse-url-secondary-browser-function'.
If this function is invoked by a mouse click, it will browse the URL
at the position of the click. Optional argument MOUSE-EVENT describes
the mouse click event."
@@ -988,7 +969,7 @@ the mouse click event."
(t
(if external
(progn
- (funcall shr-external-browser url)
+ (funcall browse-url-secondary-browser-function url)
(shr--blink-link))
(browse-url url))))))
@@ -1226,6 +1207,8 @@ START, and END. Note that START and END should be
markers."
(add-text-properties
start (point)
(list 'shr-url url
+ 'button t
+ 'category 'shr ; For button.el button buffers.
'help-echo (let ((parsed (url-generic-parse-url
(or (ignore-errors
(decode-coding-string
@@ -1534,7 +1517,6 @@ The key element should be a regexp matched against the
type of the source or
url if no type is specified. The value should be a float in the range 0.0 to
1.0. Media elements with higher value are preferred."
:version "24.4"
- :group 'shr
:type '(alist :key-type regexp :value-type float))
(defun shr--get-media-pref (elem)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 6a82fef..3399b96 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -3785,7 +3785,8 @@ file-notify events."
(intern-soft
(replace-regexp-in-string "_" "-" (downcase x))))
(split-string (match-string 1 line) "," 'omit))
- (match-string 3 line))))
+ (or (match-string 3 line)
+ (file-name-nondirectory (process-get proc 'watch-name))))))
;; Usually, we would add an Emacs event now. Unfortunately,
;; `unread-command-events' does not accept several events at
;; once. Therefore, we apply the handler directly.
diff --git a/lisp/proced.el b/lisp/proced.el
index b05046b..5f35fa3 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -1367,12 +1367,12 @@ Prefix ARG controls sort order, see
`proced-sort-interactive'."
The return string is always 6 characters wide."
(let ((d-start (decode-time start))
(d-current (decode-time)))
- (cond ( ;; process started in previous years
- (< (nth 5 d-start) (nth 5 d-current))
+ (cond (;; process started in previous years
+ (< (decoded-time-year d-start) (decoded-time-year d-current))
(format-time-string " %Y" start))
;; process started today
- ((and (= (nth 3 d-start) (nth 3 d-current))
- (= (nth 4 d-start) (nth 4 d-current)))
+ ((and (= (decoded-time-day d-start) (decoded-time-day d-current))
+ (= (decoded-time-month d-start) (decoded-time-month
d-current)))
(format-time-string " %H:%M" start))
(t ;; process started this year
(format-time-string "%b %e" start)))))
diff --git a/lisp/profiler.el b/lisp/profiler.el
index ee11ff6..92495e2 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -615,9 +615,12 @@ return it."
(profiler-report-render-calltree))
buffer))
+(defun profiler--xref-backend () 'elisp)
+
(define-derived-mode profiler-report-mode special-mode "Profiler-Report"
"Profiler Report Mode."
(add-to-invisibility-spec '(profiler . t))
+ (add-hook 'xref-backend-functions #'profiler--xref-backend nil t)
(setq buffer-read-only t
buffer-undo-list t
truncate-lines t))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 39b6134..4cc1daf 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -701,8 +701,9 @@ of `my-compilation-root' here."
;;;###autoload
(defcustom compilation-search-path '(nil)
"List of directories to search for source files named in error messages.
-Elements should be directory names, not file names of directories.
-The value nil as an element means to try the default directory."
+Elements should be directory names, not file names of
+directories. The value nil as an element means the error
+message buffer `default-directory'."
:type '(repeat (choice (const :tag "Default" nil)
(string :tag "Directory"))))
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 7bf5753..a052ad2 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2070,14 +2070,15 @@ for \\[find-tag] (which see)."
(beginning-of-line)
(pcase-let* ((tag-info (etags-snarf-tag))
(`(,hint ,line . _) tag-info))
- (unless (eq hint t) ; hint==t if we are in a filename line
- (let* ((file (file-of-tag))
- (mark-key (cons file line)))
- (unless (gethash mark-key marks)
- (let ((loc (xref-make-etags-location
- tag-info (expand-file-name file))))
- (push (xref-make hint loc) xrefs)
- (puthash mark-key t marks)))))))))))
+ (let* ((file (file-of-tag))
+ (mark-key (cons file line)))
+ (unless (gethash mark-key marks)
+ (let ((loc (xref-make-etags-location
+ tag-info (expand-file-name file))))
+ (push (xref-make (if (eq hint t) "(filename match)" hint)
+ loc)
+ xrefs)
+ (puthash mark-key t marks))))))))))
(nreverse xrefs)))
(defclass xref-etags-location (xref-location)
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 67222f7..306ae8f 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -442,9 +442,10 @@ abbreviated part can also be toggled with
:group 'grep)
(defcustom grep-search-path '(nil)
- "Search path for grep results.
-Elements should be directory names, not file names of directories.
-The value nil as an element means to try the default directory."
+ "List of directories to search for files named in grep messages.
+Elements should be directory names, not file names of
+directories. The value nil as an element means the grep messages
+buffer `default-directory'."
:group 'grep
:version "27.1"
:type '(repeat (choice (const :tag "Default" nil)
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index 2b05735..79fe56a 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -211,6 +211,9 @@ You can enable this mode locally in desired buffers, or use
`global-prettify-symbols-mode' to enable it for all modes that
support it."
:init-value nil
+ (when prettify-symbols--keywords
+ (font-lock-remove-keywords nil prettify-symbols--keywords)
+ (setq prettify-symbols--keywords nil))
(if prettify-symbols-mode
;; Turn on
(when (setq prettify-symbols--keywords (prettify-symbols--make-keywords))
@@ -226,9 +229,6 @@ support it."
(font-lock-flush))
;; Turn off
(remove-hook 'post-command-hook #'prettify-symbols--post-command-hook t)
- (when prettify-symbols--keywords
- (font-lock-remove-keywords nil prettify-symbols--keywords)
- (setq prettify-symbols--keywords nil))
(when (memq 'composition font-lock-extra-managed-props)
(setq font-lock-extra-managed-props (delq 'composition
font-lock-extra-managed-props))
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 13d0cfa..9eedbf9 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -126,13 +126,15 @@
;;; Code:
-(eval-when-compile (require 'cl))
-(eval-and-compile
- ;; Before Emacs-24.4, `pushnew' expands to runtime calls to `cl-adjoin'
- ;; even for relatively simple cases such as used here. We only test <25
- ;; because it's easier and sufficient.
- (when (or (featurep 'xemacs) (< emacs-major-version 25))
- (require 'cl)))
+(eval-when-compile
+ (condition-case nil (require 'cl-lib) (file-missing (require 'cl)))
+ (defalias 'vhdl--pushnew (if (fboundp 'cl-pushnew) 'cl-pushnew 'pushnew)))
+
+;; Before Emacs-24.4, `pushnew' expands to runtime calls to `cl-adjoin'
+;; even for relatively simple cases such as used here. We only test <25
+;; because it's easier and sufficient.
+(when (< emacs-major-version 25)
+ (condition-case nil (require 'cl-lib) (file-missing (require 'cl))))
;; Emacs 21+ handling
(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep
'xemacs)))
@@ -14315,7 +14317,7 @@ of PROJECT."
(vhdl-scan-directory-contents dir-name project nil
(format "(%s/%s) " act-dir num-dir)
(cdr dir-list))
- (pushnew (file-name-directory dir-name) dir-list-tmp :test #'equal)
+ (vhdl--pushnew (file-name-directory dir-name) dir-list-tmp :test #'equal)
(setq dir-list (cdr dir-list)
act-dir (1+ act-dir)))
(vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
@@ -16407,8 +16409,8 @@ component instantiation."
(if (or (member constant-name single-list)
(member constant-name multi-list))
(progn (setq single-list (delete constant-name single-list))
- (pushnew constant-name multi-list :test #'equal))
- (pushnew constant-name single-list :test #'equal))
+ (vhdl--pushnew constant-name multi-list :test #'equal))
+ (vhdl--pushnew constant-name single-list :test #'equal))
(unless (match-string 1)
(setq generic-alist (cdr generic-alist)))
(vhdl-forward-syntactic-ws))
@@ -16434,12 +16436,12 @@ component instantiation."
(member signal-name multi-out-list))
(setq single-out-list (delete signal-name single-out-list))
(setq multi-out-list (delete signal-name multi-out-list))
- (pushnew signal-name local-list :test #'equal))
+ (vhdl--pushnew signal-name local-list :test #'equal))
((member signal-name single-in-list)
(setq single-in-list (delete signal-name single-in-list))
- (pushnew signal-name multi-in-list :test #'equal))
+ (vhdl--pushnew signal-name multi-in-list :test #'equal))
((not (member signal-name multi-in-list))
- (pushnew signal-name single-in-list :test #'equal)))
+ (vhdl--pushnew signal-name single-in-list :test #'equal)))
;; output signal
(cond
((member signal-name local-list)
@@ -16448,12 +16450,12 @@ component instantiation."
(member signal-name multi-in-list))
(setq single-in-list (delete signal-name single-in-list))
(setq multi-in-list (delete signal-name multi-in-list))
- (pushnew signal-name local-list :test #'equal))
+ (vhdl--pushnew signal-name local-list :test #'equal))
((member signal-name single-out-list)
(setq single-out-list (delete signal-name single-out-list))
- (pushnew signal-name multi-out-list :test #'equal))
+ (vhdl--pushnew signal-name multi-out-list :test #'equal))
((not (member signal-name multi-out-list))
- (pushnew signal-name single-out-list :test #'equal))))
+ (vhdl--pushnew signal-name single-out-list :test #'equal))))
(unless (match-string 1)
(setq port-alist (cdr port-alist)))
(vhdl-forward-syntactic-ws))
@@ -16536,14 +16538,14 @@ component instantiation."
generic-end-pos
(vhdl-compose-insert-generic constant-entry)))
(setq generic-pos (point-marker))
- (pushnew constant-name written-list :test #'equal))
+ (vhdl--pushnew constant-name written-list :test #'equal))
(t
(vhdl-goto-marker
(vhdl-max-marker generic-inst-pos generic-pos))
(setq generic-end-pos
(vhdl-compose-insert-generic constant-entry))
(setq generic-inst-pos (point-marker))
- (pushnew constant-name written-list :test #'equal))))
+ (vhdl--pushnew constant-name written-list :test #'equal))))
(setq constant-alist (cdr constant-alist)))
(when (/= constant-temp-pos generic-inst-pos)
(vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos))
@@ -16562,14 +16564,14 @@ component instantiation."
(vhdl-max-marker
port-end-pos (vhdl-compose-insert-port signal-entry)))
(setq port-in-pos (point-marker))
- (pushnew signal-name written-list :test #'equal))
+ (vhdl--pushnew signal-name written-list :test #'equal))
((member signal-name multi-out-list)
(vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos))
(setq port-end-pos
(vhdl-max-marker
port-end-pos (vhdl-compose-insert-port signal-entry)))
(setq port-out-pos (point-marker))
- (pushnew signal-name written-list :test #'equal))
+ (vhdl--pushnew signal-name written-list :test #'equal))
((or (member signal-name single-in-list)
(member signal-name single-out-list))
(vhdl-goto-marker
@@ -16578,12 +16580,12 @@ component instantiation."
(vhdl-max-marker port-out-pos port-in-pos)))
(setq port-end-pos (vhdl-compose-insert-port signal-entry))
(setq port-inst-pos (point-marker))
- (pushnew signal-name written-list :test #'equal))
+ (vhdl--pushnew signal-name written-list :test #'equal))
((equal (upcase (nth 2 signal-entry)) "OUT")
(vhdl-goto-marker signal-pos)
(vhdl-compose-insert-signal signal-entry)
(setq signal-pos (point-marker))
- (pushnew signal-name written-list :test #'equal)))
+ (vhdl--pushnew signal-name written-list :test #'equal)))
(setq signal-alist (cdr signal-alist)))
(when (/= port-temp-pos port-inst-pos)
(vhdl-goto-marker
@@ -16934,7 +16936,7 @@ no project is defined."
"Remove duplicate elements from IN-LIST."
(let (out-list)
(while in-list
- (pushnew (car in-list) out-list :test #'equal)
+ (vhdl--pushnew (car in-list) out-list :test #'equal)
(setq in-list (cdr in-list)))
out-list))
diff --git a/lisp/ses.el b/lisp/ses.el
index 7fdacc7..37d0d61 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -1509,8 +1509,9 @@ Newlines in the data are escaped."
,printer
,(ses-cell-references cell))))
(ses-goto-data row col)
- (delete-region (point) (line-end-position))
- (insert text)))
+ (let ((inhibit-quit t))
+ (delete-region (point) (line-end-position))
+ (insert text))))
(message " "))))
diff --git a/lisp/simple.el b/lisp/simple.el
index 75be4fe..08021ce 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -9063,6 +9063,32 @@ to capitalize ARG words."
(capitalize-region (region-beginning) (region-end))
(capitalize-word arg)))
+;;; Accessors for `decode-time' values.
+
+(cl-defstruct (decoded-time
+ (:constructor nil)
+ (:copier nil)
+ (:type list))
+ (second nil :documentation "\
+This is an integer between 0 and 60 (inclusive). (60 is a leap
+second, which only some operating systems support.)")
+ (minute nil :documentation "This is an integer between 0 and 59
(inclusive).")
+ (hour nil :documentation "This is an integer between 0 and 23 (inclusive).")
+ (day nil :documentation "This is an integer between 1 and 31 (inclusive).")
+ (month nil :documentation "\
+This is an integer between 1 and 12 (inclusive). January is 1.")
+ (year nil :documentation "This is a four digit integer.")
+ (weekday nil :documentation "\
+This is a number between 0 and 6, and 0 is Sunday.")
+ (dst nil :documentation "\
+This is t if daylight saving time is in effect, nil if it is not
+in effect, and -1 if daylight saving information is not
+available.")
+ (zone nil :documentation "\
+This is an integer indicating the UTC offset in seconds, i.e.,
+the number of seconds east of Greenwich.")
+ )
+
(provide 'simple)
diff --git a/lisp/term.el b/lisp/term.el
index b5f4c62..77fbb1d 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -33,6 +33,21 @@
;;; Commentary:
+;; This file defines a general command-interpreter-in-a-buffer package
+;; (term mode). The idea is that you can build specific process-in-a-buffer
+;; modes on top of term mode -- e.g., lisp, shell, scheme, T, soar, ....
+;; This way, all these specific packages share a common base functionality,
+;; and a common set of bindings, which makes them easier to use (and
+;; saves code, implementation time, etc., etc.).
+
+;; If, instead of `term', you call `ansi-term', you get multiple term
+;; buffers, after every new call ansi-term opens a new
+;; "*ansi-term*<xx>" window, where <xx> is, as usual, a number...
+
+;; For hints on converting existing process modes (e.g., tex-mode,
+;; background, dbx, gdb, kermit, prolog, telnet) to use term-mode
+;; instead of shell-mode, see the notes at the end of this file.
+
;; Speed considerations and a few caveats
;; --------------------------------------
;;
@@ -85,13 +100,6 @@
;; # By default nobody can't do anything
;; deny root *
;;
-;;
-;; ----------------------------------------
-;;
-;; If, instead of 'term', you call 'ansi-term', you get multiple term
-;; buffers, after every new call ansi-term opens a new *ansi-term*<xx> window,
-;; where <xx> is, as usual, a number...
-;;
;; ----------------------------------------
;;
;; With the term-buffer-maximum-size you can finally decide how many
@@ -111,38 +119,6 @@
;; - Add hooks to allow raw-mode keys to be configurable
;; - Which keys are better ? \eOA or \e[A ?
;;
-;;
-;; Changes:
-;;
-;; V4.0 January 1997
-;;
-;; - Huge reworking of the faces code: now we only have roughly 20-30
-;; faces for everything so we're even faster than the old md-term.el !
-;; - Finished removing all the J-Shell code.
-;;
-;; V3.0 January 1997
-;;
-;; - Now all the supportable ANSI commands work well.
-;; - Reworked a little the code: much less jsh-inspired stuff
-;;
-;; V2.3 November
-;;
-;; - Now all the faces are accessed through an array: much cleaner code.
-;;
-;; V2.2 November 4 1996
-;;
-;; - Implemented ANSI output colorization ( a bit rough but enough for
-;; color_ls )
-;;
-;; - Implemented a maximum limit for the scroll buffer (stolen from
-;; comint.el)
-;;
-;; v2.1 October 28 1996, first public release
-;;
-;; - Some new keybindings for term-char mode ( notably home/end/...)
-;; - Directory, hostname and username tracking via ange-ftp
-;; - Multi-term capability via the ansi-term call
-;;
;; ----------------------------------------------------------------
;; You should/could have something like this in your .emacs to take
;; full advantage of this package
@@ -156,7 +132,6 @@
;; (auto-fill-mode -1)
;; (setq tab-width 8 ))))
;;
-;;
;; ----------------------------------------
;;
;; If you want to use color ls the best setup is to have a different file
@@ -167,7 +142,6 @@
;;
;; ----------------------------------------
;;
-;;
;; # Configuration file for the color ls utility
;; # This file goes in the /etc directory, and must be world readable.
;; # You can copy this file to .dir_colors in your $HOME directory to
@@ -224,17 +198,23 @@
;; .xbm 01;35
;; .xpm 01;35
;;
-;;
;; ----------------------------------------
;;
-;; Notice: for directory/host/user tracking you need to have something
-;; like this in your shell startup script (this is for a POSIXish shell
-;; like Bash but should be quite easy to port to other shells).
+;; There are actually two methods for directory tracking, one
+;; implemented in `term-command-hook' which sets the directory
+;; according to an escape sequence of the form "\032/<directory>\n".
+;; Some shells like bash will already send this escape sequence when
+;; they detect they are running in Emacs. This can be configured or
+;; disabled on the Emacs side by setting `term-command-hook' to
+;; a different function.
;;
-;; For troubleshooting in Bash, you can check the definition of the
-;; custom functions with the "type" command. e.g. "type cd". If you
-;; do not see the expected definition from the config below, then the
-;; directory tracking will not work.
+;; The second method is in `term-handle-ansi-terminal-messages' which
+;; sets user, host, and directory according to escape sequences of the
+;; form "\033AnSiTc <directory>\n" (replace the "c" with "u" and "h"
+;; for user and host, respectively). If the user and host don't
+;; match, it will set directory to a remote one, so it is important to
+;; set user and host correctly first. See the example bash
+;; configuration below.
;;
;; ----------------------------------------
;;
@@ -258,31 +238,24 @@
;;
;; # The \033 stands for ESC.
;; # There is a space between "AnSiT?" and $whatever.
+;; printf '\033AnSiTh %s\n' "$HOSTNAME"
+;; printf '\033AnSiTu %s\n' "$USER"
+;; printf '\033AnSiTc %s\n' "$PWD"
;;
;; cd() { command cd "$@"; printf '\033AnSiTc %s\n' "$PWD"; }
;; pushd() { command pushd "$@"; printf '\033AnSiTc %s\n' "$PWD"; }
;; popd() { command popd "$@"; printf '\033AnSiTc %s\n' "$PWD"; }
;;
-;; printf '\033AnSiTc %s\n' "$PWD"
-;; printf '\033AnSiTh %s\n' "$HOSTNAME"
-;; printf '\033AnSiTu %s\n' "$USER"
-;;
;; # Use custom dircolors in term buffers.
;; # eval $(dircolors $HOME/.emacs_dircolors)
;; esac
;;
;; # ...
;;
-;;
-
-;;; Original Commentary:
-;; ---------------------
-
-;; The changelog is at the end of this file.
-
-;; Please send me bug reports, bug fixes, and extensions, so that I can
-;; merge them into the master source.
-;; - Per Bothner (address@hidden)
+;; For troubleshooting in Bash, you can check the definition of the
+;; custom functions with the "type" command. e.g. "type cd". If you
+;; do not see the expected definition from the config below, then the
+;; directory tracking will not work.
;; Brief Command Documentation:
@@ -290,21 +263,21 @@
;; Term Mode Commands: (common to all derived modes, like cmushell & cmulisp
;; mode)
;;
-;; m-p term-previous-input Cycle backwards in input history
-;; m-n term-next-input Cycle forwards
-;; m-r term-previous-matching-input Previous input matching a regexp
-;; m-s comint-next-matching-input Next input that matches
+;; M-p term-previous-input Cycle backwards in input history
+;; M-n term-next-input Cycle forwards
+;; M-r term-previous-matching-input Previous input matching a regexp
+;; M-s comint-next-matching-input Next input that matches
;; return term-send-input
-;; c-c c-a term-bol Beginning of line; skip prompt.
-;; c-d term-delchar-or-maybe-eof Delete char unless at end of buff.
-;; c-c c-u term-kill-input ^u
-;; c-c c-w backward-kill-word ^w
-;; c-c c-c term-interrupt-subjob ^c
-;; c-c c-z term-stop-subjob ^z
-;; c-c c-\ term-quit-subjob ^\
-;; c-c c-o term-kill-output Delete last batch of process output
-;; c-c c-r term-show-output Show last batch of process output
-;; c-c c-h term-dynamic-list-input-ring List input history
+;; C-c C-a term-bol Beginning of line; skip prompt.
+;; C-d term-delchar-or-maybe-eof Delete char unless at end of buff.
+;; C-c C-u term-kill-input ^u
+;; C-c C-w backward-kill-word ^w
+;; C-c C-c term-interrupt-subjob ^c
+;; C-c C-z term-stop-subjob ^z
+;; C-c C-\ term-quit-subjob ^\
+;; C-c C-o term-kill-output Delete last batch of process output
+;; C-c C-r term-show-output Show last batch of process output
+;; C-c C-h term-dynamic-list-input-ring List input history
;;
;; Not bound by default in term-mode
;; term-send-invisible Read a line w/o echo, and send to proc
@@ -314,8 +287,8 @@
;; term-replace-by-expanded-filename Expand and complete filename at point;
;; replace with expanded/completed name.
;; term-kill-subjob No mercy.
-;; term-show-maximum-output Show as much output as possible.
-;; term-continue-subjob Send CONT signal to buffer's process
+;; term-show-maximum-output Show as much output as possible.
+;; term-continue-subjob Send CONT signal to buffer's process
;; group. Useful if you accidentally
;; suspend your process (with C-c C-z).
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 0c7fb38..9dfa9f3 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -851,13 +851,11 @@ Internal use.")
;; Ensure aspell's alias dictionary will override standard
;; definitions.
(setq found (ispell-aspell-add-aliases found))
- ;; Merge into FOUND any elements from the standard
- ;; ispell-dictionary-base-alist which have no element in FOUND at
- ;; all.
- (unless found
- (dolist (dict ispell-dictionary-base-alist)
- (unless (assoc (car dict) found)
- (setq found (nconc found (list dict))))))
+ ;; Merge into FOUND any elements from the standard
ispell-dictionary-base-alist
+ ;; which have no element in FOUND at all.
+ (dolist (dict ispell-dictionary-base-alist)
+ (unless (assoc (car dict) found)
+ (setq found (nconc found (list dict)))))
(setq ispell-aspell-dictionary-alist found)
;; Add a default entry
(let ((default-dict
@@ -1297,7 +1295,8 @@ aspell is used along with Emacs).")
;; Substitute ispell-dictionary-alist with the list of
;; dictionaries corresponding to the given spellchecker.
;; With programs that support it, use the list of really
- ;; installed dictionaries. Allow distro info.
+ ;; installed dictionaries and add to it elements of the original
+ ;; list that are not present there. Allow distro info.
(let ((found-dicts-alist
(if ispell-encoding8-command
(if ispell-really-aspell
@@ -1364,9 +1363,7 @@ aspell is used along with Emacs).")
;; Add dicts to `ispell-dictionary-alist' unless already present.
(dolist (dict (append found-dicts-alist
ispell-base-dicts-override-alist
- (if found-dicts-alist
- nil
- ispell-dictionary-base-alist)))
+ ispell-dictionary-base-alist))
(unless (assoc (car dict) all-dicts-alist)
(push dict all-dicts-alist)))
(setq ispell-dictionary-alist all-dicts-alist))
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el
index a4cf0f0..3159b69 100644
--- a/lisp/url/url-dav.el
+++ b/lisp/url/url-dav.el
@@ -33,6 +33,7 @@
(require 'url-util)
(require 'url-handlers)
(require 'url-http)
+(require 'parse-time)
(defvar url-dav-supported-protocols '(1 2)
"List of supported DAV versions.")
@@ -83,72 +84,14 @@ Returns nil if WebDAV is not supported."
(defun url-dav-process-number-property (node)
(string-to-number (url-dav-node-text node)))
-(defconst url-dav-iso8601-regexp
- (let* ((dash "-?")
- (colon ":?")
- (4digit "\\([0-9][0-9][0-9][0-9]\\)")
- (2digit "\\([0-9][0-9]\\)")
- (date-fullyear 4digit)
- (date-month 2digit)
- (date-mday 2digit)
- (time-hour 2digit)
- (time-minute 2digit)
- (time-second 2digit)
- (time-secfrac "\\(\\.[0-9]+\\)?")
- (time-numoffset (concat "[-+]\\(" time-hour "\\):" time-minute))
- (time-offset (concat "Z" time-numoffset))
- (partial-time (concat time-hour colon time-minute colon time-second
- time-secfrac))
- (full-date (concat date-fullyear dash date-month dash date-mday))
- (full-time (concat partial-time time-offset))
- (date-time (concat full-date "T" full-time)))
- (list (concat "^" full-date)
- (concat "T" partial-time)
- (concat "Z" time-numoffset)))
- "List of regular expressions matching ISO 8601 dates.
-1st regular expression matches the date.
-2nd regular expression matches the time.
-3rd regular expression matches the (optional) timezone specification.")
-
(defun url-dav-process-date-property (node)
- (require 'parse-time)
- (let* ((date-re (nth 0 url-dav-iso8601-regexp))
- (time-re (nth 1 url-dav-iso8601-regexp))
- (tz-re (nth 2 url-dav-iso8601-regexp))
- (date-string (url-dav-node-text node))
- re-start
- time seconds minute hour fractional-seconds
- day month year day-of-week dst tz)
- ;; We need to populate 'time' with
- ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
-
- ;; Nobody else handles iso8601 correctly, let's do it ourselves.
- (when (string-match date-re date-string re-start)
- (setq year (string-to-number (match-string 1 date-string))
- month (string-to-number (match-string 2 date-string))
- day (string-to-number (match-string 3 date-string))
- re-start (match-end 0))
- (when (string-match time-re date-string re-start)
- (setq hour (string-to-number (match-string 1 date-string))
- minute (string-to-number (match-string 2 date-string))
- seconds (string-to-number (match-string 3 date-string))
- fractional-seconds (string-to-number (or
- (match-string 4
date-string)
- "0"))
- re-start (match-end 0))
- (when (string-match tz-re date-string re-start)
- (setq tz (match-string 1 date-string)))
- (url-debug 'dav "Parsed iso8601%s date" (if tz "tz" ""))
- (setq time (list seconds minute hour day month year day-of-week dst
tz))))
-
- ;; Fall back to having Gnus do fancy things for us.
- (when (not time)
- (setq time (parse-time-string date-string)))
-
+ (let* ((date-string (url-dav-node-text node))
+ (time (parse-iso8601-time-string date-string)))
(if time
(setq time (encode-time time))
(url-debug 'dav "Unable to decode date (%S) (%s)"
- (xml-node-name node) date-string))
+ (xml-node-name node)
+ date-string))
time))
(defun url-dav-process-boolean-property (node)
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index b666900..1bdaca2 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -1205,13 +1205,12 @@ behavior."
;; TIME is like the output of decode-time
(defun ediff-format-date (time)
(format "%s %2d %4d %s:%s:%s"
- (cdr (assoc (nth 4 time) ediff-months)) ; month
- (nth 3 time) ; day
- (nth 5 time) ; year
- (ediff-fill-leading-zero (nth 2 time)) ; hour
- (ediff-fill-leading-zero (nth 1 time)) ; min
- (ediff-fill-leading-zero (nth 0 time)) ; sec
- ))
+ (cdr (assoc (decoded-time-month time) ediff-months))
+ (decoded-time-day time)
+ (decoded-time-year time)
+ (ediff-fill-leading-zero (decoded-time-hour time))
+ (ediff-fill-leading-zero (decoded-time-minute time))
+ (ediff-fill-leading-zero (decoded-time-second time))))
;; Draw the directories
(defun ediff-insert-dirs-in-meta-buffer (meta-list)
diff --git a/lisp/view.el b/lisp/view.el
index e4489b3..deda061 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -383,8 +383,8 @@ own View-like bindings."
"Toggle View mode, a minor mode for viewing text but not editing it.
When View mode is enabled, commands that do not change the buffer
-contents are available as usual. Kill commands insert text in
-kill buffers but do not delete. Most other commands beep and
+contents are available as usual. Kill commands save text but
+do not delete it from the buffer. Most other commands beep and
tell the user that the buffer is read-only.
\\<view-mode-map>
diff --git a/lisp/window.el b/lisp/window.el
index 8597f87..8b12c43 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -8685,7 +8685,7 @@ and defaults to `window-min-width'. Both MAX-WIDTH and
MIN-WIDTH
are specified in columns and include fringes, margins, a
scrollbar and a vertical divider, if any.
-If the optional argument `preserve-size' is non-nil, preserve the
+Optional argument PRESERVE-SIZE non-nil means to preserve the
size of WINDOW (see `window-preserve-size').
Fit pixelwise if the option `window-resize-pixelwise' is non-nil.
diff --git a/src/casefiddle.c b/src/casefiddle.c
index 3f407ea..ee292dd 100644
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -529,7 +529,7 @@ See also `capitalize-region'. */)
if (!NILP (region_noncontiguous_p))
{
- bounds = call1 (Fsymbol_value (intern ("region-extract-function")),
+ bounds = call1 (Fsymbol_value (Qregion_extract_function),
intern ("bounds"));
while (CONSP (bounds))
diff --git a/src/eval.c b/src/eval.c
index b890aa6..2e50743 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -625,7 +625,7 @@ The return value is BASE-VARIABLE. */)
&& !EQ (find_symbol_value (new_alias),
find_symbol_value (base_variable)))
call2 (intern ("display-warning"),
- list3 (intern ("defvaralias"), intern ("losing-value"), new_alias),
+ list3 (Qdefvaralias, intern ("losing-value"), new_alias),
CALLN (Fformat_message,
build_string
("Overwriting value of `%s' by aliasing to `%s'"),
diff --git a/src/lread.c b/src/lread.c
index eecb5e1..eec8876 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -287,6 +287,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
if (EQ (readcharfun, Qget_file_char))
{
+ eassert (infile);
readbyte = readbyte_from_file;
goto read_multibyte;
}
@@ -320,6 +321,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
string, and the cdr part is a value of readcharfun given to
read_vector. */
readbyte = readbyte_from_string;
+ eassert (infile);
if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
emacs_mule_encoding = 1;
goto read_multibyte;
@@ -328,6 +330,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
if (EQ (readcharfun, Qget_emacs_mule_file_char))
{
readbyte = readbyte_from_file;
+ eassert (infile);
emacs_mule_encoding = 1;
goto read_multibyte;
}
@@ -506,6 +509,7 @@ readbyte_from_stdio (void)
static int
readbyte_from_file (int c, Lisp_Object readcharfun)
{
+ eassert (infile);
if (c >= 0)
{
eassert (infile->lookahead < sizeof infile->buf);
@@ -1078,10 +1082,10 @@ suffix_p (Lisp_Object string, const char *suffix)
static void
close_infile_unwind (void *arg)
{
- FILE *stream = arg;
- eassert (infile == NULL || infile->stream == stream);
- infile = NULL;
- fclose (stream);
+ struct infile *prev_infile = arg;
+ eassert (infile && infile != prev_infile);
+ fclose (infile->stream);
+ infile = prev_infile;
}
DEFUN ("load", Fload, Sload, 1, 5, 0,
@@ -1399,6 +1403,10 @@ Return t if the file exists and loads successfully. */)
#endif
}
+ /* Declare here rather than inside the else-part because the storage
+ might be accessed by the unbind_to call below. */
+ struct infile input;
+
if (is_module)
{
/* `module-load' uses the file name, so we can close the stream
@@ -1413,7 +1421,10 @@ Return t if the file exists and loads successfully. */)
{
if (! stream)
report_file_error ("Opening stdio stream", file);
- set_unwind_protect_ptr (fd_index, close_infile_unwind, stream);
+ set_unwind_protect_ptr (fd_index, close_infile_unwind, infile);
+ input.stream = stream;
+ input.lookahead = 0;
+ infile = &input;
}
if (! NILP (Vpurify_flag))
@@ -1439,10 +1450,6 @@ Return t if the file exists and loads successfully. */)
specbind (Qinhibit_file_name_operation, Qnil);
specbind (Qload_in_progress, Qt);
- /* Declare here rather than inside the else-part because the storage
- might be accessed by the unbind_to call below. */
- struct infile input;
-
if (is_module)
{
#ifdef HAVE_MODULES
@@ -1457,10 +1464,6 @@ Return t if the file exists and loads successfully. */)
}
else
{
- input.stream = stream;
- input.lookahead = 0;
- infile = &input;
-
if (lisp_file_lexically_bound_p (Qget_file_char))
Fset (Qlexical_binding, Qt);
@@ -2019,7 +2022,7 @@ readevalloop (Lisp_Object readcharfun,
if (b && first_sexp)
whole_buffer = (BUF_PT (b) == BUF_BEG (b) && BUF_ZV (b) == BUF_Z (b));
- infile = infile0;
+ eassert (!infile0 || infile == infile0);
read_next:
c = READCHAR;
if (c == ';')
diff --git a/src/process.c b/src/process.c
index abadabe..066edbc 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1279,10 +1279,19 @@ The string argument is normally a multibyte string,
except:
if (NILP (filter))
filter = Qinternal_default_process_filter;
- pset_filter (p, filter);
-
if (p->infd >= 0)
- set_process_filter_masks (p);
+ {
+ /* If filter WILL be t, stop reading output. */
+ if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
+ delete_read_fd (p->infd);
+ else if (/* If filter WAS t, then resume reading output. */
+ EQ (p->filter, Qt)
+ /* Network or serial process not stopped: */
+ && !EQ (p->command, Qt))
+ add_process_read_fd (p->infd);
+ }
+
+ pset_filter (p, filter);
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
diff --git a/src/timefns.c b/src/timefns.c
index 3b7ed46..cce9dd5 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -1326,6 +1326,12 @@ the TZ environment variable. It can also be a list (as
from
`current-time-zone') or an integer (the UTC offset in seconds) applied
without consideration for daylight saving time.
+To access (or alter) the elements in the time value, the
+`decoded-time-second', `decoded-time-minute', `decoded-time-hour',
+`decoded-time-day', `decoded-time-month', `decoded-time-year',
+`decoded-time-weekday', `decoded-time-dst' and `decoded-time-zone'
+accessors can be used.
+
The list has the following nine members: SEC is an integer between 0
and 60; SEC is 60 for a leap second, which only some operating systems
support. MINUTE is an integer between 0 and 59. HOUR is an integer
diff --git a/test/lisp/calendar/icalendar-tests.el
b/test/lisp/calendar/icalendar-tests.el
index af617e6..baea480 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -2325,5 +2325,31 @@ END:VCALENDAR
)
)
+(defun icalendar-test--format (string &optional day zone)
+ (let ((time (icalendar--decode-isodatetime string day zone)))
+ (format-time-string "%FT%T%z" (encode-time time) 0)))
+
+(defun icalendar-tests--decode-isodatetime (ical-string)
+ (should (equal (icalendar-test--format "20040917T050910-0200")
+ "2004-09-17T03:09:10+0000"))
+ (should (equal (icalendar-test--format "20040917T050910")
+ "2004-09-17T03:09:10+0000"))
+ (should (equal (icalendar-test--format "20040917T050910Z")
+ "2004-09-17T05:09:10+0000"))
+ (should (equal (icalendar-test--format "20040917T0509")
+ "2004-09-17T03:09:00+0000"))
+ (should (equal (icalendar-test--format "20040917")
+ "2004-09-16T22:00:00+0000"))
+ (should (equal (icalendar-test--format "20040917T050910" 1)
+ "2004-09-18T03:09:10+0000"))
+ (should (equal (icalendar-test--format "20040917T050910" 30)
+ "2004-10-17T03:09:10+0000"))
+ (should (equal (icalendar-test--format "20040917T050910" -1)
+ "2004-09-16T03:09:10+0000"))
+
+ (should (equal (icalendar-test--format "20040917T050910" nil -3600)
+ "2004-09-17T06:09:10+0000")))
+
+
(provide 'icalendar-tests)
;;; icalendar-tests.el ends here
diff --git a/test/lisp/calendar/iso8601-tests.el
b/test/lisp/calendar/iso8601-tests.el
new file mode 100644
index 0000000..2959f54
--- /dev/null
+++ b/test/lisp/calendar/iso8601-tests.el
@@ -0,0 +1,291 @@
+;;; iso8601-tests.el --- tests for calendar/iso8601.el -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'iso8601)
+
+(ert-deftest test-iso8601-date-years ()
+ (should (equal (iso8601-parse-date "1985")
+ '(nil nil nil nil nil 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "-0003")
+ '(nil nil nil nil nil -4 nil nil nil)))
+ (should (equal (iso8601-parse-date "+1985")
+ '(nil nil nil nil nil 1985 nil nil nil))))
+
+(ert-deftest test-iso8601-date-dates ()
+ (should (equal (iso8601-parse-date "1985-03-14")
+ '(nil nil nil 14 3 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "19850314")
+ '(nil nil nil 14 3 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "1985-02")
+ '(nil nil nil nil 2 1985 nil nil nil))))
+
+(ert-deftest test-iso8601-date-obsolete ()
+ (should (equal (iso8601-parse-date "--02-01")
+ '(nil nil nil 1 2 nil nil nil nil)))
+ (should (equal (iso8601-parse-date "--0201")
+ '(nil nil nil 1 2 nil nil nil nil))))
+
+(ert-deftest test-iso8601-date-weeks ()
+ (should (equal (iso8601-parse-date "2008W39-6")
+ '(nil nil nil 27 9 2008 nil nil nil)))
+ (should (equal (iso8601-parse-date "2009W01-1")
+ '(nil nil nil 29 12 2008 nil nil nil)))
+ (should (equal (iso8601-parse-date "2009W53-7")
+ '(nil nil nil 3 1 2010 nil nil nil))))
+
+(ert-deftest test-iso8601-date-ordinals ()
+ (should (equal (iso8601-parse-date "1981-095")
+ '(nil nil nil 5 4 1981 nil nil nil))))
+
+(ert-deftest test-iso8601-time ()
+ (should (equal (iso8601-parse-time "13:47:30")
+ '(30 47 13 nil nil nil nil nil nil)))
+ (should (equal (iso8601-parse-time "134730")
+ '(30 47 13 nil nil nil nil nil nil)))
+ (should (equal (iso8601-parse-time "1347")
+ '(0 47 13 nil nil nil nil nil nil))))
+
+(ert-deftest test-iso8601-combined ()
+ (should (equal (iso8601-parse "2008-03-02T13:47:30")
+ '(30 47 13 2 3 2008 nil nil nil)))
+ (should (equal (iso8601-parse "2008-03-02T13:47:30Z")
+ '(30 47 13 2 3 2008 nil nil 0)))
+ (should (equal (iso8601-parse "2008-03-02T13:47:30+01:00")
+ '(30 47 13 2 3 2008 nil nil 3600)))
+ (should (equal (iso8601-parse "2008-03-02T13:47:30-01")
+ '(30 47 13 2 3 2008 nil nil -3600))))
+
+(ert-deftest test-iso8601-duration ()
+ (should (equal (iso8601-parse-duration "P3Y6M4DT12H30M5S")
+ '(5 30 12 4 6 3 nil nil nil)))
+ (should (equal (iso8601-parse-duration "P1M")
+ '(0 0 0 0 1 0 nil nil nil)))
+ (should (equal (iso8601-parse-duration "PT1M")
+ '(0 1 0 0 0 0 nil nil nil)))
+ (should (equal (iso8601-parse-duration "P0003-06-04T12:30:05")
+ '(5 30 12 4 6 3 nil nil nil))))
+
+(ert-deftest test-iso8601-invalid ()
+ (should-not (iso8601-valid-p " 2008-03-02T13:47:30-01"))
+ (should-not (iso8601-valid-p "2008-03-02T13:47:30-01:200"))
+ (should-not (iso8601-valid-p "2008-03-02T13:47:30-01 "))
+ (should-not (iso8601-valid-p "2008-03-02 T 13:47:30-01 "))
+ (should-not (iso8601-valid-p "20008-03-02T13:47:30-01")))
+
+(ert-deftest test-iso8601-intervals ()
+ (should (equal
+ (iso8601-parse-interval "2007-03-01T13:00:00Z/2008-05-11T15:30:00Z")
+ '((0 0 13 1 3 2007 nil nil 0)
+ (0 30 15 11 5 2008 nil nil 0)
+ ;; Hm... can't really use decode-time for time differences...
+ (0 30 2 14 3 1971 0 nil 0))))
+ (should (equal (iso8601-parse-interval "2007-03-01T13:00:00Z/P1Y2M10DT2H30M")
+ '((0 0 13 1 3 2007 nil nil 0)
+ (0 30 15 11 5 2008 nil nil 0)
+ (0 30 2 10 2 1 nil nil nil))))
+ (should (equal (iso8601-parse-interval "P1Y2M10DT2H30M/2008-05-11T15:30:00Z")
+ '((0 0 13 1 3 2007 nil nil 0)
+ (0 30 15 11 5 2008 nil nil 0)
+ (0 30 2 10 2 1 nil nil nil)))))
+
+(ert-deftest standard-test-dates ()
+ (should (equal (iso8601-parse-date "19850412")
+ '(nil nil nil 12 4 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "1985-04-12")
+ '(nil nil nil 12 4 1985 nil nil nil)))
+
+ (should (equal (iso8601-parse-date "1985102")
+ '(nil nil nil 12 4 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "1985-102")
+ '(nil nil nil 12 4 1985 nil nil nil)))
+
+ (should (equal (iso8601-parse-date "1985W155")
+ '(nil nil nil 12 4 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "1985-W15-5")
+ '(nil nil nil 12 4 1985 nil nil nil)))
+
+ (should (equal (iso8601-parse-date "1985W15")
+ '(nil nil nil 7 4 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "1985-W15")
+ '(nil nil nil 7 4 1985 nil nil nil)))
+
+ (should (equal (iso8601-parse-date "1985-04")
+ '(nil nil nil nil 4 1985 nil nil nil)))
+
+ (should (equal (iso8601-parse-date "1985")
+ '(nil nil nil nil nil 1985 nil nil nil)))
+
+ (should (equal (iso8601-parse-date "+1985-04-12")
+ '(nil nil nil 12 4 1985 nil nil nil)))
+ (should (equal (iso8601-parse-date "+19850412")
+ '(nil nil nil 12 4 1985 nil nil nil))))
+
+(ert-deftest standard-test-time-of-day-local-time ()
+ (should (equal (iso8601-parse-time "152746")
+ '(46 27 15 nil nil nil nil nil nil)))
+ (should (equal (iso8601-parse-time "15:27:46")
+ '(46 27 15 nil nil nil nil nil nil)))
+
+ (should (equal (iso8601-parse-time "1528")
+ '(0 28 15 nil nil nil nil nil nil)))
+ (should (equal (iso8601-parse-time "15:28")
+ '(0 28 15 nil nil nil nil nil nil)))
+
+ (should (equal (iso8601-parse-time "15")
+ '(0 0 15 nil nil nil nil nil nil))))
+
+(ert-deftest standard-test-time-of-day-fractions ()
+ ;; decoded-time doesn't support sub-second times.
+ ;; (should (equal (iso8601-parse-time "152735,5")
+ ;; '(46 27 15 nil nil nil nil nil nil)))
+ ;; (should (equal (iso8601-parse-time "15:27:35,5")
+ ;; '(46 27 15 nil nil nil nil nil nil)))
+ )
+
+(ert-deftest standard-test-time-of-day-beginning-of-day ()
+ (should (equal (iso8601-parse-time "000000")
+ '(0 0 0 nil nil nil nil nil nil)))
+ (should (equal (iso8601-parse-time "00:00:00")
+ '(0 0 0 nil nil nil nil nil nil)))
+
+ (should (equal (iso8601-parse-time "0000")
+ '(0 0 0 nil nil nil nil nil nil)))
+ (should (equal (iso8601-parse-time "00:00")
+ '(0 0 0 nil nil nil nil nil nil))))
+
+(ert-deftest standard-test-time-of-day-utc ()
+ (should (equal (iso8601-parse-time "232030Z")
+ '(30 20 23 nil nil nil nil nil 0)))
+ (should (equal (iso8601-parse-time "23:20:30Z")
+ '(30 20 23 nil nil nil nil nil 0)))
+
+ (should (equal (iso8601-parse-time "2320Z")
+ '(0 20 23 nil nil nil nil nil 0)))
+ (should (equal (iso8601-parse-time "23:20Z")
+ '(0 20 23 nil nil nil nil nil 0)))
+
+ (should (equal (iso8601-parse-time "23Z")
+ '(0 0 23 nil nil nil nil nil 0))))
+
+
+(ert-deftest standard-test-time-of-day-zone ()
+ (should (equal (iso8601-parse-time "152746+0100")
+ '(46 27 15 nil nil nil nil nil 3600)))
+ (should (equal (iso8601-parse-time "15:27:46+0100")
+ '(46 27 15 nil nil nil nil nil 3600)))
+
+ (should (equal (iso8601-parse-time "152746+01")
+ '(46 27 15 nil nil nil nil nil 3600)))
+ (should (equal (iso8601-parse-time "15:27:46+01")
+ '(46 27 15 nil nil nil nil nil 3600)))
+
+ (should (equal (iso8601-parse-time "152746-0500")
+ '(46 27 15 nil nil nil nil nil -18000)))
+ (should (equal (iso8601-parse-time "15:27:46-0500")
+ '(46 27 15 nil nil nil nil nil -18000)))
+
+ (should (equal (iso8601-parse-time "152746-05")
+ '(46 27 15 nil nil nil nil nil -18000)))
+ (should (equal (iso8601-parse-time "15:27:46-05")
+ '(46 27 15 nil nil nil nil nil -18000))))
+
+(ert-deftest standard-test-date-and-time-of-day ()
+ (should (equal (iso8601-parse "19850412T101530")
+ '(30 15 10 12 4 1985 nil nil nil)))
+ (should (equal (iso8601-parse "1985-04-12T10:15:30")
+ '(30 15 10 12 4 1985 nil nil nil)))
+
+ (should (equal (iso8601-parse "1985102T235030Z")
+ '(30 50 23 12 4 1985 nil nil 0)))
+ (should (equal (iso8601-parse "1985-102T23:50:30Z")
+ '(30 50 23 12 4 1985 nil nil 0)))
+
+ (should (equal (iso8601-parse "1985W155T235030")
+ '(30 50 23 12 4 1985 nil nil nil)))
+ (should (equal (iso8601-parse "1985-W155T23:50:30")
+ '(30 50 23 12 4 1985 nil nil nil))))
+
+(ert-deftest standard-test-interval ()
+ ;; A time interval starting at 20 minutes and 50 seconds past 23
+ ;; hours on 12 April 1985 and ending at 30 minutes past 10 hours on
+ ;; 25 June 1985.
+ (should (equal (iso8601-parse-interval "19850412T232050/19850625T103000")
+ '((50 20 23 12 4 1985 nil nil nil)
+ (0 30 10 25 6 1985 nil nil nil)
+ (10 9 11 15 3 1970 0 nil 0))))
+ (should (equal (iso8601-parse-interval
+ "1985-04-12T23:20:50/1985-06-25T10:30:00")
+ '((50 20 23 12 4 1985 nil nil nil)
+ (0 30 10 25 6 1985 nil nil nil)
+ (10 9 11 15 3 1970 0 nil 0))))
+
+ ;; A time interval starting at 12 April 1985 and ending on 25 June
+ ;; 1985.
+
+ ;; This example doesn't seem valid according to the standard.
+ ;; "0625" is unambiguous, and means "the year 625". Weird.
+ ;; (should (equal (iso8601-parse-interval "19850412/0625")
+ ;; '((nil nil nil 12 4 1985 nil nil nil)
+ ;; (nil nil nil nil nil 625 nil nil nil)
+ ;; (0 17 0 22 9 609 5 nil 0))))
+
+ ;; A time interval of 2 years, 10 months, 15 days, 10 hours, 20
+ ;; minutes and 30 seconds.
+ (should (equal (iso8601-parse-duration "P2Y10M15DT10H20M30S")
+ '(30 20 10 15 10 2 nil nil nil)))
+
+ (should (equal (iso8601-parse-duration "P00021015T102030")
+ '(30 20 10 15 10 2 nil nil nil)))
+ (should (equal (iso8601-parse-duration "P0002-10-15T10:20:30")
+ '(30 20 10 15 10 2 nil nil nil)))
+
+ ;; A time interval of 1 year and 6 months.
+ (should (equal (iso8601-parse-duration "P1Y6M")
+ '(0 0 0 0 6 1 nil nil nil)))
+ (should (equal (iso8601-parse-duration "P0001-06")
+ '(nil nil nil nil 6 1 nil nil nil)))
+
+ ;; A time interval of seventy-two hours.
+ (should (equal (iso8601-parse-duration "PT72H")
+ '(0 0 72 0 0 0 nil nil nil)))
+
+ ;; Defined by start and duration
+ ;; A time interval of 1 year, 2 months, 15 days and 12 hours,
+ ;; beginning on 12 April 1985 at 20 minutes past 23 hours.
+ (should (equal (iso8601-parse-interval "19850412T232000/P1Y2M15DT12H")
+ '((0 20 23 12 4 1985 nil nil nil)
+ (0 20 11 28 6 1986 nil nil nil)
+ (0 0 12 15 2 1 nil nil nil))))
+ (should (equal (iso8601-parse-interval "1985-04-12T23:20:00/P1Y2M15DT12H")
+ '((0 20 23 12 4 1985 nil nil nil)
+ (0 20 11 28 6 1986 nil nil nil)
+ (0 0 12 15 2 1 nil nil nil))))
+
+ ;; Defined by duration and end
+ ;; A time interval of 1 year, 2 months, 15 days and 12 hours, ending
+ ;; on 12 April 1985 at 20 minutes past 23 hour.
+ (should (equal (iso8601-parse-interval "P1Y2M15DT12H/19850412T232000")
+ '((0 20 11 28 1 1984 nil nil nil)
+ (0 20 23 12 4 1985 nil nil nil)
+ (0 0 12 15 2 1 nil nil nil)))))
+
+;;; iso8601-tests.el ends here
diff --git a/test/lisp/calendar/time-date-tests.el
b/test/lisp/calendar/time-date-tests.el
new file mode 100644
index 0000000..51250ce
--- /dev/null
+++ b/test/lisp/calendar/time-date-tests.el
@@ -0,0 +1,115 @@
+;;; time-date-tests.el --- tests for calendar/time-date.el -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'time-date)
+
+(ert-deftest test-leap-year ()
+ (should-not (date-leap-year-p 1999))
+ (should-not (date-leap-year-p 1900))
+ (should (date-leap-year-p 2000))
+ (should (date-leap-year-p 2004)))
+
+(ert-deftest test-days-in-month ()
+ (should (= (date-days-in-month 2004 2) 29))
+ (should (= (date-days-in-month 2004 3) 31))
+ (should-not (= (date-days-in-month 1900 3) 28)))
+
+(ert-deftest test-ordinal ()
+ (should (equal (date-ordinal-to-time 2008 271)
+ '(nil nil nil 27 9 2008 nil nil nil)))
+ (should (equal (date-ordinal-to-time 2008 1)
+ '(nil nil nil 1 1 2008 nil nil nil)))
+ (should (equal (date-ordinal-to-time 2008 32)
+ '(nil nil nil 1 2 2008 nil nil nil)))
+ (should (equal (date-ordinal-to-time 1981 095)
+ '(nil nil nil 5 4 1981 nil nil nil))))
+
+(cl-defmethod mdec (&key second minute hour
+ day month year
+ dst zone)
+ (list second minute hour day month year nil dst zone))
+
+(ert-deftest test-decoded-add ()
+ (let ((time '(12 15 16 8 7 2019 1 t 7200)))
+ (should (equal (decoded-time-add time (mdec :year 1))
+ '(12 15 16 8 7 2020 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :year -2))
+ '(12 15 16 8 7 2017 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :month 1))
+ '(12 15 16 8 8 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :month 10))
+ '(12 15 16 8 5 2020 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :day 1))
+ '(12 15 16 9 7 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :day -1))
+ '(12 15 16 7 7 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :day 30))
+ '(12 15 16 7 8 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :day -365))
+ '(12 15 16 8 7 2018 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :day 365))
+ '(12 15 16 7 7 2020 1 t 7200)))
+
+ ;; 2020 is a leap year.
+ (should (equal (decoded-time-add time (mdec :day 366))
+ '(12 15 16 8 7 2020 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :second 1))
+ '(13 15 16 8 7 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :second -1))
+ '(11 15 16 8 7 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :second 61))
+ '(13 16 16 8 7 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :hour 1 :minute 2 :second 3))
+ '(15 17 17 8 7 2019 1 t 7200)))
+
+ (should (equal (decoded-time-add time (mdec :hour 24))
+ '(12 15 16 9 7 2019 1 t 7200)))
+ ))
+
+(ert-deftest test-decoded-add-zone ()
+ (let ((time '(12 15 16 8 7 2019 1 t 7200)))
+ (should (equal (decoded-time-add time (mdec :zone -3600))
+ '(12 15 15 8 7 2019 1 t 7200)))
+ (should (equal (decoded-time-add time (mdec :zone -7200))
+ '(12 15 14 8 7 2019 1 t 7200)))))
+
+(ert-deftest test-time-zone-format ()
+ (should (equal (time-zone-format 3600)
+ "+01:00"))
+ (should (equal (time-zone-format -7200)
+ "-02:00")))
+
+(require 'ert)
+
+;;; time-date-tests.el ends here
diff --git a/test/lisp/char-fold-tests.el b/test/lisp/char-fold-tests.el
index e519435..241f7bf 100644
--- a/test/lisp/char-fold-tests.el
+++ b/test/lisp/char-fold-tests.el
@@ -150,57 +150,69 @@
(ert-deftest char-fold--test-without-customization ()
(let* ((matches
'(
+ ("'" "’")
("e" "ℯ" "ḗ" "ë" "ë")
("ι"
"ί" ;; 1 level decomposition
"ί" ;; 2 level decomposition
- ;; FIXME:
- ;; "ΐ" ;; 3 level decomposition
- )
- )))
- (dolist (strings matches)
- (apply 'char-fold--test-match-exactly strings))))
-
-(ert-deftest char-fold--test-with-customization ()
- :tags '(:expensive-test)
- (let* ((char-fold-include
- '(
- (?ß "ss") ;; de
- (?o "ø") ;; da no nb nn
- (?l "ł") ;; pl
- ))
- ;; FIXME: move language-specific settings to defaults
- (char-fold-exclude
- '(
- (?a "å") ;; sv da no nb nn
- (?a "ä") ;; sv fi et
- (?o "ö") ;; sv fi et
- (?n "ñ") ;; es
- (?и "й") ;; ru
- ))
- (char-fold-symmetric t)
- (char-fold-table (char-fold-make-table))
- (matches
- '(
- ("e" "ℯ" "ḗ" "ë" "ë")
- ("е" "ё" "ё")
- ("ι" "ί" "ί"
- ;; FIXME: "ΐ"
+ "ΐ" ;; 3 level decomposition
)
("ß" "ss")
- ("o" "ø")
- ("l" "ł")
-
))
(no-matches
'(
- ("a" "å")
- ("a" "ä")
- ("o" "ö")
- ("n" "ñ")
("и" "й")
)))
(dolist (strings matches)
+ (apply 'char-fold--test-match-exactly strings))
+ (dolist (strings no-matches)
+ (apply 'char-fold--test-no-match-exactly strings))))
+
+(ert-deftest char-fold--test-with-customization ()
+ :tags '(:expensive-test)
+ ;; FIXME: move some language-specific settings to defaults
+ (let ((char-fold-include
+ (append char-fold-include
+ '(
+ (?o "ø") ;; da no nb nn
+ (?l "ł") ;; pl
+ (?æ "ae")
+ (?→ "->")
+ (?⇒ "=>")
+ )))
+ (char-fold-exclude
+ (append char-fold-exclude
+ '(
+ (?a "å") ;; da no nb nn sv
+ (?a "ä") ;; et fi sv
+ (?o "ö") ;; et fi sv
+ (?n "ñ") ;; es
+ )))
+ (char-fold-symmetric t)
+ (matches
+ '(
+ ("e" "ℯ" "ḗ" "ë" "ë")
+ ("е" "ё" "ё")
+ ("ι" "ί" "ί" "ΐ")
+ ("ß" "ss")
+ ("o" "ø")
+ ("l" "ł")
+ ("æ" "ae")
+ ("→" "->")
+ ("⇒" "=>")
+ ))
+ (no-matches
+ '(
+ ("a" "å")
+ ("a" "ä")
+ ("o" "ö")
+ ("n" "ñ")
+ ("и" "й")
+ ))
+ ;; Don't override global value by char-fold-update-table below
+ char-fold-table)
+ (char-fold-update-table)
+ (dolist (strings matches)
(dolist (permutation (char-fold--permutation strings))
(apply 'char-fold--test-match-exactly permutation)))
(dolist (strings no-matches)
diff --git a/test/lisp/emacs-lisp/let-alist-tests.el
b/test/lisp/emacs-lisp/let-alist-tests.el
index 31db4a9..9c3f2a5 100644
--- a/test/lisp/emacs-lisp/let-alist-tests.el
+++ b/test/lisp/emacs-lisp/let-alist-tests.el
@@ -95,4 +95,9 @@ See Bug#24641."
(should (equal (let-alist--deep-dot-search '(foo .bar (let-alist .qux .baz)))
'((.bar . bar) (.qux . qux))))) ; no .baz
+(ert-deftest let-alist--vectors ()
+ (should (equal (let-alist '((a . 1) (b . 2))
+ `[,(+ .a) ,(+ .a .b .b)])
+ [1 5])))
+
;;; let-alist.el ends here
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 7c8c195..3d2f6e6 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -123,7 +123,7 @@ There are different timeouts for local and remote file
notification libraries."
((eq system-type 'cygwin) 6)
(t 3)))
-(defmacro file-notify--wait-for-events (timeout until)
+(defmacro file-notify--test-wait-for-events (timeout until)
"Wait for and return file notification events until form UNTIL is true.
TIMEOUT is the maximum time to wait for, in seconds."
`(with-timeout (,timeout (ignore))
@@ -134,7 +134,7 @@ TIMEOUT is the maximum time to wait for, in seconds."
"Check that `file-notify-descriptors' is an empty hash table.
Return nil when any other file notification watch is still active."
;; Give read events a last chance.
- (file-notify--wait-for-events
+ (file-notify--test-wait-for-events
(file-notify--test-timeout)
(zerop (hash-table-count file-notify-descriptors)))
;; Now check.
@@ -193,6 +193,8 @@ Return nil when any other file notification watch is still
active."
file-notify--test-desc1 nil
file-notify--test-desc2 nil
file-notify--test-results nil
+ file-notify--test-event nil
+ file-notify--test-file nil
file-notify--test-events nil
file-notify--test-monitors nil))
@@ -459,9 +461,11 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(unless (eq system-type 'cygwin)
(let (results)
(cl-flet ((first-callback (event)
- (when (eq (nth 1 event) 'deleted) (push 1 results)))
+ (when (eq (file-notify--test-event-action event) 'deleted)
+ (push 1 results)))
(second-callback (event)
- (when (eq (nth 1 event) 'deleted) (push 2 results))))
+ (when (eq (file-notify--test-event-action event) 'deleted)
+ (push 2 results))))
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
@@ -480,7 +484,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; Only the second callback shall run.
(file-notify--test-read-event)
(delete-file file-notify--test-tmpfile)
- (file-notify--wait-for-events
+ (file-notify--test-wait-for-events
(file-notify--test-timeout) results)
(should (equal results (list 2)))
@@ -494,6 +498,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
"Check `file-notify-rm-watch' for remote files.")
;; Accessors for the callback argument.
+(defun file-notify--test-event-desc (event) (car event))
+(defun file-notify--test-event-action (event) (nth 1 event))
(defun file-notify--test-event-file (event) (nth 2 event))
(defun file-notify--test-event-file1 (event) (nth 3 event))
@@ -502,14 +508,15 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
We cannot pass arguments, so we assume that `file-notify--test-event'
and `file-notify--test-file' are bound somewhere."
;; Check the descriptor.
- (should (equal (car file-notify--test-event) file-notify--test-desc))
+ (should (equal (file-notify--test-event-desc file-notify--test-event)
+ file-notify--test-desc))
;; Check the file name.
(should
(string-prefix-p
file-notify--test-file
(file-notify--test-event-file file-notify--test-event)))
;; Check the second file name if exists.
- (when (eq (nth 1 file-notify--test-event) 'renamed)
+ (when (eq (file-notify--test-event-action file-notify--test-event) 'renamed)
(should
(string-prefix-p
file-notify--test-file
@@ -535,68 +542,72 @@ and the event to `file-notify--test-events'."
file-notify--test-results
(append file-notify--test-results `(,result))))))
-(defun file-notify--test-with-events-check (events)
- "Check whether received events match one of the EVENTS alternatives."
+(defun file-notify--test-with-actions-check (actions)
+ "Check whether received actions match one of the ACTIONS alternatives."
(let (result)
- (dolist (elt events result)
+ (dolist (elt actions result)
(setq result
(or result
(if (eq (car elt) :random)
(equal (sort (cdr elt) 'string-lessp)
- (sort (mapcar #'cadr file-notify--test-events)
+ (sort (mapcar #'file-notify--test-event-action
+ file-notify--test-events)
'string-lessp))
- (equal elt (mapcar #'cadr file-notify--test-events))))))))
-
-(defun file-notify--test-with-events-explainer (events)
- "Explain why `file-notify--test-with-events-check' fails."
- (if (null (cdr events))
- (format "Received events do not match expected events\n%s\n%s"
- (mapcar #'cadr file-notify--test-events) (car events))
+ (equal elt (mapcar #'file-notify--test-event-action
+ file-notify--test-events))))))))
+
+(defun file-notify--test-with-actions-explainer (actions)
+ "Explain why `file-notify--test-with-actions-check' fails."
+ (if (null (cdr actions))
+ (format "Received actions do not match expected actions\n%s\n%s"
+ (mapcar #'file-notify--test-event-action
file-notify--test-events)
+ (car actions))
(format
- "Received events do not match any sequence of expected events\n%s\n%s"
- (mapcar #'cadr file-notify--test-events) events)))
+ "Received actions do not match any sequence of expected actions\n%s\n%s"
+ (mapcar #'file-notify--test-event-action file-notify--test-events)
+ actions)))
-(put 'file-notify--test-with-events-check 'ert-explainer
- 'file-notify--test-with-events-explainer)
+(put 'file-notify--test-with-actions-check 'ert-explainer
+ 'file-notify--test-with-actions-explainer)
-(defmacro file-notify--test-with-events (events &rest body)
- "Run BODY collecting events and then compare with EVENTS.
-EVENTS is either a simple list of events, or a list of lists of
-events, which represent different possible results. The first
+(defmacro file-notify--test-with-actions (actions &rest body)
+ "Run BODY collecting actions and then compare with ACTIONS.
+ACTIONS is either a simple list of actions, or a list of lists of
+actions, which represent different possible results. The first
event of a list could be the pseudo event `:random', which is
just an indicator for comparison.
-Don't wait longer than timeout seconds for the events to be
+Don't wait longer than timeout seconds for the actions to be
delivered."
- (declare (indent 1))
- `(let* ((events (if (consp (car ,events)) ,events (list ,events)))
+ (declare (indent 1) (debug (form body)))
+ `(let* ((actions (if (consp (car ,actions)) ,actions (list ,actions)))
(max-length
(apply
'max
(mapcar
(lambda (x) (length (if (eq (car x) :random) (cdr x) x)))
- events)))
+ actions)))
create-lockfiles)
- ;; Flush pending events.
+ ;; Flush pending actions.
(file-notify--test-read-event)
- (file-notify--wait-for-events
+ (file-notify--test-wait-for-events
(file-notify--test-timeout)
(not (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.
+ (file-notify--test-wait-for-events
+ ;; More actions 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
+ ;; Check the result sequence just to make sure that all actions
;; 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))))
+ (should (file-notify--test-with-actions-check actions))))
(ert-deftest file-notify-test03-events ()
"Check file creation/change/removal notifications."
@@ -613,7 +624,7 @@ delivered."
(file-notify--test-add-watch
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
- (file-notify--test-with-events
+ (file-notify--test-with-actions
(cond
;; gvfs-monitor-dir on cygwin does not detect the
;; `created' event reliably.
@@ -647,7 +658,7 @@ delivered."
(file-notify--test-add-watch
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
- (file-notify--test-with-events
+ (file-notify--test-with-actions
(cond
;; gvfs-monitor-dir on cygwin does not detect the
;; `changed' event reliably.
@@ -681,7 +692,7 @@ delivered."
(file-notify--test-add-watch
file-notify--test-tmpdir
'(change) #'file-notify--test-event-handler)))
- (file-notify--test-with-events
+ (file-notify--test-with-actions
(cond
;; w32notify does not raise `deleted' and `stopped'
;; events for the watched directory.
@@ -728,7 +739,7 @@ delivered."
(file-notify--test-add-watch
file-notify--test-tmpdir
'(change) #'file-notify--test-event-handler)))
- (file-notify--test-with-events
+ (file-notify--test-with-actions
(cond
;; w32notify does not distinguish between `changed' and
;; `attribute-changed'. It does not raise `deleted' and
@@ -785,7 +796,7 @@ delivered."
(file-notify--test-add-watch
file-notify--test-tmpdir
'(change) #'file-notify--test-event-handler)))
- (file-notify--test-with-events
+ (file-notify--test-with-actions
(cond
;; w32notify does not raise `deleted' and `stopped'
;; events for the watched directory.
@@ -836,7 +847,7 @@ delivered."
(file-notify--test-add-watch
file-notify--test-tmpfile
'(attribute-change) #'file-notify--test-event-handler)))
- (file-notify--test-with-events
+ (file-notify--test-with-actions
(cond
;; w32notify does not distinguish between `changed' and
;; `attribute-changed'. Under MS Windows 7, we get four
@@ -923,7 +934,7 @@ delivered."
"another text" nil file-notify--test-tmpfile nil 'no-message)
;; Check, that the buffer has been reverted.
- (file-notify--wait-for-events
+ (file-notify--test-wait-for-events
timeout
(string-match
(format-message "Reverting buffer `%s'." (buffer-name buf))
@@ -932,7 +943,7 @@ delivered."
;; Stop file notification. Autorevert shall still work via
polling.
(file-notify-rm-watch auto-revert-notify-watch-descriptor)
- (file-notify--wait-for-events
+ (file-notify--test-wait-for-events
timeout (null auto-revert-notify-watch-descriptor))
(should auto-revert-use-notify)
(should-not auto-revert-notify-watch-descriptor)
@@ -946,7 +957,7 @@ delivered."
"foo bla" nil file-notify--test-tmpfile nil 'no-message)
;; Check, that the buffer has been reverted.
- (file-notify--wait-for-events
+ (file-notify--test-wait-for-events
timeout
(string-match
(format-message "Reverting buffer `%s'." (buffer-name buf))
@@ -1002,7 +1013,7 @@ delivered."
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
(should (file-notify-valid-p file-notify--test-desc))
- (file-notify--test-with-events
+ (file-notify--test-with-actions
(cond
;; gvfs-monitor-dir on cygwin does not detect the
;; `changed' event reliably.
@@ -1039,7 +1050,7 @@ delivered."
file-notify--test-tmpdir
'(change) #'file-notify--test-event-handler)))
(should (file-notify-valid-p file-notify--test-desc))
- (file-notify--test-with-events
+ (file-notify--test-with-actions
(cond
;; w32notify does not raise `deleted' and `stopped'
;; events for the watched directory.
@@ -1100,7 +1111,7 @@ delivered."
;; After removing the watch, the descriptor must not be valid
;; anymore.
(file-notify-rm-watch file-notify--test-desc)
- (file-notify--wait-for-events
+ (file-notify--test-wait-for-events
(file-notify--test-timeout)
(not (file-notify-valid-p file-notify--test-desc)))
(should-not (file-notify-valid-p file-notify--test-desc))
@@ -1127,7 +1138,7 @@ delivered."
;; After deleting the directory, the descriptor must not be
;; valid anymore.
(delete-directory file-notify--test-tmpfile 'recursive)
- (file-notify--wait-for-events
+ (file-notify--test-wait-for-events
(file-notify--test-timeout)
(not (file-notify-valid-p file-notify--test-desc)))
(should-not (file-notify-valid-p file-notify--test-desc))
@@ -1170,7 +1181,7 @@ delivered."
(push (expand-file-name (format "y%d" i)) target-file-list))
(push (expand-file-name (format "y%d" i)) source-file-list)
(push (expand-file-name (format "x%d" i)) target-file-list)))
- (file-notify--test-with-events (make-list (+ n n) 'created)
+ (file-notify--test-with-actions (make-list (+ n n) 'created)
(let ((source-file-list source-file-list)
(target-file-list target-file-list))
(while (and source-file-list target-file-list)
@@ -1178,7 +1189,7 @@ delivered."
(write-region "" nil (pop source-file-list) nil 'no-message)
(file-notify--test-read-event)
(write-region "" nil (pop target-file-list) nil 'no-message))))
- (file-notify--test-with-events
+ (file-notify--test-with-actions
(cond
;; w32notify fires both `deleted' and `renamed' events.
((string-equal (file-notify--test-library) "w32notify")
@@ -1199,7 +1210,7 @@ delivered."
(while (and source-file-list target-file-list)
(file-notify--test-read-event)
(rename-file (pop source-file-list) (pop target-file-list) t))))
- (file-notify--test-with-events (make-list n 'deleted)
+ (file-notify--test-with-actions (make-list n 'deleted)
(dolist (file target-file-list)
(file-notify--test-read-event)
(delete-file file)))
@@ -1233,7 +1244,7 @@ delivered."
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
(should (file-notify-valid-p file-notify--test-desc))
- (file-notify--test-with-events
+ (file-notify--test-with-actions
;; There could be one or two `changed' events.
'((changed)
(changed changed))
@@ -1269,7 +1280,7 @@ delivered."
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
(should (file-notify-valid-p file-notify--test-desc))
- (file-notify--test-with-events
+ (file-notify--test-with-actions
(cond
;; On cygwin we only get the `changed' event.
((eq system-type 'cygwin)
@@ -1345,7 +1356,7 @@ the file watch."
(should-not (equal file-notify--test-desc1 file-notify--test-desc2))
(let ((n 100))
;; Run the test.
- (file-notify--test-with-events
+ (file-notify--test-with-actions
;; There could be one or two `changed' events.
(list
;; cygwin.
@@ -1387,13 +1398,13 @@ the file watch."
;; 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 '(:random deleted deleted stopped)
+ (file-notify--test-with-actions '(:random deleted deleted stopped)
(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
+ (file-notify--test-with-actions
(cond
;; In kqueue and for cygwin, just one `deleted' event for
;; the directory is received.
diff --git a/test/lisp/gnus/nnrss-tests.el b/test/lisp/gnus/nnrss-tests.el
new file mode 100644
index 0000000..184c592
--- /dev/null
+++ b/test/lisp/gnus/nnrss-tests.el
@@ -0,0 +1,29 @@
+;;; nnrss-tests.el --- tests for gnus/nnrss.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'nnrss)
+
+(ert-deftest test-nnrss-normalize ()
+ (should (equal (nnrss-normalize-date "2004-09-17T05:09:49.001+00:00")
+ "Fri, 17 Sep 2004 05:09:49 +0000")))
+
+;;; nnrss-tests.el ends here
diff --git a/test/lisp/progmodes/flymake-tests.el
b/test/lisp/progmodes/flymake-tests.el
index af97290..f1d8b3a 100644
--- a/test/lisp/progmodes/flymake-tests.el
+++ b/test/lisp/progmodes/flymake-tests.el
@@ -52,7 +52,7 @@
(flymake-reporting-backends))
while notdone
unless noninteractive do (read-event "" nil 0.1)
- do (sleep-for (+ 0.5 flymake-no-changes-timeout))
+ do (sleep-for (+ 0.5 (or flymake-no-changes-timeout 0)))
finally (when notdone (ert-skip
(format "Some backends not reporting yet %s"
notdone)))))
@@ -111,7 +111,6 @@ SEVERITY-PREDICATE is used to setup
(ert-deftest perl-backend ()
"Test the perl backend"
(skip-unless (executable-find "perl"))
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(flymake-tests--with-flymake ("test.pl")
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
@@ -123,7 +122,6 @@ SEVERITY-PREDICATE is used to setup
(ert-deftest ruby-backend ()
"Test the ruby backend"
(skip-unless (executable-find "ruby"))
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
;; Some versions of ruby fail if HOME doesn't exist (bug#29187).
(let* ((tempdir (make-temp-file "flymake-tests-ruby" t))
(process-environment (cons (format "HOME=%s" tempdir)
@@ -169,7 +167,6 @@ SEVERITY-PREDICATE is used to setup
(ert-deftest included-c-header-files ()
"Test inclusion of .h header files."
(skip-unless (and (executable-find "gcc") (executable-find "make")))
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(let ((flymake-wrap-around nil))
(flymake-tests--with-flymake
("some-problems.h")
@@ -295,7 +292,6 @@ SEVERITY-PREDICATE is used to setup
(ert-deftest recurrent-backend ()
"Test a backend that calls REPORT-FN multiple times"
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(with-temp-buffer
(let (tick)
(cl-letf
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index b853f77..7745fcc 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -144,6 +144,35 @@
(should (equal "hello stderr!\n"
(mapconcat #'identity (nreverse stderr-output) "")))))
+(ert-deftest set-process-filter-t ()
+ "Test setting process filter to t and back." ;; Bug#36591
+ (with-temp-buffer
+ (let* ((print-level nil)
+ (print-length nil)
+ (proc (start-process
+ "test proc" (current-buffer)
+ (concat invocation-directory invocation-name)
+ "-Q" "--batch" "--eval"
+ (prin1-to-string
+ '(let (s)
+ (while (setq s (read-from-minibuffer "$ "))
+ (princ s)
+ (princ "\n")))))))
+ (set-process-query-on-exit-flag proc nil)
+ (send-string proc "one\n")
+ (should
+ (accept-process-output proc 1)) ; Read "one".
+ (should (equal (buffer-string) "$ one\n$ "))
+ (set-process-filter proc t) ; Stop reading from proc.
+ (send-string proc "two\n")
+ (should-not
+ (accept-process-output proc 1)) ; Can't read "two" yet.
+ (should (equal (buffer-string) "$ one\n$ "))
+ (set-process-filter proc nil) ; Resume reading from proc.
+ (should
+ (accept-process-output proc 1)) ; Read "two" from proc.
+ (should (equal (buffer-string) "$ one\n$ two\n$ ")))))
+
(ert-deftest start-process-should-not-modify-arguments ()
"`start-process' must not modify its arguments in-place."
;; See bug#21831.