mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-15 09:47:20 +00:00
Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs into master
This commit is contained in:
commit
e9d0f36248
@ -1,4 +1,4 @@
|
||||
;;; time-date.el --- Date and time handling functions
|
||||
;;; time-date.el --- Date and time handling functions -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
@ -2789,7 +2789,9 @@ Possible return values are `standard', `saved', `set', `themed',
|
||||
(and (equal value (eval (car tmp)))
|
||||
(equal comment temp))
|
||||
(error nil))
|
||||
'set
|
||||
(if (equal value (eval (car (get symbol 'standard-value))))
|
||||
'standard
|
||||
'set)
|
||||
'changed))
|
||||
((progn (setq tmp (get symbol 'theme-value))
|
||||
(setq temp (get symbol 'saved-variable-comment))
|
||||
@ -2859,6 +2861,18 @@ otherwise."
|
||||
(defun custom-variable-standard-value (widget)
|
||||
(get (widget-value widget) 'standard-value))
|
||||
|
||||
(defun custom-variable-current-value (widget)
|
||||
"Return the current value of the variable edited by WIDGET.
|
||||
|
||||
WIDGET should be a custom-variable widget."
|
||||
(let* ((symbol (widget-value widget))
|
||||
(get (or (get symbol 'custom-get) 'default-value))
|
||||
(type (custom-variable-type symbol))
|
||||
(conv (widget-convert type)))
|
||||
(if (default-boundp symbol)
|
||||
(funcall get symbol)
|
||||
(widget-get conv :value))))
|
||||
|
||||
(defvar custom-variable-menu nil
|
||||
"If non-nil, an alist of actions for the `custom-variable' widget.
|
||||
|
||||
@ -2989,10 +3003,12 @@ Optional EVENT is the location for the menu."
|
||||
(setq comment nil)
|
||||
;; Make the comment invisible by hand if it's empty
|
||||
(custom-comment-hide comment-widget))
|
||||
(custom-variable-backup-value widget)
|
||||
(setq val (widget-value child))
|
||||
(unless (equal (eval val) (custom-variable-current-value widget))
|
||||
(custom-variable-backup-value widget))
|
||||
(custom-push-theme 'theme-value symbol 'user
|
||||
'set (custom-quote (widget-value child)))
|
||||
(funcall set symbol (eval (setq val (widget-value child))))
|
||||
'set (custom-quote val))
|
||||
(funcall set symbol (eval val))
|
||||
(put symbol 'customized-value (list val))
|
||||
(put symbol 'variable-comment comment)
|
||||
(put symbol 'customized-variable-comment comment))
|
||||
@ -3001,10 +3017,12 @@ Optional EVENT is the location for the menu."
|
||||
(setq comment nil)
|
||||
;; Make the comment invisible by hand if it's empty
|
||||
(custom-comment-hide comment-widget))
|
||||
(custom-variable-backup-value widget)
|
||||
(setq val (widget-value child))
|
||||
(unless (equal val (custom-variable-current-value widget))
|
||||
(custom-variable-backup-value widget))
|
||||
(custom-push-theme 'theme-value symbol 'user
|
||||
'set (custom-quote (widget-value child)))
|
||||
(funcall set symbol (setq val (widget-value child)))
|
||||
'set (custom-quote val))
|
||||
(funcall set symbol val)
|
||||
(put symbol 'customized-value (list (custom-quote val)))
|
||||
(put symbol 'variable-comment comment)
|
||||
(put symbol 'customized-variable-comment comment)))
|
||||
@ -3073,17 +3091,23 @@ before this operation becomes the backup value."
|
||||
(let* ((symbol (widget-value widget))
|
||||
(saved-value (get symbol 'saved-value))
|
||||
(comment (get symbol 'saved-variable-comment))
|
||||
(old-value (custom-variable-current-value widget))
|
||||
value)
|
||||
(custom-variable-backup-value widget)
|
||||
(if (not (or saved-value comment))
|
||||
;; If there is no saved value, remove the setting.
|
||||
(custom-push-theme 'theme-value symbol 'user 'reset)
|
||||
(progn
|
||||
(setq value (car (get symbol 'standard-value)))
|
||||
;; If there is no saved value, remove the setting.
|
||||
(custom-push-theme 'theme-value symbol 'user 'reset)
|
||||
;; And reset this property too.
|
||||
(put symbol 'variable-comment nil))
|
||||
(setq value (car-safe saved-value))
|
||||
(custom-push-theme 'theme-value symbol 'user 'set value)
|
||||
(put symbol 'variable-comment comment))
|
||||
(unless (equal (eval value) old-value)
|
||||
(custom-variable-backup-value widget))
|
||||
(ignore-errors
|
||||
(funcall (or (get symbol 'custom-set) #'set-default) symbol
|
||||
(eval (or value (car (get symbol 'standard-value))))))
|
||||
(eval value)))
|
||||
(put symbol 'customized-value nil)
|
||||
(put symbol 'customized-variable-comment nil)
|
||||
(widget-put widget :custom-state 'unknown)
|
||||
@ -3096,7 +3120,9 @@ If `custom-reset-standard-variables-list' is nil, save, reset and
|
||||
redraw the widget immediately."
|
||||
(let* ((symbol (widget-value widget)))
|
||||
(if (get symbol 'standard-value)
|
||||
(custom-variable-backup-value widget)
|
||||
(unless (equal (custom-variable-current-value widget)
|
||||
(eval (car (get symbol 'standard-value))))
|
||||
(custom-variable-backup-value widget))
|
||||
(user-error "No standard setting known for %S" symbol))
|
||||
(put symbol 'variable-comment nil)
|
||||
(put symbol 'customized-value nil)
|
||||
@ -3133,13 +3159,8 @@ becomes the backup value, so you can get it again."
|
||||
(defun custom-variable-backup-value (widget)
|
||||
"Back up the current value for WIDGET's variable.
|
||||
The backup value is kept in the car of the `backup-value' property."
|
||||
(let* ((symbol (widget-value widget))
|
||||
(get (or (get symbol 'custom-get) 'default-value))
|
||||
(type (custom-variable-type symbol))
|
||||
(conv (widget-convert type))
|
||||
(value (if (default-boundp symbol)
|
||||
(funcall get symbol)
|
||||
(widget-get conv :value))))
|
||||
(let ((symbol (widget-value widget))
|
||||
(value (custom-variable-current-value widget)))
|
||||
(put symbol 'backup-value (list value))))
|
||||
|
||||
(defun custom-variable-reset-backup (widget)
|
||||
|
@ -1051,8 +1051,8 @@ out of NAME."
|
||||
|
||||
(defcustom ffap-rfc-path "https://www.rfc-editor.org/in-notes/rfc%s.txt"
|
||||
"A `format' string making a filename for RFC documents.
|
||||
This can be an URL, and ange-ftp or Tramp remote filename to
|
||||
download, or a local filename if you have full set of RFCs
|
||||
This can be an URL, an ange-ftp or Tramp remote filename to
|
||||
download, or a local filename if you have the full set of RFCs
|
||||
locally. See also `ffap-rfc-directories'."
|
||||
:type 'string
|
||||
:version "28.1")
|
||||
|
@ -22,19 +22,67 @@
|
||||
(require 'ert)
|
||||
(require 'time-date)
|
||||
|
||||
(ert-deftest test-obsolete-with-decoded-time-value ()
|
||||
(with-suppressed-warnings ((obsolete with-decoded-time-value))
|
||||
(with-decoded-time-value ((high low micro pico type '(1 2 3 4 5 6 8 8)))
|
||||
(should (equal (list high low micro pico type) '(1 2 3 4 3))))))
|
||||
|
||||
(ert-deftest test-obsolete-encode-time-value ()
|
||||
(should (equal (with-suppressed-warnings ((obsolete encode-time-value))
|
||||
(encode-time-value 1 2 3 4 0))
|
||||
'(1 . 2)))
|
||||
(should (equal (with-suppressed-warnings ((obsolete encode-time-value))
|
||||
(encode-time-value 1 2 3 4 1))
|
||||
'(1 2)))
|
||||
(should (equal (with-suppressed-warnings ((obsolete encode-time-value))
|
||||
(encode-time-value 1 2 3 4 2))
|
||||
'(1 2 3)))
|
||||
(should (equal (with-suppressed-warnings ((obsolete encode-time-value))
|
||||
(encode-time-value 1 2 3 4 3))
|
||||
'(1 2 3 4))))
|
||||
|
||||
(ert-deftest test-leap-year ()
|
||||
(should-not (date-leap-year-p 1999))
|
||||
(should-not (date-leap-year-p 1900))
|
||||
(should (date-leap-year-p 2000))
|
||||
(should (date-leap-year-p 2004)))
|
||||
|
||||
(ert-deftest test-days-to-time ()
|
||||
(should (equal (days-to-time 0) '(0 0)))
|
||||
(should (equal (days-to-time 1) '(1 20864)))
|
||||
(should (equal (days-to-time 999) '(1317 2688)))
|
||||
(should (equal (days-to-time 0.0) '(0 0 0 0)))
|
||||
(should (equal (days-to-time 0.5) '(0 43200 0 0)))
|
||||
(should (equal (days-to-time 1.0) '(1 20864 0 0)))
|
||||
(should (equal (days-to-time 999.0) '(1317 2688 0 0))))
|
||||
|
||||
(ert-deftest test-seconds-to-string ()
|
||||
(should (equal (seconds-to-string 0) "0s"))
|
||||
(should (equal (seconds-to-string 9) "9.00s"))
|
||||
(should (equal (seconds-to-string 99) "99.00s"))
|
||||
(should (equal (seconds-to-string 999) "16.65m"))
|
||||
(should (equal (seconds-to-string 9999) "2.78h"))
|
||||
(should (equal (seconds-to-string 99999) "27.78h"))
|
||||
(should (equal (seconds-to-string 999999) "11.57d"))
|
||||
(should (equal (seconds-to-string 9999999) "115.74d"))
|
||||
(should (equal (seconds-to-string 99999999) "3.17y"))
|
||||
(should (equal (seconds-to-string 999999999) "31.69y")))
|
||||
|
||||
(ert-deftest test-days-in-month ()
|
||||
(should (= (date-days-in-month 2004 2) 29))
|
||||
(should (= (date-days-in-month 2004 3) 31))
|
||||
(should (= (date-days-in-month 2019 2) 28))
|
||||
(should (= (date-days-in-month 2020 12) 31))
|
||||
(should-not (= (date-days-in-month 1900 3) 28))
|
||||
(should-error (date-days-in-month 2020 0))
|
||||
(should-error (date-days-in-month 2020 15))
|
||||
(should-error (date-days-in-month 2020 'foo)))
|
||||
|
||||
(ert-deftest test-format-seconds ()
|
||||
(should (equal (format-seconds "%y %d %h %m %s %%" 0) "0 0 0 0 0 %"))
|
||||
(should (equal (format-seconds "%y %d %h %m %s %%" 9999999) "0 115 17 46 39 %"))
|
||||
(should (equal (format-seconds "%y %d %h %m %z %s %%" 1) " 1 %")))
|
||||
|
||||
(ert-deftest test-ordinal ()
|
||||
(should (equal (date-ordinal-to-time 2008 271)
|
||||
'(nil nil nil 27 9 2008 nil nil nil)))
|
||||
@ -107,7 +155,8 @@
|
||||
'(12 15 14 8 7 2019 1 t 7200)))))
|
||||
|
||||
(ert-deftest test-time-since ()
|
||||
(should (time-equal-p 0 (time-since nil))))
|
||||
(should (time-equal-p 0 (time-since nil)))
|
||||
(should (= (cadr (time-since (time-subtract (current-time) 1))) 1)))
|
||||
|
||||
(ert-deftest test-time-decoded-period ()
|
||||
(should (equal (decoded-time-period '(nil nil 1 nil nil nil nil nil nil))
|
||||
@ -119,6 +168,7 @@
|
||||
(should (equal (decoded-time-period '(0 0 0 1 0 0 nil nil nil)) 86400))
|
||||
(should (equal (decoded-time-period '(0 0 0 0 1 0 nil nil nil)) 2592000))
|
||||
(should (equal (decoded-time-period '(0 0 0 0 0 1 nil nil nil)) 31536000))
|
||||
(should (equal (decoded-time-period '(1 2 3 4 5 6 nil nil nil)) 202532521))
|
||||
|
||||
(should (equal (decoded-time-period '((135 . 10) 0 0 0 0 0 nil nil nil))
|
||||
13.5)))
|
||||
|
Loading…
Reference in New Issue
Block a user