Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 09:14:18 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge branch 'master' into feature/igc

Browse source
This commit is contained in:
Helmut Eller 2026-02-13 09:10:16 +01:00
commit 91c9e98834
239 changed files with 26061 additions and 1777 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitattributes vendored
View file

@ -25,6 +25,7 @@ admin/charsets/mapfiles/PTCP154 whitespace=cr-at-eol
test/manual/etags/c-src/dostorture.c whitespace=cr-at-eol
test/manual/etags/cp-src/c.C whitespace=cr-at-eol
test/manual/etags/html-src/algrthms.html whitespace=cr-at-eol
test/lisp/calendar/icalendar-resources/*.ics whitespace=cr-at-eol
# The todo-mode file format includes trailing whitespace.
*.tod[aorty] -whitespace=blank-at-eol

5
admin/MAINTAINERS
View file

@ -405,6 +405,11 @@ Spencer Baugh
Yuan Fu
lisp/progmodes/c-ts-mode.el
Basil L. Contovounesios
lisp/battery.el (UPower support)
lisp/json.el
src/image.c (WebP support)
==============================================================================
3. Externally maintained packages.
==============================================================================

1
admin/authors.el
View file

@ -69,6 +69,7 @@ files.")
(nil "BlaCk_Void" "alstjr7375@daum\\.net")
(nil "bug-gnu-emacs@gnu\\.org") ; mistake
("Björn Torkelsson" "Bjorn Torkelsson")
("Boris Buliga" "boris@d12frosted\\.io")
(nil "brandon\\.irizarry@gmail\\.com")
("Brian Fox" "Brian J\\. Fox")
("Brian P Templeton" "BT Templeton")

128
admin/scrape-elpa.el Normal file
View file

@ -0,0 +1,128 @@
;;; scrape-elpa.el --- Collect ELPA package suggestions -*- lexical-binding: t; -*-
;; Copyright (C) 2024, 2026 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Keywords: tools
;; This program 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.
;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This file defines an administrative command to update the
;; `package-autosuggest' database.
;;; Code:
(require 'rx)
(defun scrape-elpa--safe-eval (exp &optional vars)
"Manually evaluate EXP without potentially dangerous side-effects.
The optional argument VARS may be an alist mapping symbols to values,
used when evaluating variables. The evaluation function is not meant to
be comprehensive, but just to handle the kinds of expressions that
`scrape-elpa' expects to encounter."
(pcase-exhaustive exp
;; special handling for macros
(`(rx . ,body) (rx-to-string `(: . ,body) t))
;; quoting and quasi-quoting
(`',x x)
(`(purecopy ,x) x)
((and (guard (eq '\` (car-safe exp))) (let `(,car . ,cdr) (cadr exp)))
(cons
(if (eq (car-safe car) '\,) (scrape-elpa--safe-eval (cadr car) vars) car)
(if (eq (car-safe cdr) '\,) (scrape-elpa--safe-eval (cadr cdr) vars) cdr)))
;; allow calling `side-effect-free' functions
(`(,(and (pred symbolp) (pred (get _ 'side-effect-free)) fn) . ,args)
(apply fn (mapcar #'scrape-elpa--safe-eval args)))
;; self-evaluating forms
((pred macroexp-const-p) exp)
;; variable evaluation
((pred symbolp)
(let ((ent (assq exp vars)))
(if ent (cdr ent) (signal 'void-variable exp))))))
(defun scrape-elpa (&rest directories)
"Scrape autoload files in DIRECTORIES for package suggestions.
This file will automatically update \"package-autosuggest.eld\", but not
save it. You should invoke this command with built GNU ELPA and NonGNU
ELPA checkouts (i.e. having run \"make autoloads\" in both directories).
Please review the results before updating the autosuggest database!"
(interactive (completing-read-multiple
"ELPA directories to scrape: "
#'completion-file-name-table
#'file-directory-p))
(with-current-buffer
(find-file (expand-file-name "package-autosuggest.eld" data-directory))
(erase-buffer)
(lisp-data-mode)
(insert ";; The contents of this file are loaded into `package--autosuggest-database'.
;; were automatically generate by scraping ELPA for auto-loaded
;; code using the `scrape-elpa' command from admin/scrape-elpa.el. Please do not
;; update this file manually!
")
(fill-paragraph)
(insert "(")
(let ((standard-output (current-buffer)))
(dolist-with-progress-reporter
(file (mapcan
(lambda (dir)
(directory-files-recursively
dir "-autoloads\\.el\\'"))
directories))
"Scraping files..."
(and-let* (((string-match "/\\([^/]+?\\)-autoloads\\.el\\'" file))
(pkg (intern (match-string 1 file)))
(vars (list '(#:nihil)))
(inhibit-message t))
(with-temp-buffer
(insert-file-contents file)
(condition-case nil
(while t
(dolist (exp (macroexp-unprogn (read (current-buffer))))
(pcase exp
(`(defconst ,(and (pred symbolp) var) ,val . ,_)
(catch 'ignore
(push
(cons var (condition-case err
(scrape-elpa--safe-eval val vars)
(t (message "Failed to evaluate %S: %S in %S" exp err vars)
(throw 'ignore nil))))
vars)))
(`(add-to-list
',(and (or 'interpreter-mode-alist
'magic-mode-alist
'auto-mode-alist)
variable)
,(let `(,(and (pred stringp) regexp) .
,(and (pred symbolp) mode))
(condition-case err
(scrape-elpa--safe-eval _ vars)
(t (message "Failed to evaluate %S: %S in %S" exp err vars)
nil))))
(terpri)
(prin1 (append (list pkg variable regexp)
(and (not (eq pkg mode)) (list mode)))))
(`(add-to-list
',(or 'interpreter-mode-alist
'magic-mode-alist
'auto-mode-alist)
_)
(_ (message "Skipped over %S" exp))))))
(end-of-file nil))))))
(insert "\n)\n")))
(provide 'scrape-elpa)
;;; scrape-elpa.el ends here

328
doc/emacs/calendar.texi
View file

@ -1005,7 +1005,7 @@ entries.
* Adding to Diary:: Commands to create diary entries.
* Special Diary Entries:: Anniversaries, blocks of dates, cyclic entries, etc.
* Appointments:: Reminders when it's time to do something.
* Importing Diary:: Converting diary events to/from other formats.
* Diary Conversion:: Converting diary events to/from other formats.
@end menu
@node Format of Diary File
@ -1549,71 +1549,287 @@ clock. The command @kbd{M-x appt-add} adds entries to the appointment
list without affecting your diary file. You delete entries from the
appointment list with @kbd{M-x appt-delete}.
@node Importing Diary
@node Diary Conversion
@subsection Importing and Exporting Diary Entries
@cindex importing diary entries
@cindex diary import
@cindex diary export
You can transfer diary entries between Emacs diary files and a
variety of other formats.
You can transfer diary entries between Emacs diary files and other
formats.
@menu
* Diary iCalendar Import:: Importing iCalendar data to the Diary.
* Diary iCalendar Display:: Displaying iCalendar data without importing.
* Diary iCalendar Export:: Exporting Diary entries to iCalendar.
* Diary Outlook Import:: Importing Outlook appointments to the Diary.
@end menu
@node Diary iCalendar Import
@subsubsection Importing iCalendar data as Diary Entries
@cindex import iCalendar to diary
@cindex iCalendar support in diary
@dfn{iCalendar} is an Internet standard format for exchanging calendar
data. Many calendar applications can export and import data in
iCalendar format. iCalendar data is also often sent as email
attachments. iCalendar data usually uses the @file{.ics} file
extension, and is sent with the `text/calendar' @acronym{MIME} type in
email. (@xref{Mail Misc}, for more information on @acronym{MIME} and
email attachments.)
The @code{diary-icalendar} package allows you to make use of iCalendar
data with the Emacs diary. You can import and export data between
iCalendar format and your Emacs diary file, and also display iCalendar
data directly in the diary.
The following commands will import iCalendar data to your diary file:
@ftable @code
@item diary-icalendar-import-file
Imports an iCalendar file to an Emacs diary file.
@item diary-icalendar-import-buffer
Imports iCalendar data from the current buffer to an Emacs diary file.
@end ftable
@code{diary-icalendar-import-buffer} is also suitable for importing
iCalendar data from email attachments. For example, with the Rmail mail
client, you could use:
@example
(add-hook 'rmail-show-message-hook #'diary-icalendar-import-buffer)
@end example
Diary import depends on a number of user-customizable variables, which
are in the @code{diary-icalendar-import} customization group. You can
review and customize these variables with @kbd{M-x customize-group}.
@xref{Customization Groups}.
iCalendar data is grouped into @dfn{components} which represent calendar
events (the VEVENT component), tasks (VTODO), and other text data
(VJOURNAL). Because these components contain different types of data,
they are imported by different functions, determined by the following
variables:
@vtable @code
@item diary-icalendar-vevent-format-function
Function to format VEVENT components for the diary.
@item diary-icalendar-vjournal-format-function
Function to format VJOURNAL components for the diary.
@item diary-icalendar-vtodo-format-function
Function to format VTODO components for the diary.
@end vtable
You can customize the format of the imported diary entries by writing
your own formatting functions. It is convenient (but not required) to
express such functions as templates called @dfn{skeletons}.
@ifinfo
@xref{Top, Autotyping, The Autotype Manual, autotype}, for more about
skeletons.
@end ifinfo
For example, suppose you only want to import the date, time, summary,
and location of each calendar event, and to write them on a single line
like:
@example
2025/11/11 Summary @@ Some Location
@end example
@noindent
Then you could write the import formatting function as a skeleton and
set it to the value of @code{diary-icalendar-vevent-format-function} as
follows:
@lisp
@group
(require 'skeleton)
(defun simple-vevent (_)
"Format a VEVENT summary and location on a single line"
(skeleton-insert
'(nil
ical-start-to-end & " " & ical-summary & " "
(when ical-location "@@ ") & ical-location "\n")))
(setopt diary-icalendar-vevent-format-function #'simple-vevent)
@end group
@end lisp
The variables @code{ical-start-to-end}, @code{ical-summary} and
@code{ical-location} in this example are dynamically bound to
appropriate values when the skeleton is called. See the docstring of
@code{diary-icalendar-vevent-format-function} for more information.
Any errors encountered during import will be reported in a buffer named
@file{*icalendar-errors*}. You can review these errors with the
@code{next-error} command. @xref{Compilation Mode}. If you regularly
need to import malformed iCalendar data, there are several hooks
available for this purpose; see the @code{icalendar-parser}
customization group.
@node Diary iCalendar Display
@subsubsection Displaying iCalendar entries in the Diary
@cindex display iCalendar in diary
If you primarily store your calendar data outside of Emacs, but still
want to see it in the Emacs calendar and diary, you can do so by
including an iCalendar file from your diary file.
Suppose, for example, that you download your calendar from an
external server to a file called @file{Appointments.ics}. Then you can
include this file in your diary by writing a line like
@example
#include "path/to/Appointments.ics"
@end example
@noindent
in your diary file. You must also set up some hooks to display the
data in that file as diary entries and mark them in the calendar:
@lisp
@group
(add-hook 'diary-mark-entries-hook
#'diary-mark-included-diary-files)
(add-hook 'diary-nongregorian-marking-hook
#'diary-icalendar-mark-entries)
(add-hook 'diary-list-entries-hook
#'diary-include-other-diary-files)
(add-hook 'diary-nongregorian-listing-hook
#'diary-icalendar-display-entries)
@end group
@end lisp
@noindent
Events, tasks, and journal entries in @file{Appointments.ics} will then show
up on the appropriate days when you display the diary from the calendar.
@xref{Displaying the Diary}.
The advantage of doing this is that you don't need to synchronize the
data between the calendar server and your diary file. This is simpler
and more reliable than regularly importing and exporting between diary
and iCalendar format.
@findex diary-icalendar-mailcap-viewer
You can also display iCalendar attachments in email messages
without importing them to your diary file using the function
@code{diary-icalendar-mailcap-viewer}. You can add this function, for
example, to the variable @code{mailcap-user-mime-data}; see its docstring
for more information.
Displaying iCalendar entries uses the same infrastructure as importing
them, so customizing the import format will also change the format of
the displayed entries. @xref{Diary iCalendar Import}.
@node Diary iCalendar Export
@subsubsection Exporting Diary Entries to iCalendar
@cindex export diary to iCalendar
The following commands will export diary entries in iCalendar format:
@ftable @code
@item diary-icalendar-export-file
Exports a diary file to iCalendar format.
@item diary-icalendar-export-region
Exports a region of diary text to iCalendar format.
@end ftable
iCalendar export depends on a number of user-customizable variables, which
are in the @code{diary-icalendar-export} customization group. You can
review and customize these variables with @kbd{M-x customize-group}.
@xref{Customization Groups}.
Exporting diary entries to iCalendar requires you to respect certain
conventions in your diary, so that iCalendar properties can be parsed
from your diary entries.
By default, the exporter will use the first line of the entry (after the
date and time) as the iCalendar summary and the rest of the entry as its
iCalendar description. Other iCalendar properties can also be encoded in
the entry on separate lines, like this:
@example
@group
2025/11/11 Bender's birthday bash
Location: Robot House
Attendees:
Fry <philip.fry@@mars.edu>
Günter <guenter@@mars.edu>
@end group
@end example
@noindent
This format matches the format produced by the default import
functions.
@vindex diary-icalendar-address-regexp
@vindex diary-icalendar-class-regexp
@vindex diary-icalendar-description-regexp
@vindex diary-icalendar-location-regexp
@vindex diary-icalendar-organizer-regexp
@vindex diary-icalendar-status-regexp
@vindex diary-icalendar-summary-regexp
@vindex diary-icalendar-todo-regexp
@vindex diary-icalendar-uid-regexp
@vindex diary-icalendar-url-regexp
If you customize the import format, or you want to export diary entries
in a different format, you will need to customize the export variables
to detect the format of your diary entries. The most common iCalendar
properties are parsed from diary entries using regular expressions. See
the variables named @code{diary-icalendar-*-regexp} in the
@code{diary-icalendar-export} customization group to modify how these
properties are parsed.
@vindex diary-icalendar-other-properties-parser
If you need to export other iCalendar properties, or do more
complicated parsing, you can define a function to do so and set it as
the value of the variable @code{diary-icalendar-other-properties-parser};
see its docstring for details.
@vindex diary-icalendar-export-linewise
By default, the exporter assumes that each diary entry represents a
single iCalendar event. If you like to keep your diary in a
one-entry-per-day format, with different events on continuation
lines within the same entry, you can still export such entries as
distinct iCalendar events. To do this, set the variable
@code{diary-icalendar-export-linewise} to a non-nil value.
For example, after setting this variable, an entry like:
@example
@group
2025-05-03
9AM Lab meeting
Günter to present on new assay
Start experiment A
12:30-1:30PM Lunch with Phil
16:00 Experiment A finishes; move to freezer
@end group
@end example
@noindent
will be exported as four events, each on the same day, but with
different start times (except for the second event, ``Start experiment
A'', which has no start time). See the docstring of
@code{diary-icalendar-export-linewise} for more information.
@node Diary Outlook Import
@subsubsection Importing Outlook appointments as Diary Entries
@cindex diary outlook import
@vindex diary-outlook-formats
You can import diary entries from Outlook-generated appointment
@vindex diary-from-outlook-function
You can also import diary entries from Outlook-generated appointment
messages. While viewing such a message in Rmail or Gnus, do @kbd{M-x
diary-from-outlook} to import the entry. You can make this command
recognize additional appointment message formats by customizing the
variable @code{diary-outlook-formats}. Other mail clients can set
@code{diary-from-outlook-function} to an appropriate value.
@c FIXME the name of the RFC is hardly very relevant.
@cindex iCalendar support
The icalendar package allows you to transfer data between your Emacs
diary file and iCalendar files, which are defined in @cite{RFC
2445---Internet Calendaring and Scheduling Core Object Specification
(iCalendar)} (as well as the earlier vCalendar format).
@c Importing works for ordinary (i.e., non-recurring) events, but
@c (at present) may not work correctly (if at all) for recurring events.
@c Exporting of diary files into iCalendar files should work correctly
@c for most diary entries. This feature is a work in progress, so the
@c commands may evolve in future.
@findex icalendar-import-buffer
The command @code{icalendar-import-buffer} extracts
iCalendar data from the current buffer and adds it to your
diary file. This function is also suitable for automatic extraction of
iCalendar data; for example with the Rmail mail client one could use:
@example
(add-hook 'rmail-show-message-hook 'icalendar-import-buffer)
@end example
@findex icalendar-import-file
The command @code{icalendar-import-file} imports an iCalendar file
and adds the results to an Emacs diary file. For example:
@example
(icalendar-import-file "/here/is/calendar.ics"
"/there/goes/ical-diary")
@end example
@noindent
You can use an @code{#include} directive to add the import file contents
to the main diary file, if these are different files.
@iftex
@xref{Fancy Diary Display,,, emacs-xtra, Specialized Emacs Features}.
@end iftex
@ifnottex
@xref{Fancy Diary Display}.
@end ifnottex
@findex icalendar-export-file
@findex icalendar-export-region
@cindex export diary
Use @code{icalendar-export-file} to interactively export an entire
Emacs diary file to iCalendar format. To export only a part of a diary
file, mark the relevant area, and call @code{icalendar-export-region}.
In both cases, Emacs appends the result to the target file.
@node Daylight Saving
@section Daylight Saving Time

107
doc/emacs/custom.texi
View file

@ -1615,24 +1615,30 @@ your preference, such as @code{ws-butler-mode}.
@cindex per-connection local variables
Most of the variables reflect the situation on the local machine.
Often, they must use a different value when you operate in buffers
with a remote default directory. Think about the behavior when
calling @code{shell} -- on your local machine, you might use
@file{/bin/bash} and rely on termcap, but on a remote machine, it may
be @file{/bin/ksh} and terminfo.
Often, they must use a different value when you operate in buffers with
a remote default directory. Think about the behavior when calling
@code{shell} --- on your local machine, you might use @file{/bin/bash}
and rely on termcap, but on a remote machine, it may be @file{/bin/ksh}
and terminfo.
This can be accomplished with @dfn{connection-local variables}.
Directory and file local variables override connection-local
variables. Unsafe connection-local variables are handled in the same
way as unsafe file-local variables (@pxref{Safe File Variables}).
This can be accomplished with @dfn{connection-local variables}. Such
variables are declared depending on the value of
@code{default-directory} of the current buffer. When a buffer has a
remote @code{default-directory}, and there exist a connection-local
variable which matches @code{default-directory}, this alternative value
of the variable is used. Directory and file local variables override
connection-local variables. Unsafe connection-local variables are
handled in the same way as unsafe file-local variables (@pxref{Safe File
Variables}).
@findex connection-local-set-profile-variables
@findex connection-local-set-profiles
Connection-local variables are declared as a group of
variables/value pairs in a @dfn{profile}, using the
Connection-local variables are declared as a group of variables/value
pairs in a @dfn{profile}, using the
@code{connection-local-set-profile-variables} function. The function
@code{connection-local-set-profiles} activates profiles for a given
criteria, identifying a remote machine:
@code{connection-local-set-profiles} declares profiles for a given
criteria (the first argument), identifying a remote machine with respect
to @code{default-directory} of the current buffer:
@example
(connection-local-set-profile-variables 'remote-terminfo
@ -1654,12 +1660,46 @@ criteria, identifying a remote machine:
This code declares three different profiles, @code{remote-terminfo},
@code{remote-ksh}, and @code{remote-bash}. The profiles
@code{remote-terminfo} and @code{remote-ksh} are applied to all
buffers which have a remote default directory matching the regexp
@code{"remotemachine"} as host name. Such a criteria can also
discriminate for the properties @code{:protocol} (this is the Tramp
method) or @code{:user} (a remote user name). The @code{nil} criteria
matches all buffers with a remote default directory.
@code{remote-terminfo} and @code{remote-ksh} are applied to all buffers
which have a remote @code{default-directory} matching the string
@code{"remotemachine"} as host name.
Criteria, the first argument of @code{connection-local-set-profiles},
specifies, how the profiles match @code{default-directory}. It is a
plist identifying a connection and the application using this
connection. Property names might be @code{:application},
@code{:protocol}, @code{:user} and @code{:machine}. The property value
of @code{:application} is a symbol, all other property values are
strings. In general the symbol @code{tramp} should be used as
@code{:application} value. Some packages use a different
@code{:application} (for example @code{eshell} or @code{vc-git}); they
say it in their documentation then. All properties are optional.
The other properties are used for checking @code{default-directory}.
The propertiy @code{:protocol} is used for the method a remote
@code{default-directory} uses, the property
@code{:user} is the remote user name, and the property @code{:machine}
is the remote host name. All checks are performed via
@code{string-equal}. The @code{nil} criteria matches all buffers
with a remote default directory.
Connection-local variables are not activated by default. A package
which uses connection-local variables must activate them for a given
buffer, specifying for which @code{:application} it uses them.
@xref{Applying Connection Local Variables,,, elisp, The Emacs Lisp
Reference Manual}, for details.
After the above definition of profiles and their activation, any
connection made by Tramp to the @samp{remotemachine} system will use
@itemize
@item @code{t} as the connection-specific value of @code{system-uses-terminfo},
@item @samp{dumb-emacs-ansi} as the connection-specific value of
@code{comint-terminfo-terminal},
@item @samp{/bin/ksh} as the connection-specific value of as
@code{shell-file-name},
@item @samp{-c} as the connection-specific value of @code{shell-command-switch}.
@end itemize
Be careful when declaring different profiles with the same variable,
and setting these profiles to criteria which could match in parallel.
@ -3098,30 +3138,33 @@ elisp, The Emacs Lisp Reference Manual}.
If the directory specified by @code{user-lisp-directory}, defaulting
to @file{~/.config/emacs/user-lisp/} or @file{~/.emacs.d/user-lisp/},
exists, then at startup Emacs will prepare Lisp files within that
directory for use in the session. Emacs does the following things:
directory for use in the session. Specifically, Emacs does the
following:
@itemize
@item
Gather and activate autoload cookies. This means that you can use
autoloaded commands and other entry points for the files in your
@code{user-lisp-directory} without explicitly loading any of the
files in your initialization file. (@pxref{Autoload,,, elisp, The
Emacs Lisp Reference Manual}.)
files in your initialization file. @xref{Autoload,,, elisp, The
Emacs Lisp Reference Manual}.
@item
Byte-compile all files, and if supported on your system, natively
compile them too. This speeds up the execution of the code in the
files when they are loaded. (@pxref{Byte Compilation,,, elisp, The
Emacs Lisp Reference Manual}.)
Byte-compile all the files (@pxref{Byte Compilation,,, elisp, The Emacs
Lisp Reference Manual}), and if supported by your build of Emacs,
compile them to native code as well (@pxref{Native Compilation,,, elisp,
The Emacs Lisp Reference Manual}). This speeds up the execution of the
code in those files when they are loaded and when they are executed
later.
@item
Adjust @code{load-path} such that all the files can be loaded and
autoloaded in the usual ways. (@pxref{Library Search,,, elisp, The
Emacs Lisp Reference Manual}.)
autoloaded in the usual ways. @xref{Library Search,,, elisp, The
Emacs Lisp Reference Manual}.
@end itemize
The User Lisp directory is processed before loading the @ref{Init
File} file. Therefore any customizations to the user options discussed
below must be made in your early init file (@pxref{Early Init File}) in
order to have any effect.
The User Lisp directory is processed before loading your init file
(@pxref{Init File}). Therefore any customizations to the user
options discussed below must be made in your early init file
(@pxref{Early Init File}) in order to have any effect.
@vindex user-lisp-ignored-directories
@vindex user-lisp-auto-scrape

9
doc/emacs/emacs.texi
View file

@ -1020,7 +1020,14 @@ The Diary
* Adding to Diary:: Commands to create diary entries.
* Special Diary Entries:: Anniversaries, blocks of dates, cyclic entries, etc.
* Appointments:: Reminders when it's time to do something.
* Importing Diary:: Converting diary events to/from other formats.
* Diary Conversion:: Converting diary events to/from other formats.
Diary Conversion
* Diary iCalendar Import:: Importing iCalendar data to the Diary.
* Diary iCalendar Display:: Displaying iCalendar data without importing.
* Diary iCalendar Export:: Exporting Diary entries to iCalendar.
* Diary Outlook Import:: Importing Outlook appointments to the Diary.
@ifnottex
More advanced features of the Calendar and Diary

3
doc/emacs/files.texi
View file

@ -1835,7 +1835,8 @@ the start of the @var{n}th previous file.
@findex diff-hunk-kill
@item M-k
Kill the hunk at point (@code{diff-hunk-kill}).
Kill the hunk at point (@code{diff-hunk-kill}). If the region is
active, kills all hunks the region overlaps.
@findex diff-file-kill
@item M-K

41
doc/emacs/maintaining.texi
View file

@ -2323,6 +2323,11 @@ configuration (if any), excluding the ``ignored'' files from the output.
It has some performance optimizations for listing the files with some of
the popular VCS systems (currently Git and Mercurial).
@findex project-remember-projects-under
It also uses a time-based cache. If the mode line shows stale project
information, you can type @kbd{M-x project-remember-projects-under RET}
to refresh the stale cached info.
@defopt project-vc-include-untracked
By default, files which are neither registered with nor ignored by the
VCS are considered part of the project. Customize this variable to nil
@ -2569,12 +2574,13 @@ files, and build a database of these references. A backend can then
access this database whenever it needs to list or look up references.
The Emacs distribution includes @command{etags}, a command for tagging
identifier definitions in programs, which supports many programming
languages and other major modes, such as HTML, by extracting
references into @dfn{tags tables}. @xref{Create Tags Table}. Major
modes for languages supported by @command{etags} can use tags tables
as basis for their backend. (One disadvantage of this kind of backend
is that tags tables need to be kept reasonably up to date, by
rebuilding them from time to time.)
languages and other major modes, such as HTML, by extracting references
into @dfn{tags tables}. Major modes for languages supported by
@command{etags} can use tags tables as basis for their backend. Enable
@code{etags-regen-mode} to have tags tables generated across the current
project for supported file types and updated automatically upon edit.
Alternatively, you can build the table manually to control the set of
files and when it is updated, see @ref{Create Tags Table}.
@end enumerate
@menu
@ -2648,6 +2654,9 @@ to always prompt, customize @code{xref-prompt-for-identifier} to
usual minibuffer completion commands (@pxref{Completion}), with the
known identifier names being the completion candidates.
It uses the current Xref backend, and will signal an error when there
is none configured, with some recommendations.
@kindex C-x 4 .
@findex xref-find-definitions-other-window
@kindex C-x 5 .
@ -3028,7 +3037,9 @@ writes the tags to a @dfn{tags table file}, or @dfn{tags file} in
short. The conventional name for a tags file is @file{TAGS}@.
@xref{Create Tags Table}. (It is also possible to create a tags table
by using one of the commands from other packages that can produce such
tables in the same format.)
tables in the same format.) If you enable the @code{etags-regen-mode}
global minor mode, Emacs will generate and update the tags tables
automatically as needed.
Emacs uses the tags tables via the @code{etags} package as one of
the supported backends for @code{xref}. Because tags tables are
@ -3310,6 +3321,10 @@ You should update a tags table when you define new tags that you want
to have listed, or when you move tag definitions from one file to
another, or when changes become substantial.
If the @code{etags-regen-mode} minor mode, described below, is
enabled, Emacs will automatically keep the tags tables up-to-date as
needed.
You can make a tags table @dfn{include} another tags table, by
passing the @samp{--include=@var{file}} option to @command{etags}. It
then covers all the files covered by the included tags file, as well
@ -3418,11 +3433,11 @@ Command-line options to pass to the program which regenerates tags
tables.
@item etags-regen-ignores
List of glob patterns which specify files to ignore when regenerating
tags tables.
List of glob wildcard patterns which specify files to ignore when
regenerating tags tables.
@end vtable
@cindex tags-reset-tags-tables
@findex tags-reset-tags-tables
If you select a tags table manually, with @kbd{M-x visit-tags-table}
(@pxref{Select Tags Table}), @code{etags-regen-mode} effectively
disables itself: it will no longer automatically create and update
@ -3607,6 +3622,12 @@ to the first directory that contains a file named @file{TAGS}
encountered when recursively searching upward from the default
directory.
If you enable the @code{etags-regen-mode} global minor mode, it will
automatically find and visit the tags table file when needed. If you
then invoke @code{visit-tags-table} manually to select a tags table,
@code{etags-regen-mode} will disable automatic regeneration of the tags
table. @xref{Create Tags Table}.
@vindex tags-file-name
Emacs does not actually read in the tags table contents until you
try to use them; all @code{visit-tags-table} does is store the file

11
doc/emacs/package.texi
View file

@ -454,6 +454,17 @@ case, Emacs retrieves packages from this archive via ordinary file
access. Such local archives are mainly useful for testing.
@end defopt
@cindex suggestions
@findex package-autosuggest
@findex package-autosuggest-mode
Emacs has a built-in database of suggested packages for certain file
types. If Emacs opens a file with no specific mode, you can use the
@code{package-autosuggest} command to install the recommended packages
from ELPA. After enabling @code{package-autosuggest-mode}, Emacs will
display a clickable hint in the mode-line if it there is a suggested
package. Using the @code{package-autosuggest-style} user option, you
can adjust how Emacs presents the hint to install a package.
@anchor{Package Signing}
@cindex package security
@cindex package signing

13
doc/lispref/commands.texi
View file

@ -2778,12 +2778,12 @@ To test the signal handler, you can make Emacs send a signal to itself:
@end smallexample
@cindex @code{sleep-event} event
@item (sleep-event @var{sleep-wake})
This event is injected when the device Emacs is running on enters or
leaves the sleep state. A non-@code{nil} @var{sleep-wake} indicates
entering the sleep state.
@item (sleep-event @var{state})
This event is injected when the device Emacs is running on is about to
enter a sleep state, or has just awoken from one. @var{state} will be
the symbol @code{pre-sleep} or @code{post-wake}.
This is implemented only on GNU/Linux.
This is implemented on GNU/Linux, macOS, and MS-Windows.
@cindex @code{language-change} event
@item language-change
@ -4062,7 +4062,8 @@ definition to find the actual event.
user signals like @code{sigusr1} are normally handled in this way.
The keymap which defines how to handle special events---and which
events are special---is in the variable @code{special-event-map}
(@pxref{Controlling Active Maps}).
(@pxref{Controlling Active Maps}). @xref{Misc Events}, for more details
about these and other special events.
@defun insert-special-event
@cindex inserting special events

43
doc/lispref/control.texi
View file

@ -1493,25 +1493,27 @@ argument:
@subsection The @code{cond*} macro
@findex cond*@r{, a macro}
The @code{cond*} macro is an alternative to @code{pcase}, and supports
the same functionality, but using syntax that some might find less
cryptic.
You can use the @code{cond*} macro as an alternative to @code{pcase}
if you find @code{pcase}'s syntax too cryptic. In addition,
@code{cond*} offers some new forms of control flow that aren't related
to being an alternative to @code{pcase}.
@defmac cond* &rest clauses
The @code{cond*} macro is an extended form of the traditional
@code{cond}. A @code{cond*} expression contains a series of
@var{clauses}, each of which can use @code{bind*} to specify binding
variables, use @code{match*} to specify matching a pattern as a
condition, or specify an expression as a condition to evaluate as a
test.
@var{clauses}, each of which can use @code{bind*} or @code{bind-and*} to
specify binding variables, use @code{match*} or @code{pcase*} to specify
matching a pattern as a condition, or specify an expression as a
condition to evaluate as a test.
Each clause normally has the form @w{@code{(@var{condition}
@var{body}@dots{})}}.
@var{condition} can be a Lisp expression, as in @code{cond}
(@pxref{Conditionals}). Or it can be @w{@code{(bind*
@var{bindings}@dots{})}} or @w{@code{(match* @var{pattern}
@var{datum})}}.
@var{bindings}@dots{})}}, @w{@code{(match* @var{pattern} @var{datum})}},
@w{@code{(bind-and* @var{bindings}@dots{})}} or @w{@code{(pcase*
@var{pattern} @var{datum})}}
@findex bind*
@code{(bind* @var{bindings}@dots{})} means to bind @var{bindings} (like
@ -1536,21 +1538,22 @@ bind to the parts of @var{datum} that they match.
@code{(pcase* @var{pattern} @var{datum})} works in the same way except it
uses the Pcase syntax for @var{pattern}.
@code{bind*}, @code{match*}, and @code{pcase*} normally bind their bindings over
the execution of the whole containing clause. However, if the clause is
written to specify ``non-exit'', the clause's bindings cover the whole
rest of the @code{cond*}.
@code{match*}, and @code{pcase*} normally bind their bindings over the
execution of the whole containing clause. However, if the clause is
written to specify ``non-exit'' (see below), the clause's bindings cover
the whole rest of the @code{cond*}.
When a clause's condition is true, and it exits the @code{cond*} or is
the last clause, the value of the last expression in the clause's body
becomes the return value of the @code{cond*} construct.
@subheading Non-exit clause
@subheading Non-exit clauses
If a clause has only one element, or if its first element is @code{t},
or if it ends with the keyword @code{:non-exit}, then this clause never
exits the @code{cond*} construct. Instead, control falls through to the
next clause (if any). The bindings made in @var{condition} for the
If a clause has only one element, or if its first element is @code{t} or
a @code{bind*} form, or if it ends with the keyword @code{:non-exit},
then this clause never exits the @code{cond*} construct. Instead,
control falls through to the next clause (if any). Except for a
@code{bind-and*} clause, the bindings made in @var{condition} for the
@var{body} of the non-exit clause are passed along to the rest of the
clauses in this @code{cond*} construct.
@ -2344,7 +2347,9 @@ the other usual filtering mechanisms say it should. @xref{Error Debugging}.
The macro @code{condition-case-unless-debug} provides another way to
handle debugging of such forms. It behaves exactly like
@code{condition-case}, unless the variable @code{debug-on-error} is
non-@code{nil}, in which case it does not handle any errors at all.
non-@code{nil}, in which case it causes Emacs to enter the debugger
before executing any applicable handler. (The applicable handler, if
any, will still run when the debugger exits.)
@end defmac
Once Emacs decides that a certain handler handles the error, it

34
doc/lispref/display.texi
View file

@ -2243,6 +2243,9 @@ means hide the excess parts of @var{string} with a @code{display} text
property (@pxref{Display Property}) showing the ellipsis, instead of
actually truncating the string.
See also the function @code{truncate-string-pixelwise} for pixel-level
resolution.
@example
@group
(truncate-string-to-width "\tab\t" 12 4)
@ -2440,6 +2443,37 @@ non-@code{nil}, use any face remappings (@pxref{Face Remapping}) from
that buffer when computing the width of @var{string}.
@end defun
@defun truncate-string-pixelwise string max-pixels &optional buffer ellipsis ellipsis-pixels
This is a convenience function that uses @code{window-text-pixel-size}
to truncate @var{string} to @var{max-pixels} pixels. Caveat: if you
call this function to measure the width of a string with embedded
newlines, it will then return the width of the widest substring that
does not include newlines. The meaning of this result is the widest
line taken by the string if inserted into a buffer. If @var{buffer} is
non-@code{nil}, use any face remappings (@pxref{Face Remapping}) from
that buffer when computing the width of @var{string}.
If @var{ellipsis} is non-@code{nil}, it should be a string which will
replace the end of @var{string} when it is truncated. In this case,
more characters will be removed from @var{string} to free enough space
for @var{ellipsis} to fit within @var{max-pixels} pixels. However, if
the pixel width of @var{string} is less than the pixel width of
@var{ellipsis}, @var{ellipsis} will not be appended to the result. If
@var{ellipsis} is non-@code{nil} and not a string, it stands for the
value returned by the function @code{truncate-string-ellipsis},
described above.
If @var{ellipsis-pixels} is non-@code{nil} and @var{ellipsis} is
non-@code{nil}, it should be the number of pixels of @var{ellipsis} that
you should precompute using @code{string-pixel-width}, specifying the
same buffer. This is useful to avoid the cost of recomputing this value
repeatedly when you have many strings to truncate using the same
ellipsis string.
See also the function @code{truncate-string-to-width} for
character-level resolution.
@end defun
@defun line-pixel-height
This function returns the height in pixels of the line at point in the
selected window. The value includes the line spacing of the line

1
doc/lispref/functions.texi
View file

@ -674,6 +674,7 @@ variable; these two uses of a symbol are independent and do not
conflict. (This is not the case in some dialects of Lisp, like
Scheme.)
@cindex internal functions, naming conventions
By convention, if a function's symbol consists of two names
separated by @samp{--}, the function is intended for internal use and
the first part names the file defining the function. For example, a

2
doc/lispref/modes.texi
View file

@ -5026,7 +5026,7 @@ should return the @var{offset} to use to indent @var{arg} itself.
@item
@code{:elem}, in which case the function should return either the offset
to use to indent function arguments (if @var{arg} is the symbol
@code{arg}) or the basic indentation step (if @var{arg} is the symbol
@code{args}) or the basic indentation step (if @var{arg} is the symbol
@code{basic}).
@item
@code{:list-intro}, in which case @var{arg} is a token and the function

72
doc/lispref/os.texi
View file

@ -35,6 +35,7 @@ terminal and the screen.
* Session Management:: Saving and restoring state with X Session Management.
* Desktop Notifications:: Desktop notifications.
* System Taskbar:: Controlling system GUI taskbar features.
* System Sleep:: Block system sleep and process sleep events.
* File Notifications:: File notifications.
* Dynamic Libraries:: On-demand loading of support libraries.
* Security Considerations:: Running Emacs in an unfriendly environment.
@ -2285,7 +2286,7 @@ be protected by wrapping the timer function body with
@lisp
@group
(ignore-error 'remote-file-error
(ignore-error remote-file-error
@dots{})
@end group
@end lisp
@ -3493,6 +3494,75 @@ Examples of system taskbar functions:
@end group
@end lisp
@node System Sleep
@section Block System Sleep and Process Sleep Events
@cindex system sleep
@cindex mode, system sleep
@defun system-sleep-block-sleep &optional why allow-display-sleep
This function blocks the system from entering its idle sleep state.
It returns a token that must be passed to
@code{system-sleep-unblock-sleep} to unblock this specific block (other
sleep blocks may be simultaneously in force for other purposes).
Otherwise, it returns @code{nil} if the sleep blocking fails.
@var{why} is a string and, when non-@code{nil}, is used to identify the
sleep block as it may appear on the system's inspectable block lists.
It defaults to @samp{Emacs}.
If @var{allow-display-sleep} is non-@code{nil}, allow the display to
sleep. By default, the display is kept active.
Note that when the Emacs process terminates, blocks are released on all
platforms.
@end defun
@defun system-sleep-unblock-sleep token
This function unblocks the sleep block associated with @var{token}. It
returns non-@code{nil} on success, otherwise it returns @code{nil}.
@end defun
@defmac with-system-sleep-block (&optional why allow-display-sleep) body@dots{}
This is a convenience macro that lets you wrap the forms in @var{body}
with a sleep block that is unblocked for you when @var{body} completes.
This guarantees that the system will never go to sleep while @var{body}
executes. The arguments have the same meaning as in
@code{system-sleep-block-sleep}, above.
@end defmac
@defun system-sleep-sleep-blocked-p
This predicate function returns non-@code{nil} if there are any
active @code{system-sleep} blocks, otherwise it returns @code{nil}.
@end defun
@defun system-sleep-unblock-all-sleep-blocks
This function unblocks all active sleep blocks. It is unlikely that you
will need to call this function.
@end defun
@defopt system-sleep-event-functions
When the system is about to enter a sleep state or after it wakes from
one, each function on this abnormal hook is called with one argument,
@var{event}, a sleep event. Its state can be retrieved via
@samp{@code{(sleep-event-state event)}}. State will be one of the
symbols @code{pre-sleep} or @code{post-wake}.
Handling @code{pre-sleep} events should be done as fast as possible and
avoid user prompting. Systems often grant a very short pre-sleep
processing interval, typically ranging between 2 and 5 seconds. The
system may sleep even if your processing is not complete, so be sure you
do as little as possible. For example, your function could close active
connections or serial ports.
Handling @code{post-wake} events offers more leeway. Use this, for
example, to reestablish connections.
Note: Your code, or the functions it calls, should not raise any signals
or all hooks will be halted. You can wrap your code in a
@code{condition-case} block (@pxref{Errors}).
@end defopt
@node File Notifications
@section Notifications on File Changes
@cindex file notifications

15
doc/lispref/sequences.texi
View file

@ -1110,9 +1110,9 @@ instead of the default @code{equal}.
@cindex sequences, intersection of
@cindex intersection of sequences
This function returns a copy of @var{sequence1} from which the
elements that appear in @var{sequence2} where removed. If the optional
argument @var{function} is non-@code{nil}, it is a function of two
arguments to use to compare elements instead of the default
elements that do not appear in @var{sequence2} were removed. If the
optional argument @var{function} is non-@code{nil}, it is a function of
two arguments to use to compare elements instead of the default
@code{equal}.
@example
@ -1125,10 +1125,11 @@ arguments to use to compare elements instead of the default
@defun seq-difference sequence1 sequence2 &optional function
This function returns a list of the elements that appear in
@var{sequence1} but not in @var{sequence2}. If the optional argument
@var{function} is non-@code{nil}, it is a function of two arguments to
use to compare elements instead of the default @code{equal}.
This function returns a copy of @var{sequence1} from which the
elements that appear in @var{sequence2} were removed. If the optional
argument @var{function} is non-@code{nil}, it is a function of two
arguments to use to compare elements instead of the default
@code{equal}.
@example
@group

11
doc/lispref/strings.texi
View file

@ -281,6 +281,17 @@ another string, alter a constant string in the program, or even raise
an error. To obtain a string that you can safely mutate, use
@code{copy-sequence} on the result.
If you need to create a string made from @var{n} copies of a given
source string @var{source}, you can use @code{concat} as follows:
@lisp
(apply #'concat (make-list @var{n} @var{source}))
@end lisp
@noindent
This uses the fact that @code{concat} can take any kind of sequence as
its arguments.
For information about other concatenation functions, see the
description of @code{mapconcat} in @ref{Mapping Functions},
@code{vconcat} in @ref{Vector Functions}, and @code{append} in @ref{Building

16
doc/lispref/variables.texi
View file

@ -617,6 +617,8 @@ float-pi
@node Tips for Defining
@section Tips for Defining Variables Robustly
@cindex variables, naming conventions
@cindex naming conventions, variables
When you define a variable whose value is a function, or a list of
functions, use a name that ends in @samp{-function} or
@ -659,6 +661,7 @@ The value is a whole shell command.
@item @dots{}-switches
The value specifies options for a command.
@cindex internal variables, naming conventions
@item @var{prefix}--@dots{}
The variable is intended for internal use and is defined in the file
@file{@var{prefix}.el}. (Emacs code contributed before 2018 may
@ -2653,6 +2656,19 @@ This macro returns the connection-local value of @var{symbol} for
If @var{symbol} does not have a connection-local
binding, the value is the default binding of the variable.
The difference to @code{with-connection-local@{-application@}-variables}
is, that @code{symbol} is not set buffer-local. A typical usage pattern
is to use only the the connection value of a variable if it exists, and
not to use its default value otherwise (using @code{my-app-variable}
initialized above):
@lisp
(if (connection-local-p my-app-variable 'my-app)
(connection-local-value my-app-variable 'my-app)
;; Something else.
)
@end lisp
@end defmac
@defvar enable-connection-local-variables

151
doc/misc/dbus.texi
View file

@ -64,7 +64,7 @@ another. An overview of D-Bus can be found at
* Alternative Buses:: Alternative buses and environments.
* Errors and Events:: Errors and events.
* Monitoring Messages:: Monitoring messages.
* Inhibitor Locks:: Inhibit system shutdowns and sleep states.
* File Descriptors:: Handle file descriptors.
* Index:: Index including concepts, functions, variables.
* GNU Free Documentation License:: The license for this documentation.
@ -1212,7 +1212,7 @@ which carries the input parameters to the object owning the method to
be called, and a reply message returning the resulting output
parameters from the object.
@defun dbus-call-method bus service path interface method &optional :timeout timeout :authorizable auth &rest args
@defun dbus-call-method bus service path interface method &optional :timeout timeout :authorizable auth :keep-fd &rest args
@anchor{dbus-call-method}
This function calls @var{method} on the D-Bus @var{bus}. @var{bus} is
either the keyword @code{:system} or the keyword @code{:session}.
@ -1245,6 +1245,11 @@ running):
@result{} "/org/freedesktop/systemd1/job/17508"
@end lisp
If the parameter @code{:keep-fd} is given, and the return message has a
first argument with a D-Bus type @code{:unix-fd}, the returned file
descriptor is kept internally, and can be used in a later call of
@code{dbus--close-fd} (@pxref{File Descriptors}).
The remaining arguments @var{args} are passed to @var{method} as
arguments. They are converted into D-Bus types as described in
@ref{Type Conversion}.
@ -1324,7 +1329,7 @@ emulate the @code{lshal} command on GNU/Linux systems:
@cindex method calls, asynchronous
@cindex asynchronous method calls
@defun dbus-call-method-asynchronously bus service path interface method handler &optional :timeout timeout :authorizable auth &rest args
@defun dbus-call-method-asynchronously bus service path interface method handler &optional :timeout timeout :authorizable auth :keep-fd &rest args
This function calls @var{method} on the D-Bus @var{bus}
asynchronously. @var{bus} is either the keyword @code{:system} or the
keyword @code{:session}.
@ -1347,6 +1352,11 @@ If the parameter @code{:authorizable} is given and the following
@var{auth} is non-@code{nil}, the invoked method may interactively
prompt the user for authorization. The default is @code{nil}.
If the parameter @code{:keep-fd} is given, and the return message has a
first argument with a D-Bus type @code{:unix-fd}, the returned file
descriptor is kept internally, and can be used in a later call of
@code{dbus--close-fd} (@pxref{File Descriptors}).
The remaining arguments @var{args} are passed to @var{method} as
arguments. They are converted into D-Bus types as described in
@ref{Type Conversion}.
@ -2205,109 +2215,90 @@ switches to the monitor buffer.
@end deffn
@node Inhibitor Locks
@chapter Inhibit system shutdowns and sleep states
@node File Descriptors
@chapter Handle file descriptors
@uref{https://systemd.io/INHIBITOR_LOCKS/, Systemd} includes a logic to
inhibit system shutdowns and sleep states. It can be controlled by a
D-Bus API@footnote{@uref{https://www.freedesktop.org/software/systemd/man/latest/org.freedesktop.login1.html}}.
Because this API includes handling of file descriptors, not all
functions can be implemented by simple D-Bus method calls. Therefore,
the following functions are provided.
Methods offered by the D-Bus API could return a file descriptor, which
must be handled further. This is indicated by the @code{:keep-fd}
parameter when calling the method (@pxref{dbus-call-method}).
@defun dbus-make-inhibitor-lock what why &optional block
This function creates an inhibitor for system shutdowns and sleep states.
@var{what} is a colon-separated string of lock types: @samp{shutdown},
@samp{sleep}, @samp{idle}, @samp{handle-power-key},
@samp{handle-suspend-key}, @samp{handle-hibernate-key},
@samp{handle-lid-switch}. Example: @samp{shutdown:idle}.
@c@var{who} is a descriptive string of who is taking the lock. If it is
@c@code{nil}, it defaults to @samp{Emacs}.
@var{why} is a descriptive string of why the lock is taken. Example:
@samp{Package Update in Progress}.
The optional @var{block} is the mode of the inhibitor lock, either
@samp{block} (@var{block} is non-@code{nil}), or @samp{delay}.
Note, that the @code{who} argument of the inhibitor lock object of the
systemd manager is always set to the string @samp{Emacs}.
It returns a file descriptor or @code{nil}, if the lock cannot be
acquired. If there is already an inhibitor lock for the triple
@code{(WHAT WHY BLOCK)}, this lock is returned. Example:
For example, @uref{https://systemd.io/INHIBITOR_LOCKS/, Systemd}
includes a logic to inhibit system shutdowns and sleep states. It can
be controlled by a the method @samp{Inhibit} of interface
@samp{org.freedesktop.login1.Manager}@footnote{@uref{https://www.freedesktop.org/software/systemd/man/latest/org.freedesktop.login1.html}}.
This function returns a file descriptor, which must be used to unlock
the locked resource, some of which lock the system. In order to keep
this file descriptor internally, the respective D-Bus method call looks
like (@var{what}, @var{who}, @var{why} and @var{mode} are
method-specific string arguments)
@lisp
(dbus-make-inhibitor-lock "sleep" "Test")
(dbus-call-method
:system
"org.freedesktop.login1" "/org/freedesktop/login1"
"org.freedesktop.login1.Manager" "Inhibit"
:keep-fd WHAT WHO WHY MODE)
@result{} 25
@end lisp
@end defun
@defun dbus-registered-inhibitor-locks
Return registered inhibitor locks, an alist.
This allows to check, whether other packages of the running Emacs
instance have acquired an inhibitor lock as well.
The inhibition lock is unlocked, when the returned file descriptor is
removed from the file system. This cannot be achieved on Lisp level.
Therefore, there is the function @code{dbus--fd-close} to performs this
task (see below).
An entry in this list is a list @code{(@var{fd} @var{what} @var{why}
@var{block})}. The car of the list is the file descriptor retrieved
from a @code{dbus-make-inhibitor-lock} call. The cdr of the list
represents the three arguments @code{dbus-make-inhibitor-lock} was
called with. Example:
@strong{Note}: When the Emacs process itself dies, all such locks are
released.
@strong{Note}: The following functions are internal to the D-Bus
implementation of Emacs. Use them with care.
@defun dbus--fd-open filename
Open @var{filename} and return the respective read-only file descriptor.
This is another function to keep a file descriptor internally. The
returned file descriptor can be closed by @code{dbus--fd-close}.
Example:
@lisp
(dbus-registered-inhibitor-locks)
(dbus--fd-open "~/.emacs")
@result{} ((25 "sleep" "Test" nil))
@result{} 20
@end lisp
@end defun
@defun dbus-close-inhibitor-lock lock
Close inhibitor lock file descriptor.
@var{lock}, a file descriptor, must be the result of a
@code{dbus-make-inhibitor-lock} call. It returns @code{t} in case of
success, or @code{nil} if it isn't be possible to close the lock, or if
the lock is closed already. Example:
@defun dbus--fd-close fd
Close file descriptor @var{fd}.
@var{fd} must be the result of a @code{dbus-call-method} or
@code{dbus--fd-open} call, see @code{dbus--registered-fds}. It returns
@code{t} in case of success, or @code{nil} if it isn’t be possible to
close the file descriptor, or if the file descriptor is closed already.
Example:
@lisp
(dbus-close-inhibitor-lock 25)
(dbus--fd-close 25)
@result{} t
@end lisp
@end defun
A typical scenario for these functions is to register for the
D-Bus signal @samp{org.freedesktop.login1.Manager.PrepareForSleep}:
@defun dbus--registered-fds
Return registered file descriptors, an alist.
The key is an open file descriptor, retrieved via
@code{dbus-call-method} or @code{dbus--open-fd}. The value is a string
@var{object-path} or @var{filename}, which represents the arguments the
function was called with. Those values are not needed for further
operations; they are just shown for information.
This alist allows to check, whether other packages of the running Emacs
instance have acquired a file descriptor as well. Example:
@lisp
(defvar my-inhibitor-lock
(dbus-make-inhibitor-lock "sleep" "Test"))
(dbus--registered-fds)
(defun my-dbus-PrepareForSleep-handler (start)
(if start ;; The system goes down for sleep
(progn
@dots{}
;; Release inhibitor lock.
(when (natnump my-inhibitor-lock)
(dbus-close-inhibitor-lock my-inhibitor-lock)
(setq my-inhibitor-lock nil)))
;; Reacquire inhibitor lock.
(setq my-inhibitor-lock
(dbus-make-inhibitor-lock "sleep" "Test"))))
(dbus-register-signal
:system "org.freedesktop.login1" "/org/freedesktop/login1"
"org.freedesktop.login1.Manager" "PrepareForSleep"
#'my-dbus-PrepareForSleep-handler)
@result{} ((:signal :system "org.freedesktop.login1.Manager" "PrepareForSleep")
("org.freedesktop.login1" "/org/freedesktop/login1"
my-dbus-PrepareForSleep-handler))
@result{} ((20 . "/home/user/.emacs")
(25 . "/org/freedesktop/login1"))
@end lisp
@end defun
@node Index

10
doc/misc/tramp.texi
View file

@ -6658,7 +6658,7 @@ root directory, it is most likely sufficient to make the
@code{default-directory} of the process buffer as the root directory.
@subsection Timers, process filters, process sentinels, redisplay
@subsection Timers, process filters, process sentinels, special events, redisplay
@vindex remote-file-error
Timers run asynchronously at any time when Emacs is waiting for
@ -6678,7 +6678,13 @@ wrapping the timer function body as follows:
@end lisp
A similar problem could happen with process filters, process
sentinels, and redisplay (updating the mode line).
sentinels, special event handlers, and redisplay (updating the mode
line).
@strong{Note} that @value{tramp} raises a @code{remote-file-error}
error for any connection-related problem. You can protect against all
such problems with the code snippet above (or with a
@code{condition-case} form with a @code{remote-file-error} handler).
@node Extension packages

14
doc/misc/widget.texi
View file

@ -785,13 +785,19 @@ The following navigation commands are available:
@table @kbd
@item @key{TAB}
@deffn Command widget-forward &optional count
Move point @var{count} buttons or editing fields forward.
@deffn Command widget-forward count &optional suppress-echo
Move point @var{count} buttons or editing fields forward. The optional
@var{suppress-echo} argument suppresses showing in the echo-area the
help-echo text, if any, for the final position after the move; it is
always @code{nil} in interactive invocations.
@end deffn
@item M-@key{TAB}
@itemx S-@key{TAB}
@deffn Command widget-backward &optional count
Move point @var{count} buttons or editing fields backward.
@deffn Command widget-backward count &optional suppress-echo
Move point @var{count} buttons or editing fields backward. The optional
@var{suppress-echo} argument suppresses showing in the echo-area the
help-echo text, if any, for the final position after the move; it is
always @code{nil} in interactive invocations.
@end deffn
@end table

196
etc/NEWS
View file

@ -62,7 +62,7 @@ You can keep the old behavior by putting '(xterm-mouse-mode -1)' in your
init file.
+++
** 'site-start.el' is now loaded before the user's early init file.
** site-start.el is now loaded before the user's early init file.
Previously, the order was early-init.el, site-start.el and then the
user's regular init file, but now site-start.el comes first. This
allows site administrators to customize things that can normally only be
@ -84,9 +84,9 @@ other directory on your system. You can also invoke the
+++
** 'line-spacing' now supports specifying spacing above the line.
Previously, only spacing below the line could be specified. The variable
can now be set to a cons cell to specify spacing both above and below
the line, which allows for vertically centering text.
Previously, only spacing below the line could be specified. The user
option can now be set to a cons cell to specify spacing both above and
below the line, which allows for vertically centering text.
+++
** 'prettify-symbols-mode' attempts to ignore undisplayable characters.
@ -726,6 +726,11 @@ If the value of 'project-mode-line' is 'non-remote', project name and
the Project menu will be shown on the mode line only for projects with
local files.
*** The "VC-aware" project backend caches the current project and its name.
The duration for which the values are cached depends on whether it's
called from 'non-essential' context, and it determined by variables
'project-vc-cache-timeout' and 'project-vc-non-essential-cache-timeout'.
** Help
+++
@ -853,10 +858,10 @@ Northern Iroquoian language family: 'mohawk-postfix' (Mohawk
[Kanien’kéha / Kanyen’kéha / Onkwehonwehnéha]), 'oneida-postfix' (Oneida
[Onʌyote’a·ká· / Onyota’a:ká: / Ukwehuwehnéha]), 'cayuga-postfix'
(Cayuga [Gayogo̱ho:nǫhnéha:ˀ]), 'onondaga-postfix' (Onondaga
[Onųdaʔgegáʔ]), and 'seneca-postfix' (Seneca [Onödowá’ga:’]).
Additionally, there is a general-purpose 'haudenosaunee-postfix' input
method to facilitate writing in the orthographies of the five languages
simultaneously.
[Onųdaʔgegáʔ]), 'seneca-postfix' (Seneca [Onödowá’ga:’]), and
'tuscarora-postfix' (Tuscarora [Skarù·ręʔ]). Additionally, there is a
general-purpose 'haudenosaunee-postfix' input method to facilitate
writing in the orthographies of the six languages simultaneously.
---
*** New input methods for languages based on Burmese.
@ -1410,7 +1415,7 @@ is non-nil, this suffix is fontified using 'font-lock-type-face'.
---
*** New user option 'yaml-ts-mode-yamllint-options'.
Additional options for 'yamllint' the command used for Flymake's YAML
Additional options for 'yamllint', the command used for Flymake's YAML
support.
** EIEIO
@ -1782,6 +1787,14 @@ response.
It is believed to no longer be useful as a method to fight spam. The
'spam-use-hashcash' hook is now obsolete and has no effect.
---
*** Add 'M-i' keybinding as the symbolic prefix in the group keymap.
The symbolic prefix is another kind of universal prefix that is used in
Gnus, see "(gnus) Symbolic Prefixes" in the Gnus manual.
---
*** Sorting selected groups is now possible with 'gnus-topic-mode'.
** Sieve
+++
@ -2087,6 +2100,11 @@ for docstrings where symbols 'nil' and 't' are in quotes.
In most cases, having it enabled leads to a large amount of false
positives.
---
*** New function 'checkdoc-batch'.
It checks the buffer in batch mode, prints all found errors
and signals the first found error.
*** New file-local variable 'lisp-indent-local-overrides'.
This variable can be used to locally override the indent specification
of symbols.
@ -2164,6 +2182,12 @@ To unconditionally enable 'flyspell-mode' from a hook, use this instead:
** Tramp
+++
*** Tramp signals 'remote-file-error' in case of connection problems.
This is a subcategory of 'file-error'. Therefore, all checks for
'file-error' in 'condition-case', 'ignore-error', 'error-conditions' and
alike still work.
+++
*** New command 'tramp-cleanup-bufferless-connections'.
Connection-related objects for which no associated buffers exist, except
@ -2279,15 +2303,19 @@ one as before. This makes them different from 'vc-diff' and
*** 'diff-apply-hunk' now supports creating and deleting files.
+++
*** 'diff-apply-hunk' and 'diff-apply-buffer' now consider the region.
If the region is active, these commands now apply all hunks that the
region overlaps. Otherwise, they have their existing behavior.
*** Diff mode's application and killing commands now consider the region.
If the region is active, 'diff-apply-hunk', 'diff-apply-buffer' and
'diff-hunk-kill' now apply or kill all hunks that the region overlaps.
Otherwise, they have their existing behavior.
+++
*** 'diff-apply-buffer' can reverse-apply.
With a prefix argument, it now reverse-applies hunks.
This matches the existing prefix argument to 'diff-apply-hunk'.
---
*** 's' is now bound to 'diff-split-hunk' in read-only Diff mode buffers.
** Ediff
+++
@ -2499,6 +2527,12 @@ When point is between indentation, the command
deletes the text in the region and deactivates the mark if Transient
Mark mode is enabled, the mark is active, and prefix argument is 1.
---
*** 'python-eldoc-function-timeout' now accepts floating-point numbers.
To allow for finer-grained adjustment of timeout for
'python-eldoc-function', 'python-eldoc-function-timeout' now accepts
floating-point numbers as well as integers.
** Tmm Menubar
---
@ -2620,7 +2654,7 @@ When the argument is non-nil, the function switches to a buffer visiting
the directory into which the repository was cloned.
+++
*** 'vc-revert' is now bound to '@' in VC-Dir.
*** 'vc-revert' is now bound to '@' in VC Directory.
+++
*** 'vc-revert' is now additionally bound to 'C-x v @'.
@ -2762,7 +2796,7 @@ base with the remote branch, including uncommitted changes.
('vc-root-log-outgoing-base') show the corresponding revision logs.
These are useful to view all outstanding (unmerged, unpushed) changes on
the current branch. They are also available as 'T =', 'T D', 'T l' and
'T L' in VC-Dir buffers.
'T L' in VC Directory buffers.
+++
*** New user option 'vc-use-incoming-outgoing-prefixes'.
@ -2876,6 +2910,13 @@ This command is Diff mode's specialized 'narrow-to-region'.
consistency, 'diff-restrict-view' is now too.
To enable it again, use 'M-x enable-command'.
---
*** 'C-x v !' has its own input history.
---
*** 'C-u C-x v +' and 'C-u C-x v P' for Git have an input history.
This was already in place for Mercurial.
** Package
+++
@ -2947,6 +2988,17 @@ The package review can include reading the downloaded source code,
presenting a diff between the downloaded code and a previous
installation or displaying a ChangeLog.
+++
*** New command 'package-autosuggest'
Using a built-in database of package suggestions from ELPA, this command
will install viable packages if no specific major mode is available.
+++
*** New minor mode 'package-autosuggest-mode'
When enabled, this displays a hint in the mode line indicating the
availability of a suggested package. You can customise the presentation
of these hints using 'package-autosuggest-style'.
** Rcirc
+++
@ -3057,9 +3109,19 @@ Meant to be given a global binding convenient to the user. Example:
** Icomplete
*** New key 'M-j' for 'icomplete-mode' and 'icomplete-vertical-mode'.
Like 'M-j' in 'fido-mode', it can exit the minibuffer with a selected
candidate even when 'icomplete-show-matches-on-no-input' is non-nil.
*** Change in meaning of 'icomplete-show-matches-on-no-input' (again).
For Emacs 28 to Emacs 30, when 'icomplete-show-matches-on-no-input' was
non-nil, 'RET' had special behavior when the minibuffer's contents was
equal to the initial input it had right after minibuffer activation.
In that case, 'RET' would choose the first completion candidate, if
there was one, instead of the minibuffer's default value.
'RET' has now returned to selecting the default value in this case; you
can use 'C-j' to choose the completion under point instead.
You can opt back in to the special behavior of 'RET' like this:
(keymap-set
icomplete-minibuffer-map "<remap> <minibuffer-complete-and-exit>"
#'icomplete-ret)
*** New user options for 'icomplete-vertical-mode'.
New user options have been added to enhance 'icomplete-vertical-mode':
@ -3303,6 +3365,34 @@ The user options 'calendar-mark-holidays-flag' and
'calendar-mark-diary-entries-flag' are not modified anymore when
changing the marking state in the calendar buffer.
*** New library for iCalendar data.
A new library has been added to the calendar for handling iCalendar
(RFC5545) data. The library is designed for reuse in other parts of
Emacs and in third-party packages. Package authors can find the new
library in the Emacs distribution under "lisp/calendar/icalendar-*.el".
Most of the functions and variables in the older icalendar.el have been
marked obsolete and now suggest appropriate replacements from the new
library. diary-icalendar.el provides replacements for the diary-related
features from icalendar.el; see below.
** Diary
*** New user option 'diary-date-insertion-form'.
This user option determines how dates are inserted into the diary by
Lisp functions. Its value is a pseudo-pattern of the same type as in
'diary-date-forms'. It is used by 'diary-insert-entry' when inserting
entries from the calendar, or when importing them from other formats.
+++
*** New library 'diary-icalendar'.
This library reimplements features previously provided by icalendar.el:
import from iCalendar format to the diary, and export from the diary to
iCalendar. It also adds the ability to include iCalendar files in the
diary and display and mark their contents in the calendar without
importing them to the diary file. The library uses the new iCalendar
library (see above) and makes diary import and export more customizable.
** Calc
*** New user option 'calc-string-maximum-character'.
@ -3329,6 +3419,11 @@ each refresh. The sort direction can be controlled by using a cons cell
of a format string and a boolean. Alternatively, a sorting function can
be provided directly.
---
*** New user option 'display-time-help-echo-format'.
This option controls the format of the help echo when hovering over the
time.
** Fill
+++
@ -3467,9 +3562,25 @@ value. Previously, only 'hi-lock-face-buffer' supported this.
*** 'shadow-info-buffer' and 'shadow-todo-buffer' use ephemeral buffer names now.
** Display Battery mode
---
*** UPower battery status can update automatically without polling.
On systems where the user option 'battery-status-function' is set to
'battery-upower', it is now possible to get battery status updates on
the mode line without polling for changes every
'battery-update-interval' seconds. Setting this user option to nil
means the mode line will update only when the battery power state,
percentage, or presence in the bay changes.
* New Modes and Packages in Emacs 31.1
** New major mode 'icalendar-mode'.
A major mode for displaying and editing iCalendar (RFC5545) data. This
mode handles line unfolding and fontification, including highlighting
syntax errors in invalid data.
** New minor mode 'delete-trailing-whitespace-mode'.
A simple buffer-local mode that runs 'delete-trailing-whitespace'
before saving the buffer.
@ -3516,6 +3627,23 @@ On GNU/Linux systems, shell extensions or similar helpers such as
<https://extensions.gnome.org/extension/307/dash-to-dock/> and
<https://wiki.ubuntu.com/Unity/LauncherAPI>.
+++
** New package 'system-sleep'.
This package provides platform-neutral interfaces to block your system
from entering idle sleep and a hook to process pre-sleep and post-wake
events. You can use this to avoid the system entering an idle sleep
state and interrupting a long-running process due to lack of user
activity. The sleep event hook lets you, for example, close external
connections or serial ports before sleeping, and reestablish them when
the system wakes up.
Supported capable systems are GNU/Linux via D-Bus (sleep blocking and
sleep events require the org.freedesktop.login1 service, display sleep
blocking requires org.freedesktop.Screensaver service), macOS
(sleep/display blocking requires version 10.9 or later, sleep events are
supported on all versions), MS-Windows (sleep blocking is supported on
all versions, sleep events require Windows 8 or later).
* Incompatible Lisp Changes in Emacs 31.1
@ -3676,6 +3804,20 @@ display time or even cause Emacs to hang trying to display such a face.
Affected APIs include 'defface', 'set-face-attribute', their callers,
and other similar functions.
---
** 'help-setup-xref' now re-enables the major mode of the Help buffer.
As a result, in many cases the buffer will be read-only afterwards.
This should not cause any trouble as long as the actual buffer
modification takes place inside 'with-help-window' or
'with-output-to-temp-buffer' after the call to 'help-setup-xref'.
---
** Xref commands don't automatically suggest to visit a tags table anymore.
When no tags file is loaded, symbol completion just won't provide any
suggestions. So the 'M-?' command now works without a tags table. And
the 'M-.' will show a message describing the several built-in options
that will provide an Xref backend when used.
* Lisp Changes in Emacs 31.1
@ -3824,11 +3966,13 @@ and 'dbus-call-method-asynchronously' to allow the user to interactively
authorize the invoked D-Bus method (for example via polkit).
+++
*** New D-Bus functions to support systemd inhibitor locks.
The functions 'dbus-make-inhibitor-lock', 'dbus-close-inhibitor-lock'
and 'dbus-registered-inhibitor-locks' implement acquiring and releasing
systemd inhibitor locks. See the Info node "(dbus) Inhibitor Locks" for
details.
*** Support D-Bus file descriptor manipulation.
A new ':keep-fd' parameter has been added to 'dbus-call-method' and
'dbus-call-method-asynchronously' to instruct D-Bus to keep a file
descriptor, which has been returned by a method call, internally. The
functions 'dbus--fd-open', 'dbus--fd-close' and 'dbus--registered-fds'
implement managing these file descriptors. See the Info node "(dbus)
File Descriptors" for details.
** The customization group 'wp' has been removed.
It has been obsolete since Emacs 26.1. Use the group 'text' instead.
@ -3838,6 +3982,14 @@ It has been obsolete since Emacs 26.1. Use the group 'text' instead.
If supplied, 'string-pixel-width' will use any face remappings from
BUFFER when computing the string's width.
+++
** New function 'truncate-string-pixelwise'.
This function truncates a string to the specified maximum number of
pixels rather than by characters, as in 'truncate-string-to-width', and
respects face remappings if BUFFER is specified. You can also specify
an optional ellipsis string to append, similar to
'truncate-string-to-width'.
---
** New macro 'with-work-buffer'.
This macro is similar to the already existing macro 'with-temp-buffer',

205
etc/package-autosuggest.eld Normal file
View file

@ -0,0 +1,205 @@
;; The contents of this file are loaded into `package--autosuggest-database'.
;; were automatically generate by scraping ELPA for auto-loaded
;; code using the `scrape-elpa' command from admin/scrape-elpa.el. Please do not
;; update this file manually!
(
(a68-mode auto-mode-alist "\\.a68\\'")
(ada-mode auto-mode-alist "\\.ad[abs]\\'")
(arbitools auto-mode-alist "\\.trf?\\'" arbitools-mode)
(auctex auto-mode-alist "\\.hva\\'" LaTeX-mode)
(bnf-mode auto-mode-alist "\\.bnf\\'")
(chess auto-mode-alist "\\.pgn\\'" chess-pgn-mode)
(cobol-mode auto-mode-alist "\\.c\\(ob\\|bl\\|py\\)\\'")
(code-cells auto-mode-alist "\\.ipynb\\'" code-cells-convert-ipynb)
(csharp-mode auto-mode-alist "\\.cs\\'")
(csv-mode auto-mode-alist "\\.[Cc][Ss][Vv]\\'")
(csv-mode auto-mode-alist "\\.tsv\\'" tsv-mode)
(dicom auto-mode-alist "\\.\\(?:dcm\\|ima\\)\\'" dicom-auto-mode)
(dicom auto-mode-alist "DICOMDIR" dicom-auto-mode)
(dismal auto-mode-alist "\\.dis\\'" dismal-mode)
(djvu auto-mode-alist "\\.djvu\\'" djvu-init-mode)
(dts-mode auto-mode-alist "\\.dtsi?\\'")
(ess auto-mode-alist "\\.[Bb][Uu][Gg]\\'" ess-bugs-mode)
(ess auto-mode-alist "\\.[Bb][Oo][Gg]\\'" ess-bugs-mode)
(ess auto-mode-alist "\\.[Bb][Mm][Dd]\\'" ess-bugs-mode)
(ess auto-mode-alist "\\.[Jj][Aa][Gg]\\'" ess-jags-mode)
(ess auto-mode-alist "/R/.*\\.q\\'" ess-r-mode)
(ess auto-mode-alist "\\.[rR]\\'" ess-r-mode)
(ess auto-mode-alist "\\.[rR]profile\\'" ess-r-mode)
(ess auto-mode-alist "NAMESPACE\\'" ess-r-mode)
(ess auto-mode-alist "CITATION\\'" ess-r-mode)
(ess auto-mode-alist "\\.[Rr]out\\'" ess-r-transcript-mode)
(ess interpreter-mode-alist "Rscript" ess-r-mode)
(ess interpreter-mode-alist "r" ess-r-mode)
(ess auto-mode-alist "/Makevars\\(\\.win\\)?\\'" makefile-mode)
(ess auto-mode-alist "DESCRIPTION\\'" conf-colon-mode)
(ess auto-mode-alist "\\.Rd\\'" Rd-mode)
(ess auto-mode-alist "\\.[Ss]t\\'" S-transcript-mode)
(ess auto-mode-alist "\\.Sout\\'" S-transcript-mode)
(ess auto-mode-alist "\\.[Ss][Aa][Ss]\\'" SAS-mode)
(gle-mode auto-mode-alist "\\.gle\\'")
(gpr-mode auto-mode-alist "\\.gpr\\'")
(html5-schema auto-mode-alist "\\.html?\\'" nxml-mode)
(idlwave auto-mode-alist "\\.pro\\'" idlwave-mode)
(jgraph-mode auto-mode-alist "\\.jgr\\'")
(json-mode auto-mode-alist "\\.json\\'")
(lmc auto-mode-alist "\\.elmc\\'" lmc-asm-mode)
(matlab-mode auto-mode-alist "\\.tlc\\'" tlc-mode)
(muse auto-mode-alist "\\.muse\\'" muse-mode-choose-mode)
(auctex auto-mode-alist "\\.drv\\'" latex-mode)
(auctex auto-mode-alist "\\.dtx\\'" doctex-mode)
(nftables-mode auto-mode-alist "\\.nft\\(?:ables\\)?\\'")
(nftables-mode auto-mode-alist "/etc/nftables.conf")
(nftables-mode interpreter-mode-alist "nft\\(?:ables\\)?")
(omn-mode auto-mode-alist "\\.pomn\\'")
(omn-mode auto-mode-alist "\\.omn\\'")
(poke-mode auto-mode-alist "\\.pk\\'")
(pspp-mode auto-mode-alist "\\.sps\\'")
(python auto-mode-alist "\\(?:\\.\\(?:p\\(?:th\\|y[iw]?\\)\\)\\|/\\(?:SCons\\(?:\\(?:crip\\|truc\\)t\\)\\)\\)\\'" python-mode)
(python interpreter-mode-alist "python[0-9.]*" python-mode)
(python auto-mode-alist "/\\(?:Pipfile\\|\\.?flake8\\)\\'" conf-mode)
(rec-mode auto-mode-alist "\\.rec\\'")
(rnc-mode auto-mode-alist "\\.rnc\\'")
(sed-mode auto-mode-alist "\\.sed\\'")
(sed-mode interpreter-mode-alist "sed")
(shen-mode auto-mode-alist "\\.shen\\'")
(show-font auto-mode-alist "\\.\\(ttf\\|otf\\)\\'" show-font-mode)
(sisu-mode auto-mode-alist "\\.ss[imt]\\'")
(smalltalk-mode auto-mode-alist "\\.st\\'")
(smalltalk-mode auto-mode-alist "\\.star\\'" archive-mode)
(sml-mode auto-mode-alist "\\.s\\(ml\\|ig\\)\\'")
(sml-mode auto-mode-alist "\\.cm\\'" sml-cm-mode)
(sml-mode auto-mode-alist "\\.grm\\'" sml-yacc-mode)
(sql-cassandra auto-mode-alist "\\.cql\\'" sql-mode)
(sxhkdrc-mode auto-mode-alist "sxhkdrc\\'")
(systemd auto-mode-alist "\\.automount\\'" systemd-automount-mode)
(systemd auto-mode-alist "\\.mount\\'" systemd-mount-mode)
(systemd auto-mode-alist "\\.path\\'" systemd-path-mode)
(systemd auto-mode-alist "\\.service\\'" systemd-service-mode)
(systemd auto-mode-alist "\\.socket\\'" systemd-socket-mode)
(systemd auto-mode-alist "\\.swap\\'" systemd-swap-mode)
(systemd auto-mode-alist "\\.timer\\'" systemd-timer-mode)
(vcard auto-mode-alist "\\.[Vv][Cc][Ff]\\'" vcard-mode)
(vcl-mode auto-mode-alist "\\.vcl\\'")
(wisi auto-mode-alist "\\.parse_table.*\\'" wisitoken-parse_table-mode)
(wisitoken-grammar-mode auto-mode-alist "\\.wy\\'" simple-indent-mode)
(wisitoken-grammar-mode auto-mode-alist "\\.wy\\'")
(adoc-mode auto-mode-alist "\\.a\\(?:scii\\)?doc\\'")
(apache-mode auto-mode-alist "/\\.htaccess\\'")
(apache-mode auto-mode-alist "/\\(?:access\\|httpd\\|srm\\)\\.conf\\'")
(apache-mode auto-mode-alist "/apache2/.+\\.conf\\'")
(apache-mode auto-mode-alist "/httpd/conf/.+\\.conf\\'")
(apache-mode auto-mode-alist "/apache2/sites-\\(?:available\\|enabled\\)/")
(arduino-mode auto-mode-alist "\\.pde\\'")
(arduino-mode auto-mode-alist "\\.ino\\'")
(beancount auto-mode-alist "\\.beancount\\'" beancount-mode)
(bison-mode auto-mode-alist "\\.y\\'")
(bison-mode auto-mode-alist "\\.l\\'" flex-mode)
(bison-mode auto-mode-alist "\\.jison\\'" jison-mode)
(bqn-mode auto-mode-alist "\\.bqn\\'")
(bqn-mode interpreter-mode-alist "bqn")
(clojure-mode auto-mode-alist "\\.\\(clj\\|cljd\\|dtm\\|edn\\|lpy\\)\\'")
(clojure-mode auto-mode-alist "\\.cljc\\'" clojurec-mode)
(clojure-mode auto-mode-alist "\\.cljs\\'" clojurescript-mode)
(clojure-mode auto-mode-alist "\\(?:build\\|profile\\)\\.boot\\'")
(clojure-mode interpreter-mode-alist "bb")
(clojure-mode interpreter-mode-alist "nbb" clojurescript-mode)
(coffee-mode auto-mode-alist "\\.coffee\\'")
(coffee-mode auto-mode-alist "\\.iced\\'")
(coffee-mode auto-mode-alist "Cakefile\\'")
(coffee-mode auto-mode-alist "\\.cson\\'")
(coffee-mode interpreter-mode-alist "coffee")
(d-mode auto-mode-alist "\\.d[i]?\\'")
(dart-mode auto-mode-alist "\\.dart\\'")
(dockerfile-mode auto-mode-alist "[/\\]\\(?:Containerfile\\|Dockerfile\\)\\(?:\\.[^/\\]*\\)?\\'")
(dockerfile-mode auto-mode-alist "\\.dockerfile\\'")
(drupal-mode auto-mode-alist "[^/]\\.\\(module\\|test\\|install\\|profile\\|tpl\\.php\\|theme\\|inc\\)\\'" php-mode)
(drupal-mode auto-mode-alist "[^/]\\.info\\'" conf-windows-mode)
(drupal-mode auto-mode-alist "[^/]\\.make\\'" drush-make-mode)
(editorconfig auto-mode-alist "\\.editorconfig\\'" editorconfig-conf-mode)
(elixir-mode auto-mode-alist "\\.elixir\\'")
(elixir-mode auto-mode-alist "\\.ex\\'")
(elixir-mode auto-mode-alist "\\.exs\\'")
(elixir-mode auto-mode-alist "mix\\.lock")
(ett auto-mode-alist "\\.ett\\'" ett-mode)
(forth-mode auto-mode-alist "\\.\\(f\\|fs\\|fth\\|4th\\)\\'")
(geiser-racket auto-mode-alist "\\.rkt\\'" scheme-mode)
(gnu-apl-mode auto-mode-alist "\\.apl\\'")
(gnu-apl-mode interpreter-mode-alist "apl")
(go-mode auto-mode-alist "\\.go\\'")
(go-mode auto-mode-alist "go\\.mod\\'" go-dot-mod-mode)
(go-mode auto-mode-alist "go\\.work\\'" go-dot-work-mode)
(graphql-mode auto-mode-alist "\\.graphql\\'")
(graphql-mode auto-mode-alist "\\.gql\\'")
(haml-mode auto-mode-alist "\\.haml\\'")
(haskell-mode auto-mode-alist "\\.hcr\\'" ghc-core-mode)
(haskell-mode auto-mode-alist "\\.dump-simpl\\'" ghc-core-mode)
(haskell-mode auto-mode-alist "\\.ghci\\'" ghci-script-mode)
(haskell-mode auto-mode-alist "\\.chs\\'" haskell-c2hs-mode)
(haskell-mode auto-mode-alist "\\.cabal\\'\\|/cabal\\.project\\|/\\.cabal/config\\'" haskell-cabal-mode)
(haskell-mode auto-mode-alist "\\.[gh]s\\'")
(haskell-mode auto-mode-alist "\\.hsig\\'")
(haskell-mode auto-mode-alist "\\.l[gh]s\\'" haskell-literate-mode)
(haskell-mode auto-mode-alist "\\.hsc\\'")
(haskell-mode interpreter-mode-alist "runghc")
(haskell-mode interpreter-mode-alist "runhaskell")
(haskell-tng-mode auto-mode-alist "\\.hs\\'")
(j-mode auto-mode-alist "\\.ij[rsp]$")
(j-mode auto-mode-alist "\\.ijt$" j-lab-mode)
(jade-mode auto-mode-alist "\\.jade\\'")
(jade-mode auto-mode-alist "\\.pug\\'")
(jade-mode auto-mode-alist "\\.styl\\'" stylus-mode)
(jinja2-mode auto-mode-alist "\\.jinja2\\'")
(jinja2-mode auto-mode-alist "\\.j2\\'")
(julia-mode auto-mode-alist "\\.jl\\'")
(lua-mode auto-mode-alist "\\.lua\\'")
(lua-mode interpreter-mode-alist "lua")
(magit-section auto-mode-alist "/git-rebase-todo\\'" git-rebase-mode)
(magit auto-mode-alist "/git-rebase-todo\\'" git-rebase-mode)
(markdown-mode auto-mode-alist "\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'")
(nginx-mode auto-mode-alist "nginx\\.conf\\'")
(nginx-mode auto-mode-alist "/nginx/.+\\.conf\\'")
(nix-mode auto-mode-alist "^/nix/store/.+\\.drv\\'" nix-drv-mode)
(nix-mode auto-mode-alist "\\flake.lock\\'" js-mode)
(nix-mode auto-mode-alist "\\.nix\\'")
(php-mode interpreter-mode-alist "php\\(?:-?[34578]\\(?:\\.[0-9]+\\)*\\)?")
(php-mode auto-mode-alist "/\\.php_cs\\(?:\\.dist\\)?\\'")
(php-mode auto-mode-alist "\\.\\(?:php\\.inc\\|stub\\)\\'")
(php-mode auto-mode-alist "\\.\\(?:php[s345]?\\|phtml\\)\\'" php-mode-maybe)
(proof auto-mode-alist "\\.v\\'" coq-mode)
(racket-mode auto-mode-alist "\\.rkt\\'")
(racket-mode auto-mode-alist "\\.rktd\\'")
(racket-mode auto-mode-alist "\\.rktl\\'")
(racket-mode interpreter-mode-alist "racket")
(raku-mode interpreter-mode-alist "perl6\\|raku")
(raku-mode auto-mode-alist "\\.p[lm]?6\\'")
(raku-mode auto-mode-alist "\\.nqp\\'")
(raku-mode auto-mode-alist "\\.raku\\(?:mod\\|test\\)?\\'")
(rfc-mode auto-mode-alist "/rfc[0-9]+\\.txt\\'")
(rust-mode auto-mode-alist "\\.rs\\'")
(sass-mode auto-mode-alist "\\.sass\\'")
(scad-mode auto-mode-alist "\\.scad\\'")
(scala-mode auto-mode-alist "\\.\\(scala\\|sbt\\|worksheet\\.sc\\)\\'")
(stylus-mode auto-mode-alist "\\.jade\\'" jade-mode)
(stylus-mode auto-mode-alist "\\.pug\\'" jade-mode)
(stylus-mode auto-mode-alist "\\.styl\\'")
(subed auto-mode-alist "\\.ass\\'" subed-ass-mode)
(subed auto-mode-alist "\\.srt\\'" subed-srt-mode)
(subed auto-mode-alist "\\.vtt\\'" subed-vtt-mode)
(swift-mode auto-mode-alist "\\.swift\\(interface\\)?\\'")
(systemd auto-mode-alist "\\.nspawn\\'" systemd-mode)
(systemd auto-mode-alist "[.0-9@-Z\\_a-z-]+?\\.\\(?:automount\\|busname\\|link\\|mount\\|net\\(?:dev\\|work\\)\\|s\\(?:ervice\\|lice\\|ocket\\|wap\\)\\|t\\(?:arget\\|imer\\)\\)\\'" systemd-mode)
(systemd auto-mode-alist "\\.#\\(?:[.0-9@-Z\\_a-z-]+?\\.\\(?:automount\\|busname\\|link\\|mount\\|net\\(?:dev\\|work\\)\\|s\\(?:ervice\\|lice\\|ocket\\|wap\\)\\|t\\(?:arget\\|imer\\)\\)\\|override\\.conf\\)[[:xdigit:]]\\{16\\}\\'" systemd-mode)
(systemd auto-mode-alist "/systemd/[^z-a]+?\\.d/[^/]+?\\.conf\\'" systemd-mode)
(tuareg auto-mode-alist "\\.ml[ip]?\\'" tuareg-mode)
(tuareg auto-mode-alist "\\.eliomi?\\'" tuareg-mode)
(tuareg interpreter-mode-alist "ocamlrun" tuareg-mode)
(tuareg interpreter-mode-alist "ocaml" tuareg-mode)
(tuareg auto-mode-alist "\\.mly\\'" tuareg-menhir-mode)
(tuareg auto-mode-alist "[./]opam_?\\'" tuareg-opam-mode)
(typescript-mode auto-mode-alist "\\.ts\\'")
(yaml-mode auto-mode-alist "\\.\\(e?ya?\\|ra\\)ml\\'")
(yaml-mode magic-mode-alist "^%YAML\\s-+[0-9]+\\.[0-9]+\\(\\s-+#\\|\\s-*$\\)")
(zig-mode auto-mode-alist "\\.\\(zig\\|zon\\)\\'")
)

2
etc/symbol-releases.eld
View file

@ -9,6 +9,8 @@
;; TYPE being `fun' or `var'.
(
("31.1" fun any)
("31.1" fun all)
("30.1" fun dired-click-to-select-mode)
("30.1" var dired-click-to-select-mode)
("29.1" fun plistp)

1
etc/tutorials/TUTORIAL.translators
View file

@ -31,6 +31,7 @@ Maintainer: Rafael Sepúlveda <drs@gnulinux.org.mx>
* TUTORIAL.el_GR:
Author: Protesilaos Stavrou <info@protesilaos.com>
Maintainer: Protesilaos Stavrou <info@protesilaos.com>
Basil L. Contovounesios <basil@contovou.net>
* TUTORIAL.fa:
Author: Mohsen BANAN <emacs@mohsen.1.banan.byname.net>

40
lisp/align.el
View file

@ -1407,11 +1407,18 @@ aligner would have dealt with are."
(align-region
beg end 'entire
exclude-rules nil
;; Use markers for exclusion area bounds so
;; they remain accurate after subsequent
;; alignment sections modify the buffer.
(lambda (b e mode)
(or (and mode (listp mode))
(let ((bm (copy-marker b))
(em (copy-marker e t)))
(push bm markers)
(push em markers)
(setq exclude-areas
(cons (cons b e)
exclude-areas)))))
(cons (cons bm em)
exclude-areas))))))
(setq exclude-areas
(nreverse
(sort exclude-areas #'car-less-than-car))))
@ -1458,14 +1465,17 @@ aligner would have dealt with are."
(setq same nil)
(align--set-marker eol (line-end-position)))
;; remember the beginning position of this rule
;; match, and save the match-data, since either
;; the `valid' form, or the code that searches for
;; section separation, might alter it
(setq rule-beg (match-beginning first)
save-match-data (match-data))
;; Remember the beginning position of this rule
;; match as a marker so it remains accurate after
;; `align-regions' modifies the buffer for a
;; previous alignment section. Also save the
;; match-data, since either the `valid' form, or
;; the code that searches for section separation,
;; might alter it.
(align--set-marker rule-beg (match-beginning first) t)
(setq save-match-data (match-data))
(or rule-beg
(or (marker-position rule-beg)
(error "No match for subexpression %s" first))
;; unless the `valid' attribute is set, and tells
@ -1480,6 +1490,18 @@ aligner would have dealt with are."
(when (and last-point
(align-new-section-p last-point rule-beg
thissep))
;; Convert saved match-data positions to
;; markers before `align-regions' modifies
;; the buffer, so the restored match-data
;; reflects the updated buffer state.
(setq save-match-data
(mapcar (lambda (pos)
(if (integerp pos)
(let ((m (copy-marker pos)))
(push m markers)
m)
pos))
save-match-data))
(align-regions regions align-props rule func)
(setq regions nil)
(setq align-props nil))

55
lisp/battery.el
View file

@ -207,8 +207,14 @@ The full `format-spec' formatting syntax is supported."
:type '(choice string (const nil)))
(defcustom battery-update-interval 60
"Seconds after which the battery status will be updated."
:type 'integer)
"Seconds after which the battery status will be updated.
A value of nil means do not poll for battery status changes.
This can be useful when `battery-status-function' is set to
`battery-upower' and `battery-upower-subscribe' is non-nil, in
which case D-Bus automatically signals battery status changes."
:version "31.1"
:type '(choice (const :tag "Never" nil)
(integer :tag "Number of seconds")))
(defcustom battery-load-low 25
"Upper bound of low battery load percentage.
@ -305,8 +311,9 @@ trigger actions based on battery-related events."
(and (eq battery-status-function #'battery-upower)
battery-upower-subscribe
(battery--upower-subscribe))
(setq battery-update-timer (run-at-time nil battery-update-interval
#'battery-update-handler))
(when battery-update-interval
(setq battery-update-timer (run-at-time nil battery-update-interval
#'battery-update-handler)))
(battery-update))
(message "Battery status not available")
(setq display-battery-mode nil)))
@ -772,17 +779,37 @@ See URL `https://upower.freedesktop.org/docs/Device.html'.")
(defconst battery-upower-device-path "/org/freedesktop/UPower/devices"
"D-Bus object providing `battery-upower-device-interface'.")
(defconst battery-upower-display-device-path
"/org/freedesktop/UPower/devices/DisplayDevice"
"D-Bus object providing a subset of `battery-upower-device-interface'.
This is a composite device for displaying a digest of overall state.
In particular, it is not listed by the EnumerateDevices method.")
(defvar battery-upower-subscribe-properties
'(;; `battery-upower-path' properties.
"OnBattery"
;; `battery-upower-display-device-path' properties.
"State" "Percentage" "IsPresent")
"List of UPower device properties to listen for.
Each value is a string property of `battery-upower-path'
or `battery-upower-display-device-path'.
A D-Bus signal that any of them changed results in a `battery-update'.")
(defvar battery--upower-signals nil
"Handles for UPower signal subscriptions.")
(defun battery--upower-signal-handler (&rest _)
"Update battery status on receiving a UPower D-Bus signal."
(timer-event-handler battery-update-timer))
(if battery-update-timer
(timer-event-handler battery-update-timer)
(battery-update-handler)))
(defun battery--upower-props-changed (_interface changed _invalidated)
"Update status when system starts/stops running on battery.
"Update status when UPower device properties change.
Respond only to those in `battery-upower-subscribe-properties'.
Intended as a UPower PropertiesChanged signal handler."
(when (assoc "OnBattery" changed)
(when (any (lambda (prop) (assoc prop changed))
battery-upower-subscribe-properties)
(battery--upower-signal-handler)))
(defun battery--upower-unsubscribe ()
@ -792,12 +819,20 @@ Intended as a UPower PropertiesChanged signal handler."
(defun battery--upower-subscribe ()
"Subscribe to UPower device change signals."
;; Listen for OnBattery changes.
(push (dbus-register-signal :system battery-upower-service
battery-upower-path
dbus-interface-properties
"PropertiesChanged"
#'battery--upower-props-changed)
battery--upower-signals)
;; Listen for DisplayDevice property changes.
(push (dbus-register-signal :system battery-upower-service
battery-upower-display-device-path
dbus-interface-properties
"PropertiesChanged"
#'battery--upower-props-changed)
battery--upower-signals)
(dolist (method '("DeviceAdded" "DeviceRemoved"))
(push (dbus-register-signal :system battery-upower-service
battery-upower-path
@ -879,8 +914,10 @@ The following %-sequences are provided:
((and (eq type 1) (not (eq line-status 'online)))
;; It's a line power device: `online' if currently providing
;; power, any other non-nil value if simply present.
(setq line-status (if (cdr (assoc "Online" props)) 'online t)))
((and (eq type 2) (cdr (assoc "IsPresent" props)))
(setq line-status (or (not (cdr (assoc "Online" props))) 'online)))
((and (eq type 2)
(cdr (assoc "PowerSupply" props))
(cdr (assoc "IsPresent" props)))
;; It's a battery.
(setq count (1+ count))
(setq state (battery--upower-state props state))

30
lisp/calendar/appt.el
View file

@ -81,8 +81,7 @@
(defcustom appt-message-warning-time 12
"Default time in minutes before an appointment that the warning begins.
You probably want to make `appt-display-interval' a factor of this."
:type 'integer
:group 'appt)
:type 'integer)
(defcustom appt-warning-time-regexp "warntime \\([0-9]+\\)"
"Regexp matching a string giving the warning time for an appointment.
@ -92,13 +91,11 @@ You may want to put this inside a diary comment (see `diary-comment-start').
For example, to be warned 30 minutes in advance of an appointment:
2011/06/01 12:00 Do something ## warntime 30"
:version "24.1"
:type 'regexp
:group 'appt)
:type 'regexp)
(defcustom appt-audible t
"Non-nil means beep to indicate appointment."
:type 'boolean
:group 'appt)
:type 'boolean)
;; TODO - add popup.
(defcustom appt-display-format 'window
@ -112,7 +109,6 @@ See also `appt-audible' and `appt-display-mode-line'."
(const :tag "Separate window" window)
(const :tag "Echo-area" echo)
(const :tag "No visible display" nil))
:group 'appt
:version "24.1") ; no longer inherit from deleted obsolete variables
(defcustom appt-display-mode-line t
@ -120,21 +116,18 @@ See also `appt-audible' and `appt-display-mode-line'."
This is in addition to any other display of appointment messages.
The mode line updates every minute, independent of the value of
`appt-display-interval'."
:type 'boolean
:group 'appt)
:type 'boolean)
(defcustom appt-display-duration 10
"The number of seconds an appointment message is displayed.
Only relevant if reminders are to be displayed in their own window."
:type 'integer
:group 'appt)
:type 'integer)
(defcustom appt-display-diary t
"Non-nil displays the diary when the appointment list is first initialized.
This occurs when this package is first activated, and then at
midnight when the appointment list updates."
:type 'boolean
:group 'appt)
:type 'boolean)
(defcustom appt-display-interval 3
"Interval in minutes at which to display appointment reminders.
@ -146,8 +139,7 @@ a final message displayed precisely when the appointment is due.
Note that this variable controls the interval at which
`appt-display-message' is called. The mode line display (if active)
always updates every minute."
:type 'integer
:group 'appt)
:type 'integer)
(defcustom appt-disp-window-function #'appt-disp-window
"Function called to display appointment window.
@ -156,14 +148,12 @@ It should take three string arguments: the number of minutes till
the appointment, the current time, and the text of the appointment.
Each argument may also be a list, if multiple appointments are
relevant at any one time."
:type 'function
:group 'appt)
:type 'function)
(defcustom appt-delete-window-function #'appt-delete-window
"Function called to remove appointment window and buffer.
Only relevant if reminders are being displayed in a window."
:type 'function
:group 'appt)
:type 'function)
(defface appt-notification
'((t :inherit mode-line-emphasis))
@ -602,7 +592,7 @@ Any appointments made with `appt-add' are not affected by this function."
(not (eq diary-number-of-entries 1))
(not (memq (car (last diary-list-entries-hook))
'(diary-sort-entries sort-diary-entries)))
(setq entry-list (sort entry-list 'diary-entry-compare)))
(setq entry-list (sort entry-list #'diary-entry-compare)))
;; Skip diary entries for dates before today.
(while (and entry-list
(calendar-date-compare

3
lisp/calendar/cal-bahai.el
View file

@ -368,8 +368,7 @@ Reads a year, month and day."
(month (cdr (assoc
(completing-read
"Bahá’í calendar month name: "
(mapcar 'list
(append calendar-bahai-month-name-array nil))
(append calendar-bahai-month-name-array nil)
nil t)
(calendar-make-alist calendar-bahai-month-name-array
1))))

33
lisp/calendar/cal-china.el
View file

@ -65,8 +65,7 @@
"Minutes difference between local standard time for Chinese calendar and UTC.
Default is for Beijing. This is an expression in `year' since it changed at
1928-01-01 00:00:00 from UT+7:45:40 to UT+8."
:type 'sexp
:group 'calendar-chinese)
:type 'sexp)
;; It gets eval'd.
;;;###autoload
@ -75,8 +74,7 @@ Default is for Beijing. This is an expression in `year' since it changed at
;; FIXME unused.
(defcustom calendar-chinese-location-name "Beijing"
"Name of location used for calculation of Chinese calendar."
:type 'string
:group 'calendar-chinese)
:type 'string)
(defcustom calendar-chinese-daylight-time-offset 0
;; The correct value is as follows, but the Chinese calendrical
@ -84,8 +82,7 @@ Default is for Beijing. This is an expression in `year' since it changed at
;; 60
"Minutes difference between daylight saving and standard time.
Default is for no daylight saving time."
:type 'integer
:group 'calendar-chinese)
:type 'integer)
(defcustom calendar-chinese-standard-time-zone-name
'(if (< year 1928)
@ -95,13 +92,11 @@ Default is for no daylight saving time."
This is an expression depending on `year' because it changed
at 1928-01-01 00:00:00 from `PMT' to `CST'."
:type 'sexp
:risky t
:group 'calendar-chinese)
:risky t)
(defcustom calendar-chinese-daylight-time-zone-name "CDT"
"Abbreviated name of daylight saving time zone used for Chinese calendar."
:type 'string
:group 'calendar-chinese)
:type 'string)
(defcustom calendar-chinese-daylight-saving-start nil
;; The correct value is as follows, but the Chinese calendrical
@ -113,8 +108,7 @@ at 1928-01-01 00:00:00 from `PMT' to `CST'."
Default is for no daylight saving time. See documentation of
`calendar-daylight-savings-starts'."
:type 'sexp
:risky t
:group 'calendar-chinese)
:risky t)
(defcustom calendar-chinese-daylight-saving-end nil
;; The correct value is as follows, but the Chinese calendrical
@ -124,25 +118,21 @@ Default is for no daylight saving time. See documentation of
Default is for no daylight saving time. See documentation of
`calendar-daylight-savings-ends'."
:type 'sexp
:risky t
:group 'calendar-chinese)
:risky t)
(defcustom calendar-chinese-daylight-saving-start-time 0
"Number of minutes after midnight that daylight saving time starts.
Default is for no daylight saving time."
:type 'integer
:group 'calendar-chinese)
:type 'integer)
(defcustom calendar-chinese-daylight-saving-end-time 0
"Number of minutes after midnight that daylight saving time ends.
Default is for no daylight saving time."
:type 'integer
:group 'calendar-chinese)
:type 'integer)
(defcustom calendar-chinese-celestial-stem
["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"]
"Prefixes used by `calendar-chinese-sexagesimal-name'."
:group 'calendar-chinese
:type '(vector (string :tag "Jia")
(string :tag "Yi")
(string :tag "Bing")
@ -157,7 +147,6 @@ Default is for no daylight saving time."
(defcustom calendar-chinese-terrestrial-branch
["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"]
"Suffixes used by `calendar-chinese-sexagesimal-name'."
:group 'calendar-chinese
:type '(vector (string :tag "Zi")
(string :tag "Chou")
(string :tag "Yin")
@ -188,7 +177,7 @@ The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
(with-suppressed-warnings ((lexical year))
(defvar year))
(let* ((year (calendar-extract-year (calendar-gregorian-from-absolute d)))
(calendar-time-zone (eval calendar-chinese-time-zone)) ; uses year
(calendar-time-zone (eval calendar-chinese-time-zone t)) ; uses year
(calendar-daylight-time-offset
calendar-chinese-daylight-time-offset)
(calendar-standard-time-zone-name
@ -212,7 +201,7 @@ The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
(with-suppressed-warnings ((lexical year))
(defvar year))
(let* ((year (calendar-extract-year (calendar-gregorian-from-absolute d)))
(calendar-time-zone (eval calendar-chinese-time-zone))
(calendar-time-zone (eval calendar-chinese-time-zone t))
(calendar-daylight-time-offset
calendar-chinese-daylight-time-offset)
(calendar-standard-time-zone-name

3
lisp/calendar/cal-coptic.el
View file

@ -148,8 +148,7 @@ Reads a year, month, and day."
(month (cdr (assoc-string
(completing-read
(format "%s calendar month name: " calendar-coptic-name)
(mapcar 'list
(append calendar-coptic-month-name-array nil))
(append calendar-coptic-month-name-array nil)
nil t)
(calendar-make-alist calendar-coptic-month-name-array
1)

49
lisp/calendar/cal-dst.el
View file

@ -46,8 +46,7 @@ current date apply to all years. This is faster, but not always
correct, since the dates of daylight saving transitions sometimes
change."
:type 'boolean
:version "22.1"
:group 'calendar-dst)
:version "22.1")
;;;###autoload
(put 'calendar-daylight-savings-starts 'risky-local-variable t)
@ -68,8 +67,7 @@ If it starts on the first Sunday in April, you would set it to
(calendar-nth-named-day 1 0 4 year)
If the locale never uses daylight saving time, set this to nil."
:type 'sexp
:group 'calendar-dst)
:type 'sexp)
;;;###autoload
(put 'calendar-daylight-savings-ends 'risky-local-variable t)
@ -85,8 +83,7 @@ For example, if daylight saving time ends on the last Sunday in October:
(calendar-nth-named-day -1 0 10 year)
If the locale never uses daylight saving time, set this to nil."
:type 'sexp
:group 'calendar-dst)
:type 'sexp)
;;; More defcustoms below.
@ -208,10 +205,12 @@ The result has the proper form for `calendar-daylight-savings-starts'."
;; we require an absolute date. The following is for efficiency.
(setq date (cond ((eq (car rule) #'calendar-nth-named-day)
(eval (cons #'calendar-nth-named-absday
(cdr rule))))
(cdr rule))
t))
((eq (car rule) #'calendar-gregorian-from-absolute)
(eval (cadr rule)))
(t (calendar-absolute-from-gregorian (eval rule)))))
(eval (cadr rule) t))
(t (calendar-absolute-from-gregorian
(eval rule t)))))
(or (equal (current-time-zone
(calendar-time-from-absolute date prevday-sec))
(current-time-zone
@ -226,7 +225,7 @@ The result has the proper form for `calendar-daylight-savings-starts'."
(car candidate-rules)))
;; TODO it might be better to extract this information directly from
;; the system timezone database. But cross-platform...?
;; the system timezone database. But cross-platform...?
;; See thread
;; https://lists.gnu.org/r/emacs-pretest-bug/2006-11/msg00060.html
(defun calendar-dst-find-data (&optional time)
@ -309,7 +308,9 @@ system knows:
UTC-DIFF is an integer specifying the number of minutes difference between
standard time in the current time zone and Coordinated Universal Time
(Greenwich Mean Time). A negative value means west of Greenwich.
DST-OFFSET is an integer giving the daylight saving time offset in minutes.
DST-OFFSET is an integer giving the daylight saving time offset in minutes
relative to UTC-DIFF. (That is, the total UTC offset during daylight saving
time is UTC-DIFF + DST-OFFSET minutes.)
STD-ZONE is a string giving the name of the time zone when no seasonal time
adjustment is in effect.
DST-ZONE is a string giving the name of the time zone when there is a seasonal
@ -339,15 +340,13 @@ it can't find."
(defcustom calendar-time-zone (or (car calendar-current-time-zone-cache) -300)
"Number of minutes difference between local standard time and UTC.
For example, -300 for New York City, -480 for Los Angeles."
:type 'integer
:group 'calendar-dst)
:type 'integer)
(defcustom calendar-daylight-time-offset
(or (cadr calendar-current-time-zone-cache) 60)
"Number of minutes difference between daylight saving and standard time.
If the locale never uses daylight saving time, set this to 0."
:type 'integer
:group 'calendar-dst)
:type 'integer)
(defcustom calendar-standard-time-zone-name
(if (eq calendar-time-zone-style 'numeric)
@ -360,8 +359,7 @@ If the locale never uses daylight saving time, set this to 0."
For example, \"-0500\" or \"EST\" in New York City."
:type 'string
:version "28.1"
:set-after '(calendar-time-zone-style)
:group 'calendar-dst)
:set-after '(calendar-time-zone-style))
(defcustom calendar-daylight-time-zone-name
(if (eq calendar-time-zone-style 'numeric)
@ -374,21 +372,18 @@ For example, \"-0500\" or \"EST\" in New York City."
For example, \"-0400\" or \"EDT\" in New York City."
:type 'string
:version "28.1"
:set-after '(calendar-time-zone-style)
:group 'calendar-dst)
:set-after '(calendar-time-zone-style))
(defcustom calendar-daylight-savings-starts-time
(or (nth 6 calendar-current-time-zone-cache) 120)
"Number of minutes after midnight that daylight saving time starts."
:type 'integer
:group 'calendar-dst)
:type 'integer)
(defcustom calendar-daylight-savings-ends-time
(or (nth 7 calendar-current-time-zone-cache)
calendar-daylight-savings-starts-time)
"Number of minutes after midnight that daylight saving time ends."
:type 'integer
:group 'calendar-dst)
:type 'integer)
(defun calendar-dst-starts (year)
@ -398,7 +393,7 @@ This function respects the value of `calendar-dst-check-each-year-flag'."
(cadr (calendar-dst-find-startend year))
(nth 4 calendar-current-time-zone-cache))))
(calendar-dlet ((year year))
(if expr (eval expr))))
(if expr (eval expr t))))
;; New US rules commencing 2007. https://www.iana.org/time-zones
(and (not (zerop calendar-daylight-time-offset))
(calendar-nth-named-day 2 0 3 year))))
@ -410,7 +405,7 @@ This function respects the value of `calendar-dst-check-each-year-flag'."
(nth 2 (calendar-dst-find-startend year))
(nth 5 calendar-current-time-zone-cache))))
(calendar-dlet ((year year))
(if expr (eval expr))))
(if expr (eval expr t))))
;; New US rules commencing 2007. https://www.iana.org/time-zones
(and (not (zerop calendar-daylight-time-offset))
(calendar-nth-named-day 1 0 11 year))))
@ -421,8 +416,8 @@ This function respects the value of `calendar-dst-check-each-year-flag'."
Fractional part of DATE is local standard time of day."
(calendar-dlet ((year (calendar-extract-year
(calendar-gregorian-from-absolute (floor date)))))
(let* ((dst-starts-gregorian (eval calendar-daylight-savings-starts))
(dst-ends-gregorian (eval calendar-daylight-savings-ends))
(let* ((dst-starts-gregorian (eval calendar-daylight-savings-starts t))
(dst-ends-gregorian (eval calendar-daylight-savings-ends t))
(dst-starts (and dst-starts-gregorian
(+ (calendar-absolute-from-gregorian
dst-starts-gregorian)

2
lisp/calendar/cal-french.el
View file

@ -344,7 +344,7 @@ Echo French Revolutionary date unless NOECHO is non-nil."
(calendar-absolute-from-gregorian
(calendar-current-date)))))))
(month-list
(mapcar 'list
(mapcar #'list
(append months
(if (calendar-french-leap-year-p year)
(mapcar #'calendar-french-trim-feast feasts)

7
lisp/calendar/cal-hebrew.el
View file

@ -238,7 +238,7 @@ Reads a year, month, and day."
(month (cdr (assoc-string
(completing-read
"Hebrew calendar month name: "
(mapcar 'list (append month-array nil))
(append month-array nil)
(if (= year 3761)
(lambda (x)
(let ((m (cdr
@ -691,7 +691,7 @@ from the cursor position."
(month (cdr (assoc-string
(completing-read
"Month of death (name): "
(mapcar 'list (append month-array nil))
(append month-array nil)
nil t)
(calendar-make-alist month-array 1) t)))
(last (calendar-last-day-of-month month year))
@ -1123,6 +1123,7 @@ use when highlighting the day in the calendar."
(declare-function solar-setup "solar" ())
(declare-function solar-sunrise-sunset "solar" (date))
(declare-function solar-time-string "solar" (time time-zone))
(defvar calendar-latitude)
(defvar calendar-longitude)
(defvar calendar-time-zone)
@ -1145,7 +1146,7 @@ use when highlighting the day in the calendar."
(if sunset
(cons mark (format
"%s Sabbath candle lighting"
(apply 'solar-time-string
(apply #'solar-time-string
(cons (- (car sunset)
(/ diary-hebrew-sabbath-candles-minutes
60.0))

20
lisp/calendar/cal-html.el
View file

@ -42,18 +42,15 @@
(defcustom cal-html-directory "~/public_html"
"Directory for HTML pages generated by cal-html."
:type 'string
:group 'calendar-html)
:type 'string)
(defcustom cal-html-print-day-number-flag nil
"Non-nil means print the day-of-the-year number in the monthly cal-html page."
:type 'boolean
:group 'calendar-html)
:type 'boolean)
(defcustom cal-html-year-index-cols 3
"Number of columns in the cal-html yearly index page."
:type 'integer
:group 'calendar-html)
:type 'integer)
(defcustom cal-html-day-abbrev-array calendar-day-abbrev-array
"Array of seven strings for abbreviated day names (starting with Sunday)."
@ -64,14 +61,12 @@
(string :tag "Wed")
(string :tag "Thu")
(string :tag "Fri")
(string :tag "Sat"))
:group 'calendar-html)
(string :tag "Sat")))
(defcustom cal-html-holidays t
"If non-nil, include holidays as well as diary entries."
:version "24.3"
:type 'boolean
:group 'calendar-html)
:type 'boolean)
(defcustom cal-html-css-default
(concat
@ -93,8 +88,7 @@
"</STYLE>\n\n")
"Default cal-html css style. You can override this with a \"cal.css\" file."
:type 'string
:version "24.3" ; added SPAN.HOLIDAY
:group 'calendar-html)
:version "24.3") ; Added SPAN.HOLIDAY.
;;; End customizable variables.
@ -317,7 +311,7 @@ There are 12/cols rows of COLS months each."
Characters are replaced according to `cal-html-html-subst-list'."
(if (stringp string)
(replace-regexp-in-string
(regexp-opt (mapcar 'car cal-html-html-subst-list))
(regexp-opt (mapcar #'car cal-html-html-subst-list))
(lambda (x)
(cdr (assoc x cal-html-html-subst-list)))
string)

2
lisp/calendar/cal-islam.el
View file

@ -154,7 +154,7 @@ Reads a year, month, and day."
(month (cdr (assoc-string
(completing-read
"Islamic calendar month name: "
(mapcar 'list (append month-array nil))
(append month-array nil)
nil t)
(calendar-make-alist month-array 1) t)))
(last (calendar-islamic-last-day-of-month month year))

2
lisp/calendar/cal-julian.el
View file

@ -107,7 +107,7 @@ Driven by the variable `calendar-date-display-form'."
(month (cdr (assoc-string
(completing-read
"Julian calendar month name: "
(mapcar 'list (append month-array nil))
(append month-array nil)
nil t)
(calendar-make-alist month-array 1) t)))
(last

6
lisp/calendar/cal-mayan.el
View file

@ -70,7 +70,7 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using
(defun calendar-mayan-long-count-to-string (mayan-long-count)
"Convert MAYAN-LONG-COUNT into traditional written form."
(apply 'format (cons "%s.%s.%s.%s.%s" mayan-long-count)))
(apply #'format (cons "%s.%s.%s.%s.%s" mayan-long-count)))
(defun calendar-mayan-string-from-long-count (str)
"Given STR, a string of format \"%d.%d.%d.%d.%d\", return list of numbers."
@ -144,7 +144,7 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using
(haab-month (cdr
(assoc-string
(completing-read "Haab uinal: "
(mapcar 'list haab-month-list)
haab-month-list
nil t)
(calendar-make-alist haab-month-list 1) t))))
(cons haab-day haab-month)))
@ -160,7 +160,7 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using
(tzolkin-name (cdr
(assoc-string
(completing-read "Tzolkin uinal: "
(mapcar 'list tzolkin-name-list)
tzolkin-name-list
nil t)
(calendar-make-alist tzolkin-name-list 1) t))))
(cons tzolkin-count tzolkin-name)))

2
lisp/calendar/cal-menu.el
View file

@ -206,7 +206,7 @@ is non-nil."
(if holidays
(list "--shadow-etched-in" "--shadow-etched-in"))
(if diary-entries
(mapcar 'list (apply 'append diary-entries))
(mapcar #'list (apply #'append diary-entries))
'("None")))))
(and selection (call-interactively selection))))

6
lisp/calendar/cal-move.el
View file

@ -430,11 +430,7 @@ Interactively, prompt for YEAR and DAY number."
(calendar-day-number (calendar-current-date))
last)))
(list year day)))
(calendar-goto-date
(calendar-gregorian-from-absolute
(if (< 0 day)
(+ -1 day (calendar-absolute-from-gregorian (list 1 1 year)))
(+ 1 day (calendar-absolute-from-gregorian (list 12 31 year))))))
(calendar-goto-date (calendar-date-from-day-of-year year day))
(or noecho (calendar-print-day-of-year)))
(provide 'cal-move)

3
lisp/calendar/cal-persia.el
View file

@ -169,8 +169,7 @@ Reads a year, month, and day."
(month (cdr (assoc
(completing-read
"Persian calendar month name: "
(mapcar 'list
(append calendar-persian-month-name-array nil))
(append calendar-persian-month-name-array nil)
nil t)
(calendar-make-alist calendar-persian-month-name-array
1))))

47
lisp/calendar/cal-tex.el
View file

@ -72,26 +72,22 @@
"The days of the week that are displayed on the portrait monthly calendar.
Sunday is 0, Monday is 1, and so on. The default is to print from Sunday to
Saturday. For example, (1 3 5) prints only Monday, Wednesday, Friday."
:type '(repeat integer)
:group 'calendar-tex)
:type '(repeat integer))
(defcustom cal-tex-holidays t
"Non-nil means holidays are printed in the LaTeX calendars that support it.
Setting this to nil may speed up calendar generation."
:type 'boolean
:group 'calendar-tex)
:type 'boolean)
(defcustom cal-tex-diary nil
"Non-nil means diary entries are printed in LaTeX calendars that support it.
Setting this to nil may speed up calendar generation."
:type 'boolean
:group 'calendar-tex)
:type 'boolean)
(defcustom cal-tex-rules nil
"Non-nil means pages will be ruled in some LaTeX calendar styles.
At present, this only affects the daily filofax calendar."
:type 'boolean
:group 'calendar-tex)
:type 'boolean)
(defcustom cal-tex-daily-string
'(let* ((year (calendar-extract-year date))
@ -112,30 +108,25 @@ days remaining. As an example, setting this to
(calendar-hebrew-date-string date)
will put the Hebrew date at the bottom of each day."
:type 'sexp
:group 'calendar-tex)
:type 'sexp)
(defcustom cal-tex-buffer "calendar.tex"
"The name for the output LaTeX calendar buffer."
:type 'string
:group 'calendar-tex)
:type 'string)
(defcustom cal-tex-24 nil
"Non-nil means use a 24 hour clock in the daily calendar."
:type 'boolean
:group 'calendar-tex)
:type 'boolean)
(defcustom cal-tex-daily-start 8
"The first hour of the daily LaTeX calendar page.
At present, this only affects `cal-tex-cursor-day'."
:type 'integer
:group 'calendar-tex)
:type 'integer)
(defcustom cal-tex-daily-end 20
"The last hour of the daily LaTeX calendar page.
At present, this only affects `cal-tex-cursor-day'."
:type 'integer
:group 'calendar-tex)
:type 'integer)
(defcustom cal-tex-preamble-extra nil
"A string giving extra LaTeX commands to insert in the calendar preamble.
@ -144,7 +135,6 @@ For example, to include extra packages:
:type '(choice (const nil)
;; An example to help people format things in custom.
(string :value "\\usepackage{foo}\n\\usepackage{bar}\n"))
:group 'calendar-tex
:version "22.1")
(defcustom cal-tex-hook nil
@ -153,28 +143,23 @@ You can use this to do post-processing on the buffer. For example, to change
characters with diacritical marks to their LaTeX equivalents, use
(add-hook \\='cal-tex-hook
(lambda () (iso-iso2tex (point-min) (point-max))))"
:type 'hook
:group 'calendar-tex)
:type 'hook)
(defcustom cal-tex-year-hook nil
"List of functions called after a LaTeX year calendar buffer is generated."
:type 'hook
:group 'calendar-tex)
:type 'hook)
(defcustom cal-tex-month-hook nil
"List of functions called after a LaTeX month calendar buffer is generated."
:type 'hook
:group 'calendar-tex)
:type 'hook)
(defcustom cal-tex-week-hook nil
"List of functions called after a LaTeX week calendar buffer is generated."
:type 'hook
:group 'calendar-tex)
:type 'hook)
(defcustom cal-tex-daily-hook nil
"List of functions called after a LaTeX daily calendar buffer is generated."
:type 'hook
:group 'calendar-tex)
:type 'hook)
;;;
;;; Definitions for LaTeX code
@ -1227,7 +1212,7 @@ shown are hard-coded to 8-12, 13-17."
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
(cal-tex-arg (eval cal-tex-daily-string))
(cal-tex-arg (eval cal-tex-daily-string t))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(dotimes (_jdummy 2)
@ -1236,7 +1221,7 @@ shown are hard-coded to 8-12, 13-17."
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
(cal-tex-arg (eval cal-tex-daily-string))
(cal-tex-arg (eval cal-tex-daily-string t))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(unless (= i (1- n))

336
lisp/calendar/calendar.el
View file

@ -871,7 +871,15 @@ current word of the diary entry, so in no case can the pattern match more than
a portion of the first word of the diary entry.
For examples of three common styles, see `diary-american-date-forms',
`diary-european-date-forms', and `diary-iso-date-forms'."
`diary-european-date-forms', and `diary-iso-date-forms'.
If you customize this variable, you should also customize the variable
`diary-date-insertion-form' to contain a pseudo-pattern which produces
dates that match one of the forms in this variable. (If
`diary-date-insertion-form' does not correspond to one of the patterns
in this variable, then the diary will not recognize such dates,
including those inserted into the diary from the calendar with
`diary-insert-entry'.)"
:type '(repeat (choice (cons :tag "Backup"
:value (backup . nil)
(const backup)
@ -895,6 +903,50 @@ For examples of three common styles, see `diary-american-date-forms',
(diary))))
:group 'diary)
(defconst diary-american-date-insertion-form '(month "/" day "/" year)
"Pseudo-pattern for American dates in `diary-date-insertion-form'")
(defconst diary-european-date-insertion-form '(day "/" month "/" year)
"Pseudo-pattern for European dates in `diary-date-insertion-form'")
(defconst diary-iso-date-insertion-form '(year "/" month "/" day)
"Pseudo-pattern for ISO dates in `diary-date-insertion-form'")
(defcustom diary-date-insertion-form
(cond ((eq calendar-date-style 'iso) diary-iso-date-insertion-form)
((eq calendar-date-style 'european) diary-european-date-insertion-form)
(t diary-american-date-insertion-form))
"Pseudo-pattern describing how to format a date for a new diary entry.
A pseudo-pattern is a list of expressions that can include the symbols
`month', `day', and `year' (all numbers in string form), and `monthname'
and `dayname' (both alphabetic strings). For example, a typical American
form would be
(month \"/\" day \"/\" (substring year -2))
whereas
((format \"%9s, %9s %2s, %4s\" dayname monthname day year))
would give the usual American style in fixed-length fields.
This pattern will be used by `calendar-date-string' (which see) to
format dates when inserting them with `diary-insert-entry', or when
importing them from other formats into the diary.
If you customize this variable, you should also customize the variable
`diary-date-forms' to include a pseudo-pattern which matches dates
produced by this pattern. (If there is no corresponding pattern in
`diary-date-forms', then the diary will not recognize such dates,
including those inserted into the diary from the calendar with
`diary-insert-entry'.)"
:version "31.1"
:type 'sexp
:risky t
:set-after '(calendar-date-style)
:group 'diary)
;; Next three are provided to aid in setting calendar-date-display-form.
(defcustom calendar-iso-date-display-form '((format "%s-%.2d-%.2d" year
(string-to-number month)
@ -1028,7 +1080,9 @@ The valid styles are described in the documentation of `calendar-date-style'."
calendar-month-header
(symbol-value (intern-soft (format "calendar-%s-month-header" style)))
diary-date-forms
(symbol-value (intern-soft (format "diary-%s-date-forms" style))))
(symbol-value (intern-soft (format "diary-%s-date-forms" style)))
diary-date-insertion-form
(symbol-value (intern-soft (format "diary-%s-date-insertion-form" style))))
(calendar-redraw))
(defcustom diary-show-holidays-flag t
@ -1297,6 +1351,16 @@ return negative results."
(/ offset-years 400)
(calendar-day-number '(12 31 -1))))))) ; days in year 1 BC
;; This function is the inverse of `calendar-day-number':
(defun calendar-date-from-day-of-year (year dayno)
"Return the date of the DAYNO-th day in YEAR.
DAYNO must be an integer between -366 and 366."
(calendar-gregorian-from-absolute
(+ (if (< dayno 0)
(+ 1 dayno (if (calendar-leap-year-p year) 366 365))
dayno)
(calendar-absolute-from-gregorian (list 12 31 (1- year))))))
;;;###autoload
(defun calendar (&optional arg)
"Display a three-month Gregorian calendar.
@ -1598,143 +1662,143 @@ Otherwise, use the selected window of EVENT's frame."
mark-defun mark-whole-buffer mark-page
downcase-region upcase-region kill-region
copy-region-as-kill capitalize-region write-region))
(define-key map (vector 'remap c) 'calendar-not-implemented))
(define-key map "<" 'calendar-scroll-right)
(define-key map "\C-x<" 'calendar-scroll-right)
(define-key map [S-wheel-up] 'calendar-scroll-right)
(define-key map [prior] 'calendar-scroll-right-three-months)
(define-key map "\ev" 'calendar-scroll-right-three-months)
(define-key map [wheel-up] 'calendar-scroll-right-three-months)
(define-key map [M-wheel-up] 'calendar-backward-year)
(define-key map ">" 'calendar-scroll-left)
(define-key map "\C-x>" 'calendar-scroll-left)
(define-key map [S-wheel-down] 'calendar-scroll-left)
(define-key map [next] 'calendar-scroll-left-three-months)
(define-key map "\C-v" 'calendar-scroll-left-three-months)
(define-key map [wheel-down] 'calendar-scroll-left-three-months)
(define-key map [M-wheel-down] 'calendar-forward-year)
(define-key map "\C-l" 'calendar-recenter)
(define-key map "\C-b" 'calendar-backward-day)
(define-key map "\C-p" 'calendar-backward-week)
(define-key map "\e{" 'calendar-backward-month)
(define-key map "{" 'calendar-backward-month)
(define-key map "\C-x[" 'calendar-backward-year)
(define-key map "[" 'calendar-backward-year)
(define-key map "\C-f" 'calendar-forward-day)
(define-key map "\C-n" 'calendar-forward-week)
(define-key map [left] 'calendar-backward-day)
(define-key map [up] 'calendar-backward-week)
(define-key map [right] 'calendar-forward-day)
(define-key map [down] 'calendar-forward-week)
(define-key map "\e}" 'calendar-forward-month)
(define-key map "}" 'calendar-forward-month)
(define-key map "\C-x]" 'calendar-forward-year)
(define-key map "]" 'calendar-forward-year)
(define-key map "\C-a" 'calendar-beginning-of-week)
(define-key map "\C-e" 'calendar-end-of-week)
(define-key map "\ea" 'calendar-beginning-of-month)
(define-key map "\ee" 'calendar-end-of-month)
(define-key map "\e<" 'calendar-beginning-of-year)
(define-key map "\e>" 'calendar-end-of-year)
(define-key map "\C-@" 'calendar-set-mark)
(define-key map (vector 'remap c) #'calendar-not-implemented))
(define-key map "<" #'calendar-scroll-right)
(define-key map "\C-x<" #'calendar-scroll-right)
(define-key map [S-wheel-up] #'calendar-scroll-right)
(define-key map [prior] #'calendar-scroll-right-three-months)
(define-key map "\ev" #'calendar-scroll-right-three-months)
(define-key map [wheel-up] #'calendar-scroll-right-three-months)
(define-key map [M-wheel-up] #'calendar-backward-year)
(define-key map ">" #'calendar-scroll-left)
(define-key map "\C-x>" #'calendar-scroll-left)
(define-key map [S-wheel-down] #'calendar-scroll-left)
(define-key map [next] #'calendar-scroll-left-three-months)
(define-key map "\C-v" #'calendar-scroll-left-three-months)
(define-key map [wheel-down] #'calendar-scroll-left-three-months)
(define-key map [M-wheel-down] #'calendar-forward-year)
(define-key map "\C-l" #'calendar-recenter)
(define-key map "\C-b" #'calendar-backward-day)
(define-key map "\C-p" #'calendar-backward-week)
(define-key map "\e{" #'calendar-backward-month)
(define-key map "{" #'calendar-backward-month)
(define-key map "\C-x[" #'calendar-backward-year)
(define-key map "[" #'calendar-backward-year)
(define-key map "\C-f" #'calendar-forward-day)
(define-key map "\C-n" #'calendar-forward-week)
(define-key map [left] #'calendar-backward-day)
(define-key map [up] #'calendar-backward-week)
(define-key map [right] #'calendar-forward-day)
(define-key map [down] #'calendar-forward-week)
(define-key map "\e}" #'calendar-forward-month)
(define-key map "}" #'calendar-forward-month)
(define-key map "\C-x]" #'calendar-forward-year)
(define-key map "]" #'calendar-forward-year)
(define-key map "\C-a" #'calendar-beginning-of-week)
(define-key map "\C-e" #'calendar-end-of-week)
(define-key map "\ea" #'calendar-beginning-of-month)
(define-key map "\ee" #'calendar-end-of-month)
(define-key map "\e<" #'calendar-beginning-of-year)
(define-key map "\e>" #'calendar-end-of-year)
(define-key map "\C-@" #'calendar-set-mark)
;; Many people are used to typing C-SPC and getting C-@.
(define-key map [?\C-\s] 'calendar-set-mark)
(define-key map "\C-x\C-x" 'calendar-exchange-point-and-mark)
(define-key map "\e=" 'calendar-count-days-region)
(define-key map "gd" 'calendar-goto-date)
(define-key map "gD" 'calendar-goto-day-of-year)
(define-key map "gj" 'calendar-julian-goto-date)
(define-key map "ga" 'calendar-astro-goto-day-number)
(define-key map "gh" 'calendar-hebrew-goto-date)
(define-key map "gi" 'calendar-islamic-goto-date)
(define-key map "gb" 'calendar-bahai-goto-date)
(define-key map "gC" 'calendar-chinese-goto-date)
(define-key map "gk" 'calendar-coptic-goto-date)
(define-key map "ge" 'calendar-ethiopic-goto-date)
(define-key map "gp" 'calendar-persian-goto-date)
(define-key map "gc" 'calendar-iso-goto-date)
(define-key map "gw" 'calendar-iso-goto-week)
(define-key map "gf" 'calendar-french-goto-date)
(define-key map "gml" 'calendar-mayan-goto-long-count-date)
(define-key map "gmpc" 'calendar-mayan-previous-round-date)
(define-key map "gmnc" 'calendar-mayan-next-round-date)
(define-key map "gmph" 'calendar-mayan-previous-haab-date)
(define-key map "gmnh" 'calendar-mayan-next-haab-date)
(define-key map "gmpt" 'calendar-mayan-previous-tzolkin-date)
(define-key map "gmnt" 'calendar-mayan-next-tzolkin-date)
(define-key map "Aa" 'appt-add)
(define-key map [?\C-\s] #'calendar-set-mark)
(define-key map "\C-x\C-x" #'calendar-exchange-point-and-mark)
(define-key map "\e=" #'calendar-count-days-region)
(define-key map "gd" #'calendar-goto-date)
(define-key map "gD" #'calendar-goto-day-of-year)
(define-key map "gj" #'calendar-julian-goto-date)
(define-key map "ga" #'calendar-astro-goto-day-number)
(define-key map "gh" #'calendar-hebrew-goto-date)
(define-key map "gi" #'calendar-islamic-goto-date)
(define-key map "gb" #'calendar-bahai-goto-date)
(define-key map "gC" #'calendar-chinese-goto-date)
(define-key map "gk" #'calendar-coptic-goto-date)
(define-key map "ge" #'calendar-ethiopic-goto-date)
(define-key map "gp" #'calendar-persian-goto-date)
(define-key map "gc" #'calendar-iso-goto-date)
(define-key map "gw" #'calendar-iso-goto-week)
(define-key map "gf" #'calendar-french-goto-date)
(define-key map "gml" #'calendar-mayan-goto-long-count-date)
(define-key map "gmpc" #'calendar-mayan-previous-round-date)
(define-key map "gmnc" #'calendar-mayan-next-round-date)
(define-key map "gmph" #'calendar-mayan-previous-haab-date)
(define-key map "gmnh" #'calendar-mayan-next-haab-date)
(define-key map "gmpt" #'calendar-mayan-previous-tzolkin-date)
(define-key map "gmnt" #'calendar-mayan-next-tzolkin-date)
(define-key map "Aa" #'appt-add)
(define-key map "Ad" 'appt-delete)
(define-key map "S" 'calendar-sunrise-sunset)
(define-key map "M" 'calendar-lunar-phases)
(define-key map " " 'scroll-other-window)
(define-key map [?\S-\ ] 'scroll-other-window-down)
(define-key map "\d" 'scroll-other-window-down)
(define-key map "\C-c\C-l" 'calendar-redraw)
(define-key map "." 'calendar-goto-today)
(define-key map "o" 'calendar-other-month)
(define-key map "q" 'calendar-exit)
(define-key map "a" 'calendar-list-holidays)
(define-key map "h" 'calendar-cursor-holidays)
(define-key map "x" 'calendar-mark-holidays)
(define-key map "u" 'calendar-unmark)
(define-key map "m" 'diary-mark-entries)
(define-key map "d" 'diary-view-entries)
(define-key map "D" 'diary-view-other-diary-entries)
(define-key map "s" 'diary-show-all-entries)
(define-key map "pd" 'calendar-print-day-of-year)
(define-key map "pC" 'calendar-chinese-print-date)
(define-key map "pk" 'calendar-coptic-print-date)
(define-key map "pe" 'calendar-ethiopic-print-date)
(define-key map "pp" 'calendar-persian-print-date)
(define-key map "pc" 'calendar-iso-print-date)
(define-key map "pj" 'calendar-julian-print-date)
(define-key map "pa" 'calendar-astro-print-day-number)
(define-key map "ph" 'calendar-hebrew-print-date)
(define-key map "pi" 'calendar-islamic-print-date)
(define-key map "pb" 'calendar-bahai-print-date)
(define-key map "pf" 'calendar-french-print-date)
(define-key map "pm" 'calendar-mayan-print-date)
(define-key map "po" 'calendar-print-other-dates)
(define-key map "id" 'diary-insert-entry)
(define-key map "iw" 'diary-insert-weekly-entry)
(define-key map "im" 'diary-insert-monthly-entry)
(define-key map "iy" 'diary-insert-yearly-entry)
(define-key map "ia" 'diary-insert-anniversary-entry)
(define-key map "ib" 'diary-insert-block-entry)
(define-key map "ic" 'diary-insert-cyclic-entry)
(define-key map "ihd" 'diary-hebrew-insert-entry)
(define-key map "ihm" 'diary-hebrew-insert-monthly-entry)
(define-key map "ihy" 'diary-hebrew-insert-yearly-entry)
(define-key map "iid" 'diary-islamic-insert-entry)
(define-key map "iim" 'diary-islamic-insert-monthly-entry)
(define-key map "iiy" 'diary-islamic-insert-yearly-entry)
(define-key map "iBd" 'diary-bahai-insert-entry)
(define-key map "iBm" 'diary-bahai-insert-monthly-entry)
(define-key map "iBy" 'diary-bahai-insert-yearly-entry)
(define-key map "iCd" 'diary-chinese-insert-entry)
(define-key map "iCm" 'diary-chinese-insert-monthly-entry)
(define-key map "iCy" 'diary-chinese-insert-yearly-entry)
(define-key map "iCa" 'diary-chinese-insert-anniversary-entry)
(define-key map "?" 'calendar-goto-info-node)
(define-key map "Hm" 'cal-html-cursor-month)
(define-key map "Hy" 'cal-html-cursor-year)
(define-key map "tm" 'cal-tex-cursor-month)
(define-key map "tM" 'cal-tex-cursor-month-landscape)
(define-key map "td" 'cal-tex-cursor-day)
(define-key map "tw1" 'cal-tex-cursor-week)
(define-key map "tw2" 'cal-tex-cursor-week2)
(define-key map "tw3" 'cal-tex-cursor-week-iso) ; FIXME twi ?
(define-key map "tw4" 'cal-tex-cursor-week-monday) ; twm ?
(define-key map "twW" 'cal-tex-cursor-week2-summary)
(define-key map "tfd" 'cal-tex-cursor-filofax-daily)
(define-key map "tfw" 'cal-tex-cursor-filofax-2week)
(define-key map "tfW" 'cal-tex-cursor-filofax-week)
(define-key map "tfy" 'cal-tex-cursor-filofax-year)
(define-key map "ty" 'cal-tex-cursor-year)
(define-key map "tY" 'cal-tex-cursor-year-landscape)
(define-key map "S" #'calendar-sunrise-sunset)
(define-key map "M" #'calendar-lunar-phases)
(define-key map " " #'scroll-other-window)
(define-key map [?\S-\ ] #'scroll-other-window-down)
(define-key map "\d" #'scroll-other-window-down)
(define-key map "\C-c\C-l" #'calendar-redraw)
(define-key map "." #'calendar-goto-today)
(define-key map "o" #'calendar-other-month)
(define-key map "q" #'calendar-exit)
(define-key map "a" #'calendar-list-holidays)
(define-key map "h" #'calendar-cursor-holidays)
(define-key map "x" #'calendar-mark-holidays)
(define-key map "u" #'calendar-unmark)
(define-key map "m" #'diary-mark-entries)
(define-key map "d" #'diary-view-entries)
(define-key map "D" #'diary-view-other-diary-entries)
(define-key map "s" #'diary-show-all-entries)
(define-key map "pd" #'calendar-print-day-of-year)
(define-key map "pC" #'calendar-chinese-print-date)
(define-key map "pk" #'calendar-coptic-print-date)
(define-key map "pe" #'calendar-ethiopic-print-date)
(define-key map "pp" #'calendar-persian-print-date)
(define-key map "pc" #'calendar-iso-print-date)
(define-key map "pj" #'calendar-julian-print-date)
(define-key map "pa" #'calendar-astro-print-day-number)
(define-key map "ph" #'calendar-hebrew-print-date)
(define-key map "pi" #'calendar-islamic-print-date)
(define-key map "pb" #'calendar-bahai-print-date)
(define-key map "pf" #'calendar-french-print-date)
(define-key map "pm" #'calendar-mayan-print-date)
(define-key map "po" #'calendar-print-other-dates)
(define-key map "id" #'diary-insert-entry)
(define-key map "iw" #'diary-insert-weekly-entry)
(define-key map "im" #'diary-insert-monthly-entry)
(define-key map "iy" #'diary-insert-yearly-entry)
(define-key map "ia" #'diary-insert-anniversary-entry)
(define-key map "ib" #'diary-insert-block-entry)
(define-key map "ic" #'diary-insert-cyclic-entry)
(define-key map "ihd" #'diary-hebrew-insert-entry)
(define-key map "ihm" #'diary-hebrew-insert-monthly-entry)
(define-key map "ihy" #'diary-hebrew-insert-yearly-entry)
(define-key map "iid" #'diary-islamic-insert-entry)
(define-key map "iim" #'diary-islamic-insert-monthly-entry)
(define-key map "iiy" #'diary-islamic-insert-yearly-entry)
(define-key map "iBd" #'diary-bahai-insert-entry)
(define-key map "iBm" #'diary-bahai-insert-monthly-entry)
(define-key map "iBy" #'diary-bahai-insert-yearly-entry)
(define-key map "iCd" #'diary-chinese-insert-entry)
(define-key map "iCm" #'diary-chinese-insert-monthly-entry)
(define-key map "iCy" #'diary-chinese-insert-yearly-entry)
(define-key map "iCa" #'diary-chinese-insert-anniversary-entry)
(define-key map "?" #'calendar-goto-info-node)
(define-key map "Hm" #'cal-html-cursor-month)
(define-key map "Hy" #'cal-html-cursor-year)
(define-key map "tm" #'cal-tex-cursor-month)
(define-key map "tM" #'cal-tex-cursor-month-landscape)
(define-key map "td" #'cal-tex-cursor-day)
(define-key map "tw1" #'cal-tex-cursor-week)
(define-key map "tw2" #'cal-tex-cursor-week2)
(define-key map "tw3" #'cal-tex-cursor-week-iso) ; FIXME twi ?
(define-key map "tw4" #'cal-tex-cursor-week-monday) ; twm ?
(define-key map "twW" #'cal-tex-cursor-week2-summary)
(define-key map "tfd" #'cal-tex-cursor-filofax-daily)
(define-key map "tfw" #'cal-tex-cursor-filofax-2week)
(define-key map "tfW" #'cal-tex-cursor-filofax-week)
(define-key map "tfy" #'cal-tex-cursor-filofax-year)
(define-key map "ty" #'cal-tex-cursor-year)
(define-key map "tY" #'cal-tex-cursor-year-landscape)
(define-key map [menu-bar edit] 'undefined)
(define-key map [menu-bar search] 'undefined)
(define-key map [menu-bar edit] #'undefined)
(define-key map [menu-bar search] #'undefined)
(easy-menu-define nil map nil cal-menu-sunmoon-menu)
(easy-menu-define nil map nil cal-menu-diary-menu)

3730
lisp/calendar/diary-icalendar.el Normal file
View file

File diff suppressed because it is too large Load diff

102
lisp/calendar/diary-lib.el
View file

@ -38,15 +38,13 @@
(defcustom diary-include-string "#include"
"The string indicating inclusion of another file of diary entries.
See the documentation for the function `diary-include-other-diary-files'."
:type 'string
:group 'diary)
:type 'string)
(defcustom diary-list-include-blanks nil
"If nil, do not include days with no diary entry in the list of diary entries.
Such days will then not be shown in the fancy diary buffer, even if they
are holidays."
:type 'boolean
:group 'diary)
:type 'boolean)
(defface diary-anniversary '((t :inherit font-lock-keyword-face))
"Face used for anniversaries in the fancy diary display."
@ -105,29 +103,24 @@ are: `string', `symbol', `int', `tnil', `stringtnil'."
(const :value int :tag "An integer")
(const :value tnil :tag "t or nil")
(const :value stringtnil
:tag "A string, t, or nil"))))
:group 'diary)
:tag "A string, t, or nil")))))
(defcustom diary-glob-file-regexp-prefix "^#"
"Regular expression prepended to `diary-face-attrs' for file-wide specifiers."
:type 'regexp
:group 'diary)
:type 'regexp)
(defcustom diary-file-name-prefix nil
"Non-nil means prefix each diary entry with the name of the file defining it."
:type 'boolean
:group 'diary)
:type 'boolean)
(defcustom diary-file-name-prefix-function #'identity
"The function that will take a diary file name and return the desired prefix."
:type 'function
:group 'diary)
:type 'function)
(defcustom diary-sexp-entry-symbol "%%"
"The string used to indicate a sexp diary entry in `diary-file'.
See the documentation for the function `diary-list-sexp-entries'."
:type 'string
:group 'diary)
:type 'string)
(defcustom diary-comment-start nil
"String marking the start of a comment in the diary, or nil.
@ -138,24 +131,21 @@ for whatever you like, e.g. for meta-data that packages such as
can be only one comment on any line.
See also `diary-comment-end'."
:version "24.1"
:type '(choice (const :tag "No comment" nil) string)
:group 'diary)
:type '(choice (const :tag "No comment" nil) string))
(defcustom diary-comment-end ""
"String marking the end of a comment in the diary.
The empty string means comments finish at the end of a line.
See also `diary-comment-start'."
:version "24.1"
:type 'string
:group 'diary)
:type 'string)
(defcustom diary-hook nil
"Hook run after displaying the diary.
Used for example by the appointment package - see `appt-activate'.
The variables `number' and `original-date' are dynamically bound around
the call."
:type 'hook
:group 'diary)
:type 'hook)
(defcustom diary-display-function #'diary-fancy-display
"Function used to display the diary.
@ -171,10 +161,9 @@ holidays), or hard copy output."
(const :tag "Basic display" diary-simple-display)
(const :tag "No display" ignore)
(function :tag "User-specified function"))
:initialize 'custom-initialize-default
:set 'diary-set-maybe-redraw
:version "23.2" ; simple->fancy
:group 'diary)
:initialize #'custom-initialize-default
:set #'diary-set-maybe-redraw
:version "23.2") ; simple->fancy
(defcustom diary-list-entries-hook nil
"Hook run after diary file is culled for relevant entries.
@ -201,8 +190,7 @@ So for example, to sort the complete list of diary entries you would
use the list-entries hook, whereas to process e.g. Islamic entries in
the main file and all included files, you would use the nongregorian hook."
:type 'hook
:options '(diary-include-other-diary-files diary-sort-entries)
:group 'diary)
:options '(diary-include-other-diary-files diary-sort-entries))
(defcustom diary-mark-entries-hook nil
"List of functions called after marking diary entries in the calendar.
@ -218,8 +206,7 @@ differ only if you are using included diary files. In that case,
`displayed-year' and `displayed-month' are dynamically bound when
this hook is called."
:type 'hook
:options '(diary-mark-included-diary-files)
:group 'diary)
:options '(diary-mark-included-diary-files))
(defcustom diary-nongregorian-listing-hook nil
"List of functions called for listing diary file and included files.
@ -236,8 +223,7 @@ use `diary-list-entries-hook', which runs only for the main diary file."
:options '(diary-bahai-list-entries
diary-hebrew-list-entries
diary-islamic-list-entries
diary-chinese-list-entries)
:group 'diary)
diary-chinese-list-entries))
(defcustom diary-nongregorian-marking-hook nil
"List of functions called for marking diary file and included files.
@ -254,8 +240,7 @@ use `diary-mark-entries-hook', which runs only for the main diary file."
:options '(diary-bahai-mark-entries
diary-hebrew-mark-entries
diary-islamic-mark-entries
diary-chinese-mark-entries)
:group 'diary)
diary-chinese-mark-entries))
(defcustom diary-print-entries-hook #'lpr-buffer
"Run by `diary-print-entries' after preparing a temporary diary buffer.
@ -264,8 +249,7 @@ diary buffer. The default just does the printing. Other uses
might include, for example, rearranging the lines into order by
day and time, saving the buffer instead of deleting it, or
changing the function used to do the printing."
:type 'hook
:group 'diary)
:type 'hook)
(defcustom diary-unknown-time -9999
"Value returned by `diary-entry-time' when no time is found.
@ -273,19 +257,16 @@ The default value -9999 causes entries with no recognizable time
to be placed before those with times; 9999 would place entries
with no recognizable time after those with times."
:type 'integer
:group 'diary
:version "20.3")
(defcustom diary-mail-addr
(or (bound-and-true-p user-mail-address) "")
"Email address that `diary-mail-entries' will send email to."
:group 'diary
:type 'string
:version "20.3")
(defcustom diary-mail-days 7
"Default number of days for `diary-mail-entries' to check."
:group 'diary
:type 'integer
:version "20.3")
@ -302,8 +283,7 @@ Used by the function `diary-remind', a pseudo-pattern is a list of
expressions that can involve the keywords `days' (a number), `date'
\(a list of month, day, year), and `diary-entry' (a string)."
:type 'sexp
:risky t
:group 'diary)
:risky t)
(defcustom diary-abbreviated-year-flag t
"Interpret a two-digit year DD in a diary entry as either 19DD or 20DD.
@ -312,8 +292,7 @@ When the current century is added to a two-digit year, if the result
is more than 50 years in the future, the previous century is assumed.
If the result is more than 50 years in the past, the next century is assumed.
If this variable is nil, years must be written in full."
:type 'boolean
:group 'diary)
:type 'boolean)
(defun diary-outlook-format-1 (body)
"Return a replace-match template for an element of `diary-outlook-formats'.
@ -378,8 +357,7 @@ template following the rules above."
(string :tag "Template for entry")
(function :tag
"Unary function providing template")))
:version "22.1"
:group 'diary)
:version "22.1")
(defvar diary-header-line-flag)
(defvar diary-header-line-format)
@ -401,10 +379,9 @@ template following the rules above."
(defcustom diary-header-line-flag t
"Non-nil means `diary-simple-display' will show a header line.
The format of the header is specified by `diary-header-line-format'."
:group 'diary
:type 'boolean
:initialize 'custom-initialize-default
:set 'diary-set-header
:initialize #'custom-initialize-default
:set #'diary-set-header
:version "22.1")
(defvar diary-selective-display nil
@ -418,11 +395,10 @@ The format of the header is specified by `diary-header-line-format'."
?\s (window-width)))
"Format of the header line displayed by `diary-simple-display'.
Only used if `diary-header-line-flag' is non-nil."
:group 'diary
:type 'sexp
:risky t
:initialize 'custom-initialize-default
:set 'diary-set-header
:initialize #'custom-initialize-default
:set #'diary-set-header
:version "23.3") ; frame-width -> window-width
;; The first version of this also checked for diary-selective-display
@ -480,9 +456,8 @@ of days of diary entries displayed."
(integer :tag "Thursday")
(integer :tag "Friday")
(integer :tag "Saturday")))
:initialize 'custom-initialize-default
:set 'diary-set-maybe-redraw
:group 'diary)
:initialize #'custom-initialize-default
:set #'diary-set-maybe-redraw)
;;; More user options in calendar.el, holidays.el.
@ -1443,9 +1418,9 @@ marks. This is intended to deal with deleted diary entries."
(entry entry))
(if calendar-debug-sexp
(let ((debug-on-error t))
(eval (car (read-from-string sexp))))
(eval (car (read-from-string sexp)) t))
(condition-case err
(eval (car (read-from-string sexp)))
(eval (car (read-from-string sexp)) t)
(error
(display-warning
'diary
@ -1671,7 +1646,7 @@ be used instead of a colon (:) to separate the hour and minute parts."
If you add this function to `diary-list-entries-hook', it should
be the last item in the hook, in case earlier items add diary
entries, or change the order."
(setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
(setq diary-entries-list (sort diary-entries-list #'diary-entry-compare)))
(defun diary-list-sexp-entries (date)
@ -2027,7 +2002,7 @@ Entry applies if the date is DAYS days after another diary-sexp SEXP."
(user-error "Days must be an integer"))
(let ((date (calendar-gregorian-from-absolute
(- (calendar-absolute-from-gregorian date) days))))
(eval sexp)))
(eval sexp t)))
(defun diary-day-of-year ()
"Day of year and number of days remaining in the year of date diary entry."
@ -2058,7 +2033,7 @@ calendar."
(and (integerp days)
(< days 0)
(setq days (number-sequence 1 (- days))))
(calendar-dlet ((diary-entry (eval sexp)))
(calendar-dlet ((diary-entry (eval sexp t)))
(cond
;; Diary entry applies on date.
((and diary-entry
@ -2071,7 +2046,7 @@ calendar."
;; Adjust date, and re-evaluate.
(let ((date (calendar-gregorian-from-absolute
(+ (calendar-absolute-from-gregorian date) days))))
(when (setq diary-entry (eval sexp))
(when (setq diary-entry (eval sexp t))
;; Discard any mark portion from diary-anniversary, etc.
(if (consp diary-entry) (setq diary-entry (cdr diary-entry)))
(calendar-dlet ((days days))
@ -2120,8 +2095,9 @@ show the diary buffer."
Prefix argument ARG makes the entry nonmarking."
(interactive
(list current-prefix-arg last-nonmenu-event))
(diary-make-entry (calendar-date-string (calendar-cursor-to-date t event) t t)
arg))
(calendar-dlet ((calendar-date-display-form diary-date-insertion-form))
(diary-make-entry (calendar-date-string (calendar-cursor-to-date t event) t t)
arg)))
;;;###cal-autoload
(defun diary-insert-weekly-entry (arg)
@ -2299,7 +2275,7 @@ full month names."
"")
;; With backup, last item is not part of date.
(if (equal (car x) 'backup)
(concat "\\)" (eval (car (reverse x))))
(concat "\\)" (eval (car (reverse x)) t))
"\\)"))
'(1 'diary)))
diary-date-forms)))
@ -2318,6 +2294,10 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
;; Accepted formats: 10:00 10.00 10h00 10h 10am 10:00am 10.00am
;; Use of "." as a separator annoyingly matches numbers, eg "123.45".
;; Hence often prefix this with "\\(^\\|\\s-\\)."
;; FIXME: this regexp is too liberal to be used for parsing times from
;; entries by `diary-icalendar-parse-time', hence the existence of
;; `diary-icalendar-time-regexp'. Can we tighten it up so we don't
;; need both?
(concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\("
"[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]"
"\\)\\([AaPp][Mm]\\)?\\)")

957
lisp/calendar/icalendar-ast.el Normal file
View file

@ -0,0 +1,957 @@
;;; icalendar-ast.el --- Syntax trees for iCalendar -*- lexical-binding: t; -*-
;; Copyright (C) 2024 Free Software Foundation, Inc.
;; Author: Richard Lawrence <rwl@recursewithless.net>
;; Created: October 2024
;; Keywords: calendar
;; Human-Keywords: calendar, iCalendar
;; This file is part of GNU Emacs.
;; This file 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.
;; This file 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 this file. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This file defines the abstract syntax tree representation for
;; iCalendar data. The AST is based on `org-element-ast' (which see;
;; that feature will eventually be renamed and moved out of the Org tree
;; into the main tree).
;; This file contains low-level functions for constructing and
;; manipulating the AST, most of which are minimal wrappers around the
;; functions provided by `org-element-ast'. This low-level API is
;; primarily used by `icalendar-parser'. It also contains a higher-level
;; API for constructing AST nodes in Lisp code. Finally, it defines
;; functions for validating AST nodes.
;; There are three main pieces of data in an AST node: its type, its
;; value, and its child nodes. Nodes which represent iCalendar
;; components have no values; they are simply containers for their
;; children. Nodes which represent data of the base iCalendar data
;; types have no children; they are the leaf nodes in the syntax tree.
;; The main low-level accessors for these data in AST nodes are:
;;
;; `icalendar-ast-node-type'
;; `icalendar-ast-node-value'
;; `icalendar-ast-node-children'
;; `icalendar-ast-node-children-of'
;; `icalendar-ast-node-first-child-of'
;; To construct AST nodes in Lisp code, see especially the high-level macros:
;;
;; `icalendar-make-vcalendar'
;; `icalendar-make-vtimezone'
;; `icalendar-make-vevent'
;; `icalendar-make-vtodo'
;; `icalendar-make-vjournal'
;; `icalendar-make-property'
;; `icalendar-make-param'
;;
;; These macros wrap the macro `icalendar-make-node-from-templates',
;; which allows writing iCalendar syntax tree nodes as Lisp templates.
;; Constructing nodes with these macros automatically validates them
;; with the function `icalendar-ast-node-valid-p', which signals an
;; `icalendar-validation-error' if the node is not valid acccording to
;; RFC5545.
;;; Code:
(eval-when-compile (require 'icalendar-macs))
(require 'icalendar)
(require 'org-element-ast)
(require 'cl-lib)
;;; Type symbols and metadata
;; All nodes in the syntax tree have a type symbol as their first element.
;; We use the following symbol properties (all prefixed with 'icalendar-')
;; to associate type symbols with various important data about the type:
;;
;; is-type - t (marks this symbol as an icalendar type)
;; is-value, is-param, is-property, or is-component - t
;; (specifies what sort of value this type represents)
;; list-sep - for property and parameters types, a string (typically
;; "," or ";") which separates individual printed values, if the
;; type allows lists of values. If this is non-nil, syntax nodes of
;; this type should always have a list of values in their VALUE
;; field (even if there is only one value)
;; matcher - a function to match this type. This function matches the
;; regular expression defined under the type's name; it is used to provide
;; syntax highlighting in `icalendar-mode'
;; begin-rx, end-rx - for component-types, an `rx' regular expression which
;; matches the BEGIN and END lines that form its boundaries
;; value-rx - an `rx' regular expression which matches individual values
;; of this type, with no consideration for quoting or lists of values.
;; (For value types, this is just a synonym for the rx definition
;; under the type's symbol)
;; values-rx - for types that accept lists of values, an `rx' regular
;; expression which matches the whole list (including quotes, if required)
;; full-value-rx - for property and parameter types, an `rx' regular
;; expression which matches a valid value expression in group 2, or
;; an invalid value in group 3
;; value-reader - for value types, a function which creates syntax
;; nodes of this type given a string representing their value
;; value-printer - for value types, a function to print individual
;; values of this type. It accepts a value and returns its string
;; representation.
;; default-value - for property and parameter types, a string
;; representing a default value for nodes of this type. This is the
;; value assumed when no node of this type is present in the
;; relevant part of the syntax tree.
;; substitute-value - for parameter types, a string representing a value
;; which will be substituted at parse times for unrecognized values.
;; (This is normally the same as default-value, but differs from it
;; in at least one case in RFC5545, thus it is stored separately.)
;; default-type - for property types which can accept values of multiple
;; types, this is the default type when no type for the value is
;; specified in the parameters. Any type of value other than this
;; one requires a VALUE=... parameter when the property is read or printed.
;; other-types - for property types which can accept values of multiple types,
;; this is a list of other types that the property can accept.
;; value-type - for param types, this is the value type which the parameter
;; can accept.
;; child-spec - for property and component types, a plist describing the
;; required and optional child nodes. See `icalendar-define-property' and
;; `icalendar-define-component' for details.
;; other-validator - a function to perform type-specific validation
;; for nodes of this type. If present, this function will be called
;; by `icalendar-ast-node-valid-p' during validation.
;; type-documentation - a string documenting the type. This documentation is
;; printed in the help buffer when `describe-symbol' is called on TYPE.
;; link - a hyperlink to the documentation of the type in the relevant standard
(defun ical:type-symbol-p (symbol)
"Return non-nil if SYMBOL is an iCalendar type symbol.
This function only checks that SYMBOL has been marked as a type;
it returns t for value types defined by `icalendar-define-type',
but also e.g. for types defined by `icalendar-define-param' and
`icalendar-define-property'. To check that SYMBOL names a value
type for property or parameter values, see
`icalendar-value-type-symbol-p' and
`icalendar-printable-value-type-symbol-p'."
(and (symbolp symbol)
(get symbol 'ical:is-type)))
(defun ical:value-type-symbol-p (symbol)
"Return non-nil if SYMBOL is a type symbol for a value type.
This means that SYMBOL must both satisfy `icalendar-type-symbol-p' and
have the property `icalendar-is-value'. It does not require the type to
be associated with a print name in `icalendar-value-types'; for that see
`icalendar-printable-value-type-symbol-p'."
(and (ical:type-symbol-p symbol)
(get symbol 'ical:is-value)))
(defun ical:expects-list-of-values-p (type)
"Return non-nil if TYPE expects a list of values.
This is never t for value types or component types. For property and
parameter types defined with `icalendar-define-param' and
`icalendar-define-property', it is true if the :list-sep argument was
specified in the definition."
(and (ical:type-symbol-p type)
(get type 'ical:list-sep)))
(defun ical:param-type-symbol-p (type)
"Return non-nil if TYPE is a type symbol for an iCalendar parameter."
(and (ical:type-symbol-p type)
(get type 'ical:is-param)))
(defun ical:property-type-symbol-p (type)
"Return non-nil if TYPE is a type symbol for an iCalendar property."
(and (ical:type-symbol-p type)
(get type 'ical:is-property)))
(defun ical:component-type-symbol-p (type)
"Return non-nil if TYPE is a type symbol for an iCalendar component."
(and (ical:type-symbol-p type)
(get type 'ical:is-component)))
;; TODO: we could define other accessors here for the other metadata
;; properties, but at the moment I see no advantage to this; they would
;; all just be long-winded wrappers around `get'.
;; The basic, low-level API for the AST, mostly intended for use by
;; `icalendar-parser'. These functions are mostly aliases and simple
;; wrappers around functions provided by `org-element-ast', which does
;; the heavy lifting.
(defalias 'ical:ast-node-type #'org-element-type)
(defsubst ical:ast-node-value (node)
"Return the value of iCalendar syntax node NODE.
In component nodes, this is nil. Otherwise, it is a syntax node
representing an iCalendar (property or parameter) value."
(org-element-property :value node))
(defalias 'ical:ast-node-children #'org-element-contents)
;; TODO: probably don't want &rest form for this
(defalias 'ical:ast-node-set-children #'org-element-set-contents)
(defalias 'ical:ast-node-adopt-children #'org-element-adopt-elements)
(defalias 'ical:ast-node-meta-get #'org-element-property)
(defalias 'ical:ast-node-meta-set #'org-element-put-property)
(defun ical:ast-node-set-type (node type)
"Set the type of iCalendar syntax node NODE to TYPE.
This function is probably not what you want! It directly modifies the
type of NODE in-place, which could make the node invalid if its value or
children do not match the new TYPE. If you do not know in advance that
the data in NODE is compatible with the new TYPE, it is better to
construct a new syntax node."
(setcar node type))
(defun ical:ast-node-set-value (node value)
"Set the value of iCalendar syntax node NODE to VALUE."
(ical:ast-node-meta-set node :value value))
(defun ical:make-ast-node (type props &optional children)
"Construct a syntax node of TYPE with meta-properties PROPS and CHILDREN.
This is a low-level constructor. If you are constructing iCalendar
syntax nodes directly in Lisp code, consider using one of the
higher-level macros based on `icalendar-make-node-from-templates'
instead, which expand to calls to this function but also perform type
checking and validation.
TYPE should be an iCalendar type symbol. CHILDREN, if given, should be
a list of syntax nodes. In property nodes, these should be the
parameters of the property. In component nodes, these should be the
properties or subcomponents of the component. CHILDREN should otherwise
be nil.
PROPS should be a plist with any of the following keywords:
:value - in value nodes, this should be the Elisp value parsed from a
property or parameter's value string. In parameter and property nodes,
this should be a value node or list of value nodes. In component
nodes, it should not be present.
:buffer - buffer from which VALUE was parsed
:begin - position at which this node begins in BUFFER
:end - position at which this node ends in BUFFER
:value-begin - position at which VALUE begins in BUFFER
:value-end - position at which VALUE ends in BUFFER
:original-value - a string containing the original, uninterpreted value
of the node. This can differ from (a string represented by) VALUE
if e.g. a default VALUE was substituted for an unrecognized but
syntactically correct value.
:original-name - a string containing the original, uninterpreted name
of the parameter, property or component this node represents.
This can differ from (a string representing) TYPE
if e.g. a default TYPE was substituted for an unrecognized but
syntactically correct one."
;; automatically mark :value as a "secondary property" for org-element-ast
(let ((full-props (if (plist-member props :value)
(plist-put props :secondary (list :value))
props)))
(apply #'org-element-create type full-props children)))
(defun ical:ast-node-p (val)
"Return non-nil if VAL is an iCalendar syntax node."
(and (listp val)
(length> val 1)
(ical:type-symbol-p (ical:ast-node-type val))
(plistp (cadr val))
(listp (ical:ast-node-children val))))
(defun ical:param-node-p (node)
"Return non-nil if NODE is a syntax node whose type is a parameter type."
(and (ical:ast-node-p node)
(ical:param-type-symbol-p (ical:ast-node-type node))))
(defun ical:property-node-p (node)
"Return non-nil if NODE is a syntax node whose type is a property type."
(and (ical:ast-node-p node)
(ical:property-type-symbol-p (ical:ast-node-type node))))
(defun ical:component-node-p (node)
"Return non-nil if NODE is a syntax node whose type is a component type."
(and (ical:ast-node-p node)
(ical:component-type-symbol-p (ical:ast-node-type node))))
(defun ical:ast-node-first-child-of (type node)
"Return the first child of NODE of type TYPE, or nil."
(assq type (ical:ast-node-children node)))
(defun ical:ast-node-children-of (type node)
"Return a list of all the children of NODE of type TYPE."
(seq-filter (lambda (c) (eq type (ical:ast-node-type c)))
(ical:ast-node-children node)))
;; A high-level API for constructing iCalendar syntax nodes in Lisp code:
(defun ical:type-of (value &optional types)
"Find the iCalendar type symbol for the type to which VALUE belongs.
TYPES, if specified, should be a list of type symbols to check.
TYPES defaults to all type symbols listed in `icalendar-value-types'."
(require 'icalendar-parser) ; for ical:value-types, ical:list-of-p
(declare-function ical:list-of-p "icalendar-parser")
(catch 'found
(when (ical:ast-node-p value)
(throw 'found (ical:ast-node-type value)))
;; FIXME: the warning here is spurious, given that icalendar-parser
;; is require'd above:
(with-suppressed-warnings ((free-vars ical:value-types))
(dolist (type (or types (mapcar #'cdr ical:value-types)))
(if (ical:expects-list-of-values-p type)
(when (ical:list-of-p value type)
(throw 'found type))
(when (cl-typep value type)
(throw 'found type)))))))
;; A more flexible constructor for value nodes which can choose the
;; correct type from a list. This helps keep templates succinct and easy
;; to use in `icalendar-make-node-from-templates', and related macros
;; below.
(defun ical:make-value-node-of (type value)
"Make an iCalendar syntax node of type TYPE containing VALUE as its value.
TYPE should be a symbol for an iCalendar value type, and VALUE should be
a value of that type. If TYPE is the symbol \\='plain-text, VALUE should
be a string, and in that case VALUE is returned as-is.
TYPE may also be a list of type symbols; in that case, the first type in
the list which VALUE satisfies is used as the returned node's type. If
the list is nil, VALUE will be checked against all types in
`icalendar-value-types'.
If VALUE is nil, and `icalendar-boolean' is not (in) TYPE, nil is
returned. Otherwise, a \\='wrong-type-argument error is signaled if
VALUE does not satisfy (any type in) TYPE."
(require 'icalendar-parser) ; for `icalendar-list-of-p'
(cond
((and (null value)
(not (if (listp type) (memq 'ical:boolean type)
(eq 'ical:boolean type))))
;; Instead of signaling an error, we just return nil in this case.
;; This allows the `ical:make-*' macros higher up the stack to
;; filter out templates that evaluate to nil at run time:
nil)
((eq type 'plain-text)
(unless (stringp value)
(signal 'wrong-type-argument (list 'stringp value)))
value)
((symbolp type)
(unless (ical:value-type-symbol-p type)
(signal 'wrong-type-argument (list 'icalendar-value-type-symbol-p type)))
(if (ical:expects-list-of-values-p type)
(unless (ical:list-of-p value type)
(signal 'wrong-type-argument (list `(list-of ,type) value)))
(unless (cl-typep value type)
(signal 'wrong-type-argument (list type value)))
(ical:make-ast-node type (list :value value))))
((listp type)
;; N.B. nil is allowed; in that case, `ical:type-of' will check all
;; types in `ical:value-types':
(let ((the-type (ical:type-of value type)))
(if the-type
(ical:make-ast-node the-type (list :value value))
(signal 'wrong-type-argument
(list (if (length> type 1) (cons 'or type) (car type))
value)))))
(t (signal 'wrong-type-argument (list '(or symbolp listp) type)))))
(defun ical:-make-param--list (type value-type raw-values)
"Make a param node of TYPE with list of values RAW-VALUES of type VALUE-TYPE."
(let ((value (if (seq-every-p #'ical:ast-node-p raw-values)
raw-values
(mapcar
(lambda (c)
(ical:make-value-node-of value-type c))
raw-values))))
(when value
(ical:ast-node-valid-p
(ical:make-ast-node
type
(list :value value))))))
(defun ical:-make-param--nonlist (type value-type raw-value)
"Make a param node of TYPE with value RAW-VALUE of type VALUE-TYPE."
(let ((value (if (ical:ast-node-p raw-value)
raw-value
(ical:make-value-node-of value-type raw-value))))
(when value
(ical:ast-node-valid-p
(ical:make-ast-node
type
(list :value value))))))
(defmacro ical:make-param (type value)
"Construct an iCalendar parameter node of TYPE with value VALUE.
TYPE should be an iCalendar type symbol satisfying
`icalendar-param-type-symbol-p'; it should not be quoted.
VALUE should evaluate to a value appropriate for TYPE. In particular, if
TYPE expects a list of values (see `icalendar-expects-list-p'), VALUE
should be such a list. If necessary, the value(s) in VALUE will be
wrapped in syntax nodes indicating their type.
For example,
(icalendar-make-param icalendar-deltoparam
(list \"mailto:minionA@example.com\" \"mailto:minionB@example.com\"))
will return an `icalendar-deltoparam' node whose value is a list of
`icalendar-cal-address' nodes containing the two addresses.
The resulting syntax node is checked for validity by
`icalendar-ast-node-valid-p' before it is returned."
(declare (debug (symbolp form)))
;; TODO: support `ical:otherparam'
(unless (ical:param-type-symbol-p type)
(error "Not an iCalendar param type: %s" type))
(let ((value-type (or (get type 'ical:value-type) 'plain-text)))
(if (ical:expects-list-of-values-p type)
`(ical:-make-param--list ',type ',value-type ,value)
`(ical:-make-param--nonlist ',type ',value-type ,value))))
(defun ical:-make-property--list (type value-types raw-values &optional params)
"Make a property node of TYPE with list of values RAW-VALUES.
VALUE-TYPES should be a list of value types that TYPE accepts.
PARAMS, if given, should be a list of parameter nodes."
(require 'icalendar-parser) ; for `ical:maybe-add-value-param'
(declare-function ical:maybe-add-value-param "icalendar-parser")
(let ((value (if (seq-every-p #'ical:ast-node-p raw-values)
raw-values
(mapcar
(lambda (c) (ical:make-value-node-of value-types c))
raw-values))))
(when value
(ical:ast-node-valid-p
(ical:maybe-add-value-param
(ical:make-ast-node type (list :value value) params))))))
(defun ical:-make-property--nonlist (type value-types raw-value &optional params)
"Make a property node of TYPE with value RAW-VALUE.
VALUE-TYPES should be a list of value types that TYPE accepts.
PARAMS, if given, should be a list of parameter nodes."
(require 'icalendar-parser) ; for `ical:maybe-add-value-param'
(declare-function ical:maybe-add-value-param "icalendar-parser")
(let ((value (if (ical:ast-node-p raw-value)
raw-value
(ical:make-value-node-of value-types raw-value))))
(when value
(ical:ast-node-valid-p
(ical:maybe-add-value-param
(ical:make-ast-node type (list :value value) params))))))
(defmacro ical:make-property (type value &rest param-templates)
"Construct an iCalendar property node of TYPE with value VALUE.
TYPE should be an iCalendar type symbol satisfying
`icalendar-property-type-symbol-p'; it should not be quoted.
VALUE should evaluate to a value appropriate for TYPE. In particular,
if TYPE expects a list of values (see
`icalendar-expects-list-of-values-p'), VALUE should be such a list. If
necessary, the value(s) in VALUE will be wrapped in syntax nodes
indicating their type. If VALUE is not of the default value type for
TYPE, an `icalendar-valuetypeparam' will automatically be added to
PARAM-TEMPLATES.
Each element of PARAM-TEMPLATES should represent a parameter node; see
`icalendar-make-node-from-templates' for the format of such templates.
A template can also have the form (@ L), where L evaluates to a list of
parameter nodes to be added to the component.
PARAM-TEMPLATES which evaluate to nil are removed when the property node
is constructed.
For example,
(icalendar-make-property icalendar-rdate (list \\='(2 1 2025) \\='(3 1 2025)))
will return an `icalendar-rdate' node whose value is a list of
`icalendar-date' nodes containing the dates above as their values.
The resulting syntax node is checked for validity by
`icalendar-ast-node-valid-p' before it is returned."
;; TODO: support `ical:other-property', maybe like
;; (ical:other-property "X-NAME" value ...)
(declare (debug (symbolp form &rest form))
(indent 2))
(unless (ical:property-type-symbol-p type)
(error "Not an iCalendar property type: %s" type))
(let ((value-types (cons (get type 'ical:default-type)
(get type 'ical:other-types)))
params-expr children lists-of-children)
(dolist (c param-templates)
(cond ((and (listp c) (ical:type-symbol-p (car c)))
;; c is a template for a child node, so it should be
;; recursively expanded:
(push (cons 'ical:make-node-from-templates c)
children))
((and (listp c) (eq '@ (car c)))
;; c is a template (@ L) where L evaluates to a list of children:
(push (cadr c) lists-of-children))
(t
;; otherwise, just pass c through as is; this allows
;; interleaving templates with other expressions that
;; evaluate to syntax nodes:
(push c children))))
(when (or children lists-of-children)
(setq params-expr
`(seq-filter #'identity
(append (list ,@children) ,@lists-of-children))))
(if (ical:expects-list-of-values-p type)
`(ical:-make-property--list ',type ',value-types ,value ,params-expr)
`(ical:-make-property--nonlist ',type ',value-types ,value ,params-expr))))
(defmacro ical:make-component (type &rest templates)
"Construct an iCalendar component node of TYPE from TEMPLATES.
TYPE should be an iCalendar type symbol satisfying
`icalendar-component-type-symbol-p'; it should not be quoted.
Each expression in TEMPLATES should represent a child node of the
component; see `icalendar-make-node-from-templates' for the format of
such TEMPLATES. A template can also have the form (@ L), where L
evaluates to a list of child nodes to be added to the component.
Any value in TEMPLATES that evaluates to nil will be removed before the
component node is constructed.
If TYPE is `icalendar-vevent', `icalendar-vtodo', `icalendar-vjournal',
or `icalendar-vfreebusy', the properties `icalendar-dtstamp' and
`icalendar-uid' will be automatically provided, if they are absent in
TEMPLATES. Likewise, if TYPE is `icalendar-vcalendar', the properties
`icalendar-prodid', `icalendar-version', and `icalendar-calscale' will
be automatically provided if absent.
For example,
(icalendar-make-component icalendar-vevent
(icalendar-summary \"Party\")
(icalendar-location \"Robot House\")
(@ list-of-other-properties))
will return an `icalendar-vevent' node containing the provided
properties as well as `icalendar-dtstamp' and `icalendar-uid'
properties.
The resulting syntax node is checked for validity by
`icalendar-ast-node-valid-p' before it is returned."
(declare (debug (symbolp &rest form))
(indent 1))
;; TODO: support `ical:other-component', maybe like
;; (ical:other-component (:x-name "X-NAME") templates ...)
(unless (ical:component-type-symbol-p type)
(error "Not an iCalendar component type: %s" type))
;; Add templates for required properties automatically if we can:
(when (memq type '(ical:vevent ical:vtodo ical:vjournal ical:vfreebusy))
(unless (assq 'ical:dtstamp templates)
(push '(ical:dtstamp (decode-time nil t))
templates))
(unless (assq 'ical:uid templates)
(push `(ical:uid ,(ical:make-uid templates))
templates)))
(when (eq type 'ical:vcalendar)
(unless (assq 'ical:prodid templates)
(push `(ical:prodid ,ical:vcalendar-prodid)
templates))
(unless (assq 'ical:version templates)
(push `(ical:version ,ical:vcalendar-version)
templates))
(unless (assq 'ical:calscale templates)
(push '(ical:calscale "GREGORIAN")
templates)))
(when (null templates)
(error "At least one template is required"))
(let (children lists-of-children)
(dolist (c templates)
(cond ((and (listp c) (ical:type-symbol-p (car c)))
;; c is a template for a child node, so it should be
;; recursively expanded:
(push (cons 'ical:make-node-from-templates c)
children))
((and (listp c) (eq '@ (car c)))
;; c is a template (@ L) where L evaluates to a list of children:
(push (cadr c) lists-of-children))
(t
;; otherwise, just pass c through as is; this allows
;; interleaving templates with other expressions that
;; evaluate to syntax nodes:
(push c children))))
(setq children (nreverse children)
lists-of-children (nreverse lists-of-children))
(when (or children lists-of-children)
`(ical:ast-node-valid-p
(ical:make-ast-node
(quote ,type)
nil
(seq-filter #'identity
(append (list ,@children) ,@lists-of-children)))))))
;; TODO: allow disabling the validity check??
(defmacro ical:make-node-from-templates (type &rest templates)
"Construct an iCalendar syntax node of TYPE from TEMPLATES.
TYPE should be an iCalendar type symbol; it should not be quoted. This
macro (and the derived macros `icalendar-make-vcalendar',
`icalendar-make-vevent', `icalendar-make-vtodo',
`icalendar-make-vjournal', `icalendar-make-vfreebusy',
`icalendar-make-valarm', `icalendar-make-vtimezone',
`icalendar-make-standard', and `icalendar-make-daylight') makes it easy
to write iCalendar syntax nodes of TYPE as Lisp code.
Each expression in TEMPLATES represents a child node of the constructed
node. It must either evaluate to such a node, or it must have one of
the following forms:
\(VALUE-TYPE VALUE) - constructs a node of VALUE-TYPE containing the
value VALUE.
\(PARAM-TYPE VALUE) - constructs a parameter node of PARAM-TYPE
containing the VALUE.
\(PROPERTY-TYPE VALUE [PARAM ...]) - constructs a property node of
PROPERTY-TYPE containing the value VALUE and PARAMs as child
nodes. Each PARAM should be a template (PARAM-TYPE VALUE), as above,
or any other expression that evaluates to a parameter node.
\(COMPONENT-TYPE CHILD [CHILD ...]) - constructs a component node of
COMPONENT-TYPE with CHILDs as child nodes. Each CHILD should either be
a template for a property (as above), a template for a
sub-component (of the same form), or any other expression that
evaluates to an iCalendar syntax node.
If TYPE is an iCalendar component or property type, a TEMPLATE can also
have the form (@ L), where L evaluates to a list of child nodes to be
added to the component or property node.
For example, an iCalendar VEVENT could be written like this:
(icalendar-make-node-from-templates icalendar-vevent
(icalendar-dtstamp (decode-time (current-time) 0))
(icalendar-uid \"some-unique-id\")
(icalendar-summary \"Party\")
(icalendar-location \"Robot House\")
(icalendar-organizer \"mailto:bender@mars.edu\")
(icalendar-attendee \"mailto:philip.j.fry@mars.edu\"
(icalendar-partstatparam \"ACCEPTED\"))
(icalendar-attendee \"mailto:gunther@mars.edu\"
(icalendar-partstatparam \"DECLINED\"))
(icalendar-categories (list \"MISCHIEF\" \"DOUBLE SECRET PROBATION\"))
(icalendar-dtstart (icalendar-make-date-time :year 3003 :month 3 :day 13
:hour 22 :minute 0 :second 0)
(icalendar-tzidparam \"Mars/University_Time\")))
Before the constructed node is returned, it is validated by
`icalendar-ast-node-valid-p'."
(declare (debug (symbolp &rest form))
(indent 1))
(cond
((not (ical:type-symbol-p type))
(error "Not an iCalendar type symbol: %s" type))
((ical:value-type-symbol-p type)
`(ical:ast-node-valid-p
(ical:make-value-node-of (quote ,type) ,(car templates))))
((ical:param-type-symbol-p type)
`(ical:make-param ,type ,(car templates)))
((ical:property-type-symbol-p type)
`(ical:make-property ,type ,(car templates) ,@(cdr templates)))
((ical:component-type-symbol-p type)
`(ical:make-component ,type ,@templates))))
(defmacro ical:make-vcalendar (&rest templates)
"Construct an iCalendar VCALENDAR object from TEMPLATES.
See `icalendar-make-node-from-templates' for the format of TEMPLATES.
See `icalendar-vcalendar' for the permissible child types.
If TEMPLATES does not contain templates for the `icalendar-prodid' and
`icalendar-version' properties, they will be automatically added; see
the variables `icalendar-vcalendar-prodid' and
`icalendar-vcalendar-version'."
`(ical:make-node-from-templates ical:vcalendar ,@templates))
(defmacro ical:make-vevent (&rest templates)
"Construct an iCalendar VEVENT node from TEMPLATES.
See `icalendar-make-node-from-templates' for the format of TEMPLATES.
See `icalendar-vevent' for the permissible child types.
If TEMPLATES does not contain templates for the `icalendar-dtstamp' and
`icalendar-uid' properties (both required), they will be automatically
provided."
`(ical:make-node-from-templates ical:vevent ,@templates))
(defmacro ical:make-vtodo (&rest templates)
"Construct an iCalendar VTODO node from TEMPLATES.
See `icalendar-make-node-from-templates' for the format of TEMPLATES.
See `icalendar-vtodo' for the permissible child types.
If TEMPLATES does not contain templates for the `icalendar-dtstamp' and
`icalendar-uid' properties (both required), they will be automatically
provided."
`(ical:make-node-from-templates ical:vtodo ,@templates))
(defmacro ical:make-vjournal (&rest templates)
"Construct an iCalendar VJOURNAL node from TEMPLATES.
See `icalendar-make-node-from-templates' for the format of TEMPLATES.
See `icalendar-vjournal' for the permissible child types.
If TEMPLATES does not contain templates for the `icalendar-dtstamp' and
`icalendar-uid' properties (both required), they will be automatically
provided."
`(ical:make-node-from-templates ical:vjournal ,@templates))
(defmacro ical:make-vfreebusy (&rest templates)
"Construct an iCalendar VFREEBUSY node from TEMPLATES.
See `icalendar-make-node-from-templates' for the format of TEMPLATES.
See `icalendar-vfreebusy' for the permissible child types.
If TEMPLATES does not contain templates for the `icalendar-dtstamp' and
`icalendar-uid' properties (both required), they will be automatically
provided."
`(ical:make-node-from-templates ical:vfreebusy ,@templates))
(defmacro ical:make-valarm (&rest templates)
"Construct an iCalendar VALARM node from TEMPLATES.
See `icalendar-make-node-from-templates' for the format of TEMPLATES.
See `icalendar-valarm' for the permissible child types."
`(ical:make-node-from-templates ical:valarm ,@templates))
(defmacro ical:make-vtimezone (&rest templates)
"Construct an iCalendar VTIMEZONE node from TEMPLATES.
See `icalendar-make-node-from-templates' for the format of TEMPLATES.
See `icalendar-vtimezone' for the permissible child types."
`(ical:make-node-from-templates ical:vtimezone ,@templates))
(defmacro ical:make-standard (&rest templates)
"Construct an iCalendar STANDARD node from TEMPLATES.
See `icalendar-make-node-from-templates' for the format of TEMPLATES.
See `icalendar-standard' for the permissible child types."
`(ical:make-node-from-templates ical:standard ,@templates))
(defmacro ical:make-daylight (&rest templates)
"Construct an iCalendar DAYLIGHT node from TEMPLATES.
See `icalendar-make-node-from-templates' for the format of TEMPLATES.
See `icalendar-daylight' for the permissible child types."
`(ical:make-node-from-templates ical:daylight ,@templates))
;;; Validation:
;; Errors at the validation stage:
;; e.g. property/param values did not match, or are of the wrong type,
;; or required properties not present in a component
(define-error 'ical:validation-error "Invalid iCalendar data" 'ical:error)
(cl-defun ical:signal-validation-error (msg &key node (severity 2))
(signal 'ical:validation-error
(list :message msg
:buffer (ical:ast-node-meta-get :buffer node)
:position (ical:ast-node-meta-get :begin node)
:severity severity
:node node)))
(defun ical:ast-node-required-child-p (child parent)
"Return non-nil if CHILD is required by PARENT's node type."
(let* ((type (ical:ast-node-type parent))
(child-spec (get type 'ical:child-spec))
(child-type (ical:ast-node-type child)))
(or (memq child-type (plist-get child-spec :one))
(memq child-type (plist-get child-spec :one-or-more)))))
(defun ical:ast-node-valid-value-p (node)
"Validate that NODE's value satisfies the requirements of its type.
Signals an `icalendar-validation-error' if NODE's value is
invalid, or returns NODE."
(require 'icalendar-parser) ; for ical:printable-value-type-symbol-p
(declare-function ical:printable-value-type-symbol-p "icalendar-parser")
(let* ((type (ical:ast-node-type node))
(value (ical:ast-node-value node))
(valtype-param (when (ical:property-type-symbol-p type)
(ical:with-param-of node 'ical:valuetypeparam)))
(allowed-types
(cond ((ical:printable-value-type-symbol-p valtype-param)
;; with an explicit `VALUE=sometype' param, this is the
;; only allowed type:
(list valtype-param))
((and (ical:param-type-symbol-p type)
(get type 'ical:value-type))
(list (get type 'ical:value-type)))
((ical:property-type-symbol-p type)
(cons (get type 'ical:default-type)
(get type 'ical:other-types)))
(t nil))))
(cond ((ical:value-type-symbol-p type)
(unless (cl-typep value type) ; see `ical:define-type'
(ical:signal-validation-error
(format "Invalid value for `%s' node: %s" type value)
:node node))
node)
((ical:component-node-p node)
;; component types have no value, so no need to check anything
node)
((and (or (ical:param-type-symbol-p type)
(ical:property-type-symbol-p type))
(null (get type 'ical:value-type))
(stringp value))
;; property and param nodes with no value type are assumed to contain
;; strings which match a value regex:
(unless (string-match (rx-to-string (get type 'ical:value-rx)) value)
(ical:signal-validation-error
(format "Invalid string value for `%s' node: %s" type value)
:node node))
node)
;; otherwise this is a param or property node which itself
;; should have one or more syntax nodes as a value, so
;; recurse on value(s):
((ical:expects-list-of-values-p type)
(unless (listp value)
(ical:signal-validation-error
(format "Expected list of values for `%s' node" type)
:node node))
(when allowed-types
(dolist (v value)
(unless (memq (ical:ast-node-type v) allowed-types)
(ical:signal-validation-error
(format "Value of unexpected type `%s' in `%s' node"
(ical:ast-node-type v) type)
:node node))))
(mapc #'ical:ast-node-valid-value-p value)
node)
(t
(unless (ical:ast-node-p value)
(ical:signal-validation-error
(format "Invalid value for `%s' node: %s" type value)
:node node))
(when allowed-types
(unless (memq (ical:ast-node-type value) allowed-types)
(ical:signal-validation-error
(format "Value of unexpected type `%s' in `%s' node"
(ical:ast-node-type value) type)
:node node)))
(ical:ast-node-valid-value-p value)))))
(defun ical:count-children-by-type (node)
"Count NODE's children by type.
Returns an alist mapping type symbols to the number of NODE's children
of that type."
(let ((children (ical:ast-node-children node))
(map nil))
(dolist (child children map)
(let* ((type (ical:ast-node-type child))
(n (alist-get type map)))
(setf (alist-get type map) (1+ (or n 0)))))))
(defun ical:ast-node-valid-children-p (node)
"Validate that NODE's children satisfy its type's :child-spec.
The :child-spec is associated with NODE's type by
`icalendar-define-component', `icalendar-define-property',
`icalendar-define-param', or `icalendar-define-type', which see.
Signals an `icalendar-validation-error' if NODE is invalid, or returns
NODE.
Note that this function does not check that the children of NODE
are themselves valid; for that, see `ical:ast-node-valid-p'."
(let* ((type (ical:ast-node-type node))
(child-spec (get type 'ical:child-spec))
(child-counts (ical:count-children-by-type node)))
(when child-spec
(dolist (child-type (plist-get child-spec :one))
(unless (= 1 (alist-get child-type child-counts 0))
(ical:signal-validation-error
(format "iCalendar `%s' node must contain exactly one `%s'"
type child-type)
:node node)))
(dolist (child-type (plist-get child-spec :one-or-more))
(unless (<= 1 (alist-get child-type child-counts 0))
(ical:signal-validation-error
(format "iCalendar `%s' node must contain one or more `%s'"
type child-type)
:node node)))
(dolist (child-type (plist-get child-spec :zero-or-one))
(unless (<= (alist-get child-type child-counts 0)
1)
(ical:signal-validation-error
(format "iCalendar `%s' node may contain at most one `%s'"
type child-type)
:node node)))
;; check that all child nodes are allowed:
(unless (plist-get child-spec :allow-others)
(let ((allowed-types (append (plist-get child-spec :one)
(plist-get child-spec :one-or-more)
(plist-get child-spec :zero-or-one)
(plist-get child-spec :zero-or-more)))
(appearing-types (mapcar #'car child-counts)))
(dolist (child-type appearing-types)
(unless (member child-type allowed-types)
(ical:signal-validation-error
(format "`%s' may not contain `%s'" type child-type)
:node node))))))
;; success:
node))
(defun ical:ast-node-valid-p (node &optional recursively)
"Check that NODE is a valid iCalendar syntax node.
By default, the check will only validate NODE itself, but if
RECURSIVELY is non-nil, it will recursively check all its
descendants as well. Signals an `icalendar-validation-error' if
NODE is invalid, or returns NODE."
(unless (ical:ast-node-p node)
(ical:signal-validation-error
"Not an iCalendar syntax node"
:node node))
(ical:ast-node-valid-value-p node)
(ical:ast-node-valid-children-p node)
(let* ((type (ical:ast-node-type node))
(other-validator (get type 'ical:other-validator)))
(unless (ical:type-symbol-p type)
(ical:signal-validation-error
(format "Node's type `%s' is not an iCalendar type symbol" type)
:node node))
(when (and other-validator (not (functionp other-validator)))
(ical:signal-validation-error
(format "Bad validator function `%s' for type `%s'" other-validator type)))
(when other-validator
(funcall other-validator node)))
(when recursively
(dolist (c (ical:ast-node-children node))
(ical:ast-node-valid-p c recursively)))
;; success:
node)
(provide 'icalendar-ast)
;; Local Variables:
;; read-symbol-shorthands: (("ical:" . "icalendar-"))
;; End:
;;; icalendar-ast.el ends here

1134
lisp/calendar/icalendar-macs.el Normal file
View file

File diff suppressed because it is too large Load diff

611
lisp/calendar/icalendar-mode.el Normal file
View file

@ -0,0 +1,611 @@
;;; icalendar-mode.el --- Major mode for iCalendar format -*- lexical-binding: t; -*-
;;;
;; Copyright (C) 2024 Free Software Foundation, Inc.
;; Author: Richard Lawrence <rwl@recursewithless.net>
;; Created: October 2024
;; Keywords: calendar
;; Human-Keywords: calendar, iCalendar
;; This file is part of GNU Emacs.
;; This file 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.
;; This file 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 this file. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This file defines icalendar-mode, a major mode for iCalendar data.
;; Its main job is to provide syntax highlighting using the matching
;; functions created for iCalendar syntax in icalendar-parser.el, and to
;; perform line unfolding and folding via format conversion.
;; When activated, icalendar-mode unfolds content lines if necessary.
;; This is because the parsing functions, and thus syntax highlighting,
;; assume that content lines have already been unfolded. When a buffer
;; is saved, icalendar-mode also automatically folds long content if
;; necessary, as required by RFC5545.
;;; Code:
(require 'icalendar-parser)
(require 'format)
;; Faces and font lock:
(defgroup ical:faces
'((ical:property-name custom-face)
(ical:property-value custom-face)
(ical:parameter-name custom-face)
(ical:parameter-value custom-face)
(ical:component-name custom-face)
(ical:keyword custom-face)
(ical:binary-data custom-face)
(ical:date-time-types custom-face)
(ical:numeric-types custom-face)
(ical:recurrence-rule custom-face)
(ical:warning custom-face)
(ical:ignored custom-face))
"Faces for `icalendar-mode'."
:version "31.1"
:group 'icalendar
:prefix 'icalendar)
(defface ical:property-name
'((default . (:inherit font-lock-keyword-face)))
"Face for iCalendar property names.")
(defface ical:property-value
'((default . (:inherit default)))
"Face for iCalendar property values.")
(defface ical:parameter-name
'((default . (:inherit font-lock-property-name-face)))
"Face for iCalendar parameter names.")
(defface ical:parameter-value
'((default . (:inherit font-lock-property-use-face)))
"Face for iCalendar parameter values.")
(defface ical:component-name
'((default . (:inherit font-lock-constant-face)))
"Face for iCalendar component names.")
(defface ical:keyword
'((default . (:inherit font-lock-keyword-face)))
"Face for other iCalendar keywords.")
(defface ical:binary-data
'((default . (:inherit font-lock-comment-face)))
"Face for iCalendar values that represent binary data.")
(defface ical:date-time-types
'((default . (:inherit font-lock-type-face)))
"Face for iCalendar values that represent time.
These include dates, date-times, durations, periods, and UTC offsets.")
(defface ical:numeric-types
'((default . (:inherit ical:property-value-face)))
"Face for iCalendar values that represent integers, floats, and geolocations.")
(defface ical:recurrence-rule
'((default . (:inherit font-lock-type-face)))
"Face for iCalendar recurrence rule values.")
(defface ical:uri
'((default . (:inherit ical:property-value-face :underline t)))
"Face for iCalendar values that are URIs (including URLs and mail addresses).")
(defface ical:warning
'((default . (:inherit font-lock-warning-face)))
"Face for iCalendar syntax errors.")
(defface ical:ignored
'((default . (:inherit font-lock-comment-face)))
"Face for iCalendar syntax which is parsed but ignored.")
;;; Font lock:
(defconst ical:params-font-lock-keywords
'((ical:match-other-param
(1 'font-lock-comment-face t t)
(2 'font-lock-comment-face t t)
(3 'ical:warning t t))
(ical:match-value-param
(1 'ical:parameter-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t))
(ical:match-tzid-param
(1 'ical:parameter-name t t)
(2 'ical:parameter-value t t)
(3 'ical:warning t t))
(ical:match-sent-by-param
(1 'ical:parameter-name t t)
(2 'ical:uri t t)
(3 'ical:warning t t))
(ical:match-rsvp-param
(1 'ical:parameter-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t))
(ical:match-role-param
(1 'ical:parameter-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t))
(ical:match-reltype-param
(1 'ical:parameter-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t))
(ical:match-related-param
(1 'ical:parameter-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t))
(ical:match-range-param
(1 'ical:parameter-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t))
(ical:match-partstat-param
(1 'ical:parameter-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t))
(ical:match-member-param
(1 'ical:parameter-name t t)
(2 'ical:uri t t)
(3 'ical:warning t t))
(ical:match-language-param
(1 'ical:parameter-name t t)
(2 'ical:parameter-value t t)
(3 'ical:warning t t))
(ical:match-fbtype-param
(1 'ical:parameter-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t))
(ical:match-fmttype-param
(1 'ical:parameter-name t t)
(2 'ical:parameter-value t t)
(3 'ical:warning t t))
(ical:match-encoding-param
(1 'ical:parameter-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t))
(ical:match-dir-param
(1 'ical:parameter-name t t)
(2 'ical:uri t t)
(3 'ical:warning t t))
(ical:match-delegated-to-param
(1 'ical:parameter-name t t)
(2 'ical:uri t t)
(3 'ical:warning t t))
(ical:match-delegated-from-param
(1 'ical:parameter-name t t)
(2 'ical:uri t t)
(3 'ical:warning t t))
(ical:match-cutype-param
(1 'ical:parameter-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t))
(ical:match-cn-param
(1 'ical:parameter-name t t)
(2 'ical:parameter-value t t)
(3 'ical:warning t t))
(ical:match-altrep-param
(1 'ical:parameter-name t t)
(2 'ical:uri t t)
(3 'ical:warning t t)))
"Entries for iCalendar property parameters in `font-lock-keywords'.")
(defconst ical:properties-font-lock-keywords
'((ical:match-request-status-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-other-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-sequence-property
(1 'ical:property-name t t)
(2 'ical:numeric-types t t)
(3 'ical:warning t t))
(ical:match-last-modified-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-dtstamp-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-created-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-trigger-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-repeat-property
(1 'ical:property-name t t)
(2 'ical:numeric-types t t)
(3 'ical:warning t t))
(ical:match-action-property
(1 'ical:property-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t))
(ical:match-rrule-property
(1 'ical:property-name t t)
(2 'ical:recurrence-rule t t)
(3 'ical:warning t t))
(ical:match-rdate-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-exdate-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-uid-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-url-property
(1 'ical:property-name t t)
(2 'ical:uri t t)
(3 'ical:warning t t))
(ical:match-related-to-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-recurrence-id-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-organizer-property
(1 'ical:property-name t t)
(2 'ical:uri t t)
(3 'ical:warning t t))
(ical:match-contact-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-attendee-property
(1 'ical:property-name t t)
(2 'ical:uri t t)
(3 'ical:warning t t))
(ical:match-tzurl-property
(1 'ical:property-name t t)
(2 'ical:uri t t)
(3 'ical:warning t t))
(ical:match-tzoffsetto-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-tzoffsetfrom-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-tzname-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-tzid-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-transp-property
(1 'ical:property-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t))
(ical:match-freebusy-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-duration-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-dtstart-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-due-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-dtend-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-completed-property
(1 'ical:property-name t t)
(2 'ical:date-time-types t t)
(3 'ical:warning t t))
(ical:match-summary-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-status-property
(1 'ical:property-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t))
(ical:match-resources-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-priority-property
(1 'ical:property-name t t)
(2 'ical:numeric-types t t)
(3 'ical:warning t t))
(ical:match-percent-complete-property
(1 'ical:property-name t t)
(2 'ical:numeric-types t t)
(3 'ical:warning t t))
(ical:match-location-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-geo-property
(1 'ical:property-name t t)
(2 'ical:numeric-types t t)
(3 'ical:warning t t))
(ical:match-description-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-comment-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-class-property
(1 'ical:property-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t))
(ical:match-categories-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-attach-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t)
(13 'ical:uri t t)
(14 'ical:binary-data t t))
(ical:match-version-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-prodid-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-method-property
(1 'ical:property-name t t)
(2 'ical:property-value t t)
(3 'ical:warning t t))
(ical:match-calscale-property
(1 'ical:property-name t t)
(2 'ical:keyword t t)
(3 'ical:warning t t)))
"Entries for iCalendar properties in `font-lock-keywords'.")
(defconst ical:ignored-properties-font-lock-keywords
`((,(rx ical:other-property) (1 'ical:ignored keep t)
(2 'ical:ignored keep t)))
"Entries for iCalendar ignored properties in `font-lock-keywords'.")
(defconst ical:components-font-lock-keywords
'((ical:match-vcalendar-component
(1 'ical:keyword t t)
(2 'ical:component-name t t))
(ical:match-other-component
(1 'ical:keyword t t)
(2 'ical:component-name t t))
(ical:match-valarm-component
(1 'ical:keyword t t)
(2 'ical:component-name t t))
(ical:match-daylight-component
(1 'ical:keyword t t)
(2 'ical:component-name t t))
(ical:match-standard-component
(1 'ical:keyword t t)
(2 'ical:component-name t t))
(ical:match-vtimezone-component
(1 'ical:keyword t t)
(2 'ical:component-name t t))
(ical:match-vfreebusy-component
(1 'ical:keyword t t)
(2 'ical:component-name t t))
(ical:match-vjournal-component
(1 'ical:keyword t t)
(2 'ical:component-name t t))
(ical:match-vtodo-component
(1 'ical:keyword t t)
(2 'ical:component-name t t))
(ical:match-vevent-component
(1 'ical:keyword t t)
(2 'ical:component-name t t)))
"Entries for iCalendar components in `font-lock-keywords'.")
(defvar ical:font-lock-keywords
(append ical:params-font-lock-keywords
ical:properties-font-lock-keywords
ical:components-font-lock-keywords
ical:ignored-properties-font-lock-keywords)
"Value of `font-lock-keywords' for `icalendar-mode'.")
;; The major mode:
;;; Mode hook
(defvar ical:mode-hook nil
"Hook run when activating `icalendar-mode'.")
;;; Activating the mode for .ics files:
(add-to-list 'auto-mode-alist '("\\.ics\\'" . icalendar-mode))
;;; Syntax table
(defvar ical:mode-syntax-table
(let ((st (make-syntax-table)))
;; Characters for which the standard syntax table suffices:
;; ; (punctuation): separates some property values, and property parameters
;; " (string): begins and ends string values
;; : (punctuation): separates property name (and parameters) from property
;; values
;; , (punctuation): separates values in a list
;; CR, LF (whitespace): content line endings
;; space (whitespace): when at the beginning of a line, continues the
;; previous line
;; Characters which need to be adjusted from the standard syntax table:
;; = is punctuation, not a symbol constituent:
(modify-syntax-entry ?= ". " st)
;; / is punctuation, not a symbol constituent:
(modify-syntax-entry ?/ ". " st)
st)
"Syntax table used in `icalendar-mode'.")
;;; Coding systems
;; Provide a hint to the decoding system that iCalendar files use DOS
;; line endings. This appears to be the simplest way to ensure that
;; `find-file' will correctly decode an iCalendar file, since decoding
;; happens before icalendar-mode starts.
(add-to-list 'file-coding-system-alist '("\\.ics\\'" . undecided-dos))
;;; Format conversion
;; We use the format conversion infrastructure provided by format.el,
;; `insert-file-contents', and `write-region' to automatically perform
;; line unfolding when icalendar-mode starts in a buffer, and line
;; folding when it is saved to a file. See Info node `(elisp)Format
;; Conversion' for more.
(defconst ical:format-definition
'(text/calendar "iCalendar format"
nil ; no regexp - icalendar-mode runs decode instead
ical:unfold-region ; decoding function
ical:folding-annotations ; encoding function
nil ; encoding function does not modify buffer
nil ; no need to activate a minor mode
t) ; preserve the format when saving
"Entry for iCalendar format in `format-alist'.")
(add-to-list 'format-alist ical:format-definition)
(defun ical:-format-decode-buffer ()
"Call `format-decode-buffer' with the \\='text/calendar format.
This function is intended to be run from `icalendar-mode-hook'."
(format-decode-buffer 'text/calendar))
(add-hook 'ical:mode-hook #'ical:-format-decode-buffer -90)
(defun ical:-disable-auto-fill ()
"Disable `auto-fill-mode' in iCalendar buffers.
Auto-fill-mode interferes with line folding and syntax highlighting, so
it is off by default in iCalendar buffers. This function is intended to
be run from `icalendar-mode-hook'."
(when auto-fill-function
(auto-fill-mode -1)))
(add-hook 'ical:mode-hook #'ical:-disable-auto-fill -91)
;;; Commands
(defun ical:switch-to-unfolded-buffer ()
"Switch to a new buffer with content lines unfolded.
The new buffer will contain the same data as the current buffer, but
with content lines unfolded (before decoding, if possible).
`Folding' means inserting a line break and a single whitespace
character to continue lines longer than 75 octets; `unfolding'
means removing the extra whitespace inserted by folding. The
iCalendar standard (RFC5545) requires folding lines when
serializing data to iCalendar format, and unfolding before
parsing it. In `icalendar-mode', folded lines may not have proper
syntax highlighting; this command allows you to view iCalendar
data with proper syntax highlighting, as the parser sees it.
If the current buffer is visiting a file, this function will
offer to save the buffer first, and then reload the contents from
the file, performing unfolding with `icalendar-unfold-undecoded-region'
before decoding it. This is the most reliable way to unfold lines.
If it is not visiting a file, it will unfold the new buffer
with `icalendar-unfold-region'. This can in some cases have
undesirable effects (see its docstring), so the original contents
are preserved unchanged in the current buffer.
In both cases, after switching to the new buffer, this command
offers to kill the original buffer.
It is recommended to turn off `auto-fill-mode' when viewing an
unfolded buffer, so that filling does not interfere with syntax
highlighting. This function offers to disable `auto-fill-mode' if
it is enabled in the new buffer; consider using
`visual-line-mode' instead."
(interactive)
(when (and buffer-file-name (buffer-modified-p))
(when (y-or-n-p (format "Save before reloading from %s?"
(file-name-nondirectory buffer-file-name)))
(save-buffer)))
(let ((old-buffer (current-buffer))
(mmode major-mode)
(uf-buffer (if buffer-file-name
(ical:unfolded-buffer-from-file buffer-file-name)
(ical:unfolded-buffer-from-buffer (current-buffer)))))
(switch-to-buffer uf-buffer)
;; restart original major mode, in case the new buffer is
;; still in fundamental-mode: TODO: is this necessary?
(funcall mmode)
(when (y-or-n-p (format "Unfolded buffer is shown. Kill %s?"
(buffer-name old-buffer)))
(kill-buffer old-buffer))
(when (and auto-fill-function (y-or-n-p "Disable auto-fill-mode?"))
(auto-fill-mode -1))))
;;; Mode definition
;;;###autoload
(define-derived-mode icalendar-mode text-mode "iCalendar"
"Major mode for viewing and editing iCalendar (RFC5545) data.
This mode provides syntax highlighting for iCalendar components,
properties, values, and property parameters, and defines a format to
automatically handle folding and unfolding iCalendar content lines.
`Folding' means inserting whitespace characters to continue long
lines; `unfolding' means removing the extra whitespace inserted
by folding. The iCalendar standard requires folding lines when
serializing data to iCalendar format, and unfolding before
parsing it.
Thus icalendar-mode's syntax highlighting is designed to work with
unfolded lines. When `icalendar-mode' is activated in a buffer, it will
automatically unfold lines using a file format conversion, and
automatically fold lines when saving the buffer to a file; see Info
node `(elisp)Format Conversion' for more information. It also disables
`auto-fill-mode' if it is active, since filling interferes with line
folding and syntax highlighting. Consider using `visual-line-mode' in
`icalendar-mode' instead."
:group 'icalendar
:syntax-table ical:mode-syntax-table
;; TODO: Keymap?
;; TODO: buffer-local variables?
;; TODO: indent-line-function and indentation variables
;; TODO: mode-specific menu and context menus
;; TODO: eldoc integration
;; TODO: completion of keywords
(progn
(setq font-lock-defaults '(ical:font-lock-keywords nil t))))
(provide 'icalendar-mode)
;; Local Variables:
;; read-symbol-shorthands: (("ical:" . "icalendar-"))
;; End:
;;; icalendar-mode.el ends here

4887
lisp/calendar/icalendar-parser.el Normal file
View file

File diff suppressed because it is too large Load diff

2148
lisp/calendar/icalendar-recur.el Normal file
View file

File diff suppressed because it is too large Load diff

754
lisp/calendar/icalendar-utils.el Normal file
View file

@ -0,0 +1,754 @@
;;; icalendar-utils.el --- iCalendar utility functions -*- lexical-binding: t; -*-
;; Copyright (C) 2024 Richard Lawrence
;; Author: Richard Lawrence <rwl@recursewithless.net>
;; Created: January 2025
;; Keywords: calendar
;; This file is part of GNU Emacs.
;; This file 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.
;; This file 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 this file. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This file contains a variety of utility functions to work with
;; iCalendar data which are used throughout the rest of the iCalendar
;; library. Most of the functions here deal with calendar and clock
;; arithmetic, and help smooth over the type distinction between plain
;; dates and date-times.
;;; Code:
(require 'cl-lib)
(require 'calendar)
(eval-when-compile (require 'icalendar-macs))
(require 'icalendar-parser)
;; Accessors for commonly used properties
(defun ical:component-dtstart (component)
"Return the value of the `icalendar-dtstart' property of COMPONENT.
COMPONENT can be any component node."
(ical:with-property-of component 'ical:dtstart nil value))
(defun ical:component-dtend (component)
"Return the value of the `icalendar-dtend' property of COMPONENT.
COMPONENT can be any component node."
(ical:with-property-of component 'ical:dtend nil value))
(defun ical:component-rdate (component)
"Return the value of the `icalendar-rdate' property of COMPONENT.
COMPONENT can be any component node."
(ical:with-property-of component 'ical:rdate nil value))
(defun ical:component-summary (component)
"Return the value of the `icalendar-summary' property of COMPONENT.
COMPONENT can be any component node."
(ical:with-property-of component 'ical:summary nil value))
(defun ical:component-description (component)
"Return the value of the `icalendar-description' property of COMPONENT.
COMPONENT can be any component node."
(ical:with-property-of component 'ical:description nil value))
(defun ical:component-tzname (component)
"Return the value of the `icalendar-tzname' property of COMPONENT.
COMPONENT can be any component node."
(ical:with-property-of component 'ical:tzname nil value))
(defun ical:component-uid (component)
"Return the value of the `icalendar-uid' property of COMPONENT.
COMPONENT can be any component node."
(ical:with-property-of component 'ical:uid nil value))
(defun ical:component-url (component)
"Return the value of the `icalendar-url' property of COMPONENT.
COMPONENT can be any component node."
(ical:with-property-of component 'ical:url nil value))
(defun ical:property-tzid (property)
"Return the value of the `icalendar-tzid' parameter of PROPERTY."
(ical:with-param-of property 'ical:tzidparam nil value))
;; String manipulation
(defun ical:trimp (s &optional trim-left trim-right)
"Like `string-trim', but return nil if the trimmed string is empty."
(when (and s (stringp s))
(let ((trimmed (string-trim s trim-left trim-right)))
(unless (equal "" trimmed) trimmed))))
(defun ical:strip-mailto (s)
"Remove \"mailto:\" case-insensitively from the start of S."
(let ((case-fold-search t))
(replace-regexp-in-string "^mailto:" "" s)))
;; Date/time
;; N.B. Notation: "date/time" is used in function names when a function
;; can accept either `icalendar-date' or `icalendar-date-time' values;
;; in contrast, "date-time" means it accepts *only*
;; `icalendar-date-time' values, not plain dates.
;; TODO: turn all the 'date/time' functions into methods dispatched by
;; type?
(defun ical:date-time-to-date (dt)
"Convert an `icalendar-date-time' value DT to an `icalendar-date'."
(list (decoded-time-month dt)
(decoded-time-day dt)
(decoded-time-year dt)))
(cl-defun ical:date-to-date-time (dt &key (hour 0) (minute 0) (second 0) (tz nil))
"Convert an `icalendar-date' value DT to an `icalendar-date-time'.
The following keyword arguments are accepted:
:hour, :minute, :second - integers representing a local clock time on date DT
:tz - an `icalendar-vtimezone' in which to interpret this clock time
If these arguments are all unspecified, the hour, minute, and second
slots of the returned date-time will be zero, and it will contain no
time zone information. See `icalendar-make-date-time' for more on these
arguments."
(ical:make-date-time
:year (calendar-extract-year dt)
:month (calendar-extract-month dt)
:day (calendar-extract-day dt)
:hour hour
:minute minute
:second second
:tz tz))
(defun ical:date/time-to-date (dt)
"Extract a Gregorian date from DT.
An `icalendar-date' value is returned unchanged.
An `icalendar-date-time' value is converted to an `icalendar-date'."
(if (cl-typep dt 'ical:date)
dt
(ical:date-time-to-date dt)))
;; Type-aware accessors for date/time slots that work for both ical:date
;; and ical:date-time:
;; NOTE: cl-typecase ONLY works here if dt is valid according to
;; `ical:-decoded-date-time-p'! May need to adjust this if it's
;; necessary to work with incomplete decoded-times
(defun ical:date/time-year (dt)
"Return DT's year slot.
DT may be either an `icalendar-date' or an `icalendar-date-time'."
(cl-typecase dt
(ical:date (calendar-extract-year dt))
(ical:date-time (decoded-time-year dt))))
(defun ical:date/time-month (dt)
"Return DT's month slot.
DT may be either an `icalendar-date' or an `icalendar-date-time'."
(cl-typecase dt
(ical:date (calendar-extract-month dt))
(ical:date-time (decoded-time-month dt))))
(defun ical:date/time-monthday (dt)
"Return DT's day of the month slot.
DT may be either an `icalendar-date' or an `icalendar-date-time'."
(cl-typecase dt
(ical:date (calendar-extract-day dt))
(ical:date-time (decoded-time-day dt))))
(defun ical:date/time-weekno (dt &optional weekstart)
"Return DT's ISO week number.
DT may be either an `icalendar-date' or an `icalendar-date-time'.
WEEKSTART defaults to 1; it represents the day which starts the week,
and should be an integer between 0 (= Sunday) and 6 (= Saturday)."
;; TODO: Add support for weekstart.
;; calendar-iso-from-absolute doesn't support this yet.
(when (and weekstart (not (= weekstart 1)))
(error "Support for WEEKSTART other than 1 (=Monday) not implemented yet"))
(let* ((gdate (ical:date/time-to-date dt))
(isodate (calendar-iso-from-absolute
(calendar-absolute-from-gregorian gdate)))
(weekno (car isodate)))
weekno))
(defun ical:date/time-weekday (dt)
"Return DT's day of the week.
DT may be either an `icalendar-date' or an `icalendar-date-time'."
(cl-typecase dt
(ical:date (calendar-day-of-week dt))
(ical:date-time
(or (decoded-time-weekday dt)
;; compensate for possibly-nil weekday slot if the date-time
;; has been constructed by `make-decoded-time'; cf. comment
;; in `icalendar--decoded-date-time-p':
(calendar-day-of-week (ical:date-time-to-date dt))))))
(defun ical:date/time-hour (dt)
"Return DT's hour slot, or nil.
DT may be either an `icalendar-date' or an `icalendar-date-time'."
(when (cl-typep dt 'ical:date-time)
(decoded-time-hour dt)))
(defun ical:date/time-minute (dt)
"Return DT's minute slot, or nil.
DT may be either an `icalendar-date' or an `icalendar-date-time'."
(when (cl-typep dt 'ical:date-time)
(decoded-time-minute dt)))
(defun ical:date/time-second (dt)
"Return DT's second slot, or nil.
DT may be either an `icalendar-date' or an `icalendar-date-time'."
(when (cl-typep dt 'ical:date-time)
(decoded-time-second dt)))
(defun ical:date/time-zone (dt)
"Return DT's time zone slot, or nil.
DT may be either an `icalendar-date' or an `icalendar-date-time'."
(when (cl-typep dt 'ical:date-time)
(decoded-time-zone dt)))
;;; Date/time comparisons and arithmetic:
(defun ical:date< (dt1 dt2)
"Return non-nil if date DT1 is strictly earlier than date DT2.
DT1 and DT2 must both be `icalendar-date' values of the form (MONTH DAY YEAR)."
(< (calendar-absolute-from-gregorian dt1)
(calendar-absolute-from-gregorian dt2)))
(defun ical:date<= (dt1 dt2)
"Return non-nil if date DT1 is earlier than or the same date as DT2.
DT1 and DT2 must both be `icalendar-date' values of the form (MONTH DAY YEAR)."
(or (calendar-date-equal dt1 dt2) (ical:date< dt1 dt2)))
(defun ical:date-time-locally-earlier (dt1 dt2 &optional or-equal)
"Return non-nil if date-time DT1 is locally earlier than DT2.
Unlike `icalendar-date-time<', this function assumes both times are
local to some time zone and does not consider their zone information.
If OR-EQUAL is non-nil, this function acts like `<=' rather than `<':
it will return non-nil if DT1 and DT2 are locally the same time."
(let ((year1 (decoded-time-year dt1))
(year2 (decoded-time-year dt2))
(month1 (decoded-time-month dt1))
(month2 (decoded-time-month dt2))
(day1 (decoded-time-day dt1))
(day2 (decoded-time-day dt2))
(hour1 (decoded-time-hour dt1))
(hour2 (decoded-time-hour dt2))
(minute1 (decoded-time-minute dt1))
(minute2 (decoded-time-minute dt2))
(second1 (decoded-time-second dt1))
(second2 (decoded-time-second dt2)))
(or (< year1 year2)
(and (= year1 year2)
(or (< month1 month2)
(and (= month1 month2)
(or (< day1 day2)
(and (= day1 day2)
(or (< hour1 hour2)
(and (= hour1 hour2)
(or (< minute1 minute2)
(and (= minute1 minute2)
(if or-equal
(<= second1 second2)
(< second1 second2))))))))))))))
(defun ical:date-time-locally< (dt1 dt2)
"Return non-nil if date-time DT1 is locally strictly earlier than DT2.
Unlike `icalendar-date-time<', this function assumes both times are
local to some time zone and does not consider their zone information."
(ical:date-time-locally-earlier dt1 dt2 nil))
(defun ical:date-time-locally<= (dt1 dt2)
"Return non-nil if date-time DT1 is locally earlier than, or equal to, DT2.
Unlike `icalendar-date-time<=', this function assumes both times are
local to some time zone and does not consider their zone information."
(ical:date-time-locally-earlier dt1 dt2 t))
(defun ical:date-time< (dt1 dt2)
"Return non-nil if date-time DT1 is strictly earlier than DT2.
DT1 and DT2 must both be decoded times, and either both or neither
should have time zone information.
If one has a time zone offset and the other does not, the offset
returned from `current-time-zone' is used as the missing offset; if
`current-time-zone' cannot provide this information, an error is
signaled."
(let ((zone1 (decoded-time-zone dt1))
(zone2 (decoded-time-zone dt2)))
(cond ((and (integerp zone1) (integerp zone2))
(time-less-p (encode-time dt1) (encode-time dt2)))
((and (null zone1) (null zone2))
(ical:date-time-locally< dt1 dt2))
(t
;; Cf. RFC5545 Sec. 3.3.5:
;; "The recipient of an iCalendar object with a property value
;; consisting of a local time, without any relative time zone
;; information, SHOULD interpret the value as being fixed to whatever
;; time zone the "ATTENDEE" is in at any given moment. This means
;; that two "Attendees", in different time zones, receiving the same
;; event definition as a floating time, may be participating in the
;; event at different actual times. Floating time SHOULD only be
;; used where that is the reasonable behavior."
;; I'm interpreting this to mean that if we get here, where
;; one date-time has zone information and the other doesn't,
;; we should use the offset from (current-time-zone).
(let* ((user-tz (current-time-zone))
(user-offset (car user-tz))
(dt1z (ical:date-time-variant dt1 :zone (or zone1 user-offset)))
(dt2z (ical:date-time-variant dt2 :zone (or zone2 user-offset))))
(if user-offset
(time-less-p (encode-time dt1z) (encode-time dt2z))
(error "Too little zone information for comparison: %s %s"
dt1 dt2)))))))
;; Two different notions of equality are relevant to decoded times:
;; strict equality (`icalendar-date-time=') of all slots, or
;; simultaneity (`icalendar-date-time-simultaneous-p').
;; Most tests probably want the strict notion, because it distinguishes
;; between simultaneous events decoded into different time zones,
;; whereas most user-facing functions (e.g. sorting events by date and time)
;; probably want simultaneity.
(defun ical:date-time= (dt1 dt2)
"Return non-nil if DT1 and DT2 are decoded-times with identical slot values.
Note that this function returns nil if DT1 and DT2 represent times in
different time zones, even if they are simultaneous. For the latter, see
`icalendar-date-time-simultaneous-p'."
(equal dt1 dt2))
(defun ical:date-time-locally-simultaneous-p (dt1 dt2)
"Return non-nil if DT1 and DT2 are locally simultaneous date-times.
Note that this function ignores zone information in dt1 and dt2. It
returns non-nil if DT1 and DT2 represent the same clock time in
different time zones, even if they encode to different absolute times."
(and (eq (decoded-time-year dt1) (decoded-time-year dt2))
(eq (decoded-time-month dt1) (decoded-time-month dt2))
(eq (decoded-time-day dt1) (decoded-time-day dt2))
(eq (decoded-time-hour dt1) (decoded-time-hour dt2))
(eq (decoded-time-minute dt1) (decoded-time-minute dt2))
(eq (decoded-time-second dt1) (decoded-time-second dt2))))
(defun ical:date-time-simultaneous-p (dt1 dt2)
"Return non-nil if DT1 and DT2 are simultaneous date-times.
This function returns non-nil if DT1 and DT2 encode to the same Lisp
timestamp. Thus they can count as simultaneous even if they represent
times in different timezones. If both date-times lack an offset from
UTC, they are treated as simultaneous if they encode to the same
timestamp in UTC.
If only one date-time has an offset, they are treated as
non-simultaneous if they represent different clock times according to
`icalendar-date-time-locally-simultaneous-p'. Otherwise an error is
signaled."
(let ((zone1 (decoded-time-zone dt1))
(zone2 (decoded-time-zone dt2)))
(cond ((and (integerp zone1) (integerp zone2))
(time-equal-p (encode-time dt1) (encode-time dt2)))
((and (null zone1) (null zone2))
(time-equal-p (encode-time (ical:date-time-variant dt1 :zone 0))
(encode-time (ical:date-time-variant dt2 :zone 0))))
(t
;; Best effort:
;; TODO: I'm not convinced this is the right thing to do yet.
;; Might want to be stricter here and fix the problem of comparing
;; times with and without zone information elsewhere.
(if (ical:date-time-locally-simultaneous-p dt1 dt2)
(error "Missing zone information: %s %s" dt1 dt2)
nil)))))
(defun ical:date-time<= (dt1 dt2)
"Return non-nil if DT1 is earlier than, or simultaneous with, DT2.
DT1 and DT2 must both be decoded times, and either both or neither must have
time zone information."
(or (ical:date-time< dt1 dt2)
(ical:date-time-simultaneous-p dt1 dt2)))
(defun ical:date/time< (dt1 dt2)
"Return non-nil if DT1 is strictly earlier than DT2.
DT1 and DT2 must be either `icalendar-date' or `icalendar-date-time'
values. If they are not of the same type, only the date in the
`icalendar-date-time' value will be considered."
(cl-typecase dt1
(ical:date
(if (cl-typep dt2 'ical:date)
(ical:date< dt1 dt2)
(ical:date< dt1 (ical:date-time-to-date dt2))))
(ical:date-time
(if (cl-typep dt2 'ical:date-time)
(ical:date-time< dt1 dt2)
(ical:date< (ical:date-time-to-date dt1) dt2)))))
(defun ical:date/time<= (dt1 dt2)
"Return non-nil if DT1 is earlier than or simultaneous to DT2.
DT1 and DT2 must be either `icalendar-date' or `icalendar-date-time'
values. If they are not of the same type, only the date in the
`icalendar-date-time' value will be considered."
(cl-typecase dt1
(ical:date
(if (cl-typep dt2 'ical:date)
(ical:date<= dt1 dt2)
(ical:date<= dt1 (ical:date-time-to-date dt2))))
(ical:date-time
(if (cl-typep dt2 'ical:date-time)
(ical:date-time<= dt1 dt2)
(ical:date<= (ical:date-time-to-date dt1) dt2)))))
(defun ical:date/time-min (&rest dts)
"Return the earliest date or date-time among DTS.
The DTS may be any `icalendar-date' or `icalendar-date-time' values, and
will be ordered by `icalendar-date/time<='."
(car (sort dts :lessp #'ical:date/time<=)))
(defun ical:date/time-max (&rest dts)
"Return the latest date or date-time among DTS.
The DTS may be any `icalendar-date' or `icalendar-date-time' values, and
will be ordered by `icalendar-date/time<='."
(car (sort dts :reverse t :lessp #'ical:date/time<=)))
(defun ical:date-add (date unit n)
"Add N UNITs to DATE.
UNIT should be `:year', `:month', `:week', or `:day'; time units will be
ignored. N may be a positive or negative integer."
(if (memq unit '(:hour :minute :second))
date
(let* ((dt (ical:make-date-time :year (calendar-extract-year date)
:month (calendar-extract-month date)
:day (calendar-extract-day date)))
(delta (if (eq unit :week)
(make-decoded-time :day (* 7 n))
(make-decoded-time unit n)))
(new-dt (decoded-time-add dt delta)))
(ical:date-time-to-date new-dt))))
(defun ical:date-time-add (dt delta &optional vtimezone)
"Like `decoded-time-add', but also updates weekday and time zone slots.
DT and DELTA should be `icalendar-date-time' values (decoded times), as
in `decoded-time-add'. VTIMEZONE, if given, should be an
`icalendar-vtimezone'. The resulting date-time will be given the offset
determined by VTIMEZONE at the local time determined by adding DELTA to
DT.
This function assumes that time units in DELTA larger than an hour
should not affect the local clock time in the result, even when crossing
an observance boundary in VTIMEZONE. This means that e.g. if DT is at
9AM daylight savings time on the day before the transition to standard
time, then the result of adding a DELTA of two days will be at 9AM
standard time, even though this is not exactly 48 hours later. Adding a
DELTA of 48 hours, on the other hand, will result in a time exactly 48
hours later, but at a different local time."
(require 'icalendar-recur) ; for icr:tz-decode-time; avoids circular requires
(declare-function icalendar-recur-tz-decode-time "icalendar-recur")
(if (not vtimezone)
;; the simple case: we have no time zone info, so just use
;; `decoded-time-add':
(let ((sum (decoded-time-add dt delta)))
(ical:date-time-variant sum))
;; `decoded-time-add' does not take time zone shifts into account,
;; so we need to do the adjustment ourselves. We first add the units
;; larger than an hour using `decoded-time-add', holding the clock
;; time fixed, as described in the docstring. Then we add the time
;; units as a fixed number of seconds and re-decode the resulting
;; absolute time into the time zone.
(let* ((cal-delta (make-decoded-time :year (or (decoded-time-year delta) 0)
:month (or (decoded-time-month delta) 0)
:day (or (decoded-time-day delta) 0)))
(cal-sum (decoded-time-add dt cal-delta))
(dt-w/zone (ical:date-time-variant cal-sum
:tz vtimezone))
(secs-delta (+ (or (decoded-time-second delta) 0)
(* 60 (or (decoded-time-minute delta) 0))
(* 60 60 (or (decoded-time-hour delta) 0))))
(sum-ts (time-add (encode-time dt-w/zone) secs-delta)))
(icalendar-recur-tz-decode-time sum-ts vtimezone))))
;; TODO: rework so that it's possible to add dur-values to plain dates.
;; Perhaps rename this to "date/time-inc" or so, or use kwargs to allow
;; multiple units, or...
(defun ical:date/time-add (dt unit n &optional vtimezone)
"Add N UNITs to DT.
DT should be an `icalendar-date' or `icalendar-date-time'. UNIT should
be `:year', `:month', `:week', `:day', `:hour', `:minute', or `:second';
time units will be ignored if DT is an `icalendar-date'. N may be a
positive or negative integer."
(cl-typecase dt
(ical:date-time
(let ((delta (if (eq unit :week) (make-decoded-time :day (* 7 n))
(make-decoded-time unit n))))
(ical:date-time-add dt delta vtimezone)))
(ical:date (ical:date-add dt unit n))))
(defun ical:date/time-add-duration (start duration &optional vtimezone)
"Return the end date(-time) which is a length of DURATION after START.
START should be an `icalendar-date' or `icalendar-date-time'; the
returned value will be of the same type as START. DURATION should be an
`icalendar-dur-value'. VTIMEZONE, if specified, should be the
`icalendar-vtimezone' representing the time zone of START."
(if (integerp duration)
;; number of weeks:
(setq duration (make-decoded-time :day (* 7 duration))))
(cl-typecase start
(ical:date
(ical:date-time-to-date
(ical:date-time-add (ical:date-to-date-time start) duration)))
(ical:date-time
(ical:date-time-add start duration vtimezone))))
(defun ical:duration-between (start end)
"Return the duration between START and END.
START should be an `icalendar-date' or `icalendar-date-time'; END must
be of the same type as START. The returned value is an
`icalendar-dur-value', i.e., a time delta in the sense of
`decoded-time-add'."
(cl-typecase start
(ical:date
(make-decoded-time :day (- (calendar-absolute-from-gregorian end)
(calendar-absolute-from-gregorian start))))
(ical:date-time
(let* ((start-abs (time-convert (encode-time start) 'integer))
(end-abs (time-convert (encode-time end) 'integer))
(dur-secs (- end-abs start-abs))
(days (/ dur-secs (* 60 60 24)))
(dur-nodays (mod dur-secs (* 60 60 24)))
(hours (/ dur-nodays (* 60 60)))
(dur-nohours (mod dur-nodays (* 60 60)))
(minutes (/ dur-nohours 60))
(seconds (mod dur-nohours 60)))
(make-decoded-time :day days
:hour hours :minute minutes :second seconds)))))
(defun ical:date/time-to-local (dt)
"Reinterpret DT in Emacs local time if necessary.
If DT is an `icalendar-date-time', encode and re-decode it into Emacs
local time. If DT is an `icalendar-date', return it unchanged."
(cl-typecase dt
(ical:date dt)
(ical:date-time
(ical:date-time-variant ; ensure weekday is present too
(decode-time (encode-time dt))))))
(defun ical:dates-until (start end &optional locally)
"Return a list of `icalendar-date' values between START and END.
START and END may be either `icalendar-date' or `icalendar-date-time'
values. START is an inclusive lower bound, and END is an exclusive
upper bound. (Note, however, that if END is a date-time and its time is
after midnight, then its date will be included in the returned list.)
If LOCALLY is non-nil and START and END are date-times, these will be
interpreted into Emacs local time, so that the dates returned are valid
for the local time zone."
(require 'icalendar-recur) ; avoid circular requires
(declare-function icalendar-recur-subintervals-to-dates "icalendar-recur")
(when locally
(when (cl-typep start 'ical:date-time)
(setq start (ical:date/time-to-local start)))
(when (cl-typep end 'ical:date-time)
(setq end (ical:date/time-to-local end))))
(cl-typecase start
(ical:date
(cl-typecase end
(ical:date
(icalendar-recur-subintervals-to-dates
(list (list (ical:date-to-date-time start)
(ical:date-to-date-time end)))))
(ical:date-time
(icalendar-recur-subintervals-to-dates
(list (list (ical:date-to-date-time start) end))))))
(ical:date-time
(cl-typecase end
(ical:date
(icalendar-recur-subintervals-to-dates
(list (list start (ical:date-to-date-time end)))))
(ical:date-time
(icalendar-recur-subintervals-to-dates (list (list start end))))))))
(cl-defun ical:make-date-time (&key second minute hour day month year
(dst -1 given-dst) zone tz)
"Make an `icalendar-date-time' from the given keyword arguments.
This function is like `make-decoded-time', except that it automatically
sets the weekday slot set based on the date arguments, and it accepts an
additional keyword argument: `:tz'. If provided, its value should be an
`icalendar-vtimezone', and the `:zone' and `:dst' arguments should not
be provided. In this case, the zone and dst slots in the returned
date-time will be adjusted to the correct values in the given time zone
for the local time represented by the remaining arguments."
(when (and tz (or zone given-dst))
(error "Possibly conflicting time zone data in args"))
(apply #'ical:date-time-variant (make-decoded-time)
`(:second ,second :minute ,minute :hour ,hour
:day ,day :month ,month :year ,year
;; Don't pass these keywords unless they were given explicitly.
;; TODO: is there a cleaner way to write this?
,@(when tz (list :tz tz))
,@(when given-dst (list :dst dst))
,@(when zone (list :zone zone)))))
(cl-defun ical:date-time-variant (dt &key second minute hour
day month year
(dst -1 given-dst)
(zone nil given-zone)
tz)
"Return a variant of DT with slots modified as in the given arguments.
DT should be an `icalendar-date-time'; the keyword arguments have the
same meanings as in `make-decoded-time'. The returned variant will have
slot values as specified by the arguments or copied from DT, except that
the weekday slot will be updated if necessary, and the zone and dst
fields will not be set unless given explicitly (because varying the date
and clock time generally invalidates the time zone information in DT).
One additional keyword argument is accepted: `:tz'. If provided, its
value should be an `icalendar-vtimezone', an `icalendar-utc-offset', or
the symbol \\='preserve. If it is a time zone component, the zone and
dst slots in the returned variant will be adjusted to the correct
values in the given time zone for the local time represented by the
variant. If it is a UTC offset, the variant's zone slot will contain
this value, but its dst slot will not be adjusted. If it is the symbol
\\='preserve, then both the zone and dst fields are copied from DT into
the variant."
(require 'icalendar-recur) ; for icr:tz-set-zone; avoids circular requires
(declare-function icalendar-recur-tz-set-zone "icalendar-recur")
(let ((variant
(make-decoded-time :second (or second (decoded-time-second dt))
:minute (or minute (decoded-time-minute dt))
:hour (or hour (decoded-time-hour dt))
:day (or day (decoded-time-day dt))
:month (or month (decoded-time-month dt))
:year (or year (decoded-time-year dt))
;; For zone and dst slots, trust the value
;; if explicitly specified or explicitly
;; requested to preserve, but not otherwise
:dst (cond (given-dst dst)
((eq 'preserve tz) (decoded-time-dst dt))
(t -1))
:zone (cond (given-zone zone)
((eq 'preserve tz) (decoded-time-zone dt))
(t nil)))))
;; update weekday slot when possible, since it depends on the date
;; slots, which might have changed. (It's not always possible,
;; because pure time values are also represented as decoded-times,
;; with empty date slots.)
(unless (or (null (decoded-time-year variant))
(null (decoded-time-month variant))
(null (decoded-time-day variant)))
(setf (decoded-time-weekday variant)
(calendar-day-of-week (ical:date-time-to-date variant))))
;; if given a time zone or UTC offset, update zone and dst slots,
;; which also might have changed:
(when (and tz (not (eq 'preserve tz)))
(icalendar-recur-tz-set-zone variant tz))
variant))
(defun ical:date/time-in-period-p (dt period &optional vtimezone)
"Return non-nil if DT occurs within PERIOD.
DT can be an `icalendar-date' or `icalendar-date-time' value. PERIOD
should be an `icalendar-period' value. VTIMEZONE, if given, is passed
to `icalendar-period-end' to compute the end time of the period if it
was not specified explicitly."
(and (ical:date/time<= (ical:period-start period) dt)
(ical:date/time< dt (ical:period-end period vtimezone))))
;; TODO: surely this exists already?
(defun ical:time<= (a b)
"Compare two Lisp timestamps A and B: is A <= B?"
(or (time-equal-p a b)
(time-less-p a b)))
(defun ical:number-of-weeks (year &optional weekstart)
"Return the number of weeks in (Gregorian) YEAR.
RFC5545 defines week 1 as the first week to include at least four days
in the year. Weeks are assumed to start on Monday (= 1) unless WEEKSTART
is specified, in which case it should be an integer between 0 (= Sunday)
and 6 (= Saturday)."
;; There are 53 weeks in a year if Jan 1 is the fourth day after
;; WEEKSTART, e.g. if the week starts on Monday and Jan 1 is a
;; Thursday, or in a leap year if Jan 1 is the third day after WEEKSTART
(let* ((jan1wd (calendar-day-of-week (list 1 1 year)))
(delta (mod (- jan1wd (or weekstart 1)) 7)))
(if (or (= 4 delta)
(and (= 3 delta) (calendar-leap-year-p year)))
53
52)))
(defun ical:start-of-weekno (weekno year &optional weekstart)
"Return the start of the WEEKNOth week in the (Gregorian) YEAR.
RFC5545 defines week 1 as the first week to include at least four days
in the year. Weeks are assumed to start on Monday (= 1) unless WEEKSTART
is specified, in which case it should be an integer between 0 (= Sunday)
and 6 (= Saturday). The returned value is an `icalendar-date'.
If WEEKNO is negative, it refers to the WEEKNOth week before the end of
the year: -1 is the last week of the year, -2 second to last, etc."
(calendar-gregorian-from-absolute
(+
(* 7 (if (< 0 weekno)
(1- weekno)
(+ 1 weekno (ical:number-of-weeks year weekstart))))
(calendar-dayname-on-or-before
(or weekstart 1)
;; Three days after Jan 1. gives us the nearest occurrence;
;; see `calendar-dayname-on-or-before'
(+ 3 (calendar-absolute-from-gregorian (list 1 1 year)))))))
(defun ical:nth-weekday-in (n weekday year &optional month)
"Return the Nth WEEKDAY in YEAR or MONTH.
If MONTH is specified, it refers to MONTH in YEAR, and N acts as an
index for WEEKDAYs within the month. Otherwise, N acts as an index for
WEEKDAYs within the entire YEAR.
N should be an integer. If N<0, it counts from the end of the month or
year: if N=-1, it refers to the last WEEKDAY in the month or year, if
N=-2 the second to last, and so on."
(if month
(calendar-nth-named-day n weekday month year)
(let* ((jan1 (calendar-absolute-from-gregorian (list 1 1 year)))
(dec31 (calendar-absolute-from-gregorian (list 12 31 year))))
;; Adapted from `calendar-nth-named-absday'.
;; TODO: we could generalize that function to make month an optional
;; argument, but that would mean changing its interface.
(calendar-gregorian-from-absolute
(if (> n 0)
(+ (* 7 (1- n))
(calendar-dayname-on-or-before
weekday
(+ 6 jan1)))
(+ (* 7 (1+ n))
(calendar-dayname-on-or-before
weekday
dec31)))))))
(provide 'icalendar-utils)
;; Local Variables:
;; read-symbol-shorthands: (("ical:" . "icalendar-"))
;; End:
;;; icalendar-utils.el ends here

609
lisp/calendar/icalendar.el
View file

File diff suppressed because it is too large Load diff

2
lisp/calendar/lunar.el
View file

@ -150,7 +150,7 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
(time (* 24 (- date (truncate date))))
(date (calendar-gregorian-from-absolute (truncate date)))
(adj (dst-adjust-time date time)))
(list (car adj) (apply 'solar-time-string (cdr adj)) phase eclipse)))
(list (car adj) (apply #'solar-time-string (cdr adj)) phase eclipse)))
;; from "Astronomy with your Personal Computer", Subroutine Eclipse
;; Line 7000 Peter Duffett-Smith Cambridge University Press 1990

4
lisp/calendar/solar.el
View file

@ -668,7 +668,7 @@ Optional NOLOCATION non-nil means do not print the location."
(concat "sunset " (apply #'solar-time-string (cadr l)))
"no sunset")
(if nolocation ""
(format " at %s" (eval calendar-location-name)))
(format " at %s" (eval calendar-location-name t)))
(nth 2 l))))
(defconst solar-data-list
@ -881,7 +881,7 @@ Accurate to a few seconds."
(last (calendar-last-day-of-month month year))
(title (format "Sunrise/sunset times for %s %d at %s"
(calendar-month-name month) year
(eval calendar-location-name))))
(eval calendar-location-name t))))
(calendar-in-read-only-buffer solar-sunrises-buffer
(calendar-set-mode-line title)
(insert title ":\n\n")

6
lisp/calendar/timeclock.el
View file

@ -296,7 +296,7 @@ set before switching this mode on."
`timeclock-use-display-time' to see timeclock information"))
(add-hook 'display-time-hook #'timeclock-update-mode-line))
(setq timeclock-update-timer
(run-at-time nil 60 'timeclock-update-mode-line))))
(run-at-time nil 60 #'timeclock-update-mode-line))))
(setq global-mode-string
(delq 'timeclock-mode-string global-mode-string))
(remove-hook 'timeclock-event-hook #'timeclock-update-mode-line)
@ -513,8 +513,8 @@ non-nil, the amount returned will be relative to past time worked."
(message "%s" string)
string)))
(define-obsolete-function-alias 'timeclock-time-to-seconds 'float-time "26.1")
(define-obsolete-function-alias 'timeclock-seconds-to-time 'time-convert "26.1")
(define-obsolete-function-alias 'timeclock-time-to-seconds #'float-time "26.1")
(define-obsolete-function-alias 'timeclock-seconds-to-time #'time-convert "26.1")
;; Should today-only be removed in favor of timeclock-relative? - gm
(defsubst timeclock-when-to-leave (&optional today-only)

32
lisp/cedet/semantic/decorate/include.el
View file

@ -352,9 +352,9 @@ Argument EVENT is the mouse clicked event."
(file (semantic-dependency-tag-file tag))
(table (when file
(semanticdb-file-table-object file t))))
(with-output-to-temp-buffer (help-buffer) ; "*Help*"
(help-setup-xref (list #'semantic-decoration-include-describe)
(called-interactively-p 'interactive))
(help-setup-xref (list #'semantic-decoration-include-describe)
(called-interactively-p 'interactive))
(with-help-window (help-buffer) ; "*Help*"
(princ "Include File: ")
(princ (semantic-format-tag-name tag nil t))
(princ "\n")
@ -451,9 +451,9 @@ Argument EVENT is the mouse clicked event."
(interactive)
(let ((tag (semantic-current-tag))
(mm major-mode))
(with-output-to-temp-buffer (help-buffer) ; "*Help*"
(help-setup-xref (list #'semantic-decoration-unknown-include-describe)
(called-interactively-p 'interactive))
(help-setup-xref (list #'semantic-decoration-unknown-include-describe)
(called-interactively-p 'interactive))
(with-help-window (help-buffer) ; "*Help*"
(princ "Include File: ")
(princ (semantic-format-tag-name tag nil t))
(princ "\n\n")
@ -534,9 +534,9 @@ Argument EVENT is the mouse clicked event."
(let* ((tag (semantic-current-tag))
(table (semanticdb-find-table-for-include tag (current-buffer)))
) ;; (mm major-mode)
(with-output-to-temp-buffer (help-buffer) ; "*Help*"
(help-setup-xref (list #'semantic-decoration-fileless-include-describe)
(called-interactively-p 'interactive))
(help-setup-xref (list #'semantic-decoration-fileless-include-describe)
(called-interactively-p 'interactive))
(with-help-window (help-buffer) ; "*Help*"
(princ "Include Tag: ")
(princ (semantic-format-tag-name tag nil t))
(princ "\n\n")
@ -573,10 +573,9 @@ Argument EVENT describes the event that caused this function to be called."
Argument EVENT is the mouse clicked event."
(interactive)
(let ((tag (semantic-current-tag)))
(with-output-to-temp-buffer (help-buffer); "*Help*"
(help-setup-xref (list #'semantic-decoration-unparsed-include-describe)
(called-interactively-p 'interactive))
(help-setup-xref (list #'semantic-decoration-unparsed-include-describe)
(called-interactively-p 'interactive))
(with-help-window (help-buffer); "*Help*"
(princ "Include File: ")
(princ (semantic-format-tag-name tag nil t))
(princ "\n")
@ -654,10 +653,9 @@ Argument EVENT describes the event that caused this function to be called."
(tags (semantic-fetch-tags))
(inc (semantic-find-tags-by-class 'include table))
)
(with-output-to-temp-buffer (help-buffer) ;"*Help*"
(help-setup-xref (list #'semantic-decoration-all-include-summary)
(called-interactively-p 'interactive))
(help-setup-xref (list #'semantic-decoration-all-include-summary)
(called-interactively-p 'interactive))
(with-help-window (help-buffer) ;"*Help*"
(princ "Include Summary for File: ")
(princ (file-truename (buffer-file-name)))
(princ "\n")

7
lisp/cedet/semantic/util.el
View file

@ -271,10 +271,9 @@ If TAG is not specified, use the tag at point."
(interactive)
(let ((buff (current-buffer))
)
(with-output-to-temp-buffer (help-buffer)
(help-setup-xref (list #'semantic-describe-buffer)
(called-interactively-p 'interactive))
(help-setup-xref (list #'semantic-describe-buffer)
(called-interactively-p 'interactive))
(with-help-window (help-buffer)
(with-current-buffer standard-output
(princ "Semantic Configuration in ")
(princ (buffer-name buff))

3
lisp/comint.el
View file

@ -3715,6 +3715,9 @@ last function is the text that is actually inserted in the redirection buffer.
You can use `add-hook' to add functions to this list
either globally or locally.")
(defvar comint-redirect-hook nil
"Normal hook run after completing a comint-redirect.")
;; Internal variables
(defvar comint-redirect-output-buffer nil

10
lisp/desktop.el
View file

@ -1064,13 +1064,19 @@ DIRNAME must be the directory in which the desktop file will be saved."
;; ----------------------------------------------------------------------------
(defun desktop--check-dont-save (frame)
(not (frame-parameter frame 'desktop-dont-save)))
(and (not (frame-parameter frame 'desktop-dont-save))
;; Don't save daemon initial frames, since we cannot (and don't
;; need to) restore them.
(not (and (daemonp)
(equal (terminal-name (frame-terminal frame))
"initial_terminal")))))
(defconst desktop--app-id `(desktop . ,desktop-file-version))
(defun desktop-save-frameset ()
"Save the state of existing frames in `desktop-saved-frameset'.
Frames with a non-nil `desktop-dont-save' parameter are not saved."
Frames with a non-nil `desktop-dont-save' parameter are not saved.
Likewise the initial frame of a daemon sesion."
(setq desktop-saved-frameset
(and desktop-restore-frames
(frameset-save nil

2
lisp/doc-view.el
View file

@ -955,7 +955,7 @@ It's a subdirectory of `doc-view-cache-directory'."
(defun doc-view-mode-p (type)
"Return non-nil if document type TYPE is available for `doc-view'.
Document types are symbols like `dvi', `ps', `pdf', `epub',
`cbz', `fb2', `xps', `oxps', or`odf' (any OpenDocument format)."
`cbz', `fb2', `xps', `oxps', or `odf' (any OpenDocument format)."
(and (display-graphic-p)
(image-type-available-p 'png)
(cond

13
lisp/emacs-lisp/byte-opt.el
View file

@ -341,14 +341,13 @@ There can be multiple entries for the same NAME if it has several aliases.")
(if (cdr exps)
(macroexp-progn (byte-optimize-body exps for-effect))
(byte-optimize-form (car exps) for-effect)))
(`(prog1 ,exp . ,exps)
(let ((exp-opt (byte-optimize-form exp for-effect)))
(if exps
(let ((exps-opt (byte-optimize-body exps t)))
(if (macroexp-const-p exp-opt)
`(progn ,@exps-opt ,exp-opt)
`(,fn ,exp-opt ,@exps-opt)))
exp-opt)))
(let ((exp-opt (byte-optimize-form exp for-effect))
(exps-opt (byte-optimize-body exps t)))
(cond ((null exps-opt) exp-opt)
((macroexp-const-p exp-opt) `(progn ,@exps-opt ,exp-opt))
(t `(,fn ,exp-opt ,@exps-opt)))))
(`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps)
;; Those subrs which have an implicit progn; it's not quite good

6
lisp/emacs-lisp/bytecomp.el
View file

@ -1857,7 +1857,8 @@ It is too wide if it has any lines longer than the largest of
;; The native compiler doesn't use those dynamic docstrings.
(not byte-native-compiling)
;; Docstrings can only be dynamic when compiling a file.
byte-compile--\#$)
byte-compile--\#$
(not (equal doc ""))) ; empty lazy strings are pointless
(let* ((byte-pos (with-memoization
;; Reuse a previously written identical docstring.
;; This is not done out of thriftiness but to try and
@ -5142,7 +5143,8 @@ binding slots have been popped."
(when (stringp doc)
(setq rest (byte-compile--list-with-n
rest 0
(byte-compile--docstring doc (nth 0 form) name)))))
(byte-compile--docstring doc (nth 0 form) name)))
(setq form (nconc (take 3 form) rest))))
(pcase-let*
;; `macro' is non-nil if it defines a macro.
;; `fun' is the function part of `arg' (defaults to `arg').

29
lisp/emacs-lisp/checkdoc.el
View file

@ -381,6 +381,9 @@ large number of libraries means it is impractical to fix all
of these warnings masse. In almost any other case, setting
this to anything but t is likely to be counter-productive.")
(defvar checkdoc--batch-flag nil
"Non-nil in batch mode.")
(defun checkdoc-list-of-strings-p (obj)
"Return t when OBJ is a list of strings."
(declare (obsolete list-of-strings-p "29.1"))
@ -1063,12 +1066,13 @@ Optional argument INTERACT permits more interactive fixing."
(e (checkdoc-rogue-space-check-engine nil nil interact))
(checkdoc-generate-compile-warnings-flag
(or take-notes checkdoc-generate-compile-warnings-flag)))
(if (not (called-interactively-p 'interactive))
(if (not (or (called-interactively-p 'interactive) checkdoc--batch-flag))
e
(if e
(message "%s" (checkdoc-error-text e))
(checkdoc-show-diagnostics)
(message "Space Check: done.")))))
(if (called-interactively-p 'interactive)
(message "Space Check: done."))))))
;;;###autoload
(defun checkdoc-message-text (&optional take-notes)
@ -1081,7 +1085,7 @@ Optional argument TAKE-NOTES causes all errors to be logged."
(checkdoc-generate-compile-warnings-flag
(or take-notes checkdoc-generate-compile-warnings-flag)))
(setq e (checkdoc-message-text-search))
(if (not (called-interactively-p 'interactive))
(if (not (or (called-interactively-p 'interactive) checkdoc--batch-flag))
e
(if e
(user-error "%s" (checkdoc-error-text e))
@ -2819,7 +2823,7 @@ function called to create the messages."
(defun checkdoc-show-diagnostics ()
"Display the checkdoc diagnostic buffer in a temporary window."
(if checkdoc-pending-errors
(if (and checkdoc-pending-errors (not checkdoc--batch-flag))
(let* ((b (get-buffer checkdoc-diagnostic-buffer))
(win (if b (display-buffer b))))
(when win
@ -2832,6 +2836,23 @@ function called to create the messages."
(setq checkdoc-pending-errors nil)
nil)))
;;;###autoload
(defun checkdoc-batch ()
"Check current buffer in batch mode.
Report any errors and signal the first found error."
(when noninteractive
(let ((checkdoc-autofix-flag nil)
(checkdoc--batch-flag t))
(checkdoc-current-buffer t)
(when checkdoc-pending-errors
(when-let* ((b (get-buffer checkdoc-diagnostic-buffer)))
(with-current-buffer b
(princ (buffer-string)))
(terpri))
(checkdoc-current-buffer)))))
(defun checkdoc-get-keywords ()
"Return a list of package keywords for the current file."
(save-excursion

24
lisp/emacs-lisp/cond-star.el
View file

@ -58,7 +58,7 @@ normally has the form (CONDITION BODY...).
CONDITION can be a Lisp expression, as in `cond'.
Or it can be one of `(bind* BINDINGS...)', `(match* PATTERN DATUM)',
or `(pcase* PATTERN DATUM)',
`(bind-and* BINDINGS...)' or `(pcase* PATTERN DATUM)',
`(bind* BINDINGS...)' means to bind BINDINGS (as if they were in `let*')
for the body of the clause, and all subsequent clauses, since the `bind*'
@ -81,15 +81,17 @@ When a clause's condition is true, and it exits the `cond*'
or is the last clause, the value of the last expression
in its body becomes the return value of the `cond*' construct.
Non-exit clause:
Non-exit clauses:
If a clause has only one element, or if its first element is
t or a `bind*' clause, this clause never exits the `cond*' construct.
Instead, control always falls through to the next clause (if any).
All bindings made in CONDITION for the BODY of the non-exit clause
are passed along to the rest of the clauses in this `cond*' construct.
If a clause has only one element, or if its first element is t or a
`bind*' form, or if it ends with the keyword `:non-exit', then this
clause never exits the `cond*' construct. Instead, control always falls
through to the next clause (if any). Except for a `bind-and*' clause,
all bindings made in CONDITION for the BODY of the non-exit clause are
passed along to the rest of the clauses in this `cond*' construct.
\\[match*] for documentation of the patterns for use in `match*'."
See `match*' for documentation of the patterns for use in `match*'
conditions."
;; FIXME: Want an Edebug declaration.
(cond*-convert clauses))
@ -195,7 +197,9 @@ CONDITION of a `cond*' clause. See `cond*' for details."
(or (eq (car clause) t)
;; Starts with a `bind*' pseudo-form.
(and (consp (car clause))
(eq (caar clause) 'bind*))))))
(eq (caar clause) 'bind*))))
;; Ends with keyword.
(eq (car (last clause)) :non-exit)))
(defun cond*-non-exit-clause-substance (clause)
"For a non-exit cond* clause CLAUSE, return its substance.
@ -214,7 +218,7 @@ This removes a final keyword if that's what makes CLAUSE non-exit."
(cons t (cdr clause)))
;; Ends with keyword.
((keywordp (car (last clause)))
((eq (car (last clause)) :non-exit)
;; Do NOT include the final keyword.
(butlast clause))))

19
lisp/emacs-lisp/crm.el
View file

@ -255,14 +255,11 @@ with empty strings removed."
crm-local-must-match-map
crm-local-completion-map))
(map (minibuffer-visible-completions--maybe-compose-map map))
(buffer (current-buffer))
input)
(minibuffer-with-setup-hook
(lambda ()
(add-hook 'choose-completion-string-functions
'crm--choose-completion-string nil 'local)
(setq-local minibuffer-completion-table #'crm--collection-fn)
(setq-local minibuffer-completion-predicate predicate)
(setq-local completion-list-insert-choice-function
(lambda (_start _end choice)
(let* ((beg (save-excursion
@ -276,14 +273,9 @@ with empty strings removed."
(1- (point))
(point-max)))))
(completion--replace beg end choice))))
;; see completing_read in src/minibuf.c
(setq-local minibuffer-completion-confirm
(unless (eq require-match t) require-match))
(setq-local minibuffer--require-match require-match)
(setq-local minibuffer--original-buffer buffer)
(setq-local crm-completion-table table)
(completions--start-eager-display))
(setq input (read-from-minibuffer
(use-local-map map))
(setq input (completing-read
(format-spec
crm-prompt
(let* ((sep (or (get-text-property 0 'separator crm-separator)
@ -291,11 +283,8 @@ with empty strings removed."
(desc (or (get-text-property 0 'description crm-separator)
(concat "list separated by " sep))))
`((?s . ,sep) (?d . ,desc) (?p . ,prompt))))
initial-input map nil hist def inherit-input-method)))
;; If the user enters empty input, `read-from-minibuffer'
;; returns the empty string, not DEF.
(when (and def (string-equal input ""))
(setq input (if (consp def) (car def) def)))
#'crm--collection-fn predicate
require-match initial-input hist def inherit-input-method)))
;; Remove empty strings in the list of read strings.
(split-string input crm-separator t)))

7
lisp/emacs-lisp/loaddefs-gen.el
View file

@ -732,11 +732,8 @@ instead of just updating them with the new/changed autoloads."
'(t (escape-newlines . t)
(escape-control-characters . t)))
(insert " "))
(let ((start (point)))
(prin1 (pop def) (current-buffer) t)
(save-excursion
(goto-char (1+ start))
(insert "\\\n")))
(delete-char -1) (insert "\n")
(prin1 (pop def) (current-buffer) t)
(while def
(insert " ")
(prin1 (pop def) (current-buffer)

145
lisp/emacs-lisp/package-activate.el
View file

@ -30,6 +30,8 @@
;; activate packages at startup, as well as other functions that are
;; useful without having to load the entirety of package.el.
;; Note that the contents of this file are preloaded!
;;; Code:
(eval-when-compile (require 'cl-lib))
@ -534,5 +536,148 @@ the `Version:' header."
(require 'lisp-mnt)
(lm-package-version mainfile)))))))
;;;; Package suggestions system
;; Note that only the definitions necessary to recognise package
;; suggestions are defined here. The user interface to select and act
;; on package suggestions is to be found in package.el.
(defcustom package-autosuggest-style 'mode-line
"How to draw attention to `package-autosuggest-mode' suggestions.
You can set this value to `mode-line' (default) to indicate the
availability of a package suggestion in the minor mode, `always' to
prompt the user in the minibuffer every time a suggestion is available
in a `fundamental-mode' buffer, or `message' to just display a message
hinting at the existence of a suggestion. If you only wish to be
reminded of package suggestions once every session, consider customizing
the `package-autosuggest-once' user option."
:type '(choice (const :tag "Indicate in mode line" mode-line)
(const :tag "Always prompt" always)
(const :tag "Indicate with message" message))
:group 'package)
(defcustom package-autosuggest-once nil
"Non-nil means not to repeat package suggestions."
:type 'boolean
:group 'package)
(defvar package--autosuggest-database 'unset
"A list of package suggestions.
Each entry in the list is of a form suitable to for
`package--suggestion-applies-p', which see. The special value `unset'
is used to indicate that `package--autosuggest-find-candidates' should
load the database into memory.")
(defvar package--autosuggest-suggested '()
"List of packages that have already been suggested.
Suggestions found in this list will not count as suggestions (e.g. if
`package-autosuggest-style' is set to `mode-line', a suggestion found in
here will inhibit `package-autosuggest-mode' from displaying a hint in
the mode line).")
(defun package--suggestion-applies-p (sug)
"Check if a suggestion SUG is applicable to the current buffer.
Each suggestion has the form (PACKAGE TYPE DATA), where PACKAGE is a
symbol denoting the package and major-mode the suggestion applies to,
TYPE is one of `auto-mode-alist', `magic-mode-alist' or
`interpreter-mode-alist' indicating the type of check to be made and
DATA is the value to check against TYPE in the intuitive way (e.g. for
`auto-mode-alist' DATA is a regular expression matching a file name that
PACKAGE should be suggested for). If the package name and the major
mode name differ, then an optional forth element MAJOR-MODE can indicate
what command to invoke to enable the package."
(pcase sug
((or (guard (not (eq major-mode 'fundamental-mode)))
(guard (and package-autosuggest-once
(not (memq (car sug) package--autosuggest-suggested))))
`(,(pred package-installed-p) . ,_))
nil)
(`(,_ auto-mode-alist ,ext . ,_)
(and (buffer-file-name) (string-match-p ext (buffer-file-name)) t))
(`(,_ magic-mode-alist ,mag . ,_)
(without-restriction
(save-excursion
(goto-char (point-min))
(looking-at-p mag))))
(`(,_ interpreter-mode-alist ,intr . ,_)
(without-restriction
(save-excursion
(goto-char (point-min))
(and (looking-at auto-mode-interpreter-regexp)
(string-match-p
(concat "\\`" (file-name-nondirectory (match-string 2)) "\\'")
intr)))))))
(defun package--autosuggest-find-candidates ()
"Return a list of suggestions that might be interesting the current buffer.
The elements of the returned list will have the form described in
`package--suggestion-applies-p'."
(and (eq major-mode 'fundamental-mode)
(let ((suggetions '()))
(when (eq package--autosuggest-database 'unset)
(setq package--autosuggest-database
(with-temp-buffer
(insert-file-contents
(expand-file-name "package-autosuggest.eld"
data-directory))
(read (current-buffer)))))
(dolist (sug package--autosuggest-database)
(when (package--suggestion-applies-p sug)
(push sug suggetions)))
suggetions)))
(defvar package--autosugest-line-format
'(:eval (package--autosugest-line-format)))
(put 'package--autosugest-line-format 'risky-local-variable t)
(defun package--autosugest-line-format ()
"Generate a mode-line string to indicate a suggested package."
`(,@(and-let* (((not (null package-autosuggest-mode)))
((eq package-autosuggest-style 'mode-line))
(avail (package--autosuggest-find-candidates)))
(propertize
"[Upgrade?]"
'face 'mode-line-emphasis
'mouse-face 'mode-line-highlight
'help-echo "Click to install suggested package."
'keymap (let ((map (make-sparse-keymap)))
(define-key map [mode-line down-mouse-1] #'package-autosuggest)
map)))))
(declare-function package-autosuggest "package" (&optional candidates))
(defun package--autosuggest-after-change-mode ()
"Display package suggestions for the current buffer.
This function should be added to `after-change-major-mode-hook'."
(when-let* ((avail (package--autosuggest-find-candidates))
(pkgs (mapconcat #'symbol-name
(delete-dups (mapcar #'car avail))
", ")))
(pcase-exhaustive package-autosuggest-style
('mode-line
(setq mode-name (append (ensure-list mode-name)
'((package-autosuggest-mode
package--autosugest-line-format))))
(force-mode-line-update t))
('always
(package-autosuggest avail))
('message
(message
(substitute-command-keys
(format "Found suggested packages: %s. Install using \\[package-autosuggest]"
pkgs)))
(dolist (rec avail)
(add-to-list 'package--autosuggest-suggested (car rec)))))))
;;;###autoload
(define-minor-mode package-autosuggest-mode
"Enable the automatic suggestion and installation of packages."
:global t :group 'package
;; :initialize #'custom-initialize-delay
(funcall (if package-autosuggest-mode #'add-hook #'remove-hook)
'after-change-major-mode-hook
#'package--autosuggest-after-change-mode))
(provide 'package-activate)
;;; package-activate.el ends here

116
lisp/emacs-lisp/package.el
View file

@ -4529,6 +4529,122 @@ The list is displayed in a buffer named `*Packages*'."
(interactive)
(list-packages t))
;;;; Package Suggestions
(defun package--autosuggest-install-and-enable (sug)
"Install and enable a package suggestion PKG-ENT.
SUG should be of the form as described in `package--suggestion-applies-p'."
(let ((buffers-to-update '()))
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (and (eq major-mode 'fundamental-mode) (buffer-file-name)
(package--suggestion-applies-p sug))
(push buf buffers-to-update))))
(with-demoted-errors "Failed to install package: %S"
(package-install (car sug))
(dolist (buf buffers-to-update)
(with-demoted-errors "Failed to enable major mode: %S"
(with-current-buffer buf
(funcall-interactively (or (cadddr sug) (car sug)))))))))
(defun package--autosugest-prompt (packages)
"Query the user whether to install PACKAGES or not.
PACKAGES is a list of package suggestions in the form as described in
`package--suggestion-applies-p'. The function returns a non-nil value
if affirmative, otherwise nil"
(let* ((inhibit-read-only t) (use-hard-newlines t)
(nl (propertize "\n" 'hard t)) (nlnl (concat nl nl))
(buf (current-buffer)))
(with-current-buffer (get-buffer-create
(format "*package suggestion: %s*"
(buffer-name buf)))
(erase-buffer)
(insert
"The buffer \""
(buffer-name buf)
"\" currently lacks any language-specific support.
The package manager can provide the editor support for these kinds of
files by downloading a package from Emacs's package archive:" nl)
(when (length> packages 1)
(insert nl "(Note that there are multiple candidate packages,
so you have to select which to install!)" nl))
(pcase-dolist (`(,pkg . ,sugs) (seq-group-by #'car packages))
(insert nl "* "
(buttonize (concat "Install " (symbol-name pkg))
(lambda (_)
(package--autosuggest-install-and-enable
(car sugs))
(quit-window)))
" ("
(buttonize "about"
(lambda (_)
(unless (assq pkg package-archive-contents)
(package-read-all-archive-contents))
(describe-package pkg)))
", matches ")
(dolist (sug sugs)
(unless (eq (char-before) ?\s)
(insert ", "))
(pcase sug
(`(,_ auto-mode-alist . ,_)
(insert "file extension "))
(`(,_ magic-mode-alist . ,_)
(insert "magic bytes"))
(`(,_ interpreter-mode-alist . ,_)
(insert "interpreter "))))
(delete-horizontal-space) (insert ").")
(add-to-list 'package--autosuggest-suggested pkg))
(insert nl "* " (buttonize "Do not install anything" (lambda (_) (quit-window))) "."
nl "* " (buttonize "Permanently disable package suggestions"
(lambda (_)
(customize-save-variable
'package-autosuggest-mode nil
"Disabled at user's request")
(quit-window)))
"."
nlnl "To learn more about package management, read "
(buttonize "(emacs) Packages" (lambda (_) (info "(emacs) Packages")))
", and to learn more about how Emacs supports specific languages, read "
(buttonize "(emacs) Major modes" (lambda (_) (info "(emacs) Major modes")))
".")
(fill-region (point-min) (point-max))
(special-mode)
(button-mode t)
(let ((win (display-buffer-below-selected (current-buffer) '())))
(fit-window-to-buffer win)
(select-window win)
(set-window-dedicated-p win t)
(set-window-point win (point-min))))))
;;;###autoload
(defun package-autosuggest (&optional candidates)
"Prompt the user to install the suggested packages.
The optional argument CANDIDATES may be a list of packages that match
for form described in `package--suggestion-applies-p'. If omitted, the
list of candidates will be computed from the database."
(interactive)
(package--autosugest-prompt
(or candidates
(package--autosuggest-find-candidates)
(user-error "No package suggestions found"))))
(defun package-reset-suggestions ()
"Forget previous package suggestions.
Emacs will remember if you have previously rejected a suggestion during
a session and won't mention it afterwards. If you have made a mistake
or would like to reconsider this, use this command to want to reset the
suggestions."
(interactive)
(setq package--autosuggest-suggested nil))
;;;; Quickstart: precompute activation actions for faster start up.

4
lisp/emacs-lisp/seq.el
View file

@ -567,7 +567,7 @@ This does not modify SEQUENCE1 or SEQUENCE2."
;;;###autoload
(cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn)
"Return copy of SEQUENCE1 with elements that appear in SEQUENCE2 removed.
"Return copy of SEQUENCE1 with elements that do not appear in SEQUENCE2 removed.
\"Equality\" of elements is defined by the function TESTFN, which
defaults to `equal'.
This does not modify SEQUENCE1 or SEQUENCE2."
@ -579,7 +579,7 @@ This does not modify SEQUENCE1 or SEQUENCE2."
'()))
(cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn)
"Return list of all the elements that appear in SEQUENCE1 but not in SEQUENCE2.
"Return copy of SEQUENCE1 with elements that appear in SEQUENCE2 removed.
\"Equality\" of elements is defined by the function TESTFN, which
defaults to `equal'.
This does not modify SEQUENCE1 or SEQUENCE2."

4
lisp/emacs-lisp/shortdoc.el
View file

@ -1707,7 +1707,9 @@ function's documentation in the Info manual"))
;; Doc string.
(insert " "
(or (plist-get data :doc)
(car (split-string (documentation function) "\n"))))
(car (split-string (or (documentation function)
"Error: missing docstring.")
"\n"))))
(insert "\n")
(add-face-text-property start-section (point) 'shortdoc-section t)
(let ((print-escape-newlines t)

2
lisp/emacs-lisp/smie.el
View file

@ -1153,7 +1153,7 @@ METHOD can be:
- :before, in which case ARG is a token and the function should return the
OFFSET to use to indent ARG itself.
- :elem, in which case the function should return either:
- the offset to use to indent function arguments (ARG = `arg')
- the offset to use to indent function arguments (ARG = `args')
- the basic indentation step (ARG = `basic').
- the token to use (when ARG = `empty-line-token') when we don't know how
to indent an empty line.

104
lisp/emacs-lisp/subr-x.el
View file

@ -37,6 +37,7 @@
(eval-when-compile (require 'cl-lib))
(require 'mule-util)
(defmacro internal--thread-argument (first? &rest forms)
"Internal implementation for `thread-first' and `thread-last'.
@ -357,6 +358,29 @@ buffer when possible, instead of creating a new one on each call."
(progn ,@body)
(work-buffer--release ,work-buffer))))))
(defun work-buffer--prepare-pixelwise (string buffer)
"Set up the current buffer to correctly compute STRING's pixel width.
Call this with a work buffer as the current buffer.
BUFFER is the originating buffer and if non-nil, make the current
buffer's (work buffer) face remappings match it."
(when buffer
(dolist (v '(face-remapping-alist
char-property-alias-alist
default-text-properties))
(if (local-variable-p v buffer)
(set (make-local-variable v)
(buffer-local-value v buffer)))))
;; Avoid deactivating the region as side effect.
(let (deactivate-mark)
(insert string))
;; If `display-line-numbers' is enabled in internal
;; buffers (e.g. globally), it breaks width calculation
;; (bug#59311). Disable `line-prefix' and `wrap-prefix',
;; for the same reason.
(add-text-properties
(point-min) (point-max)
'(display-line-numbers-disable t line-prefix "" wrap-prefix "")))
;;;###autoload
(defun string-pixel-width (string &optional buffer)
"Return the width of STRING in pixels.
@ -371,26 +395,70 @@ substring that does not include newlines."
;; Keeping a work buffer around is more efficient than creating a
;; new temporary buffer.
(with-work-buffer
;; Setup current buffer to correctly compute pixel width.
(when buffer
(dolist (v '(face-remapping-alist
char-property-alias-alist
default-text-properties))
(if (local-variable-p v buffer)
(set (make-local-variable v)
(buffer-local-value v buffer)))))
;; Avoid deactivating the region as side effect.
(let (deactivate-mark)
(insert string))
;; If `display-line-numbers' is enabled in internal
;; buffers (e.g. globally), it breaks width calculation
;; (bug#59311). Disable `line-prefix' and `wrap-prefix',
;; for the same reason.
(add-text-properties
(point-min) (point-max)
'(display-line-numbers-disable t line-prefix "" wrap-prefix ""))
(work-buffer--prepare-pixelwise string buffer)
(car (buffer-text-pixel-size nil nil t)))))
;;;###autoload
(defun truncate-string-pixelwise (string max-pixels &optional buffer
ellipsis ellipsis-pixels)
"Return STRING truncated to fit within MAX-PIXELS.
If BUFFER is non-nil, use the face remappings, alternative and default
properties from that buffer when determining the width.
If you call this function to measure pixel width of a string
with embedded newlines, it returns the width of the widest
substring that does not include newlines.
If ELLIPSIS is non-nil, it should be a string which will replace the end
of STRING if it extends beyond MAX-PIXELS, unless the pixel width of
STRING is equal to or less than the pixel width of ELLIPSIS. If it is
non-nil and not a string, then ELLIPSIS defaults to
`truncate-string-ellipsis', or to three dots when it's nil.
If ELLIPSIS-PIXELS is non-nil, it is the pixel width of ELLIPSIS, and
can be used to avoid the cost of recomputing this for multiple calls to
this function using the same ELLIPSIS."
(declare (important-return-value t))
(if (zerop (length string))
string
;; Keeping a work buffer around is more efficient than creating a
;; new temporary buffer.
(let ((original-buffer (or buffer (current-buffer))))
(with-work-buffer
(work-buffer--prepare-pixelwise string buffer)
(set-window-buffer nil (current-buffer) 'keep-margins)
;; Use a binary search to prune the number of calls to
;; `window-text-pixel-size'.
;; These are 1-based buffer indexes.
(let* ((low 1)
(high (1+ (length string)))
mid)
(when (> (car (window-text-pixel-size nil 1 high)) max-pixels)
(when (and ellipsis (not (stringp ellipsis)))
(setq ellipsis (truncate-string-ellipsis)))
(setq ellipsis-pixels (if ellipsis
(if ellipsis-pixels
ellipsis-pixels
(string-pixel-width ellipsis buffer))
0))
(let ((adjusted-pixels
(if (> max-pixels ellipsis-pixels)
(- max-pixels ellipsis-pixels)
max-pixels)))
(while (<= low high)
(setq mid (floor (+ low high) 2))
(if (<= (car (window-text-pixel-size nil 1 mid))
adjusted-pixels)
(setq low (1+ mid))
(setq high (1- mid))))))
(set-window-buffer nil original-buffer 'keep-margins)
(if mid
;; Binary search ran.
(if (and ellipsis (> max-pixels ellipsis-pixels))
(concat (substring string 0 (1- high)) ellipsis)
(substring string 0 (1- high)))
;; Fast path.
string))))))
;;;###autoload
(defun string-glyph-split (string)
"Split STRING into a list of strings representing separate glyphs.

15
lisp/frameset.el
View file

@ -1362,9 +1362,18 @@ All keyword parameters default to nil."
;; Clean up the frame list
(when cleanup-frames
(let ((map nil)
(cleanup (if (eq cleanup-frames t)
(lambda (frame action)
(when (memq action '(:rejected :ignored))
(cleanup
(if (eq cleanup-frames t)
(lambda (frame action)
(when (and (memq action '(:rejected :ignored))
;; Don't try deleting the daemon's initial
;; frame, as that would only trigger
;; warnings.
(not
(and (daemonp)
(equal (terminal-name (frame-terminal
frame))
"initial_terminal"))))
(delete-frame frame)))
cleanup-frames)))
(maphash (lambda (frame _action) (push frame map)) frameset--action-map)

1
lisp/gnus/gnus-group.el
View file

@ -640,6 +640,7 @@ simple manner."
"M-&" #'gnus-group-universal-argument
"#" #'gnus-group-mark-group
"M-#" #'gnus-group-unmark-group
"M-i" #'gnus-symbolic-argument
"~" (define-keymap :prefix 'gnus-group-cloud-map
"u" #'gnus-cloud-upload-all-data

28
lisp/gnus/gnus-topic.el
View file

@ -1158,7 +1158,8 @@ articles in the topic and its subtopics."
#'gnus-topic-group-indentation)
(setq-local gnus-group-update-group-function
#'gnus-topic-update-topics-containing-group)
(setq-local gnus-group-sort-alist-function #'gnus-group-sort-topic)
(setq-local gnus-group-sort-alist-function #'gnus-group-sort-topic
gnus-group-sort-selected-function #'gnus-group-sort-selected-topic)
(setq gnus-group-change-level-function #'gnus-topic-change-level)
(setq gnus-goto-missing-group-function #'gnus-topic-goto-missing-group)
(add-hook 'gnus-check-bogus-groups-hook #'gnus-topic-clean-alist
@ -1173,7 +1174,8 @@ articles in the topic and its subtopics."
(setq gnus-group-change-level-function nil)
(remove-hook 'gnus-check-bogus-groups-hook #'gnus-topic-clean-alist)
(setq gnus-group-prepare-function #'gnus-group-prepare-flat)
(setq gnus-group-sort-alist-function #'gnus-group-sort-flat))
(setq gnus-group-sort-alist-function #'gnus-group-sort-flat
gnus-group-sort-selected-function #'gnus-group-sort-selected-flat))
(when (called-interactively-p 'any)
(gnus-group-list-groups))))
@ -1651,6 +1653,28 @@ If performed on a topic, edit the topic parameters instead."
(setcar alist (delete "dummy.group" (car alist)))
(gnus-topic-sort-topic (pop alist) func reverse))))
(defun gnus-group-sort-selected-topic (groups func reverse)
"Sort selected GROUPS in the topics according to FUNC and REVERSE."
(let ((alist gnus-topic-alist))
(while alist
;; !!!Sometimes nil elements sneak into the alist,
;; for some reason or other.
(setcar alist (delq nil (car alist)))
(setcar alist (delete "dummy.group" (car alist)))
(let* ((topic (pop alist))
(inter (seq-intersection groups (cdr topic))))
;; Do something only if there are some selected groups in this
;; topic.
(when inter
(let ((sorted (mapcar #'gnus-info-group
(sort (mapcar #'gnus-get-info inter) func))))
;; Do the reversal, if necessary.
(when reverse
(setq sorted (nreverse (cdr sorted))))
;; Set the topic contents as the union of the sorted
;; selected groups and its previous contents.
(setcdr topic (seq-union sorted (cdr topic)))))))))
(defun gnus-topic-sort-topic (topic func reverse)
;; Each topic only lists the name of the group, while
;; the sort predicates expect group infos as inputs.

19
lisp/help-fns.el
View file

@ -40,8 +40,8 @@
(defvar help-fns-describe-function-functions nil
"List of functions to run in help buffer in `describe-function'.
Those functions will be run after the header line and argument
list was inserted, and before the documentation is inserted.
Those functions will be run after the header line, the argument
list, and the function's documentation are inserted.
The functions will be called with one argument: the function's symbol.
They can assume that a newline was output just before they were called,
and they should terminate any of their own output with a newline.
@ -2242,7 +2242,7 @@ is enabled in the Help buffer."
(insert (format "Minor mode%s enabled in this buffer:"
(if (length> local-minors 1)
"s" ""))))
(describe-mode--minor-modes local-minors))
(describe-mode--minor-modes local-minors nil buffer))
;; Document the major mode.
(let ((major (buffer-local-value 'major-mode buffer)))
@ -2269,7 +2269,9 @@ is enabled in the Help buffer."
(help-function-def--button-function
major file-name))))))
(insert ":\n\n"
(help-split-fundoc (documentation major) nil 'doc)
(help-split-fundoc (with-current-buffer buffer
(documentation major))
nil 'doc)
(with-current-buffer buffer
(help-fns--list-local-commands)))
(ensure-empty-lines 1)
@ -2280,7 +2282,7 @@ is enabled in the Help buffer."
(insert (format "Global minor mode%s enabled:"
(if (length> global-minor-modes 1)
"s" ""))))
(describe-mode--minor-modes global-minor-modes t)
(describe-mode--minor-modes global-minor-modes t buffer)
(unless describe-mode-outline
(when (re-search-forward "^\f")
(beginning-of-line)
@ -2297,7 +2299,7 @@ is enabled in the Help buffer."
;; For the sake of IELM and maybe others
nil)))))
(defun describe-mode--minor-modes (modes &optional global)
(defun describe-mode--minor-modes (modes &optional global buffer)
(dolist (mode (seq-sort #'string< modes))
(let ((pretty-minor-mode
(capitalize
@ -2338,7 +2340,10 @@ is enabled in the Help buffer."
"no indicator"
(format "indicator%s"
indicator)))))
(insert (or (help-split-fundoc (documentation mode) nil 'doc)
(insert (or (help-split-fundoc
(with-current-buffer (or buffer (current-buffer))
(documentation mode))
nil 'doc)
"No docstring"))
(when describe-mode-outline
(insert "\n\n")))))

10
lisp/help-mode.el
View file

@ -501,9 +501,13 @@ buffer after following a reference. INTERACTIVE-P is non-nil if the
calling command was invoked interactively. In this case the stack of
items for help buffer \"back\" buttons is cleared.
This should be called very early, before the output buffer is cleared,
because we want to record the \"previous\" position of point so we can
restore it properly when going back."
This function also re-enables the major mode of the buffer, thus
resetting local variables to the values set by the mode and running the
mode hooks.
So this should be called very early, before the output buffer is
cleared, also because we want to record the \"previous\" position of
point so we can restore it properly when going back."
(with-current-buffer (help-buffer)
;; Re-enable major mode, killing all unrelated local vars.
(funcall major-mode)

34
lisp/icomplete.el
View file

@ -79,11 +79,12 @@ selection process starts again from the user's $HOME."
(defcustom icomplete-show-matches-on-no-input nil
"When non-nil, show completions when first prompting for input.
This means to show completions even when the current minibuffer contents
is the same as was the initial input after minibuffer activation.
This also means that if you traverse the list of completions with
commands like \\`C-.' and just hit \\`RET' without typing any
characters, the match under point will be chosen instead of the
default."
is the same as the initial input after minibuffer activation.
This also means that if you just hit \\`C-j' without typing any
characters, this chooses the first completion candidate instead of the
minibuffer's default value.
See also `icomplete-ret'."
:type 'boolean
:version "24.4")
@ -242,16 +243,25 @@ Used to implement the option `icomplete-show-matches-on-no-input'.")
:doc "Keymap used by `icomplete-mode' in the minibuffer."
"C-M-i" #'icomplete-force-complete
"C-j" #'icomplete-force-complete-and-exit
"M-j" #'icomplete-exit
"C-." #'icomplete-forward-completions
"C-," #'icomplete-backward-completions
"<remap> <minibuffer-complete-and-exit>" #'icomplete-ret)
"C-," #'icomplete-backward-completions)
(defun icomplete-ret ()
"Exit minibuffer for icomplete."
"Alternative minibuffer exit for Icomplete.
If there is a completion candidate and the minibuffer contents is the
same as it was right after minibuffer activation, exit selecting that
candidate. Otherwise do as `minibuffer-complete-and-exit'.
You may wish to consider binding this command to \\`RET' (or to
`<remap> <minibuffer-complete-and-exit>') in `icomplete-minibuffer-map'.
If you do that, then when Emacs first prompts for input such that the
current minibuffer contents is equal to the initial input right after
minibuffer activation, \\`RET' chooses the first completion candidate
instead of the minibuffer's default value.
This rebinding is especially useful if you have customized
`icomplete-show-matches-on-no-input' to a non-nil value."
(interactive)
(if (and icomplete-show-matches-on-no-input
(car completion-all-sorted-completions)
(if (and (car completion-all-sorted-completions)
(equal (icomplete--field-string) icomplete--initial-input))
(icomplete-force-complete-and-exit)
(minibuffer-complete-and-exit)))
@ -456,8 +466,6 @@ if that doesn't produce a completion match."
(minibuffer-complete-and-exit)
(exit-minibuffer)))
(defalias 'icomplete-exit #'icomplete-fido-exit)
(defun icomplete-fido-backward-updir ()
"Delete char before or go up directory, like `ido-mode'."
(interactive)

4
lisp/isearch.el
View file

@ -274,8 +274,6 @@ It is nil if none yet.")
Default value, nil, means edit the string instead."
:type 'boolean)
(autoload 'char-fold-to-regexp "char-fold")
(defcustom search-default-mode nil
"Default mode to use when starting isearch.
Value is nil, t, or a function.
@ -2827,7 +2825,6 @@ With argument, add COUNT copies of the character."
(mapconcat 'isearch-text-char-description
string ""))))))))
(autoload 'emoji--read-emoji "emoji")
(defun isearch-emoji-by-name (&optional count)
"Read an Emoji name and add it to the search string COUNT times.
COUNT (interactively, the prefix argument) defaults to 1.
@ -2835,6 +2832,7 @@ The command accepts Unicode names like \"smiling face\" or
\"heart with arrow\", and completion is available."
(interactive "p")
(emoji--init)
(declare-function emoji--read-emoji "emoji" ())
(with-isearch-suspended
(pcase-let* ((`(,glyph . ,derived) (emoji--read-emoji))
(emoji (if derived

11
lisp/json.el
View file

@ -609,12 +609,11 @@ transforms an unsortable MAP into a sortable alist."
"Insert a JSON representation of ALIST at point.
Sort ALIST first if `json-encoding-object-sort-predicate' is
non-nil. Sorting can optionally be DESTRUCTIVE for speed."
(json--print-map (if (and json-encoding-object-sort-predicate alist)
(sort (if destructive alist (copy-sequence alist))
(lambda (a b)
(funcall json-encoding-object-sort-predicate
(car a) (car b))))
alist)))
(json--print-map (let ((pred json-encoding-object-sort-predicate))
(if (and pred alist)
(sort alist :key #'car :lessp pred
:in-place destructive)
alist))))
;; The following two are unused but useful to keep around due to the
;; inherent ambiguity of lists.

9
lisp/language/indian.el
View file

@ -308,6 +308,7 @@ environment."))
("H" . "\u094D") ; HALANT
("s" . "[\u0951\u0952]") ; stress sign
("t" . "[\u0953\u0954]") ; accent
("D" . "[\u0964\u0965]") ; punctuation sign
("1" . "\u0967") ; numeral 1
("3" . "\u0969") ; numeral 3
("N" . "\u200C") ; ZWNJ
@ -316,15 +317,15 @@ environment."))
(indian-compose-regexp
(concat
;; syllables with an independent vowel, or
"\\(?:RH\\)?Vn?\\(?:J?HR\\)?v*n?a?s?t?A?\\|"
"\\(?:RH\\)?Vn?\\(?:J?HR\\)?v*n?a?s?t?A?D?\\|"
;; consonant-based syllables, or
"Cn?\\(?:J?HJ?Cn?\\)*\\(?:H[NJ]?\\|v*n?a?s?t?A?\\)\\|"
"Cn?\\(?:J?HJ?Cn?\\)*\\(?:H[NJ]?D?\\|v*n?a?s?t?A?D?\\)\\|"
;; special consonant form, or
"JHR\\|"
"JHRD?\\|"
;; vedic accents with numerals, or
"1ss?\\|3ss\\|s3ss\\|"
;; any other singleton characters
"X")
"XD?")
table))
"Regexp matching a composable sequence of Devanagari characters.")

1
lisp/leim/quail/ipa.el
View file

@ -74,6 +74,7 @@ Upside-down characters are obtained by a preceding slash (/)."
("A~" ["ɑ̃"])
("oe~" ["œ̃"])
("/c~" ["ɔ̃"])
("/E" ?ɜ)
("p" ?p)
("b" ?b)
("t" ?t)

198
lisp/leim/quail/iroquoian.el
View file

@ -24,7 +24,7 @@
;; This file implements input methods for Northern Iroquoian languages.
;; Input methods are implemented for all Five Nations Iroquois
;; Input methods are implemented for the following Northern Iroquoian
;; languages:
;; - Mohawk (Kanien’kéha / Kanyen’kéha / Onkwehonwehnéha)
@ -32,6 +32,7 @@
;; - Onondaga (Onųdaʔgegáʔ)
;; - Cayuga (Gayogo̱ho:nǫhnéha:ˀ)
;; - Seneca (Onödowá’ga:’)
;; - Tuscarora (Skarù·ręʔ)
;; A composite input method for all of the languages above is also
;; defined: `haudenosaunee-postfix'.
@ -39,7 +40,6 @@
;; Input methods are not yet implemented for the remaining Northern
;; Iroquoian languages, including:
;; - Tuscarora (Skarù:ręʔ)
;; - Wendat (Huron) / Wyandot
;;; Code:
@ -798,6 +798,159 @@ simultaneously using the input method `haudenosaunee-postfix'."
iroquoian-seneca-vowel-alist))
(quail-defrule key trans))
;;; Tuscarora
;;
;; The primary community orthography used for Tuscarora follows that
;; used in Blair Rudes's dictionary (see below).
;;
;; Reference work for Tuscarora orthography:
;;
;; Blair Rudes. 1999. Tuscarora-English/English-Tuscarora
;; dictionary. Toronto: University of Toronto Press.
;;
(defconst iroquoian-tuscarora-modifier-alist
'(("::" ?\N{MIDDLE DOT}))
"Alist of rules for modifier letters in Tuscarora input methods.
Entries are as with rules in `quail-define-rules'.")
(defconst iroquoian-tuscarora-vowel-alist
'(("a'" ?á)
("a`" ?à)
("A'" ?Á)
("A`" ?À)
("e'" ?é)
("e`" ?è)
("E'" ?É)
("E`" ?È)
("i'" ?í)
("i`" ?ì)
("I'" ?Í)
("I`" ?Ì)
("u'" ?ú)
("u`" ?ù)
("U'" ?Ú)
("U`" ?Ù)
("e," ?ę)
("e,'" ["ę́"])
("e,`" ["ę̀"])
("E," ?Ę)
("E,'" ["Ę́"])
("E,`" ["Ę̀"])
("a''" ["a'"])
("a``" ["a`"])
("A''" ["A'"])
("A``" ["A`"])
("e''" ["e'"])
("e``" ["e`"])
("E''" ["E'"])
("E``" ["E`"])
("i''" ["i'"])
("i``" ["i`"])
("I''" ["I'"])
("I``" ["I`"])
("u''" ["u'"])
("u``" ["u`"])
("U''" ["U'"])
("U``" ["U`"])
("e,," ["e,"])
("e,''" ["ę'"])
("e,``" ["ę`"])
("E,," ["E,"])
("E,''" ["Ę'"])
("E,``" ["Ę`"]))
"Alist of rules for vowel letters in Tuscarora input methods.
Entries are as with rules in `quail-define-rules'.")
(defconst iroquoian-tuscarora-consonant-alist
'((";;" ?\N{LATIN LETTER GLOTTAL STOP})
("c/" ?č)
("c//" ["c/"])
("C/" ?Č)
("C//" ["C/"])
("t/" ?θ)
("t//" ["t/"]))
"Alist of rules for consonant letters in Tuscarora input methods.
Entries are as with rules in `quail-define-rules'.")
(defconst iroquoian-tuscarora-exception-alist
'(("_" ?\N{COMBINING LOW LINE})
("__" ?_))
"Alist of rules for phonological exception marking in Tuscarora input methods.
Entries are as with rules in `quail-define-rules'.")
(quail-define-package
"tuscarora-postfix" "Tuscarora" "TUS<" t
"Tuscarora (Skarù·ręʔ) input method with postfix modifiers
Modifiers:
| Key | Translation | Description |
|-----+-------------+--------------------------|
| :: | · | Vowel length |
Stress diacritics:
| Key | Description | Example |
|------+--------------+---------|
| \\=' | Acute accent | a' -> á |
| \\=` | Grave accent | a` -> à |
Doubling the postfix separates the letter and the postfix.
Vowels:
| Key | Translation | Description |
|-----+-------------+---------------------------------|
| e, | ę | Mid front nasal vowel |
| E, | Ę | Mid front nasal vowel (capital) |
a, e, i, and u are bound to a single key.
Consonants:
| Key | Translation | Description |
|-------+-------------+------------------------------------|
| ;; | ˀ | Glottal stop |
| c/ | č | Postalveolar affricate |
| C/ | Č | Postalveolar affricate (capital) |
| t/ | θ | Voiceless dental fricative |
h, k, n, r, s, t, w, and y are bound to a single key.
b, l, m, and p are used rarely in loanwords. They are also each bound
to a single key.
Stress exception markers:
| Key | Description | Example |
|-----+--------------------+----------|
| _ | Combining low line | a_ -> a̲ |
Note: Not all fonts can properly display a combining low line on all
letters.
Underlining has been used by some to indicate that vowels behave
exceptionally with regard to stress placement. Alternatively, markup or
other methods can be used to create an underlining effect.
To enter a plain underscore, type the underscore twice.
All Haudenosaunee languages, including Tuscarora can be input
simultaneously using the input method `haudenosaunee-postfix'."
nil t nil nil nil nil nil nil nil nil t)
(pcase-dolist (`(,key ,trans)
(append iroquoian-tuscarora-modifier-alist
iroquoian-tuscarora-consonant-alist
iroquoian-tuscarora-vowel-alist
iroquoian-tuscarora-exception-alist))
(quail-defrule key trans))
;;; Haudenosaunee (composite Northern Iroquoian)
@ -857,7 +1010,8 @@ simultaneously using the input method `haudenosaunee-postfix'."
iroquoian-oneida-modifier-alist
iroquoian-onondaga-modifier-alist
iroquoian-cayuga-modifier-alist
iroquoian-seneca-modifier-alist))
iroquoian-seneca-modifier-alist
iroquoian-tuscarora-modifier-alist))
"Alist of rules for modifier letters in Haudenosaunee input methods.
Entries are as with rules in `quail-define-rules'.")
@ -866,7 +1020,8 @@ Entries are as with rules in `quail-define-rules'.")
iroquoian-oneida-vowel-alist
iroquoian-onondaga-vowel-alist
iroquoian-cayuga-vowel-alist
iroquoian-seneca-vowel-alist))
iroquoian-seneca-vowel-alist
iroquoian-tuscarora-vowel-alist))
"Alist of rules for vowel letters in Haudenosaunee input methods.
Entries are as with rules in `quail-define-rules'.")
@ -879,16 +1034,17 @@ Entries are as with rules in `quail-define-rules'.")
iroquoian-oneida-consonant-alist
iroquoian-onondaga-consonant-alist
iroquoian-cayuga-consonant-alist
iroquoian-seneca-consonant-alist)
iroquoian-seneca-consonant-alist
iroquoian-tuscarora-consonant-alist)
(lambda (c1 c2)
(equal (car c1) (car c2))))
"Alist of rules for consonant letters in Haudenosaunee input methods.
Entries are as with rules in `quail-define-rules'.")
(defconst iroquoian-haudenosaunee-devoicing-alist
(defconst iroquoian-haudenosaunee-exception-alist
'(("_" ?\N{COMBINING LOW LINE})
("__" ?_))
"Alist of rules for devoicing characters in Haudenosaunee input methods.
"Rules alist for phonological exception markers in Haudenosaunee input methods.
Entries are as with rules in `quail-define-rules'.")
(defconst iroquoian-haudenosaunee-nasal-alist iroquoian-onondaga-nasal-alist
@ -906,6 +1062,7 @@ This input method can be used to enter the following languages:
- Cayuga (Gayogo̱ho:nǫhnéha:ˀ)
- Onondaga (Onųdaʔgegáʔ)
- Seneca (Onödowá’ga:’)
- Tuscarora (Skarù·ręʔ)
Modifiers:
@ -989,6 +1146,12 @@ Vowels:
| a\" | ä | Low front vowel |
| A\" | Ä | Low front vowel (capital) |
| Single-key vowels: a e i o u |
|----------------------------------------------------------------------|
| Tuscarora |
| -------------------------------------------------------------------- |
| e, | ę | Mid front nasal vowel |
| E, | Ę | Mid front nasal vowel (capital) |
| Single-key vowels: a e i u |
Consonants:
@ -1023,8 +1186,16 @@ Consonants:
| s/ | š | Voiceless postalveolar fricative |
| S/ | Š | Voiceless postalveolar fricative (capital) |
| Single-key consonants: d g h j k n s t w y z (b m p) |
|----------------------------------------------------------------------|
| Tuscarora |
| -------------------------------------------------------------------- |
| ;: | ʔ | Glottal stop (alternate) |
| c/ | č | Postalveolar affricate |
| C/ | Č | Postalveolar affricate (capital) |
| t/ | θ | Voiceless dental fricative |
| Single-key consonants: h k n r s t w y (b l m p) |
Devoicing:
Phonological exception markers:
| Key | Description | Examples |
|-----+------------------------+------------------------------|
@ -1035,8 +1206,10 @@ Note: Not all fonts can properly display a combining low line on all
letters and a combining macron below on all vowels.
Underlining is commonly used in Oneida to indicate devoiced syllables on
pre-pausal forms (also called utterance-final forms). Alternatively,
markup or other methods can be used to create an underlining effect.
pre-pausal forms (also called utterance-final forms), and it has been
used in some Tuscarora orthographies to indicate that vowels behave
exceptionally with regard to stress placement. Alternatively, markup or
other methods can be used to create an underlining effect.
To enter a plain underscore, the underscore twice.
@ -1046,7 +1219,8 @@ To enter a plain hyphen after a vowel, simply type the hyphen twice.
There are individual input methods for each of the languages that can be
entered with this input method: `mohawk-postfix', `oneida-postfix',
`onondaga-postfix', `cayuga-postfix', `seneca-postfix'."
`onondaga-postfix', `cayuga-postfix', `seneca-postfix',
`tuscarora-postfix'.."
nil t nil nil nil nil nil nil nil nil t)
(pcase-dolist (`(,key ,trans)
@ -1054,7 +1228,7 @@ entered with this input method: `mohawk-postfix', `oneida-postfix',
iroquoian-haudenosaunee-consonant-alist
iroquoian-haudenosaunee-nasal-alist
iroquoian-haudenosaunee-vowel-alist
iroquoian-haudenosaunee-devoicing-alist))
iroquoian-haudenosaunee-exception-alist))
(quail-defrule key trans))
(provide 'iroquoian)

12
lisp/net/dbus.el
View file

@ -319,6 +319,10 @@ If the parameter `:authorizable' is given and the following AUTH
is non-nil, the invoked method may interactively prompt the user
for authorization. The default is nil.
If the parameter `:keep-fd' is given, and the return message has a first
argument with a D-Bus type `:unix-fd', the returned file desriptor is
kept internally, and can be used in a later `dbus--close-fd' call.
All other arguments ARGS are passed to METHOD as arguments. They are
converted into D-Bus types via the following rules:
@ -453,6 +457,10 @@ If the parameter `:authorizable' is given and the following AUTH
is non-nil, the invoked method may interactively prompt the user
for authorization. The default is nil.
If the parameter `:keep-fd' is given, and the return message has a first
argument with a D-Bus type `:unix-fd', the returned file desriptor is
kept internally, and can be used in a later `dbus--close-fd' call.
All other arguments ARGS are passed to METHOD as arguments. They are
converted into D-Bus types via the following rules:
@ -604,6 +612,7 @@ This is an internal function, it shall not be used outside dbus.el."
;;; Hash table of registered functions.
;; Seems to be unused. Dow we want to keep it?
(defun dbus-list-hash-table ()
"Return all registered member registrations to D-Bus.
The return value is a list, with elements of kind (KEY . VALUE).
@ -613,7 +622,7 @@ hash table."
(maphash
(lambda (key value) (push (cons key value) result))
dbus-registered-objects-table)
result))
(nreverse result)))
(defun dbus-setenv (bus variable value)
"Set the value of the BUS environment variable named VARIABLE to VALUE.
@ -2098,6 +2107,7 @@ either a method name, a signal name, or an error name."
(defun dbus-monitor-goto-serial ()
"Goto D-Bus message with the same serial number."
(declare (completion ignore))
(interactive)
(when (mouse-event-p last-input-event) (mouse-set-point last-input-event))
(when-let* ((point (get-text-property (point) 'dbus-serial)))

13
lisp/net/newst-backend.el
View file

@ -1109,12 +1109,13 @@ same as in `newsticker--parse-atom-1.0'."
(defun newsticker--parse-text-container (node)
"Handle content according to ``type'' attribute."
(let ((content (car (xml-node-children node))))
(if (string= "html" (xml-get-attribute node 'type))
;; element contains entity escaped html
content
;; plain text or xhtml
(newsticker--unxml content))))
(let ((content (car (xml-node-children node)))
(type (xml-get-attribute node 'type)))
(if (string= "xhtml" type)
;; xhtml: reverse-parse xml nodes back to string
(newsticker--unxml content)
;; plain text (default) or entity-escaped html: return as-is
content)))
(defun newsticker--unxml (node)
"Reverse parsing of an xml string.

2
lisp/net/shr.el
View file

@ -2731,7 +2731,7 @@ flags that control whether to collect or render objects."
(aref widths width-column)
(* 10 shr-table-separator-pixel-width)))
(when (setq colspan (dom-attr column 'colspan))
(setq colspan (min (string-to-number colspan)
(setq colspan (min (truncate (string-to-number colspan))
;; The colspan may be wrong, so
;; truncate it to the length of the
;; remaining columns.

23
lisp/net/tramp-adb.el
View file

@ -974,7 +974,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
(sleep-for 0.1)
host)
(t (tramp-error
vec 'file-error "Could not find device %s" host)))))))
vec 'remote-file-error "Could not find device %s" host)))))))
(defun tramp-adb-execute-adb-command (vec &rest args)
"Execute an adb command.
@ -1047,7 +1047,7 @@ the exit status."
(with-current-buffer (tramp-get-connection-buffer vec)
(unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit)))
(tramp-error
vec 'file-error "Couldn't find exit status of `%s'" command))
vec 'remote-file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
(prog1
(if exit-status
@ -1060,13 +1060,14 @@ the exit status."
"Run COMMAND, check exit status, throw error if exit status not okay.
FMT and ARGS are passed to `error'."
(unless (tramp-adb-send-command-and-check vec command)
(apply #'tramp-error vec 'file-error fmt args)))
(apply #'tramp-error vec 'remote-file-error fmt args)))
(defun tramp-adb-wait-for-output (proc &optional timeout)
"Wait for output from remote command."
(unless (buffer-live-p (process-buffer proc))
(delete-process proc)
(tramp-error proc 'file-error "Process `%s' not available, try again" proc))
(tramp-error
proc 'remote-file-error "Process `%s' not available, try again" proc))
(let ((prompt (tramp-get-connection-property proc "prompt" tramp-adb-prompt)))
(with-current-buffer (process-buffer proc)
(if (tramp-wait-for-regexp proc timeout prompt)
@ -1085,10 +1086,11 @@ FMT and ARGS are passed to `error'."
(delete-region (point) (point-max))))
(if timeout
(tramp-error
proc 'file-error
proc 'remote-file-error
"[[Remote prompt `%s' not found in %d secs]]" prompt timeout)
(tramp-error
proc 'file-error "[[Remote prompt `%s' not found]]" prompt))))))
proc 'remote-file-error
"[[Remote prompt `%s' not found]]" prompt))))))
(defun tramp-adb-maybe-open-connection (vec)
"Maybe open a connection VEC.
@ -1110,13 +1112,14 @@ connection if a previous connection has died for some reason."
;; whether it is still the same device.
(when
(and user (not (tramp-get-connection-property vec " su-command-p" t)))
(tramp-error vec 'file-error "Cannot switch to user `%s'" user))
(tramp-error vec 'remote-file-error "Cannot switch to user `%s'" user))
(unless (process-live-p p)
(save-match-data
(when (and p (processp p)) (delete-process p))
(if (tramp-string-empty-or-nil-p device)
(tramp-error vec 'file-error "Device %s not connected" host))
(tramp-error
vec 'remote-file-error "Device %s not connected" host))
(with-tramp-progress-reporter vec 3 "Opening adb shell connection"
(let* ((coding-system-for-read 'utf-8-dos) ; Is this correct?
(process-connection-type tramp-process-connection-type)
@ -1137,7 +1140,7 @@ connection if a previous connection has died for some reason."
(tramp-send-string vec tramp-rsh-end-of-line)
(tramp-adb-wait-for-output p 30)
(unless (process-live-p p)
(tramp-error vec 'file-error "Terminated!"))
(tramp-error vec 'remote-file-error "Terminated!"))
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)
@ -1193,7 +1196,7 @@ connection if a previous connection has died for some reason."
;; Do not flush, we need the nil value.
(tramp-set-connection-property vec " su-command-p" nil)
(tramp-error
vec 'file-error "Cannot switch to user `%s'" user)))
vec 'remote-file-error "Cannot switch to user `%s'" user)))
;; Mark it as connected.
(tramp-set-connection-property p "connected" t))))))))

2
lisp/net/tramp-archive.el
View file

@ -737,7 +737,7 @@ offered."
(apply #'tramp-archive-file-name-for-operation operation args)))))
(tramp-message v 10 "%s" (cons operation args))
(tramp-error
v 'file-error
v 'remote-file-error
"Operation `%s' not implemented for file archives" operation)))
(add-hook 'tramp-unload-hook

4
lisp/net/tramp-crypt.el
View file

@ -446,7 +446,7 @@ Otherwise, return NAME."
crypt-vec (if (eq op 'encrypt) "encode" "decode")
tramp-compat-temporary-file-directory localname)
(tramp-error
crypt-vec 'file-error "%s of file name %s failed"
crypt-vec 'remote-file-error "%s of file name %s failed"
(if (eq op 'encrypt) "Encoding" "Decoding") name))
(with-current-buffer (tramp-get-connection-buffer crypt-vec)
(goto-char (point-min))
@ -481,7 +481,7 @@ Raise an error if this fails."
(file-name-directory infile)
(concat "/" (file-name-nondirectory infile)))
(tramp-error
crypt-vec 'file-error "%s of file %s failed"
crypt-vec 'remote-file-error "%s of file %s failed"
(if (eq op 'encrypt) "Encrypting" "Decrypting") infile))
(with-current-buffer (tramp-get-connection-buffer crypt-vec)
(write-region nil nil outfile)))))

10
lisp/net/tramp-gvfs.el
View file

@ -1006,7 +1006,7 @@ The global value will always be nil; it is bound where needed.")
"Called when a D-Bus error message arrives, see `dbus-event-error-functions'."
(when tramp-gvfs-dbus-event-vector
(tramp-message tramp-gvfs-dbus-event-vector 6 "%S" event)
(tramp-error tramp-gvfs-dbus-event-vector 'file-error (cadr err))))
(tramp-error tramp-gvfs-dbus-event-vector 'remote-file-error (cadr err))))
(add-hook 'dbus-event-error-functions #'tramp-gvfs-dbus-event-error)
(add-hook 'tramp-gvfs-unload-hook
@ -2234,7 +2234,7 @@ connection if a previous connection has died for some reason."
method)
tramp-gvfs-mounttypes)
(tramp-error
vec 'file-error "Method `%s' not supported by GVFS" method)))
vec 'remote-file-error "Method `%s' not supported by GVFS" method)))
;; For password handling, we need a process bound to the
;; connection buffer. Therefore, we create a dummy process.
@ -2332,10 +2332,10 @@ connection if a previous connection has died for some reason."
vec 'tramp-connection-timeout tramp-connection-timeout)
(if (tramp-string-empty-or-nil-p user-domain)
(tramp-error
vec 'file-error
vec 'remote-file-error
"Timeout reached mounting %s using %s" host-port method)
(tramp-error
vec 'file-error
vec 'remote-file-error
"Timeout reached mounting %s@%s using %s"
user-domain host-port method)))
(while (not (tramp-get-file-property vec "/" "fuse-mountpoint"))
@ -2345,7 +2345,7 @@ connection if a previous connection has died for some reason."
;; is marked with the fuse-mountpoint "/". We shall react.
(when (string-equal
(tramp-get-file-property vec "/" "fuse-mountpoint" "") "/")
(tramp-error vec 'file-error "FUSE mount denied"))
(tramp-error vec 'remote-file-error "FUSE mount denied"))
;; Save the password.
(ignore-errors

84
lisp/net/tramp-rclone.el
View file

@ -381,53 +381,53 @@ connection if a previous connection has died for some reason."
(with-tramp-debug-message vec "Opening connection"
(let ((host (tramp-file-name-host vec)))
(when (rassoc `(,host) (tramp-rclone-parse-device-names nil))
(if (tramp-string-empty-or-nil-p host)
(tramp-error vec 'file-error "Storage %s not connected" host))
;; We need a process bound to the connection buffer.
;; Therefore, we create a dummy process. Maybe there is a
;; better solution?
(unless (get-buffer-process (tramp-get-connection-buffer vec))
(let ((p (make-network-process
:name (tramp-get-connection-name vec)
:buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t)))
(tramp-post-process-creation p vec)
(when (or (tramp-string-empty-or-nil-p host)
(not (rassoc `(,host) (tramp-rclone-parse-device-names nil))))
(tramp-error vec 'remote-file-error "Storage %s not connected" host))
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)))
;; We need a process bound to the connection buffer. Therefore,
;; we create a dummy process. Maybe there is a better solution?
(unless (get-buffer-process (tramp-get-connection-buffer vec))
(let ((p (make-network-process
:name (tramp-get-connection-name vec)
:buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t)))
(tramp-post-process-creation p vec)
;; Create directory.
(unless (file-directory-p (tramp-fuse-mount-point vec))
(make-directory (tramp-fuse-mount-point vec) 'parents))
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)))
;; Mount. This command does not return, so we use 0 as
;; DESTINATION of `tramp-call-process'.
(unless (tramp-fuse-mounted-p vec)
(apply
#'tramp-call-process
vec tramp-rclone-program nil 0 nil
"mount" (tramp-fuse-mount-spec vec)
(tramp-fuse-mount-point vec)
(tramp-get-method-parameter vec 'tramp-mount-args))
(while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc)))
(tramp-cleanup-connection vec 'keep-debug 'keep-password))
(add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec)))
;; Create directory.
(unless (file-directory-p (tramp-fuse-mount-point vec))
(make-directory (tramp-fuse-mount-point vec) 'parents))
;; Mark it as connected.
(tramp-set-connection-property
(tramp-get-connection-process vec) "connected" t)))
;; Mount. This command does not return, so we use 0 as
;; DESTINATION of `tramp-call-process'.
(unless (tramp-fuse-mounted-p vec)
(apply
#'tramp-call-process
vec tramp-rclone-program nil 0 nil
"mount" (tramp-fuse-mount-spec vec)
(tramp-fuse-mount-point vec)
(tramp-get-method-parameter vec 'tramp-mount-args))
(while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc)))
(tramp-cleanup-connection vec 'keep-debug 'keep-password))
(add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec)))
;; In `tramp-check-cached-permissions', the connection properties
;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
(with-tramp-connection-property
vec "uid-integer" (tramp-get-local-uid 'integer))
(with-tramp-connection-property
vec "gid-integer" (tramp-get-local-gid 'integer))
(with-tramp-connection-property
vec "uid-string" (tramp-get-local-uid 'string))
(with-tramp-connection-property
vec "gid-string" (tramp-get-local-gid 'string))))
;; Mark it as connected.
(tramp-set-connection-property
(tramp-get-connection-process vec) "connected" t)))
;; In `tramp-check-cached-permissions', the connection properties
;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
(with-tramp-connection-property
vec "uid-integer" (tramp-get-local-uid 'integer))
(with-tramp-connection-property
vec "gid-integer" (tramp-get-local-gid 'integer))
(with-tramp-connection-property
vec "uid-string" (tramp-get-local-uid 'string))
(with-tramp-connection-property
vec "gid-string" (tramp-get-local-gid 'string)))
(defun tramp-rclone-send-command (vec &rest args)
"Send a command to connection VEC.

53
lisp/net/tramp-sh.el
View file

@ -1969,7 +1969,7 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-send-command-and-read
vec (format "tramp_perl_directory_files_and_attributes %s"
(tramp-shell-quote-argument localname)))))
(when (stringp object) (tramp-error vec 'file-error object))
(when (stringp object) (tramp-error vec 'remote-file-error object))
object))
;; FIXME: Fix function to work with count parameter.
@ -2378,7 +2378,7 @@ the uid and gid from FILENAME."
((eq op 'copy) "cp -f")
((eq op 'rename) "mv -f")
(t (tramp-error
v 'file-error
v 'remote-file-error
"Unknown operation `%s', must be `copy' or `rename'"
op))))
(localname1 (tramp-file-local-name filename))
@ -2608,7 +2608,7 @@ The method used must be an out-of-band method."
;; Check for local copy program.
(unless (executable-find copy-program)
(tramp-error
v 'file-error "Cannot find local copy program: %s" copy-program))
v 'remote-file-error "Cannot find local copy program: %s" copy-program))
;; Install listener on the remote side. The prompt must be
;; consumed later on, when the process does not listen anymore.
@ -2618,7 +2618,7 @@ The method used must be an out-of-band method."
(tramp-find-executable
v remote-copy-program (tramp-get-remote-path v)))
(tramp-error
v 'file-error
v 'remote-file-error
"Cannot find remote listener: %s" remote-copy-program))
(setq remote-copy-program
(string-join
@ -2629,7 +2629,7 @@ The method used must be an out-of-band method."
(tramp-send-command v remote-copy-program)
(with-timeout
(60 (tramp-error
v 'file-error
v 'remote-file-error
"Listener process not running on remote host: `%s'"
remote-copy-program))
(tramp-send-command v (format "netstat -l | grep -q :%s" listener))
@ -3468,7 +3468,8 @@ will be used."
;; Oops, I don't know what to do.
(t (tramp-error
v 'file-error "Wrong method specification for `%s'" method)))
v 'remote-file-error
"Wrong method specification for `%s'" method)))
;; Error handling.
((error quit)
@ -3663,7 +3664,7 @@ will be used."
;; That's not expected.
(t
(tramp-error
v 'file-error
v 'remote-file-error
(concat "Method `%s' should specify both encoding and "
"decoding command or an scp program")
method)))))))))
@ -3689,7 +3690,7 @@ are \"file-exists-p\", \"file-readable-p\", \"file-directory-p\" and
tramp-end-of-heredoc
(mapconcat #'tramp-shell-quote-argument files "\n")
tramp-end-of-heredoc))
(tramp-error vec 'file-error "%s" (tramp-get-buffer-string)))
(tramp-error vec 'remote-file-error "%s" (tramp-get-buffer-string)))
;; Read the expression.
(goto-char (point-min))
(read (current-buffer))))
@ -4165,7 +4166,7 @@ Only send the definition if it has not already been done."
;; Expand format specifiers.
(unless (setq script (tramp-expand-script vec script))
(tramp-error
vec 'file-error
vec 'remote-file-error
(format "Script %s is not applicable on remote host" name)))
;; Send it.
(tramp-barf-unless-okay
@ -4325,13 +4326,15 @@ file exists and nonzero exit status otherwise."
;; We cannot use `tramp-get-ls-command', this results in an infloop.
;; (Bug#65321)
(ignore-errors
(and (setq result (format "ls -d >%s" (tramp-get-remote-null-device vec)))
(and (setq
result
(format "ls -d >%s" (tramp-get-remote-null-device vec)))
(tramp-send-command-and-check
vec (format "%s %s" result existing))
(not (tramp-send-command-and-check
vec (format "%s %s" result nonexistent))))))
(tramp-error
vec 'file-error "Couldn't find command to check if file exists"))
vec 'remote-file-error "Couldn't find command to check if file exists"))
(tramp-set-file-property vec existing "file-exists-p" t)
result))
@ -4484,7 +4487,8 @@ seconds. If not, it produces an error message with the given ERROR-ARGS."
(error
(delete-process proc)
(apply #'tramp-error-with-buffer
(tramp-get-connection-buffer vec) vec 'file-error error-args)))))
(tramp-get-connection-buffer vec) vec
'remote-file-error error-args)))))
(defvar tramp-config-check nil
"A function to be called with one argument, VEC.
@ -5293,8 +5297,8 @@ connection if a previous connection has died for some reason."
(unless (and (process-live-p p)
(tramp-wait-for-output p 10))
;; The error will be caught locally.
(tramp-error vec 'file-error "Awake did fail")))
(file-error
(tramp-error vec 'remote-file-error "Awake did fail")))
(remote-file-error
(tramp-cleanup-connection vec t)
(setq p nil)))
@ -5314,7 +5318,8 @@ connection if a previous connection has died for some reason."
(setenv "HISTFILESIZE" "0")
(setenv "HISTSIZE" "0"))))
(unless (stringp tramp-encoding-shell)
(tramp-error vec 'file-error "`tramp-encoding-shell' not set"))
(tramp-error
vec 'remote-file-error "`tramp-encoding-shell' not set"))
(let* ((current-host tramp-system-name)
(target-alist (tramp-compute-multi-hops vec))
(previous-hop tramp-null-hop)
@ -5520,7 +5525,8 @@ function waits for output unless NOOUTPUT is set."
"Wait for output from remote command."
(unless (buffer-live-p (process-buffer proc))
(delete-process proc)
(tramp-error proc 'file-error "Process `%s' not available, try again" proc))
(tramp-error
proc 'remote-file-error "Process `%s' not available, try again" proc))
(with-current-buffer (process-buffer proc)
(let* (;; Initially, `tramp-end-of-output' is "#$ ". There might
;; be leading ANSI control escape sequences, which must be
@ -5551,11 +5557,11 @@ function waits for output unless NOOUTPUT is set."
(delete-region (point) (point-max))))
(if timeout
(tramp-error
proc 'file-error
proc 'remote-file-error
"[[Remote prompt `%s' not found in %d secs]]"
tramp-end-of-output timeout)
(tramp-error
proc 'file-error
proc 'remote-file-error
"[[Remote prompt `%s' not found]]" tramp-end-of-output)))
;; Return value is whether end-of-output sentinel was found.
found)))
@ -5594,7 +5600,7 @@ the exit status."
(with-current-buffer (tramp-get-connection-buffer vec)
(unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit)))
(tramp-error
vec 'file-error "Couldn't find exit status of `%s'" command))
vec 'remote-file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
(prog1
(if exit-status
@ -5608,7 +5614,7 @@ the exit status."
Similar to `tramp-send-command-and-check' but accepts two more arguments
FMT and ARGS which are passed to `error'."
(or (tramp-send-command-and-check vec command)
(apply #'tramp-error vec 'file-error fmt args)))
(apply #'tramp-error vec 'remote-file-error fmt args)))
(defun tramp-send-command-and-read (vec command &optional noerror marker)
"Run COMMAND and return the output, which must be a Lisp expression.
@ -5627,7 +5633,7 @@ raises an error."
(search-forward-regexp marker)
(error (unless noerror
(tramp-error
vec 'file-error
vec 'remote-file-error
"`%s' does not return the marker `%s': `%s'"
command marker (buffer-string))))))
;; Read the expression.
@ -5641,7 +5647,7 @@ raises an error."
(error nil)))
(error (unless noerror
(tramp-error
vec 'file-error
vec 'remote-file-error
"`%s' does not return a valid Lisp expression: `%s'"
command (buffer-string))))))))
@ -5854,7 +5860,8 @@ Nonexistent directories are removed from spec."
(setq result (concat result " --color=never")))
(throw 'ls-found result))
(setq dl (cdr dl))))))
(tramp-error vec 'file-error "Couldn't find a proper `ls' command"))))
(tramp-error
vec 'remote-file-error "Couldn't find a proper `ls' command"))))
(defun tramp-get-ls-command-with (vec option)
"Return OPTION, if the remote `ls' command supports the OPTION option."

20
lisp/net/tramp-smb.el
View file

@ -821,7 +821,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq filename (directory-file-name (expand-file-name filename)))
(with-parsed-tramp-file-name filename nil
(tramp-convert-file-attributes v localname id-format
(ignore-errors
(condition-case err
(if (tramp-smb-get-stat-capability v)
(tramp-smb-do-file-attributes-with-stat v)
;; Reading just the filename entry via "dir localname" is
@ -851,7 +851,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(nth 1 entry) ;8 mode
nil ;9 gid weird
inode ;10 inode number
device)))))))) ;11 file system number
device)))) ;11 file system number
(remote-file-error (signal (car err) (cdr err)))
(error)))))
(defun tramp-smb-do-file-attributes-with-stat (vec)
"Implement `file-attributes' for Tramp files using `stat' command."
@ -1382,7 +1384,7 @@ will be used."
"Like `make-symbolic-link' for Tramp files."
(let ((v (tramp-dissect-file-name (expand-file-name linkname))))
(unless (tramp-smb-get-cifs-capabilities v)
(tramp-error v 'file-error "make-symbolic-link not supported")))
(tramp-error v 'remote-file-error "make-symbolic-link not supported")))
(tramp-skeleton-make-symbolic-link target linkname ok-if-already-exists
(unless (tramp-smb-send-command
@ -1571,8 +1573,7 @@ will be used."
(tramp-search-regexp (rx "tramp_exit_status " (+ digit)))
(tramp-error
v 'file-error
"Couldn't find exit status of `%s'"
tramp-smb-acl-program))
"Couldn't find exit status of `%s'" tramp-smb-acl-program))
(skip-chars-forward "^ ")
(when (zerop (read (current-buffer)))
;; Success.
@ -1705,7 +1706,7 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
(when (string-match-p (rx blank eol) localname)
(tramp-error
vec 'file-error
"Invalid file name %s" (tramp-make-tramp-file-name vec localname)))
"Invalid file name `%s'" (tramp-make-tramp-file-name vec localname)))
localname)))
@ -1988,7 +1989,7 @@ If ARGUMENT is non-nil, use it as argument for
(unless tramp-smb-version
(unless (executable-find tramp-smb-program)
(tramp-error
vec 'file-error
vec 'remote-file-error
"Cannot find command %s in %s" tramp-smb-program exec-path))
(setq tramp-smb-version (shell-command-to-string command))
(tramp-message vec 6 command)
@ -2165,11 +2166,12 @@ Removes smb prompt. Returns nil if an error message has appeared."
;; Check for program.
(unless (executable-find tramp-smb-winexe-program)
(tramp-error
vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program))
vec 'remote-file-error "Cannot find program: %s" tramp-smb-winexe-program))
;; winexe does not supports ports.
(when (tramp-file-name-port vec)
(tramp-error vec 'file-error "Port not supported for remote processes"))
(tramp-error
vec 'remote-file-error "Port not supported for remote processes"))
;; Check share.
(unless (tramp-smb-get-share vec)

2
lisp/net/tramp-sshfs.el
View file

@ -359,7 +359,7 @@ connection if a previous connection has died for some reason."
vec 'tramp-mount-args nil
?p (or (tramp-file-name-port vec) ""))))))
(tramp-error
vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec)))
vec 'remote-file-error "Error mounting %s" (tramp-fuse-mount-spec vec)))
;; Mark it as connected.
(add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec))

11
lisp/net/tramp-sudoedit.el
View file

@ -52,6 +52,10 @@
`(,(rx bos (literal tramp-sudoedit-method) eos)
nil ,tramp-root-id-string))
(add-to-list 'tramp-default-host-alist
`(,(rx bos (literal tramp-sudoedit-method) eos)
nil ,(system-name)))
(tramp-set-completion-function
tramp-sudoedit-method tramp-completion-function-alist-su))
@ -742,6 +746,10 @@ connection if a previous connection has died for some reason."
(unless (tramp-connectable-p vec)
(throw 'non-essential 'non-essential))
(unless (string-match-p tramp-local-host-regexp (tramp-file-name-host vec))
(tramp-error
vec 'remote-file-error "%s is not a local host" (tramp-file-name-host vec)))
(with-tramp-debug-message vec "Opening connection"
;; We need a process bound to the connection buffer. Therefore,
;; we create a dummy process. Maybe there is a better solution?
@ -775,7 +783,6 @@ in case of error, t otherwise."
(append
(tramp-expand-args
vec 'tramp-sudo-login nil
?h (or (tramp-file-name-host vec) "")
?u (or (tramp-file-name-user vec) ""))
(flatten-tree args))))
;; We suppress the messages `Waiting for prompts from remote shell'.
@ -817,7 +824,7 @@ In case there is no valid Lisp expression, it raises an error."
(when (search-forward-regexp (rx (not blank)) (line-end-position) t)
(error nil)))
(error (tramp-error
vec 'file-error
vec 'remote-file-error
"`%s' does not return a valid Lisp expression: `%s'"
(car args) (buffer-string)))))))

19
lisp/net/tramp.el
View file

@ -3931,7 +3931,7 @@ BODY is the backend specific code."
;; The implementation is not complete yet.
(when (and (numberp ,destination) (zerop ,destination))
(tramp-error
v 'file-error "Implementation does not handle immediate return"))
v 'remote-file-error "Implementation does not handle immediate return"))
(let (command input tmpinput stderr tmpstderr outbuf ret)
;; Determine input.
@ -5239,6 +5239,9 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
?u (or (tramp-file-name-user (car target-alist)) "")
?h (or (tramp-file-name-host (car target-alist)) ""))))
(with-parsed-tramp-file-name proxy l
(when (member l target-alist)
(tramp-user-error
vec "Cycle proxy definition `%s' in multi-hop" proxy))
;; Add the hop.
(push l target-alist)
;; Start next search.
@ -5505,7 +5508,7 @@ processes."
This is the fallback implementation for backends which do not
support symbolic links."
(tramp-error
(tramp-dissect-file-name (expand-file-name linkname)) 'file-error
(tramp-dissect-file-name (expand-file-name linkname)) 'remote-file-error
"make-symbolic-link not supported"))
(defun tramp-handle-memory-info ()
@ -6255,7 +6258,7 @@ performed successfully. Any other value means an error."
(tramp-clear-passwd vec)
(delete-process proc)
(tramp-error-with-buffer
(tramp-get-connection-buffer vec) vec 'file-error
(tramp-get-connection-buffer vec) vec 'remote-file-error
(cond
((eq exit 'permission-denied) "Permission denied")
((eq exit 'out-of-band-failed)
@ -6402,7 +6405,7 @@ nil."
(tramp-accept-process-output proc)
(unless (process-live-p proc)
(tramp-error-with-buffer
nil proc 'file-error "Process has died"))
nil proc 'remote-file-error "Process has died"))
(setq found (tramp-check-for-regexp proc regexp))))
;; The process could have timed out, for example due to session
;; timeout of sudo. The process buffer does not exist any longer then.
@ -6412,9 +6415,10 @@ nil."
(unless found
(if timeout
(tramp-error
proc 'file-error "[[Regexp `%s' not found in %d secs]]"
proc 'remote-file-error "[[Regexp `%s' not found in %d secs]]"
regexp timeout)
(tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
(tramp-error
proc 'remote-file-error "[[Regexp `%s' not found]]" regexp)))
found))
;; It seems that Tru64 Unix does not like it if long strings are sent
@ -6431,7 +6435,8 @@ the remote host use line-endings as defined in the variable
(chunksize (tramp-get-connection-property p "chunksize")))
(unless p
(tramp-error
vec 'file-error "Can't send string to remote host -- not logged in"))
vec 'remote-file-error
"Can't send string to remote host -- not logged in"))
(tramp-set-connection-property p "last-cmd-time" (current-time))
(tramp-message vec 10 "%s" string)
(with-current-buffer (tramp-get-connection-buffer vec)

17
lisp/pixel-scroll.el
View file

@ -90,7 +90,6 @@
(require 'mwheel)
(require 'subr-x)
(require 'ring)
(require 'cua-base)
(defvar pixel-wait 0
"Idle time on each step of pixel scroll specified in second.
@ -831,7 +830,13 @@ It is a vector of the form [ VELOCITY TIME SIGN ]."
;; since we want exactly 1
;; page to be scrolled.
nil 1)
(cua-scroll-up)))
(cond
((eobp)
(scroll-up)) ; signal error
(t
(condition-case nil
(scroll-up)
(end-of-buffer (goto-char (point-max))))))))
;;;###autoload
(defun pixel-scroll-interpolate-up ()
@ -840,7 +845,13 @@ It is a vector of the form [ VELOCITY TIME SIGN ]."
(if pixel-scroll-precision-interpolate-page
(pixel-scroll-precision-interpolate (window-text-height nil t)
nil 1)
(cua-scroll-down)))
(cond
((bobp)
(scroll-down)) ; signal error
(t
(condition-case nil
(scroll-down)
(beginning-of-buffer (goto-char (point-min))))))))
;;;###autoload
(define-minor-mode pixel-scroll-precision-mode

65
lisp/progmodes/eglot.el
View file

@ -282,7 +282,8 @@ automatically)."
. ,(eglot-alternatives
'(("solargraph" "socket" "--port" :autoport) "ruby-lsp")))
(haskell-mode
. ("haskell-language-server-wrapper" "--lsp"))
. ,(eglot-alternatives
'(("haskell-language-server-wrapper" "--lsp") "static-ls")))
(elm-mode . ("elm-language-server"))
(mint-mode . ("mint" "ls"))
((kotlin-mode kotlin-ts-mode) . ("kotlin-language-server"))
@ -308,7 +309,7 @@ automatically)."
(racket-mode . ("racket" "-l" "racket-langserver"))
((latex-mode plain-tex-mode context-mode texinfo-mode bibtex-mode tex-mode)
. ,(eglot-alternatives '("digestif" "texlab")))
(erlang-mode . ("erlang_ls" "--transport" "stdio"))
(erlang-mode . ("elp" "server"))
(wat-mode . ("wat_server"))
((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio"))
((toml-ts-mode conf-toml-mode) . ("tombi" "lsp"))
@ -1438,6 +1439,12 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see."
(maphash (lambda (f s)
(when (eq s server) (remhash f eglot--servers-by-xrefed-file)))
eglot--servers-by-xrefed-file)
;; Cleanup entries in 'flymake-list-only-diagnostics'
(setq flymake-list-only-diagnostics
(cl-delete-if
(lambda (x) (eq server
(get-text-property 0 'eglot--server (car x))))
flymake-list-only-diagnostics))
(cond ((eglot--shutdown-requested server)
t)
((not (eglot--inhibit-autoreconnect server))
@ -2024,21 +2031,25 @@ according to `eglot-advertise-cancellation'.")
(timeout-fn nil timeout-fn-supplied-p)
(timeout nil timeout-supplied-p)
hint
&aux moreargs
id (buf (current-buffer)))
&aux moreargs id
(buf (current-buffer))
(inflight eglot--inflight-async-requests))
"Like `jsonrpc-async-request', but for Eglot LSP requests.
SUCCESS-FN, ERROR-FN and TIMEOUT-FN run in buffer of call site.
HINT argument is a symbol passed as DEFERRED to `jsonrpc-async-request'
and also used as a hint of the request cancellation mechanism (see
`eglot-advertise-cancellation')."
(cl-labels
((clearing-fn (fn)
((wrapfn (fn)
(lambda (&rest args)
(eglot--when-live-buffer buf
(when (and
fn (memq id (cl-getf eglot--inflight-async-requests hint)))
(apply fn args))
(cl-remf eglot--inflight-async-requests hint)))))
(cond (eglot-advertise-cancellation
(when-let* ((tail (and fn (plist-member inflight hint))))
(when (memq id (cadr tail))
(apply fn args))
(setf (cadr tail) (delete id (cadr tail)))))
(t
(apply fn args)))))))
(eglot--cancel-inflight-async-requests (list hint))
(when timeout-supplied-p
(setq moreargs (nconc `(:timeout ,timeout) moreargs)))
@ -2047,13 +2058,12 @@ and also used as a hint of the request cancellation mechanism (see
(setq id
(car (apply #'jsonrpc-async-request
server method params
:success-fn (clearing-fn success-fn)
:error-fn (clearing-fn error-fn)
:timeout-fn (clearing-fn timeout-fn)
:success-fn (wrapfn success-fn)
:error-fn (wrapfn error-fn)
:timeout-fn (wrapfn timeout-fn)
moreargs)))
(when (and hint eglot-advertise-cancellation)
(push id
(plist-get eglot--inflight-async-requests hint)))
(push id (plist-get inflight hint)))
id))
(cl-defun eglot--delete-overlays (&optional (prop 'eglot--overlays))
@ -3422,11 +3432,8 @@ object. The originator of this \"push\" is usually either regular
(with-current-buffer buffer
(if (and version (/= version eglot--docver))
(cl-return-from eglot--flymake-handle-push))
(setq
;; if no explicit version received, assume it's current.
version eglot--docver
flymake-list-only-diagnostics
(assoc-delete-all path flymake-list-only-diagnostics))
;; if no explicit version received, assume it's current.
(setq version eglot--docver)
(funcall then diagnostics))
(cl-loop
for diag-spec across diagnostics
@ -3437,12 +3444,13 @@ object. The originator of this \"push\" is usually either regular
(flymake-make-diagnostic
path (cons line char) nil
(eglot--flymake-diag-type severity)
(list source code message))))
(list source code message)
`((eglot-lsp-diag . ,diag-spec)))))
into diags
finally
(setq flymake-list-only-diagnostics
(assoc-delete-all path flymake-list-only-diagnostics))
(push (cons path diags) flymake-list-only-diagnostics))))
(setf (alist-get (propertize path 'eglot--server server)
flymake-list-only-diagnostics nil nil #'equal)
diags))))
(cl-defun eglot--flymake-pull (&aux (server (eglot--current-server-or-lose))
(origin (current-buffer)))
@ -3506,6 +3514,17 @@ MODE is like `eglot--flymake-report-1'."
(pushed-outdated-p (and pushed-docver (< pushed-docver eglot--docver))))
"Push previously collected diagnostics to `eglot--flymake-report-fn'.
If KEEP, knowingly push a dummy do-nothing update."
;; Maybe hack in diagnostics we previously may have saved in
;; `flymake-list-only-diagnostics', pushed for this file before it was
;; visited (github#1531).
(when-let* ((hack (and (<= eglot--docver 0)
(null eglot--pushed-diagnostics)
(cdr (assoc (buffer-file-name)
flymake-list-only-diagnostics)))))
(cl-loop
for x in hack
collect (alist-get 'eglot-lsp-diag (flymake-diagnostic-data x)) into res
finally (setq eglot--pushed-diagnostics `(,(vconcat res) ,eglot--docver))))
(eglot--widening
(if (and (null eglot--pulled-diagnostics) pushed-outdated-p)
;; Here, we don't have anything interesting to give to Flymake.

4
lisp/progmodes/elisp-mode.el
View file

@ -1783,7 +1783,9 @@ and `eval-expression-print-level'.
(funcall
(syntax-propertize-rules
(emacs-lisp-byte-code-comment-re
(1 (prog1 "< b" (elisp--byte-code-comment end (point))))))
(1 (prog1 "< b"
(goto-char (match-end 2))
(elisp--byte-code-comment end (point))))))
start end))
;;;###autoload

Some files were not shown because too many files have changed in this diff Show more