From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: dick.r.chiang@gmail.com Newsgroups: gmane.emacs.bugs Subject: bug#61741: 30.0.50; [PATCH] Reset errant timers Date: Thu, 23 Feb 2023 13:54:46 -0500 Message-ID: <87r0ugtdop.fsf@dick> Mime-Version: 1.0 Content-Type: text/x-diff Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="13486"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.14 (Gnus v5.14) To: 61741@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Thu Feb 23 23:05:34 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1pVJiY-0003OY-0n for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 23 Feb 2023 23:05:34 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pVJi4-0004jV-W4; Thu, 23 Feb 2023 17:05:05 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pVJi3-0004ik-C5 for bug-gnu-emacs@gnu.org; Thu, 23 Feb 2023 17:05:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pVJi3-0003Sg-24 for bug-gnu-emacs@gnu.org; Thu, 23 Feb 2023 17:05:03 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pVJi2-0004tc-RF for bug-gnu-emacs@gnu.org; Thu, 23 Feb 2023 17:05:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: dick.r.chiang@gmail.com Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 23 Feb 2023 22:05:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 61741 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs Original-Received: via spool by submit@debbugs.gnu.org id=B.167718988018773 (code B ref -1); Thu, 23 Feb 2023 22:05:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 23 Feb 2023 22:04:40 +0000 Original-Received: from localhost ([127.0.0.1]:35487 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pVJhf-0004sh-48 for submit@debbugs.gnu.org; Thu, 23 Feb 2023 17:04:40 -0500 Original-Received: from lists.gnu.org ([209.51.188.17]:60612) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pVGk7-0008Ml-DL for submit@debbugs.gnu.org; Thu, 23 Feb 2023 13:55:00 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pVGk1-00076O-2Y for bug-gnu-emacs@gnu.org; Thu, 23 Feb 2023 13:54:55 -0500 Original-Received: from mail-qt1-x835.google.com ([2607:f8b0:4864:20::835]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pVGjx-0003aV-R9 for bug-gnu-emacs@gnu.org; Thu, 23 Feb 2023 13:54:52 -0500 Original-Received: by mail-qt1-x835.google.com with SMTP id k20so8602975qtj.5 for ; Thu, 23 Feb 2023 10:54:49 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=content-disposition:mime-version:user-agent:message-id:date:subject :to:from:from:to:cc:subject:date:message-id:reply-to; bh=YwhcHjoQhWNZM6TcVOIxhQfZhKQ9lYrDFpsBXiZ1mCg=; b=aUbaTeBHzNMcfEy4jJHl9lkYIiGkTSslUan13yy+qM7WkORQsjwAgbRv6215aT4qdy DVR8gpil5zpDaa/oNW2o5akdiWudR8geOfHfIur17jSCBQ/ovGEkeWxqTQ4NIYhRX/mq 7XtyevZrhpzEHiv7i/uzd6fvBFg0A4O3HvQK3xE9B26vYYAw1Gvd6pjKq/FSM3piic/o K46zwQVLhO7HsAkg/qmsL4bZOsiDmVSebm9an1oTYxz7hr+ws13N6UWzGrjkugfAQTdc hrEm6DE6lMleUnQjGDoMLVsincZQrxgRWkBrt6HNNFnCYyiErgzADr1zUKBdhMNZuO+s xVvA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-disposition:mime-version:user-agent:message-id:date:subject :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=YwhcHjoQhWNZM6TcVOIxhQfZhKQ9lYrDFpsBXiZ1mCg=; b=kn3gcidmOolELCRMlKEetfM+OrG5yvWOyuCiyPmvhmILQbb0f7InzgVetiTGHt8h3J UFjqme+zaCU9fwD2uVCl7RHKVUFbd8+LAC38thk6QAs/mc3P/bfhvDdTk3oGKEK052Gn hc0rrPUkyOBjTPaKu/iSOnMO7Nmmfxa2+x0RwiX52BOloBlhhAPv0V2DR7my3MYI5/Ex ORlkdSdKM9JjEn/wx9H6CATEsin5/iKvjGeCwIBXDJWsrNZMQl1k0GZsEPgZbQdsqVbp F246DTXlCpDFiCD/qQX+mDTg+R7DvmLNxVUBvQ7CGH7+Q9Hxy6jXraGnnfsD+MZEI1OY G6jw== X-Gm-Message-State: AO0yUKXfjWUsGCbUu3ml8RuLiWuIpfRoueSVAcWljbKCsVWkI6wiGq10 frve/pgUQtuePrB8S1AsbOyBSuGMgEs= X-Google-Smtp-Source: AK7set9ZHcIzco5Sd7tRrw6d2JbScyASAufaVCkMS4rQ0VIwQvxyAm4olpcKtf1xl0CJdi8sq2GKhA== X-Received: by 2002:a05:622a:1a9d:b0:3b9:bd77:1971 with SMTP id s29-20020a05622a1a9d00b003b9bd771971mr9644883qtc.42.1677178488015; Thu, 23 Feb 2023 10:54:48 -0800 (PST) Original-Received: from localhost (ool-45763be4.dyn.optonline.net. [69.118.59.228]) by smtp.gmail.com with ESMTPSA id y28-20020ac8705c000000b003bfb6ddc49dsm657087qtm.1.2023.02.23.10.54.47 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 23 Feb 2023 10:54:47 -0800 (PST) Content-Disposition: inline; filename=0001-Reset-errant-timers.patch Received-SPF: pass client-ip=2607:f8b0:4864:20::835; envelope-from=dick.r.chiang@gmail.com; helo=mail-qt1-x835.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Mailman-Approved-At: Thu, 23 Feb 2023 17:04:38 -0500 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:256530 Archived-At: >From 5f8dd26a2e521864ba5ca6c61e5a89ac5db223e0 Mon Sep 17 00:00:00 2001 From: dickmao Date: Thu, 23 Feb 2023 13:30:33 -0500 Subject: [PATCH] Reset errant timers It's always irked me that a repeated timer, should it error under debug-on-error, enters a zombie state. emacs -Q \ --eval "(setq debugger (lambda (&rest _args) \ (run-at-time 1 nil \ (function list-timers)) \ (top-level)))" \ --eval "(setq debug-on-error t)" \ --eval "(run-at-time nil 0.5 (lambda () (error \"foo\"))))" * lisp/emacs-lisp/timer-list.el (timer, list-timers, timer-list-mode): time-subtract prefers a smaller subtrahend. * lisp/emacs-lisp/timer.el (timer, timerp): A timer does not begin life already triggered. (timer--check, timer--time-setter, timer-set-function, cancel-timer): Make weak sauce less weak. (cancel-timer-internal): Remove. (timer-event-handler): Rewrite. (run-with-idle-timer): Brevity is clarity. (internal-timer-start-idle): Why test indeed. * lisp/frame.el (blink-cursor--start-idle-timer): Everyone else simply says "t". * lisp/jit-lock.el (jit-lock-stealth-fontify): Demangle interfaces. * lisp/time.el (display-time-event-handler): Prefer descriptive getters. * src/fns.c (Fcopy_sequence): Stay safe. * src/keyboard.c (trigger_timer, timer_check_2, timer_check): Brevity is clarity. * test/lisp/emacs-lisp/timer-tests.el (timer-test-debug-on-error-delay, timer-test-debug-on-error-timer, timer-test-debug-on-error-0, timer-test-debug-on-error-1): Test. --- lisp/emacs-lisp/timer-list.el | 34 ++-- lisp/emacs-lisp/timer.el | 257 ++++++++------------------- lisp/frame.el | 2 +- lisp/jit-lock.el | 2 +- lisp/time.el | 4 +- src/fns.c | 2 +- src/keyboard.c | 261 +++++++--------------------- test/lisp/emacs-lisp/timer-tests.el | 26 +++ 8 files changed, 189 insertions(+), 399 deletions(-) diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index b9a171adc07..1e1c22b8f77 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -24,6 +24,8 @@ ;;; Code: +(require 'timer) + (defvar cl-print-compiled) (defvar cl-print-compiled-button) @@ -41,23 +43,29 @@ list-timers nil `[ ;; Idle. ,(propertize - (if (aref timer 7) " *" " ") + (if (timer--idle-delay timer) " *" " ") 'help-echo "* marks idle timers" 'timer timer) ;; Next time. ,(propertize - (let ((time (list (aref timer 1) - (aref timer 2) - (aref timer 3)))) - (format "%12s" - (format-seconds "%dd %hh %mm %z%,1ss" - (float-time - (if (aref timer 7) - time - (time-subtract time nil)))))) + (let* ((time (timer--time timer)) + (idle-p (timer--idle-delay timer)) + (inverted-p (and (not idle-p) + (time-less-p time nil))) + (formatted (format-seconds + "%1dd %2hh %2mm %z%,1ss" + (float-time + (if idle-p + time + (if inverted-p + (time-subtract nil time) + (time-subtract time nil))))))) + (when (equal formatted "0.0s") + (setq inverted-p nil)) + (format "%13s" (concat (if inverted-p "-" "") formatted))) 'help-echo "Time until next invocation") ;; Repeat. - ,(let ((repeat (aref timer 4))) + ,(let ((repeat (timer--repeat-delay timer))) (cond ((numberp repeat) (propertize @@ -73,7 +81,7 @@ list-timers (let ((cl-print-compiled 'static) (cl-print-compiled-button nil) (print-escape-newlines t)) - (cl-prin1-to-string (aref timer 5))) + (cl-prin1-to-string (timer--function timer))) 'help-echo "Function called by timer")])) (append timer-list timer-idle-list))) (tabulated-list-print)) @@ -94,7 +102,7 @@ timer-list-mode (setq-local revert-buffer-function #'list-timers) (setq tabulated-list-format '[("Idle" 6 timer-list--idle-predicate) - ("Next" 12 timer-list--next-predicate :right-align t :pad-right 1) + ("Next" 13 timer-list--next-predicate :right-align t :pad-right 1) ("Repeat" 12 timer-list--repeat-predicate :right-align t :pad-right 1) ("Function" 10 timer-list--function-predicate)])) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 7544279d8aa..097290c7b4f 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -28,18 +28,13 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) - -;; If you change this structure, you also have to change `timerp' -;; (below) and decode_timer in keyboard.c. (cl-defstruct (timer (:constructor nil) (:copier nil) (:constructor timer--create ()) - (:type vector) + (:type vector) ; undefines timer-p (see timerp) (:conc-name timer--)) - ;; nil if the timer is active (waiting to be triggered), - ;; non-nil if it is inactive ("already triggered", in theory). - (triggered t) + triggered ;; Time of next trigger: for normal timers, absolute time, for idle timers, ;; time relative to idle-start. high-seconds low-seconds usecs @@ -61,18 +56,23 @@ timer-create ;; hardcode the shape of timers in other .elc files. (timer--create)) -(defun timerp (object) - "Return t if OBJECT is a timer." - (and (vectorp object) - ;; Timers are now ten elements, but old .elc code may have - ;; shorter versions of `timer-create'. - (<= 9 (length object) 10))) +(defsubst timerp (object) + "Return t if OBJECT appears to be a timer. +As the timer struct does not implicitly define a timer-p +predicate (since it explicitly shunts to a vector type), we +attempt an heuristic." + (and (vectorp object) (= (length object) 10))) (defsubst timer--check (timer) - (or (timerp timer) (signal 'wrong-type-argument (list #'timerp timer)))) + (or (and (timerp timer) + (integerp (timer--high-seconds timer)) + (integerp (timer--low-seconds timer)) + (integerp (timer--usecs timer)) + (integerp (timer--psecs timer)) + (timer--function timer)) + (error "Invalid timer %S" timer))) (defun timer--time-setter (timer time) - (timer--check timer) (let ((lt (time-convert time 'list))) (setf (timer--high-seconds timer) (nth 0 lt)) (setf (timer--low-seconds timer) (nth 1 lt)) @@ -153,100 +153,29 @@ timer-inc-time (defun timer-set-function (timer function &optional args) "Make TIMER call FUNCTION with optional ARGS when triggering." - (timer--check timer) (setf (timer--function timer) function) (setf (timer--args timer) args) timer) - -(defun timer--activate (timer &optional triggered-p reuse-cell idle) - (let ((timers (if idle timer-idle-list timer-list)) - last) - (cond - ((not (and (timerp timer) - (integerp (timer--high-seconds timer)) - (integerp (timer--low-seconds timer)) - (integerp (timer--usecs timer)) - (integerp (timer--psecs timer)) - (timer--function timer))) - (error "Invalid or uninitialized timer")) - ;; FIXME: This is not reliable because `idle-delay' is only set late, - ;; by `timer-activate-when-idle' :-( - ;;((not (eq (not idle) - ;; (not (timer--idle-delay timer)))) - ;; (error "idle arg %S out of sync with idle-delay field of timer: %S" - ;; idle timer)) - ((memq timer timers) - (error "Timer already activated")) - (t - ;; Skip all timers to trigger before the new one. - (while (and timers (timer--time-less-p (car timers) timer)) - (setq last timers - timers (cdr timers))) - (if reuse-cell - (progn - (setcar reuse-cell timer) - (setcdr reuse-cell timers)) - (setq reuse-cell (cons timer timers))) - ;; Insert new timer after last which possibly means in front of queue. - (setf (cond (last (cdr last)) - (idle timer-idle-list) - (t timer-list)) - reuse-cell) - (setf (timer--triggered timer) triggered-p) - (setf (timer--idle-delay timer) idle) - nil)))) - -(defun timer-activate (timer &optional triggered-p reuse-cell) - "Insert TIMER into `timer-list'. -If TRIGGERED-P is t, make TIMER inactive (put it on the list, but -mark it as already triggered). To remove it, use `cancel-timer'. - -REUSE-CELL, if non-nil, is a cons cell to reuse when inserting -TIMER into `timer-list' (usually a cell removed from that list by -`cancel-timer-internal'; using this reduces consing for repeat -timers). If nil, allocate a new cell." - (timer--activate timer triggered-p reuse-cell nil)) - -(defun timer-activate-when-idle (timer &optional dont-wait reuse-cell) - "Insert TIMER into `timer-idle-list'. -This arranges to activate TIMER whenever Emacs is next idle. -If optional argument DONT-WAIT is non-nil, set TIMER to activate -immediately \(see below), or at the right time, if Emacs is -already idle. - -REUSE-CELL, if non-nil, is a cons cell to reuse when inserting -TIMER into `timer-idle-list' (usually a cell removed from that -list by `cancel-timer-internal'; using this reduces consing for -repeat timers). If nil, allocate a new cell. - -Using non-nil DONT-WAIT is not recommended when activating an -idle timer from an idle timer handler, if the timer being -activated has an idleness time that is smaller or equal to -the time of the current timer. That's because the activated -timer will fire right away." - (timer--activate timer (not dont-wait) reuse-cell 'idle)) + +(defsubst timer-activate (timer &optional _triggered-p _reuse-cell) + "Install TIMER." + (timer--check timer) + (cl-pushnew timer timer-list)) + +(defsubst timer-activate-when-idle (timer &optional _dont-wait _reuse-cell) + "Install idle TIMER" + (setf (timer--idle-delay timer) 'idle) + (timer--check timer) + (cl-pushnew timer timer-idle-list)) (defalias 'disable-timeout #'cancel-timer) (defun cancel-timer (timer) "Remove TIMER from the list of active timers." - (timer--check timer) (setq timer-list (delq timer timer-list)) (setq timer-idle-list (delq timer timer-idle-list)) nil) -(defun cancel-timer-internal (timer) - "Remove TIMER from the list of active timers or idle timers. -Only to be used in this file. It returns the cons cell -that was removed from the timer list." - (let ((cell1 (memq timer timer-list)) - (cell2 (memq timer timer-idle-list))) - (if cell1 - (setq timer-list (delq timer timer-list))) - (if cell2 - (setq timer-idle-list (delq timer timer-idle-list))) - (or cell1 cell2))) - (defun cancel-function-timers (function) "Cancel all timers which would run FUNCTION. This affects ordinary timers such as are scheduled by `run-at-time', @@ -258,7 +187,7 @@ cancel-function-timers (dolist (timer timer-idle-list) (if (eq (timer--function timer) function) (setq timer-idle-list (delq timer timer-idle-list))))) - + ;; Record the last few events, for debugging. (defvar timer-event-last nil "Last timer that was run.") @@ -285,74 +214,51 @@ timer-until (defun timer-event-handler (timer) "Call the handler for the timer TIMER. This function is called, by name, directly by the C code." - (setq timer-event-last-2 timer-event-last-1) - (setq timer-event-last-1 timer-event-last) - (setq timer-event-last timer) - (let ((inhibit-quit t)) - (timer--check timer) - (let ((retrigger nil) - (cell - ;; Delete from queue. Record the cons cell that was used. - (cancel-timer-internal timer))) - ;; If `cell' is nil, it means the timer was already canceled, so we - ;; shouldn't be running it at all. This can happen for example with the - ;; following scenario (bug#17392): - ;; - we run timers, starting with A (and remembering the rest as (B C)). - ;; - A runs and a does a sit-for. - ;; - during sit-for we run timer D which cancels timer B. - ;; - timer A finally finishes, so we move on to timers B and C. - (when cell - ;; Re-schedule if requested. - (if (timer--repeat-delay timer) - (if (timer--idle-delay timer) - (timer-activate-when-idle timer nil cell) - (timer-inc-time timer (timer--repeat-delay timer) 0) - ;; If real time has jumped forward, - ;; perhaps because Emacs was suspended for a long time, - ;; limit how many times things get repeated. - (if (and (numberp timer-max-repeats) - (time-less-p (timer--time timer) nil)) - (let ((repeats (/ (timer-until timer nil) - (timer--repeat-delay timer)))) - (if (> repeats timer-max-repeats) - (timer-inc-time timer (* (timer--repeat-delay timer) - repeats))))) - ;; If we want integral multiples, we have to recompute - ;; the repetition. - (when (and (> (length timer) 9) ; Backwards compatible. - (timer--integral-multiple timer) - (not (timer--idle-delay timer))) - (setf (timer--time timer) - (timer-next-integral-multiple-of-time - nil (timer--repeat-delay timer)))) - ;; Place it back on the timer-list before running - ;; timer--function, so it can cancel-timer itself. - (timer-activate timer t cell) - (setq retrigger t))) - ;; Run handler. - (condition-case-unless-debug err - ;; Timer functions should not change the current buffer. - ;; If they do, all kinds of nasty surprises can happen, - ;; and it can be hellish to track down their source. - (save-current-buffer - (apply (timer--function timer) (timer--args timer))) - (error (message "Error running timer%s: %S" - (if (symbolp (timer--function timer)) - (format-message " `%s'" (timer--function timer)) - "") - err))) - (when (and retrigger - ;; If the timer's been canceled, don't "retrigger" it - ;; since it might still be in the copy of timer-list kept - ;; by keyboard.c:timer_check (bug#14156). - (memq timer timer-list)) - (setf (timer--triggered timer) nil)))))) + (setq timer-event-last-2 timer-event-last-1 + timer-event-last-1 timer-event-last + timer-event-last timer) + (let ((inhibit-quit t) + (run-handler + (lambda (timer) + (condition-case-unless-debug err + (save-current-buffer + (setf (timer--triggered timer) t) + (let ((restore-deactivate-mark deactivate-mark)) + (apply (timer--function timer) (timer--args timer)) + (setq deactivate-mark restore-deactivate-mark))) + (error (message "Error running timer%s: %s" + (if (symbolp (timer--function timer)) + (format-message " '%s'" (timer--function timer)) + "") + (error-message-string err))))))) + (cond ((memq timer timer-list) + (funcall run-handler timer) + (if (not (timer--repeat-delay timer)) + ;; dequeue + (cancel-timer timer) + ;; requeue at new time + (setf (timer--triggered timer) nil) + (if (timer--integral-multiple timer) + (setf (timer--time timer) + (timer-next-integral-multiple-of-time + nil (timer--repeat-delay timer))) + (timer-inc-time timer (timer--repeat-delay timer))) + (when (numberp timer-max-repeats) + ;; Limit repetitions in case emacs was unduly suspended + (let ((limit (time-subtract nil (* timer-max-repeats + (timer--repeat-delay timer))))) + (when (time-less-p (timer--time timer) limit) + (setf (timer--time timer) limit)))))) + ((memq timer timer-idle-list) + (funcall run-handler timer) + (unless (timer--repeat-delay timer) + (cancel-timer timer)))))) ;; This function is incompatible with the one in levents.el. (defun timeout-event-p (event) "Non-nil if EVENT is a timeout event." (and (listp event) (eq (car event) 'timer-event))) - + (declare-function diary-entry-time "diary-lib" (s)) @@ -451,19 +357,11 @@ add-timeout (run-with-timer secs repeat function object)) (defun run-with-idle-timer (secs repeat function &rest args) - "Perform an action the next time Emacs is idle for SECS seconds. -The action is to call FUNCTION with arguments ARGS. -SECS may be an integer, a floating point number, or the internal -time format returned by, e.g., `current-idle-time'. -If Emacs is currently idle, and has been idle for N seconds (N < SECS), -then it will call FUNCTION in SECS - N seconds from now. Using -SECS <= N is not recommended if this function is invoked from an idle -timer, because FUNCTION will then be called immediately. - -If REPEAT is non-nil, do the action each time Emacs has been idle for -exactly SECS seconds (that is, only once for each time Emacs becomes idle). - -This function returns a timer object which you can use in `cancel-timer'." + "Call FUNCTION on ARGS when idle for SECS seconds. +If REPEAT is non-nil, repeat the behavior until cancelled via +`cancel-timer'. SECS may be an integer, a floating point number, +or the internal time format returned by, e.g., +`current-idle-time'." (interactive (list (read-from-minibuffer "Run after idle (seconds): " nil nil t) (y-or-n-p "Repeat each time Emacs is idle? ") @@ -471,9 +369,9 @@ run-with-idle-timer (let ((timer (timer-create))) (timer-set-function timer function args) (timer-set-idle-time timer secs repeat) - (timer-activate-when-idle timer t) + (timer-activate-when-idle timer) timer)) - + (defvar with-timeout-timers nil "List of all timers used by currently pending `with-timeout' calls.") @@ -533,7 +431,7 @@ y-or-n-p-with-timeout If the user does not answer after SECONDS seconds, return DEFAULT-VALUE." (with-timeout (seconds default-value) (y-or-n-p prompt))) - + (defconst timer-duration-words (list (cons "microsec" 0.000001) (cons "microsecond" 0.000001) @@ -578,9 +476,8 @@ timer-duration (defun internal-timer-start-idle () "Mark all idle-time timers as once again candidates for running." (dolist (timer timer-idle-list) - (if (timerp timer) ;; FIXME: Why test? - (setf (timer--triggered timer) nil)))) - + (setf (timer--triggered timer) nil))) + (provide 'timer) ;;; timer.el ends here diff --git a/lisp/frame.el b/lisp/frame.el index b820d5fcd96..6eb7459ba42 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2861,7 +2861,7 @@ blink-cursor--start-idle-timer ;; during command execution) if they set blink-cursor-delay ;; to a very small or even zero value. (run-with-idle-timer (max 0.2 blink-cursor-delay) - :repeat #'blink-cursor-start))) + t #'blink-cursor-start))) (defun blink-cursor--start-timer () "Start the `blink-cursor-timer'." diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index 452cbd1ca51..2246cff28bf 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -593,7 +593,7 @@ jit-lock-stealth-fontify (when jit-lock-stealth-buffers (timer-set-idle-time jit-lock-stealth-repeat-timer (current-idle-time)) (timer-inc-time jit-lock-stealth-repeat-timer delay) - (timer-activate-when-idle jit-lock-stealth-repeat-timer t))))) + (timer-activate-when-idle jit-lock-stealth-repeat-timer))))) ;;; Deferred fontification. diff --git a/lisp/time.el b/lisp/time.el index 522bec46ac6..280293a9de2 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -238,8 +238,8 @@ display-time-event-handler (timer display-time-timer) ;; Compute the time when this timer will run again, next. (next-time (timer-relative-time - (list (aref timer 1) (aref timer 2) (aref timer 3)) - (* 5 (aref timer 4)) 0))) + (timer--time timer) + (* 5 (timer--repeat-delay timer)) 0))) ;; If the activation time is not in the future, ;; skip executions until we reach a time in the future. ;; This avoids a long pause if Emacs has been suspended for hours. diff --git a/src/fns.c b/src/fns.c index 0af9b725c7a..28cffc9053f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -751,7 +751,7 @@ DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0, Lisp_Object val = Fcons (XCAR (arg), Qnil); Lisp_Object prev = val; Lisp_Object tail = XCDR (arg); - FOR_EACH_TAIL (tail) + FOR_EACH_TAIL_SAFE (tail) { Lisp_Object c = Fcons (XCAR (tail), Qnil); XSETCDR (prev, c); diff --git a/src/keyboard.c b/src/keyboard.c index b2816f8270b..761e731fb22 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -4527,47 +4527,9 @@ timer_resume_idle (void) ...). Each element has the form (FUN . ARGS). */ Lisp_Object pending_funcalls; -/* Return true if TIMER is a valid timer, placing its value into *RESULT. */ -static bool -decode_timer (Lisp_Object timer, struct timespec *result) -{ - Lisp_Object *vec; - - if (! (VECTORP (timer) && ASIZE (timer) == 10)) - return false; - vec = XVECTOR (timer)->contents; - if (! NILP (vec[0])) - return false; - if (! FIXNUMP (vec[2])) - return false; - return list4_to_timespec (vec[1], vec[2], vec[3], vec[8], result); -} - - -/* Check whether a timer has fired. To prevent larger problems we simply - disregard elements that are not proper timers. Do not make a circular - timer list for the time being. - - Returns the time to wait until the next timer fires. If a - timer is triggering now, return zero. - If no timer is active, return -1. - - If a timer is ripe, we run it, with quitting turned off. - In that case we return 0 to indicate that a new timer_check_2 call - should be done. */ - -static struct timespec -timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers) +static void +trigger_timer (Lisp_Object timer) { - struct timespec nexttime; - struct timespec now; - struct timespec idleness_now; - Lisp_Object chosen_timer; - - nexttime = invalid_timespec (); - - chosen_timer = Qnil; - /* First run the code that was delayed. */ while (CONSP (pending_funcalls)) { @@ -4575,180 +4537,77 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers) pending_funcalls = XCDR (pending_funcalls); safe_call2 (Qapply, XCAR (funcall), XCDR (funcall)); } - - if (CONSP (timers) || CONSP (idle_timers)) - { - now = current_timespec (); - idleness_now = (timespec_valid_p (timer_idleness_start_time) - ? timespec_sub (now, timer_idleness_start_time) - : make_timespec (0, 0)); - } - - while (CONSP (timers) || CONSP (idle_timers)) - { - Lisp_Object timer = Qnil, idle_timer = Qnil; - struct timespec timer_time, idle_timer_time; - struct timespec difference; - struct timespec timer_difference = invalid_timespec (); - struct timespec idle_timer_difference = invalid_timespec (); - bool ripe, timer_ripe = 0, idle_timer_ripe = 0; - - /* Set TIMER and TIMER_DIFFERENCE - based on the next ordinary timer. - TIMER_DIFFERENCE is the distance in time from NOW to when - this timer becomes ripe. - Skip past invalid timers and timers already handled. */ - if (CONSP (timers)) - { - timer = XCAR (timers); - if (! decode_timer (timer, &timer_time)) - { - timers = XCDR (timers); - continue; - } - - timer_ripe = timespec_cmp (timer_time, now) <= 0; - timer_difference = (timer_ripe - ? timespec_sub (now, timer_time) - : timespec_sub (timer_time, now)); - } - - /* Likewise for IDLE_TIMER and IDLE_TIMER_DIFFERENCE - based on the next idle timer. */ - if (CONSP (idle_timers)) - { - idle_timer = XCAR (idle_timers); - if (! decode_timer (idle_timer, &idle_timer_time)) - { - idle_timers = XCDR (idle_timers); - continue; - } - - idle_timer_ripe = timespec_cmp (idle_timer_time, idleness_now) <= 0; - idle_timer_difference - = (idle_timer_ripe - ? timespec_sub (idleness_now, idle_timer_time) - : timespec_sub (idle_timer_time, idleness_now)); - } - - /* Decide which timer is the next timer, - and set CHOSEN_TIMER, DIFFERENCE, and RIPE accordingly. - Also step down the list where we found that timer. */ - - if (timespec_valid_p (timer_difference) - && (! timespec_valid_p (idle_timer_difference) - || idle_timer_ripe < timer_ripe - || (idle_timer_ripe == timer_ripe - && ((timer_ripe - ? timespec_cmp (idle_timer_difference, - timer_difference) - : timespec_cmp (timer_difference, - idle_timer_difference)) - < 0)))) - { - chosen_timer = timer; - timers = XCDR (timers); - difference = timer_difference; - ripe = timer_ripe; - } - else - { - chosen_timer = idle_timer; - idle_timers = XCDR (idle_timers); - difference = idle_timer_difference; - ripe = idle_timer_ripe; - } - - /* If timer is ripe, run it if it hasn't been run. */ - if (ripe) - { - /* If we got here, presumably `decode_timer` has checked - that this timer has not yet been triggered. */ - eassert (NILP (AREF (chosen_timer, 0))); - /* In a production build, where assertions compile to - nothing, we still want to play it safe here. */ - if (NILP (AREF (chosen_timer, 0))) - { - specpdl_ref count = SPECPDL_INDEX (); - Lisp_Object old_deactivate_mark = Vdeactivate_mark; - - /* Mark the timer as triggered to prevent problems if the lisp - code fails to reschedule it right. */ - ASET (chosen_timer, 0, Qt); - - specbind (Qinhibit_quit, Qt); - - call1 (Qtimer_event_handler, chosen_timer); - Vdeactivate_mark = old_deactivate_mark; - timers_run++; - unbind_to (count, Qnil); - - /* Since we have handled the event, - we don't need to tell the caller to wake up and do it. */ - /* But the caller must still wait for the next timer, so - return 0 to indicate that. */ - } - - nexttime = make_timespec (0, 0); - break; - } - else - /* When we encounter a timer that is still waiting, - return the amount of time to wait before it is ripe. */ - { - return difference; - } - } - - /* No timers are pending in the future. */ - /* Return 0 if we generated an event, and -1 if not. */ - return nexttime; + call1 (Qtimer_event_handler, timer); + timers_run++; } +/* Trigger any timers meeting their respective criteria. -/* Check whether a timer has fired. To prevent larger problems we simply - disregard elements that are not proper timers. Do not make a circular - timer list for the time being. + For ordinary timers, this means current time is at + or past their scheduled time. - Returns the time to wait until the next timer fires. - If no timer is active, return an invalid value. + For idle timers, this means the idled period exceeds + their idle threshold. - As long as any timer is ripe, we run it. */ + Return the time distance to the next upcoming timer. +*/ struct timespec timer_check (void) { - struct timespec nexttime; - Lisp_Object timers, idle_timers; - - Lisp_Object tem = Vinhibit_quit; - Vinhibit_quit = Qt; - block_input (); - turn_on_atimers (false); - - /* We use copies of the timers' lists to allow a timer to add itself - again, without locking up Emacs if the newly added timer is - already ripe when added. */ + struct timespec now = current_timespec (); + struct timespec idled = timespec_valid_p (timer_idleness_start_time) + ? timespec_sub (now, timer_idleness_start_time) + : invalid_timespec (); + struct timespec until_next = invalid_timespec (); + Lisp_Object *const lists[] = { &Vtimer_list, &Vtimer_idle_list }; + struct timespec const bogeys[] = { now, idled }; - /* Always consider the ordinary timers. */ - timers = Fcopy_sequence (Vtimer_list); - /* Consider the idle timers only if Emacs is idle. */ - if (timespec_valid_p (timer_idleness_start_time)) - idle_timers = Fcopy_sequence (Vtimer_idle_list); - else - idle_timers = Qnil; - - turn_on_atimers (true); - unblock_input (); - Vinhibit_quit = tem; - - do + for (int i = 0; i < 2; ++i) { - nexttime = timer_check_2 (timers, idle_timers); + struct timespec bogey = bogeys[i]; + if (! timespec_valid_p (bogey)) + continue; + + Lisp_Object timers = Fcopy_sequence (*lists[i]); + FOR_EACH_TAIL_SAFE (timers) + { + struct timespec time; + Lisp_Object *vec; + CHECK_VECTOR (XCAR (timers)); + vec = XVECTOR (XCAR (timers))->contents; + if (NILP (vec[0])) /* not yet triggered */ + { + if (list4_to_timespec (vec[1], vec[2], vec[3], vec[8], &time)) + { + /* Trigger when: + For ordinary timer, now is at or past trigger time. + For idle timer, idled duration at or past threshold. */ + if (timespec_cmp (bogey, time) >= 0) + { + trigger_timer (XCAR (timers)); + } + else + { + struct timespec diff = timespec_sub (time, bogey); + if (! timespec_valid_p (until_next) + || timespectod (diff) < timespectod (until_next)) + until_next = diff; + } + } + } + else /* was triggered */ + { + /* Clean up timers that errored out. */ + if (NILP (vec[4])) /* if not repeated, delete it. */ + *lists[i] = Fdelq (XCAR (timers), *lists[i]); + else if (NILP (vec[7]) /* if not idle, reset it. */) + vec[0] = Qnil; + } + } } - while (nexttime.tv_sec == 0 && nexttime.tv_nsec == 0); - return nexttime; + return until_next; } DEFUN ("current-idle-time", Fcurrent_idle_time, Scurrent_idle_time, 0, 0, 0, diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el index 7652b324493..be59727620d 100644 --- a/test/lisp/emacs-lisp/timer-tests.el +++ b/test/lisp/emacs-lisp/timer-tests.el @@ -65,4 +65,30 @@ timer-next-integral-multiple-of-time-3 (let ((nt (timer-next-integral-multiple-of-time '(32770 . 65539) 0.5))) (should (time-equal-p 1 nt)))) +(defvar timer-test-debug-on-error-delay 0.5) +(defvar timer-test-debug-on-error-timer nil) + +(ert-deftest timer-test-debug-on-error-0 () + "Set the trap." + :expected-result :failed + (setq timer-test-debug-on-error-timer + (run-at-time nil timer-test-debug-on-error-delay + (lambda () + (setf (timer--function timer-test-debug-on-error-timer) + #'ignore) + (error "foo")))) + (sit-for 0.1 t)) + +(ert-deftest timer-test-debug-on-error-1 () + "Recover when `debug-on-error' leaves timer-event-handler in limbo." + (should debug-on-error) + (unwind-protect + (progn + (sit-for (* timer-test-debug-on-error-delay 3) t) + (should-not (timer--triggered timer-test-debug-on-error-timer)) + (list-timers) + (with-current-buffer "*timer-list*" + (should-error (re-search-forward (regexp-quote "-1d "))))) + (cancel-timer timer-test-debug-on-error-timer))) + ;;; timer-tests.el ends here -- 2.38.1