Merge remote-tracking branch 'savannah/master' into HEAD
This commit is contained in:
Andrea Corallo
commit
6a726c5ad7
113 changed files with 1165 additions and 1069 deletions
6
.gitignore
vendored
6
.gitignore
vendored
|
|
@ -165,6 +165,12 @@ GSYMS
|
|||
GRTAGS
|
||||
GTAGS
|
||||
|
||||
# auto-generated compilation database
|
||||
compile_commands.json
|
||||
|
||||
# ccls, a LSP-compliant server for C
|
||||
/.ccls-cache
|
||||
|
||||
# GNU idutils.
|
||||
ID
|
||||
|
||||
|
|
|
|||
|
|
@ -786,10 +786,7 @@ case "${canonical}" in
|
|||
*-nto-qnx* )
|
||||
opsys=qnxnto
|
||||
test -z "$CC" && CC=qcc
|
||||
CFLAGS="$CFLAGS -D__NO_EXT_QNX"
|
||||
if test "$with_unexec" = yes; then
|
||||
LDFLAGS="-N2MB $LDFLAGS"
|
||||
fi
|
||||
LDFLAGS="-N2M $LDFLAGS"
|
||||
;;
|
||||
|
||||
## Intel 386 machines where we don't care about the manufacturer.
|
||||
|
|
|
|||
|
|
@ -109,6 +109,16 @@ the minibuffer (@pxref{Minibuffer History}).
|
|||
You can also invoke Dired by giving @kbd{C-x C-f} (@code{find-file})
|
||||
a directory's name.
|
||||
|
||||
@findex dired-jump
|
||||
@findex dired-jump-other-window
|
||||
@kindex C-x C-j
|
||||
@kindex C-x 4 C-j
|
||||
Typing @kbd{C-x C-j} (@code{dired-jump}) in any buffer will open a
|
||||
Dired buffer and move point to the line corresponding to the current
|
||||
file. In Dired, move up a level and go to the previous directory's
|
||||
line. Typing @kbd{C-x 4 C-j} (@code{dired-jump-other-window} has the
|
||||
same effect but opens a new window for the Dired buffer.
|
||||
|
||||
The variable @code{dired-listing-switches} specifies the options to
|
||||
give to @command{ls} for listing the directory; this string
|
||||
@emph{must} contain @samp{-l}. If you use a prefix argument with the
|
||||
|
|
|
|||
|
|
@ -1215,11 +1215,8 @@ system can encode.
|
|||
|
||||
If @code{file-name-coding-system} is @code{nil}, Emacs uses a
|
||||
default coding system determined by the selected language environment,
|
||||
and stored in the @code{default-file-name-coding-system} variable.
|
||||
@c FIXME? Is this correct? What is the "default language environment"?
|
||||
In the default language environment, non-@acronym{ASCII} characters in
|
||||
file names are not encoded specially; they appear in the file system
|
||||
using the internal Emacs representation.
|
||||
and stored in the @code{default-file-name-coding-system} variable
|
||||
(normally UTF-8).
|
||||
|
||||
@cindex file-name encoding, MS-Windows
|
||||
@vindex w32-unicode-filenames
|
||||
|
|
|
|||
|
|
@ -1471,7 +1471,7 @@ If @var{handler} returns a reply message with an empty argument list,
|
|||
to distinguish it from @code{nil} (the boolean false).
|
||||
|
||||
If @var{handler} detects an error, it shall return the list
|
||||
@code{(:error @var{error-name} @var{error-message)}}.
|
||||
@code{(:error @var{error-name} @var{error-message})}.
|
||||
@var{error-name} is a namespaced string which characterizes the error
|
||||
type, and @var{error-message} is a free text string. Alternatively,
|
||||
any Emacs signal @code{dbus-error} in @var{handler} raises a D-Bus
|
||||
|
|
@ -2031,10 +2031,11 @@ This function returns the member name of the D-Bus object @var{event}
|
|||
is coming from. It is either a signal name or a method name.
|
||||
@end defun
|
||||
|
||||
D-Bus errors are not propagated during event handling, because it is
|
||||
usually not desired. D-Bus errors in events can be made visible by
|
||||
setting the variable @code{dbus-debug} to @code{t}. They can also be
|
||||
handled by a hook function.
|
||||
@vindex dbus-show-dbus-errors
|
||||
D-Bus error messages are not propagated during event handling, because
|
||||
it is usually not desired. D-Bus errors in events can be made visible
|
||||
by setting the user option @code{dbus-show-dbus-errors} to
|
||||
non-@code{nil}. They can also be handled by a hook function.
|
||||
|
||||
@defvar dbus-event-error-functions
|
||||
This hook variable keeps a list of functions, which are called when a
|
||||
|
|
|
|||
|
|
@ -150,10 +150,8 @@ Commands using file marking
|
|||
|
||||
@noindent
|
||||
@file{dired-x.el} binds some functions to keys in Dired Mode (@pxref{Key
|
||||
Index}) and also binds @kbd{C-x C-j} and @kbd{C-x 4 C-j} @emph{globally} to
|
||||
@code{dired-jump} (@pxref{Miscellaneous Commands}). Optionally, it
|
||||
also binds @kbd{C-x C-f} and @kbd{C-x 4 C-f} to
|
||||
@code{dired-x-find-file} and @code{dired-x-find-file-other-window},
|
||||
Index}). Optionally, it also binds @kbd{C-x C-f} and @kbd{C-x 4 C-f}
|
||||
to @code{dired-x-find-file} and @code{dired-x-find-file-other-window},
|
||||
respectively (@pxref{Find File At Point}).
|
||||
|
||||
@node Technical Details
|
||||
|
|
@ -204,32 +202,10 @@ when you first type @kbd{C-x d}).
|
|||
|
||||
@ifnottex
|
||||
@menu
|
||||
* Optional Installation Dired Jump::
|
||||
* Optional Installation File At Point::
|
||||
@end menu
|
||||
@end ifnottex
|
||||
|
||||
@node Optional Installation Dired Jump
|
||||
@section Optional Installation Dired Jump
|
||||
|
||||
@cindex autoloading @code{dired-jump} and @code{dired-jump-other-window}
|
||||
|
||||
In order to have @code{dired-jump} and @code{dired-jump-other-window}
|
||||
(@pxref{Miscellaneous Commands}) work @emph{before} @code{dired} and
|
||||
@code{dired-x} have been properly loaded you should set-up an autoload
|
||||
for these functions. In your @file{.emacs} file put
|
||||
|
||||
@example
|
||||
(autoload 'dired-jump "dired-x"
|
||||
"Jump to Dired buffer corresponding to current buffer." t)
|
||||
|
||||
(autoload 'dired-jump-other-window "dired-x"
|
||||
"Like \\[dired-jump] (dired-jump) but in other window." t)
|
||||
|
||||
(define-key global-map "\C-x\C-j" 'dired-jump)
|
||||
(define-key global-map "\C-x4\C-j" 'dired-jump-other-window)
|
||||
@end example
|
||||
|
||||
@node Optional Installation File At Point
|
||||
@section Optional Installation File At Point
|
||||
|
||||
|
|
@ -919,28 +895,6 @@ inserted subdirectories.
|
|||
|
||||
@table @code
|
||||
|
||||
@item dired-jump
|
||||
@findex dired-jump
|
||||
@kindex C-x C-j
|
||||
@cindex jumping to Dired listing containing file.
|
||||
Bound to @kbd{C-x C-j}. Jump back to Dired: If in a file, edit the current
|
||||
directory and move to file's line. If in Dired already, pop up a level and
|
||||
go to old directory's line. In case the proper Dired file line cannot be
|
||||
found, refresh the Dired buffer and try again.
|
||||
|
||||
@item dired-jump-other-window
|
||||
@findex dired-jump-other-window
|
||||
@kindex C-x 4 C-j
|
||||
Bound to @kbd{C-x 4 C-j}. Like @code{dired-jump}, but to other window.
|
||||
|
||||
These functions can be autoloaded so they work even though @file{dired-x.el}
|
||||
has not been loaded yet (@pxref{Optional Installation Dired Jump}).
|
||||
|
||||
@vindex dired-bind-jump
|
||||
If the variable @code{dired-bind-jump} is @code{nil}, @code{dired-jump} will not be
|
||||
bound to @kbd{C-x C-j} and @code{dired-jump-other-window} will not be bound to
|
||||
@kbd{C-x 4 C-j}.
|
||||
|
||||
@item dired-vm
|
||||
@cindex reading mail.
|
||||
@kindex V
|
||||
|
|
|
|||
|
|
@ -212,6 +212,22 @@ in an external browser by customizing
|
|||
@node Advanced
|
||||
@chapter Advanced
|
||||
|
||||
@findex eww-retrieve-command
|
||||
EWW normally uses @code{url-retrieve} to fetch the @acronym{HTML}
|
||||
before rendering it. It can sometimes be convenient to use an
|
||||
external program to do this, and @code{eww-retrieve-command} should
|
||||
then be a list that specifies a command and the parameters. For
|
||||
instance, to use the Chromium browser, you could say something like
|
||||
this:
|
||||
|
||||
@lisp
|
||||
(setq eww-retrieve-command
|
||||
'("chromium" "--headless" "--dump-dom"))
|
||||
@end lisp
|
||||
|
||||
The command should return the @acronym{HTML} on standard output, and
|
||||
the data should use @acronym{UTF-8} as the charset.
|
||||
|
||||
@findex eww-view-source
|
||||
@kindex v
|
||||
@cindex Viewing Source
|
||||
|
|
|
|||
|
|
@ -21401,8 +21401,8 @@ be nice.
|
|||
Gnus has various ways of finding articles that match certain criteria
|
||||
(from a particular author, on a certain subject, etc.). The simplest
|
||||
method is to enter a group and then either "limit" the summary buffer
|
||||
to the desired articles using the limiting commands (@xref{Limiting}),
|
||||
or searching through messages in the summary buffer (@xref{Searching
|
||||
to the desired articles using the limiting commands (@pxref{Limiting}),
|
||||
or searching through messages in the summary buffer (@pxref{Searching
|
||||
for Articles}).
|
||||
|
||||
Limiting commands and summary buffer searching work on subsets of the
|
||||
|
|
|
|||
75
etc/NEWS
75
etc/NEWS
|
|
@ -85,6 +85,12 @@ useful on systems such as FreeBSD which ships only with "etc/termcap".
|
|||
|
||||
* Changes in Emacs 28.1
|
||||
|
||||
+++
|
||||
*** Emacs now defaults to UTF-8 instead of ISO-8859-1.
|
||||
This is only for the default, where the user has set no LANG (or
|
||||
similar) variable or environment. This change should lead to no
|
||||
user-visible changes for normal usage.
|
||||
|
||||
+++
|
||||
** New variables that hold default buffer names for shell output.
|
||||
The new constants 'shell-command-buffer-name' and
|
||||
|
|
@ -164,6 +170,11 @@ setting the variable 'auto-save-visited-mode' buffer-locally to nil.
|
|||
description of the properties. Likewise 'button-describe' does the
|
||||
same for a button.
|
||||
|
||||
** Obsolete commands are no longer hidden from command completion.
|
||||
Completion of command names now considers obsolete aliases as
|
||||
candidates. Invoking a command via an obsolete alias now mentions the
|
||||
obsolescence fact and shows the new name of the command.
|
||||
|
||||
|
||||
* Changes in Specialized Modes and Packages in Emacs 28.1
|
||||
|
||||
|
|
@ -290,6 +301,19 @@ details of marking the file at the end of the region.
|
|||
*** State changing VC operations are supported in Dired on files and
|
||||
directories with the help of new command 'dired-vc-next-action'.
|
||||
|
||||
+++
|
||||
*** 'dired-jump' and 'dired-jump-other-window' moved from dired-x to dired.
|
||||
The 'dired-jump' and 'dired-jump-other-window' commands have been
|
||||
moved from the 'dired-x' package to 'dired'. The user option
|
||||
'dired-bind-jump' no longer has any effect and is now obsolete.
|
||||
The commands are now bound to 'C-x C-j' and 'C-x 4 C-j' by default.
|
||||
|
||||
To get the old behavior of 'dired-bind-jump' back and unbind the above
|
||||
keys, add the following to your Init file:
|
||||
|
||||
(global-set-key "\C-x\C-j" nil)
|
||||
(global-set-key "\C-x4\C-j" nil)
|
||||
|
||||
** Change Logs and VC
|
||||
|
||||
*** More VC commands can be used from non-file buffers.
|
||||
|
|
@ -789,6 +813,11 @@ background colors or transparency, such as xbm, pbm, svg, png and gif.
|
|||
|
||||
** EWW
|
||||
|
||||
+++
|
||||
*** New variable 'eww-retrieve-command'.
|
||||
This can be used to download data via an external command. If nil
|
||||
(the default), then 'url-retrieve' is used.
|
||||
|
||||
+++
|
||||
*** New Emacs command line convenience function.
|
||||
The 'eww-browse' command has been added, which allows you to register
|
||||
|
|
@ -959,14 +988,14 @@ window after starting). This variable defaults to nil.
|
|||
** Miscellaneous
|
||||
|
||||
+++
|
||||
*** New command 'submit-emacs-patch'
|
||||
*** New command 'submit-emacs-patch'.
|
||||
This works along the lines of 'report-emacs-bug', but is more geared
|
||||
towards sending a patch to the Emacs issue tracker.
|
||||
|
||||
+++
|
||||
*** New minor mode 'button-mode'.
|
||||
This minor mode does nothing else than install 'button-buffer-map' as
|
||||
a minor mode map (which binds the TAB/S-TAB key bindings to navigate
|
||||
a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate
|
||||
to buttons), and can be used in any view-mode-like buffer that has
|
||||
buttons in it.
|
||||
|
||||
|
|
@ -1112,9 +1141,11 @@ type symbols.
|
|||
+++
|
||||
*** In case of problems, handlers can emit proper D-Bus error messages now.
|
||||
|
||||
---
|
||||
+++
|
||||
*** D-Bus errors, which have been converted from incoming D-Bus error
|
||||
messages, contain the error name of that message now.
|
||||
messages, contain the error name of that message now. They can be
|
||||
made visible by setting user variable 'dbus-show-dbus-errors' to
|
||||
non-nil, even if protected by 'dbus-ignore-errors' otherwise.
|
||||
|
||||
|
||||
* New Modes and Packages in Emacs 28.1
|
||||
|
|
@ -1210,8 +1241,8 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
|
|||
'completion-base-size', 'completion-common-substring',
|
||||
'crm-minibuffer-complete', 'crm-minibuffer-complete-and-exit',
|
||||
'crm-minibuffer-completion-help', 'custom-mode', 'custom-mode-hook',
|
||||
'detect-coding-with-priority', 'dirtrack-debug',
|
||||
'dirtrack-debug-toggle', 'dynamic-completion-table',
|
||||
'define-mode-overload-implementation', 'detect-coding-with-priority',
|
||||
'dirtrack-debug', 'dirtrack-debug-toggle', 'dynamic-completion-table',
|
||||
'easy-menu-precalculate-equivalent-keybindings',
|
||||
'epa-display-verify-result', 'epg-passphrase-callback-function',
|
||||
'eshell-report-bug', 'eval-next-after-load', 'exchange-dot-and-mark',
|
||||
|
|
@ -1231,17 +1262,47 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
|
|||
'pre-abbrev-expand-hook', 'princ-list', 'print-help-return-message',
|
||||
'process-filter-multibyte-p', 'read-file-name-predicate',
|
||||
'remember-buffer', 'rmail-highlight-face', 'rmail-message-filter',
|
||||
'semantic-after-idle-scheduler-reparse-hooks',
|
||||
'semantic-after-toplevel-bovinate-hook',
|
||||
'semantic-before-idle-scheduler-reparse-hooks',
|
||||
'semantic-before-toplevel-bovination-hook',
|
||||
'semantic-bovinate-from-nonterminal-full',
|
||||
'semantic-bovinate-region-until-error', 'semantic-bovinate-toplevel',
|
||||
'semantic-bovination-working-type',
|
||||
'semantic-decorate-pending-decoration-hooks',
|
||||
'semantic-edits-incremental-reparse-failed-hooks',
|
||||
'semantic-eldoc-current-symbol-info', 'semantic-expand-nonterminal',
|
||||
'semantic-file-token-stream', 'semantic-find-dependency',
|
||||
'semantic-find-nonterminal', 'semantic-flex', 'semantic-flex-buffer',
|
||||
'semantic-flex-keyword-get', 'semantic-flex-keyword-p',
|
||||
'semantic-flex-keyword-put', 'semantic-flex-keywords',
|
||||
'semantic-flex-list', 'semantic-flex-make-keyword-table',
|
||||
'semantic-flex-map-keywords', 'semantic-flex-token-end',
|
||||
'semantic-flex-token-start', 'semantic-flex-token-text',
|
||||
'semantic-imenu-bucketize-type-parts',
|
||||
'semantic-imenu-expand-type-parts', 'semantic-imenu-expandable-token',
|
||||
'semantic-init-db-hooks)', 'semantic-init-hooks',
|
||||
'semantic-init-mode-hooks', 'semantic-java-prototype-nonterminal',
|
||||
'semantic-nonterminal-abstract', 'semantic-nonterminal-full-name',
|
||||
'semantic-nonterminal-leaf', 'semantic-nonterminal-protection',
|
||||
'semantic-something-to-stream', 'semantic-tag-make-assoc-list',
|
||||
'semantic-token-type-parent', 'semantic-toplevel-bovine-cache',
|
||||
'semantic-toplevel-bovine-table', 'semanticdb-mode-hooks',
|
||||
'set-coding-priority', 'set-process-filter-multibyte',
|
||||
'shadows-compare-text-p', 'shell-dirtrack-toggle', 't-mouse-mode',
|
||||
'term-dynamic-simple-complete', 'tooltip-hook', 'tpu-have-ispell',
|
||||
'url-generate-unique-filename', 'url-temporary-directory',
|
||||
'vc-arch-command', 'vc-default-working-revision' (variable),
|
||||
'vc-mtn-command', 'vc-revert-buffer', 'vc-workfile-version',
|
||||
'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font'.
|
||||
'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font',
|
||||
'wisent-lex-make-token-table'.
|
||||
|
||||
|
||||
* Lisp Changes in Emacs 28.1
|
||||
|
||||
---
|
||||
*** 'ascii' is now a coding system alias for 'us-ascii'.
|
||||
|
||||
+++
|
||||
*** New function 'file-backup-file-names'.
|
||||
This function returns the list of file names of all the backup files
|
||||
|
|
|
|||
|
|
@ -233,7 +233,7 @@ If VERBOSE is non-nil, display a message indicating where abbrevs
|
|||
have been saved."
|
||||
(interactive
|
||||
(list
|
||||
(read-file-name (format-prompt "Write abbrev file" abbrev-file-name)
|
||||
(read-file-name "Write abbrev file: "
|
||||
(file-name-directory (expand-file-name abbrev-file-name))
|
||||
abbrev-file-name)))
|
||||
(or (and file (> (length file) 0))
|
||||
|
|
@ -262,7 +262,7 @@ have been saved."
|
|||
(defun abbrev-edit-save-to-file (file)
|
||||
"Save all user-level abbrev definitions in current buffer to FILE."
|
||||
(interactive
|
||||
(list (read-file-name (format-prompt "Save abbrevs to file" abbrev-file-name)
|
||||
(list (read-file-name "Save abbrevs to file: "
|
||||
(file-name-directory
|
||||
(expand-file-name abbrev-file-name))
|
||||
abbrev-file-name)))
|
||||
|
|
|
|||
|
|
@ -1383,6 +1383,9 @@ if `inhibit-field-text-motion' is non-nil."
|
|||
(define-key ctl-x-map "'" 'expand-abbrev)
|
||||
(define-key ctl-x-map "\C-b" 'list-buffers)
|
||||
|
||||
(define-key ctl-x-map "\C-j" 'dired-jump)
|
||||
(define-key ctl-x-4-map "\C-j" 'dired-jump-other-window)
|
||||
|
||||
(define-key ctl-x-map "z" 'repeat)
|
||||
|
||||
(define-key esc-map "\C-l" 'reposition-window)
|
||||
|
|
|
|||
|
|
@ -1425,8 +1425,8 @@ for a file, defaulting to the file defined by variable
|
|||
bookmark-default-file)))
|
||||
(if parg
|
||||
;; This should be part of the `interactive' spec.
|
||||
(read-file-name (format-prompt "File to save bookmarks in"
|
||||
default)
|
||||
(read-file-name (format "File to save bookmarks in: (%s) "
|
||||
default)
|
||||
(file-name-directory default) default)
|
||||
default))))
|
||||
(bookmark-write-file file)
|
||||
|
|
@ -1538,7 +1538,7 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
|
|||
(or (car bookmark-bookmarks-timestamp)
|
||||
(expand-file-name bookmark-default-file))))
|
||||
(prefix current-prefix-arg))
|
||||
(list (read-file-name (format-prompt "Load bookmarks from" default)
|
||||
(list (read-file-name (format "Load bookmarks from: (%s) " default)
|
||||
(file-name-directory default) default 'confirm)
|
||||
prefix nil prefix)))
|
||||
(let* ((file (expand-file-name file))
|
||||
|
|
|
|||
|
|
@ -292,15 +292,9 @@
|
|||
|
||||
(defconst math-small-factorial-table
|
||||
(vector 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800
|
||||
(math-read-number-simple "479001600")
|
||||
(math-read-number-simple "6227020800")
|
||||
(math-read-number-simple "87178291200")
|
||||
(math-read-number-simple "1307674368000")
|
||||
(math-read-number-simple "20922789888000")
|
||||
(math-read-number-simple "355687428096000")
|
||||
(math-read-number-simple "6402373705728000")
|
||||
(math-read-number-simple "121645100408832000")
|
||||
(math-read-number-simple "2432902008176640000")))
|
||||
479001600 6227020800 87178291200 1307674368000 20922789888000
|
||||
355687428096000 6402373705728000 121645100408832000
|
||||
2432902008176640000))
|
||||
|
||||
(defun calcFunc-fact (n) ; [I I] [F F] [Public]
|
||||
(let (temp)
|
||||
|
|
|
|||
|
|
@ -816,25 +816,25 @@
|
|||
(list
|
||||
(list 'frac
|
||||
-174611
|
||||
(math-read-number-simple "802857662698291200000"))
|
||||
802857662698291200000)
|
||||
(list 'frac
|
||||
43867
|
||||
(math-read-number-simple "5109094217170944000"))
|
||||
5109094217170944000)
|
||||
(list 'frac
|
||||
-3617
|
||||
(math-read-number-simple "10670622842880000"))
|
||||
10670622842880000)
|
||||
(list 'frac
|
||||
1
|
||||
(math-read-number-simple "74724249600"))
|
||||
74724249600)
|
||||
(list 'frac
|
||||
-691
|
||||
(math-read-number-simple "1307674368000"))
|
||||
1307674368000)
|
||||
(list 'frac
|
||||
1
|
||||
(math-read-number-simple "47900160"))
|
||||
47900160)
|
||||
(list 'frac
|
||||
-1
|
||||
(math-read-number-simple "1209600"))
|
||||
1209600)
|
||||
(list 'frac
|
||||
1
|
||||
30240)
|
||||
|
|
|
|||
|
|
@ -1382,6 +1382,29 @@ Notations: 3.14e6 3.14 * 10^6
|
|||
(set-keymap-parent map calc-mode-map)
|
||||
map))
|
||||
|
||||
(defun calc--header-line (long short width &optional fudge)
|
||||
"Return a Calc header line appropriate for the buffer width.
|
||||
|
||||
LONG is a desired text for a wide window, SHORT is a desired
|
||||
abbreviated text, and width is the buffer width, which will be
|
||||
some fraction of the 'parent' window width (At the time of
|
||||
writing, 2/3 for calc, 1/3 for trail). The optional FUDGE is a
|
||||
trial-and-error adjustment number for the edge-cases at the
|
||||
border of the two cases."
|
||||
;; TODO: This could be called as part of a 'window-resize' hook.
|
||||
(setq header-line-format
|
||||
(let* ((len-long (length long))
|
||||
(len-short (length short))
|
||||
(fudge (or fudge 0))
|
||||
;; fudge for trail is: -3 (added to len-long)
|
||||
;; (width ) for trail
|
||||
(factor (if (> width (+ len-long fudge)) len-long len-short))
|
||||
(size (max (/ (- width factor) 2) 0))
|
||||
(fill (make-string size ?-))
|
||||
(pre (replace-regexp-in-string ".$" " " fill))
|
||||
(post (replace-regexp-in-string "^." " " fill)))
|
||||
(concat pre (if (= factor len-long) long short) post))))
|
||||
|
||||
(define-derived-mode calc-trail-mode fundamental-mode "Calc Trail"
|
||||
"Calc Trail mode.
|
||||
This mode is used by the *Calc Trail* buffer, which records all results
|
||||
|
|
@ -1396,9 +1419,9 @@ commands given here will actually operate on the *Calculator* stack."
|
|||
(setq buffer-read-only t)
|
||||
(make-local-variable 'overlay-arrow-position)
|
||||
(make-local-variable 'overlay-arrow-string)
|
||||
(when (= (buffer-size) 0)
|
||||
(let ((inhibit-read-only t))
|
||||
(insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))))
|
||||
(when calc-show-banner
|
||||
(calc--header-line "Emacs Calculator Trail" "Calc Trail"
|
||||
(/ (window-width) 3) -3)))
|
||||
|
||||
(defun calc-create-buffer ()
|
||||
"Create and initialize a buffer for the Calculator."
|
||||
|
|
@ -1451,7 +1474,6 @@ commands given here will actually operate on the *Calculator* stack."
|
|||
(pop-to-buffer (current-buffer)))))))
|
||||
(with-current-buffer (calc-trail-buffer)
|
||||
(and calc-display-trail
|
||||
(= (window-width) (frame-width))
|
||||
(calc-trail-display 1 t)))
|
||||
(message "Welcome to the GNU Emacs Calculator! Press `?' or `h' for help, `q' to quit")
|
||||
(run-hooks 'calc-start-hook)
|
||||
|
|
@ -1986,13 +2008,11 @@ See calc-keypad for details."
|
|||
(calc-any-evaltos nil))
|
||||
(setq calc-any-selections nil)
|
||||
(erase-buffer)
|
||||
(when calc-show-banner
|
||||
(insert (propertize "--- Emacs Calculator Mode ---\n"
|
||||
'face 'italic)))
|
||||
(when calc-show-banner
|
||||
(calc--header-line "Emacs Calculator Mode" "Emacs Calc"
|
||||
(* 2 (/ (window-width) 3)) -3))
|
||||
(while thing
|
||||
(goto-char (point-min))
|
||||
(when calc-show-banner
|
||||
(forward-line 1))
|
||||
(insert (math-format-stack-value (car thing)) "\n")
|
||||
(setq thing (cdr thing)))
|
||||
(calc-renumber-stack)
|
||||
|
|
@ -2076,7 +2096,6 @@ the United States."
|
|||
(eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
|
||||
(with-current-buffer calc-trail-buffer
|
||||
(goto-char (point-min))
|
||||
(forward-line 1)
|
||||
(setq calc-trail-pointer (point-marker))))
|
||||
calc-trail-buffer)
|
||||
|
||||
|
|
@ -2144,10 +2163,8 @@ the United States."
|
|||
(if (derived-mode-p 'calc-trail-mode)
|
||||
(progn
|
||||
(beginning-of-line)
|
||||
(if (bobp)
|
||||
(forward-line 1)
|
||||
(if (eobp)
|
||||
(forward-line -1)))
|
||||
(if (eobp)
|
||||
(forward-line -1))
|
||||
(if (or (bobp) (eobp))
|
||||
(setq overlay-arrow-position nil) ; trail is empty
|
||||
(set-marker calc-trail-pointer (point) (current-buffer))
|
||||
|
|
@ -2161,7 +2178,7 @@ the United States."
|
|||
(if win
|
||||
(save-excursion
|
||||
(forward-line (/ (window-height win) 2))
|
||||
(forward-line (- 1 (window-height win)))
|
||||
(forward-line (- 2 (window-height win)))
|
||||
(set-window-start win (point))
|
||||
(set-window-point win (+ calc-trail-pointer 4))
|
||||
(set-buffer calc-main-buffer)
|
||||
|
|
@ -3435,12 +3452,10 @@ See Info node `(calc)Defining Functions'."
|
|||
(defun calc-clear-unread-commands ()
|
||||
(setq unread-command-events nil))
|
||||
|
||||
(defcalcmodevar math-2-word-size
|
||||
(math-read-number-simple "4294967296")
|
||||
(defcalcmodevar math-2-word-size 4294967296
|
||||
"Two to the power of `calc-word-size'.")
|
||||
|
||||
(defcalcmodevar math-half-2-word-size
|
||||
(math-read-number-simple "2147483648")
|
||||
(defcalcmodevar math-half-2-word-size 2147483648
|
||||
"One-half of two to the power of `calc-word-size'.")
|
||||
|
||||
(when calc-always-load-extensions
|
||||
|
|
|
|||
|
|
@ -472,7 +472,7 @@
|
|||
(setq defc (calc-invent-parameter-variables nc defv)))
|
||||
(let ((vars (read-string (format-prompt
|
||||
"Fitting variables"
|
||||
(format "%s; %s)"
|
||||
(format "%s; %s"
|
||||
(mapconcat 'symbol-name
|
||||
(mapcar (function (lambda (v)
|
||||
(nth 1 v)))
|
||||
|
|
|
|||
|
|
@ -82,8 +82,6 @@ introduced."
|
|||
This variable is for internal use only, and its content depends on the
|
||||
external parser used.")
|
||||
(make-variable-buffer-local 'semantic--parse-table)
|
||||
(semantic-varalias-obsolete 'semantic-toplevel-bovine-table
|
||||
'semantic--parse-table "23.2")
|
||||
|
||||
(defvar semantic-symbol->name-assoc-list
|
||||
'((type . "Types")
|
||||
|
|
@ -112,17 +110,6 @@ in classes, such as protection labels.")
|
|||
"Value for `case-fold-search' when parsing.")
|
||||
(make-variable-buffer-local 'semantic-case-fold)
|
||||
|
||||
(defvar semantic-expand-nonterminal nil
|
||||
"Function to call for each nonterminal production.
|
||||
Return a list of non-terminals derived from the first argument, or nil
|
||||
if it does not need to be expanded.
|
||||
Languages with compound definitions should use this function to expand
|
||||
from one compound symbol into several. For example, in C the definition
|
||||
int a, b;
|
||||
is easily parsed into one tag. This function should take this
|
||||
compound tag and turn it into two tags, one for A, and the other for B.")
|
||||
(make-variable-buffer-local 'semantic-expand-nonterminal)
|
||||
|
||||
(defvar semantic--buffer-cache nil
|
||||
"A cache of the fully parsed buffer.
|
||||
If no significant changes have been made (based on the state) then
|
||||
|
|
@ -134,8 +121,6 @@ If you need a tag list, use `semantic-fetch-tags'. If you need the
|
|||
cached values for some reason, chances are you can add a hook to
|
||||
`semantic-after-toplevel-cache-change-hook'.")
|
||||
(make-variable-buffer-local 'semantic--buffer-cache)
|
||||
(semantic-varalias-obsolete 'semantic-toplevel-bovine-cache
|
||||
'semantic--buffer-cache "23.2")
|
||||
|
||||
(defvar semantic-unmatched-syntax-cache nil
|
||||
"A cached copy of unmatched syntax tokens.")
|
||||
|
|
@ -171,18 +156,6 @@ It is called before any request for tags is made via the function
|
|||
`semantic-fetch-tags' by an application.
|
||||
If any hook returns a nil value, the cached value is returned
|
||||
immediately, even if it is empty.")
|
||||
(semantic-varalias-obsolete 'semantic-before-toplevel-bovination-hook
|
||||
'semantic--before-fetch-tags-hook "23.2")
|
||||
|
||||
(defvar semantic-after-toplevel-bovinate-hook nil
|
||||
"Hooks run after a toplevel parse.
|
||||
It is not run if the toplevel parse command is called, and buffer does
|
||||
not need to be fully reparsed.
|
||||
For language specific hooks, make sure you define this as a local hook.
|
||||
|
||||
This hook should not be used any more.
|
||||
Use `semantic-after-toplevel-cache-change-hook' instead.")
|
||||
(make-obsolete-variable 'semantic-after-toplevel-bovinate-hook nil "23.2")
|
||||
|
||||
(defvar semantic-after-toplevel-cache-change-hook nil
|
||||
"Hooks run after the buffer tag list has changed.
|
||||
|
|
@ -305,13 +278,6 @@ This hook is for database functions which intend to swap in a tag table.
|
|||
This guarantees that the DB will go before other modes that require
|
||||
a parse of the buffer.")
|
||||
|
||||
(semantic-varalias-obsolete 'semantic-init-hooks
|
||||
'semantic-init-hook "23.2")
|
||||
(semantic-varalias-obsolete 'semantic-init-mode-hooks
|
||||
'semantic-init-mode-hook "23.2")
|
||||
(semantic-varalias-obsolete 'semantic-init-db-hooks
|
||||
'semantic-init-db-hook "23.2")
|
||||
|
||||
(defsubst semantic-error-if-unparsed ()
|
||||
"Raise an error if current buffer was not parsed by Semantic."
|
||||
(unless semantic-new-buffer-fcn-was-run
|
||||
|
|
@ -516,8 +482,6 @@ is requested."
|
|||
(semantic-parse-tree-set-needs-rebuild)
|
||||
;; Remove this hook which tracks if a buffer is up to date or not.
|
||||
(remove-hook 'after-change-functions 'semantic-change-function t)
|
||||
;; Old model. Delete someday.
|
||||
;;(run-hooks 'semantic-after-toplevel-bovinate-hook)
|
||||
|
||||
(run-hook-with-args 'semantic-after-toplevel-cache-change-hook
|
||||
semantic--buffer-cache)
|
||||
|
|
@ -540,17 +504,12 @@ is requested."
|
|||
(setq semantic--completion-cache nil)
|
||||
;; Refresh the display of unmatched syntax tokens if enabled
|
||||
(run-hook-with-args 'semantic-unmatched-syntax-hook
|
||||
semantic-unmatched-syntax-cache)
|
||||
;; Old Semantic 1.3 hook API. Maybe useful forever?
|
||||
(run-hooks 'semantic-after-toplevel-bovinate-hook)
|
||||
)
|
||||
semantic-unmatched-syntax-cache))
|
||||
|
||||
(defvar semantic-working-type 'percent
|
||||
"The type of working message to use when parsing.
|
||||
'percent means we are doing a linear parse through the buffer.
|
||||
'dynamic means we are reparsing specific tags.")
|
||||
(semantic-varalias-obsolete 'semantic-bovination-working-type
|
||||
'semantic-working-type "23.2")
|
||||
|
||||
(defvar semantic-minimum-working-buffer-size (* 1024 5)
|
||||
"The minimum size of a buffer before working messages are displayed.
|
||||
|
|
@ -585,8 +544,6 @@ was marked unparseable, then do nothing, and return the cache."
|
|||
;; Is this a semantic enabled buffer?
|
||||
(semantic-active-p)
|
||||
;; Application hooks say the buffer is safe for parsing
|
||||
(run-hook-with-args-until-failure
|
||||
'semantic-before-toplevel-bovination-hook)
|
||||
(run-hook-with-args-until-failure
|
||||
'semantic--before-fetch-tags-hook)
|
||||
;; If the buffer was previously marked unparseable,
|
||||
|
|
@ -690,11 +647,6 @@ Does nothing if the current buffer doesn't need reparsing."
|
|||
;; Return if we are lexically safe
|
||||
lexically-safe))))
|
||||
|
||||
(defun semantic-bovinate-toplevel (&optional ignored)
|
||||
"Backward compatibility function."
|
||||
(semantic-fetch-tags))
|
||||
(make-obsolete 'semantic-bovinate-toplevel 'semantic-fetch-tags "23.2")
|
||||
|
||||
;; Another approach is to let Emacs call the parser on idle time, when
|
||||
;; needed, use `semantic-fetch-available-tags' to only retrieve
|
||||
;; available tags, and setup the `semantic-after-*-hook' hooks to
|
||||
|
|
@ -812,20 +764,6 @@ This function returns semantic tags without overlays."
|
|||
;; Please move away from these functions, and try using semantic 2.x
|
||||
;; interfaces instead.
|
||||
;;
|
||||
(defsubst semantic-bovinate-region-until-error
|
||||
(start end nonterm &optional depth)
|
||||
"NOTE: Use `semantic-parse-region' instead.
|
||||
|
||||
Bovinate between START and END starting with NONTERM.
|
||||
Optional DEPTH specifies how many levels of parenthesis to enter.
|
||||
This command will parse until an error is encountered, and return
|
||||
the list of everything found until that moment.
|
||||
This is meant for finding variable definitions at the beginning of
|
||||
code blocks in methods. If `bovine-inner-scope' can also support
|
||||
commands, use `semantic-bovinate-from-nonterminal-full'."
|
||||
(semantic-parse-region start end nonterm depth t))
|
||||
(make-obsolete 'semantic-bovinate-region-until-error
|
||||
'semantic-parse-region "23.2")
|
||||
|
||||
(defsubst semantic-bovinate-from-nonterminal
|
||||
(start end nonterm &optional depth length)
|
||||
|
|
@ -840,21 +778,6 @@ tokens."
|
|||
(semantic-lex start end (or depth 1) length)
|
||||
nonterm))))
|
||||
|
||||
(defsubst semantic-bovinate-from-nonterminal-full
|
||||
(start end nonterm &optional depth)
|
||||
"NOTE: Use `semantic-parse-region' instead.
|
||||
|
||||
Bovinate from within a nonterminal lambda from START to END.
|
||||
Iterates until all the space between START and END is exhausted.
|
||||
Argument NONTERM is the nonterminal symbol to start with.
|
||||
If NONTERM is nil, use `bovine-block-toplevel'.
|
||||
Optional argument DEPTH is the depth of lists to dive into.
|
||||
When used in a `lambda' of a MATCH-LIST, there is no need to include
|
||||
a START and END part."
|
||||
(semantic-parse-region start end nonterm (or depth 1)))
|
||||
(make-obsolete 'semantic-bovinate-from-nonterminal-full
|
||||
'semantic-parse-region "23.2")
|
||||
|
||||
;;; User interface
|
||||
|
||||
(defun semantic-force-refresh ()
|
||||
|
|
|
|||
|
|
@ -420,7 +420,6 @@ Return a bovination list to use."
|
|||
:parent (symbol-name (nth 2 form))
|
||||
:documentation (semantic-elisp-do-doc (nth 4 form))
|
||||
)))
|
||||
define-mode-overload-implementation ;; obsoleted
|
||||
define-mode-local-override
|
||||
)
|
||||
|
||||
|
|
|
|||
|
|
@ -69,10 +69,6 @@ database, which can be saved for future Emacs sessions."
|
|||
(dolist (elt semanticdb-hooks)
|
||||
(remove-hook (cadr elt) (car elt)))))
|
||||
|
||||
(semantic-varalias-obsolete 'semanticdb-mode-hooks
|
||||
'global-semanticdb-minor-mode-hook "23.2")
|
||||
|
||||
|
||||
(defun semanticdb-toggle-global-mode ()
|
||||
"Toggle use of the Semantic Database feature.
|
||||
Update the environment of Semantic enabled buffers accordingly."
|
||||
|
|
|
|||
|
|
@ -204,9 +204,6 @@ Also make sure old decorations in the area are completely flushed."
|
|||
(defvar semantic-decorate-pending-decoration-hook nil
|
||||
"Normal hook run to perform pending decoration changes.")
|
||||
|
||||
(semantic-varalias-obsolete 'semantic-decorate-pending-decoration-hooks
|
||||
'semantic-decorate-pending-decoration-hook "23.2")
|
||||
|
||||
(defun semantic-decorate-add-pending-decoration (fcn &optional buffer)
|
||||
"Add a pending decoration change represented by FCN.
|
||||
Applies only to the current BUFFER.
|
||||
|
|
|
|||
|
|
@ -93,8 +93,7 @@ just the lexical token and not the string."
|
|||
Attempt to strip out comment syntactic sugar.
|
||||
Argument NOSNARF means don't modify the found text.
|
||||
If NOSNARF is `lex', then return the lex token."
|
||||
(let* ((semantic-ignore-comments nil)
|
||||
(semantic-lex-analyzer #'semantic-comment-lexer))
|
||||
(let* ((semantic-lex-analyzer #'semantic-comment-lexer))
|
||||
(if (memq nosnarf '(lex flex)) ;; keep `flex' for compatibility
|
||||
(car (semantic-lex (point) (1+ (point))))
|
||||
(let ((ct (semantic-lex-token-text
|
||||
|
|
|
|||
|
|
@ -121,9 +121,6 @@ incremental reparse.")
|
|||
"Hook run after the incremental parser fails.
|
||||
When this happens, the buffer is marked as needing a full reparse.")
|
||||
|
||||
(semantic-varalias-obsolete 'semantic-edits-incremental-reparse-failed-hooks
|
||||
'semantic-edits-incremental-reparse-failed-hook "23.2")
|
||||
|
||||
(defcustom semantic-edits-verbose-flag nil
|
||||
"Non-nil means the incremental parser is verbose.
|
||||
If nil, errors are still displayed, but informative messages are not."
|
||||
|
|
|
|||
|
|
@ -173,6 +173,7 @@ Remove self from `post-command-hook' if it is empty."
|
|||
;;
|
||||
(defun semantic-overload-symbol-from-function (name)
|
||||
"Return the symbol for overload used by NAME, the defined symbol."
|
||||
(declare (obsolete define-obsolete-function-alias "28.1"))
|
||||
(let ((sym-name (symbol-name name)))
|
||||
(if (string-match "^semantic-" sym-name)
|
||||
(intern (substring sym-name (match-end 0)))
|
||||
|
|
@ -182,6 +183,7 @@ Remove self from `post-command-hook' if it is empty."
|
|||
"Make OLDFNALIAS an alias for NEWFN.
|
||||
Mark OLDFNALIAS as obsolete, such that the byte compiler
|
||||
will throw a warning when it encounters this symbol."
|
||||
(declare (obsolete define-obsolete-function-alias "28.1"))
|
||||
(defalias oldfnalias newfn)
|
||||
(make-obsolete oldfnalias newfn when)
|
||||
(when (and (mode-local--function-overload-p newfn)
|
||||
|
|
@ -196,13 +198,14 @@ will throw a warning when it encounters this symbol."
|
|||
"%s: `%s' obsoletes overload `%s'"
|
||||
byte-compile-current-file
|
||||
newfn
|
||||
(semantic-overload-symbol-from-function oldfnalias))
|
||||
))
|
||||
(with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function))
|
||||
(semantic-overload-symbol-from-function oldfnalias)))))
|
||||
|
||||
(defun semantic-varalias-obsolete (oldvaralias newvar when)
|
||||
"Make OLDVARALIAS an alias for variable NEWVAR.
|
||||
Mark OLDVARALIAS as obsolete, such that the byte compiler
|
||||
will throw a warning when it encounters this symbol."
|
||||
(declare (obsolete define-obsolete-variable-alias "28.1"))
|
||||
(make-obsolete-variable oldvaralias newvar when)
|
||||
(condition-case nil
|
||||
(defvaralias oldvaralias newvar)
|
||||
|
|
@ -256,9 +259,6 @@ FUNCTION does not have arguments. When FUNCTION is entered
|
|||
|
||||
(defalias 'semantic-map-mode-buffers 'mode-local-map-mode-buffers)
|
||||
|
||||
(semantic-alias-obsolete 'define-mode-overload-implementation
|
||||
'define-mode-local-override "23.2")
|
||||
|
||||
(defun semantic-install-function-overrides (overrides &optional transient)
|
||||
"Install the function OVERRIDES in the specified environment.
|
||||
OVERRIDES must be an alist ((OVERLOAD . FUNCTION) ...) where OVERLOAD
|
||||
|
|
@ -396,13 +396,10 @@ into `mode-local-init-hook'." file filename)
|
|||
;; "define-lex-regex-type-analyzer"
|
||||
;; "define-lex-string-type-analyzer"
|
||||
;; "define-lex-block-type-analyzer"
|
||||
;; ;;"define-mode-overload-implementation"
|
||||
;; ;;"define-semantic-child-mode"
|
||||
;; "define-semantic-idle-service"
|
||||
;; "define-semantic-decoration-style"
|
||||
;; "define-wisent-lexer"
|
||||
;; "semantic-alias-obsolete"
|
||||
;; "semantic-varalias-obsolete"
|
||||
;; "semantic-make-obsolete-overload"
|
||||
;; "defcustom-mode-local-semantic-dependency-system-include-path"
|
||||
;; ))
|
||||
|
|
|
|||
|
|
@ -142,7 +142,7 @@ It ignores whitespaces, newlines and comments."
|
|||
"Return expansion of built-in ASSOC expression.
|
||||
ARGS are ASSOC's key value list."
|
||||
(let ((key t))
|
||||
`(semantic-tag-make-assoc-list
|
||||
`(semantic-tag-make-plist
|
||||
,@(mapcar #'(lambda (i)
|
||||
(prog1
|
||||
(if key
|
||||
|
|
|
|||
|
|
@ -472,11 +472,6 @@ This hook is not protected from lexical errors.")
|
|||
If any hook function throws an error, this variable is reset to nil.
|
||||
This hook is not protected from lexical errors.")
|
||||
|
||||
(semantic-varalias-obsolete 'semantic-before-idle-scheduler-reparse-hooks
|
||||
'semantic-before-idle-scheduler-reparse-hook "23.2")
|
||||
(semantic-varalias-obsolete 'semantic-after-idle-scheduler-reparse-hooks
|
||||
'semantic-after-idle-scheduler-reparse-hook "23.2")
|
||||
|
||||
(defun semantic-idle-scheduler-refresh-tags ()
|
||||
"Refreshes the current buffer's tags.
|
||||
This is called by `semantic-idle-scheduler-function' to update the
|
||||
|
|
@ -734,10 +729,6 @@ specific to a major mode. For example, in jde mode:
|
|||
(define-overloadable-function semantic-idle-summary-current-symbol-info ()
|
||||
"Return a string message describing the current context.")
|
||||
|
||||
(make-obsolete-overload 'semantic-eldoc-current-symbol-info
|
||||
'semantic-idle-summary-current-symbol-info
|
||||
"23.2")
|
||||
|
||||
(defcustom semantic-idle-summary-mode-hook nil
|
||||
"Hook run at the end of `semantic-idle-summary'."
|
||||
:group 'semantic
|
||||
|
|
|
|||
|
|
@ -88,8 +88,6 @@ This option is ignored if `semantic-imenu-bucketize-file' is nil."
|
|||
:group 'semantic-imenu
|
||||
:type 'boolean)
|
||||
(make-variable-buffer-local 'semantic-imenu-expand-type-members)
|
||||
(semantic-varalias-obsolete 'semantic-imenu-expand-type-parts
|
||||
'semantic-imenu-expand-type-members "23.2")
|
||||
|
||||
(defcustom semantic-imenu-bucketize-type-members t
|
||||
"Non-nil if members of a type should be grouped into buckets.
|
||||
|
|
@ -98,8 +96,6 @@ Overridden to nil if `semantic-imenu-bucketize-file' is nil."
|
|||
:group 'semantic-imenu
|
||||
:type 'boolean)
|
||||
(make-variable-buffer-local 'semantic-imenu-bucketize-type-members)
|
||||
(semantic-varalias-obsolete 'semantic-imenu-bucketize-type-parts
|
||||
'semantic-imenu-bucketize-type-members "23.2")
|
||||
|
||||
(defcustom semantic-imenu-sort-bucket-function nil
|
||||
"Function to use when sorting tags in the buckets of functions.
|
||||
|
|
@ -145,8 +141,6 @@ Tags of those classes will be given submenu with children.
|
|||
By default, a `type' has interesting children. In Texinfo, however, a
|
||||
`section' has interesting children.")
|
||||
(make-variable-buffer-local 'semantic-imenu-expandable-tag-classes)
|
||||
(semantic-varalias-obsolete 'semantic-imenu-expandable-token
|
||||
'semantic-imenu-expandable-tag-classes "23.2")
|
||||
|
||||
;;; Code:
|
||||
(defun semantic-imenu-tag-overlay (tag)
|
||||
|
|
|
|||
|
|
@ -253,9 +253,6 @@ Optional argument COLOR indicates that color should be mixed in."
|
|||
'semantic-format-tag-prototype-default)
|
||||
tag parent color)))
|
||||
|
||||
(semantic-alias-obsolete 'semantic-java-prototype-nonterminal
|
||||
'semantic-format-tag-prototype-java-mode "23.2")
|
||||
|
||||
;; Include Tag Name
|
||||
;;
|
||||
|
||||
|
|
|
|||
|
|
@ -1751,32 +1751,12 @@ If there is no error, then the last value of FORMS is returned."
|
|||
))
|
||||
|
||||
;;; Compatibility with Semantic 1.x lexical analysis
|
||||
;;
|
||||
;; NOTE: DELETE THIS SOMEDAY SOON
|
||||
|
||||
(semantic-alias-obsolete 'semantic-flex-start 'semantic-lex-token-start "23.2")
|
||||
(semantic-alias-obsolete 'semantic-flex-end 'semantic-lex-token-end "23.2")
|
||||
(semantic-alias-obsolete 'semantic-flex-text 'semantic-lex-token-text "23.2")
|
||||
(semantic-alias-obsolete 'semantic-flex-make-keyword-table 'semantic-lex-make-keyword-table "23.2")
|
||||
(semantic-alias-obsolete 'semantic-flex-keyword-p 'semantic-lex-keyword-p "23.2")
|
||||
(semantic-alias-obsolete 'semantic-flex-keyword-put 'semantic-lex-keyword-put "23.2")
|
||||
(semantic-alias-obsolete 'semantic-flex-keyword-get 'semantic-lex-keyword-get "23.2")
|
||||
(semantic-alias-obsolete 'semantic-flex-map-keywords 'semantic-lex-map-keywords "23.2")
|
||||
(semantic-alias-obsolete 'semantic-flex-keywords 'semantic-lex-keywords "23.2")
|
||||
(semantic-alias-obsolete 'semantic-flex-buffer 'semantic-lex-buffer "23.2")
|
||||
(semantic-alias-obsolete 'semantic-flex-list 'semantic-lex-list "23.2")
|
||||
|
||||
;; This simple scanner uses the syntax table to generate a stream of
|
||||
;; simple tokens of the form:
|
||||
;;
|
||||
;; (SYMBOL START . END)
|
||||
;;
|
||||
;; Where symbol is the type of thing it is. START and END mark that
|
||||
;; objects boundary.
|
||||
|
||||
(defvar semantic-flex-tokens semantic-lex-tokens
|
||||
"An alist of semantic token types.
|
||||
See variable `semantic-lex-tokens'.")
|
||||
(make-obsolete-variable 'semantic-flex-tokens
|
||||
'semantic-lex-tokens "28.1")
|
||||
|
||||
(defvar semantic-flex-unterminated-syntax-end-function
|
||||
(lambda (_syntax _syntax-start flex-end) flex-end)
|
||||
|
|
@ -1788,6 +1768,8 @@ FLEX-END is where the lexical analysis was asked to end.
|
|||
This function can be used for languages that can intelligently fix up
|
||||
broken syntax, or the exit lexical analysis via `throw' or `signal'
|
||||
when finding unterminated syntax.")
|
||||
(make-obsolete-variable 'semantic-flex-unterminated-syntax-end-function
|
||||
nil "28.1")
|
||||
|
||||
(defvar semantic-flex-extensions nil
|
||||
"Buffer local extensions to the lexical analyzer.
|
||||
|
|
@ -1799,6 +1781,7 @@ nil is also a valid return value.
|
|||
TYPE can be any type of symbol, as long as it doesn't occur as a
|
||||
nonterminal in the language definition.")
|
||||
(make-variable-buffer-local 'semantic-flex-extensions)
|
||||
(make-obsolete-variable 'semantic-flex-extensions nil "28.1")
|
||||
|
||||
(defvar semantic-flex-syntax-modifications nil
|
||||
"Changes to the syntax table for this buffer.
|
||||
|
|
@ -1809,237 +1792,47 @@ CHAR is the char passed to `modify-syntax-entry',
|
|||
and CLASS is the string also passed to `modify-syntax-entry' to define
|
||||
what syntax class CHAR has.")
|
||||
(make-variable-buffer-local 'semantic-flex-syntax-modifications)
|
||||
(make-obsolete-variable 'semantic-flex-syntax-modifications nil "28.1")
|
||||
|
||||
(defvar semantic-ignore-comments t
|
||||
"Default comment handling.
|
||||
The value t means to strip comments when flexing; nil means
|
||||
to keep comments as part of the token stream.")
|
||||
(make-variable-buffer-local 'semantic-ignore-comments)
|
||||
(make-obsolete-variable 'semantic-ignore-comments nil "28.1")
|
||||
|
||||
(defvar semantic-flex-enable-newlines nil
|
||||
"When flexing, report newlines as syntactic elements.
|
||||
Useful for languages where the newline is a special case terminator.
|
||||
Only set this on a per mode basis, not globally.")
|
||||
(make-variable-buffer-local 'semantic-flex-enable-newlines)
|
||||
(make-obsolete-variable 'semantic-flex-enable-newlines nil "28.1")
|
||||
|
||||
(defvar semantic-flex-enable-whitespace nil
|
||||
"When flexing, report whitespace as syntactic elements.
|
||||
Useful for languages where the syntax is whitespace dependent.
|
||||
Only set this on a per mode basis, not globally.")
|
||||
(make-variable-buffer-local 'semantic-flex-enable-whitespace)
|
||||
(make-obsolete-variable 'semantic-flex-enable-whitespace nil "28.1")
|
||||
|
||||
(defvar semantic-flex-enable-bol nil
|
||||
"When flexing, report beginning of lines as syntactic elements.
|
||||
Useful for languages like python which are indentation sensitive.
|
||||
Only set this on a per mode basis, not globally.")
|
||||
(make-variable-buffer-local 'semantic-flex-enable-bol)
|
||||
(make-obsolete-variable 'semantic-flex-enable-bol nil "28.1")
|
||||
|
||||
(defvar semantic-number-expression semantic-lex-number-expression
|
||||
"See variable `semantic-lex-number-expression'.")
|
||||
(make-variable-buffer-local 'semantic-number-expression)
|
||||
(make-obsolete-variable 'semantic-number-expression
|
||||
'semantic-lex-number-expression "28.1")
|
||||
|
||||
(defvar semantic-flex-depth 0
|
||||
"Default flexing depth.
|
||||
This specifies how many lists to create tokens in.")
|
||||
(make-variable-buffer-local 'semantic-flex-depth)
|
||||
|
||||
(defun semantic-flex (start end &optional depth length)
|
||||
"Using the syntax table, do something roughly equivalent to flex.
|
||||
Semantically check between START and END. Optional argument DEPTH
|
||||
indicates at what level to scan over entire lists.
|
||||
The return value is a token stream. Each element is a list, such of
|
||||
the form (symbol start-expression . end-expression) where SYMBOL
|
||||
denotes the token type.
|
||||
See `semantic-flex-tokens' variable for details on token types.
|
||||
END does not mark the end of the text scanned, only the end of the
|
||||
beginning of text scanned. Thus, if a string extends past END, the
|
||||
end of the return token will be larger than END. To truly restrict
|
||||
scanning, use `narrow-to-region'.
|
||||
The last argument, LENGTH specifies that `semantic-flex' should only
|
||||
return LENGTH tokens."
|
||||
(declare (obsolete define-lex "23.2"))
|
||||
(if (not semantic-flex-keywords-obarray)
|
||||
(setq semantic-flex-keywords-obarray [ nil ]))
|
||||
(let ((ts nil)
|
||||
(pos (point))
|
||||
(ep nil)
|
||||
(curdepth 0)
|
||||
(cs (if comment-start-skip
|
||||
(concat "\\(\\s<\\|" comment-start-skip "\\)")
|
||||
(concat "\\(\\s<\\)")))
|
||||
(newsyntax (copy-syntax-table (syntax-table)))
|
||||
(mods semantic-flex-syntax-modifications)
|
||||
;; Use the default depth if it is not specified.
|
||||
(depth (or depth semantic-flex-depth)))
|
||||
;; Update the syntax table
|
||||
(while mods
|
||||
(modify-syntax-entry (car (car mods)) (car (cdr (car mods))) newsyntax)
|
||||
(setq mods (cdr mods)))
|
||||
(with-syntax-table newsyntax
|
||||
(goto-char start)
|
||||
(while (and (< (point) end) (or (not length) (<= (length ts) length)))
|
||||
(cond
|
||||
;; catch beginning of lines when needed.
|
||||
;; Must be done before catching any other tokens!
|
||||
((and semantic-flex-enable-bol
|
||||
(bolp)
|
||||
;; Just insert a (bol N . N) token in the token stream,
|
||||
;; without moving the point. N is the point at the
|
||||
;; beginning of line.
|
||||
(setq ts (cons (cons 'bol (cons (point) (point))) ts))
|
||||
nil)) ;; CONTINUE
|
||||
;; special extensions, includes whitespace, nl, etc.
|
||||
((and semantic-flex-extensions
|
||||
(let ((fe semantic-flex-extensions)
|
||||
(r nil))
|
||||
(while fe
|
||||
(if (looking-at (car (car fe)))
|
||||
(setq ts (cons (funcall (cdr (car fe))) ts)
|
||||
r t
|
||||
fe nil
|
||||
ep (point)))
|
||||
(setq fe (cdr fe)))
|
||||
(if (and r (not (car ts))) (setq ts (cdr ts)))
|
||||
r)))
|
||||
;; catch newlines when needed
|
||||
((looking-at "\\s-*\\(\n\\|\\s>\\)")
|
||||
(if semantic-flex-enable-newlines
|
||||
(setq ep (match-end 1)
|
||||
ts (cons (cons 'newline
|
||||
(cons (match-beginning 1) ep))
|
||||
ts))))
|
||||
;; catch whitespace when needed
|
||||
((looking-at "\\s-+")
|
||||
(if semantic-flex-enable-whitespace
|
||||
;; Language wants whitespaces, link them together.
|
||||
(if (eq (car (car ts)) 'whitespace)
|
||||
(setcdr (cdr (car ts)) (match-end 0))
|
||||
(setq ts (cons (cons 'whitespace
|
||||
(cons (match-beginning 0)
|
||||
(match-end 0)))
|
||||
ts)))))
|
||||
;; numbers
|
||||
((and semantic-number-expression
|
||||
(looking-at semantic-number-expression))
|
||||
(setq ts (cons (cons 'number
|
||||
(cons (match-beginning 0)
|
||||
(match-end 0)))
|
||||
ts)))
|
||||
;; symbols
|
||||
((looking-at "\\(\\sw\\|\\s_\\)+")
|
||||
(setq ts (cons (cons
|
||||
;; Get info on if this is a keyword or not
|
||||
(or (semantic-lex-keyword-p (match-string 0))
|
||||
'symbol)
|
||||
(cons (match-beginning 0) (match-end 0)))
|
||||
ts)))
|
||||
;; Character quoting characters (ie, \n as newline)
|
||||
((looking-at "\\s\\+")
|
||||
(setq ts (cons (cons 'charquote
|
||||
(cons (match-beginning 0) (match-end 0)))
|
||||
ts)))
|
||||
;; Open parens, or semantic-lists.
|
||||
((looking-at "\\s(")
|
||||
(if (or (not depth) (< curdepth depth))
|
||||
(progn
|
||||
(setq curdepth (1+ curdepth))
|
||||
(setq ts (cons (cons 'open-paren
|
||||
(cons (match-beginning 0) (match-end 0)))
|
||||
ts)))
|
||||
(setq ts (cons
|
||||
(cons 'semantic-list
|
||||
(cons (match-beginning 0)
|
||||
(save-excursion
|
||||
(condition-case nil
|
||||
(forward-list 1)
|
||||
;; This case makes flex robust
|
||||
;; to broken lists.
|
||||
(error
|
||||
(goto-char
|
||||
(funcall
|
||||
semantic-flex-unterminated-syntax-end-function
|
||||
'semantic-list
|
||||
start end))))
|
||||
(setq ep (point)))))
|
||||
ts))))
|
||||
;; Close parens
|
||||
((looking-at "\\s)")
|
||||
(setq ts (cons (cons 'close-paren
|
||||
(cons (match-beginning 0) (match-end 0)))
|
||||
ts))
|
||||
(setq curdepth (1- curdepth)))
|
||||
;; String initiators
|
||||
((looking-at "\\s\"")
|
||||
;; Zing to the end of this string.
|
||||
(setq ts (cons (cons 'string
|
||||
(cons (match-beginning 0)
|
||||
(save-excursion
|
||||
(condition-case nil
|
||||
(forward-sexp 1)
|
||||
;; This case makes flex
|
||||
;; robust to broken strings.
|
||||
(error
|
||||
(goto-char
|
||||
(funcall
|
||||
semantic-flex-unterminated-syntax-end-function
|
||||
'string
|
||||
start end))))
|
||||
(setq ep (point)))))
|
||||
ts)))
|
||||
;; comments
|
||||
((looking-at cs)
|
||||
(if (and semantic-ignore-comments
|
||||
(not semantic-flex-enable-whitespace))
|
||||
;; If the language doesn't deal with comments nor
|
||||
;; whitespaces, ignore them here.
|
||||
(let ((comment-start-point (point)))
|
||||
(forward-comment 1)
|
||||
(if (eq (point) comment-start-point)
|
||||
;; In this case our start-skip string failed
|
||||
;; to work properly. Lets try and move over
|
||||
;; whatever white space we matched to begin
|
||||
;; with.
|
||||
(skip-syntax-forward "-.'" (point-at-eol))
|
||||
;;(forward-comment 1)
|
||||
;; Generate newline token if enabled
|
||||
(if (and semantic-flex-enable-newlines
|
||||
(bolp))
|
||||
(backward-char 1)))
|
||||
(if (eq (point) comment-start-point)
|
||||
(error "Strange comment syntax prevents lexical analysis"))
|
||||
(setq ep (point)))
|
||||
(let ((tk (if semantic-ignore-comments 'whitespace 'comment)))
|
||||
(save-excursion
|
||||
(forward-comment 1)
|
||||
;; Generate newline token if enabled
|
||||
(if (and semantic-flex-enable-newlines
|
||||
(bolp))
|
||||
(backward-char 1))
|
||||
(setq ep (point)))
|
||||
;; Language wants comments or want them as whitespaces,
|
||||
;; link them together.
|
||||
(if (eq (car (car ts)) tk)
|
||||
(setcdr (cdr (car ts)) ep)
|
||||
(setq ts (cons (cons tk (cons (match-beginning 0) ep))
|
||||
ts))))))
|
||||
;; punctuation
|
||||
((looking-at "\\(\\s.\\|\\s$\\|\\s'\\)")
|
||||
(setq ts (cons (cons 'punctuation
|
||||
(cons (match-beginning 0) (match-end 0)))
|
||||
ts)))
|
||||
;; unknown token
|
||||
(t
|
||||
(error "What is that?")))
|
||||
(goto-char (or ep (match-end 0)))
|
||||
(setq ep nil)))
|
||||
;; maybe catch the last beginning of line when needed
|
||||
(and semantic-flex-enable-bol
|
||||
(= (point) end)
|
||||
(bolp)
|
||||
(setq ts (cons (cons 'bol (cons (point) (point))) ts)))
|
||||
(goto-char pos)
|
||||
;;(message "Flexing muscles...done")
|
||||
(nreverse ts)))
|
||||
(make-obsolete-variable 'semantic-flex-depth nil "28.1")
|
||||
|
||||
(provide 'semantic/lex)
|
||||
|
||||
|
|
|
|||
|
|
@ -101,9 +101,6 @@ PARENT can also be a `semanticdb-table' object."
|
|||
)
|
||||
)
|
||||
|
||||
(make-obsolete-overload 'semantic-find-nonterminal
|
||||
'semantic-go-to-tag "23.2")
|
||||
|
||||
;;; Dependencies
|
||||
;;
|
||||
;; A tag which is of type 'include specifies a dependency.
|
||||
|
|
@ -175,9 +172,6 @@ Depends on `semantic-dependency-include-path' for searching. Always searches
|
|||
nil)
|
||||
)))
|
||||
|
||||
(make-obsolete-overload 'semantic-find-dependency
|
||||
'semantic-dependency-tag-file "23.2")
|
||||
|
||||
;;; PROTOTYPE FILE
|
||||
;;
|
||||
;; In C, a function in the .c file often has a representation in a
|
||||
|
|
@ -199,13 +193,6 @@ file prototypes belong in."
|
|||
(if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t)
|
||||
(match-string 1))))))
|
||||
|
||||
(semantic-alias-obsolete 'semantic-find-nonterminal
|
||||
'semantic-go-to-tag "23.2")
|
||||
|
||||
(semantic-alias-obsolete 'semantic-find-dependency
|
||||
'semantic-dependency-tag-file "23.2")
|
||||
|
||||
|
||||
(provide 'semantic/tag-file)
|
||||
|
||||
;; Local variables:
|
||||
|
|
|
|||
|
|
@ -190,7 +190,7 @@ See `semantic-tag-similar-p' for details."
|
|||
;; will contain the info needed to determine the full name.
|
||||
(define-overloadable-function semantic-tag-full-package (tag &optional stream-or-buffer)
|
||||
"Return the fully qualified package name of TAG in a package hierarchy.
|
||||
STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream',
|
||||
STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-tag-table',
|
||||
but must be a toplevel semantic tag stream that contains TAG.
|
||||
A Package Hierarchy is defined in UML by the way classes and methods
|
||||
are organized on disk. Some languages use this concept such that a
|
||||
|
|
@ -213,7 +213,7 @@ Return the name of the first tag of class `package' in STREAM."
|
|||
|
||||
(define-overloadable-function semantic-tag-full-name (tag &optional stream-or-buffer)
|
||||
"Return the fully qualified name of TAG in the package hierarchy.
|
||||
STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream',
|
||||
STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-tag-table',
|
||||
but must be a toplevel semantic tag stream that contains TAG.
|
||||
A Package Hierarchy is defined in UML by the way classes and methods
|
||||
are organized on disk. Some languages use this concept such that a
|
||||
|
|
@ -233,9 +233,6 @@ resolve issues where a method in a class in a package is present."
|
|||
(or stream-or-buffer tag))))
|
||||
(:override-with-args (tag stream))))
|
||||
|
||||
(make-obsolete-overload 'semantic-nonterminal-full-name
|
||||
'semantic-tag-full-name "23.2")
|
||||
|
||||
(defun semantic-tag-full-name-default (tag stream)
|
||||
"Default method for `semantic-tag-full-name'.
|
||||
Return the name of TAG found in the toplevel STREAM."
|
||||
|
|
@ -287,9 +284,6 @@ is to return a symbol based on type modifiers."
|
|||
(setq parent (semantic-tag-calculate-parent tag)))
|
||||
(:override))
|
||||
|
||||
(make-obsolete-overload 'semantic-nonterminal-protection
|
||||
'semantic-tag-protection "23.2")
|
||||
|
||||
(defun semantic-tag-protection-default (tag &optional parent)
|
||||
"Return the protection of TAG as a child of PARENT default action.
|
||||
See `semantic-tag-protection'."
|
||||
|
|
@ -377,9 +371,6 @@ in how methods are overridden. In UML, abstract methods are italicized.
|
|||
The default behavior (if not overridden with `tag-abstract-p'
|
||||
is to return true if `abstract' is in the type modifiers.")
|
||||
|
||||
(make-obsolete-overload 'semantic-nonterminal-abstract
|
||||
'semantic-tag-abstract-p "23.2")
|
||||
|
||||
(defun semantic-tag-abstract-p-default (tag &optional parent)
|
||||
"Return non-nil if TAG is abstract as a child of PARENT default action.
|
||||
See `semantic-tag-abstract-p'."
|
||||
|
|
@ -400,9 +391,6 @@ In UML, leaf methods and classes have special meaning and behavior.
|
|||
The default behavior (if not overridden with `tag-leaf-p'
|
||||
is to return true if `leaf' is in the type modifiers.")
|
||||
|
||||
(make-obsolete-overload 'semantic-nonterminal-leaf
|
||||
'semantic-tag-leaf-p "23.2")
|
||||
|
||||
(defun semantic-tag-leaf-p-default (tag &optional parent)
|
||||
"Return non-nil if TAG is leaf as a child of PARENT default action.
|
||||
See `semantic-tag-leaf-p'."
|
||||
|
|
|
|||
|
|
@ -1328,26 +1328,6 @@ This function is overridable with the symbol `insert-foreign-tag'."
|
|||
(defconst semantic-token-incompatible-version
|
||||
semantic-tag-incompatible-version)
|
||||
|
||||
(defsubst semantic-token-type-parent (tag)
|
||||
"Return the parent of the type that TAG describes.
|
||||
The return value is a list. A value of nil means no parents.
|
||||
The `car' of the list is either the parent class, or a list
|
||||
of parent classes. The `cdr' of the list is the list of
|
||||
interfaces, or abstract classes which are parents of TAG."
|
||||
(cons (semantic-tag-get-attribute tag :superclasses)
|
||||
(semantic-tag-type-interfaces tag)))
|
||||
|
||||
(make-obsolete 'semantic-token-type-parent
|
||||
"\
|
||||
use `semantic-tag-type-superclass' \
|
||||
and `semantic-tag-type-interfaces' instead" "23.2")
|
||||
|
||||
(semantic-alias-obsolete 'semantic-tag-make-assoc-list
|
||||
'semantic-tag-make-plist "23.2")
|
||||
|
||||
(semantic-varalias-obsolete 'semantic-expand-nonterminal
|
||||
'semantic-tag-expand-function "23.2")
|
||||
|
||||
(provide 'semantic/tag)
|
||||
|
||||
;; Local variables:
|
||||
|
|
|
|||
|
|
@ -79,9 +79,6 @@ If FILE is not loaded, and semanticdb is not available, find the file
|
|||
(with-current-buffer (find-file-noselect file)
|
||||
(semantic-fetch-tags))))))
|
||||
|
||||
(semantic-alias-obsolete 'semantic-file-token-stream
|
||||
'semantic-file-tag-table "23.2")
|
||||
|
||||
(declare-function semanticdb-abstract-table-child-p "semantic/db" (obj) t)
|
||||
(declare-function semanticdb-refresh-table "semantic/db")
|
||||
(declare-function semanticdb-get-tags "semantic/db" (arg &rest args) t)
|
||||
|
|
@ -137,9 +134,6 @@ buffer, or a filename. If SOMETHING is nil return nil."
|
|||
;; don't know what it is
|
||||
(t nil)))
|
||||
|
||||
(semantic-alias-obsolete 'semantic-something-to-stream
|
||||
'semantic-something-to-tag-table "23.2")
|
||||
|
||||
;;; Completion APIs
|
||||
;;
|
||||
;; These functions provide minibuffer reading/completion for lists of
|
||||
|
|
@ -307,7 +301,6 @@ If TAG is not specified, use the tag at point."
|
|||
semantic-init-db-hook
|
||||
semantic-unmatched-syntax-hook
|
||||
semantic--before-fetch-tags-hook
|
||||
semantic-after-toplevel-bovinate-hook
|
||||
semantic-after-toplevel-cache-change-hook
|
||||
semantic-before-toplevel-cache-flush-hook
|
||||
semantic-dump-parse
|
||||
|
|
|
|||
|
|
@ -43,11 +43,6 @@
|
|||
"Extra lookahead token.
|
||||
When non-nil it is directly returned by `wisent-lex-function'.")
|
||||
|
||||
;; Maintain this alias for compatibility until all WY grammars have
|
||||
;; been translated again to Elisp code.
|
||||
(semantic-alias-obsolete 'wisent-lex-make-token-table
|
||||
'semantic-lex-make-type-table "23.2")
|
||||
|
||||
(defmacro wisent-lex-eoi ()
|
||||
"Return an End-Of-Input lexical token.
|
||||
The EOI token is like this: ($EOI \"\" POINT-MAX . POINT-MAX)."
|
||||
|
|
|
|||
|
|
@ -64,21 +64,8 @@ mbox format, and so cannot be distinguished in this way."
|
|||
:type 'boolean
|
||||
:group 'dired-keys)
|
||||
|
||||
(defcustom dired-bind-jump t
|
||||
"Non-nil means bind `dired-jump' to C-x C-j, otherwise do not.
|
||||
Setting this variable directly after dired-x is loaded has no effect -
|
||||
use \\[customize]."
|
||||
:type 'boolean
|
||||
:set (lambda (sym val)
|
||||
(if (set sym val)
|
||||
(progn
|
||||
(define-key ctl-x-map "\C-j" 'dired-jump)
|
||||
(define-key ctl-x-4-map "\C-j" 'dired-jump-other-window))
|
||||
(if (eq 'dired-jump (lookup-key ctl-x-map "\C-j"))
|
||||
(define-key ctl-x-map "\C-j" nil))
|
||||
(if (eq 'dired-jump-other-window (lookup-key ctl-x-4-map "\C-j"))
|
||||
(define-key ctl-x-4-map "\C-j" nil))))
|
||||
:group 'dired-keys)
|
||||
(defvar dired-bind-jump t)
|
||||
(make-obsolete-variable 'dired-bind-jump "not used." "28.1")
|
||||
|
||||
(defcustom dired-bind-man t
|
||||
"Non-nil means bind `dired-man' to \"N\" in Dired, otherwise do not.
|
||||
|
|
@ -308,7 +295,6 @@ To see the options you can set, use M-x customize-group RET dired-x RET.
|
|||
See also the functions:
|
||||
`dired-flag-extension'
|
||||
`dired-virtual'
|
||||
`dired-jump'
|
||||
`dired-man'
|
||||
`dired-vm'
|
||||
`dired-rmail'
|
||||
|
|
@ -446,68 +432,7 @@ See variables `dired-texinfo-unclean-extensions',
|
|||
dired-bibtex-unclean-extensions
|
||||
dired-tex-unclean-extensions
|
||||
(list ".dvi"))))
|
||||
|
||||
(defvar archive-superior-buffer)
|
||||
(defvar tar-superior-buffer)
|
||||
;;; JUMP.
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-jump (&optional other-window file-name)
|
||||
"Jump to Dired buffer corresponding to current buffer.
|
||||
If in a file, Dired the current directory and move to file's line.
|
||||
If in Dired already, pop up a level and goto old directory's line.
|
||||
In case the proper Dired file line cannot be found, refresh the dired
|
||||
buffer and try again.
|
||||
When OTHER-WINDOW is non-nil, jump to Dired buffer in other window.
|
||||
When FILE-NAME is non-nil, jump to its line in Dired.
|
||||
Interactively with prefix argument, read FILE-NAME."
|
||||
(interactive
|
||||
(list nil (and current-prefix-arg
|
||||
(read-file-name "Jump to Dired file: "))))
|
||||
(cond
|
||||
((and (bound-and-true-p archive-subfile-mode)
|
||||
(buffer-live-p archive-superior-buffer))
|
||||
(switch-to-buffer archive-superior-buffer))
|
||||
((and (bound-and-true-p tar-subfile-mode)
|
||||
(buffer-live-p tar-superior-buffer))
|
||||
(switch-to-buffer tar-superior-buffer))
|
||||
(t
|
||||
;; Expand file-name before `dired-goto-file' call:
|
||||
;; `dired-goto-file' requires its argument to be an absolute
|
||||
;; file name; the result of `read-file-name' could be
|
||||
;; an abbreviated file name (Bug#24409).
|
||||
(let* ((file (or (and file-name (expand-file-name file-name))
|
||||
buffer-file-name))
|
||||
(dir (if file (file-name-directory file) default-directory)))
|
||||
(if (and (eq major-mode 'dired-mode) (null file-name))
|
||||
(progn
|
||||
(setq dir (dired-current-directory))
|
||||
(dired-up-directory other-window)
|
||||
(unless (dired-goto-file dir)
|
||||
;; refresh and try again
|
||||
(dired-insert-subdir (file-name-directory dir))
|
||||
(dired-goto-file dir)))
|
||||
(if other-window
|
||||
(dired-other-window dir)
|
||||
(dired dir))
|
||||
(if file
|
||||
(or (dired-goto-file file)
|
||||
;; refresh and try again
|
||||
(progn
|
||||
(dired-insert-subdir (file-name-directory file))
|
||||
(dired-goto-file file))
|
||||
;; Toggle omitting, if it is on, and try again.
|
||||
(when dired-omit-mode
|
||||
(dired-omit-mode)
|
||||
(dired-goto-file file)))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-jump-other-window (&optional file-name)
|
||||
"Like \\[dired-jump] (`dired-jump') but in other window."
|
||||
(interactive
|
||||
(list (and current-prefix-arg
|
||||
(read-file-name "Jump to Dired file: "))))
|
||||
(dired-jump t file-name))
|
||||
|
||||
;;; OMITTING.
|
||||
|
||||
|
|
|
|||
|
|
@ -896,9 +896,8 @@ ERROR can be a string with the error message."
|
|||
(if (next-read-file-uses-dialog-p)
|
||||
(read-directory-name (format "Dired %s(directory): " str)
|
||||
nil default-directory nil)
|
||||
(read-file-name (format-prompt "Dired %s(directory)"
|
||||
default-directory str)
|
||||
nil default-directory)))))
|
||||
(read-file-name (format "Dired %s(directory): " str)
|
||||
nil default-directory nil)))))
|
||||
|
||||
;; We want to switch to a more sophisticated version of
|
||||
;; dired-read-dir-and-switches like the following, if there is a way
|
||||
|
|
@ -4476,6 +4475,70 @@ Ask means pop up a menu for the user to select one of copy, move or link."
|
|||
(add-to-list 'desktop-buffer-mode-handlers
|
||||
'(dired-mode . dired-restore-desktop-buffer))
|
||||
|
||||
|
||||
;;;; Jump to Dired
|
||||
|
||||
(defvar archive-superior-buffer)
|
||||
(defvar tar-superior-buffer)
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-jump (&optional other-window file-name)
|
||||
"Jump to Dired buffer corresponding to current buffer.
|
||||
If in a file, Dired the current directory and move to file's line.
|
||||
If in Dired already, pop up a level and goto old directory's line.
|
||||
In case the proper Dired file line cannot be found, refresh the dired
|
||||
buffer and try again.
|
||||
When OTHER-WINDOW is non-nil, jump to Dired buffer in other window.
|
||||
When FILE-NAME is non-nil, jump to its line in Dired.
|
||||
Interactively with prefix argument, read FILE-NAME."
|
||||
(interactive
|
||||
(list nil (and current-prefix-arg
|
||||
(read-file-name "Jump to Dired file: "))))
|
||||
(cond
|
||||
((and (bound-and-true-p archive-subfile-mode)
|
||||
(buffer-live-p archive-superior-buffer))
|
||||
(switch-to-buffer archive-superior-buffer))
|
||||
((and (bound-and-true-p tar-subfile-mode)
|
||||
(buffer-live-p tar-superior-buffer))
|
||||
(switch-to-buffer tar-superior-buffer))
|
||||
(t
|
||||
;; Expand file-name before `dired-goto-file' call:
|
||||
;; `dired-goto-file' requires its argument to be an absolute
|
||||
;; file name; the result of `read-file-name' could be
|
||||
;; an abbreviated file name (Bug#24409).
|
||||
(let* ((file (or (and file-name (expand-file-name file-name))
|
||||
buffer-file-name))
|
||||
(dir (if file (file-name-directory file) default-directory)))
|
||||
(if (and (eq major-mode 'dired-mode) (null file-name))
|
||||
(progn
|
||||
(setq dir (dired-current-directory))
|
||||
(dired-up-directory other-window)
|
||||
(unless (dired-goto-file dir)
|
||||
;; refresh and try again
|
||||
(dired-insert-subdir (file-name-directory dir))
|
||||
(dired-goto-file dir)))
|
||||
(if other-window
|
||||
(dired-other-window dir)
|
||||
(dired dir))
|
||||
(if file
|
||||
(or (dired-goto-file file)
|
||||
;; refresh and try again
|
||||
(progn
|
||||
(dired-insert-subdir (file-name-directory file))
|
||||
(dired-goto-file file))
|
||||
;; Toggle omitting, if it is on, and try again.
|
||||
(when (bound-and-true-p dired-omit-mode)
|
||||
(dired-omit-mode)
|
||||
(dired-goto-file file)))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-jump-other-window (&optional file-name)
|
||||
"Like \\[dired-jump] (`dired-jump') but in other window."
|
||||
(interactive
|
||||
(list (and current-prefix-arg
|
||||
(read-file-name "Jump to Dired file: "))))
|
||||
(dired-jump t file-name))
|
||||
|
||||
(provide 'dired)
|
||||
|
||||
(run-hooks 'dired-load-hook) ; for your customizations
|
||||
|
|
|
|||
|
|
@ -663,6 +663,7 @@ This can be needed when using code byte-compiled using the old
|
|||
macro-expansion of `cl-defstruct' that used vectors objects instead
|
||||
of record objects."
|
||||
:global t
|
||||
:group 'tools
|
||||
(cond
|
||||
(cl-old-struct-compat-mode
|
||||
(advice-add 'type-of :around #'cl--old-struct-type-of))
|
||||
|
|
|
|||
|
|
@ -184,7 +184,7 @@ In insert mode, this key also functions as Meta."
|
|||
:type 'string
|
||||
:group 'viper)
|
||||
|
||||
(defconst viper-ESC-key [escape]
|
||||
(defconst viper-ESC-key (kbd "ESC")
|
||||
"Key used to ESC.")
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -31,6 +31,7 @@
|
|||
(require 'erc)
|
||||
(require 'xml)
|
||||
(require 'notifications)
|
||||
(require 'erc-goodies)
|
||||
(require 'erc-match)
|
||||
(require 'dbus)
|
||||
|
||||
|
|
@ -62,12 +63,12 @@ This will replace the last notification sent with this function."
|
|||
;; setting the current buffer to the existing query buffer)
|
||||
(dbus-ignore-errors
|
||||
(setq erc-notifications-last-notification
|
||||
(let ((channel (if privp (erc-get-buffer nick) (current-buffer))))
|
||||
(let* ((channel (if privp (erc-get-buffer nick) (current-buffer)))
|
||||
(title (format "%s in %s" (xml-escape-string nick t) channel))
|
||||
(body (xml-escape-string (erc-controls-strip msg) t)))
|
||||
(notifications-notify :bus erc-notifications-bus
|
||||
:title (format "%s in %s"
|
||||
(xml-escape-string nick)
|
||||
channel)
|
||||
:body (xml-escape-string msg)
|
||||
:title title
|
||||
:body body
|
||||
:replaces-id erc-notifications-last-notification
|
||||
:app-icon erc-notifications-icon
|
||||
:actions '("default" "Switch to buffer")
|
||||
|
|
|
|||
|
|
@ -116,6 +116,9 @@ is non-nil."
|
|||
(defcustom eshell-command-completions-alist
|
||||
'(("acroread" . "\\.pdf\\'")
|
||||
("xpdf" . "\\.pdf\\'")
|
||||
("gunzip" . "\\.t?gz\\'")
|
||||
("bunzip2" . "\\.t?bz2\\'")
|
||||
("unxz" . "\\.t?xz\\'")
|
||||
("ar" . "\\.[ao]\\'")
|
||||
("gcc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
|
||||
("g++" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
|
||||
|
|
|
|||
|
|
@ -4530,12 +4530,13 @@ Interactively, confirmation is required unless you supply a prefix argument."
|
|||
;; (interactive "FWrite file: ")
|
||||
(interactive
|
||||
(list (if buffer-file-name
|
||||
(read-file-name "Write file: ")
|
||||
(read-file-name
|
||||
(format-prompt "Write file" (file-name-nondirectory (buffer-name)))
|
||||
default-directory
|
||||
(expand-file-name (file-name-nondirectory (buffer-name))
|
||||
default-directory)))
|
||||
(read-file-name "Write file: "
|
||||
nil nil nil nil)
|
||||
(read-file-name "Write file: " default-directory
|
||||
(expand-file-name
|
||||
(file-name-nondirectory (buffer-name))
|
||||
default-directory)
|
||||
nil nil))
|
||||
(not current-prefix-arg)))
|
||||
(or (null filename) (string-equal filename "")
|
||||
(progn
|
||||
|
|
@ -5273,13 +5274,10 @@ Before and after saving the buffer, this function runs
|
|||
(unless (run-hook-with-args-until-success 'write-contents-functions)
|
||||
;; If buffer has no file name, ask user for one.
|
||||
(or buffer-file-name
|
||||
(let* ((default (expand-file-name (buffer-name)))
|
||||
(filename
|
||||
(expand-file-name
|
||||
(read-file-name
|
||||
(format-prompt "File to save in"
|
||||
(file-name-nondirectory default))
|
||||
nil default))))
|
||||
(let ((filename
|
||||
(expand-file-name
|
||||
(read-file-name "File to save in: "
|
||||
nil (expand-file-name (buffer-name))))))
|
||||
(if (file-exists-p filename)
|
||||
(if (file-directory-p filename)
|
||||
;; Signal an error if the user specified the name of an
|
||||
|
|
|
|||
|
|
@ -3812,6 +3812,7 @@ has been fetched."
|
|||
t))))
|
||||
|
||||
(defun gnus-agent-store-article (article group)
|
||||
(declare (obsolete nil "28.1"))
|
||||
(let* ((gnus-command-method (gnus-find-method-for-group group))
|
||||
(file (gnus-agent-article-name (number-to-string article) group))
|
||||
(file-name-coding-system nnmail-pathname-coding-system)
|
||||
|
|
|
|||
|
|
@ -7084,10 +7084,7 @@ If given a prefix, show the hidden text instead."
|
|||
gnus-summary-buffer)
|
||||
(when gnus-keep-backlog
|
||||
(gnus-backlog-enter-article
|
||||
group article (current-buffer)))
|
||||
(when (and gnus-agent
|
||||
(gnus-agent-group-covered-p group))
|
||||
(gnus-agent-store-article article group)))
|
||||
group article (current-buffer))))
|
||||
(setq result 'article))
|
||||
(methods
|
||||
(setq gnus-override-method (pop methods)))
|
||||
|
|
|
|||
|
|
@ -225,12 +225,6 @@ that was fetched."
|
|||
(save-excursion
|
||||
(save-restriction
|
||||
(narrow-to-region mark (point-max))
|
||||
;; Put the articles into the agent, if they aren't already.
|
||||
(when (and gnus-agent
|
||||
(gnus-agent-group-covered-p group))
|
||||
(save-restriction
|
||||
(narrow-to-region mark (point-max))
|
||||
(gnus-agent-store-article article group)))
|
||||
;; Prefetch images for the groups that want that.
|
||||
(when (fboundp 'gnus-html-prefetch-images)
|
||||
(gnus-html-prefetch-images summary))
|
||||
|
|
|
|||
|
|
@ -315,7 +315,8 @@ affect point."
|
|||
"Load Gnus bookmarks from FILE (which must be in bookmark format)."
|
||||
(interactive
|
||||
(list (read-file-name
|
||||
(format-prompt "Load Gnus bookmarks from" gnus-bookmark-default-file)
|
||||
(format "Load Gnus bookmarks from: (%s) "
|
||||
gnus-bookmark-default-file)
|
||||
"~/" gnus-bookmark-default-file 'confirm)))
|
||||
(setq file (expand-file-name file))
|
||||
(if (file-readable-p file)
|
||||
|
|
|
|||
|
|
@ -3166,30 +3166,13 @@ mail messages or news articles in files that have numeric names."
|
|||
(list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
|
||||
|
||||
|
||||
(autoload 'nnir-make-specs "nnir")
|
||||
(autoload 'nnir-read-parms "nnir")
|
||||
(autoload 'nnir-server-to-search-engine "nnir")
|
||||
(autoload 'gnus-group-topic-name "gnus-topic")
|
||||
|
||||
;; Temporary to make group creation easier
|
||||
(defun gnus-group-make-search-group (nnir-extra-parms &optional specs)
|
||||
(interactive "P")
|
||||
(let ((name (gnus-read-group "Group name: ")))
|
||||
(with-current-buffer gnus-group-buffer
|
||||
(gnus-group-make-group
|
||||
name
|
||||
(list 'nnselect "nnselect")
|
||||
nil
|
||||
(list
|
||||
(cons 'nnselect-specs
|
||||
(list
|
||||
(cons 'nnselect-function 'nnir-run-query)
|
||||
(cons 'nnselect-args
|
||||
(nnir-make-specs nnir-extra-parms specs)))))))))
|
||||
|
||||
(define-obsolete-function-alias 'gnus-group-make-nnir-group
|
||||
'gnus-group-read-ephemeral-search-group "28.1")
|
||||
|
||||
(defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional specs)
|
||||
"Create an nnselect group based on a search.
|
||||
"Make a group based on a search.
|
||||
Prompt for a search query and determine the groups to search as
|
||||
follows: if called from the *Server* buffer search all groups
|
||||
belonging to the server on the current line; if called from the
|
||||
|
|
@ -3200,19 +3183,96 @@ constraints. A non-nil SPECS arg must be an alist with
|
|||
`nnir-query-spec' and `nnir-group-spec' keys, and skips all
|
||||
prompting."
|
||||
(interactive "P")
|
||||
(gnus-group-read-ephemeral-group
|
||||
(concat "nnselect-" (message-unique-id))
|
||||
(list 'nnselect "nnselect")
|
||||
nil
|
||||
(cons (current-buffer) gnus-current-window-configuration)
|
||||
nil nil
|
||||
(list
|
||||
(cons 'nnselect-specs
|
||||
(list
|
||||
(cons 'nnselect-function 'nnir-run-query)
|
||||
(cons 'nnselect-args
|
||||
(nnir-make-specs nnir-extra-parms specs))))
|
||||
(cons 'nnselect-artlist nil))))
|
||||
(let ((name (gnus-read-group "Group name: ")))
|
||||
(with-current-buffer gnus-group-buffer
|
||||
(let* ((group-spec
|
||||
(or
|
||||
(cdr (assq 'nnir-group-spec specs))
|
||||
(if (gnus-server-server-name)
|
||||
(list (list (gnus-server-server-name)))
|
||||
(seq-group-by
|
||||
(lambda (elt) (gnus-group-server elt))
|
||||
(or gnus-group-marked
|
||||
(if (gnus-group-group-name)
|
||||
(list (gnus-group-group-name))
|
||||
(cdr
|
||||
(assoc (gnus-group-topic-name) gnus-topic-alist))))))))
|
||||
(query-spec
|
||||
(or
|
||||
(cdr (assq 'nnir-query-spec specs))
|
||||
(apply
|
||||
'append
|
||||
(list (cons 'query
|
||||
(read-string "Query: " nil 'nnir-search-history)))
|
||||
(when nnir-extra-parms
|
||||
(mapcar
|
||||
(lambda (x)
|
||||
(nnir-read-parms (nnir-server-to-search-engine (car x))))
|
||||
group-spec))))))
|
||||
(gnus-group-make-group
|
||||
name
|
||||
(list 'nnselect "nnselect")
|
||||
nil
|
||||
(list
|
||||
(cons 'nnselect-specs
|
||||
(list
|
||||
(cons 'nnselect-function 'nnir-run-query)
|
||||
(cons 'nnselect-args
|
||||
(list (cons 'nnir-query-spec query-spec)
|
||||
(cons 'nnir-group-spec group-spec)))))
|
||||
(cons 'nnselect-artlist nil)))))))
|
||||
|
||||
(define-obsolete-function-alias 'gnus-group-make-nnir-group
|
||||
'gnus-group-read-ephemeral-search-group "28.1")
|
||||
|
||||
(defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional specs)
|
||||
"Read an nnselect group based on a search.
|
||||
Prompt for a search query and determine the groups to search as
|
||||
follows: if called from the *Server* buffer search all groups
|
||||
belonging to the server on the current line; if called from the
|
||||
*Group* buffer search any marked groups, or the group on the
|
||||
current line, or all the groups under the current topic. Calling
|
||||
with a prefix arg prompts for additional search-engine specific
|
||||
constraints. A non-nil SPECS arg must be an alist with
|
||||
`nnir-query-spec' and `nnir-group-spec' keys, and skips all
|
||||
prompting."
|
||||
(interactive "P")
|
||||
(let* ((group-spec
|
||||
(or (cdr (assq 'nnir-group-spec specs))
|
||||
(if (gnus-server-server-name)
|
||||
(list (list (gnus-server-server-name)))
|
||||
(seq-group-by
|
||||
(lambda (elt) (gnus-group-server elt))
|
||||
(or gnus-group-marked
|
||||
(if (gnus-group-group-name)
|
||||
(list (gnus-group-group-name))
|
||||
(cdr
|
||||
(assoc (gnus-group-topic-name) gnus-topic-alist))))))))
|
||||
(query-spec
|
||||
(or (cdr (assq 'nnir-query-spec specs))
|
||||
(apply
|
||||
'append
|
||||
(list (cons 'query
|
||||
(read-string "Query: " nil 'nnir-search-history)))
|
||||
(when nnir-extra-parms
|
||||
(mapcar
|
||||
(lambda (x)
|
||||
(nnir-read-parms (nnir-server-to-search-engine (car x))))
|
||||
group-spec))))))
|
||||
(gnus-group-read-ephemeral-group
|
||||
(concat "nnselect-" (message-unique-id))
|
||||
(list 'nnselect "nnselect")
|
||||
nil
|
||||
(cons (current-buffer) gnus-current-window-configuration)
|
||||
nil nil
|
||||
(list
|
||||
(cons 'nnselect-specs
|
||||
(list
|
||||
(cons 'nnselect-function 'nnir-run-query)
|
||||
(cons 'nnselect-args
|
||||
(list (cons 'nnir-query-spec query-spec)
|
||||
(cons 'nnir-group-spec group-spec)))))
|
||||
(cons 'nnselect-artlist nil)))))
|
||||
|
||||
(defun gnus-group-add-to-virtual (n vgroup)
|
||||
"Add the current group to a virtual group."
|
||||
|
|
|
|||
|
|
@ -365,6 +365,48 @@ If it is down, start it up (again)."
|
|||
(funcall (gnus-get-function gnus-command-method 'request-list)
|
||||
(nth 1 gnus-command-method)))
|
||||
|
||||
(defun gnus-server-get-active (server &optional ignored)
|
||||
"Return the active list for SERVER.
|
||||
Groups matching the IGNORED regexp are excluded."
|
||||
(let ((method (gnus-server-to-method server))
|
||||
groups)
|
||||
(gnus-request-list method)
|
||||
(with-current-buffer nntp-server-buffer
|
||||
(let ((cur (current-buffer)))
|
||||
(goto-char (point-min))
|
||||
(unless (or (null ignored)
|
||||
(string= ignored ""))
|
||||
(delete-matching-lines ignored))
|
||||
(if (eq (car method) 'nntp)
|
||||
(while (not (eobp))
|
||||
(ignore-errors
|
||||
(push (gnus-group-full-name
|
||||
(buffer-substring
|
||||
(point)
|
||||
(progn
|
||||
(skip-chars-forward "^ \t")
|
||||
(point)))
|
||||
method)
|
||||
groups))
|
||||
(forward-line))
|
||||
(while (not (eobp))
|
||||
(ignore-errors
|
||||
(push (if (eq (char-after) ?\")
|
||||
(gnus-group-full-name (read cur) method)
|
||||
(let ((p (point)) (name ""))
|
||||
(skip-chars-forward "^ \t\\\\")
|
||||
(setq name (buffer-substring p (point)))
|
||||
(while (eq (char-after) ?\\)
|
||||
(setq p (1+ (point)))
|
||||
(forward-char 2)
|
||||
(skip-chars-forward "^ \t\\\\")
|
||||
(setq name (concat name (buffer-substring
|
||||
p (point)))))
|
||||
(gnus-group-full-name name method)))
|
||||
groups))
|
||||
(forward-line)))))
|
||||
groups))
|
||||
|
||||
(defun gnus-finish-retrieve-group-infos (gnus-command-method infos data)
|
||||
"Read and update infos from GNUS-COMMAND-METHOD."
|
||||
(when (stringp gnus-command-method)
|
||||
|
|
|
|||
|
|
@ -862,6 +862,18 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header."
|
|||
(setq match (string-to-number match)))
|
||||
(set-text-properties 0 (length match) nil match))
|
||||
|
||||
;; Modify match and type for article age scoring.
|
||||
(if (string= "date" (nth 0 (assoc header gnus-header-index)))
|
||||
(let ((age (string-to-number match)))
|
||||
(if (or (< age 0)
|
||||
(string= "0" match))
|
||||
(user-error "Article age must be a positive number"))
|
||||
(setq match age
|
||||
type (cond ((eq type 'after)
|
||||
'<)
|
||||
((eq type 'before)
|
||||
'>)))))
|
||||
|
||||
(unless (eq date 'now)
|
||||
;; Add the score entry to the score file.
|
||||
(when (= score gnus-score-interactive-default-score)
|
||||
|
|
@ -1695,9 +1707,10 @@ score in `gnus-newsgroup-scored' by SCORE."
|
|||
match (gnus-date-iso8601 (nth 0 kill))))
|
||||
((eq type '<)
|
||||
(setq type 'after
|
||||
match-func 'gnus-string>
|
||||
match-func 'string<
|
||||
match (gnus-time-iso8601
|
||||
(time-add (current-time) (* 86400 (nth 0 kill))))))
|
||||
(time-subtract (current-time)
|
||||
(* 86400 (nth 0 kill))))))
|
||||
((eq type 'before)
|
||||
(setq match-func 'gnus-string>
|
||||
match (gnus-date-iso8601 (nth 0 kill))))
|
||||
|
|
@ -1705,7 +1718,8 @@ score in `gnus-newsgroup-scored' by SCORE."
|
|||
(setq type 'before
|
||||
match-func 'gnus-string>
|
||||
match (gnus-time-iso8601
|
||||
(time-add (current-time) (* -86400 (nth 0 kill))))))
|
||||
(time-subtract (current-time)
|
||||
(* 86400 (nth 0 kill))))))
|
||||
((eq type 'at)
|
||||
(setq match-func 'string=
|
||||
match (gnus-date-iso8601 (nth 0 kill))))
|
||||
|
|
|
|||
|
|
@ -10708,6 +10708,7 @@ groups."
|
|||
;; We only have to update this line.
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(nnheader-ms-strip-cr)
|
||||
(message-narrow-to-head)
|
||||
(let ((head (buffer-substring-no-properties
|
||||
(point-min) (point-max)))
|
||||
|
|
|
|||
|
|
@ -3628,11 +3628,12 @@ If you call this function inside a loop, consider using the faster
|
|||
|
||||
(defun gnus-group-get-parameter (group &optional symbol allow-list)
|
||||
"Return the group parameters for GROUP.
|
||||
If SYMBOL, return the value of that symbol in the group parameters.
|
||||
If ALLOW-LIST, also allow list as a result.
|
||||
Most functions should use `gnus-group-find-parameter', which
|
||||
also examines the topic parameters."
|
||||
(let ((params (gnus-info-params (gnus-get-info group))))
|
||||
If SYMBOL, return the value of that symbol in the group
|
||||
parameters. If ALLOW-LIST, also allow list as a result. Most
|
||||
functions should use `gnus-group-find-parameter', which also
|
||||
examines the topic parameters. GROUP can also be an info structure."
|
||||
(let ((params (gnus-info-params (if (listp group) group
|
||||
(gnus-get-info group)))))
|
||||
(if symbol
|
||||
(gnus-group-parameter-value params symbol allow-list)
|
||||
params)))
|
||||
|
|
|
|||
|
|
@ -3536,8 +3536,8 @@ Prefix arg means justify as well."
|
|||
(equal quoted (match-string 0)))
|
||||
(goto-char (match-end 0))
|
||||
(looking-at "[ \t]*")
|
||||
(if (> (length leading-space) (length (match-string 0)))
|
||||
(setq leading-space (match-string 0)))
|
||||
(when (< (length leading-space) (length (match-string 0)))
|
||||
(setq leading-space (match-string 0)))
|
||||
(forward-line 1))
|
||||
(setq end (point))
|
||||
(goto-char beg)
|
||||
|
|
|
|||
|
|
@ -549,6 +549,7 @@ construct the vector entries."
|
|||
|
||||
;;; Search Engine Interfaces:
|
||||
|
||||
(autoload 'gnus-server-get-active "gnus-int")
|
||||
(autoload 'nnimap-change-group "nnimap")
|
||||
(declare-function nnimap-buffer "nnimap" ())
|
||||
(declare-function nnimap-command "nnimap" (&rest args))
|
||||
|
|
@ -567,7 +568,8 @@ extensions."
|
|||
(cdr (assoc nnir-imap-default-search-key
|
||||
nnir-imap-search-arguments))))
|
||||
(gnus-inhibit-demon t)
|
||||
(groups (or groups (nnir-get-active srv))))
|
||||
(groups
|
||||
(or groups (gnus-server-get-active srv nnir-ignored-newsgroups))))
|
||||
(message "Opening server %s" server)
|
||||
(apply
|
||||
'vconcat
|
||||
|
|
@ -1205,7 +1207,8 @@ construct path: search terms (see the variable
|
|||
(directory (cadr (assoc sym (cddr method))))
|
||||
(regexp (cdr (assoc 'query query)))
|
||||
(grep-options (cdr (assoc 'grep-options query)))
|
||||
(grouplist (or grouplist (nnir-get-active server))))
|
||||
(grouplist
|
||||
(or grouplist (gnus-server-get-active server nnir-ignored-newsgroups))))
|
||||
(unless directory
|
||||
(error "No directory found in method specification of server %s"
|
||||
server))
|
||||
|
|
@ -1332,54 +1335,13 @@ environment unless NOT-GLOBAL is non-nil."
|
|||
((and (not not-global) (boundp key)) (symbol-value key))
|
||||
(t nil))))
|
||||
|
||||
(autoload 'gnus-request-list "gnus-int")
|
||||
|
||||
(defun nnir-get-active (srv)
|
||||
"Return the active list for SRV."
|
||||
(let ((method (gnus-server-to-method srv))
|
||||
groups)
|
||||
(gnus-request-list method)
|
||||
(with-current-buffer nntp-server-buffer
|
||||
(let ((cur (current-buffer)))
|
||||
(goto-char (point-min))
|
||||
(unless (or (null nnir-ignored-newsgroups)
|
||||
(string= nnir-ignored-newsgroups ""))
|
||||
(delete-matching-lines nnir-ignored-newsgroups))
|
||||
(if (eq (car method) 'nntp)
|
||||
(while (not (eobp))
|
||||
(ignore-errors
|
||||
(push (gnus-group-full-name
|
||||
(buffer-substring
|
||||
(point)
|
||||
(progn
|
||||
(skip-chars-forward "^ \t")
|
||||
(point)))
|
||||
method)
|
||||
groups))
|
||||
(forward-line))
|
||||
(while (not (eobp))
|
||||
(ignore-errors
|
||||
(push (if (eq (char-after) ?\")
|
||||
(gnus-group-full-name (read cur) method)
|
||||
(let ((p (point)) (name ""))
|
||||
(skip-chars-forward "^ \t\\\\")
|
||||
(setq name (buffer-substring p (point)))
|
||||
(while (eq (char-after) ?\\)
|
||||
(setq p (1+ (point)))
|
||||
(forward-char 2)
|
||||
(skip-chars-forward "^ \t\\\\")
|
||||
(setq name (concat name (buffer-substring
|
||||
p (point)))))
|
||||
(gnus-group-full-name name method)))
|
||||
groups))
|
||||
(forward-line)))))
|
||||
groups))
|
||||
|
||||
(autoload 'nnselect-categorize "nnselect" nil nil)
|
||||
(autoload 'gnus-group-topic-name "gnus-topic" nil nil)
|
||||
(defvar gnus-group-marked)
|
||||
(defvar gnus-topic-alist)
|
||||
|
||||
(make-obsolete 'nnir-make-specs "This function should no longer
|
||||
be used." "28.1")
|
||||
|
||||
(defun nnir-make-specs (nnir-extra-parms &optional specs)
|
||||
"Make the query-spec and group-spec for a search with NNIR-EXTRA-PARMS.
|
||||
Query for the specs, or use SPECS."
|
||||
|
|
@ -1387,12 +1349,12 @@ Query for the specs, or use SPECS."
|
|||
(or (cdr (assq 'nnir-group-spec specs))
|
||||
(if (gnus-server-server-name)
|
||||
(list (list (gnus-server-server-name)))
|
||||
(nnselect-categorize
|
||||
(seq-group-by
|
||||
(lambda (elt) (gnus-group-server elt))
|
||||
(or gnus-group-marked
|
||||
(if (gnus-group-group-name)
|
||||
(list (gnus-group-group-name))
|
||||
(cdr (assoc (gnus-group-topic-name) gnus-topic-alist))))
|
||||
'nnselect-group-server))))
|
||||
(cdr (assoc (gnus-group-topic-name) gnus-topic-alist))))))))
|
||||
(query-spec
|
||||
(or (cdr (assq 'nnir-query-spec specs))
|
||||
(apply
|
||||
|
|
@ -1407,6 +1369,8 @@ Query for the specs, or use SPECS."
|
|||
(list (cons 'nnir-query-spec query-spec)
|
||||
(cons 'nnir-group-spec group-spec))))
|
||||
|
||||
(define-obsolete-function-alias 'nnir-get-active 'gnus-server-get-active "28.1")
|
||||
|
||||
;; The end.
|
||||
(provide 'nnir)
|
||||
|
||||
|
|
|
|||
|
|
@ -105,9 +105,7 @@
|
|||
(gnus-uncompress-sequence artseq)) selection)))
|
||||
selection)))
|
||||
|
||||
(defun nnselect-group-server (group)
|
||||
"Return the server for GROUP."
|
||||
(gnus-group-server group))
|
||||
(make-obsolete 'nnselect-group-server 'gnus-group-server "28.1")
|
||||
|
||||
;; Data type article list.
|
||||
|
||||
|
|
@ -418,6 +416,21 @@ If this variable is nil, or if the provided function returns nil,
|
|||
to-newsgroup ; Not respooling
|
||||
(gnus-group-real-name to-newsgroup)))))
|
||||
|
||||
(deffoo nnselect-request-replace-article
|
||||
(article _group buffer &optional no-encode)
|
||||
(pcase-let ((`[,artgroup ,artnumber ,artrsv]
|
||||
(with-current-buffer gnus-summary-buffer
|
||||
(nnselect-artlist-article gnus-newsgroup-selection article))))
|
||||
(unless (gnus-check-backend-function
|
||||
'request-replace-article artgroup)
|
||||
(user-error "The group %s does not support article editing" artgroup))
|
||||
(let ((newart
|
||||
(gnus-request-replace-article artnumber artgroup buffer no-encode)))
|
||||
(with-current-buffer gnus-summary-buffer
|
||||
(cl-nsubstitute `[,artgroup ,newart ,artrsv]
|
||||
`[,artgroup ,artnumber ,artrsv]
|
||||
gnus-newsgroup-selection
|
||||
:test #'equal :count 1)))))
|
||||
|
||||
(deffoo nnselect-request-expire-articles
|
||||
(articles _group &optional _server force)
|
||||
|
|
|
|||
|
|
@ -1820,9 +1820,8 @@ one of them returns non-nil."
|
|||
;;;###autoload
|
||||
(defun doc-file-to-man (file)
|
||||
"Produce an nroff buffer containing the doc-strings from the DOC file."
|
||||
(interactive (list (read-file-name (format-prompt "Name of DOC file"
|
||||
internal-doc-file-name)
|
||||
doc-directory internal-doc-file-name t)))
|
||||
(interactive (list (read-file-name "Name of DOC file: " doc-directory
|
||||
internal-doc-file-name t)))
|
||||
(or (file-readable-p file)
|
||||
(error "Cannot read file `%s'" file))
|
||||
(pop-to-buffer (generate-new-buffer "*man-doc*"))
|
||||
|
|
@ -1851,9 +1850,8 @@ one of them returns non-nil."
|
|||
;;;###autoload
|
||||
(defun doc-file-to-info (file)
|
||||
"Produce a texinfo buffer with sorted doc-strings from the DOC file."
|
||||
(interactive (list (read-file-name (format-prompt "Name of DOC file"
|
||||
internal-doc-file-name)
|
||||
doc-directory internal-doc-file-name t)))
|
||||
(interactive (list (read-file-name "Name of DOC file: " doc-directory
|
||||
internal-doc-file-name t)))
|
||||
(or (file-readable-p file)
|
||||
(error "Cannot read file `%s'" file))
|
||||
(let ((i 0) type name doc alist)
|
||||
|
|
|
|||
|
|
@ -308,7 +308,7 @@ The format is (FUNCTION ARGS...).")
|
|||
:supertype 'help-xref
|
||||
'help-function
|
||||
(lambda (file pos)
|
||||
(pop-to-buffer (find-file-noselect file))
|
||||
(view-buffer-other-window (find-file-noselect file))
|
||||
(goto-char pos))
|
||||
'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement"))
|
||||
|
||||
|
|
|
|||
|
|
@ -1799,13 +1799,11 @@ The default status is as follows:
|
|||
'raw-text)
|
||||
|
||||
(set-default-coding-systems nil)
|
||||
(setq default-sendmail-coding-system 'iso-latin-1)
|
||||
;; On Darwin systems, this should be utf-8-unix, but when this file is loaded
|
||||
;; that is not yet defined, so we set it in set-locale-environment instead.
|
||||
;; [Actually, it seems to work fine to use utf-8-unix here, and not just
|
||||
;; on Darwin. The previous comment seems to be outdated?
|
||||
;; See patch at https://debbugs.gnu.org/15803 ]
|
||||
(setq default-file-name-coding-system 'iso-latin-1-unix)
|
||||
(setq default-sendmail-coding-system 'utf-8)
|
||||
(setq default-file-name-coding-system (if (memq system-type
|
||||
'(window-nt ms-dos))
|
||||
'iso-latin-1-unix
|
||||
'utf-8-unix))
|
||||
;; Preserve eol-type from existing default-process-coding-systems.
|
||||
;; On non-unix-like systems in particular, these may have been set
|
||||
;; carefully by the user, or by the startup code, to deal with the
|
||||
|
|
@ -1821,8 +1819,10 @@ The default status is as follows:
|
|||
(input-coding
|
||||
(condition-case nil
|
||||
(coding-system-change-text-conversion
|
||||
(cdr default-process-coding-system) 'iso-latin-1)
|
||||
(coding-system-error 'iso-latin-1))))
|
||||
(cdr default-process-coding-system)
|
||||
(if (memq system-type '(window-nt ms-dos)) 'iso-latin-1 'utf-8))
|
||||
(coding-system-error
|
||||
(if (memq system-type '(window-nt ms-dos)) 'iso-latin-1 'utf-8)))))
|
||||
(setq default-process-coding-system
|
||||
(cons output-coding input-coding)))
|
||||
|
||||
|
|
|
|||
|
|
@ -1508,6 +1508,7 @@ for decoding and encoding files, process I/O, etc."
|
|||
:mime-charset 'us-ascii)
|
||||
|
||||
(define-coding-system-alias 'iso-safe 'us-ascii)
|
||||
(define-coding-system-alias 'ascii 'us-ascii)
|
||||
|
||||
(define-coding-system 'utf-7
|
||||
"UTF-7 encoding of Unicode (RFC 2152)."
|
||||
|
|
|
|||
|
|
@ -170,7 +170,6 @@
|
|||
(load "cus-face")
|
||||
(load "faces") ; after here, `defface' may be used.
|
||||
|
||||
(load "button")
|
||||
|
||||
;; We don't want to store loaddefs.el in the repository because it is
|
||||
;; a generated file; but it is required in order to compile the lisp files.
|
||||
|
|
@ -193,6 +192,7 @@
|
|||
definition-prefixes)
|
||||
(setq definition-prefixes new))
|
||||
|
||||
(load "button") ;After loaddefs, because of define-minor-mode!
|
||||
(load "emacs-lisp/nadvice")
|
||||
(load "emacs-lisp/cl-preloaded")
|
||||
(load "obarray") ;abbrev.el is implemented in terms of obarrays.
|
||||
|
|
|
|||
|
|
@ -157,7 +157,8 @@ lines."
|
|||
;; Hack: Don't do the flowing on the signature line.
|
||||
(when (and (not (looking-at "-- $"))
|
||||
(eq (char-before (line-end-position)) ?\s))
|
||||
(while (eq (char-before (line-end-position)) ?\s)
|
||||
(while (and (not (eobp))
|
||||
(eq (char-before (line-end-position)) ?\s))
|
||||
(end-of-line)
|
||||
(when delete-space
|
||||
(delete-char -1))
|
||||
|
|
|
|||
|
|
@ -269,7 +269,7 @@ TRUNCATED is non-nil if the text of this entity was truncated."
|
|||
(unless (y-or-n-p "This entity is truncated; save anyway? ")
|
||||
(error "Aborted")))
|
||||
(setq filename (expand-file-name
|
||||
(read-file-name (format-prompt "Save as" filename)
|
||||
(read-file-name (format "Save as (default: %s): " filename)
|
||||
directory
|
||||
(expand-file-name filename directory))
|
||||
directory))
|
||||
|
|
|
|||
|
|
@ -975,7 +975,7 @@ but lower priority than the local value of `buffer-file-coding-system'.
|
|||
See also the function `select-message-coding-system'.")
|
||||
|
||||
;;;###autoload
|
||||
(defvar default-sendmail-coding-system 'iso-latin-1
|
||||
(defvar default-sendmail-coding-system 'utf-8
|
||||
"Default coding system for encoding the outgoing mail.
|
||||
This variable is used only when `sendmail-coding-system' is nil.
|
||||
|
||||
|
|
|
|||
|
|
@ -536,6 +536,12 @@
|
|||
(if (featurep 'ns)
|
||||
(bindings--define-key menu [separator-undo] menu-bar-separator))
|
||||
|
||||
(bindings--define-key menu [undo-redo]
|
||||
'(menu-item "Redo" undo-redo
|
||||
:enable (and (not buffer-read-only)
|
||||
(undo--last-change-was-undo-p buffer-undo-list))
|
||||
:help "Redo last undone edits"))
|
||||
|
||||
(bindings--define-key menu [undo]
|
||||
'(menu-item "Undo" undo
|
||||
:enable (and (not buffer-read-only)
|
||||
|
|
@ -543,7 +549,7 @@
|
|||
(if (eq last-command 'undo)
|
||||
(listp pending-undo-list)
|
||||
(consp buffer-undo-list)))
|
||||
:help "Undo last operation"))
|
||||
:help "Undo last edits"))
|
||||
|
||||
menu))
|
||||
|
||||
|
|
|
|||
|
|
@ -305,6 +305,7 @@ message and scan line."
|
|||
(let ((draft-buffer (current-buffer))
|
||||
(file-name buffer-file-name)
|
||||
(config mh-previous-window-config)
|
||||
;; FIXME this is subtly different to select-message-coding-system.
|
||||
(coding-system-for-write
|
||||
(if (fboundp 'select-message-coding-system)
|
||||
(select-message-coding-system) ; Emacs has this since at least 21.1
|
||||
|
|
@ -318,7 +319,7 @@ message and scan line."
|
|||
(or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
|
||||
(and (default-boundp 'buffer-file-coding-system)
|
||||
(default-value 'buffer-file-coding-system))
|
||||
'iso-latin-1)))))
|
||||
'utf-8)))))
|
||||
;; Older versions of spost do not support -msgid and -mime.
|
||||
(unless mh-send-uses-spost-flag
|
||||
;; Adding a Message-ID field looks good, makes it easier to search for
|
||||
|
|
|
|||
|
|
@ -48,7 +48,7 @@
|
|||
(regexp-quote (substring minibuffer-default-prompt-format
|
||||
(match-end 0))))
|
||||
(regexp-quote minibuffer-default-prompt-format))
|
||||
": *\\)")
|
||||
"\\): ")
|
||||
1)
|
||||
`(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'"
|
||||
1 ,(if minibuffer-eldef-shorten-default " [\\2]"))
|
||||
|
|
|
|||
|
|
@ -316,10 +316,9 @@ Every next/previous file in the defined sequence is visited by
|
|||
(defun multi-isearch-read-files ()
|
||||
"Return a list of files specified interactively, one by one."
|
||||
;; Most code from `multi-occur'.
|
||||
(let* ((files (list (read-file-name
|
||||
(format-prompt "First file to search: "
|
||||
(file-name-nondirectory buffer-file-name))
|
||||
default-directory buffer-file-name)))
|
||||
(let* ((files (list (read-file-name "First file to search: "
|
||||
default-directory
|
||||
buffer-file-name)))
|
||||
(file nil))
|
||||
(while (not (string-equal
|
||||
(setq file (read-file-name
|
||||
|
|
|
|||
198
lisp/net/dbus.el
198
lisp/net/dbus.el
|
|
@ -55,6 +55,9 @@
|
|||
|
||||
;;; D-Bus constants.
|
||||
|
||||
(defconst dbus-compound-types '(:array :variant :struct :dict-entry)
|
||||
"D-Bus compound types, represented as list.")
|
||||
|
||||
(defconst dbus-service-dbus "org.freedesktop.DBus"
|
||||
"The bus name used to talk to the bus itself.")
|
||||
|
||||
|
|
@ -151,6 +154,17 @@ See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#standard-inter
|
|||
|
||||
;;; Default D-Bus errors.
|
||||
|
||||
(defgroup dbus nil
|
||||
"Elisp bindings for D-Bus."
|
||||
:group 'comm
|
||||
:link '(custom-manual "(dbus)Top")
|
||||
:version "28.1")
|
||||
|
||||
(defcustom dbus-show-dbus-errors nil
|
||||
"Propagate incoming D-Bus error messages."
|
||||
:version "28.1"
|
||||
:type 'boolean)
|
||||
|
||||
(defconst dbus-error-dbus "org.freedesktop.DBus.Error"
|
||||
"The namespace for default error names.
|
||||
See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
|
||||
|
|
@ -164,6 +178,9 @@ See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
|
|||
(defconst dbus-error-invalid-args (concat dbus-error-dbus ".InvalidArgs")
|
||||
"Invalid arguments passed to a method call.")
|
||||
|
||||
(defconst dbus-error-no-reply (concat dbus-error-dbus ".NoReply")
|
||||
"No reply to a message expecting one, usually means a timeout occurred.")
|
||||
|
||||
(defconst dbus-error-property-read-only
|
||||
(concat dbus-error-dbus ".PropertyReadOnly")
|
||||
"Property you tried to set is read-only.")
|
||||
|
|
@ -183,6 +200,7 @@ See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
|
|||
|
||||
|
||||
;;; Emacs defaults.
|
||||
|
||||
(defconst dbus-service-emacs "org.gnu.Emacs"
|
||||
"The well known service name of Emacs.")
|
||||
|
||||
|
|
@ -199,11 +217,17 @@ shall be subdirectories of this path.")
|
|||
|
||||
(defmacro dbus-ignore-errors (&rest body)
|
||||
"Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
|
||||
Otherwise, return result of last form in BODY, or all other errors."
|
||||
Signals also D-Bus error when `dbus-show-dbus-errors' is non-nil
|
||||
and a D-Bus error message has arrived. Otherwise, return result
|
||||
of last form in BODY, or all other errors."
|
||||
(declare (indent 0) (debug t))
|
||||
`(condition-case err
|
||||
(progn ,@body)
|
||||
(dbus-error (when dbus-debug (signal (car err) (cdr err))))))
|
||||
(dbus-error
|
||||
(when (or dbus-debug
|
||||
(and dbus-show-dbus-errors
|
||||
(= dbus-message-type-error (nth 2 last-input-event))))
|
||||
(signal (car err) (cdr err))))))
|
||||
|
||||
(defvar dbus-event-error-functions '(dbus-notice-synchronous-call-errors)
|
||||
"Functions to be called when a D-Bus error happens in the event handler.
|
||||
|
|
@ -348,23 +372,24 @@ object is returned instead of a list containing this single Lisp object.
|
|||
|
||||
(puthash key result dbus-return-values-table)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(with-timeout ((if timeout (/ timeout 1000.0) 25)
|
||||
(signal 'dbus-error (list "call timed out")))
|
||||
(while (eq (car result) :pending)
|
||||
(let ((event (let ((inhibit-redisplay t) unread-command-events)
|
||||
(read-event nil nil check-interval))))
|
||||
(when event
|
||||
(if (ignore-errors (dbus-check-event event))
|
||||
(setf result (gethash key dbus-return-values-table))
|
||||
(setf unread-command-events
|
||||
(nconc unread-command-events
|
||||
(cons event nil)))))
|
||||
(when (< check-interval 1)
|
||||
(setf check-interval (* check-interval 1.05))))))
|
||||
(when (eq (car result) :error)
|
||||
(signal (cadr result) (cddr result)))
|
||||
(cdr result))
|
||||
(progn
|
||||
(with-timeout
|
||||
((if timeout (/ timeout 1000.0) 25)
|
||||
(signal 'dbus-error `(,dbus-error-no-reply "Call timed out")))
|
||||
(while (eq (car result) :pending)
|
||||
(let ((event (let ((inhibit-redisplay t) unread-command-events)
|
||||
(read-event nil nil check-interval))))
|
||||
(when event
|
||||
(if (ignore-errors (dbus-check-event event))
|
||||
(setf result (gethash key dbus-return-values-table))
|
||||
(setf unread-command-events
|
||||
(nconc unread-command-events
|
||||
(cons event nil)))))
|
||||
(when (< check-interval 1)
|
||||
(setf check-interval (* check-interval 1.05))))))
|
||||
(when (eq (car result) :error)
|
||||
(signal (cadr result) (cddr result)))
|
||||
(cdr result))
|
||||
(remhash key dbus-return-values-table))))
|
||||
|
||||
(defun dbus-call-method-asynchronously
|
||||
|
|
@ -409,7 +434,7 @@ Example:
|
|||
|
||||
\(dbus-call-method-asynchronously
|
||||
:system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
|
||||
\"org.freedesktop.Hal.Device\" \"GetPropertyString\" \\='message
|
||||
\"org.freedesktop.Hal.Device\" \"GetPropertyString\" #\\='message
|
||||
\"system.kernel.machine\")
|
||||
|
||||
-| i686
|
||||
|
|
@ -689,7 +714,7 @@ Example:
|
|||
|
||||
\(dbus-register-signal
|
||||
:system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\"
|
||||
\"org.freedesktop.Hal.Manager\" \"DeviceAdded\" \\='my-signal-handler)
|
||||
\"org.freedesktop.Hal.Manager\" \"DeviceAdded\" #\\='my-signal-handler)
|
||||
|
||||
=> ((:signal :system \"org.freedesktop.Hal.Manager\" \"DeviceAdded\")
|
||||
(\"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\" my-signal-handler))
|
||||
|
|
@ -901,16 +926,19 @@ association to the service from D-Bus."
|
|||
(progn
|
||||
(maphash
|
||||
(lambda (k v)
|
||||
(dolist (e v)
|
||||
(ignore-errors
|
||||
(and
|
||||
;; Bus.
|
||||
(equal bus (cadr k))
|
||||
;; Service.
|
||||
(string-equal service (cadr e))
|
||||
;; Non-empty object path.
|
||||
(nth 2 e)
|
||||
(throw :found t)))))
|
||||
(when (consp v)
|
||||
(dolist (e v)
|
||||
(ignore-errors
|
||||
(and
|
||||
;; Type.
|
||||
(eq type (car k))
|
||||
;; Bus.
|
||||
(equal bus (cadr k))
|
||||
;; Service.
|
||||
(string-equal service (cadr e))
|
||||
;; Non-empty object path.
|
||||
(nth 2 e)
|
||||
(throw :found t))))))
|
||||
dbus-registered-objects-table)
|
||||
nil))))
|
||||
(dbus-unregister-service bus service))
|
||||
|
|
@ -1454,20 +1482,19 @@ valid D-Bus value, or nil if there is no PROPERTY, or PROPERTY cannot be read."
|
|||
(defun dbus-set-property (bus service path interface property &rest args)
|
||||
"Set value of PROPERTY of INTERFACE to VALUE.
|
||||
It will be checked at BUS, SERVICE, PATH. VALUE can be preceded
|
||||
by a TYPE symbol. When the value is successfully set return
|
||||
VALUE. Otherwise, return nil.
|
||||
by a TYPE symbol. When the value is successfully set, and the
|
||||
property's access type is not `:write', return VALUE. Otherwise,
|
||||
return nil.
|
||||
|
||||
\(dbus-set-property BUS SERVICE PATH INTERFACE PROPERTY [TYPE] VALUE)"
|
||||
(dbus-ignore-errors
|
||||
;; "Set" requires a variant.
|
||||
(dbus-call-method
|
||||
bus service path dbus-interface-properties
|
||||
"Set" :timeout 500 interface property (cons :variant args))
|
||||
;; Return VALUE. The property could have the `:write' access type,
|
||||
;; so we ignore errors in `dbus-get-property'.
|
||||
(dbus-ignore-errors
|
||||
(or (dbus-get-property bus service path interface property)
|
||||
(if (symbolp (car args)) (cadr args) (car args))))))
|
||||
"Set" :timeout 500 interface property (list :variant args))
|
||||
;; Return VALUE.
|
||||
(or (dbus-get-property bus service path interface property)
|
||||
(if (symbolp (car args)) (cadr args) (car args)))))
|
||||
|
||||
(defun dbus-get-all-properties (bus service path interface)
|
||||
"Return all properties of INTERFACE at BUS, SERVICE, PATH.
|
||||
|
|
@ -1543,13 +1570,15 @@ clients from discovering the still incomplete interface.
|
|||
|
||||
\(dbus-register-property BUS SERVICE PATH INTERFACE PROPERTY ACCESS \
|
||||
[TYPE] VALUE &optional EMITS-SIGNAL DONT-REGISTER-SERVICE)"
|
||||
(let ((type (when (symbolp (car args)) (pop args)))
|
||||
(let ((signature "s") ;; FIXME: For the time being.
|
||||
;; Read basic type symbol.
|
||||
(type (when (symbolp (car args)) (pop args)))
|
||||
(value (pop args))
|
||||
(emits-signal (pop args))
|
||||
(dont-register-service (pop args)))
|
||||
(unless (member access '(:read :write :readwrite))
|
||||
(signal 'wrong-type-argument (list "Access type invalid" access)))
|
||||
(unless type
|
||||
(unless (or type (consp value))
|
||||
(setq type
|
||||
(cond
|
||||
((memq value '(t nil)) :boolean)
|
||||
|
|
@ -1559,6 +1588,8 @@ clients from discovering the still incomplete interface.
|
|||
((stringp value) :string)
|
||||
(t
|
||||
(signal 'wrong-type-argument (list "Value type invalid" value))))))
|
||||
(unless (consp value)
|
||||
(setq value (list type value)))
|
||||
|
||||
;; Add handlers for the three property-related methods.
|
||||
(dbus-register-method
|
||||
|
|
@ -1579,12 +1610,14 @@ clients from discovering the still incomplete interface.
|
|||
(when emits-signal
|
||||
(dbus-send-signal
|
||||
bus service path dbus-interface-properties "PropertiesChanged"
|
||||
(if (member access '(:read :readwrite))
|
||||
`(:array
|
||||
(:dict-entry
|
||||
,property
|
||||
,(if type (list :variant type value) (list :variant value))))
|
||||
'(:array: :signature "{sv}"))
|
||||
;; changed_properties.
|
||||
(if (eq access :write)
|
||||
'(:array: :signature "{sv}")
|
||||
`(:array
|
||||
(:dict-entry
|
||||
,property
|
||||
,(if type (list :variant type value) (list :variant value)))))
|
||||
;; invalidated_properties.
|
||||
(if (eq access :write)
|
||||
`(:array ,property)
|
||||
'(:array))))
|
||||
|
|
@ -1595,10 +1628,7 @@ clients from discovering the still incomplete interface.
|
|||
(val
|
||||
(cons
|
||||
(list
|
||||
nil service path
|
||||
(cons
|
||||
(if emits-signal (list access :emits-signal) (list access))
|
||||
(if type (list type value) (list value))))
|
||||
nil service path (list access emits-signal signature value))
|
||||
(dbus-get-other-registered-properties
|
||||
bus service path interface property))))
|
||||
(puthash key val dbus-registered-objects-table)
|
||||
|
|
@ -1626,16 +1656,19 @@ It will be registered for all objects created by `dbus-register-property'."
|
|||
`(:error ,dbus-error-unknown-property
|
||||
,(format-message
|
||||
"No such property \"%s\" at path \"%s\"" property path)))
|
||||
((memq :write (car object))
|
||||
((eq :write (car object))
|
||||
`(:error ,dbus-error-access-denied
|
||||
,(format-message
|
||||
"Property \"%s\" at path \"%s\" is not readable" property path)))
|
||||
;; Return the result.
|
||||
(t (list :variant (cdar (last (car entry))))))))
|
||||
;; Return the result. Since variant is a list, we must embed
|
||||
;; it into another list.
|
||||
(t (list (if (memq (car (nth 3 object)) dbus-compound-types)
|
||||
(list :variant (nth 3 object))
|
||||
(cons :variant (nth 3 object))))))))
|
||||
|
||||
;; "Set" expects a variant.
|
||||
;; "Set" expects the same type as registered. FIXME: Implement!
|
||||
((string-equal method "Set")
|
||||
(let* ((value (caar (cddr args)))
|
||||
(let* ((value (caar (nth 2 args)))
|
||||
(entry (dbus-get-this-registered-property
|
||||
bus service path interface property))
|
||||
(object (car (last (car entry)))))
|
||||
|
|
@ -1644,27 +1677,30 @@ It will be registered for all objects created by `dbus-register-property'."
|
|||
`(:error ,dbus-error-unknown-property
|
||||
,(format-message
|
||||
"No such property \"%s\" at path \"%s\"" property path)))
|
||||
((memq :read (car object))
|
||||
((eq :read (car object))
|
||||
`(:error ,dbus-error-property-read-only
|
||||
,(format-message
|
||||
"Property \"%s\" at path \"%s\" is not writable" property path)))
|
||||
(t (puthash (list :property bus interface property)
|
||||
(t (unless (consp value)
|
||||
(setq value (list (car (nth 3 object)) value)))
|
||||
(puthash (list :property bus interface property)
|
||||
(cons (append
|
||||
(butlast (car entry))
|
||||
;; Reuse ACCESS und TYPE from registration.
|
||||
(list (list (car object) (cadr object) value)))
|
||||
;; Reuse ACCESS, EMITS-SIGNAL and TYPE.
|
||||
(list (append (butlast object) (list value))))
|
||||
(dbus-get-other-registered-properties
|
||||
bus service path interface property))
|
||||
dbus-registered-objects-table)
|
||||
;; Send the "PropertiesChanged" signal.
|
||||
(when (member :emits-signal (car object))
|
||||
(when (nth 1 object)
|
||||
(dbus-send-signal
|
||||
bus service path dbus-interface-properties "PropertiesChanged"
|
||||
(if (or (member :read (car object))
|
||||
(member :readwrite (car object)))
|
||||
`(:array (:dict-entry ,property (:variant ,value)))
|
||||
'(:array: :signature "{sv}"))
|
||||
(if (eq (car object) :write)
|
||||
;; changed_properties.
|
||||
(if (eq :write (car object))
|
||||
'(:array: :signature "{sv}")
|
||||
`(:array (:dict-entry ,property (:variant ,value))))
|
||||
;; invalidated_properties.
|
||||
(if (eq :write (car object))
|
||||
`(:array ,property)
|
||||
'(:array))))
|
||||
;; Return empty reply.
|
||||
|
|
@ -1677,18 +1713,22 @@ It will be registered for all objects created by `dbus-register-property'."
|
|||
(lambda (key val)
|
||||
(when (consp val)
|
||||
(dolist (item val)
|
||||
(when (and (equal (butlast key) (list :property bus interface))
|
||||
(string-equal path (nth 2 item))
|
||||
(consp (car (last item)))
|
||||
(not (memq :write (caar (last item)))))
|
||||
(push
|
||||
(list :dict-entry
|
||||
(car (last key))
|
||||
(cons :variant (cdar (last item))))
|
||||
result)))))
|
||||
(let ((object (car (last item))))
|
||||
(when (and (equal (butlast key) (list :property bus interface))
|
||||
(string-equal path (nth 2 item))
|
||||
(consp object)
|
||||
(not (eq :write (car object))))
|
||||
(push
|
||||
(list :dict-entry
|
||||
(car (last key))
|
||||
(if (memq (car (nth 3 object)) dbus-compound-types)
|
||||
(list :variant (nth 3 object))
|
||||
(cons :variant (nth 3 object))))
|
||||
result))))))
|
||||
dbus-registered-objects-table)
|
||||
;; Return the result, or an empty array.
|
||||
(list :array (or result '(:signature "{sv}")))))
|
||||
;; Return the result, or an empty array. An array must be
|
||||
;; embedded in a list.
|
||||
(list (cons :array (or result '(:signature "{sv}"))))))
|
||||
|
||||
(t `(:error ,dbus-error-unknown-method
|
||||
,(format-message
|
||||
|
|
@ -1896,9 +1936,13 @@ this connection to those buses."
|
|||
|
||||
;;; TODO:
|
||||
|
||||
;; * Check property type in org.freedesktop.DBus.Properties.Set.
|
||||
;;
|
||||
;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and
|
||||
;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved.
|
||||
;;
|
||||
;; * Implement org.freedesktop.DBus.Monitoring.BecomeMonitor.
|
||||
;;
|
||||
;; * Cache introspection data.
|
||||
;;
|
||||
;; * Run handlers in own threads.
|
||||
|
|
|
|||
|
|
@ -134,6 +134,15 @@ The string will be passed through `substitute-command-keys'."
|
|||
:type '(choice (const :tag "Unlimited" nil)
|
||||
integer))
|
||||
|
||||
(defcustom eww-retrieve-command nil
|
||||
"Command to retrieve an URL via an external program.
|
||||
If nil, `url-retrieve' is used to download the data. If non-nil,
|
||||
this should be a list where the first item is the program, and
|
||||
the rest are the arguments."
|
||||
:version "28.1"
|
||||
:type '(choice (const :tag "Use `url-retrieve'" nil)
|
||||
(list string)))
|
||||
|
||||
(defcustom eww-use-external-browser-for-content-type
|
||||
"\\`\\(video/\\|audio/\\|application/ogg\\)"
|
||||
"Always use external browser for specified content-type."
|
||||
|
|
@ -346,9 +355,34 @@ killed after rendering."
|
|||
(let ((eww-buffer (current-buffer)))
|
||||
(with-current-buffer buffer
|
||||
(eww-render nil url nil eww-buffer)))
|
||||
(url-retrieve url #'eww-render
|
||||
(eww-retrieve url #'eww-render
|
||||
(list url nil (current-buffer))))))
|
||||
|
||||
(defun eww-retrieve (url callback cbargs)
|
||||
(if (null eww-retrieve-command)
|
||||
(url-retrieve url #'eww-render
|
||||
(list url nil (current-buffer)))
|
||||
(let ((buffer (generate-new-buffer " *eww retrieve*"))
|
||||
(error-buffer (generate-new-buffer " *eww error*")))
|
||||
(with-current-buffer buffer
|
||||
(set-buffer-multibyte nil)
|
||||
(make-process
|
||||
:name "*eww fetch*"
|
||||
:buffer (current-buffer)
|
||||
:stderr error-buffer
|
||||
:command (append eww-retrieve-command (list url))
|
||||
:sentinel (lambda (process _)
|
||||
(unless (process-live-p process)
|
||||
(when (buffer-live-p error-buffer)
|
||||
(when (get-buffer-process error-buffer)
|
||||
(delete-process (get-buffer-process error-buffer) ))
|
||||
(kill-buffer error-buffer))
|
||||
(when (buffer-live-p buffer)
|
||||
(with-current-buffer buffer
|
||||
(goto-char (point-min))
|
||||
(insert "Content-type: text/html; charset=utf-8\n\n")
|
||||
(apply #'funcall callback nil cbargs))))))))))
|
||||
|
||||
(function-put 'eww 'browse-url-browser-kind 'internal)
|
||||
|
||||
(defun eww--dwim-expand-url (url)
|
||||
|
|
@ -695,14 +729,15 @@ Currently this means either text/html or application/xhtml+xml."
|
|||
(defun eww-update-header-line-format ()
|
||||
(setq header-line-format
|
||||
(and eww-header-line-format
|
||||
(let ((title (propertize (plist-get eww-data :title)
|
||||
'face 'variable-pitch))
|
||||
(peer (plist-get eww-data :peer))
|
||||
(let ((peer (plist-get eww-data :peer))
|
||||
(url (propertize (plist-get eww-data :url)
|
||||
'face 'variable-pitch)))
|
||||
(when (zerop (length title))
|
||||
(setq title (propertize "[untitled]" 'face 'variable-pitch)))
|
||||
;; This connection has is https.
|
||||
'face 'variable-pitch))
|
||||
(title (propertize
|
||||
(if (zerop (length (plist-get eww-data :title)))
|
||||
"[untitled]"
|
||||
(plist-get eww-data :title))
|
||||
'face 'variable-pitch)))
|
||||
;; This connection is https.
|
||||
(when peer
|
||||
(add-face-text-property 0 (length title)
|
||||
(if (plist-get peer :warnings)
|
||||
|
|
@ -1117,7 +1152,7 @@ just re-display the HTML already fetched."
|
|||
(eww-display-html 'utf-8 url (plist-get eww-data :dom)
|
||||
(point) (current-buffer)))
|
||||
(let ((url-mime-accept-string eww-accept-content-types))
|
||||
(url-retrieve url #'eww-render
|
||||
(eww-retrieve url #'eww-render
|
||||
(list url (point) (current-buffer) encode))))))
|
||||
|
||||
;; Form support.
|
||||
|
|
|
|||
|
|
@ -1133,11 +1133,15 @@ For instance, \"foo.png\" will result in \"image/png\"."
|
|||
`mailcap--computed-mime-data' determines the method to use."
|
||||
(let ((method (mailcap-mime-info type)))
|
||||
(if (stringp method)
|
||||
(shell-command-on-region (point-min) (point-max)
|
||||
;; Use stdin as the "%s".
|
||||
(format method "-")
|
||||
(current-buffer)
|
||||
t)
|
||||
(let ((file (make-temp-file "emacs-mailcap" nil
|
||||
(cadr (split-string type "/")))))
|
||||
(unwind-protect
|
||||
(let ((coding-system-for-write 'binary))
|
||||
(write-region (point-min) (point-max) file nil 'silent)
|
||||
(delete-region (point-min) (point-max))
|
||||
(shell-command (format method file)))
|
||||
(when (file-exists-p file)
|
||||
(delete-file file))))
|
||||
(funcall method))))
|
||||
|
||||
(provide 'mailcap)
|
||||
|
|
|
|||
|
|
@ -431,6 +431,8 @@ of `minibuffer-completion-table' and the minibuffer contents.")
|
|||
(let ((result (try-completion string alist predicate)))
|
||||
(if (eq result t) string result)))
|
||||
|
||||
(defvar completion-base-size)
|
||||
|
||||
;; TODO document MODE magic...
|
||||
(defun PC-do-completion (&optional mode beg end goto-end)
|
||||
"Internal function to do the work of partial completion.
|
||||
|
|
|
|||
|
|
@ -434,6 +434,15 @@ to it is returned. This function does not modify the point or the mark."
|
|||
(setq count (+ count (skip-chars-backward "\\\\"))))
|
||||
(not (zerop (logand count 1))))))
|
||||
|
||||
(defmacro c-will-be-unescaped (beg end)
|
||||
;; Would the character after END be unescaped after the removal of (BEG END)?
|
||||
;; This is regardless of its current status. It is assumed that (>= POS END).
|
||||
`(save-excursion
|
||||
(let (count)
|
||||
(goto-char ,beg)
|
||||
(setq count (skip-chars-backward "\\\\"))
|
||||
(zerop (logand count 1)))))
|
||||
|
||||
(defvar c-use-extents)
|
||||
|
||||
(defmacro c-next-single-property-change (position prop &optional object limit)
|
||||
|
|
|
|||
|
|
@ -2238,7 +2238,7 @@ comment at the start of cc-engine.el for more info."
|
|||
|
||||
((and c-opt-cpp-prefix
|
||||
(looking-at c-noise-macro-name-re))
|
||||
;; Skip over a noise macro.
|
||||
;; Skip over a noise macro without parens.
|
||||
(goto-char (match-end 1))
|
||||
(not (eobp)))
|
||||
|
||||
|
|
@ -9130,6 +9130,12 @@ This function might do hidden buffer changes."
|
|||
(catch 'is-function
|
||||
(while
|
||||
(progn
|
||||
(while
|
||||
(cond
|
||||
((looking-at c-decl-hangon-key)
|
||||
(c-forward-keyword-clause 1))
|
||||
((looking-at c-noise-macro-with-parens-name-re)
|
||||
(c-forward-noise-clause))))
|
||||
(if (eq (char-after) ?\))
|
||||
(throw 'is-function t))
|
||||
(setq cdd-got-type (c-forward-type))
|
||||
|
|
@ -9782,6 +9788,16 @@ This function might do hidden buffer changes."
|
|||
(save-excursion
|
||||
(goto-char after-paren-pos)
|
||||
(c-forward-syntactic-ws)
|
||||
(progn
|
||||
(while
|
||||
(cond
|
||||
((and
|
||||
c-opt-cpp-prefix
|
||||
(looking-at c-noise-macro-with-parens-name-re))
|
||||
(c-forward-noise-clause))
|
||||
((looking-at c-decl-hangon-key)
|
||||
(c-forward-keyword-clause 1))))
|
||||
t)
|
||||
(or (c-forward-type)
|
||||
;; Recognize a top-level typeless
|
||||
;; function declaration in C.
|
||||
|
|
|
|||
|
|
@ -1478,9 +1478,11 @@ Note that the style variables are always made local to the buffer."
|
|||
(c-will-be-escaped end beg end))
|
||||
(c-remove-string-fences end)
|
||||
(goto-char (1+ end)))
|
||||
;; Are we unescaping a newline by inserting stuff between \ and \n?
|
||||
((and (eq end beg)
|
||||
(c-is-escaped end))
|
||||
;; Are we unescaping a newline ...
|
||||
((and
|
||||
(c-is-escaped end)
|
||||
(or (eq beg end) ; .... by inserting stuff between \ and \n?
|
||||
(c-will-be-unescaped beg end))) ; ... by removing an odd number of \s?
|
||||
(goto-char (1+ end))) ; To after the NL which is being unescaped.
|
||||
(t
|
||||
(goto-char end)))
|
||||
|
|
@ -1518,10 +1520,11 @@ Note that the style variables are always made local to the buffer."
|
|||
(not (c-characterp c-multiline-string-start-char))))
|
||||
(when (and (eq end-literal-type 'string)
|
||||
(not (eq (char-before (cdr end-limits)) ?\())
|
||||
(memq (char-after (car end-limits)) c-string-delims)
|
||||
(equal (c-get-char-property (car end-limits) 'syntax-table)
|
||||
'(15)))
|
||||
(c-remove-string-fences (car end-limits))
|
||||
(memq (char-after (car end-limits)) c-string-delims))
|
||||
(setq c-new-END (max c-new-END (cdr end-limits)))
|
||||
(when (equal (c-get-char-property (car end-limits) 'syntax-table)
|
||||
'(15))
|
||||
(c-remove-string-fences (car end-limits)))
|
||||
(setq c-new-END (max c-new-END (cdr end-limits))))
|
||||
|
||||
(when (and (eq beg-literal-type 'string)
|
||||
|
|
@ -1594,8 +1597,12 @@ Note that the style variables are always made local to the buffer."
|
|||
; insertion/deletion of string delimiters.
|
||||
(max
|
||||
(progn
|
||||
(goto-char (min (1+ end) ; 1+, in case a NL has become escaped.
|
||||
(point-max)))
|
||||
(goto-char
|
||||
(if (and (memq (char-after end) '(?\n ?\r))
|
||||
(c-is-escaped end))
|
||||
(min (1+ end) ; 1+, if we're inside an escaped NL.
|
||||
(point-max))
|
||||
end))
|
||||
(re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*"
|
||||
nil t)
|
||||
(point))
|
||||
|
|
@ -2259,7 +2266,8 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
|
|||
(defun c-fl-decl-end (pos)
|
||||
;; If POS is inside a declarator, return the end of the token that follows
|
||||
;; the declarator, otherwise return nil. POS being in a literal does not
|
||||
;; count as being in a declarator (on pragmatic grounds).
|
||||
;; count as being in a declarator (on pragmatic grounds). POINT is not
|
||||
;; preserved.
|
||||
(goto-char pos)
|
||||
(let ((lit-start (c-literal-start))
|
||||
enclosing-attribute pos1)
|
||||
|
|
@ -2272,12 +2280,31 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
|
|||
(let ((lim (save-excursion
|
||||
(and (c-beginning-of-macro)
|
||||
(progn (c-end-of-macro) (point))))))
|
||||
(when (and (c-forward-declarator lim)
|
||||
(or (not (eq (char-after) ?\())
|
||||
(c-go-list-forward nil lim))
|
||||
(eq (c-forward-token-2 1 nil lim) 0))
|
||||
(c-backward-syntactic-ws)
|
||||
(point)))))))
|
||||
(and (c-forward-declarator lim)
|
||||
(if (eq (char-after) ?\()
|
||||
(and
|
||||
(c-go-list-forward nil lim)
|
||||
(progn (c-forward-syntactic-ws lim)
|
||||
(not (eobp)))
|
||||
(progn
|
||||
(if (looking-at c-symbol-char-key)
|
||||
;; Deal with baz (foo((bar)) type var), where
|
||||
;; foo((bar)) is not semantically valid. The result
|
||||
;; must be after var).
|
||||
(and
|
||||
(goto-char pos)
|
||||
(setq pos1 (c-on-identifier))
|
||||
(goto-char pos1)
|
||||
(progn
|
||||
(c-backward-syntactic-ws)
|
||||
(eq (char-before) ?\())
|
||||
(c-fl-decl-end (1- (point))))
|
||||
(c-backward-syntactic-ws)
|
||||
(point))))
|
||||
(and (progn (c-forward-syntactic-ws lim)
|
||||
(not (eobp)))
|
||||
(c-backward-syntactic-ws)
|
||||
(point)))))))))
|
||||
|
||||
(defun c-change-expand-fl-region (_beg _end _old-len)
|
||||
;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock
|
||||
|
|
|
|||
|
|
@ -1670,7 +1670,8 @@ indented as a statement."
|
|||
like \"INLINE\" which are syntactic noise. Such a macro/extension is complete
|
||||
in itself, never having parentheses. All these names must be syntactically
|
||||
valid identifiers. Alternatively, this variable may be a regular expression
|
||||
which matches the names of such macros.
|
||||
which matches the names of such macros, in which case it must have a submatch
|
||||
1 which matches the actual noise macro name.
|
||||
|
||||
If you change this variable's value, call the function
|
||||
`c-make-noise-macro-regexps' to set the necessary internal variables (or do
|
||||
|
|
@ -1686,7 +1687,8 @@ this implicitly by reinitializing C/C++/Objc Mode on any buffer)."
|
|||
which optionally have arguments in parentheses, and which expand to nothing.
|
||||
All these names must be syntactically valid identifiers. These are recognized
|
||||
by CC Mode only in declarations. Alternatively, this variable may be a
|
||||
regular expression which matches the names of such macros.
|
||||
regular expression which matches the names of such macros, in which case it
|
||||
must have a submatch 1 which matches the actual noise macro name.
|
||||
|
||||
If you change this variable's value, call the function
|
||||
`c-make-noise-macro-regexps' to set the necessary internal variables (or do
|
||||
|
|
|
|||
|
|
@ -277,6 +277,7 @@
|
|||
(define-minor-mode cl-font-lock-built-in-mode
|
||||
"Highlight built-in functions, variables, and types in `lisp-mode'."
|
||||
:global t
|
||||
:group 'tools
|
||||
(funcall
|
||||
(if cl-font-lock-built-in-mode
|
||||
#'font-lock-add-keywords
|
||||
|
|
|
|||
|
|
@ -292,7 +292,7 @@ file the tag was in."
|
|||
(or (locate-dominating-file default-directory "TAGS")
|
||||
default-directory)))
|
||||
(list (read-file-name
|
||||
(format-prompt "Visit tags table" "TAGS")
|
||||
"Visit tags table (default TAGS): "
|
||||
;; default to TAGS from default-directory up to root.
|
||||
default-tag-dir
|
||||
(expand-file-name "TAGS" default-tag-dir)
|
||||
|
|
@ -625,7 +625,7 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
|
|||
(car list))
|
||||
;; Finally, prompt the user for a file name.
|
||||
(expand-file-name
|
||||
(read-file-name (format-prompt "Visit tags table" "TAGS")
|
||||
(read-file-name "Visit tags table (default TAGS): "
|
||||
default-directory
|
||||
"TAGS"
|
||||
t))))))
|
||||
|
|
|
|||
|
|
@ -1881,22 +1881,20 @@ to get different commands to edit and resubmit."
|
|||
'(metadata
|
||||
(annotation-function . read-extended-command--annotation)
|
||||
(category . command))
|
||||
(let ((pred
|
||||
(if (memq action '(nil t))
|
||||
;; Exclude obsolete commands from completions.
|
||||
(lambda (sym)
|
||||
(and (funcall pred sym)
|
||||
(or (equal string (symbol-name sym))
|
||||
(not (get sym 'byte-obsolete-info)))))
|
||||
pred)))
|
||||
(complete-with-action action obarray string pred))))
|
||||
(complete-with-action action obarray string pred)))
|
||||
#'commandp t nil 'extended-command-history)))
|
||||
|
||||
(defun read-extended-command--annotation (command-name)
|
||||
(let* ((function (and (stringp command-name) (intern-soft command-name)))
|
||||
(binding (where-is-internal function overriding-local-map t)))
|
||||
(when (and binding (not (stringp binding)))
|
||||
(format " (%s)" (key-description binding)))))
|
||||
(let* ((fun (and (stringp command-name) (intern-soft command-name)))
|
||||
(binding (where-is-internal fun overriding-local-map t))
|
||||
(obsolete (get fun 'byte-obsolete-info))
|
||||
(alias (symbol-function fun)))
|
||||
(cond ((symbolp alias)
|
||||
(format " (%s)" alias))
|
||||
(obsolete
|
||||
(format " (%s)" (car obsolete)))
|
||||
((and binding (not (stringp binding)))
|
||||
(format " (%s)" (key-description binding))))))
|
||||
|
||||
(defcustom suggest-key-bindings t
|
||||
"Non-nil means show the equivalent key-binding when M-x command has one.
|
||||
|
|
@ -2752,7 +2750,8 @@ Contrary to `undo', this will not redo a previous undo."
|
|||
(let ((undo-no-redo t)) (undo arg)))
|
||||
|
||||
(defun undo-redo (&optional arg)
|
||||
"Undo the last ARG undos."
|
||||
"Undo the last ARG undos, i.e., redo the last ARG changes.
|
||||
Interactively, ARG is the prefix numeric argument and defaults to 1."
|
||||
(interactive "*p")
|
||||
(cond
|
||||
((not (undo--last-change-was-undo-p buffer-undo-list))
|
||||
|
|
|
|||
|
|
@ -646,7 +646,8 @@ using the `previous-buffer' command."
|
|||
"Enable cycling tab switch.
|
||||
If non-nil, `tab-line-switch-to-prev-tab' in the first tab
|
||||
switches to the last tab and `tab-line-switch-to-next-tab' in the
|
||||
last tab switches to the first tab."
|
||||
last tab switches to the first tab. This variable is not consulted
|
||||
when `tab-line-tabs-function' is `tab-line-tabs-window-buffers'."
|
||||
:type 'boolean
|
||||
:group 'tab-line
|
||||
:version "28.1")
|
||||
|
|
|
|||
|
|
@ -115,8 +115,6 @@
|
|||
|
||||
;;; Requirements:
|
||||
|
||||
;; Artist requires Emacs 19.28 or higher.
|
||||
;;
|
||||
;; Artist requires the `rect' package (which comes with Emacs) to be
|
||||
;; loadable, unless the variable `artist-interface-with-rect' is set
|
||||
;; to nil.
|
||||
|
|
@ -127,9 +125,6 @@
|
|||
|
||||
;;; Known bugs:
|
||||
|
||||
;; The shifted operations are not available when drawing with the mouse
|
||||
;; in Emacs 19.29 and 19.30.
|
||||
;;
|
||||
;; It is not possible to change between shifted and unshifted operation
|
||||
;; while drawing with the mouse. (See the comment in the function
|
||||
;; artist-shift-has-changed for further details.)
|
||||
|
|
|
|||
|
|
@ -551,9 +551,9 @@ See `world-clock'."
|
|||
(delete-char -1))
|
||||
(goto-char (point-min)))
|
||||
|
||||
;; Old name -- preserved for backwards compatibility.
|
||||
;;;###autoload
|
||||
(defalias 'display-time-world #'world-clock)
|
||||
(define-obsolete-function-alias 'display-time-world
|
||||
#'world-clock "28.1")
|
||||
|
||||
;;;###autoload
|
||||
(defun world-clock ()
|
||||
|
|
|
|||
|
|
@ -911,11 +911,10 @@ like \(diff-merge-strings \"b/foo\" \"b/bar\" \"/a/c/foo\")."
|
|||
If the OLD prefix arg is passed, tell the file NAME of the old file."
|
||||
(interactive
|
||||
(let* ((old current-prefix-arg)
|
||||
(fs (diff-hunk-file-names current-prefix-arg))
|
||||
(default (diff-find-file-name old 'noprompt)))
|
||||
(fs (diff-hunk-file-names current-prefix-arg)))
|
||||
(unless fs (error "No file name to look for"))
|
||||
(list old (read-file-name (format-prompt "File for %s" default (car fs))
|
||||
nil default t))))
|
||||
(list old (read-file-name (format "File for %s: " (car fs))
|
||||
nil (diff-find-file-name old 'noprompt) t))))
|
||||
(let ((fs (diff-hunk-file-names old)))
|
||||
(unless fs (error "No file name to look for"))
|
||||
(push (cons fs name) diff-remembered-files-alist)))
|
||||
|
|
@ -931,8 +930,12 @@ If the OLD prefix arg is passed, tell the file NAME of the old file."
|
|||
(progn (diff-hunk-prev) (point))
|
||||
(error (point-min)))))
|
||||
(header-files
|
||||
;; handle filenames with spaces;
|
||||
;; handle file names with spaces;
|
||||
;; cf. diff-font-lock-keywords / diff-file-header
|
||||
;; FIXME if there are nonascii characters in the file names,
|
||||
;; GNU diff displays them as octal escapes.
|
||||
;; This function should undo that, so as to return file names
|
||||
;; that are usable in Emacs.
|
||||
(if (looking-at "[-*][-*][-*] \\([^\t\n]+\\).*\n[-+][-+][-+] \\([^\t\n]+\\)")
|
||||
(list (if old (match-string 1) (match-string 2))
|
||||
(if old (match-string 2) (match-string 1)))
|
||||
|
|
@ -2170,9 +2173,10 @@ Return new point, if it was moved."
|
|||
(smerge-refine-regions beg-del beg-add beg-add end-add
|
||||
nil #'diff-refine-preproc props-r props-a)))))
|
||||
('context
|
||||
(let* ((middle (save-excursion (re-search-forward "^---" end)))
|
||||
(let* ((middle (save-excursion (re-search-forward "^---" end t)))
|
||||
(other middle))
|
||||
(while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
|
||||
(while (and middle
|
||||
(re-search-forward "^\\(?:!.*\n\\)+" middle t))
|
||||
(smerge-refine-regions (match-beginning 0) (match-end 0)
|
||||
(save-excursion
|
||||
(goto-char other)
|
||||
|
|
|
|||
|
|
@ -145,9 +145,17 @@ Possible values are:
|
|||
|
||||
(defun diff-no-select (old new &optional switches no-async buf)
|
||||
;; Noninteractive helper for creating and reverting diff buffers
|
||||
"Compare the OLD and NEW file/buffer, and return a diff buffer.
|
||||
"Compare the OLD and NEW file/buffer.
|
||||
If the optional SWITCHES is nil, the switches specified in the
|
||||
variable ‘diff-switches’ are passed to the diff command,
|
||||
otherwise SWITCHES is used. SWITCHES can be a string or a list
|
||||
of strings.
|
||||
|
||||
See `diff' for the meaning of the arguments."
|
||||
If NO-ASYNC is non-nil, call diff synchronously.
|
||||
|
||||
By default, this function creates the diff in the \"*Diff*\"
|
||||
buffer. If BUF is non-nil, BUF is used instead. This function
|
||||
returns the buffer used."
|
||||
(unless (bufferp new) (setq new (expand-file-name new)))
|
||||
(unless (bufferp old) (setq old (expand-file-name old)))
|
||||
(or switches (setq switches diff-switches)) ; If not specified, use default.
|
||||
|
|
|
|||
|
|
@ -499,11 +499,15 @@ are two possible targets for this %spatch. However, these files do not exist."
|
|||
patch-file-name)
|
||||
(setq patch-file-name
|
||||
(read-file-name
|
||||
(format-prompt "Patch is in file"
|
||||
(and buffer-file-name
|
||||
(format "Patch is in file%s: "
|
||||
(cond ((and buffer-file-name
|
||||
(equal (expand-file-name dir)
|
||||
(file-name-directory buffer-file-name))
|
||||
(file-name-nondirectory buffer-file-name)))
|
||||
(file-name-directory buffer-file-name)))
|
||||
(concat
|
||||
" (default "
|
||||
(file-name-nondirectory buffer-file-name)
|
||||
")"))
|
||||
(t "")))
|
||||
dir buffer-file-name 'must-match))
|
||||
(if (file-directory-p patch-file-name)
|
||||
(error "Patch file cannot be a directory: %s" patch-file-name)
|
||||
|
|
|
|||
|
|
@ -953,9 +953,10 @@ use."
|
|||
;; repository, make sure it's a parent of
|
||||
;; file.
|
||||
(read-file-name
|
||||
(format-prompt "create %s repository in" def-dir bk)
|
||||
(format "create %s repository in: " bk)
|
||||
default-directory def-dir t nil
|
||||
(lambda (arg)
|
||||
(message "arg %s" arg)
|
||||
(and (file-directory-p arg)
|
||||
(string-prefix-p (expand-file-name arg) def-dir)))))))
|
||||
(let ((default-directory repo-dir))
|
||||
|
|
@ -2899,10 +2900,10 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
|
|||
"Delete file and mark it as such in the version control system.
|
||||
If called interactively, read FILE, defaulting to the current
|
||||
buffer's file name if it's under version control."
|
||||
(interactive (list (let ((default (when (vc-backend buffer-file-name)
|
||||
buffer-file-name)))
|
||||
(read-file-name "VC delete file" default)
|
||||
nil default t)))
|
||||
(interactive (list (read-file-name "VC delete file: " nil
|
||||
(when (vc-backend buffer-file-name)
|
||||
buffer-file-name)
|
||||
t)))
|
||||
(setq file (expand-file-name file))
|
||||
(let ((buf (get-file-buffer file))
|
||||
(backend (vc-backend file)))
|
||||
|
|
@ -2943,10 +2944,9 @@ buffer's file name if it's under version control."
|
|||
"Rename file OLD to NEW in both work area and repository.
|
||||
If called interactively, read OLD and NEW, defaulting OLD to the
|
||||
current buffer's file name if it's under version control."
|
||||
(interactive (list (let ((default (when (vc-backend buffer-file-name)
|
||||
buffer-file-name)))
|
||||
(read-file-name (format-prompt "VC rename file" default)
|
||||
nil default t))
|
||||
(interactive (list (read-file-name "VC rename file: " nil
|
||||
(when (vc-backend buffer-file-name)
|
||||
buffer-file-name) t)
|
||||
(read-file-name "Rename to: ")))
|
||||
;; in CL I would have said (setq new (merge-pathnames new old))
|
||||
(let ((old-base (file-name-nondirectory old)))
|
||||
|
|
|
|||
|
|
@ -3162,8 +3162,9 @@ It reads a file name from an editable text field."
|
|||
#'completion-file-name-table
|
||||
(not read-file-name-completion-ignore-case))
|
||||
:match (lambda (widget value)
|
||||
(or (not (widget-get widget :must-match))
|
||||
(file-exists-p value)))
|
||||
(and (stringp value)
|
||||
(or (not (widget-get widget :must-match))
|
||||
(file-exists-p value))))
|
||||
:validate (lambda (widget)
|
||||
(let ((value (widget-value widget)))
|
||||
(unless (widget-apply widget :match value)
|
||||
|
|
|
|||
19
lisp/xml.el
19
lisp/xml.el
|
|
@ -1015,7 +1015,10 @@ The first line is indented with the optional INDENT-STRING."
|
|||
|
||||
(defalias 'xml-print 'xml-debug-print)
|
||||
|
||||
(defun xml-escape-string (string)
|
||||
(defconst xml-invalid-characters-re
|
||||
"[^\u0009\u000A\u000D\u0020-\uD7FF\uE000-\uFFFD\U00010000-\U0010FFFF]")
|
||||
|
||||
(defun xml-escape-string (string &optional noerror)
|
||||
"Convert STRING into a string containing valid XML character data.
|
||||
Replace occurrences of &<>\\='\" in STRING with their default XML
|
||||
entity references (e.g., replace each & with &).
|
||||
|
|
@ -1026,15 +1029,17 @@ restriction on \" or \\=', but we just substitute for these too
|
|||
\(as is permitted by the spec).
|
||||
|
||||
If STRING contains characters that are invalid in XML (as defined
|
||||
by https://www.w3.org/TR/xml/#charsets), signal an error of type
|
||||
`xml-invalid-character'."
|
||||
by https://www.w3.org/TR/xml/#charsets), operate depending on the
|
||||
value of NOERROR: if it is non-nil, remove them; else, signal an
|
||||
error of type `xml-invalid-character'."
|
||||
(with-temp-buffer
|
||||
(insert string)
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward
|
||||
"[^\u0009\u000A\u000D\u0020-\uD7FF\uE000-\uFFFD\U00010000-\U0010FFFF]"
|
||||
nil t)
|
||||
(signal 'xml-invalid-character (list (char-before) (match-beginning 0))))
|
||||
(while (re-search-forward xml-invalid-characters-re nil t)
|
||||
(if noerror
|
||||
(replace-match "")
|
||||
(signal 'xml-invalid-character
|
||||
(list (char-before) (match-beginning 0)))))
|
||||
(dolist (substitution '(("&" . "&")
|
||||
("<" . "<")
|
||||
(">" . ">")
|
||||
|
|
|
|||
|
|
@ -326,15 +326,14 @@ If non-nil, plugins are enabled. Otherwise, disabled."))
|
|||
FILE-NAME combined with `xwidget-webkit-download-dir' is the default file name
|
||||
of the prompt when reading. When the file name the user specified is a
|
||||
directory, URL is saved at the specified directory as FILE-NAME."
|
||||
(let* ((default (when file-name
|
||||
(expand-file-name
|
||||
file-name
|
||||
xwidget-webkit-download-dir)))
|
||||
(save-name
|
||||
(read-file-name
|
||||
(format-prompt "Save URL `%s' of type `%s' in file/directory"
|
||||
default url mime-type)
|
||||
xwidget-webkit-download-dir default)))
|
||||
(let ((save-name (read-file-name
|
||||
(format "Save URL `%s' of type `%s' in file/directory: "
|
||||
url mime-type)
|
||||
xwidget-webkit-download-dir
|
||||
(when file-name
|
||||
(expand-file-name
|
||||
file-name
|
||||
xwidget-webkit-download-dir)))))
|
||||
(if (file-directory-p save-name)
|
||||
(setq save-name
|
||||
(expand-file-name (file-name-nondirectory file-name) save-name)))
|
||||
|
|
|
|||
|
|
@ -1824,10 +1824,11 @@ SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
|
|||
registered, UNAME is the corresponding unique name. In case of
|
||||
registered methods and properties, UNAME is nil. PATH is the object
|
||||
path of the sending object. All of them can be nil, which means a
|
||||
wildcard then. OBJECT is either the handler to be called when a D-Bus
|
||||
message, which matches the key criteria, arrives (TYPE `:method' and
|
||||
`:signal'), or a list containing the value of the property and its
|
||||
attributes (TYPE `:property').
|
||||
wildcard then.
|
||||
|
||||
OBJECT is either the handler to be called when a D-Bus message, which
|
||||
matches the key criteria, arrives (TYPE `:method' and `:signal'), or a
|
||||
list (ACCESS EMITS-SIGNAL SIGNATURE VALUE) for TYPE `:property'.
|
||||
|
||||
For entries of type `:signal', there is also a fifth element RULE,
|
||||
which keeps the match string the signal is registered with.
|
||||
|
|
|
|||
|
|
@ -2919,6 +2919,11 @@ DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
|
|||
doc: /* Return t if FILENAME names an existing directory.
|
||||
Return nil if FILENAME does not name a directory, or if there
|
||||
was trouble determining whether FILENAME is a directory.
|
||||
|
||||
As a special case, this function will also return t if FILENAME is the
|
||||
empty string (\"\"). This quirk is due to Emacs interpreting the
|
||||
empty string (in some cases) as the current directory.
|
||||
|
||||
Symbolic links to directories count as directories.
|
||||
See `file-symlink-p' to distinguish symlinks. */)
|
||||
(Lisp_Object filename)
|
||||
|
|
|
|||
|
|
@ -5478,15 +5478,15 @@ w32_read_socket (struct terminal *terminal,
|
|||
/* Windows can send us a SIZE_MAXIMIZED message even
|
||||
when fullscreen is fullboth. The following is a
|
||||
simple hack to check that based on the fact that
|
||||
only a maximized fullscreen frame should have both
|
||||
top/left outside the screen. */
|
||||
only a maximized fullscreen frame should have top
|
||||
or left outside the screen. */
|
||||
if (EQ (fullscreen, Qfullwidth) || EQ (fullscreen, Qfullheight)
|
||||
|| NILP (fullscreen))
|
||||
{
|
||||
int x, y;
|
||||
|
||||
w32_real_positions (f, &x, &y);
|
||||
if (x < 0 && y < 0)
|
||||
if (x < 0 || y < 0)
|
||||
store_frame_param (f, Qfullscreen, Qmaximized);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -19308,20 +19308,21 @@ try_window (Lisp_Object window, struct text_pos pos, int flags)
|
|||
if ((flags & TRY_WINDOW_CHECK_MARGINS)
|
||||
&& !MINI_WINDOW_P (w))
|
||||
{
|
||||
int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
|
||||
int top_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
|
||||
int bot_scroll_margin = top_scroll_margin;
|
||||
if (window_wants_header_line (w))
|
||||
this_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w);
|
||||
top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w);
|
||||
start_display (&it, w, pos);
|
||||
|
||||
if ((w->cursor.y >= 0 /* not vscrolled */
|
||||
&& w->cursor.y < this_scroll_margin
|
||||
&& w->cursor.y < top_scroll_margin
|
||||
&& CHARPOS (pos) > BEGV)
|
||||
/* rms: considering make_cursor_line_fully_visible_p here
|
||||
seems to give wrong results. We don't want to recenter
|
||||
when the last line is partly visible, we want to allow
|
||||
that case to be handled in the usual way. */
|
||||
|| w->cursor.y > (it.last_visible_y - partial_line_height (&it)
|
||||
- this_scroll_margin - 1))
|
||||
- bot_scroll_margin - 1))
|
||||
{
|
||||
w->cursor.vpos = -1;
|
||||
clear_glyph_matrix (w->desired_matrix);
|
||||
|
|
|
|||
|
|
@ -89,11 +89,6 @@ unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS
|
|||
## To run tests under a debugger, set this to eg: "gdb --args".
|
||||
GDB =
|
||||
|
||||
# The locale to run tests under. Tests should work if this is set to
|
||||
# any supported locale. Use the C locale by default, as it should be
|
||||
# supported everywhere.
|
||||
TEST_LOCALE = C
|
||||
|
||||
# Set this to 'yes' to run the tests in an interactive instance.
|
||||
TEST_INTERACTIVE ?= no
|
||||
|
||||
|
|
@ -128,7 +123,7 @@ endif
|
|||
|
||||
# The actual Emacs command run in the targets below.
|
||||
# Prevent any setting of EMACSLOADPATH in user environment causing problems.
|
||||
emacs = EMACSLOADPATH= LC_ALL=$(TEST_LOCALE) \
|
||||
emacs = EMACSLOADPATH= \
|
||||
EMACS_TEST_DIRECTORY=$(abspath $(srcdir)) \
|
||||
$(GDB) "$(EMACS)" $(MODULES_EMACSOPT) $(EMACSOPT)
|
||||
|
||||
|
|
|
|||
|
|
@ -156,6 +156,7 @@ This expects `auto-revert--messages' to be bound by
|
|||
"Check autorevert for a file."
|
||||
;; `auto-revert-buffers' runs every 5". And we must wait, until the
|
||||
;; file has been reverted.
|
||||
:tags '(:expensive-test)
|
||||
(let ((tmpfile (make-temp-file "auto-revert-test"))
|
||||
buf)
|
||||
(unwind-protect
|
||||
|
|
@ -356,6 +357,7 @@ This expects `auto-revert--messages' to be bound by
|
|||
"Check autorevert tail mode."
|
||||
;; `auto-revert-buffers' runs every 5". And we must wait, until the
|
||||
;; file has been reverted.
|
||||
:tags '(:expensive-test)
|
||||
(let ((tmpfile (make-temp-file "auto-revert-test"))
|
||||
buf)
|
||||
(unwind-protect
|
||||
|
|
@ -394,6 +396,7 @@ This expects `auto-revert--messages' to be bound by
|
|||
"Check autorevert for dired."
|
||||
;; `auto-revert-buffers' runs every 5". And we must wait, until the
|
||||
;; file has been reverted.
|
||||
:tags '(:expensive-test)
|
||||
(let* ((tmpfile (make-temp-file "auto-revert-test"))
|
||||
(name (file-name-nondirectory tmpfile))
|
||||
buf)
|
||||
|
|
|
|||
|
|
@ -63,22 +63,16 @@ An existing calc stack is reused, otherwise a new one is created."
|
|||
(calc-top-n 1))
|
||||
(calc-pop 0)))
|
||||
|
||||
;; (ert-deftest test-math-bignum ()
|
||||
;; ;; bug#17556
|
||||
;; (let ((n (math-bignum most-negative-fixnum)))
|
||||
;; (should (math-negp n))
|
||||
;; (should (cl-notany #'cl-minusp (cdr n)))))
|
||||
|
||||
(ert-deftest test-calc-remove-units ()
|
||||
(ert-deftest calc-remove-units ()
|
||||
(should (calc-tests-equal (calc-tests-simple #'calc-remove-units "-1 m") -1)))
|
||||
|
||||
(ert-deftest test-calc-extract-units ()
|
||||
(ert-deftest calc-extract-units ()
|
||||
(should (calc-tests-equal (calc-tests-simple #'calc-extract-units "-1 m")
|
||||
'(var m var-m)))
|
||||
(should (calc-tests-equal (calc-tests-simple #'calc-extract-units "-1 m*cm")
|
||||
'(* (float 1 -2) (^ (var m var-m) 2)))))
|
||||
|
||||
(ert-deftest test-calc-convert-units ()
|
||||
(ert-deftest calc-convert-units ()
|
||||
;; Used to ask for `(The expression is unitless when simplified) Old Units: '.
|
||||
(should (calc-tests-equal (calc-tests-simple #'calc-convert-units "-1 m" nil "cm")
|
||||
'(* -100 (var cm var-cm))))
|
||||
|
|
@ -94,7 +88,7 @@ An existing calc stack is reused, otherwise a new one is created."
|
|||
(let ((var-i (calcFunc-sqrt -1)))
|
||||
(should (math-imaginary-i))))
|
||||
|
||||
(ert-deftest test-calc-23889 ()
|
||||
(ert-deftest calc-bug-23889 ()
|
||||
"Test for https://debbugs.gnu.org/23889 and 25652."
|
||||
(skip-unless t) ;; (>= math-bignum-digit-length 9))
|
||||
(dolist (mode '(deg rad))
|
||||
|
|
@ -139,7 +133,7 @@ An existing calc stack is reused, otherwise a new one is created."
|
|||
(nth 1 (calcFunc-cos 1)))
|
||||
0 4))))))
|
||||
|
||||
(ert-deftest calc-test-trig ()
|
||||
(ert-deftest calc-trig ()
|
||||
"Trigonometric simplification; bug#33052."
|
||||
(let ((calc-angle-mode 'rad))
|
||||
(let ((calc-symbolic-mode t))
|
||||
|
|
@ -169,7 +163,7 @@ An existing calc stack is reused, otherwise a new one is created."
|
|||
(should (equal (math-simplify '(calcFunc-cot (/ (var pi var-pi) 3)))
|
||||
'(calcFunc-cot (/ (var pi var-pi) 3)))))))
|
||||
|
||||
(ert-deftest calc-test-format-radix ()
|
||||
(ert-deftest calc-format-radix ()
|
||||
"Test integer formatting (bug#36689)."
|
||||
(let ((calc-group-digits nil))
|
||||
(let ((calc-number-radix 10))
|
||||
|
|
@ -194,7 +188,7 @@ An existing calc stack is reused, otherwise a new one is created."
|
|||
(let ((calc-number-radix 36))
|
||||
(should (equal (math-format-number 12345678901) "36#5,O6A,QT1")))))
|
||||
|
||||
(ert-deftest calc-test-calendar ()
|
||||
(ert-deftest calc-calendar ()
|
||||
"Test calendar conversions (bug#36822)."
|
||||
(should (equal (calcFunc-julian (math-parse-date "2019-07-27")) 2458692))
|
||||
(should (equal (math-parse-date "2019-07-27") '(date 737267)))
|
||||
|
|
@ -216,7 +210,7 @@ An existing calc stack is reused, otherwise a new one is created."
|
|||
(should (equal (math-absolute-from-julian-dt -101 3 1) -36832))
|
||||
(should (equal (math-absolute-from-julian-dt -4713 1 1) -1721425)))
|
||||
|
||||
(ert-deftest calc-test-solve-linear-system ()
|
||||
(ert-deftest calc-solve-linear-system ()
|
||||
"Test linear system solving (bug#35374)."
|
||||
;; x + y = 3
|
||||
;; 2x - 3y = -4
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; semantic-utest-c.el --- C based parsing tests.
|
||||
;;; semantic-utest-c.el --- C based parsing tests. -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -40,11 +40,13 @@
|
|||
(defvar semantic-utest-c-test-directory (expand-file-name "tests" cedet-utest-directory)
|
||||
"Location of test files.")
|
||||
|
||||
(defvar semantic-lex-c-nested-namespace-ignore-second)
|
||||
|
||||
;;; Code:
|
||||
;;;###autoload
|
||||
(ert-deftest semantic-test-c-preprocessor-simulation ()
|
||||
"Run parsing test for C from the test directory."
|
||||
(interactive)
|
||||
:tags '(:expensive-test)
|
||||
(semantic-mode 1)
|
||||
(dolist (fp semantic-utest-c-comparisons)
|
||||
(let* ((semantic-lex-c-nested-namespace-ignore-second nil)
|
||||
|
|
@ -146,33 +148,32 @@ gcc version 2.95.2 19991024 (release)"
|
|||
|
||||
(ert-deftest semantic-test-gcc-output-parser ()
|
||||
"Test the output parser against some collected strings."
|
||||
(let ((fail nil))
|
||||
(dolist (S semantic-gcc-test-strings)
|
||||
(let* ((fields (semantic-gcc-fields S))
|
||||
(v (cdr (assoc 'version fields)))
|
||||
(h (or (cdr (assoc 'target fields))
|
||||
(cdr (assoc '--target fields))
|
||||
(cdr (assoc '--host fields))))
|
||||
(p (cdr (assoc '--prefix fields)))
|
||||
)
|
||||
;; No longer test for prefixes.
|
||||
(when (not (and v h))
|
||||
(let ((strs (split-string S "\n")))
|
||||
(message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p)
|
||||
))
|
||||
(should (and v h))
|
||||
))
|
||||
(dolist (S semantic-gcc-test-strings-fail)
|
||||
(let* ((fields (semantic-gcc-fields S))
|
||||
(v (cdr (assoc 'version fields)))
|
||||
(h (or (cdr (assoc '--host fields))
|
||||
(cdr (assoc 'target fields))))
|
||||
(p (cdr (assoc '--prefix fields)))
|
||||
)
|
||||
;; negative test
|
||||
(should-not (and v h p))
|
||||
))
|
||||
))
|
||||
(dolist (S semantic-gcc-test-strings)
|
||||
(let* ((fields (semantic-gcc-fields S))
|
||||
(v (cdr (assoc 'version fields)))
|
||||
(h (or (cdr (assoc 'target fields))
|
||||
(cdr (assoc '--target fields))
|
||||
(cdr (assoc '--host fields))))
|
||||
(p (cdr (assoc '--prefix fields)))
|
||||
)
|
||||
;; No longer test for prefixes.
|
||||
(when (not (and v h))
|
||||
(let ((strs (split-string S "\n")))
|
||||
(message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p)
|
||||
))
|
||||
(should (and v h))
|
||||
))
|
||||
(dolist (S semantic-gcc-test-strings-fail)
|
||||
(let* ((fields (semantic-gcc-fields S))
|
||||
(v (cdr (assoc 'version fields)))
|
||||
(h (or (cdr (assoc '--host fields))
|
||||
(cdr (assoc 'target fields))))
|
||||
(p (cdr (assoc '--prefix fields)))
|
||||
)
|
||||
;; negative test
|
||||
(should-not (and v h p))
|
||||
))
|
||||
)
|
||||
|
||||
|
||||
(provide 'semantic-utest-c)
|
||||
|
|
|
|||
|
|
@ -55,6 +55,7 @@ private:
|
|||
(defvar srecode-insert-getset-fully-automatic-flag) ; Silence byte-compiler.
|
||||
(ert-deftest srecode-utest-getset-output ()
|
||||
"Test various template insertion options."
|
||||
:tags '(:expensive-test)
|
||||
(save-excursion
|
||||
(let ((testbuff (find-file-noselect srecode-utest-getset-testfile))
|
||||
(srecode-insert-getset-fully-automatic-flag t))
|
||||
|
|
|
|||
|
|
@ -24,11 +24,11 @@
|
|||
(ert-deftest dired-autoload ()
|
||||
"Tests to see whether dired-x has been autoloaded"
|
||||
(should
|
||||
(fboundp 'dired-jump))
|
||||
(fboundp 'dired-do-relsymlink))
|
||||
(should
|
||||
(autoloadp
|
||||
(symbol-function
|
||||
'dired-jump))))
|
||||
'dired-do-relsymlink))))
|
||||
|
||||
(ert-deftest dired-test-bug22694 ()
|
||||
"Test for https://debbugs.gnu.org/22694 ."
|
||||
|
|
|
|||
|
|
@ -294,6 +294,7 @@ Body are forms defining the test."
|
|||
|
||||
(ert-deftest cl-seq-test-bug24264 ()
|
||||
"Test for https://debbugs.gnu.org/24264 ."
|
||||
:tags '(:expensive-test)
|
||||
(let ((list (append (make-list 8000005 1) '(8)))
|
||||
(list2 (make-list 8000005 2)))
|
||||
(should (cl-position 8 list))
|
||||
|
|
|
|||
|
|
@ -135,8 +135,9 @@
|
|||
"--eval"
|
||||
(prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99)
|
||||
(message "%d" (car gv-test-pair)))))
|
||||
(should (equal (buffer-string)
|
||||
"Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n")))))
|
||||
(should (string-match
|
||||
"\\`Symbol.s function definition is void: \\\\(setf\\\\ gv-test-foo\\\\)\n\\'"
|
||||
(buffer-string))))))
|
||||
|
||||
(ert-deftest gv-setter-edebug ()
|
||||
"Check that a setter can be defined and edebugged together with
|
||||
|
|
|
|||
|
|
@ -492,6 +492,7 @@ Must called from within a `tar-mode' buffer."
|
|||
|
||||
(ert-deftest package-test-update-archives-async ()
|
||||
"Test updating package archives asynchronously."
|
||||
:tags '(:expensive-test)
|
||||
(skip-unless (executable-find "python2"))
|
||||
(let* ((package-menu-async t)
|
||||
(default-directory package-test-data-dir)
|
||||
|
|
|
|||
|
|
@ -611,6 +611,7 @@ delivered."
|
|||
|
||||
(ert-deftest file-notify-test03-events ()
|
||||
"Check file creation/change/removal notifications."
|
||||
:tags '(:expensive-test)
|
||||
(skip-unless (file-notify--test-local-enabled))
|
||||
|
||||
(unwind-protect
|
||||
|
|
@ -888,6 +889,7 @@ delivered."
|
|||
|
||||
(ert-deftest file-notify-test04-autorevert ()
|
||||
"Check autorevert via file notification."
|
||||
:tags '(:expensive-test)
|
||||
(skip-unless (file-notify--test-local-enabled))
|
||||
|
||||
;; `auto-revert-buffers' runs every 5". And we must wait, until the
|
||||
|
|
@ -983,6 +985,7 @@ delivered."
|
|||
|
||||
(ert-deftest file-notify-test05-file-validity ()
|
||||
"Check `file-notify-valid-p' for files."
|
||||
:tags '(:expensive-test)
|
||||
(skip-unless (file-notify--test-local-enabled))
|
||||
|
||||
(unwind-protect
|
||||
|
|
@ -1235,6 +1238,7 @@ delivered."
|
|||
|
||||
(ert-deftest file-notify-test08-backup ()
|
||||
"Check that backup keeps file notification."
|
||||
:tags '(:expensive-test)
|
||||
(skip-unless (file-notify--test-local-enabled))
|
||||
|
||||
(unwind-protect
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; gnustest-mml-sec.el --- Tests mml-sec.el, see README-mml-secure.txt.
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
||||
;;; mml-sec-tests.el --- Tests mml-sec.el, see README-mml-secure.txt. -*- lexical-binding:t -*-
|
||||
;; Copyright (C) 2015, 2020 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org>
|
||||
|
||||
|
|
@ -51,6 +51,8 @@ Mostly, the empty passphrase is used. However, the keys for
|
|||
'(sign-pgp sign-pgp-mime sign-smime)
|
||||
'(sign-pgp sign-pgp-mime)))
|
||||
|
||||
(defvar mml-smime-use)
|
||||
|
||||
(defun mml-secure-test-fixture (body &optional interactive)
|
||||
"Setup GnuPG home containing test keys and prepare environment for BODY.
|
||||
If optional INTERACTIVE is non-nil, allow questions to the user in case of
|
||||
|
|
@ -80,7 +82,9 @@ instead of gpg-agent."
|
|||
;; not look in the proper places otherwise, see:
|
||||
;; https://bugs.gnupg.org/gnupg/issue2126
|
||||
(setenv "GNUPGHOME" epg-gpg-home-directory)
|
||||
(funcall body))
|
||||
(unwind-protect
|
||||
(funcall body)
|
||||
(mml-sec-test--kill-gpg-agent)))
|
||||
(error
|
||||
(setenv "GPG_AGENT_INFO" agent-info)
|
||||
(setenv "GNUPGHOME" gpghome)
|
||||
|
|
@ -120,9 +124,9 @@ Subject: Test
|
|||
Pass optional INTERACTIVE to mml-secure-test-fixture."
|
||||
(mml-secure-test-fixture
|
||||
(lambda ()
|
||||
(let ((context (if (memq method '(enc-smime enc-sign-smime sign-smime))
|
||||
(epg-make-context 'CMS)
|
||||
(epg-make-context 'OpenPGP)))
|
||||
(let ((_context (if (memq method '(enc-smime enc-sign-smime sign-smime))
|
||||
(epg-make-context 'CMS)
|
||||
(epg-make-context 'OpenPGP)))
|
||||
;; Verify and decrypt by default.
|
||||
(mm-verify-option 'known)
|
||||
(mm-decrypt-option 'known)
|
||||
|
|
@ -546,6 +550,10 @@ Pass optional INTERACTIVE to mml-secure-test-mail-fixture."
|
|||
))))))
|
||||
interactive))
|
||||
|
||||
(defvar mml-smime-cache-passphrase)
|
||||
(defvar mml2015-cache-passphrase)
|
||||
(defvar mml1991-cache-passphrase)
|
||||
|
||||
(defun mml-secure-test-en-decrypt-with-passphrase
|
||||
(method to from checksig jl-passphrase do-cache
|
||||
&optional enc-keys expectfail)
|
||||
|
|
@ -562,7 +570,7 @@ If optional EXPECTFAIL is non-nil, a decryption failure is expected."
|
|||
(mml-smime-cache-passphrase do-cache)
|
||||
)
|
||||
(cl-letf (((symbol-function 'read-passwd)
|
||||
(lambda (prompt &optional confirm default) jl-passphrase)))
|
||||
(lambda (_prompt &optional _confirm _default) jl-passphrase)))
|
||||
(mml-secure-test-en-decrypt method to from checksig t enc-keys expectfail)
|
||||
)))
|
||||
|
||||
|
|
@ -897,4 +905,16 @@ So the second decryption fails."
|
|||
(let ((with-smime nil))
|
||||
(ert-run-tests-batch)))
|
||||
|
||||
;;; gnustest-mml-sec.el ends here
|
||||
(defun mml-sec-test--kill-gpg-agent ()
|
||||
(dolist (pid (list-system-processes))
|
||||
(let ((atts (process-attributes pid)))
|
||||
(when (and (equal (cdr (assq 'user atts)) (user-login-name))
|
||||
(equal (cdr (assq 'comm atts)) "gpg-agent")
|
||||
(string-match
|
||||
(concat "homedir.*"
|
||||
(regexp-quote (expand-file-name "test/data/mml-sec"
|
||||
source-directory)))
|
||||
(cdr (assq 'args atts))))
|
||||
(call-process "kill" nil nil nil (format "%d" pid))))))
|
||||
|
||||
;;; mml-sec-tests.el ends here
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Reference in a new issue