commit 6a3b1aaa066dac28355ca5d09550947250108950 (HEAD, refs/remotes/origin/master) Author: Alex Branham Date: Sat Feb 23 07:35:01 2019 -0600 * lisp/comint.el (comint-skip-input): Set inhibit-read-only to t Bug#33975 diff --git a/lisp/comint.el b/lisp/comint.el index 0a6aff2e73..a51413dc65 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -2536,13 +2536,16 @@ Useful if you accidentally suspend the top-level process." (defun comint-skip-input () "Skip all pending input, from last stuff output by interpreter to point. -This means mark it as if it had been sent as input, without sending it." +This means mark it as if it had been sent as input, without +sending it. The command keys used to trigger the command that +called this function are inserted into the buffer." (let ((comint-input-sender 'ignore) (comint-input-filter-functions nil)) (comint-send-input t t)) (end-of-line) (let ((pos (point)) - (marker (process-mark (get-buffer-process (current-buffer))))) + (marker (process-mark (get-buffer-process (current-buffer)))) + (inhibit-read-only t)) (insert " " (key-description (this-command-keys))) (if (= marker pos) (set-marker marker (point))))) commit 72ec233f2a1b8a6a9574e61588d0467caf41755c Author: Philipp Stephani Date: Wed Jan 2 22:04:56 2019 +0100 Ignore pending_signals when checking for quits. pending_signals is often set if no quit is pending. This results in bugs in module code if the module returns but no quit is actually pending. As a better alternative, add a new process_input environment function for Emacs 27. That function processes signals (like maybe_quit). * configure.ac: Add module snippet for Emacs 27. * src/module-env-27.h: New file. * src/emacs-module.h.in: Add process_input function to environment interface. * src/emacs-module.c (module_should_quit): Use QUITP macro to check whether the caller should quit. (module_process_input): New function. (initialize_environment): Use it. * src/eval.c: Remove obsolete comment. * test/data/emacs-module/mod-test.c (signal_wrong_type_argument) (signal_errno): New helper functions. (Fmod_test_sleep_until): New test module function. * test/src/emacs-module-tests.el (mod-test-sleep-until): New unit test. * doc/lispref/internals.texi (Module Misc): Document process_input. diff --git a/configure.ac b/configure.ac index c26eb6d1e8..110ea2909a 100644 --- a/configure.ac +++ b/configure.ac @@ -3689,8 +3689,10 @@ AC_SUBST(MODULES_SUFFIX) AC_CONFIG_FILES([src/emacs-module.h]) AC_SUBST_FILE([module_env_snippet_25]) AC_SUBST_FILE([module_env_snippet_26]) +AC_SUBST_FILE([module_env_snippet_27]) module_env_snippet_25="$srcdir/src/module-env-25.h" module_env_snippet_26="$srcdir/src/module-env-26.h" +module_env_snippet_27="$srcdir/src/module-env-27.h" ### Use -lpng if available, unless '--with-png=no'. HAVE_PNG=no diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 3fbff266ad..56465126f4 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1623,7 +1623,27 @@ purpose. @deftypefn Function bool should_quit (emacs_env *@var{env}) This function returns @code{true} if the user wants to quit. In that case, we recommend that your module function aborts any on-going -processing and returns as soon as possible. +processing and returns as soon as possible. In most cases, use +@code{process_input} instead. +@end deftypefn + +To process input events in addition to checking whether the user wants +to quit, use the following function, which is available since Emacs +27.1. + +@anchor{process_input} +@deftypefn Function enum emacs_process_input_result process_input (emacs_env *@var{env}) +This function processes pending input events. It returns +@code{emacs_process_input_quit} if the user wants to quit or an error +occurred while processing signals. In that case, we recommend that +your module function aborts any on-going processing and returns as +soon as possible. If the module code may continue running, +@code{process_input} returns @code{emacs_process_input_continue}. The +return value is @code{emacs_process_input_continue} if and only if +there is no pending nonlocal exit in @code{env}. If the module +continues after calling @code{process_input}, global state such as +variable values and buffer content may have been modified in arbitrary +ways. @end deftypefn @node Module Nonlocal diff --git a/etc/NEWS b/etc/NEWS index 67e376d9b3..8acbf6d3a7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1614,6 +1614,9 @@ given frame supports resizing. This is currently supported on GNUish hosts and on modern versions of MS-Windows. +** New module environment function 'process_input' to process user +input while module code is running. + * Changes in Emacs 27.1 on Non-Free Operating Systems diff --git a/src/emacs-module.c b/src/emacs-module.c index cbab023420..b70d6cea81 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -671,13 +671,21 @@ module_vec_size (emacs_env *env, emacs_value vec) return ASIZE (lvec); } -/* This function should return true if and only if maybe_quit would do - anything. */ +/* This function should return true if and only if maybe_quit would + quit. */ static bool module_should_quit (emacs_env *env) { MODULE_FUNCTION_BEGIN_NO_CATCH (false); - return (! NILP (Vquit_flag) && NILP (Vinhibit_quit)) || pending_signals; + return QUITP; +} + +static enum emacs_process_input_result +module_process_input (emacs_env *env) +{ + MODULE_FUNCTION_BEGIN (emacs_process_input_quit); + maybe_quit (); + return emacs_process_input_continue; } @@ -1082,6 +1090,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) env->vec_get = module_vec_get; env->vec_size = module_vec_size; env->should_quit = module_should_quit; + env->process_input = module_process_input; Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments); return env; } diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in index 4c5286f625..009d1583fe 100644 --- a/src/emacs-module.h.in +++ b/src/emacs-module.h.in @@ -47,7 +47,7 @@ extern "C" { #endif /* Current environment. */ -typedef struct emacs_env_26 emacs_env; +typedef struct emacs_env_27 emacs_env; /* Opaque pointer representing an Emacs Lisp value. BEWARE: Do not assume NULL is a valid value! */ @@ -83,6 +83,16 @@ enum emacs_funcall_exit emacs_funcall_exit_throw = 2 }; +/* Possible return values for emacs_env.process_input. */ +enum emacs_process_input_result +{ + /* Module code may continue */ + emacs_process_input_continue = 0, + + /* Module code should return control to Emacs as soon as possible. */ + emacs_process_input_quit = 1 +}; + struct emacs_env_25 { @module_env_snippet_25@ @@ -95,6 +105,15 @@ struct emacs_env_26 @module_env_snippet_26@ }; +struct emacs_env_27 +{ +@module_env_snippet_25@ + +@module_env_snippet_26@ + +@module_env_snippet_27@ +}; + /* Every module should define a function as follows. */ extern int emacs_module_init (struct emacs_runtime *ert) EMACS_NOEXCEPT diff --git a/src/eval.c b/src/eval.c index b094fc2e66..b6cdfc911d 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1575,10 +1575,7 @@ process_quit_flag (void) If quit-flag is set to `kill-emacs' the SIGINT handler has received a request to exit Emacs when it is safe to do. - When not quitting, process any pending signals. - - If you change this function, also adapt module_should_quit in - emacs-module.c. */ + When not quitting, process any pending signals. */ void maybe_quit (void) diff --git a/src/module-env-27.h b/src/module-env-27.h new file mode 100644 index 0000000000..b491b60fbb --- /dev/null +++ b/src/module-env-27.h @@ -0,0 +1,4 @@ + /* Processes pending input events and returns whether the module + function should quit. */ + enum emacs_process_input_result (*process_input) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL (1); diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index 98242e85ba..47ea159d0e 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -17,12 +17,20 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ +#include "config.h" + #include +#include +#include #include #include -#include +#include +#include + #include +#include "timespec.h" + int plugin_is_GPL_compatible; #if INTPTR_MAX <= 0 @@ -299,6 +307,64 @@ Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args, return env->funcall (env, env->intern (env, "garbage-collect"), 0, NULL); } +static void +signal_wrong_type_argument (emacs_env *env, const char *predicate, + emacs_value arg) +{ + emacs_value symbol = env->intern (env, "wrong-type-argument"); + emacs_value elements[2] = {env->intern (env, predicate), arg}; + emacs_value data = env->funcall (env, env->intern (env, "list"), 2, elements); + env->non_local_exit_signal (env, symbol, data); +} + +static void +signal_errno (emacs_env *env, const char *function) +{ + const char *message = strerror (errno); + emacs_value message_value = env->make_string (env, message, strlen (message)); + emacs_value symbol = env->intern (env, "file-error"); + emacs_value elements[2] + = {env->make_string (env, function, strlen (function)), message_value}; + emacs_value data = env->funcall (env, env->intern (env, "list"), 2, elements); + env->non_local_exit_signal (env, symbol, data); +} + +/* A long-running operation that occasionally calls `should_quit' or + `process_input'. */ + +static emacs_value +Fmod_test_sleep_until (emacs_env *env, ptrdiff_t nargs, emacs_value *args, + void *data) +{ + assert (nargs == 2); + const double until_seconds = env->extract_float (env, args[0]); + if (env->non_local_exit_check (env)) + return NULL; + if (until_seconds <= 0) + { + signal_wrong_type_argument (env, "cl-plusp", args[0]); + return NULL; + } + const bool process_input = env->is_not_nil (env, args[1]); + const struct timespec until = dtotimespec (until_seconds); + const struct timespec amount = make_timespec(0, 10000000); + while (true) + { + const struct timespec now = current_timespec (); + if (timespec_cmp (now, until) >= 0) + break; + if (nanosleep (&amount, NULL) && errno != EINTR) + { + signal_errno (env, "nanosleep"); + return NULL; + } + if ((process_input + && env->process_input (env) == emacs_process_input_quit) + || env->should_quit (env)) + return NULL; + } + return env->intern (env, "finished"); +} /* Lisp utilities for easier readability (simple wrappers). */ @@ -367,6 +433,7 @@ emacs_module_init (struct emacs_runtime *ert) DEFUN ("mod-test-invalid-load", Fmod_test_invalid_load, 0, 0, NULL, NULL); DEFUN ("mod-test-invalid-finalizer", Fmod_test_invalid_finalizer, 0, 0, NULL, NULL); + DEFUN ("mod-test-sleep-until", Fmod_test_sleep_until, 2, 2, NULL, NULL); #undef DEFUN diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index e4593044ec..e30980b599 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -289,4 +289,24 @@ Return A + B" (should (member '(provide . mod-test) entries)) (should (member '(defun . mod-test-sum) entries)))) +(ert-deftest mod-test-sleep-until () + "Check that `mod-test-sleep-until' either returns normally or quits. +Interactively, you can try hitting \\[keyboard-quit] to quit." + (dolist (arg '(nil t)) + ;; Guard against some caller setting `inhibit-quit'. + (with-local-quit + (condition-case nil + (should (eq (with-local-quit + ;; Because `inhibit-quit' is nil here, the next + ;; form either quits or returns `finished'. + (mod-test-sleep-until + ;; Interactively, run for 5 seconds to give the + ;; user time to quit. In batch mode, run only + ;; briefly since the user can't quit. + (float-time (time-add nil (if noninteractive 0.1 5))) + ;; should_quit or process_input + arg)) + 'finished)) + (quit))))) + ;;; emacs-module-tests.el ends here commit 5653b76d0bacf1edfc3d962c0bb991344cd80f6f Author: Stefan Monnier Date: Sun Feb 24 16:19:59 2019 -0500 * lisp/term.el: Fix minor compilation issues with cl-lib and lexbind Remove left-over comment from the bulk comint->term query/replace. (term-command-function): Rename from term-command-hook. Give it a global default value. (term-suppress-hard-newline): Mark it as generally obsolete. (term-mode): Don't manually make hooks buffer-local. (term--remove-fake-newlines): Fix assert -> cl-assert. (term-char-mode): Use add-function. (term-send-input): Use run-hook-with-args. (term-dynamic-complete): Use run-hook-with-args-until-success. (term-dynamic-simple-complete): Completion tables can be plain lists. (serial-read-name): Simplify and fix misuse of `set`. diff --git a/lisp/term.el b/lisp/term.el index fdcc39de72..e759bb8e4f 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -284,17 +284,6 @@ ;; merge them into the master source. ;; - Per Bothner (bothner@cygnus.com) -;; This file defines a general command-interpreter-in-a-buffer package -;; (term mode). The idea is that you can build specific process-in-a-buffer -;; modes on top of term mode -- e.g., lisp, shell, scheme, T, soar, .... -;; This way, all these specific packages share a common base functionality, -;; and a common set of bindings, which makes them easier to use (and -;; saves code, implementation time, etc., etc.). - -;; For hints on converting existing process modes (e.g., tex-mode, -;; background, dbx, gdb, kermit, prolog, telnet) to use term-mode -;; instead of shell-mode, see the notes at the end of this file. - ;; Brief Command Documentation: ;;============================================================================ @@ -406,7 +395,9 @@ This emulates (more or less) the behavior of xterm.") (defvar term-pager-count nil "Number of lines before we need to page; if nil, paging is disabled.") (defvar term-saved-cursor nil) -(defvar term-command-hook) +(define-obsolete-variable-alias 'term-command-hook + 'term-command-function "27.1") +(defvar term-command-function #'term-command-hook) (defvar term-log-buffer nil) (defvar term-scroll-with-delete nil "If t, forward scrolling should be implemented by delete to @@ -546,8 +537,7 @@ This means text can automatically reflow if the window is resized." :type 'boolean :group 'term) (make-obsolete-variable 'term-suppress-hard-newline nil - "27.1" - 'set) + "27.1") ;; Where gud-display-frame should put the debugging arrow. This is ;; set by the marker-filter, which scans the debugger's output for @@ -582,7 +572,7 @@ These functions get one argument, a string containing the text to send. This variable is buffer-local.") -(defvar term-input-sender (function term-simple-send) +(defvar term-input-sender #'term-simple-send "Function to actually send to PROCESS the STRING submitted by user. Usually this is just `term-simple-send', but if your mode needs to massage the input string, this is your hook. This is called from @@ -1039,8 +1029,6 @@ Entry to this mode runs the hooks on `term-mode-hook'." (set (make-local-variable 'term-last-input-start) (make-marker)) (set (make-local-variable 'term-last-input-end) (make-marker)) (set (make-local-variable 'term-last-input-match) "") - (set (make-local-variable 'term-command-hook) - (symbol-function 'term-command-hook)) ;; These local variables are set to their local values: (make-local-variable 'term-saved-home-marker) @@ -1094,21 +1082,18 @@ Entry to this mode runs the hooks on `term-mode-hook'." (make-local-variable 'term-pager-old-local-map) (make-local-variable 'term-old-mode-map) (make-local-variable 'term-insert-mode) - (make-local-variable 'term-dynamic-complete-functions) (make-local-variable 'term-completion-fignore) (make-local-variable 'term-get-old-input) (make-local-variable 'term-matching-input-from-input-string) (make-local-variable 'term-input-autoexpand) (make-local-variable 'term-input-ignoredups) (make-local-variable 'term-delimiter-argument-list) - (make-local-variable 'term-input-filter-functions) (make-local-variable 'term-input-filter) (make-local-variable 'term-input-sender) (make-local-variable 'term-eol-on-send) (make-local-variable 'term-scroll-to-bottom-on-output) (make-local-variable 'term-scroll-show-maximum-output) (make-local-variable 'term-ptyp) - (make-local-variable 'term-exec-hook) (set (make-local-variable 'term-vertical-motion) 'vertical-motion) (set (make-local-variable 'term-pending-delete-marker) (make-marker)) (make-local-variable 'term-current-face) @@ -1144,7 +1129,7 @@ Entry to this mode runs the hooks on `term-mode-hook'." (while (setq fake-newline (next-single-property-change (point) 'term-line-wrap)) (goto-char fake-newline) - (assert (eq ?\n (char-after))) + (cl-assert (eq ?\n (char-after))) (let ((inhibit-read-only t)) (delete-char 1))))) @@ -1329,16 +1314,14 @@ intervention from Emacs, except for the escape character (usually C-c)." (add-hook 'post-command-hook #'term-goto-process-mark-maybe nil t) ;; Send existing partial line to inferior (without newline). - (let ((pmark (process-mark (get-buffer-process (current-buffer)))) - (save-input-sender term-input-sender)) + (let ((pmark (process-mark (get-buffer-process (current-buffer))))) (when (> (point) pmark) (unwind-protect (progn - (setq term-input-sender - (symbol-function 'term-send-string)) + (add-function :override term-input-sender #'term-send-string) (end-of-line) (term-send-input)) - (setq term-input-sender save-input-sender)))) + (remove-function term-input-sender #'term-send-string)))) (term-update-mode-line))) (defun term-line-mode () @@ -1468,8 +1451,8 @@ buffer. The hook `term-exec-hook' is run after each exec." ;; Jump to the end, and set the process mark. (goto-char (point-max)) (set-marker (process-mark proc) (point)) - (set-process-filter proc 'term-emulate-terminal) - (set-process-sentinel proc 'term-sentinel) + (set-process-filter proc #'term-emulate-terminal) + (set-process-sentinel proc #'term-sentinel) ;; Feed it the startfile. (when startfile ;;This is guaranteed to wait long enough @@ -1598,7 +1581,7 @@ Nil if unknown.") (when (term--bash-needs-EMACSp) (push (format "EMACS=%s (term:%s)" emacs-version term-protocol-version) process-environment)) - (apply 'start-process name buffer + (apply #'start-process name buffer "/bin/sh" "-c" (format "stty -nl echo rows %d columns %d sane 2>/dev/null;\ if [ $1 = .. ]; then shift; fi; exec \"$@\"" @@ -2092,7 +2075,7 @@ Argument 0 is the command name." (let ((n (or nth (1- count))) (m (if mth (1- (- count mth)) 0))) (mapconcat - (function (lambda (a) a)) (nthcdr n (nreverse (nthcdr m args))) " ")))) + #'identity (nthcdr n (nreverse (nthcdr m args))) " ")))) ;;; ;;; Input processing stuff [line mode] @@ -2172,10 +2155,7 @@ Similarly for Soar, Scheme, etc." (not (string-equal (ring-ref term-input-ring 0) history)))) (ring-insert term-input-ring history)) - (let ((functions term-input-filter-functions)) - (while functions - (funcall (car functions) (concat input "\n")) - (setq functions (cdr functions)))) + (run-hook-with-args 'term-input-filter-functions (concat input "\n")) (setq term-input-ring-index nil) ;; Update the markers before we send the input @@ -3009,7 +2989,7 @@ See `term-prompt-regexp'." (?\C-g ;; (terminfo: bel) (beep t)) (?\032 ; Emacs specific control sequence. - (funcall term-command-hook + (funcall term-command-function (decode-coding-string (substring str (1+ i) (- ctl-end @@ -3103,8 +3083,10 @@ See `term-prompt-regexp'." (setq term-terminal-undecoded-bytes (substring str (1- i))) (aset term-terminal-undecoded-bytes 0 ?\r)) (goto-char (point-max))) + ;; FIXME: Use (add-function :override (process-filter proc) (make-local-variable 'term-pager-old-filter) (setq term-pager-old-filter (process-filter proc)) + ;; FIXME: Where is `term-pager-filter' set to a function?! (set-process-filter proc term-pager-filter) (setq i str-length)) (setq i ctl-end))))) @@ -3486,7 +3468,7 @@ The top-most line is line 0." ;; (setq term-current-row 0) ;; (term-goto row col)))) -;; Default value for the symbol term-command-hook. +;; Default value for the symbol term-command-function. (defun term-command-hook (string) (cond ((equal string "") @@ -4040,9 +4022,7 @@ Calls the functions in `term-dynamic-complete-functions' to perform completion until a function returns non-nil, at which point completion is assumed to have occurred." (interactive) - (let ((functions term-dynamic-complete-functions)) - (while (and functions (null (funcall (car functions)))) - (setq functions (cdr functions))))) + (run-hook-with-args-until-success 'term-dynamic-complete-functions)) (defun term-dynamic-complete-filename () @@ -4142,7 +4122,6 @@ Returns `listed' if a completion listing was shown. See also `term-dynamic-complete-filename'." (declare (obsolete completion-in-region "23.2")) (let* ((completion-ignore-case nil) - (candidates (mapcar (function (lambda (x) (list x))) candidates)) (completions (all-completions stub candidates))) (cond ((null completions) (message "No completions of %s" stub) @@ -4367,9 +4346,9 @@ well as the newer ports COM10 and higher." (setq serial-name-history file-name-history)) (when (or (null x) (and (stringp x) (zerop (length x)))) (error "No serial port selected")) - (when (and (not (serial-port-is-file-p)) - (not (string-match "\\\\" x))) - (set 'x (concat "\\\\.\\" x))) + (when (not (or (serial-port-is-file-p) + (string-match "\\\\" x))) + (setq x (concat "\\\\.\\" x))) x)) (defun serial-read-speed () @@ -4423,8 +4402,8 @@ use in that buffer. (term-char-mode) (goto-char (point-max)) (set-marker (process-mark process) (point)) - (set-process-filter process 'term-emulate-terminal) - (set-process-sentinel process 'term-sentinel)) + (set-process-filter process #'term-emulate-terminal) + (set-process-sentinel process #'term-sentinel)) (switch-to-buffer buffer) buffer)) @@ -4561,27 +4540,19 @@ The return value may be nil for a special serial port." ;; term-mode will take care of it. The following example, from shell.el, ;; is typical: ;; -;; (defvar shell-mode-map '()) -;; (cond ((not shell-mode-map) -;; (setq shell-mode-map (copy-keymap term-mode-map)) -;; (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command) -;; (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command) -;; (define-key shell-mode-map "\t" 'term-dynamic-complete) -;; (define-key shell-mode-map "\M-?" -;; 'term-dynamic-list-filename-completions))) -;; -;; (defun shell-mode () -;; (interactive) -;; (term-mode) -;; (setq term-prompt-regexp shell-prompt-pattern) -;; (setq major-mode 'shell-mode) -;; (setq mode-name "Shell") -;; (use-local-map shell-mode-map) -;; (make-local-variable 'shell-directory-stack) -;; (setq shell-directory-stack nil) -;; (add-hook 'term-input-filter-functions 'shell-directory-tracker) -;; (run-mode-hooks 'shell-mode-hook)) +;; (defvar shell-mode-map +;; (let ((map (make-sparse-keymap))) +;; (define-key map "\C-c\C-f" 'shell-forward-command) +;; (define-key map "\C-c\C-b" 'shell-backward-command) +;; (define-key map "\t" 'term-dynamic-complete) +;; (define-key map "\M-?" +;; 'term-dynamic-list-filename-completions))) ;; +;; (define-derived-mode shell-mode term-mode "Shell" +;; "A shell mode." +;; (setq-local term-prompt-regexp shell-prompt-pattern) +;; (setq-local shell-directory-stack nil) +;; (add-hook 'term-input-filter-functions #'shell-directory-tracker nil t)) ;; ;; Completion for term-mode users ;; commit 467e6ccb85e89cbfaccb25bb392d24a0511044fc Author: John Shahid Date: Sun Jan 20 19:08:17 2019 -0500 Adjust line wrapping on window resize and killing text * lisp/term.el (term-mode): Advice filter-buffer-substring-function to remove line unwrapping from killed text. (term-reset-size): Add or remove line unwrapping depending on the new terminal width. (term-suppress-hard-newline): Mark obsolete. (term-unwrap-line): Use text properties to be able to find the newlines later. diff --git a/lisp/term.el b/lisp/term.el index f49777f94c..fdcc39de72 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -545,6 +545,9 @@ This means text can automatically reflow if the window is resized." :version "24.4" :type 'boolean :group 'term) +(make-obsolete-variable 'term-suppress-hard-newline nil + "27.1" + 'set) ;; Where gud-display-frame should put the debugging arrow. This is ;; set by the marker-filter, which scans the debugger's output for @@ -1116,6 +1119,9 @@ Entry to this mode runs the hooks on `term-mode-hook'." (set (make-local-variable 'font-lock-defaults) '(nil t)) + (add-function :filter-return + (local 'filter-buffer-substring-function) + #'term--filter-buffer-substring) (add-function :filter-return (local 'window-adjust-process-window-size-function) (lambda (size) @@ -1132,9 +1138,51 @@ Entry to this mode runs the hooks on `term-mode-hook'." (setq term-input-ring (make-ring term-input-ring-size))) (term-update-mode-line)) +(defun term--remove-fake-newlines () + (goto-char (point-min)) + (let (fake-newline) + (while (setq fake-newline (next-single-property-change (point) + 'term-line-wrap)) + (goto-char fake-newline) + (assert (eq ?\n (char-after))) + (let ((inhibit-read-only t)) + (delete-char 1))))) + +(defun term--filter-buffer-substring (content) + (with-temp-buffer + (insert content) + (term--remove-fake-newlines) + (buffer-string))) + +(defun term--unwrap-visible-long-lines (width) + ;; Unwrap lines longer than width using fake newlines. Only do it + ;; for lines that are currently visible (i.e. following the home + ;; marker). Invisible lines don't have to be unwrapped since they + ;; are unreachable using the cursor movement anyway. Not having to + ;; unwrap the entire buffer means the runtime of this function is + ;; bounded by the size of the screen instead of the buffer size. + + (save-excursion + ;; We will just assume that our accounting for the home marker is + ;; correct, i.e. programs will not try to reach any position + ;; earlier than this marker. + (goto-char term-home-marker) + + (move-to-column width) + (while (not (eobp)) + (if (eolp) + (forward-char) + (let ((inhibit-read-only t)) + (term-unwrap-line))) + (move-to-column width)))) + (defun term-reset-size (height width) (when (or (/= height term-height) (/= width term-width)) + ;; Delete all newlines used for wrapping + (when (/= width term-width) + (save-excursion + (term--remove-fake-newlines))) (let ((point (point))) (setq term-height height) (setq term-width width) @@ -1147,7 +1195,8 @@ Entry to this mode runs the hooks on `term-mode-hook'." (setq term-start-line-column nil) (setq term-current-row nil) (setq term-current-column nil) - (goto-char point)))) + (goto-char point)) + (term--unwrap-visible-long-lines width))) ;; Recursive routine used to check if any string in term-kill-echo-list ;; matches part of the buffer before point. @@ -3719,7 +3768,10 @@ all pending output has been dealt with.")) ;; if the line above point wraps around, add a ?\n to undo the wrapping. ;; FIXME: Probably should be called more than it is. (defun term-unwrap-line () - (when (not (bolp)) (insert-before-markers ?\n))) + (when (not (bolp)) + (let ((old-point (point))) + (insert-before-markers ?\n) + (put-text-property old-point (point) 'term-line-wrap t)))) (defun term-erase-in-line (kind) (when (= kind 1) ;; erase left of point commit 28f7e981c10cddd06b879a79ade214f273ba4498 Author: Eric Abrahamsen Date: Wed Jan 30 12:31:49 2019 -0800 Make pinyin to Chinese character mapping available to elisp * leim/Makefile.in: Build the file pinyin.el from pinyin.map. * lisp/international/titdic-cnv.el (pinyin-convert): New function that writes the library pinyin.el, containing a new constant `pinyin-character-map'. * .gitignore: Ignore the generated pinyin.el file. diff --git a/.gitignore b/.gitignore index 81d3adfb57..355824f390 100644 --- a/.gitignore +++ b/.gitignore @@ -199,6 +199,7 @@ lisp/international/charscript.el lisp/international/cp51932.el lisp/international/eucjp-ms.el lisp/international/uni-*.el +lisp/language/pinyin.el # Documentation. *.aux diff --git a/leim/Makefile.in b/leim/Makefile.in index c2fc8c41f2..4307d50087 100644 --- a/leim/Makefile.in +++ b/leim/Makefile.in @@ -84,7 +84,8 @@ MISC= \ ${leimdir}/quail/PY.el \ ${leimdir}/quail/ZIRANMA.el \ ${leimdir}/quail/CTLau.el \ - ${leimdir}/quail/CTLau-b5.el + ${leimdir}/quail/CTLau-b5.el \ + ${srcdir}/../lisp/language/pinyin.el ## All the generated .el files. TIT_MISC = ${TIT_GB} ${TIT_BIG5} ${MISC} @@ -142,6 +143,9 @@ ${leimdir}/ja-dic/ja-dic.el: $(srcdir)/SKK-DIC/SKK-JISYO.L $(AM_V_GEN)$(RUN_EMACS) -batch -l ja-dic-cnv \ -f batch-skkdic-convert -dir "$(leimdir)/ja-dic" "$<" +${srcdir}/../lisp/language/pinyin.el: ${srcdir}/MISC-DIC/pinyin.map + $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv -f pinyin-convert $< $@ + .PHONY: bootstrap-clean distclean maintainer-clean extraclean diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el index 2ce2c527b9..e6065fb0f7 100644 --- a/lisp/international/titdic-cnv.el +++ b/lisp/international/titdic-cnv.el @@ -1203,6 +1203,38 @@ to store generated Quail packages." (miscdic-convert filename dir)))) (kill-emacs 0)) +(defun pinyin-convert () + "Convert text file pinyin.map into an elisp library. +The library is named pinyin.el, and contains the constant +`pinyin-character-map'." + (let ((src-file (car command-line-args-left)) + (dst-file (cadr command-line-args-left)) + (coding-system-for-write 'utf-8-unix)) + (with-temp-file dst-file + (insert ";; This file is automatically generated from pinyin.map,\ + by the\n;; function pinyin-convert.\n\n") + (insert "(defconst pinyin-character-map\n'(") + (let ((pos (point))) + (insert-file-contents src-file) + (goto-char pos) + (re-search-forward "^[a-z]") + (beginning-of-line) + (delete-region pos (point)) + (while (not (eobp)) + (insert "(\"") + (skip-chars-forward "a-z") + (insert "\" . \"") + (delete-char 1) + (end-of-line) + (while (= (preceding-char) ?\r) + (delete-char -1)) + (insert "\")") + (forward-line 1))) + (insert ")\n\"An alist holding correspondences between pinyin syllables\ + and\nChinese characters.\")\n\n") + (insert "(provide 'pinyin)\n")) + (kill-emacs 0))) + ;; Prevent "Local Variables" above confusing Emacs. commit 13e6275e58c3dc84fbb65bc9d05eb875e3096f5f Author: Richard Stallman Date: Sun Feb 24 10:45:34 2019 -0800 fix rmail armor decryption problems * lisp/mail/rmail.el (rmail-epa-decrypt): Don't decrypt an armor that was copied into the message from a message it is a reply to. (rmail-epa-decrypt-1): Catch and ignore errors in epa-decrypt-region. Make armor-start and armor-end markers. diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 36821e83e0..7f7f0e967d 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4544,6 +4544,9 @@ Argument MIME is non-nil if this is a mime message." (unless armor-end (error "Encryption armor beginning has no matching end")) + (setq armor-start (move-marker (make-marker) armor-start)) + (setq armor-end (move-marker (make-marker) armor-end)) + (goto-char armor-start) ;; Because epa--find-coding-system-for-mime-charset not autoloaded. @@ -4576,15 +4579,16 @@ Argument MIME is non-nil if this is a mime message." (mail-unquote-printable-region armor-start (- (point-max) after-end)))) - ;; Decrypt it, maybe in place, maybe making new buffer. - (epa-decrypt-region - armor-start (- (point-max) after-end) - ;; Call back this function to prepare the output. - (lambda () - (let ((inhibit-read-only t)) - (delete-region armor-start (- (point-max) after-end)) - (goto-char armor-start) - (current-buffer)))) + (condition-case nil + (epa-decrypt-region + armor-start (- (point-max) after-end) + ;; Call back this function to prepare the output. + (lambda () + (let ((inhibit-read-only t)) + (delete-region armor-start (- (point-max) after-end)) + (goto-char armor-start) + (current-buffer)))) + (error nil)) (list armor-start (- (point-max) after-end) mime armor-end-regexp @@ -4620,9 +4624,14 @@ Argument MIME is non-nil if this is a mime message." (goto-char (point-min)) (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t) (let ((coding-system-for-read coding-system-for-read) - (case-fold-search t)) - - (push (rmail-epa-decrypt-1 mime) decrypts))) + (case-fold-search t) + (armor-start (match-beginning 0))) + ;; Don't decrypt an armor that was copied into + ;; the message from a message it is a reply to. + (or (equal (buffer-substring (line-beginning-position) + armor-start) + "> ") + (push (rmail-epa-decrypt-1 mime) decrypts)))) (when (and decrypts (eq major-mode 'rmail-mode)) (rmail-add-label "decrypt")) commit 5a513470276f1f48ee44f4409a323ba526c18f4e Author: Richard Stallman Date: Sun Feb 24 08:45:41 2019 -0800 Don't clobber epa-mail-aliases * lisp/epa-mail.el (epa-mail-default-recipients): Copy elements of epa-mail-aliases; don't clobber them. diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index ce71ed8f9e..1bb8d9bfde 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -150,7 +150,7 @@ If no one is selected, default secret key is used. " (mapcar (lambda (recipient) (let ((tem (assoc recipient epa-mail-aliases))) - (if tem (cdr tem) + (if tem (copy-sequence (cdr tem)) (list recipient)))) real-recipients))) ))) commit 982e8f7b2165294493a2bf30a99f3c83cb54c092 Author: Eli Zaretskii Date: Sun Feb 24 18:03:21 2019 +0200 * doc/lispref/text.texi (Replacing): Fix a typo in recent change. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 88843c3764..ceb2a37120 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4472,7 +4472,7 @@ replacement could be performed. Otherwise, i.e., if MAX-SECS was exceeded, it returns nil. @end deffn -@defun Command replace-region-contents beg end replace-fn &optional max-secs max-costs +@deffn Command replace-region-contents beg end replace-fn &optional max-secs max-costs This function replaces the region between @code{beg} and @code{end} using the given @code{replace-fn}. The function @code{replace-fn} is run in the current buffer narrowed to the specified region and it commit cbcb5718761dc645c291110ceb7250628510b1dc Author: Michael Albinus Date: Sun Feb 24 11:15:49 2019 +0100 Cleanup also recentf files in Tramp * doc/misc/tramp.texi (Cleanup remote connections): Mention also recentf cache. * lisp/net/tramp-cmds.el (tramp-cleanup-connection) (tramp-cleanup-all-connections): Call `tramp-recentf-cleanup'. * lisp/net/tramp-integration.el: New package. * lisp/net/tramp.el (tramp-rfn-eshadow-overlay) (tramp-rfn-eshadow-setup-minibuffer) (tramp-rfn-eshadow-update-overlay-regexp) (tramp-rfn-eshadow-update-overlay): (tramp-eshell-directory-change): Move to tramp-integration.el diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 7587059f39..3630c317b2 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3166,7 +3166,8 @@ interactively, this command lists active remote connections in the minibuffer. Each connection is of the format @file{@trampfn{method,user@@host,}}. Flushing remote connections also cleans the password cache (@pxref{Password handling}), file cache, -connection cache (@pxref{Connection caching}), and connection buffers. +connection cache (@pxref{Connection caching}), recentf cache +(@pxref{File Conveniences, , , emacs}), and connection buffers. @end deffn @deffn Command tramp-cleanup-this-connection diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 325d19361c..38e440e093 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -118,7 +118,10 @@ When called interactively, a Tramp connection has to be selected." (unless keep-debug (get-buffer (tramp-debug-buffer-name vec))) (tramp-get-connection-property vec "process-buffer" nil))) - (when (bufferp buf) (kill-buffer buf))))) + (when (bufferp buf) (kill-buffer buf))) + + ;; Remove recentf files. + (tramp-recentf-cleanup vec))) ;;;###tramp-autoload (defun tramp-cleanup-this-connection () @@ -162,7 +165,11 @@ This includes password cache, file cache, connection cache, buffers." ;; Remove buffers. (dolist (name (tramp-list-tramp-buffers)) - (when (bufferp (get-buffer name)) (kill-buffer name)))) + (when (bufferp (get-buffer name)) (kill-buffer name))) + + ;; Remove recentf files. + (dolist (v (tramp-list-connections)) + (tramp-recentf-cleanup v))) ;;;###tramp-autoload (defun tramp-cleanup-all-buffers () diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el new file mode 100644 index 0000000000..f3f95f1b69 --- /dev/null +++ b/lisp/net/tramp-integration.el @@ -0,0 +1,159 @@ +;;; tramp-integration.el --- Tramp integration into other packages -*- lexical-binding:t -*- + +;; Copyright (C) 2019 Free Software Foundation, Inc. + +;; Author: Michael Albinus +;; Keywords: comm, processes +;; Package: tramp + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This assembles all integration of Tramp with other packages. + +;;; Code: + +;; Pacify byte-compiler. +(require 'cl-lib) +(declare-function tramp-compat-exec-path "tramp") +(declare-function tramp-dissect-file-name "tramp") +(declare-function tramp-file-name-equal-p "tramp") +(declare-function tramp-tramp-file-p "tramp") +(declare-function recentf-cleanup "recentf") +(defvar eshell-path-env) +(defvar recentf-exclude) +(defvar tramp-current-connection) +(defvar tramp-postfix-host-format) + +;;; Fontification of `read-file-name': + +(defvar tramp-rfn-eshadow-overlay) +(make-variable-buffer-local 'tramp-rfn-eshadow-overlay) + +(defun tramp-rfn-eshadow-setup-minibuffer () + "Set up a minibuffer for `file-name-shadow-mode'. +Adds another overlay hiding filename parts according to Tramp's +special handling of `substitute-in-file-name'." + (when minibuffer-completing-file-name + (setq tramp-rfn-eshadow-overlay + (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end))) + ;; Copy rfn-eshadow-overlay properties. + (let ((props (overlay-properties rfn-eshadow-overlay))) + (while props + ;; The `field' property prevents correct minibuffer + ;; completion; we exclude it. + (if (not (eq (car props) 'field)) + (overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props)) + (pop props) (pop props)))))) + +(add-hook 'rfn-eshadow-setup-minibuffer-hook + 'tramp-rfn-eshadow-setup-minibuffer) +(add-hook 'tramp-unload-hook + (lambda () + (remove-hook 'rfn-eshadow-setup-minibuffer-hook + 'tramp-rfn-eshadow-setup-minibuffer))) + +(defun tramp-rfn-eshadow-update-overlay-regexp () + (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format)) + +;; Package rfn-eshadow is preloaded in Emacs, but for some reason, +;; it only did (defvar rfn-eshadow-overlay) without giving it a global +;; value, so it was only declared as dynamically-scoped within the +;; rfn-eshadow.el file. This is now fixed in Emacs>26.1 but we still need +;; this defvar here for older releases. +(defvar rfn-eshadow-overlay) + +(defun tramp-rfn-eshadow-update-overlay () + "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input. +This is intended to be used as a minibuffer `post-command-hook' for +`file-name-shadow-mode'; the minibuffer should have already +been set up by `rfn-eshadow-setup-minibuffer'." + ;; In remote files name, there is a shadowing just for the local part. + (ignore-errors + (let ((end (or (overlay-end rfn-eshadow-overlay) + (minibuffer-prompt-end))) + ;; We do not want to send any remote command. + (non-essential t)) + (when (tramp-tramp-file-p (buffer-substring end (point-max))) + (save-excursion + (save-restriction + (narrow-to-region + (1+ (or (string-match-p + (tramp-rfn-eshadow-update-overlay-regexp) + (buffer-string) end) + end)) + (point-max)) + (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay) + (rfn-eshadow-update-overlay-hook nil) + file-name-handler-alist) + (move-overlay rfn-eshadow-overlay (point-max) (point-max)) + (rfn-eshadow-update-overlay)))))))) + +(add-hook 'rfn-eshadow-update-overlay-hook + 'tramp-rfn-eshadow-update-overlay) +(add-hook 'tramp-unload-hook + (lambda () + (remove-hook 'rfn-eshadow-update-overlay-hook + 'tramp-rfn-eshadow-update-overlay))) + +;;; Integration of eshell.el: + +;; eshell.el keeps the path in `eshell-path-env'. We must change it +;; when `default-directory' points to another host. +(defun tramp-eshell-directory-change () + "Set `eshell-path-env' to $PATH of the host related to `default-directory'." + ;; Remove last element of `(exec-path)', which is `exec-directory'. + ;; Use `path-separator' as it does eshell. + (setq eshell-path-env + (mapconcat + 'identity (butlast (tramp-compat-exec-path)) path-separator))) + +(eval-after-load "esh-util" + '(progn + (add-hook 'eshell-mode-hook + 'tramp-eshell-directory-change) + (add-hook 'eshell-directory-change-hook + 'tramp-eshell-directory-change) + (add-hook 'tramp-unload-hook + (lambda () + (remove-hook 'eshell-mode-hook + 'tramp-eshell-directory-change) + (remove-hook 'eshell-directory-change-hook + 'tramp-eshell-directory-change))))) + +;;; Integration of recentf.el: + +(defun tramp-recentf-exclude-predicate (name) + "Predicate to exclude a remote file name from recentf. +NAME must be equal to `tramp-current-connection'." + (when (file-remote-p name) + (tramp-file-name-equal-p + (tramp-dissect-file-name name) (car tramp-current-connection)))) + +(defun tramp-recentf-cleanup (vec) + "Remove all file names related to VEC from recentf." + (when (bound-and-true-p recentf-list) + (let ((tramp-current-connection `(,vec)) + (recentf-exclude '(tramp-recentf-exclude-predicate))) + (recentf-cleanup)))) + +(add-hook 'tramp-unload-hook + (lambda () (unload-feature 'tramp-integration 'force))) + +(provide 'tramp-integration) + +;;; tramp-integration.el ends here diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index efe75033f7..c2636274a3 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -56,13 +56,13 @@ ;;; Code: (require 'tramp-compat) +(require 'tramp-integration) (require 'trampver) ;; Pacify byte-compiler. (require 'cl-lib) (declare-function netrc-parse "netrc") (defvar auto-save-file-name-transforms) -(defvar eshell-path-env) (defvar ls-lisp-use-insert-directory-program) (defvar outline-regexp) @@ -2056,77 +2056,6 @@ For definition of that list see `tramp-set-completion-function'." ;; The method related defaults. (cdr (assoc method tramp-completion-function-alist)))) -;;; Fontification of `read-file-name': - -(defvar tramp-rfn-eshadow-overlay) -(make-variable-buffer-local 'tramp-rfn-eshadow-overlay) - -(defun tramp-rfn-eshadow-setup-minibuffer () - "Set up a minibuffer for `file-name-shadow-mode'. -Adds another overlay hiding filename parts according to Tramp's -special handling of `substitute-in-file-name'." - (when minibuffer-completing-file-name - (setq tramp-rfn-eshadow-overlay - (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end))) - ;; Copy rfn-eshadow-overlay properties. - (let ((props (overlay-properties rfn-eshadow-overlay))) - (while props - ;; The `field' property prevents correct minibuffer - ;; completion; we exclude it. - (if (not (eq (car props) 'field)) - (overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props)) - (pop props) (pop props)))))) - -(add-hook 'rfn-eshadow-setup-minibuffer-hook - 'tramp-rfn-eshadow-setup-minibuffer) -(add-hook 'tramp-unload-hook - (lambda () - (remove-hook 'rfn-eshadow-setup-minibuffer-hook - 'tramp-rfn-eshadow-setup-minibuffer))) - -(defun tramp-rfn-eshadow-update-overlay-regexp () - (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format)) - -;; Package rfn-eshadow is preloaded in Emacs, but for some reason, -;; it only did (defvar rfn-eshadow-overlay) without giving it a global -;; value, so it was only declared as dynamically-scoped within the -;; rfn-eshadow.el file. This is now fixed in Emacs>26.1 but we still need -;; this defvar here for older releases. -(defvar rfn-eshadow-overlay) - -(defun tramp-rfn-eshadow-update-overlay () - "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input. -This is intended to be used as a minibuffer `post-command-hook' for -`file-name-shadow-mode'; the minibuffer should have already -been set up by `rfn-eshadow-setup-minibuffer'." - ;; In remote files name, there is a shadowing just for the local part. - (ignore-errors - (let ((end (or (overlay-end rfn-eshadow-overlay) - (minibuffer-prompt-end))) - ;; We do not want to send any remote command. - (non-essential t)) - (when (tramp-tramp-file-p (buffer-substring end (point-max))) - (save-excursion - (save-restriction - (narrow-to-region - (1+ (or (string-match-p - (tramp-rfn-eshadow-update-overlay-regexp) - (buffer-string) end) - end)) - (point-max)) - (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay) - (rfn-eshadow-update-overlay-hook nil) - file-name-handler-alist) - (move-overlay rfn-eshadow-overlay (point-max) (point-max)) - (rfn-eshadow-update-overlay)))))))) - -(add-hook 'rfn-eshadow-update-overlay-hook - 'tramp-rfn-eshadow-update-overlay) -(add-hook 'tramp-unload-hook - (lambda () - (remove-hook 'rfn-eshadow-update-overlay-hook - 'tramp-rfn-eshadow-update-overlay))) - ;; Inodes don't exist for some file systems. Therefore we must ;; generate virtual ones. Used in `find-buffer-visiting'. The method ;; applied might be not so efficient (Ange-FTP uses hashes). But @@ -4899,31 +4828,6 @@ Only works for Bourne-like shells." (lambda () (remove-hook 'interrupt-process-functions #'tramp-interrupt-process)))) -;;; Integration of eshell.el: - -;; eshell.el keeps the path in `eshell-path-env'. We must change it -;; when `default-directory' points to another host. -(defun tramp-eshell-directory-change () - "Set `eshell-path-env' to $PATH of the host related to `default-directory'." - ;; Remove last element of `(exec-path)', which is `exec-directory'. - ;; Use `path-separator' as it does eshell. - (setq eshell-path-env - (mapconcat - 'identity (butlast (tramp-compat-exec-path)) path-separator))) - -(eval-after-load "esh-util" - '(progn - (add-hook 'eshell-mode-hook - 'tramp-eshell-directory-change) - (add-hook 'eshell-directory-change-hook - 'tramp-eshell-directory-change) - (add-hook 'tramp-unload-hook - (lambda () - (remove-hook 'eshell-mode-hook - 'tramp-eshell-directory-change) - (remove-hook 'eshell-directory-change-hook - 'tramp-eshell-directory-change))))) - ;; Checklist for `tramp-unload-hook' ;; - Unload all `tramp-*' packages ;; - Reset `file-name-handler-alist' commit 975893b229072aa1b5565cc1a73987fa83ed5b21 Author: Paul Eggert Date: Sat Feb 23 13:47:52 2019 -0800 Don’t assume timersub and gettimeofday POSIX does not specify timersub, and marks gettimeofday as obsolescent. Avoid porting problems by using timespec.h functions instead. * src/editfns.c: Include systime.h instead of sys/time.h. (EXTRA_CONTEXT_FIELDS): Replace start and max_secs with time_limit. All uses changed. This removes the need to call gettimeofday or timersub. * src/term.c (timeval_to_Time): Remove. Replace all uses with ... (current_Time): ... this new function, removing the need to call gettimeofday. diff --git a/src/editfns.c b/src/editfns.c index 8f21f8a677..b349bd59a2 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -20,7 +20,6 @@ along with GNU Emacs. If not, see . */ #include #include -#include #include #ifdef HAVE_PWD_H @@ -48,6 +47,7 @@ along with GNU Emacs. If not, see . */ #include "composite.h" #include "intervals.h" #include "ptr-bounds.h" +#include "systime.h" #include "character.h" #include "buffer.h" #include "window.h" @@ -1935,8 +1935,7 @@ static unsigned short rbc_quitcounter; or inserted. */ \ unsigned char *deletions; \ unsigned char *insertions; \ - struct timeval start; \ - double max_secs; \ + struct timespec time_limit; \ unsigned int early_abort_tests; #define NOTE_DELETE(ctx, xoff) set_bit ((ctx)->deletions, (xoff)) @@ -2037,6 +2036,17 @@ nil. */) else CHECK_FIXNUM (max_costs); + struct timespec time_limit = make_timespec (0, -1); + if (!NILP (max_secs)) + { + struct timespec + tlim = timespec_add (current_timespec (), + lisp_time_argument (max_secs)), + tmax = make_timespec (TYPE_MAXIMUM (time_t), TIMESPEC_HZ - 1); + if (timespec_cmp (tlim, tmax) < 0) + time_limit = tlim; + } + /* Micro-optimization: Casting to size_t generates much better code. */ ptrdiff_t del_bytes = (size_t) size_a / CHAR_BIT + 1; @@ -2054,13 +2064,12 @@ nil. */) .bdiag = buffer + diags + size_b + 1, .heuristic = true, .too_expensive = XFIXNUM (max_costs), - .max_secs = FLOATP (max_secs) ? XFLOAT_DATA (max_secs) : -1.0, + .time_limit = time_limit, .early_abort_tests = 0 }; memclear (ctx.deletions, del_bytes); memclear (ctx.insertions, ins_bytes); - gettimeofday (&ctx.start, NULL); /* compareseq requires indices to be zero-based. We add BEGV back later. */ bool early_abort = compareseq (0, size_a, 0, size_b, false, &ctx); @@ -2213,13 +2222,9 @@ buffer_chars_equal (struct context *ctx, static bool compareseq_early_abort (struct context *ctx) { - if (ctx->max_secs < 0.0) + if (ctx->time_limit.tv_nsec < 0) return false; - - struct timeval now, diff; - gettimeofday (&now, NULL); - timersub (&now, &ctx->start, &diff); - return diff.tv_sec + diff.tv_usec / 1000000.0 > ctx->max_secs; + return timespec_cmp (ctx->time_limit, current_timespec ()) < 0; } diff --git a/src/term.c b/src/term.c index 7255f561e2..60ee861948 100644 --- a/src/term.c +++ b/src/term.c @@ -2435,15 +2435,14 @@ term_mouse_movement (struct frame *frame, Gpm_Event *event) return 0; } -/* Return the Time that corresponds to T. Wrap around on overflow. */ +/* Return the current time, as a Time value. Wrap around on overflow. */ static Time -timeval_to_Time (struct timeval const *t) +current_Time (void) { - Time s_1000, ms; - - s_1000 = t->tv_sec; + struct timespec now = current_timespec (); + Time s_1000 = now.tv_sec; s_1000 *= 1000; - ms = t->tv_usec / 1000; + Time ms = now.tv_nsec / 1000000; return s_1000 + ms; } @@ -2465,8 +2464,6 @@ term_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y, Time *timeptr) { - struct timeval now; - *fp = SELECTED_FRAME (); (*fp)->mouse_moved = 0; @@ -2475,8 +2472,7 @@ term_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, XSETINT (*x, last_mouse_x); XSETINT (*y, last_mouse_y); - gettimeofday(&now, 0); - *timeptr = timeval_to_Time (&now); + *timeptr = current_Time (); } /* Prepare a mouse-event in *RESULT for placement in the input queue. @@ -2488,7 +2484,6 @@ static Lisp_Object term_mouse_click (struct input_event *result, Gpm_Event *event, struct frame *f) { - struct timeval now; int i, j; result->kind = GPM_CLICK_EVENT; @@ -2499,8 +2494,7 @@ term_mouse_click (struct input_event *result, Gpm_Event *event, break; } } - gettimeofday(&now, 0); - result->timestamp = timeval_to_Time (&now); + result->timestamp = current_Time (); if (event->type & GPM_UP) result->modifiers = up_modifier; commit e96923c188a2a38d09917c5b7f606187a1413a96 Author: Tassilo Horn Date: Sat Feb 23 21:18:36 2019 +0100 Improve replace-buffer-contents/replace-region-contents * src/editfns.c (Freplace_buffer_contents): Add two optional arguments for mitigating performance issues. * lisp/emacs-lisp/subr-x.el (replace-region-contents): Move from subr.el. Add the same two arguments as for replace-buffer-contents. * lisp/json.el (json-pretty-print-max-secs): New variable holding the default MAX-SECS value json-pretty-print passes to replace-buffer-contents. (json-pretty-print): Use it. * doc/lispref/text.texi (Replacing): Add documentation for replace-buffer-contents two new optional arguments. Document replace-region-contents. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 6dfd211d1a..88843c3764 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4436,20 +4436,57 @@ all markers unrelocated. You can use the following function to replace the text of one buffer with the text of another buffer: -@deffn Command replace-buffer-contents source +@deffn Command replace-buffer-contents source &optional max-secs max-costs This function replaces the accessible portion of the current buffer with the accessible portion of the buffer @var{source}. @var{source} may either be a buffer object or the name of a buffer. When @code{replace-buffer-contents} succeeds, the text of the accessible portion of the current buffer will be equal to the text of the -accessible portion of the @var{source} buffer. This function attempts -to keep point, markers, text properties, and overlays in the current -buffer intact. One potential case where this behavior is useful is -external code formatting programs: they typically write the -reformatted text into a temporary buffer or file, and using -@code{delete-region} and @code{insert-buffer-substring} would destroy -these properties. However, the latter combination is typically -faster. @xref{Deletion}, and @ref{Insertion}. +accessible portion of the @var{source} buffer. + +This function attempts to keep point, markers, text properties, and +overlays in the current buffer intact. One potential case where this +behavior is useful is external code formatting programs: they +typically write the reformatted text into a temporary buffer or file, +and using @code{delete-region} and @code{insert-buffer-substring} +would destroy these properties. However, the latter combination is +typically faster (@xref{Deletion}, and @ref{Insertion}). + +For its working, @code{replace-buffer-contents} needs to compare the +contents of the original buffer with that of @code{source} which is a +costly operation if the buffers are huge and there is a high number of +differences between them. In order to keep +@code{replace-buffer-contents}'s runtime in bounds, it has two +optional arguments. + +@code{max-secs} defines a hard boundary in terms of seconds. If given +and exceeded, it will fall back to @code{delete-region} and +@code{insert-buffer-substring}. + +@code{max-costs} defines the quality of the difference computation. +If the actual costs exceed this limit, heuristics are used to provide +a faster but suboptimal solution. The default value is 1000000. + +@code{replace-buffer-contents} returns t if a non-destructive +replacement could be performed. Otherwise, i.e., if MAX-SECS was +exceeded, it returns nil. +@end deffn + +@defun Command replace-region-contents beg end replace-fn &optional max-secs max-costs +This function replaces the region between @code{beg} and @code{end} +using the given @code{replace-fn}. The function @code{replace-fn} is +run in the current buffer narrowed to the specified region and it +should return either a string or a buffer replacing the region. + +The replacement is performed using @code{replace-buffer-contents} +which also describes the @code{max-secs} and @code{max-costs} +arguments and the return value. + +Note: If the replacement is a string, it will be placed in a temporary +buffer so that @code{replace-buffer-contents} can operate on it. +Therefore, if you already have the replacement in a buffer, it makes +no sense to convert it to a string using @code{buffer-substring} or +similar. @end deffn @node Decompression diff --git a/etc/NEWS b/etc/NEWS index 3c5fb24b0e..67e376d9b3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -335,6 +335,16 @@ the node "(emacs) Directory Variables" of the user manual. 'make-network-process' now uses the correct loopback address when asked to use :host 'local and :family 'ipv6. ++++ +** The new function `replace-region-contents' replaces the current +region using a given replacement-function in a non-destructive manner +(in terms of `replace-buffer-contents'). + ++++ +** The command `replace-buffer-contents' now has two optional +arguments mitigating performance issues when operating on huge +buffers. + * Changes in Specialized Modes and Packages in Emacs 27.1 diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 7d9f0bba4c..b9ffe6a6fc 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -250,6 +250,35 @@ TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"." (substring string 0 (- (length string) (length suffix))) string)) +(defun replace-region-contents (beg end replace-fn + &optional max-secs max-costs) + "Replace the region between BEG and END using REPLACE-FN. +REPLACE-FN runs on the current buffer narrowed to the region. It +should return either a string or a buffer replacing the region. + +The replacement is performed using `replace-buffer-contents' +which also describes the MAX-SECS and MAX-COSTS arguments and the +return value. + +Note: If the replacement is a string, it'll be placed in a +temporary buffer so that `replace-buffer-contents' can operate on +it. Therefore, if you already have the replacement in a buffer, +it makes no sense to convert it to a string using +`buffer-substring' or similar." + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let ((repl (funcall replace-fn))) + (if (bufferp repl) + (replace-buffer-contents repl max-secs max-costs) + (let ((source-buffer (current-buffer))) + (with-temp-buffer + (insert repl) + (let ((tmp-buffer (current-buffer))) + (set-buffer source-buffer) + (replace-buffer-contents tmp-buffer max-secs max-costs))))))))) + (provide 'subr-x) ;;; subr-x.el ends here diff --git a/lisp/json.el b/lisp/json.el index 19b8f09dcd..44b3c33df7 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -49,10 +49,13 @@ ;; 2008-02-21 - Installed in GNU Emacs. ;; 2011-10-17 - Patch `json-alist-p' and `json-plist-p' to avoid recursion -tzz ;; 2012-10-25 - Added pretty-printed reformatting -Ryan Crum (ryan@ryancrum.org) +;; 2019-02-02 - Pretty-printing now uses replace-region-contents and support for +;; minimization -tsdh ;;; Code: (require 'map) +(require 'subr-x) ;; Parameters @@ -738,6 +741,12 @@ With prefix argument MINIMIZE, minimize it instead." (interactive "P") (json-pretty-print (point-min) (point-max) minimize)) +(defvar json-pretty-print-max-secs 2.0 + "Maximum time for `json-pretty-print's comparison. +The function `json-pretty-print' uses `replace-region-contents' +(which see) passing the value of this variable as argument +MAX-SECS.") + (defun json-pretty-print (begin end &optional minimize) "Pretty-print selected region. With prefix argument MINIMIZE, minimize it instead." @@ -749,7 +758,11 @@ With prefix argument MINIMIZE, minimize it instead." (json-object-type 'alist)) (replace-region-contents begin end - (lambda () (json-encode (json-read)))))) + (lambda () (json-encode (json-read))) + json-pretty-print-max-secs + ;; FIXME: What's a good value here? Can we use something better, + ;; e.g., by deriving a value from the size of the region? + 64))) (defun json-pretty-print-buffer-ordered (&optional minimize) "Pretty-print current buffer with object keys ordered. diff --git a/lisp/subr.el b/lisp/subr.el index 69ae804e20..5c8b84b8e9 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5476,30 +5476,4 @@ returned list are in the same order as in TREE. ;; for discoverability: (defalias 'flatten-list 'flatten-tree) -(defun replace-region-contents (beg end replace-fn) - "Replace the region between BEG and END using REPLACE-FN. -REPLACE-FN runs on the current buffer narrowed to the region. It -should return either a string or a buffer replacing the region. - -The replacement is performed using `replace-buffer-contents'. - -Note: If the replacement is a string, it'll be placed in a -temporary buffer so that `replace-buffer-contents' can operate on -it. Therefore, if you already have the replacement in a buffer, -it makes no sense to convert it to a string using -`buffer-substring' or similar." - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (let ((repl (funcall replace-fn))) - (if (bufferp repl) - (replace-buffer-contents repl) - (let ((source-buffer (current-buffer))) - (with-temp-buffer - (insert repl) - (let ((tmp-buffer (current-buffer))) - (set-buffer source-buffer) - (replace-buffer-contents tmp-buffer))))))))) - ;;; subr.el ends here diff --git a/src/editfns.c b/src/editfns.c index 7a600bacf1..8f21f8a677 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -20,6 +20,7 @@ along with GNU Emacs. If not, see . */ #include #include +#include #include #ifdef HAVE_PWD_H @@ -1912,10 +1913,6 @@ determines whether case is significant or ignored. */) #undef EQUAL #define USE_HEURISTIC -#ifdef USE_HEURISTIC -#define DIFFSEQ_HEURISTIC -#endif - /* Counter used to rarely_quit in replace-buffer-contents. */ static unsigned short rbc_quitcounter; @@ -1937,30 +1934,54 @@ static unsigned short rbc_quitcounter; /* Bit vectors recording for each character whether it was deleted or inserted. */ \ unsigned char *deletions; \ - unsigned char *insertions; + unsigned char *insertions; \ + struct timeval start; \ + double max_secs; \ + unsigned int early_abort_tests; #define NOTE_DELETE(ctx, xoff) set_bit ((ctx)->deletions, (xoff)) #define NOTE_INSERT(ctx, yoff) set_bit ((ctx)->insertions, (yoff)) +#define EARLY_ABORT(ctx) compareseq_early_abort (ctx) struct context; static void set_bit (unsigned char *, OFFSET); static bool bit_is_set (const unsigned char *, OFFSET); static bool buffer_chars_equal (struct context *, OFFSET, OFFSET); +static bool compareseq_early_abort (struct context *); #include "minmax.h" #include "diffseq.h" DEFUN ("replace-buffer-contents", Freplace_buffer_contents, - Sreplace_buffer_contents, 1, 1, "bSource buffer: ", + Sreplace_buffer_contents, 1, 3, "bSource buffer: ", doc: /* Replace accessible portion of current buffer with that of SOURCE. SOURCE can be a buffer or a string that names a buffer. Interactively, prompt for SOURCE. + As far as possible the replacement is non-destructive, i.e. existing buffer contents, markers, properties, and overlays in the current buffer stay intact. -Warning: this function can be slow if there's a large number of small -differences between the two buffers. */) - (Lisp_Object source) + +Because this function can be very slow if there is a large number of +differences between the two buffers, there are two optional arguments +mitigating this issue. + +The MAX-SECS argument, if given, defines a hard limit on the time used +for comparing the buffers. If it takes longer than MAX-SECS, the +function falls back to a plain `delete-region' and +`insert-buffer-substring'. (Note that the checks are not performed +too evenly over time, so in some cases it may run a bit longer than +allowed). + +The optional argument MAX-COSTS defines the quality of the difference +computation. If the actual costs exceed this limit, heuristics are +used to provide a faster but suboptimal solution. The default value +is 1000000. + +This function returns t if a non-destructive replacement could be +performed. Otherwise, i.e., if MAX-SECS was exceeded, it returns +nil. */) + (Lisp_Object source, Lisp_Object max_secs, Lisp_Object max_costs) { struct buffer *a = current_buffer; Lisp_Object source_buffer = Fget_buffer (source); @@ -1985,15 +2006,18 @@ differences between the two buffers. */) empty. */ if (a_empty && b_empty) - return Qnil; + return Qt; if (a_empty) - return Finsert_buffer_substring (source, Qnil, Qnil); + { + Finsert_buffer_substring (source, Qnil, Qnil); + return Qt; + } if (b_empty) { del_range_both (BEGV, BEGV_BYTE, ZV, ZV_BYTE, true); - return Qnil; + return Qt; } ptrdiff_t count = SPECPDL_INDEX (); @@ -2007,6 +2031,12 @@ differences between the two buffers. */) ptrdiff_t *buffer; USE_SAFE_ALLOCA; SAFE_NALLOCA (buffer, 2, diags); + + if (NILP (max_costs)) + XSETFASTINT (max_costs, 1000000); + else + CHECK_FIXNUM (max_costs); + /* Micro-optimization: Casting to size_t generates much better code. */ ptrdiff_t del_bytes = (size_t) size_a / CHAR_BIT + 1; @@ -2022,20 +2052,26 @@ differences between the two buffers. */) .insertions = SAFE_ALLOCA (ins_bytes), .fdiag = buffer + size_b + 1, .bdiag = buffer + diags + size_b + 1, -#ifdef DIFFSEQ_HEURISTIC .heuristic = true, -#endif - /* FIXME: Find a good number for .too_expensive. */ - .too_expensive = 64, + .too_expensive = XFIXNUM (max_costs), + .max_secs = FLOATP (max_secs) ? XFLOAT_DATA (max_secs) : -1.0, + .early_abort_tests = 0 }; memclear (ctx.deletions, del_bytes); memclear (ctx.insertions, ins_bytes); + + gettimeofday (&ctx.start, NULL); /* compareseq requires indices to be zero-based. We add BEGV back later. */ bool early_abort = compareseq (0, size_a, 0, size_b, false, &ctx); - /* Since we didn’t define EARLY_ABORT, we should never abort - early. */ - eassert (! early_abort); + + if (early_abort) + { + del_range (min_a, ZV); + Finsert_buffer_substring (source, Qnil,Qnil); + SAFE_FREE_UNBIND_TO (count, Qnil); + return Qnil; + } rbc_quitcounter = 0; @@ -2097,6 +2133,7 @@ differences between the two buffers. */) --i; --j; } + SAFE_FREE_UNBIND_TO (count, Qnil); rbc_quitcounter = 0; @@ -2106,7 +2143,7 @@ differences between the two buffers. */) update_compositions (BEGV, ZV, CHECK_INSIDE); } - return Qnil; + return Qt; } static void @@ -2173,6 +2210,18 @@ buffer_chars_equal (struct context *ctx, == BUF_FETCH_MULTIBYTE_CHAR (ctx->buffer_b, bpos_b); } +static bool +compareseq_early_abort (struct context *ctx) +{ + if (ctx->max_secs < 0.0) + return false; + + struct timeval now, diff; + gettimeofday (&now, NULL); + timersub (&now, &ctx->start, &diff); + return diff.tv_sec + diff.tv_usec / 1000000.0 > ctx->max_secs; +} + static void subst_char_in_region_unwind (Lisp_Object arg) @@ -4441,6 +4490,12 @@ it to be non-nil. */); binary_as_unsigned = true; #endif + DEFVAR_LISP ("replace-buffer-contents-max-secs", + Vreplace_buffer_contents_max_secs, + doc: /* If differencing the two buffers takes longer than this, +`replace-buffer-contents' falls back to a plain delete and insert. */); + Vreplace_buffer_contents_max_secs = Qnil; + defsubr (&Spropertize); defsubr (&Schar_equal); defsubr (&Sgoto_char); commit 5f640bfdf84753322763be23ebaa8ded92dc1c5d Author: Michael Albinus Date: Sat Feb 23 11:56:37 2019 +0100 Make last Tramp change backward compatible to Emacs 24 * lisp/net/tramp-cache.el (tramp-get-file-property): * lisp/net/tramp-sh.el (tramp-maybe-open-connection): * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): Make them backward compatible to Emacs 24. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 064b209ec2..0fb9bea14b 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -128,9 +128,14 @@ Returns DEFAULT if not set." (and (consp value) (or (null remote-file-name-inhibit-cache) (and (integerp remote-file-name-inhibit-cache) - (time-less-p nil - (time-add (car value) - remote-file-name-inhibit-cache))) + (time-less-p + ;; `current-time' can be nil once we get rid of Emacs 24. + (current-time) + (time-add + (car value) + ;; `seconds-to-time' can be removed once we get + ;; rid of Emacs 24. + (seconds-to-time remote-file-name-inhibit-cache)))) (and (consp remote-file-name-inhibit-cache) (time-less-p remote-file-name-inhibit-cache (car value))))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 91ff153293..2d02961db5 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4785,8 +4785,11 @@ connection if a previous connection has died for some reason." (not (tramp-file-name-equal-p vec (car tramp-current-connection))) (time-less-p - (or tramp-connection-min-time-diff 0) - (time-since (cdr tramp-current-connection)))) + ;; `current-time' can be removed once we get rid of Emacs 24. + (time-since (or (cdr tramp-current-connection) (current-time))) + ;; `seconds-to-time' can be removed once we get rid + ;; of Emacs 24. + (seconds-to-time (or tramp-connection-min-time-diff 0)))) (throw 'suppress 'suppress)) ;; If too much time has passed since last command was sent, look @@ -4797,10 +4800,11 @@ connection if a previous connection has died for some reason." ;; try to send a command from time to time, then look again ;; whether the process is really alive. (condition-case nil - (when (and (time-less-p 60 + ;; `seconds-to-time' can be removed once we get rid of Emacs 24. + (when (and (time-less-p (seconds-to-time 60) (time-since (tramp-get-connection-property - p "last-cmd-time" 0))) + p "last-cmd-time" (seconds-to-time 0)))) (process-live-p p)) (tramp-send-command vec "echo are you awake" t t) (unless (and (process-live-p p) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 31470b2979..eda30812eb 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1900,10 +1900,11 @@ If ARGUMENT is non-nil, use it as argument for ;; connection timeout. (with-current-buffer buf (goto-char (point-min)) - (when (and (time-less-p 60 + ;; `seconds-to-time' can be removed once we get rid of Emacs 24. + (when (and (time-less-p (seconds-to-time 60) (time-since (tramp-get-connection-property - p "last-cmd-time" 0))) + p "last-cmd-time" (seconds-to-time 0)))) (process-live-p p) (re-search-forward tramp-smb-errors nil t)) (delete-process p) commit c7e4bc974b7ec3d6fdae105df05fc19a2cf9fdbd Author: Felicián Németh Date: Wed Feb 13 21:19:36 2019 +0100 Jump to the current error in xref with zero prefix arg * xref.el (xref--next-error-function): Handle the corner case of n == 0. (Bug#34462) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 9522d7e475..6974d00048 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -694,8 +694,10 @@ references displayed in the current *xref* buffer." (let ((backward (< n 0)) (n (abs n)) (xref nil)) - (dotimes (_ n) - (setq xref (xref--search-property 'xref-item backward))) + (if (= n 0) + (setq xref (get-text-property (point) 'xref-item)) + (dotimes (_ n) + (setq xref (xref--search-property 'xref-item backward)))) (cond (xref ;; Save the current position (when the buffer is visible, ;; it gets reset to that window's point from time to time). commit 476066e89d6f0bb87220da690b8a476bf9655b80 Author: Paul Eggert Date: Fri Feb 22 18:32:31 2019 -0800 Avoid some double-rounding of Lisp timestamps Also, simplify some time-related Lisp timestamp code while we’re in the neighborhood. * lisp/battery.el (battery-linux-proc-acpi) (battery-linux-sysfs, battery-upower, battery-bsd-apm): * lisp/calendar/timeclock.el (timeclock-seconds-to-string) (timeclock-log, timeclock-last-period) (timeclock-entry-length, timeclock-entry-list-span) (timeclock-find-discrep, timeclock-generate-report): * lisp/cedet/ede/detect.el (ede-detect-qtest): * lisp/completion.el (cmpl-hours-since-origin): * lisp/ecomplete.el (ecomplete-decay-1): * lisp/emacs-lisp/ert.el (ert--results-update-stats-display) (ert--results-update-stats-display-maybe): * lisp/emacs-lisp/timer-list.el (list-timers): * lisp/emacs-lisp/timer.el (timer-until) (timer-event-handler): * lisp/erc/erc-backend.el (erc-server-send-ping) (erc-server-send-queue, erc-handle-parsed-server-response) (erc-handle-unknown-server-response): * lisp/erc/erc-track.el (erc-buffer-visible): * lisp/erc/erc.el (erc-lurker-cleanup, erc-lurker-p) (erc-cmd-PING, erc-send-current-line): * lisp/eshell/em-pred.el (eshell-pred-file-time): * lisp/eshell/em-unix.el (eshell-show-elapsed-time): * lisp/gnus/gnus-icalendar.el (gnus-icalendar-event:org-timestamp): * lisp/gnus/gnus-int.el (gnus-backend-trace): * lisp/gnus/gnus-sum.el (gnus-user-date): * lisp/gnus/mail-source.el (mail-source-delete-crash-box): * lisp/gnus/nnmaildir.el (nnmaildir--scan): * lisp/ibuf-ext.el (ibuffer-mark-old-buffers): * lisp/gnus/nnmaildir.el (nnmaildir--scan): * lisp/mouse.el (mouse--down-1-maybe-follows-link) (mouse--click-1-maybe-follows-link): * lisp/mpc.el (mpc--faster-toggle): * lisp/net/rcirc.el (rcirc-handler-ctcp-KEEPALIVE) (rcirc-sentinel): * lisp/net/tramp-cache.el (tramp-get-file-property): * lisp/net/tramp-sh.el (tramp-sh-handle-file-newer-than-file-p) (tramp-maybe-open-connection): * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): * lisp/org/org-clock.el (org-clock-resolve): (org-resolve-clocks, org-clock-in, org-clock-out, org-clock-sum): * lisp/org/org-timer.el (org-timer-start) (org-timer-pause-or-continue, org-timer-seconds): * lisp/org/org.el (org-evaluate-time-range): * lisp/org/ox-publish.el (org-publish-cache-ctime-of-src): * lisp/pixel-scroll.el (pixel-scroll-in-rush-p): * lisp/play/hanoi.el (hanoi-move-ring): * lisp/proced.el (proced-format-time): * lisp/progmodes/cpp.el (cpp-progress-message): * lisp/progmodes/flymake.el (flymake--handle-report): * lisp/progmodes/js.el (js--wait-for-matching-output): * lisp/subr.el (progress-reporter-do-update): * lisp/term/xterm.el (xterm--read-event-for-query): * lisp/time.el (display-time-update, emacs-uptime): * lisp/tooltip.el (tooltip-delay): * lisp/url/url-cookie.el (url-cookie-parse-file-netscape): * lisp/url/url-queue.el (url-queue-prune-old-entries): * lisp/url/url.el (url-retrieve-synchronously): * lisp/xt-mouse.el (xterm-mouse-event): Avoid double-rounding of time-related values. Simplify. * lisp/calendar/icalendar.el (icalendar--decode-isodatetime): When hoping for the best (unlikely), use a better decoded time. (icalendar--convert-sexp-to-ical): Avoid unnecessary encode-time. * lisp/calendar/timeclock.el (timeclock-when-to-leave): * lisp/cedet/ede/detect.el (ede-detect-qtest): * lisp/desktop.el (desktop-create-buffer): * lisp/emacs-lisp/benchmark.el (benchmark-elapse): * lisp/gnus/gnus-art.el (article-lapsed-string): * lisp/gnus/gnus-group.el (gnus-group-timestamp-delta): * lisp/gnus/nnmail.el (nnmail-expired-article-p): * lisp/gnus/nnmaildir.el (nnmaildir-request-expire-articles): * lisp/nxml/rng-maint.el (rng-time-function): * lisp/org/org-clock.el (org-clock-get-clocked-time) (org-clock-resolve, org-resolve-clocks, org-resolve-clocks-if-idle): * lisp/org/org-habit.el (org-habit-insert-consistency-graphs): * lisp/progmodes/vhdl-mode.el (vhdl-update-progress-info) (vhdl-fix-case-region-1): Use time-since instead of open-coding most of it. * lisp/erc/erc-dcc.el (erc-dcc-get-sentinel): * lisp/erc/erc.el (erc-string-to-emacs-time, erc-time-gt): Now obsolete. All uses changed. (erc-time-diff): Accept all Lisp time values. All uses changed. * lisp/gnus/gnus-demon.el (gnus-demon-idle-since): * lisp/gnus/gnus-score.el (gnus-score-headers): * lisp/gnus/nneething.el (nneething-make-head): * lisp/gnus/nnheader.el (nnheader-message-maybe): * lisp/gnus/nnimap.el (nnimap-keepalive): * lisp/image.el (image-animate-timeout): * lisp/mail/feedmail.el (feedmail-rfc822-date): * lisp/net/imap.el (imap-wait-for-tag): * lisp/net/newst-backend.el (newsticker--image-get): * lisp/net/rcirc.el (rcirc-handler-317, rcirc-handler-333): * lisp/obsolete/xesam.el (xesam-refresh-entry): * lisp/org/org-agenda.el (org-agenda-show-clocking-issues) (org-agenda-check-clock-gap, org-agenda-to-appt): * lisp/org/org-capture.el (org-capture-set-target-location): * lisp/org/org-clock.el (org-clock-resolve-clock) (org-clocktable-steps): * lisp/org/org-colview.el (org-columns-edit-value) (org-columns, org-agenda-columns): * lisp/org/org-duration.el (org-duration-from-minutes): * lisp/org/org-element.el (org-element-cache-sync-duration) (org-element-cache-sync-break) (org-element--cache-interrupt-p, org-element--cache-sync): * lisp/org/org-habit.el (org-habit-get-faces) * lisp/org/org-indent.el (org-indent-add-properties): * lisp/org/org-table.el (org-table-sum): * lisp/org/org-timer.el (org-timer-show-remaining-time) (org-timer-set-timer): * lisp/org/org.el (org-babel-load-file, org-today) (org-auto-repeat-maybe, org-2ft, org-time-stamp) (org-read-date-analyze, org-time-stamp-to-now) (org-small-year-to-year, org-goto-calendar): * lisp/org/ox.el (org-export-insert-default-template): * lisp/ses.el (ses--time-check): * lisp/type-break.el (type-break-time-warning) (type-break-statistics, type-break-demo-boring): * lisp/url/url-cache.el (url-cache-expired) (url-cache-prune-cache): * lisp/vc/vc-git.el (vc-git-stash-snapshot): * lisp/erc/erc-match.el (erc-log-matches-come-back): Simplify. diff --git a/lisp/battery.el b/lisp/battery.el index c21ba767fe..efd2a2181a 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -375,12 +375,12 @@ The following %-sequences are provided: last-full-capacity design-capacity)) (and capacity rate (setq minutes (if (zerop rate) 0 - (floor (* (/ (float (if (string= charging-state - "charging") - (- full-capacity capacity) - capacity)) - rate) - 60))) + (floor (* (if (string= charging-state + "charging") + (- full-capacity capacity) + capacity) + 60) + rate)) hours (/ minutes 60))) (list (cons ?c (or (and capacity (number-to-string capacity)) "N/A")) (cons ?L (or (battery-search-for-one-match-in-files @@ -414,8 +414,7 @@ The following %-sequences are provided: (cons ?p (or (and full-capacity capacity (> full-capacity 0) (number-to-string - (floor (/ capacity - (/ (float full-capacity) 100))))) + (floor (* 100 capacity) full-capacity))) "N/A"))))) @@ -471,9 +470,9 @@ The following %-sequences are provided: "POWER_SUPPLY_\\(CURRENT\\|POWER\\)_NOW=\\([0-9]*\\)$" nil t) (cl-incf power-now - (* (float (string-to-number (match-string 2))) + (* (string-to-number (match-string 2)) (if (eq (char-after (match-beginning 1)) ?C) - voltage-now 1.0)))) + voltage-now 1)))) (goto-char (point-min)) (when (re-search-forward "POWER_SUPPLY_TEMP=\\([0-9]*\\)$" nil t) (setq temperature (match-string 1))) @@ -585,9 +584,7 @@ The following %-sequences are provided: (when seconds (setq minutes (/ seconds 60) hours (/ minutes 60) - remaining-time - (format "%d:%02d" (truncate hours) - (- (truncate minutes) (* 60 (truncate hours)))))) + remaining-time (format "%d:%02d" hours (mod minutes 60)))) (list (cons ?c (or (and energy (number-to-string (round (* 1000 energy)))) "N/A")) @@ -656,10 +653,9 @@ The following %-sequences are provided: (setq minutes (string-to-number battery-life) seconds (* 60 minutes)) (setq seconds (string-to-number battery-life) - minutes (truncate (/ seconds 60)))) - (setq hours (truncate (/ minutes 60)) - remaining-time (format "%d:%02d" hours - (- minutes (* 60 hours))))) + minutes (truncate seconds 60))) + (setq hours (truncate minutes 60) + remaining-time (format "%d:%02d" hours (mod minutes 60)))) (list (cons ?L (or line-status "N/A")) (cons ?B (or (car battery-status) "N/A")) (cons ?b (or (cdr battery-status) "N/A")) diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index 57747c64f6..2126cfdadb 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -231,7 +231,7 @@ The result has the proper form for `calendar-daylight-savings-starts'." ;; https://lists.gnu.org/r/emacs-pretest-bug/2006-11/msg00060.html (defun calendar-dst-find-data (&optional time) "Find data on the first daylight saving time transitions after TIME. -TIME defaults to `current-time'. Return value is as described +TIME defaults to the current time. Return value is as described for `calendar-current-time-zone'." (let* ((t0 (or time (current-time))) (t0-zone (current-time-zone t0)) diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 31ace6fb9b..a8fd765129 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -643,12 +643,14 @@ FIXME: multiple comma-separated values should be allowed!" (setq year (nth 2 mdy)))) ;; create the decoded date-time ;; FIXME!?! - (condition-case nil - (decode-time (encode-time second minute hour day month year zone)) - (error - (message "Cannot decode \"%s\"" isodatetimestring) - ;; hope for the best... - (list second minute hour day month year 0 nil 0)))) + (let ((decoded-time (list second minute hour day month year + nil -1 zone))) + (condition-case nil + (decode-time (encode-time decoded-time 'integer)) + (error + (message "Cannot decode \"%s\"" isodatetimestring) + ;; Hope for the best.... + decoded-time)))) ;; isodatetimestring == nil nil)) @@ -1596,8 +1598,7 @@ regular expression matching the start of non-marking entries. ENTRY-MAIN is the first line of the diary entry. Optional argument START determines the first day of the -enumeration, given as a time value, in same format as returned by -`current-time' -- used for test purposes." +enumeration, given as a Lisp time value -- used for test purposes." (cond ((string-match (concat nonmarker "%%(and \\(([^)]+)\\))\\(\\s-*.*?\\) ?$") entry-main) @@ -1621,8 +1622,7 @@ enumeration, given as a time value, in same format as returned by (mapcar (lambda (offset) (let* ((day (decode-time (time-add now - (encode-time - (* offset 60 60 24))))) + (* 60 60 24 offset)))) (d (nth 3 day)) (m (nth 4 day)) (y (nth 5 day)) diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index 5c3580dd84..a896df5e57 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -467,16 +467,10 @@ include the second count. If REVERSE-LEADER is non-nil, it means to output a \"+\" if the time value is negative, rather than a \"-\". This is used when negative time values have an inverted meaning (such as with time remaining, where negative time really means overtime)." - (if show-seconds - (format "%s%d:%02d:%02d" - (if (< seconds 0) (if reverse-leader "+" "-") "") - (truncate (/ (abs seconds) 60 60)) - (% (truncate (/ (abs seconds) 60)) 60) - (% (truncate (abs seconds)) 60)) - (format "%s%d:%02d" + (let ((s (abs (truncate seconds)))) + (format (if show-seconds "%s%d:%02d:%02d" "%s%d:%02d") (if (< seconds 0) (if reverse-leader "+" "-") "") - (truncate (/ (abs seconds) 60 60)) - (% (truncate (/ (abs seconds) 60)) 60)))) + (/ s 3600) (% (/ s 60) 60) (% s 60)))) (defsubst timeclock-currently-in-p () "Return non-nil if the user is currently clocked in." @@ -528,13 +522,12 @@ non-nil, the amount returned will be relative to past time worked." "Return a time value representing the end of today's workday. If TODAY-ONLY is non-nil, the value returned will be relative only to the time worked today, and not to past time." - (time-subtract nil - (let ((discrep (timeclock-find-discrep))) - (if discrep - (if today-only - (cadr discrep) - (car discrep)) - 0)))) + (time-since (let ((discrep (timeclock-find-discrep))) + (if discrep + (if today-only + (cadr discrep) + (car discrep)) + 0)))) ;;;###autoload (defun timeclock-when-to-leave-string (&optional show-seconds @@ -671,8 +664,8 @@ being logged for. Normally only \"in\" events specify a project." "\n") (if (equal (downcase code) "o") (setq timeclock-last-period - (- (float-time now) - (float-time (cadr timeclock-last-event))) + (float-time + (time-subtract now (cadr timeclock-last-event))) timeclock-discrepancy (+ timeclock-discrepancy timeclock-last-period))) @@ -707,8 +700,7 @@ recorded to disk. If MOMENT is non-nil, use that as the current time. This is only provided for coherency when used by `timeclock-discrepancy'." (if (equal (car timeclock-last-event) "i") - (- (float-time moment) - (float-time (cadr timeclock-last-event))) + (float-time (time-subtract moment (cadr timeclock-last-event))) timeclock-last-period)) (cl-defstruct (timeclock-entry @@ -721,8 +713,7 @@ This is only provided for coherency when used by (defsubst timeclock-entry-length (entry) "Return the length of ENTRY in seconds." - (- (float-time (cadr entry)) - (float-time (car entry)))) + (float-time (time-subtract (cadr entry) (car entry)))) (defsubst timeclock-entry-list-length (entry-list) "Return the total length of ENTRY-LIST in seconds." @@ -741,8 +732,8 @@ This is only provided for coherency when used by (defsubst timeclock-entry-list-span (entry-list) "Return the total time in seconds spanned by ENTRY-LIST." - (- (float-time (timeclock-entry-list-end entry-list)) - (float-time (timeclock-entry-list-begin entry-list)))) + (float-time (time-subtract (timeclock-entry-list-end entry-list) + (timeclock-entry-list-begin entry-list)))) (defsubst timeclock-entry-list-break (entry-list) "Return the total break time (span - length) in ENTRY-LIST." @@ -1109,7 +1100,7 @@ discrepancy, today's discrepancy, and the time worked today." last-date-limited nil) (if beg (error "Error in format of timelog file!") - (setq beg (float-time (cadr event)))))) + (setq beg (cadr event))))) ((equal (downcase (car event)) "o") (if (and (nth 2 event) (> (length (nth 2 event)) 0)) @@ -1117,7 +1108,7 @@ discrepancy, today's discrepancy, and the time worked today." (if (not beg) (error "Error in format of timelog file!") (setq timeclock-last-period - (- (float-time (cadr event)) beg) + (float-time (time-subtract (cadr event) beg)) accum (+ timeclock-last-period accum) beg nil)) (if (equal last-date todays-date) @@ -1262,12 +1253,11 @@ HTML-P is non-nil, HTML markup is added." (unless (time-less-p (timeclock-day-begin day) (aref lengths i)) - (let ((base (float-time - (timeclock-day-base - (timeclock-day-begin day))))) + (let ((base (timeclock-day-base (timeclock-day-begin day)))) (nconc (aref time-in i) - (list (- (float-time (timeclock-day-begin day)) - base))) + (list (float-time (time-subtract + (timeclock-day-begin day) + base)))) (let ((span (timeclock-day-span day)) (len (timeclock-day-length day)) (req (timeclock-day-required day))) @@ -1278,8 +1268,9 @@ HTML-P is non-nil, HTML markup is added." (when (and (> span 0) (> (/ (float len) (float span)) 0.70)) (nconc (aref time-out i) - (list (- (float-time (timeclock-day-end day)) - base))) + (list (float-time (time-subtract + (timeclock-day-end day) + base)))) (nconc (aref breaks i) (list (- span len)))) (if req (setq len (+ len (- timeclock-workday req)))) diff --git a/lisp/cedet/ede/detect.el b/lisp/cedet/ede/detect.el index daffb6eb5a..e33f7a9a0f 100644 --- a/lisp/cedet/ede/detect.el +++ b/lisp/cedet/ede/detect.el @@ -198,7 +198,7 @@ Return a cons cell: (ans (ede-detect-directory-for-project default-directory))) (if ans (message "Project found in %d sec @ %s of type %s" - (float-time (time-subtract nil start)) + (encode-time (time-since start) 'integer) (car ans) (eieio-object-name-string (cdr ans))) (message "No Project found.") ))) diff --git a/lisp/completion.el b/lisp/completion.el index 1073ae8915..89285c74d4 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -432,7 +432,7 @@ Used to decide whether to save completions.") (defun cmpl-hours-since-origin () - (floor (float-time) 3600)) + (floor (encode-time nil 'integer) 3600)) ;;--------------------------------------------------------------------------- ;; "Symbol" parsing functions diff --git a/lisp/desktop.el b/lisp/desktop.el index a431d044b5..acabde5eb2 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -1544,10 +1544,10 @@ and try to load that." ;; for the sake of `clean-buffer-list': preserving the invariant ;; "how much time the user spent in Emacs without looking at this buffer". (setq buffer-display-time - (if buffer-display-time - (time-add buffer-display-time - (time-subtract nil desktop-file-modtime)) - (current-time))) + (time-since (if buffer-display-time + (time-subtract desktop-file-modtime + buffer-display-time) + 0))) (unless (< desktop-file-version 208) ; Don't misinterpret any old custom args (dolist (record compacted-vars) (let* diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el index fb23ead63f..d9f34ef0c0 100644 --- a/lisp/ecomplete.el +++ b/lisp/ecomplete.el @@ -210,7 +210,7 @@ matches." (defun ecomplete-decay-1 (elem) ;; We subtract 5% from the item for each week it hasn't been used. (/ (car elem) - (expt 1.05 (/ (- (float-time) (cadr elem)) + (expt 1.05 (/ (float-time (time-since (cadr elem))) (* 7 24 60 60))))) ;; `ecomplete-get-matches' uses substring matching, so also use the `substring' diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el index f7384e19a1..5b5cda3615 100644 --- a/lisp/emacs-lisp/benchmark.el +++ b/lisp/emacs-lisp/benchmark.el @@ -38,7 +38,7 @@ `(let (,t1) (setq ,t1 (current-time)) ,@forms - (float-time (time-subtract nil ,t1))))) + (float-time (time-since ,t1))))) ;;;###autoload (defmacro benchmark-run (&optional repetitions &rest forms) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index d6bd2c5967..20d013b079 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1822,13 +1822,13 @@ determines how frequently the progress display is updated.") (force-mode-line-update) (redisplay t) (setf (ert--stats-next-redisplay stats) - (+ (float-time) ert-test-run-redisplay-interval-secs))) + (float-time (time-add nil ert-test-run-redisplay-interval-secs)))) (defun ert--results-update-stats-display-maybe (ewoc stats) "Call `ert--results-update-stats-display' if not called recently. EWOC and STATS are arguments for `ert--results-update-stats-display'." - (when (>= (float-time) (ert--stats-next-redisplay stats)) + (unless (time-less-p nil (ert--stats-next-redisplay stats)) (ert--results-update-stats-display ewoc stats))) (defun ert--tests-running-mode-line-indicator () diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index c9b2fae7d9..81e2f91c0e 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -37,16 +37,14 @@ ;; Idle. (if (aref timer 7) "*" " ") ;; Next time. - (let ((time (float-time (list (aref timer 1) - (aref timer 2) - (aref timer 3))))) + (let ((time (list (aref timer 1) + (aref timer 2) + (aref timer 3)))) (format "%.2f" - (if (aref timer 7) - time - (- (float-time (list (aref timer 1) - (aref timer 2) - (aref timer 3))) - (float-time))))) + (float-time + (if (aref timer 7) + time + (time-subtract time nil))))) ;; Repeat. (let ((repeat (aref timer 4))) (cond diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 51d7e6f99e..f706d9bc62 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -74,7 +74,7 @@ (defun timer-set-time (timer time &optional delta) "Set the trigger time of TIMER to TIME. -TIME must be in the internal format returned by, e.g., `current-time'. +TIME must be a Lisp time value. If optional third argument DELTA is a positive number, make the timer fire repeatedly that many seconds apart." (setf (timer--time timer) time) @@ -249,8 +249,8 @@ how many will really happen." (defun timer-until (timer time) "Calculate number of seconds from when TIMER will run, until TIME. TIMER is a timer, and stands for the time when its next repeat is scheduled. -TIME is a time-list." - (- (float-time time) (float-time (timer--time timer)))) +TIME is a Lisp time value." + (float-time (time-subtract time (timer--time timer)))) (defun timer-event-handler (timer) "Call the handler for the timer TIMER. @@ -281,7 +281,7 @@ This function is called, by name, directly by the C code." ;; perhaps because Emacs was suspended for a long time, ;; limit how many times things get repeated. (if (and (numberp timer-max-repeats) - (< 0 (timer-until timer nil))) + (time-less-p nil (timer--time timer))) (let ((repeats (/ (timer-until timer nil) (timer--repeat-delay timer)))) (if (> repeats timer-max-repeats) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 2fd3d454bf..2854cde19c 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -844,10 +844,9 @@ Additionally, detect whether the IRC process has hung." erc-server-last-received-time)) (with-current-buffer buf (if (and erc-server-send-ping-timeout - (> - (erc-time-diff (erc-current-time) - erc-server-last-received-time) - erc-server-send-ping-timeout)) + (time-less-p + erc-server-send-ping-timeout + (time-since erc-server-last-received-time))) (progn ;; if the process is hung, kill it (setq erc-server-timed-out t) @@ -865,16 +864,15 @@ Additionally, detect whether the IRC process has hung." See `erc-server-flood-margin' for an explanation of the flood protection algorithm." (with-current-buffer buffer - (let ((now (erc-current-time))) + (let ((now (current-time))) (when erc-server-flood-timer (erc-cancel-timer erc-server-flood-timer) (setq erc-server-flood-timer nil)) - (when (< erc-server-flood-last-message - now) - (setq erc-server-flood-last-message now)) + (when (time-less-p erc-server-flood-last-message now) + (setq erc-server-flood-last-message (erc-emacs-time-to-erc-time now))) (while (and erc-server-flood-queue - (< erc-server-flood-last-message - (+ now erc-server-flood-margin))) + (time-less-p erc-server-flood-last-message + (time-add now erc-server-flood-margin))) (let ((msg (caar erc-server-flood-queue)) (encoding (cdar erc-server-flood-queue))) (setq erc-server-flood-queue (cdr erc-server-flood-queue) @@ -1070,8 +1068,8 @@ Hands off to helper functions via `erc-call-hooks'." erc-server-prevent-duplicates) (let ((m (erc-response.unparsed parsed-response))) ;; duplicate suppression - (if (< (or (gethash m erc-server-duplicates) 0) - (- (erc-current-time) erc-server-duplicate-timeout)) + (if (time-less-p (or (gethash m erc-server-duplicates) 0) + (time-since erc-server-duplicate-timeout)) (erc-call-hooks process parsed-response)) (puthash m (erc-current-time) erc-server-duplicates)) ;; Hand off to the relevant handler. @@ -1447,7 +1445,7 @@ add things to `%s' instead." "Handle pong messages." nil (let ((time (string-to-number (erc-response.contents parsed)))) (when (> time 0) - (setq erc-server-lag (erc-time-diff time (erc-current-time))) + (setq erc-server-lag (erc-time-diff time nil)) (when erc-verbose-server-ping (erc-display-message parsed 'notice proc 'PONG @@ -1730,7 +1728,7 @@ See `erc-display-server-message'." nil (cdr (erc-response.command-args parsed)))) (setq time (when on-since (format-time-string erc-server-timestamp-format - (erc-string-to-emacs-time on-since)))) + (string-to-number on-since)))) (erc-update-user-nick nick nick nil nil nil (and time (format "on since %s" time))) (if time @@ -1802,7 +1800,7 @@ See `erc-display-server-message'." nil (define-erc-response-handler (329) "Channel creation date." nil (let ((channel (cadr (erc-response.command-args parsed))) - (time (erc-string-to-emacs-time + (time (string-to-number (nth 2 (erc-response.command-args parsed))))) (erc-display-message parsed 'notice (erc-get-buffer channel proc) @@ -1844,7 +1842,7 @@ See `erc-display-server-message'." nil (pcase-let ((`(,channel ,nick ,time) (cdr (erc-response.command-args parsed)))) (setq time (format-time-string erc-server-timestamp-format - (erc-string-to-emacs-time time))) + (string-to-number time))) (erc-update-channel-topic channel (format "\C-o (%s, %s)" nick time) 'append) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 2849e25bf7..a6b7532e1f 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -1024,7 +1024,7 @@ transfer is complete." ?s (number-to-string erc-dcc-byte-count) ?t (format "%.0f" (erc-time-diff (plist-get erc-dcc-entry-data :start-time) - (erc-current-time))))) + nil)))) (kill-buffer (process-buffer proc)) (delete-process proc)) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 6b526bdcf5..cc4b4a88f1 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -601,7 +601,7 @@ See `erc-log-match-format'." 'timestamp)))) (away-time (erc-emacs-time-to-erc-time (erc-away-time)))) (when (and away-time last-msg-time - (erc-time-gt last-msg-time away-time)) + (time-less-p away-time last-msg-time)) (erc-display-message nil 'notice 'active (format "You have logged messages waiting in \"%s\"." diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index f42bd64872..e51e6056fb 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -630,8 +630,8 @@ only consider active buffers visible.") (if erc-track-when-inactive (when erc-buffer-activity; could be nil (and (erc-track-get-buffer-window buffer erc-track-visibility) - (<= (erc-time-diff erc-buffer-activity (erc-current-time)) - erc-buffer-activity-timeout))) + (not (time-less-p erc-buffer-activity-timeout + (erc-time-diff erc-buffer-activity nil))))) (erc-track-get-buffer-window buffer erc-track-visibility))) ;;; Tracking the channel modifications diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 697e26b794..101a5a05bf 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2565,8 +2565,8 @@ consumption for long-lived IRC or Emacs sessions." (maphash (lambda (nick last-PRIVMSG-time) (when - (> (float-time (time-subtract nil last-PRIVMSG-time)) - erc-lurker-threshold-time) + (time-less-p erc-lurker-threshold-time + (time-since last-PRIVMSG-time)) (remhash nick hash))) hash) (if (zerop (hash-table-count hash)) @@ -2631,9 +2631,8 @@ server within `erc-lurker-threshold-time'. See also (gethash (erc-lurker-maybe-trim nick) (gethash server erc-lurker-state (make-hash-table))))) (or (null last-PRIVMSG-time) - (> (float-time - (time-subtract nil last-PRIVMSG-time)) - erc-lurker-threshold-time)))) + (time-less-p erc-lurker-threshold-time + (time-since last-PRIVMSG-time))))) (defcustom erc-common-server-suffixes '(("openprojects.net\\'" . "OPN") @@ -3412,7 +3411,7 @@ Otherwise leave the channel indicated by LINE." (defun erc-cmd-PING (recipient) "Ping RECIPIENT." - (let ((time (format "%f" (erc-current-time)))) + (let ((time (format-time-string "%s.%6N"))) (erc-log (format "cmd: PING: %s" time)) (erc-cmd-CTCP recipient "PING" time))) @@ -4640,7 +4639,7 @@ See also `erc-display-message'." (user-full-name) (user-login-name) (system-name)))) - (ns (erc-time-diff erc-server-last-sent-time (erc-current-time)))) + (ns (erc-time-diff erc-server-last-sent-time nil))) (when (> ns 0) (setq s (concat s " Idle for " (erc-sec-to-time ns)))) (erc-send-ctcp-notice nick s))) @@ -4729,8 +4728,7 @@ See also `erc-display-message'." nil (let ((time (match-string 1 msg))) (condition-case nil - (let ((delta (erc-time-diff (string-to-number time) - (erc-current-time)))) + (let ((delta (erc-time-diff (string-to-number time) nil))) (erc-display-message nil 'notice 'active 'CTCP-PING ?n nick @@ -4788,10 +4786,7 @@ If non-nil, return from being away." (erc-default-target) (if away-time (format "is back (gone for %s)" - (erc-sec-to-time - (erc-time-diff - (erc-emacs-time-to-erc-time away-time) - (erc-current-time)))) + (erc-sec-to-time (erc-time-diff away-time nil))) "is back"))))))))) (erc-update-mode-line))) @@ -5383,10 +5378,10 @@ submitted line to be intentional." (defun erc-send-current-line () "Parse current line and send it to IRC." (interactive) - (let ((now (float-time))) + (let ((now (current-time))) (if (or (not erc-accidental-paste-threshold-seconds) - (< erc-accidental-paste-threshold-seconds - (- now erc-last-input-time))) + (time-less-p erc-accidental-paste-threshold-seconds + (time-subtract now erc-last-input-time))) (save-restriction (widen) (if (< (point) (erc-beg-of-input-line)) @@ -6036,22 +6031,20 @@ non-nil value is found. ;; time routines -(defun erc-string-to-emacs-time (string) - "Convert the long number represented by STRING into an Emacs timestamp." - (let* ((n (string-to-number (concat string ".0")))) - (list (truncate (/ n 65536)) - (truncate (mod n 65536))))) +(define-obsolete-function-alias 'erc-string-to-emacs-time 'string-to-number + "27.1") (defalias 'erc-emacs-time-to-erc-time 'float-time) (defalias 'erc-current-time 'float-time) (defun erc-time-diff (t1 t2) - "Return the time difference in seconds between T1 and T2." - (abs (- t2 t1))) + "Return the absolute value of the difference in seconds between T1 and T2." + (abs (float-time (time-subtract t1 t2)))) (defun erc-time-gt (t1 t2) "Check whether T1 > T2." - (> t1 t2)) + (declare (obsolete time-less-p "27.1")) + (time-less-p t2 t1)) (defun erc-sec-to-time (ns) "Convert NS to a time string HH:MM.SS." diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 1cbd2367f5..dd3351b14d 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -421,9 +421,8 @@ resultant list of strings." (forward-char)) (if (looking-at "[0-9]+") (progn - (setq when (- (float-time) - (* (string-to-number (match-string 0)) - quantum))) + (setq when (time-since (* (string-to-number (match-string 0)) + quantum))) (goto-char (match-end 0))) (setq open (char-after)) (if (setq close (memq open '(?\( ?\[ ?\< ?\{))) @@ -438,17 +437,17 @@ resultant list of strings." (attrs (file-attributes file))) (unless attrs (error "Cannot stat file `%s'" file)) - (setq when (float-time (nth attr-index attrs)))) + (setq when (nth attr-index attrs))) (goto-char (1+ end))) `(lambda (file) (let ((attrs (file-attributes file))) (if attrs (,(if (eq qual ?-) - '< + 'time-less-p (if (eq qual ?+) - '> - '=)) ,when (float-time - (nth ,attr-index attrs)))))))) + '(lambda (a b) (time-less-p b a)) + 'time-equal-p)) + ,when (nth ,attr-index attrs))))))) (defun eshell-pred-file-type (type) "Return a test which tests that the file is of a certain TYPE. diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index fca50d70ae..e4c4265d70 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -943,7 +943,8 @@ Summarize disk usage of each FILE, recursively for directories.") (defvar eshell-time-start nil) (defun eshell-show-elapsed-time () - (let ((elapsed (format "%.3f secs\n" (- (float-time) eshell-time-start)))) + (let ((elapsed (format "%.3f secs\n" + (float-time (time-since eshell-time-start))))) (set-text-properties 0 (length elapsed) '(face bold) elapsed) (eshell-interactive-print elapsed)) (remove-hook 'eshell-post-command-hook 'eshell-show-elapsed-time t)) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 0ea156118c..06f7be3da7 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -3610,7 +3610,7 @@ possible values." (defun article-lapsed-string (time &optional max-segments) ;; If the date is seriously mangled, the timezone functions are ;; liable to bug out, so we ignore all errors. - (let* ((real-time (time-subtract nil time)) + (let* ((real-time (time-since time)) (real-sec (float-time real-time)) (sec (abs real-sec)) (segments 0) diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index b9cb8eb71c..6c5e0b7f5d 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el @@ -93,7 +93,7 @@ Emacs has been idle for IDLE `gnus-demon-timestep's." (defun gnus-demon-idle-since () "Return the number of seconds since when Emacs is idle." - (float-time (or (current-idle-time) '(0 0 0)))) + (float-time (or (current-idle-time) 0))) (defun gnus-demon-run-callback (func &optional idle time special) "Run FUNC if Emacs has been idle for longer than IDLE seconds. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index cf8423b2db..9f579bbd96 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -4590,7 +4590,7 @@ or `gnus-group-catchup-group-hook'." ;; FIXME: This should return a Lisp integer, not a Lisp float, ;; since it is always an integer. (let* ((time (or (gnus-group-timestamp group) 0)) - (delta (time-subtract nil time))) + (delta (time-since time))) (float-time delta))) (defun gnus-group-timestamp-string (group) diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index a9d15f9226..062dd1b291 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -413,13 +413,12 @@ Return nil for non-recurring EVENT." (end-time (format-time-string "%H:%M" end)) (end-at-midnight (string= end-time "00:00")) (start-end-date-diff - (/ (float-time (time-subtract - (org-time-string-to-time end-date) - (org-time-string-to-time start-date))) - 86400)) + (time-to-number-of-days (time-subtract + (org-time-string-to-time end-date) + (org-time-string-to-time start-date)))) (org-repeat (gnus-icalendar-event:org-repeat event)) (repeat (if org-repeat (concat " " org-repeat) "")) - (time-1-day '(0 86400))) + (time-1-day 86400)) ;; NOTE: special care is needed with appointments ending at midnight ;; (typically all-day events): the end time has to be changed to 23:59 to diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 477eb9c464..e23e53b1ef 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -257,7 +257,8 @@ If it is down, start it up (again)." (insert (format-time-string "%H:%M:%S") (format " %.2fs %s %S\n" (if (numberp gnus-backend-trace-elapsed) - (- (float-time) gnus-backend-trace-elapsed) + (float-time + (time-since gnus-backend-trace-elapsed)) 0) type form)) (setq gnus-backend-trace-elapsed (float-time))))) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index f5fd4f300a..6114fb5f4f 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -1501,7 +1501,7 @@ If FORMAT, also format the current score file." (when (and gnus-summary-default-score scores) (let* ((entries gnus-header-index) - (now (time-to-days (current-time))) + (now (time-to-days nil)) (expire (and gnus-score-expiry-days (- now gnus-score-expiry-days))) (headers gnus-newsgroup-headers) @@ -2380,7 +2380,7 @@ score in `gnus-newsgroup-scored' by SCORE." (memq 'word gnus-newsgroup-adaptive)) (with-temp-buffer (let* ((hashtb (gnus-make-hashtable 1000)) - (date (time-to-days (current-time))) + (date (time-to-days nil)) (data gnus-newsgroup-data) word d score val) (with-syntax-table gnus-adaptive-word-syntax-table diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 3a5886a863..efb3e4f1a6 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -3855,20 +3855,20 @@ respectively." Returns \" ? \" if there's bad input or if another error occurs. Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." (condition-case () - (let* ((messy-date (float-time (gnus-date-get-time messy-date))) - (now (float-time)) + (let* ((messy-date (gnus-date-get-time messy-date)) + (now (current-time)) ;;If we don't find something suitable we'll use this one (my-format "%b %d '%y")) - (let* ((difference (- now messy-date)) + (let* ((difference (time-subtract now messy-date)) (templist gnus-user-date-format-alist) (top (eval (caar templist)))) - (while (if (numberp top) (< top difference) (not top)) + (while (if (numberp top) (time-less-p top difference) (not top)) (progn (setq templist (cdr templist)) (setq top (eval (caar templist))))) (if (stringp (cdr (car templist))) (setq my-format (cdr (car templist))))) - (format-time-string (eval my-format) (encode-time messy-date))) + (format-time-string (eval my-format) messy-date)) (error " ? "))) (defun gnus-summary-set-local-parameters (group) @@ -5093,8 +5093,8 @@ Unscored articles will be counted as having a score of zero." "Return the highest article date in THREAD." (apply 'max (mapcar (lambda (header) (float-time - (gnus-date-get-time - (mail-header-date header)))) + (gnus-date-get-time + (mail-header-date header)))) (flatten-tree thread)))) (defun gnus-thread-total-score-1 (root) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 5a389fae13..7514e64e7c 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -647,9 +647,9 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) ;; Don't check for old incoming files more than once per day to ;; save a lot of file accesses. (when (or (null mail-source-incoming-last-checked-time) - (> (float-time - (time-since mail-source-incoming-last-checked-time)) - (* 24 60 60))) + (time-less-p + (* 24 60 60) + (time-since mail-source-incoming-last-checked-time))) (setq mail-source-incoming-last-checked-time (current-time)) (mail-source-delete-old-incoming mail-source-delete-incoming diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index 885d6f2afc..f64007aaf7 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -319,7 +319,7 @@ included.") "Subject: " (file-name-nondirectory file) (or extra-msg "") "\n" "Message-ID: \n" - (if (zerop (float-time (file-attribute-modification-time atts))) "" + (if (time-equal-p 0 (file-attribute-modification-time atts)) "" (concat "Date: " (current-time-string (file-attribute-modification-time atts)) "\n")) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 7c8673ee1c..090b842084 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -1075,7 +1075,7 @@ See `find-file-noselect' for the arguments." (defvar nnheader-last-message-time '(0 0)) (defun nnheader-message-maybe (&rest args) (let ((now (current-time))) - (when (> (float-time (time-subtract now nnheader-last-message-time)) 1) + (when (time-less-p 1 (time-subtract now nnheader-last-message-time)) (setq nnheader-last-message-time now) (apply 'nnheader-message args)))) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 9646bb51d0..ac1d28644f 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -386,12 +386,12 @@ textual parts.") (with-current-buffer buffer (when (and nnimap-object (nnimap-last-command-time nnimap-object) - (> (float-time - (time-subtract - now - (nnimap-last-command-time nnimap-object))) - ;; More than five minutes since the last command. - (* 5 60))) + (time-less-p + ;; More than five minutes since the last command. + (* 5 60) + (time-subtract + now + (nnimap-last-command-time nnimap-object)))) (ignore-errors ;E.g. "buffer foo has no process". (nnimap-send-command "NOOP")))))))) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index c2e84c4703..f6d7525293 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -1882,7 +1882,7 @@ If TIME is nil, then return the cutoff time for oldness instead." (setq days (days-to-time days)) ;; Compare the time with the current time. (if (null time) - (time-subtract nil days) + (time-since days) (ignore-errors (time-less-p days (time-since time))))))))) (declare-function gnus-group-mark-article-read "gnus-group" (group article)) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index d7117a1ce2..5fabeac7e3 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -764,7 +764,7 @@ This variable is set by `nnmaildir-request-article'.") (defun nnmaildir--scan (gname scan-msgs groups _method srv-dir srv-ls) (catch 'return - (let ((36h-ago (- (float-time) 129600)) + (let ((36h-ago (time-since 129600)) absdir nndir tdir ndir cdir nattr cattr isnew pgname read-only ls files num dir flist group x) (setq absdir (nnmaildir--srvgrp-dir srv-dir gname) @@ -1577,7 +1577,7 @@ This variable is set by `nnmaildir-request-article'.") (when no-force (unless (integerp time) ;; handle 'never (throw 'return (gnus-uncompress-range ranges))) - (setq boundary (time-subtract nil time))) + (setq boundary (time-since time))) (setq dir (nnmaildir--srv-dir nnmaildir--cur-server) dir (nnmaildir--srvgrp-dir dir gname) dir (nnmaildir--cur dir) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index fcda565e5d..1b69574a39 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -1948,11 +1948,10 @@ Otherwise buffers whose name matches an element of (ibuffer-mark-on-buffer #'(lambda (buf) (with-current-buffer buf - ;; hacked from midnight.el (when buffer-display-time - (let* ((now (float-time)) - (then (float-time buffer-display-time))) - (> (- now then) (* 60 60 ibuffer-old-time)))))))) + (time-less-p + (* 60 60 ibuffer-old-time) + (time-since buffer-display-time))))))) ;;;###autoload (defun ibuffer-mark-special-buffers () diff --git a/lisp/image.el b/lisp/image.el index c66440c86e..6da3a0b6cd 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -804,19 +804,22 @@ If the image has a non-nil :speed property, it acts as a multiplier for the animation speed. A negative value means to animate in reverse." (when (and (buffer-live-p (plist-get (cdr image) :animate-buffer)) ;; Delayed more than two seconds more than expected. - (or (<= (- (float-time) target-time) 2) + (or (time-less-p (time-since target-time) 2) (progn (message "Stopping animation; animation possibly too big") nil))) (image-show-frame image n t) (let* ((speed (image-animate-get-speed image)) - (time (float-time)) + (time (current-time)) (animation (image-multi-frame-p image)) + (time-to-load-image (time-since time)) + (stated-delay-time (/ (or (cdr animation) + image-default-frame-delay) + (float (abs speed)))) ;; Subtract off the time we took to load the image from the ;; stated delay time. - (delay (max (+ (* (or (cdr animation) image-default-frame-delay) - (/ 1.0 (abs speed))) - time (- (float-time))) + (delay (max (float-time (time-subtract stated-delay-time + time-to-load-image)) image-minimum-frame-delay)) done) (setq n (if (< speed 0) diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index ff178241a9..a90d9c4657 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -2369,7 +2369,7 @@ mapped to mostly alphanumerics for safety." (defun feedmail-rfc822-date (arg-time) (feedmail-say-debug ">in-> feedmail-rfc822-date %s" arg-time) - (let ((time (if arg-time arg-time (current-time))) + (let ((time (or arg-time (current-time))) (system-time-locale "C")) (concat (format-time-string "%a, %e %b %Y %T " time) diff --git a/lisp/mouse.el b/lisp/mouse.el index 698c2ce990..835eaa32c6 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -98,7 +98,7 @@ point at the click position." (defun mouse--down-1-maybe-follows-link (&optional _prompt) (when mouse-1-click-follows-link - (setq mouse--last-down (cons (car-safe last-input-event) (float-time)))) + (setq mouse--last-down (cons (car-safe last-input-event) (current-time)))) nil) (defun mouse--click-1-maybe-follows-link (&optional _prompt) @@ -110,8 +110,10 @@ Expects to be bound to `(double-)mouse-1' in `key-translation-map'." ('double (eq 'double-mouse-1 (car-safe last-input-event))) (_ (and (eq 'mouse-1 (car-safe last-input-event)) (or (not (numberp mouse-1-click-follows-link)) - (funcall (if (< mouse-1-click-follows-link 0) #'> #'<) - (- (float-time) (cdr mouse--last-down)) + (funcall (if (< mouse-1-click-follows-link 0) + (lambda (a b) (time-less-p b a)) + #'time-less-p) + (time-since (cdr mouse--last-down)) (/ (abs mouse-1-click-follows-link) 1000.0)))))) (eq (car mouse--last-down) (event-convert-list (list 'down (car-safe last-input-event)))) diff --git a/lisp/mpc.el b/lisp/mpc.el index 4a349871a5..8e557ed2b3 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -2555,7 +2555,6 @@ If stopped, start playback." (defvar mpc--faster-toggle-forward nil) (defvar mpc--faster-acceleration 0.5) (defun mpc--faster-toggle (speedup step) - (setq speedup (float speedup)) (if mpc--faster-toggle-timer (mpc--faster-stop) (mpc-status-refresh) (mpc-proc-sync) @@ -2582,7 +2581,7 @@ If stopped, start playback." (setq songtime (string-to-number (cdr (assq 'time mpc-status)))) (setq songduration (mpc--songduration)) - (setq oldtime (float-time))) + (setq oldtime (current-time))) ((and (>= songtime songduration) mpc--faster-toggle-forward) ;; Skip to the beginning of the next song. (if (not (equal (cdr (assq 'state mpc-status)) "play")) @@ -2601,14 +2600,16 @@ If stopped, start playback." (lambda () (setq songid (cdr (assq 'songid mpc-status))) (setq songtime (setq songduration (mpc--songduration))) - (setq oldtime (float-time)) + (setq oldtime (current-time)) (mpc-proc-cmd (list "seekid" songid songtime))))))) (t (setq speedup (+ speedup mpc--faster-acceleration)) (let ((newstep - (truncate (* speedup (- (float-time) oldtime))))) + (truncate + (* speedup + (float-time (time-since oldtime)))))) (if (<= newstep 1) (setq newstep 1)) - (setq oldtime (+ oldtime (/ newstep speedup))) + (setq oldtime (time-add oldtime (/ newstep speedup))) (if (not mpc--faster-toggle-forward) (setq newstep (- newstep))) (setq songtime (min songduration (+ songtime newstep))) diff --git a/lisp/net/imap.el b/lisp/net/imap.el index bc0e2e609a..9f43c57ffd 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -1918,11 +1918,7 @@ on failure." (unless (< len 10) (setq imap-have-messaged t) (message "imap read: %dk" len)) - (accept-process-output imap-process - (truncate imap-read-timeout) - (truncate (* (- imap-read-timeout - (truncate imap-read-timeout)) - 1000))))) + (accept-process-output imap-process imap-read-timeout))) ;; A process can die _before_ we have processed everything it ;; has to say. Moreover, this can happen in between the call to ;; accept-process-output and the call to process-status in an diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 9ff4649fee..9925a04575 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -1802,7 +1802,7 @@ download it from URL first." (time-less-p nil (time-add (file-attribute-modification-time (file-attributes image-name)) - (encode-time 86400)))) + 86400))) (newsticker--debug-msg "%s: Getting image for %s skipped" (format-time-string "%A, %H:%M") feed-name) @@ -1995,8 +1995,7 @@ older than TIME." (mapc (lambda (item) (when (eq (newsticker--age item) old-age) - (let ((exp-time (time-add (newsticker--time item) - (encode-time time)))) + (let ((exp-time (time-add (newsticker--time item) time))) (when (time-less-p exp-time nil) (newsticker--debug-msg "Item `%s' from %s has expired on %s" diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 24f1c424dc..b1a6c1ce8d 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -670,8 +670,9 @@ last ping." (defun rcirc-handler-ctcp-KEEPALIVE (process _target _sender message) (with-rcirc-process-buffer process - (setq header-line-format (format "%f" (- (float-time) - (string-to-number message)))))) + (setq header-line-format + (format "%f" (float-time + (time-since (string-to-number message))))))) (defvar rcirc-debug-buffer "*rcirc debug*") (defvar rcirc-debug-flag nil @@ -723,8 +724,8 @@ When 0, do not auto-reconnect." (< 0 rcirc-reconnect-delay)) (let ((now (current-time))) (when (or (null rcirc-last-connect-time) - (< rcirc-reconnect-delay - (float-time (time-subtract now rcirc-last-connect-time)))) + (time-less-p rcirc-reconnect-delay + (time-subtract now rcirc-last-connect-time))) (setq rcirc-last-connect-time now) (rcirc-cmd-reconnect nil)))) (run-hook-with-args 'rcirc-sentinel-functions process sentinel)))) @@ -2794,7 +2795,7 @@ the only argument." (let* ((nick (nth 1 args)) (idle-secs (string-to-number (nth 2 args))) (idle-string (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs)) - (signon-time (encode-time (string-to-number (nth 3 args)))) + (signon-time (string-to-number (nth 3 args))) (signon-string (format-time-string "%c" signon-time)) (message (format "%s idle for %s, signed on %s" nick idle-string signon-string))) @@ -2815,8 +2816,7 @@ Not in rfc1459.txt" (with-current-buffer buffer (let ((setter (nth 2 args)) (time (current-time-string - (encode-time - (string-to-number (cl-cadddr args)))))) + (string-to-number (cl-cadddr args))))) (rcirc-print process sender "TOPIC" (cadr args) (format "%s (%s on %s)" rcirc-topic setter time)))))) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 487fc54dbd..064b209ec2 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -128,8 +128,9 @@ Returns DEFAULT if not set." (and (consp value) (or (null remote-file-name-inhibit-cache) (and (integerp remote-file-name-inhibit-cache) - (<= (tramp-time-diff (current-time) (car value)) - remote-file-name-inhibit-cache)) + (time-less-p nil + (time-add (car value) + remote-file-name-inhibit-cache))) (and (consp remote-file-name-inhibit-cache) (time-less-p remote-file-name-inhibit-cache (car value))))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 49bc9bfcfc..91ff153293 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1635,9 +1635,9 @@ of." (tramp-compat-time-equal-p (tramp-compat-file-attribute-modification-time fa2) tramp-time-dont-know))) - (> 0 (tramp-time-diff - (tramp-compat-file-attribute-modification-time fa2) - (tramp-compat-file-attribute-modification-time fa1))) + (time-less-p + (tramp-compat-file-attribute-modification-time fa2) + (tramp-compat-file-attribute-modification-time fa1)) ;; If one of them is the dont-know value, then we can ;; still try to run a shell command on the remote host. ;; However, this only works if both files are Tramp @@ -4784,9 +4784,9 @@ connection if a previous connection has died for some reason." (unless (or (process-live-p p) (not (tramp-file-name-equal-p vec (car tramp-current-connection))) - (> (tramp-time-diff - (current-time) (cdr tramp-current-connection)) - (or tramp-connection-min-time-diff 0))) + (time-less-p + (or tramp-connection-min-time-diff 0) + (time-since (cdr tramp-current-connection)))) (throw 'suppress 'suppress)) ;; If too much time has passed since last command was sent, look @@ -4797,11 +4797,10 @@ connection if a previous connection has died for some reason." ;; try to send a command from time to time, then look again ;; whether the process is really alive. (condition-case nil - (when (and (> (tramp-time-diff - (current-time) - (tramp-get-connection-property - p "last-cmd-time" '(0 0 0))) - 60) + (when (and (time-less-p 60 + (time-since + (tramp-get-connection-property + p "last-cmd-time" 0))) (process-live-p p)) (tramp-send-command vec "echo are you awake" t t) (unless (and (process-live-p p) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index f57c76c260..31470b2979 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1900,11 +1900,10 @@ If ARGUMENT is non-nil, use it as argument for ;; connection timeout. (with-current-buffer buf (goto-char (point-min)) - (when (and (> (tramp-time-diff - (current-time) - (tramp-get-connection-property - p "last-cmd-time" '(0 0 0))) - 60) + (when (and (time-less-p 60 + (time-since + (tramp-get-connection-property + p "last-cmd-time" 0))) (process-live-p p) (re-search-forward tramp-smb-errors nil t)) (delete-process p) diff --git a/lisp/nxml/rng-maint.el b/lisp/nxml/rng-maint.el index 18e3898992..56fbf12eda 100644 --- a/lisp/nxml/rng-maint.el +++ b/lisp/nxml/rng-maint.el @@ -228,8 +228,7 @@ (let* ((start (current-time)) (val (apply function args))) (message "%s ran in %g seconds" - function - (float-time (time-subtract nil start))) + function (float-time (time-since start))) val)) (defun rng-time-tokenize-buffer () diff --git a/lisp/obsolete/xesam.el b/lisp/obsolete/xesam.el index a1a4639a23..16da6d9cbb 100644 --- a/lisp/obsolete/xesam.el +++ b/lisp/obsolete/xesam.el @@ -622,8 +622,7 @@ Return propertized STRING." (or (widget-get widget :tag) "") (format-time-string "%d %B %Y, %T" - (encode-time - (string-to-number (widget-get widget :xesam:sourceModified))))))) + (string-to-number (widget-get widget :xesam:sourceModified)))))) ;; Second line: :value. (widget-put widget :value (widget-get widget :xesam:url)) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index d491dff477..6593c6d8fa 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -5867,12 +5867,12 @@ See also the user option `org-agenda-clock-consistency-checks'." ((> dt (* 60 maxtime)) ;; a very long clocking chunk (setq issue (format "Clocking interval is very long: %s" - (org-duration-from-minutes (floor (/ dt 60.)))) + (org-duration-from-minutes (floor dt 60))) face (or (plist-get pl :long-face) face))) ((< dt (* 60 mintime)) ;; a very short clocking chunk (setq issue (format "Clocking interval is very short: %s" - (org-duration-from-minutes (floor (/ dt 60.)))) + (org-duration-from-minutes (floor dt 60))) face (or (plist-get pl :short-face) face))) ((and (> tlend 0) (< ts tlend)) ;; Two clock entries are overlapping @@ -5912,8 +5912,8 @@ See also the user option `org-agenda-clock-consistency-checks'." (throw 'exit t)) ;; We have a shorter gap. ;; Now we have to get the minute of the day when these times are - (let* ((t1dec (decode-time (encode-time t1))) - (t2dec (decode-time (encode-time t2))) + (let* ((t1dec (decode-time t1)) + (t2dec (decode-time t2)) ;; compute the minute on the day (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec)))) (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec))))) @@ -10157,8 +10157,7 @@ to override `appt-message-warning-time'." ;; Do not use `org-today' here because appt only takes ;; time and without date as argument, so it may pass wrong ;; information otherwise - (today (org-date-to-gregorian - (time-to-days (current-time)))) + (today (org-date-to-gregorian (time-to-days nil))) (org-agenda-restrict nil) (files (org-agenda-files 'unrestricted)) entries file (org-agenda-buffer nil)) diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index 0c7f159369..dbba33b50d 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -1000,8 +1000,7 @@ Store them in the capture property list." (equal current-prefix-arg 1)) ;; Prompt for date. (let ((prompt-time (org-read-date - nil t nil "Date for tree entry:" - (current-time)))) + nil t nil "Date for tree entry:" nil))) (org-capture-put :default-time (cond ((and (or (not (boundp 'org-time-was-given)) diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index babf1f7066..34b694d487 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -723,7 +723,7 @@ menu\nmouse-2 will jump to task")) The time returned includes the time spent on this task in previous clocking intervals." (let ((currently-clocked-time - (floor (encode-time (time-subtract nil org-clock-start-time) 'integer) + (floor (encode-time (time-since org-clock-start-time) 'integer) 60))) (+ currently-clocked-time (or org-clock-total-time 0)))) @@ -932,7 +932,7 @@ If necessary, clock-out of the currently active clock." (unless (org-is-active-clock clock) (org-clock-clock-in clock t)))) - ((not (time-less-p resolve-to (current-time))) + ((not (time-less-p resolve-to nil)) (error "RESOLVE-TO must refer to a time in the past")) (t @@ -1033,8 +1033,7 @@ to be CLOCKED OUT.")))) nil 45))) (and (not (memq char-pressed '(?i ?q))) char-pressed))))) (default - (floor (encode-time (time-subtract (current-time) last-valid) - 'integer) + (floor (encode-time (time-since last-valid) 'integer) 60)) (keep (and (memq ch '(?k ?K)) @@ -1043,8 +1042,9 @@ to be CLOCKED OUT.")))) (and (memq ch '(?g ?G)) (read-number "Got back how many minutes ago? " default))) (subtractp (memq ch '(?s ?S))) - (barely-started-p (< (- (float-time last-valid) - (float-time (cdr clock))) 45)) + (barely-started-p (time-less-p + (time-subtract last-valid (cdr clock)) + 45)) (start-over (and subtractp barely-started-p))) (cond ((memq ch '(?j ?J)) @@ -1070,10 +1070,9 @@ to be CLOCKED OUT.")))) (and gotback (= gotback default))) 'now) (keep - (time-add last-valid (encode-time (* 60 keep)))) + (time-add last-valid (* 60 keep))) (gotback - (time-subtract (current-time) - (encode-time (* 60 gotback)))) + (time-since (* 60 gotback))) (t (error "Unexpected, please report this as a bug"))) (and gotback last-valid) @@ -1103,7 +1102,7 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling (lambda (clock) (format "Dangling clock started %d mins ago" - (floor (encode-time (time-subtract nil (cdr clock)) + (floor (encode-time (time-since (cdr clock)) 'integer) 60))))) (or last-valid @@ -1155,8 +1154,7 @@ so long." org-clock-marker (marker-buffer org-clock-marker)) (let* ((org-clock-user-idle-seconds (org-user-idle-seconds)) (org-clock-user-idle-start - (time-subtract (current-time) - (encode-time org-clock-user-idle-seconds))) + (time-since org-clock-user-idle-seconds)) (org-clock-resolving-clocks-due-to-idleness t)) (if (> org-clock-user-idle-seconds (* 60 org-clock-idle-time)) (org-clock-resolve @@ -1165,9 +1163,8 @@ so long." (lambda (_) (format "Clocked in & idle for %.1f mins" (/ (float-time - (time-subtract (current-time) - org-clock-user-idle-start)) - 60.0))) + (time-since org-clock-user-idle-start)) + 60))) org-clock-user-idle-start))))) (defvar org-clock-current-task nil "Task currently clocked in.") @@ -1324,9 +1321,11 @@ the default behavior." (y-or-n-p (format "You stopped another clock %d mins ago; start this one from then? " - (/ (- (float-time - (org-current-time org-clock-rounding-minutes t)) - (float-time leftover)) + (/ (encode-time + (time-subtract + (org-current-time org-clock-rounding-minutes t) + leftover) + 'integer) 60))) leftover) start-time @@ -1577,19 +1576,19 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (delete-region (point) (point-at-eol)) (insert "--") (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) - (setq s (float-time (time-subtract - (org-time-string-to-time te) - (org-time-string-to-time ts))) + (setq s (encode-time (time-subtract + (org-time-string-to-time te) + (org-time-string-to-time ts)) + 'integer) h (floor s 3600) - s (- s (* 3600 h)) - m (floor s 60)) + m (floor (mod s 3600) 60)) (insert " => " (format "%2d:%02d" h m)) (move-marker org-clock-marker nil) (move-marker org-clock-hd-marker nil) ;; Possibly remove zero time clocks. However, do not add ;; a note associated to the CLOCK line in this case. (cond ((and org-clock-out-remove-zero-time-clocks - (= (+ h m) 0)) + (= 0 h m)) (setq remove t) (delete-region (line-beginning-position) (line-beginning-position 2))) @@ -1833,8 +1832,9 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." tend (>= (float-time org-clock-start-time) tstart) (<= (float-time org-clock-start-time) tend)) - (let ((time (floor (- (float-time) - (float-time org-clock-start-time)) + (let ((time (floor (encode-time + (time-since org-clock-start-time) + 'integer) 60))) (setq t1 (+ t1 time)))) (let* ((headline-forced @@ -2712,14 +2712,14 @@ LEVEL is an integer. Indent by two spaces per level above 1." (setq te (float-time (org-time-string-to-time te))))) (setq tsb (if (eq step0 'week) - (let ((dow (nth 6 (decode-time (encode-time ts))))) + (let ((dow (nth 6 (decode-time ts)))) (if (<= dow ws) ts (- ts (* 86400 (- dow ws))))) ts)) (while (< tsb te) (unless (bolp) (insert "\n")) (let ((start-time (max tsb ts))) - (cl-incf tsb (let ((dow (nth 6 (decode-time (encode-time tsb))))) + (cl-incf tsb (let ((dow (nth 6 (decode-time tsb)))) (if (or (eq step0 'day) (= dow ws)) step @@ -2739,7 +2739,7 @@ LEVEL is an integer. Indent by two spaces per level above 1." :tstart (format-time-string (org-time-stamp-format t t) start-time) :tend (format-time-string (org-time-stamp-format t t) - (encode-time (min te tsb)))))))) + (min te tsb))))))) (re-search-forward "^[ \t]*#\\+END:") (when (and stepskip0 (equal step-time 0)) ;; Remove the empty table diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index f3e118b6de..799cc608bf 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -540,7 +540,7 @@ Where possible, use the standard interface for changing this line." (eol (line-end-position)) (pom (or (get-text-property bol 'org-hd-marker) (point))) (key (or key (get-char-property (point) 'org-columns-key))) - (org-columns--time (float-time (current-time))) + (org-columns--time (float-time)) (action (pcase key ("CLOCKSUM" @@ -790,7 +790,7 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format." (org-columns-goto-top-level) ;; Initialize `org-columns-current-fmt' and ;; `org-columns-current-fmt-compiled'. - (let ((org-columns--time (float-time (current-time)))) + (let ((org-columns--time (float-time))) (org-columns-get-format columns-fmt-string) (unless org-columns-inhibit-recalculation (org-columns-compute-all)) (save-excursion @@ -1494,7 +1494,7 @@ PARAMS is a property list of parameters: (if (markerp org-columns-begin-marker) (move-marker org-columns-begin-marker (point)) (setq org-columns-begin-marker (point-marker))) - (let* ((org-columns--time (float-time (current-time))) + (let* ((org-columns--time (float-time)) (fmt (cond ((bound-and-true-p org-agenda-overriding-columns-format)) diff --git a/lisp/org/org-duration.el b/lisp/org/org-duration.el index f115082243..770c72fd67 100644 --- a/lisp/org/org-duration.el +++ b/lisp/org/org-duration.el @@ -317,11 +317,10 @@ When optional argument CANONICAL is non-nil, ignore Raise an error if expected format is unknown." (pcase (or fmt org-duration-format) (`h:mm - (let ((minutes (floor minutes))) - (format "%d:%02d" (/ minutes 60) (mod minutes 60)))) + (format "%d:%02d" (/ minutes 60) (mod minutes 60))) (`h:mm:ss (let* ((whole-minutes (floor minutes)) - (seconds (floor (* 60 (- minutes whole-minutes))))) + (seconds (mod (* 60 minutes) 60))) (format "%s:%02d" (org-duration-from-minutes whole-minutes 'h:mm) seconds))) @@ -402,9 +401,7 @@ Raise an error if expected format is unknown." (pcase-let* ((`(,unit . ,required?) units) (modifier (org-duration--modifier unit canonical))) (cond ((<= modifier minutes) - (let ((value (if (integerp modifier) - (/ (floor minutes) modifier) - (floor (/ minutes modifier))))) + (let ((value (floor minutes modifier))) (cl-decf minutes (* value modifier)) (format " %d%s" value unit))) (required? (concat " 0" unit)) diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index e2ee0a0fe8..690dcd139e 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -4765,13 +4765,13 @@ you want to help debugging the issue.") (defvar org-element-cache-sync-idle-time 0.6 "Length, in seconds, of idle time before syncing cache.") -(defvar org-element-cache-sync-duration (encode-time 0.04) +(defvar org-element-cache-sync-duration 0.04 "Maximum duration, as a time value, for a cache synchronization. If the synchronization is not over after this delay, the process pauses and resumes after `org-element-cache-sync-break' seconds.") -(defvar org-element-cache-sync-break (encode-time 0.3) +(defvar org-element-cache-sync-break 0.3 "Duration, as a time value, of the pause between synchronizations. See `org-element-cache-sync-duration' for more information.") @@ -5066,7 +5066,7 @@ Assume ELEMENT belongs to cache and that a cache is active." TIME-LIMIT is a time value or nil." (and time-limit (or (input-pending-p) - (time-less-p time-limit (current-time))))) + (time-less-p time-limit nil)))) (defsubst org-element--cache-shift-positions (element offset &optional props) "Shift ELEMENT properties relative to buffer positions by OFFSET. @@ -5120,8 +5120,7 @@ updated before current modification are actually submitted." (and next (aref next 0)) threshold (and (not threshold) - (time-add (current-time) - org-element-cache-sync-duration)) + (time-add nil org-element-cache-sync-duration)) future-change) ;; Request processed. Merge current and next offsets and ;; transfer ending position. diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index 06429d7ff3..6234d0251e 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -288,7 +288,7 @@ Habits are assigned colors on the following basis: (deadline (if scheduled-days (+ scheduled-days (- d-repeat s-repeat)) (org-habit-deadline habit))) - (m-days (or now-days (time-to-days (current-time))))) + (m-days (or now-days (time-to-days nil)))) (cond ((< m-days scheduled) '(org-habit-clear-face . org-habit-clear-future-face)) @@ -406,8 +406,7 @@ current time." "Insert consistency graph for any habitual tasks." (let ((inhibit-read-only t) (buffer-invisibility-spec '(org-link)) - (moment (time-subtract (current-time) - (list 0 (* 3600 org-extend-today-until) 0)))) + (moment (time-since (* 3600 org-extend-today-until)))) (save-excursion (goto-char (if line (point-at-bol) (point-min))) (while (not (eobp)) diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index f6d6cd497f..97cf878656 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -332,7 +332,7 @@ stopped." (let* ((case-fold-search t) (limited-re (org-get-limited-outline-regexp)) (level (or (org-current-level) 0)) - (time-limit (and delay (time-add (current-time) delay)))) + (time-limit (and delay (time-add nil delay)))) ;; For each line, set `line-prefix' and `wrap-prefix' ;; properties depending on the type of line (headline, inline ;; task, item or other). @@ -345,7 +345,7 @@ stopped." ;; In asynchronous mode, take a break of ;; `org-indent-agent-resume-delay' every DELAY to avoid ;; blocking any other idle timer or process output. - ((and delay (time-less-p time-limit (current-time))) + ((and delay (time-less-p time-limit nil)) (setq org-indent-agent-resume-timer (run-with-idle-timer (time-add (current-idle-time) org-indent-agent-resume-delay) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 81a77fde6c..765a1ee5c9 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -2175,8 +2175,8 @@ If NLAST is a number, only the NLAST fields will actually be summed." (sres (if (= org-timecnt 0) (number-to-string res) (setq diff (* 3600 res) - h (floor (/ diff 3600)) diff (mod diff 3600) - m (floor (/ diff 60)) diff (mod diff 60) + h (floor diff 3600) diff (mod diff 3600) + m (floor diff 60) diff (mod diff 60) s diff) (format "%.0f:%02.0f:%02.0f" h m s)))) (kill-new sres) diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index c9ca85c0c3..6529a8b0dd 100644 --- a/lisp/org/org-timer.el +++ b/lisp/org/org-timer.el @@ -139,12 +139,7 @@ the region 0:00:00." (format "Restart timer with offset [%s]: " def))) (unless (string-match "\\S-" s) (setq s def)) (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s))))) - (setq org-timer-start-time - (encode-time - ;; Pass `current-time' result to `float-time' (instead - ;; of calling without arguments) so that only - ;; `current-time' has to be overridden in tests. - (- (float-time (current-time)) delta)))) + (setq org-timer-start-time (time-since delta))) (setq org-timer-pause-time nil) (org-timer-set-mode-line 'on) (message "Timer start time set to %s, current value is %s" @@ -167,14 +162,9 @@ With prefix arg STOP, stop it entirely." (setq org-timer-countdown-timer (org-timer--run-countdown-timer new-secs org-timer-countdown-timer-title)) - (setq org-timer-start-time - (time-add (current-time) (encode-time new-secs)))) + (setq org-timer-start-time (time-add nil new-secs))) (setq org-timer-start-time - ;; Pass `current-time' result to `float-time' (instead - ;; of calling without arguments) so that only - ;; `current-time' has to be overridden in tests. - (encode-time (- (float-time (current-time)) - (- pause-secs start-secs))))) + (time-since (- pause-secs start-secs)))) (setq org-timer-pause-time nil) (org-timer-set-mode-line 'on) (run-hooks 'org-timer-continue-hook) @@ -233,14 +223,9 @@ it in the buffer." (abs (floor (org-timer-seconds)))))) (defun org-timer-seconds () - ;; Pass `current-time' result to `float-time' (instead of calling - ;; without arguments) so that only `current-time' has to be - ;; overridden in tests. - (if org-timer-countdown-timer - (- (float-time org-timer-start-time) - (float-time (or org-timer-pause-time (current-time)))) - (- (float-time (or org-timer-pause-time (current-time))) - (float-time org-timer-start-time)))) + (let ((s (float-time (time-subtract org-timer-pause-time + org-timer-start-time)))) + (if org-timer-countdown-timer (- s) s))) ;;;###autoload (defun org-timer-change-times-in-region (beg end delta) @@ -400,7 +385,7 @@ VALUE can be `on', `off', or `paused'." (message "No timer set") (let* ((rtime (decode-time (time-subtract (timer--time org-timer-countdown-timer) - (current-time)))) + nil))) (rsecs (nth 0 rtime)) (rmins (nth 1 rtime))) (message "%d minute(s) %d seconds left before next time out" @@ -463,8 +448,7 @@ using three `C-u' prefix arguments." (org-timer--run-countdown-timer secs org-timer-countdown-timer-title)) (run-hooks 'org-timer-set-hook) - (setq org-timer-start-time - (time-add (current-time) (encode-time secs))) + (setq org-timer-start-time (time-add nil secs)) (setq org-timer-pause-time nil) (org-timer-set-mode-line 'on)))))) diff --git a/lisp/org/org.el b/lisp/org/org.el index b627282a63..8a11a8f75e 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -229,10 +229,10 @@ file to byte-code before it is loaded." (interactive "fFile to load: \nP") (let* ((age (lambda (file) (float-time - (time-subtract (current-time) - (file-attribute-modification-time - (or (file-attributes (file-truename file)) - (file-attributes file))))))) + (time-since + (file-attribute-modification-time + (or (file-attributes (file-truename file)) + (file-attributes file))))))) (base-name (file-name-sans-extension file)) (exported-file (concat base-name ".el"))) ;; tangle if the Org file is newer than the elisp file @@ -5626,8 +5626,7 @@ the rounding returns a past time." (defun org-today () "Return today date, considering `org-extend-today-until'." (time-to-days - (time-subtract (current-time) - (list 0 (* 3600 org-extend-today-until) 0)))) + (time-since (* 3600 org-extend-today-until)))) ;;;; Font-Lock stuff, including the activators @@ -13110,8 +13109,7 @@ This function is run automatically after each state change to a DONE state." (while (re-search-forward org-clock-line-re end t) (when (org-at-clock-log-p) (throw :clock t)))))) (org-entry-put nil "LAST_REPEAT" (format-time-string - (org-time-stamp-format t t) - (current-time)))) + (org-time-stamp-format t t)))) (when org-log-repeat (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) (memq 'org-add-log-note post-command-hook)) @@ -13170,7 +13168,7 @@ has been set" (let ((nshiftmax 10) (nshift 0)) (while (or (= nshift 0) - (not (time-less-p (current-time) time))) + (not (time-less-p nil time))) (when (= (cl-incf nshift) nshiftmax) (or (y-or-n-p (format "%d repeater intervals were not \ @@ -14666,8 +14664,8 @@ it as a time string and apply `float-time' to it. If S is nil, just return 0." ((stringp s) (condition-case nil (float-time (org-time-string-to-time s)) - (error 0.))) - (t 0.))) + (error 0))) + (t 0))) (defun org-time-today () "Time in seconds today at 0:00. @@ -16568,22 +16566,20 @@ non-nil." ((org-at-timestamp-p 'lax) (match-string 0)))) ;; Default time is either the timestamp at point or today. ;; When entering a range, only the range start is considered. - (default-time (if (not ts) (current-time) - (org-time-string-to-time ts))) + (default-time (and ts (org-time-string-to-time ts))) (default-input (and ts (org-get-compact-tod ts))) (repeater (and ts (string-match "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ts) (match-string 0 ts))) org-time-was-given org-end-time-was-given - (time - (and (if (equal arg '(16)) (current-time) + (time (if (equal arg '(16)) (current-time) ;; Preserve `this-command' and `last-command'. (let ((this-command this-command) (last-command last-command)) (org-read-date arg 'totime nil nil default-time default-input - inactive)))))) + inactive))))) (cond ((and ts (memq last-command '(org-time-stamp org-time-stamp-inactive)) @@ -16957,7 +16953,7 @@ user." (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans) (setq ans "+0")) - (when (setq delta (org-read-date-get-relative ans (current-time) org-def)) + (when (setq delta (org-read-date-get-relative ans nil org-def)) (setq ans (replace-match "" t t ans) deltan (car delta) deltaw (nth 1 delta) @@ -17114,7 +17110,7 @@ user." ; (when (and org-read-date-prefer-future ; (not iso-year) ; (< (calendar-absolute-from-gregorian iso-date) - ; (time-to-days (current-time)))) + ; (time-to-days nil))) ; (setq year (1+ year) ; iso-date (calendar-gregorian-from-absolute ; (calendar-iso-to-absolute @@ -17308,7 +17304,7 @@ Don't touch the rest." If SECONDS is non-nil, return the difference in seconds." (let ((fdiff (if seconds #'float-time #'time-to-days))) (- (funcall fdiff (org-time-string-to-time timestamp-string)) - (funcall fdiff (current-time))))) + (funcall fdiff nil)))) (defun org-deadline-close-p (timestamp-string &optional ndays) "Is the time in TIMESTAMP-STRING close to the current date?" @@ -17490,10 +17486,8 @@ days in order to avoid rounding problems." (match-end (match-end 0)) (time1 (org-time-string-to-time ts1)) (time2 (org-time-string-to-time ts2)) - (t1 (float-time time1)) - (t2 (float-time time2)) - (diff (abs (- t2 t1))) - (negative (< (- t2 t1) 0)) + (diff (abs (float-time (time-subtract time2 time1)))) + (negative (time-less-p time2 time1)) ;; (ys (floor (* 365 24 60 60))) (ds (* 24 60 60)) (hs (* 60 60)) @@ -17504,14 +17498,14 @@ days in order to avoid rounding problems." (fh "%02d:%02d") y d h m align) (if havetime - (setq ; y (floor (/ diff ys)) diff (mod diff ys) + (setq ; y (floor diff ys) diff (mod diff ys) y 0 - d (floor (/ diff ds)) diff (mod diff ds) - h (floor (/ diff hs)) diff (mod diff hs) - m (floor (/ diff 60))) - (setq ; y (floor (/ diff ys)) diff (mod diff ys) + d (floor diff ds) diff (mod diff ds) + h (floor diff hs) diff (mod diff hs) + m (floor diff 60)) + (setq ; y (floor diff ys) diff (mod diff ys) y 0 - d (floor (+ (/ diff ds) 0.5)) + d (round diff ds) h 0 m 0)) (if (not to-buffer) (message "%s" (org-make-tdiff-string y d h m)) @@ -17602,7 +17596,7 @@ signaled." YEAR is expanded into one of the 30 next years, if possible, or into a past one. Any year larger than 99 is returned unchanged." (if (>= year 100) year - (let* ((current (string-to-number (format-time-string "%Y" (current-time)))) + (let* ((current (string-to-number (format-time-string "%Y"))) (century (/ current 100)) (offset (- year (% current 100)))) (cond ((> offset 30) (+ (* (1- century) 100) year)) @@ -18122,7 +18116,7 @@ A prefix ARG can be used to force the current date." diff) (when (or (org-at-timestamp-p 'lax) (org-match-line (concat ".*" org-ts-regexp))) - (let ((d1 (time-to-days (current-time))) + (let ((d1 (time-to-days nil)) (d2 (time-to-days (org-time-string-to-time (match-string 1))))) (setq diff (- d2 d1)))) (calendar) diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index bc86a4d563..74312bc20f 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -1348,7 +1348,7 @@ does not exist." (expand-file-name (or (file-symlink-p file) file) (file-name-directory file))))) (if (not attr) (error "No such file: \"%s\"" file) - (floor (float-time (file-attribute-modification-time attr)))))) + (encode-time (file-attribute-modification-time attr) 'integer)))) (provide 'ox-publish) diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 6c278a1b7c..8813968332 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -3252,7 +3252,7 @@ locally for the subtree through node properties." (let ((val (cond ((equal (car key) "DATE") (or (cdr key) (with-temp-buffer - (org-insert-time-stamp (current-time))))) + (org-insert-time-stamp nil)))) ((equal (car key) "TITLE") (or (let ((visited-file (buffer-file-name (buffer-base-buffer)))) diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 566a0fdb77..dfd9a5ad5b 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -97,10 +97,11 @@ When scrolling request is delivered soon after the previous one, user is in hurry. When the time since last scroll is larger than `pixel-dead-time', we are ready for another smooth scroll, and this function returns nil." - (let* ((current-time (float-time)) - (scroll-in-rush-p (< (- current-time pixel-last-scroll-time) - pixel-dead-time))) - (setq pixel-last-scroll-time current-time) + (let* ((now (current-time)) + (scroll-in-rush-p (time-less-p + (time-subtract now pixel-last-scroll-time) + pixel-dead-time))) + (setq pixel-last-scroll-time (float-time now)) scroll-in-rush-p)) ;;;###autoload diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index 635e4a95bc..d762290f0d 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -381,7 +381,7 @@ BITS must be of length nrings. Start at START-TIME." (cl-loop for elapsed = (- (float-time) start-time) while (< elapsed hanoi-move-period) with tick-period = (/ (float hanoi-move-period) total-ticks) - for tick = (ceiling (/ elapsed tick-period)) do + for tick = (ceiling elapsed tick-period) do (hanoi-ring-to-pos ring (funcall tick-to-pos tick)) (hanoi-sit-for (- (* tick tick-period) elapsed))) (cl-loop for tick from 1 to total-ticks by 2 do diff --git a/lisp/proced.el b/lisp/proced.el index b3c8e2cb69..ce379a7c6a 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -1348,7 +1348,7 @@ Prefix ARG controls sort order, see `proced-sort-interactive'." (defun proced-format-time (time) "Format time interval TIME." - (let* ((ftime (float-time time)) + (let* ((ftime (encode-time time 'integer)) (days (truncate ftime 86400)) (ftime (mod ftime 86400)) (hours (truncate ftime 3600)) diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index afdf6a96e1..29988eb14f 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -849,8 +849,8 @@ If that option is nil, don't prints messages. ARGS are the same as for `message'." (when cpp-message-min-time-interval (let ((time (current-time))) - (when (>= (float-time (time-subtract time cpp-progress-time)) - cpp-message-min-time-interval) + (unless (time-less-p cpp-message-min-time-interval + (time-subtract time cpp-progress-time)) (setq cpp-progress-time time) (apply 'message args))))) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 261e50a613..7afcf7891d 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -765,7 +765,8 @@ report applies to that region." (flymake-log :debug "backend %s reported %d diagnostics in %.2f second(s)" backend (length new-diags) - (- (float-time) flymake-check-start-time))) + (float-time + (time-since flymake-check-start-time)))) (when (and (get-buffer (flymake--diagnostics-buffer-name)) (get-buffer-window (flymake--diagnostics-buffer-name)) (null (cl-set-difference (flymake-running-backends) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index b0bb8213dc..532739daae 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2771,8 +2771,8 @@ Otherwise, use the current value of `process-mark'." (with-current-buffer (process-buffer process) (cl-loop with start-pos = (or start (marker-position (process-mark process))) - with end-time = (+ (float-time) timeout) - for time-left = (- end-time (float-time)) + with end-time = (time-add nil timeout) + for time-left = (float-time (time-subtract end-time nil)) do (goto-char (point-max)) if (looking-back regexp start-pos) return t while (> time-left 0) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 27380b33ad..b8297c4847 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -7393,7 +7393,7 @@ only-lines." "Update progress information." (when (and vhdl-progress-info (not noninteractive) (time-less-p vhdl-progress-interval - (time-subtract nil (aref vhdl-progress-info 2)))) + (time-since (aref vhdl-progress-info 2)))) (let ((delta (- (aref vhdl-progress-info 1) (aref vhdl-progress-info 0)))) (message "%s... (%2d%%)" string @@ -8143,7 +8143,7 @@ depending on parameter UPPER-CASE." (downcase-word -1))) (when (and count vhdl-progress-interval (not noninteractive) (time-less-p vhdl-progress-interval - (time-subtract nil last-update))) + (time-since last-update))) (message "Fixing case... (%2d%s)" (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg))) "%") diff --git a/lisp/ses.el b/lisp/ses.el index df32363aa1..73157d6f5f 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -837,7 +837,7 @@ updated again." (defmacro ses--time-check (format &rest args) "If `ses-start-time' is more than a second ago, call `message' with FORMAT and ARGS and reset `ses-start-time' to the current time." - `(when (> (- (float-time) ses-start-time) 1.0) + `(when (time-less-p 1 (time-since ses-start-time)) (message ,format ,@args) (setq ses-start-time (float-time)))) diff --git a/lisp/subr.el b/lisp/subr.el index 44a1c60894..69ae804e20 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5041,7 +5041,7 @@ NEW-MESSAGE, if non-nil, sets a new message for the reporter." (enough-time-passed ;; See if enough time has passed since the last update. (or (not update-time) - (when (>= (float-time) update-time) + (when (time-less-p update-time nil) ;; Calculate time for the next update (aset parameters 0 (+ update-time (aref parameters 5))))))) (cond ((and min-value max-value) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 0973329fa3..c4b0a8fb6e 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -767,13 +767,15 @@ Can be nil to mean \"no timeout\".") By not redisplaying right away for xterm queries, we can avoid unsightly flashing during initialization. Give up and redisplay anyway if we've been waiting a little while." - (let ((start-time (float-time))) + (let ((start-time (current-time))) (or (let ((inhibit-redisplay t)) (read-event nil nil xterm-query-redisplay-timeout)) (read-event nil nil (and xterm-query-timeout - (max 0 (+ start-time xterm-query-timeout - (- (float-time))))))))) + (max 0 (float-time + (time-subtract + xterm-query-timeout + (time-since start-time))))))))) (defun xterm--query (query handlers &optional no-async) "Send QUERY string to the terminal and watch for a response. diff --git a/lisp/time.el b/lisp/time.el index 9084217024..35157c5e80 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -434,16 +434,17 @@ update which can wait for the next redisplay." ((and (stringp mail-spool-file) (or (null display-time-server-down-time) ;; If have been down for 20 min, try again. - (< 1200 (- (float-time now) - display-time-server-down-time)))) - (let ((start-time (float-time))) + (time-less-p 1200 (time-since + display-time-server-down-time)))) + (let ((start-time (current-time))) (prog1 (display-time-file-nonempty-p mail-spool-file) ;; Record whether mail file is accessible. (setq display-time-server-down-time - (let ((end-time (float-time))) - (and (< 20 (- end-time start-time)) - end-time)))))))) + (let ((end-time (current-time))) + (and (time-less-p 20 (time-subtract + end-time start-time)) + (float-time end-time))))))))) (24-hours (substring time 11 13)) (hour (string-to-number 24-hours)) (12-hours (int-to-string (1+ (% (+ hour 11) 12)))) @@ -571,8 +572,9 @@ For example, the Unix uptime command format is \"%D, %z%2h:%.2m\"." (interactive) (let ((str (format-seconds (or format "%Y, %D, %H, %M, %z%S") - (float-time - (time-subtract nil before-init-time))))) + (encode-time + (time-since before-init-time) + 'integer)))) (if (called-interactively-p 'interactive) (message "%s" str) str))) diff --git a/lisp/tooltip.el b/lisp/tooltip.el index cbb61efc49..b1c69ae736 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -201,7 +201,8 @@ This might return nil if the event did not occur over a buffer." (defun tooltip-delay () "Return the delay in seconds for the next tooltip." (if (and tooltip-hide-time - (< (- (float-time) tooltip-hide-time) tooltip-recent-seconds)) + (time-less-p (time-since tooltip-hide-time) + tooltip-recent-seconds)) tooltip-short-delay tooltip-delay)) diff --git a/lisp/type-break.el b/lisp/type-break.el index 9a8100fb0b..0ad79dd113 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -460,8 +460,7 @@ the variable of the same name." )))))) (defun timep (time) - "If TIME is in the format returned by `current-time' then -return TIME, else return nil." + "If TIME is a Lisp time value then return TIME, else return nil." (condition-case nil (and (float-time time) time) (error nil))) @@ -481,8 +480,7 @@ return TIME, else return nil." (defun type-break-get-previous-time () "Get previous break time from `type-break-file-name'. -Returns nil if the file is missing or if the time breaks with the -`current-time' format." +Return nil if the file is missing or if the time is not a Lisp time value." (let ((file (type-break-choose-file))) (if file (timep ;; returns expected format, else nil @@ -808,7 +806,7 @@ this or ask the user to start one right now." ((and (car type-break-keystroke-threshold) (< type-break-keystroke-count (car type-break-keystroke-threshold)))) ((> type-break-time-warning-count 0) - (let ((timeleft (type-break-time-difference (current-time) + (let ((timeleft (type-break-time-difference nil type-break-time-next-break))) (setq type-break-warning-countdown-string (number-to-string timeleft)) (cond @@ -905,8 +903,8 @@ Current keystroke count : %s" (current-time-string type-break-time-next-break) (type-break-format-time (type-break-time-difference - (current-time) - type-break-time-next-break))) + nil + type-break-time-next-break))) "none scheduled") (or (car type-break-keystroke-threshold) "none") (or (cdr type-break-keystroke-threshold) "none") @@ -1090,7 +1088,7 @@ With optional non-nil ALL, force redisplay of all mode-lines." (erase-buffer) (setq elapsed (type-break-time-difference type-break-time-last-break - (current-time))) + nil)) (let ((good-interval (or type-break-good-rest-interval type-break-good-break-interval))) (cond diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index a1cb0b9274..b306082c3b 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el @@ -205,7 +205,7 @@ If `url-standalone-mode' is non-nil, cached items never expire." (time-less-p (time-add cache-time - (encode-time (or expire-time url-cache-expire-time))) + (or expire-time url-cache-expire-time)) nil))))) (defun url-cache-prune-cache (&optional directory) @@ -227,7 +227,7 @@ considered \"expired\"." ((time-less-p (time-add (file-attribute-modification-time (file-attributes file)) - (encode-time url-cache-expire-time)) + url-cache-expire-time) now) (delete-file file) (setq deleted-files (1+ deleted-files)))))) diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index 213dab268c..31fc3e7266 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -105,11 +105,10 @@ i.e. 1970-1-1) are loaded as expiring one year from now instead." ;; away, make it expire a year from now (expires (format-time-string "%d %b %Y %T [GMT]" - (encode-time - (let ((s (string-to-number (nth 4 fields)))) - (if (and (= s 0) long-session) - (encode-time (+ (* 365 24 60 60) (float-time))) - s))))) + (let ((s (string-to-number (nth 4 fields)))) + (if (and (zerop s) long-session) + (time-add nil (* 365 24 60 60)) + s)))) (key (nth 5 fields)) (val (nth 6 fields))) (cl-incf n) diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el index 6350081b1a..9bf1bca238 100644 --- a/lisp/url/url-queue.el +++ b/lisp/url/url-queue.el @@ -162,8 +162,8 @@ The variable `url-queue-timeout' sets a timeout." (dolist (job url-queue) ;; Kill jobs that have lasted longer than the timeout. (when (and (url-queue-start-time job) - (> (- (float-time) (url-queue-start-time job)) - url-queue-timeout)) + (time-less-p url-queue-timeout + (time-since (url-queue-start-time job)))) (push job dead-jobs))) (dolist (job dead-jobs) (url-queue-kill-job job) diff --git a/lisp/url/url.el b/lisp/url/url.el index 101c2b2c54..ed0947795b 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -259,8 +259,7 @@ how long to wait for a response before giving up." ;; process output. (while (and (not retrieval-done) (or (not timeout) - (< (float-time (time-subtract nil start-time)) - timeout))) + (time-less-p (time-since start-time) timeout))) (url-debug 'retrieval "Spinning in url-retrieve-synchronously: %S (%S)" retrieval-done asynch-buffer) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index f9ea4def15..c6806ba5cd 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1541,10 +1541,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." "Create a stash with the current tree state." (interactive) (vc-git--call nil "stash" "save" - (let ((ct (current-time))) - (concat - (format-time-string "Snapshot on %Y-%m-%d" ct) - (format-time-string " at %H:%M" ct)))) + (format-time-string "Snapshot on %Y-%m-%d at %H:%M")) (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" "stash@{0}") (vc-resynch-buffer (vc-git-root default-directory) t t)) diff --git a/lisp/woman.el b/lisp/woman.el index 110069335c..38e083a961 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -2011,7 +2011,7 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated." ;; ;; Terminates man processing ;; "Report formatting time." ;; (message "Man formatting done in %s seconds" -;; (float-time (time-subtract nil WoMan-Man-start-time)))) +;; (float-time (time-since WoMan-Man-start-time)))) ;;; Buffer handling: diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 770aecfcbe..5ff718292d 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -243,11 +243,10 @@ which is the \"1006\" extension implemented in Xterm >= 277." (y (nth 2 click)) ;; Emulate timestamp information. This is accurate enough ;; for default value of mouse-1-click-follows-link (450msec). - (timestamp (truncate - (* 1000 - (- (float-time) - (or xt-mouse-epoch - (setq xt-mouse-epoch (float-time))))))) + (timestamp (if (not xt-mouse-epoch) + (progn (setq xt-mouse-epoch (float-time)) 0) + (car (encode-time (time-since xt-mouse-epoch) + 1000)))) (w (window-at x y)) (ltrb (window-edges w)) (left (nth 0 ltrb)) commit eba66c1eafeef6512259c9b46face2b03c7433b8 Author: Paul Eggert Date: Fri Feb 22 13:24:16 2019 -0800 Remove some timestamp format assumptions Don’t assume that current-time and plain encode-time return timestamps in (HI LO US PS) format. * lisp/gnus/gnus-art.el (article-make-date-line) (article-lapsed-string): * lisp/gnus/gnus-demon.el (gnus-demon-time-to-step): * lisp/gnus/gnus-diary.el (gnus-user-format-function-d): * lisp/gnus/nnmaildir.el (nnmaildir-request-expire-articles): * lisp/net/pop3.el (pop3-uidl-dele): * lisp/org/ox-publish.el (org-publish-sitemap): * lisp/vc/vc-hg.el (vc-hg-state-fast): Simplify and remove assumptions about timestamp format. * lisp/gnus/gnus-art.el (article-lapsed-string): * lisp/gnus/gnus-diary.el (gnus-user-format-function-d): Do not worry about time-subtract returning nil; that's not possible. * lisp/gnus/gnus-diary.el (gnus-user-format-function-d): Avoid race due to duplicate current-time calls. * lisp/vc/vc-hg.el (vc-hg--time-to-integer): Remove; no longer used. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 191f623afa..0ea156118c 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -3540,18 +3540,11 @@ possible values." (concat "Date: " (message-make-date time))) ;; Convert to Universal Time. ((eq type 'ut) - (concat "Date: " - (substring - (message-make-date - (let* ((e (parse-time-string date)) - (tm (encode-time e)) - (ms (car tm)) - (ls (- (cadr tm) (car (current-time-zone time))))) - (cond ((< ls 0) (list (1- ms) (+ ls 65536))) - ((> ls 65535) (list (1+ ms) (- ls 65536))) - (t (list ms ls))))) - 0 -5) - "UT")) + (let ((system-time-locale "C")) + (format-time-string + "Date: %a, %d %b %Y %T UT" + (encode-time (parse-time-string date)) + t))) ;; Get the original date from the article. ((eq type 'original) (concat "Date: " (if (string-match "\n+$" date) @@ -3569,13 +3562,7 @@ possible values." (concat "Date: " (format-time-string format time))))) ;; ISO 8601. ((eq type 'iso8601) - (let ((tz (car (current-time-zone time)))) - (concat - "Date: " - (format-time-string "%Y%m%dT%H%M%S" time) - (format "%s%02d%02d" - (if (> tz 0) "+" "-") (/ (abs tz) 3600) - (/ (% (abs tz) 3600) 60))))) + (format-time-string "Date: %Y%m%dT%H%M%S%z" time)) ;; Do a lapsed format. ((eq type 'lapsed) (concat "Date: " (article-lapsed-string time))) @@ -3624,17 +3611,13 @@ possible values." ;; If the date is seriously mangled, the timezone functions are ;; liable to bug out, so we ignore all errors. (let* ((real-time (time-subtract nil time)) - (real-sec (and real-time - (+ (* (float (car real-time)) 65536) - (cadr real-time)))) - (sec (and real-time (abs real-sec))) + (real-sec (float-time real-time)) + (sec (abs real-sec)) (segments 0) num prev) (unless max-segments (setq max-segments (length article-time-units))) (cond - ((null real-time) - "Unknown") ((zerop sec) "Now") (t diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index 4ae4c65d83..b9cb8eb71c 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el @@ -192,11 +192,9 @@ marked with SPECIAL." (elt nowParts 6) (elt nowParts 7) (elt nowParts 8))) - ;; calculate number of seconds between NOW and THEN - (diff (+ (* 65536 (- (car then) (car now))) - (- (cadr then) (cadr now))))) - ;; return number of timesteps in the number of seconds - (round (/ diff gnus-demon-timestep)))) + (diff (float-time (time-subtract then now)))) + ;; Return number of timesteps in the number of seconds. + (round diff gnus-demon-timestep))) (gnus-add-shutdown 'gnus-demon-cancel 'gnus) diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index 51e3995879..ceb0d4a30d 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -159,32 +159,29 @@ There are currently two built-in format functions: ;; Code partly stolen from article-make-date-line (let* ((extras (mail-header-extra header)) (sched (gnus-diary-header-schedule extras)) - (occur (nndiary-next-occurrence sched (current-time))) (now (current-time)) + (occur (nndiary-next-occurrence sched now)) (real-time (time-subtract occur now))) - (if (null real-time) - "?????" - (let* ((sec (+ (* (float (car real-time)) 65536) (cadr real-time))) - (past (< sec 0)) - delay) - (and past (setq sec (- sec))) - (unless (zerop sec) - ;; This is a bit convoluted, but basically we go through the time - ;; units for years, weeks, etc, and divide things to see whether - ;; that results in positive answers. - (let ((units `((year . ,(* 365.25 24 3600)) - (month . ,(* 31 24 3600)) - (week . ,(* 7 24 3600)) - (day . ,(* 24 3600)) - (hour . 3600) - (minute . 60))) - unit num) - (while (setq unit (pop units)) - (unless (zerop (setq num (ffloor (/ sec (cdr unit))))) - (setq delay (append delay `((,(floor num) . ,(car unit)))))) - (setq sec (- sec (* num (cdr unit))))))) - (funcall gnus-diary-delay-format-function past delay))) - )) + (let* ((sec (encode-time real-time 'integer)) + (past (< sec 0)) + delay) + (and past (setq sec (- sec))) + (unless (zerop sec) + ;; This is a bit convoluted, but basically we go through the time + ;; units for years, weeks, etc, and divide things to see whether + ;; that results in positive answers. + (let ((units `((year . ,(round (* 365.25 24 3600))) + (month . ,(* 31 24 3600)) + (week . ,(* 7 24 3600)) + (day . ,(* 24 3600)) + (hour . 3600) + (minute . 60))) + unit num) + (while (setq unit (pop units)) + (unless (zerop (setq num (floor sec (cdr unit)))) + (setq delay (append delay `((,num . ,(car unit)))))) + (setq sec (mod sec (cdr unit)))))) + (funcall gnus-diary-delay-format-function past delay)))) ;; #### NOTE: Gnus sometimes gives me a HEADER not corresponding to any ;; message, with all fields set to nil here. I don't know what it is for, and diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 9df2292e78..d7117a1ce2 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -1577,14 +1577,7 @@ This variable is set by `nnmaildir-request-article'.") (when no-force (unless (integerp time) ;; handle 'never (throw 'return (gnus-uncompress-range ranges))) - (setq boundary (current-time) - high (- (car boundary) (/ time 65536)) - low (- (cadr boundary) (% time 65536))) - (if (< low 0) - (setq low (+ low 65536) - high (1- high))) - (setcar (cdr boundary) low) - (setcar boundary high)) + (setq boundary (time-subtract nil time))) (setq dir (nnmaildir--srv-dir nnmaildir--cur-server) dir (nnmaildir--srvgrp-dir dir gname) dir (nnmaildir--cur dir) diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el index 3aac5b5c45..cd6a113bff 100644 --- a/lisp/net/pop3.el +++ b/lisp/net/pop3.el @@ -180,8 +180,8 @@ Shorter values mean quicker response, but are more CPU intensive.") ;; ("SERVER_B" ("USER_B1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...) ;; ("USER_B2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...) ;; ...)) -;; Where TIMESTAMP is the most significant two digits of an Emacs time, -;; i.e. the return value of `current-time'. +;; Where TIMESTAMP is an Emacs time value (HI LO) representing the +;; number of seconds (+ (ash HI 16) LO). ;;;###autoload (defun pop3-movemail (file) @@ -380,7 +380,9 @@ Use streaming commands." (defun pop3-uidl-dele (process) "Delete messages according to `pop3-leave-mail-on-server'. Return non-nil if it is necessary to update the local UIDL file." - (let* ((ctime (current-time)) + (let* ((ctime (encode-time nil 'list)) + (age-limit (and (numberp pop3-leave-mail-on-server) + (* 86400 pop3-leave-mail-on-server))) (srvr (assoc pop3-mailhost pop3-uidl-saved)) (saved (assoc pop3-maildrop (cdr srvr))) i uidl mod new tstamp dele) @@ -397,17 +399,13 @@ Return non-nil if it is necessary to update the local UIDL file." (setq new (mapcan (lambda (elt) (list elt ctime)) pop3-uidl)))) (when new (setq mod t)) ;; List expirable messages and delete them from the data to be saved. - (setq ctime (when (numberp pop3-leave-mail-on-server) - (/ (+ (* (car ctime) 65536.0) (cadr ctime)) 86400)) - i (1- (length saved))) + (setq i (1- (length saved))) (while (> i 0) (if (member (setq uidl (nth (1- i) saved)) pop3-uidl) (progn (setq tstamp (nth i saved)) - (if (and ctime - (> (- ctime (/ (+ (* (car tstamp) 65536.0) (cadr tstamp)) - 86400)) - pop3-leave-mail-on-server)) + (if (and age-limit + (time-less-p age-limit (time-subtract ctime tstamp))) ;; Mails to delete. (progn (setq mod t) diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index cd49cd0afc..bc86a4d563 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -793,13 +793,11 @@ Default for SITEMAP-FILENAME is `sitemap.org'." (not (string-lessp B A)))))) ((or `anti-chronologically `chronologically) (let* ((adate (org-publish-find-date a project)) - (bdate (org-publish-find-date b project)) - (A (+ (ash (car adate) 16) (cadr adate))) - (B (+ (ash (car bdate) 16) (cadr bdate)))) + (bdate (org-publish-find-date b project))) (setq retval - (if (eq sort-files 'chronologically) - (<= A B) - (>= A B))))) + (not (if (eq sort-files 'chronologically) + (time-less-p bdate adate) + (time-less-p adate bdate)))))) (`nil nil) (_ (user-error "Invalid sort value %s" sort-files))) ;; Directory-wise wins: diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 342c6d214c..6b17e861dd 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -923,9 +923,6 @@ FILENAME must be the file's true absolute name." (setf ignored (string-match (pop patterns) filename))) ignored)) -(defun vc-hg--time-to-integer (ts) - (+ (* 65536 (car ts)) (cadr ts))) - (defvar vc-hg--cached-ignore-patterns nil "Cached pre-parsed hg ignore patterns.") @@ -1046,8 +1043,9 @@ hg binary." (let ((vc-hg-size (nth 2 dirstate-entry)) (vc-hg-mtime (nth 3 dirstate-entry)) (fs-size (file-attribute-size stat)) - (fs-mtime (vc-hg--time-to-integer - (file-attribute-modification-time stat)))) + (fs-mtime (encode-time + (file-attribute-modification-time stat) + 'integer))) (if (and (eql vc-hg-size fs-size) (eql vc-hg-mtime fs-mtime)) 'up-to-date 'edited))) commit 0613e7a38efc3b0534e0ca5c5fa401e2a3bda906 Author: Alex Branham Date: Tue Dec 11 08:29:50 2018 -0600 which-function: Do not display outdated imenu information * lisp/progmodes/which-func.el (which-function): Check `add-log-current-defun' before imenu. Update `imenu--index-alist' if needed. Bug#33695 diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 40a74d1df6..564e0ff62c 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -272,16 +272,21 @@ It calls them sequentially, and if any returns non-nil, (defun which-function () "Return current function name based on point. -Uses `which-func-functions', `imenu--index-alist' -or `add-log-current-defun'. +Uses `which-func-functions', `add-log-current-defun'. +or `imenu--index-alist' If no function name is found, return nil." (let ((name ;; Try the `which-func-functions' functions first. (run-hook-with-args-until-success 'which-func-functions))) - + ;; Try using add-log support. + (when (null name) + (setq name (add-log-current-defun))) ;; If Imenu is loaded, try to make an index alist with it. (when (and (null name) - (boundp 'imenu--index-alist) (null imenu--index-alist) + (boundp 'imenu--index-alist) + (or (null imenu--index-alist) + ;; Update if outdated + (/= (buffer-chars-modified-tick) imenu-menubar-modified-tick)) (null which-function-imenu-failed)) (ignore-errors (imenu--make-index-alist t)) (unless imenu--index-alist @@ -323,10 +328,6 @@ If no function name is found, return nil." (funcall which-func-imenu-joiner-function (reverse (cons (car pair) namestack)))))))))))) - - ;; Try using add-log support. - (when (null name) - (setq name (add-log-current-defun))) ;; Filter the name if requested. (when name (if which-func-cleanup-function