commit e5ef59b87da5c2ddfa22f7342efe29b3eea6ed97 (HEAD, refs/remotes/origin/master) Author: Dima Kogan Date: Mon Dec 19 23:23:14 2016 -0800 diff-mode auto-refines only after a successful motion Prior to this patch (if enabled) auto-refinement would kick in after all hunk navigation commands, even if the motion failed. This would result in a situation where the hunk navigation would signal an error and beep, but yet still accomplish potentially useful work, by auto-refining. This patch moves the auto-refinement code to only run when a motion was successful * lisp/vc/diff-mode.el (diff--internal-hunk-next, diff--internal-hunk-prev): Removed auto-refinement-triggering code * lisp/vc/diff-mode.el (diff--wrap-navigation): Added auto-refinement-triggering code diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index d74ff2f5c9..75fd420922 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -551,23 +551,7 @@ next hunk if TRY-HARDER is non-nil; otherwise signal an error." ;; Define diff-{hunk,file}-{prev,next} (easy-mmode-define-navigation - diff--internal-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view - (when diff-auto-refine-mode - (unless (prog1 diff--auto-refine-data - (setq diff--auto-refine-data - (cons (current-buffer) (point-marker)))) - (run-at-time 0.0 nil - (lambda () - (when diff--auto-refine-data - (let ((buffer (car diff--auto-refine-data)) - (point (cdr diff--auto-refine-data))) - (setq diff--auto-refine-data nil) - (with-local-quit - (when (buffer-live-p buffer) - (with-current-buffer buffer - (save-excursion - (goto-char point) - (diff-refine-hunk)))))))))))) + diff--internal-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view) (easy-mmode-define-navigation diff--internal-file diff-file-header-re "file" diff-end-of-file) @@ -605,7 +589,26 @@ to the NEXT marker." (when (not (looking-at header-re)) (goto-char start) - (user-error (format "No %s" what)))))) + (user-error (format "No %s" what))) + + ;; We successfully moved to the next/prev hunk/file. Apply the + ;; auto-refinement if needed + (when diff-auto-refine-mode + (unless (prog1 diff--auto-refine-data + (setq diff--auto-refine-data + (cons (current-buffer) (point-marker)))) + (run-at-time 0.0 nil + (lambda () + (when diff--auto-refine-data + (let ((buffer (car diff--auto-refine-data)) + (point (cdr diff--auto-refine-data))) + (setq diff--auto-refine-data nil) + (with-local-quit + (when (buffer-live-p buffer) + (with-current-buffer buffer + (save-excursion + (goto-char point) + (diff-refine-hunk)))))))))))))) ;; These functions all take a skip-hunk-start argument which controls ;; whether we skip pre-hunk-start text or not. In interactive uses we commit 6b6abe0dba6a9a2e5f78aac3814421886e7a184f Author: Dima Kogan Date: Mon Dec 19 23:25:28 2016 -0800 diff-mode is able to better handle file headers This fixes a regression introduced in http://git.savannah.gnu.org/gitweb/?p=emacs.git;a=commit;h=2c8a7e50d24daf19ea7d86f1cfeaa98a41c56085 This bug was filed in https://debbugs.gnu.org/cgi/bugreport.cgi?bug=25105 Patches generated from a VCS such as git contain a patch message at the start, and diff-mode is now once-again able to properly able to ignore this message when issuing navigation commands around the message. * lisp/vc/diff-mode.el (diff-beginning-of-file-and-junk): More thoroughly ignore the header when looking for a beginning of file diffs. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index d5ea002fa8..d74ff2f5c9 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -768,7 +768,7 @@ data such as \"Index: ...\" and such." (setq prevfile nextfile)) (if (and previndex (numberp prevfile) (< previndex prevfile)) (setq prevfile previndex)) - (if (and (numberp prevfile) (<= prevfile start)) + (if (numberp prevfile) (progn (goto-char prevfile) ;; Now skip backward over the leading junk we may have before the commit 2dae636237603b436b48e77e2f893bb4d42f3ce7 Author: Paul Eggert Date: Sat Dec 24 17:03:22 2016 -0800 Use libpng-config --ldflags, not --libs Problem reported by James K. Lowden (Bug#25268). * configure.ac (LIBPNG): Pass --ldflags, not --libs, to libpng-config. diff --git a/configure.ac b/configure.ac index 5aaf006c54..cd6c689a52 100644 --- a/configure.ac +++ b/configure.ac @@ -3476,7 +3476,7 @@ elif test "${with_png}" != no; then elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then AC_MSG_CHECKING([for png]) png_cflags=`(libpng-config --cflags) 2>&AS_MESSAGE_LOG_FD` && - png_libs=`(libpng-config --libs) 2>&AS_MESSAGE_LOG_FD` || { + png_ldflags=`(libpng-config --ldflags) 2>&AS_MESSAGE_LOG_FD` || { # libpng-config does not work; configure by hand. # Debian unstable as of July 2003 has multiple libpngs, and puts png.h # in /usr/include/libpng. @@ -3486,18 +3486,18 @@ elif test "${with_png}" != no; then else png_cflags= fi - png_libs='-lpng' + png_ldflags='-lpng' } SAVE_CFLAGS=$CFLAGS SAVE_LIBS=$LIBS CFLAGS="$CFLAGS $png_cflags" - LIBS="$png_libs -lz -lm $LIBS" + LIBS="$png_ldflags -lz -lm $LIBS" AC_LINK_IFELSE( [AC_LANG_PROGRAM([[#include ]], [[return !png_get_channels (0, 0);]])], [HAVE_PNG=yes PNG_CFLAGS=`AS_ECHO(["$png_cflags"]) | sed -e "$edit_cflags"` - LIBPNG=$png_libs + LIBPNG=$png_ldflags # $LIBPNG requires explicit -lz in some cases. # We don't know what those cases are, exactly, so play it safe and # append -lz to any nonempty $LIBPNG, unless we're already using LIBZ. commit da52e939aa26b0fc241151ba554bdca6ea1ef38c Author: Noam Postavsky Date: Sat Dec 24 09:41:46 2016 -0500 Remove redundant `save-match-data' in whitespace.el * lisp/whitespace.el (whitespace-cleanup, whitespace-cleanup-region): (whitespace-report-region): Remove redundant `save-match-data' calls. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index a15308c0bc..231675407d 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1398,18 +1398,17 @@ documentation." ;; whole buffer (t (save-excursion - (save-match-data ;FIXME: Why? - ;; PROBLEM 1: empty lines at bob - ;; PROBLEM 2: empty lines at eob - ;; ACTION: remove all empty lines at bob and/or eob - (when (memq 'empty whitespace-style) - (let (overwrite-mode) ; enforce no overwrite - (goto-char (point-min)) - (when (looking-at whitespace-empty-at-bob-regexp) - (delete-region (match-beginning 1) (match-end 1))) - (when (re-search-forward - whitespace-empty-at-eob-regexp nil t) - (delete-region (match-beginning 1) (match-end 1))))))) + ;; PROBLEM 1: empty lines at bob + ;; PROBLEM 2: empty lines at eob + ;; ACTION: remove all empty lines at bob and/or eob + (when (memq 'empty whitespace-style) + (let (overwrite-mode) ; enforce no overwrite + (goto-char (point-min)) + (when (looking-at whitespace-empty-at-bob-regexp) + (delete-region (match-beginning 1) (match-end 1))) + (when (re-search-forward + whitespace-empty-at-eob-regexp nil t) + (delete-region (match-beginning 1) (match-end 1)))))) ;; PROBLEM 3: `tab-width' or more SPACEs at bol ;; PROBLEM 4: SPACEs before TAB ;; PROBLEM 5: SPACEs or TABs at eol @@ -1476,76 +1475,75 @@ documentation." overwrite-mode ; enforce no overwrite tmp) (save-excursion - (save-match-data ;FIXME: Why? - ;; PROBLEM 1: `tab-width' or more SPACEs at bol - (cond - ;; ACTION: replace `tab-width' or more SPACEs at bol by TABs, if - ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs - ;; by SPACEs. - ((memq 'indentation whitespace-style) - (let ((regexp (whitespace-indentation-regexp))) - (goto-char rstart) - (while (re-search-forward regexp rend t) - (setq tmp (current-indentation)) - (goto-char (match-beginning 0)) - (delete-horizontal-space) - (unless (eolp) - (indent-to tmp))))) - ;; ACTION: replace `tab-width' or more SPACEs at bol by TABs. - ((memq 'indentation::tab whitespace-style) - (whitespace-replace-action - 'tabify rstart rend - (whitespace-indentation-regexp 'tab) 0)) - ;; ACTION: replace TABs by SPACEs. - ((memq 'indentation::space whitespace-style) - (whitespace-replace-action - 'untabify rstart rend - (whitespace-indentation-regexp 'space) 0))) - ;; PROBLEM 3: SPACEs or TABs at eol - ;; ACTION: remove all SPACEs or TABs at eol - (when (memq 'trailing whitespace-style) - (whitespace-replace-action - 'delete-region rstart rend - whitespace-trailing-regexp 1)) - ;; PROBLEM 4: `tab-width' or more SPACEs after TAB - (cond - ;; ACTION: replace `tab-width' or more SPACEs by TABs, if - ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs - ;; by SPACEs. - ((memq 'space-after-tab whitespace-style) - (whitespace-replace-action - (if whitespace-indent-tabs-mode 'tabify 'untabify) - rstart rend (whitespace-space-after-tab-regexp) 1)) - ;; ACTION: replace `tab-width' or more SPACEs by TABs. - ((memq 'space-after-tab::tab whitespace-style) - (whitespace-replace-action - 'tabify rstart rend - (whitespace-space-after-tab-regexp 'tab) 1)) - ;; ACTION: replace TABs by SPACEs. - ((memq 'space-after-tab::space whitespace-style) - (whitespace-replace-action - 'untabify rstart rend - (whitespace-space-after-tab-regexp 'space) 1))) - ;; PROBLEM 2: SPACEs before TAB - (cond - ;; ACTION: replace SPACEs before TAB by TABs, if - ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs - ;; by SPACEs. - ((memq 'space-before-tab whitespace-style) - (whitespace-replace-action - (if whitespace-indent-tabs-mode 'tabify 'untabify) - rstart rend whitespace-space-before-tab-regexp - (if whitespace-indent-tabs-mode 0 2))) - ;; ACTION: replace SPACEs before TAB by TABs. - ((memq 'space-before-tab::tab whitespace-style) - (whitespace-replace-action - 'tabify rstart rend - whitespace-space-before-tab-regexp 0)) - ;; ACTION: replace TABs by SPACEs. - ((memq 'space-before-tab::space whitespace-style) - (whitespace-replace-action - 'untabify rstart rend - whitespace-space-before-tab-regexp 2))))) + ;; PROBLEM 1: `tab-width' or more SPACEs at bol + (cond + ;; ACTION: replace `tab-width' or more SPACEs at bol by TABs, if + ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs + ;; by SPACEs. + ((memq 'indentation whitespace-style) + (let ((regexp (whitespace-indentation-regexp))) + (goto-char rstart) + (while (re-search-forward regexp rend t) + (setq tmp (current-indentation)) + (goto-char (match-beginning 0)) + (delete-horizontal-space) + (unless (eolp) + (indent-to tmp))))) + ;; ACTION: replace `tab-width' or more SPACEs at bol by TABs. + ((memq 'indentation::tab whitespace-style) + (whitespace-replace-action + 'tabify rstart rend + (whitespace-indentation-regexp 'tab) 0)) + ;; ACTION: replace TABs by SPACEs. + ((memq 'indentation::space whitespace-style) + (whitespace-replace-action + 'untabify rstart rend + (whitespace-indentation-regexp 'space) 0))) + ;; PROBLEM 3: SPACEs or TABs at eol + ;; ACTION: remove all SPACEs or TABs at eol + (when (memq 'trailing whitespace-style) + (whitespace-replace-action + 'delete-region rstart rend + whitespace-trailing-regexp 1)) + ;; PROBLEM 4: `tab-width' or more SPACEs after TAB + (cond + ;; ACTION: replace `tab-width' or more SPACEs by TABs, if + ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs + ;; by SPACEs. + ((memq 'space-after-tab whitespace-style) + (whitespace-replace-action + (if whitespace-indent-tabs-mode 'tabify 'untabify) + rstart rend (whitespace-space-after-tab-regexp) 1)) + ;; ACTION: replace `tab-width' or more SPACEs by TABs. + ((memq 'space-after-tab::tab whitespace-style) + (whitespace-replace-action + 'tabify rstart rend + (whitespace-space-after-tab-regexp 'tab) 1)) + ;; ACTION: replace TABs by SPACEs. + ((memq 'space-after-tab::space whitespace-style) + (whitespace-replace-action + 'untabify rstart rend + (whitespace-space-after-tab-regexp 'space) 1))) + ;; PROBLEM 2: SPACEs before TAB + (cond + ;; ACTION: replace SPACEs before TAB by TABs, if + ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs + ;; by SPACEs. + ((memq 'space-before-tab whitespace-style) + (whitespace-replace-action + (if whitespace-indent-tabs-mode 'tabify 'untabify) + rstart rend whitespace-space-before-tab-regexp + (if whitespace-indent-tabs-mode 0 2))) + ;; ACTION: replace SPACEs before TAB by TABs. + ((memq 'space-before-tab::tab whitespace-style) + (whitespace-replace-action + 'tabify rstart rend + whitespace-space-before-tab-regexp 0)) + ;; ACTION: replace TABs by SPACEs. + ((memq 'space-before-tab::space whitespace-style) + (whitespace-replace-action + 'untabify rstart rend + whitespace-space-before-tab-regexp 2)))) (set-marker rend nil)))) ; point marker to nowhere @@ -1710,74 +1708,73 @@ cleaning up these problems." (interactive "r") (setq force (or current-prefix-arg force)) (save-excursion - (save-match-data ;FIXME: Why? - (let* ((has-bogus nil) - (rstart (min start end)) - (rend (max start end)) - ;; Fall back to whitespace-style so we can run before - ;; before the mode is active. - (style (copy-sequence - (or whitespace-active-style whitespace-style))) - (bogus-list - (mapcar - #'(lambda (option) - (when force - (add-to-list 'style (car option))) - (goto-char rstart) - (let ((regexp - (cond - ((eq (car option) 'indentation) - (whitespace-indentation-regexp)) - ((eq (car option) 'indentation::tab) - (whitespace-indentation-regexp 'tab)) - ((eq (car option) 'indentation::space) - (whitespace-indentation-regexp 'space)) - ((eq (car option) 'space-after-tab) - (whitespace-space-after-tab-regexp)) - ((eq (car option) 'space-after-tab::tab) - (whitespace-space-after-tab-regexp 'tab)) - ((eq (car option) 'space-after-tab::space) - (whitespace-space-after-tab-regexp 'space)) - (t - (cdr option))))) - (when (re-search-forward regexp rend t) - (unless has-bogus - (setq has-bogus (memq (car option) style))) - t))) - whitespace-report-list))) - (when (pcase report-if-bogus (`nil t) (`never nil) (_ has-bogus)) - (whitespace-kill-buffer whitespace-report-buffer-name) - ;; `whitespace-indent-tabs-mode' is local to current buffer - ;; `whitespace-tab-width' is local to current buffer - (let ((ws-indent-tabs-mode whitespace-indent-tabs-mode) - (ws-tab-width whitespace-tab-width)) - (with-current-buffer (get-buffer-create - whitespace-report-buffer-name) - (erase-buffer) - (insert (if ws-indent-tabs-mode - (car whitespace-report-text) - (cdr whitespace-report-text))) - (goto-char (point-min)) - (forward-line 3) - (dolist (option whitespace-report-list) - (forward-line 1) - (whitespace-mark-x - 27 (memq (car option) style)) - (whitespace-mark-x 7 (car bogus-list)) - (setq bogus-list (cdr bogus-list))) - (forward-line 1) - (whitespace-insert-value ws-indent-tabs-mode) - (whitespace-insert-value ws-tab-width) - (when has-bogus - (goto-char (point-max)) - (insert (substitute-command-keys - " Type `\\[whitespace-cleanup]'") - " to cleanup the buffer.\n\n" - (substitute-command-keys - " Type `\\[whitespace-cleanup-region]'") - " to cleanup a region.\n\n")) - (whitespace-display-window (current-buffer))))) - has-bogus)))) + (let* ((has-bogus nil) + (rstart (min start end)) + (rend (max start end)) + ;; Fall back to whitespace-style so we can run before + ;; before the mode is active. + (style (copy-sequence + (or whitespace-active-style whitespace-style))) + (bogus-list + (mapcar + #'(lambda (option) + (when force + (add-to-list 'style (car option))) + (goto-char rstart) + (let ((regexp + (cond + ((eq (car option) 'indentation) + (whitespace-indentation-regexp)) + ((eq (car option) 'indentation::tab) + (whitespace-indentation-regexp 'tab)) + ((eq (car option) 'indentation::space) + (whitespace-indentation-regexp 'space)) + ((eq (car option) 'space-after-tab) + (whitespace-space-after-tab-regexp)) + ((eq (car option) 'space-after-tab::tab) + (whitespace-space-after-tab-regexp 'tab)) + ((eq (car option) 'space-after-tab::space) + (whitespace-space-after-tab-regexp 'space)) + (t + (cdr option))))) + (when (re-search-forward regexp rend t) + (unless has-bogus + (setq has-bogus (memq (car option) style))) + t))) + whitespace-report-list))) + (when (pcase report-if-bogus (`nil t) (`never nil) (_ has-bogus)) + (whitespace-kill-buffer whitespace-report-buffer-name) + ;; `whitespace-indent-tabs-mode' is local to current buffer + ;; `whitespace-tab-width' is local to current buffer + (let ((ws-indent-tabs-mode whitespace-indent-tabs-mode) + (ws-tab-width whitespace-tab-width)) + (with-current-buffer (get-buffer-create + whitespace-report-buffer-name) + (erase-buffer) + (insert (if ws-indent-tabs-mode + (car whitespace-report-text) + (cdr whitespace-report-text))) + (goto-char (point-min)) + (forward-line 3) + (dolist (option whitespace-report-list) + (forward-line 1) + (whitespace-mark-x + 27 (memq (car option) style)) + (whitespace-mark-x 7 (car bogus-list)) + (setq bogus-list (cdr bogus-list))) + (forward-line 1) + (whitespace-insert-value ws-indent-tabs-mode) + (whitespace-insert-value ws-tab-width) + (when has-bogus + (goto-char (point-max)) + (insert (substitute-command-keys + " Type `\\[whitespace-cleanup]'") + " to cleanup the buffer.\n\n" + (substitute-command-keys + " Type `\\[whitespace-cleanup-region]'") + " to cleanup a region.\n\n")) + (whitespace-display-window (current-buffer))))) + has-bogus))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; commit cf5417f02887d681923c7d23326916889ae4049a Author: Noam Postavsky Date: Tue Dec 20 23:02:48 2016 -0500 Fix whitespace eob cleanup * lisp/whitespace.el (whitespace-empty-at-eob-regexp): Match any number of empty lines at end of buffer. * test/lisp/whitespace-tests.el (whitespace-cleanup-eob): New test. (whitespace-tests--cleanup-string): New helper function for tests. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 29d60c9a0d..a15308c0bc 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -729,7 +729,7 @@ Used when `whitespace-style' includes `empty'." :group 'whitespace) -(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]*\\(\n\\{2,\\}\\|[ \t]+\\)\\)\\'" +(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'" "Specify regexp for empty lines at end of buffer. Used when `whitespace-style' includes `empty'." diff --git a/test/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el new file mode 100644 index 0000000000..ffd2e65d9a --- /dev/null +++ b/test/lisp/whitespace-tests.el @@ -0,0 +1,52 @@ +;;; whitespace-tests.el --- Test suite for whitespace -*- lexical-binding: t -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; 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 . + +;;; Code: + +(require 'ert) +(require 'whitespace) + +(defun whitespace-tests--cleanup-string (string) + (with-temp-buffer + (insert string) + (whitespace-cleanup) + (buffer-string))) + +(ert-deftest whitespace-cleanup-eob () + (let ((whitespace-style '(empty))) + (should (equal (whitespace-tests--cleanup-string "a\n") + "a\n")) + (should (equal (whitespace-tests--cleanup-string "a\n\n") + "a\n")) + (should (equal (whitespace-tests--cleanup-string "a\n\t\n") + "a\n")) + (should (equal (whitespace-tests--cleanup-string "a\n\t \n") + "a\n")) + (should (equal (whitespace-tests--cleanup-string "a\n\t \n\n") + "a\n")) + (should (equal (whitespace-tests--cleanup-string "\n\t\n") + "")) + ;; Whitespace at end of non-empty line is not covered by the + ;; `empty' style. + (should (equal (whitespace-tests--cleanup-string "a \n\t \n\n") + "a \n")))) + +(provide 'whitespace-tests) + +;;; whitespace-tests.el ends here commit 25c9cb77b4346c9912c995ca3a63fc7ab424795e Author: Hong Xu Date: Sat Dec 24 14:35:12 2016 +0200 Fix timezone detection of parse-iso8601-time-string * parse-time.el (parse-iso8601-time-string): Fix timezone parsing. Add a doc string. (Bug#25086) * editfns.c (Fdecode-time): Doc fix. * emacs-mime.texi (time-date): Add an example for parse-iso8601-time-string. * parse-time-tests.el (parse-time-tests): Add tests for parse-iso8601-time-string. diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 2b935870da..9389435faf 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -1536,6 +1536,9 @@ Here's a bunch of time/date/second/day examples: (date-to-time "Sat Sep 12 12:21:54 1998 +0200") @result{} (13818 19266) +(parse-iso8601-time-string "1998-09-12T12:21:54+0200") +@result{} (13818 19266) + (float-time '(13818 19266)) @result{} 905595714.0 diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index b62f9fa794..ef7758df44 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -202,7 +202,7 @@ any values that are unknown are returned as nil." (time-minute 2digit) (time-second 2digit) (time-secfrac "\\(\\.[0-9]+\\)?") - (time-numoffset (concat "[-+]\\(" time-hour "\\):" time-minute)) + (time-numoffset (concat "\\([-+]\\)" time-hour ":?" time-minute "?")) (time-offset (concat "Z" time-numoffset)) (partial-time (concat time-hour colon time-minute colon time-second time-secfrac)) @@ -211,19 +211,22 @@ any values that are unknown are returned as nil." (date-time (concat full-date "T" full-time))) (list (concat "^" full-date) (concat "T" partial-time) - (concat "Z" time-numoffset))) + (concat "\\(Z\\|" time-numoffset "\\)"))) "List of regular expressions matching ISO 8601 dates. 1st regular expression matches the date. 2nd regular expression matches the time. 3rd regular expression matches the (optional) timezone specification.") (defun parse-iso8601-time-string (date-string) + "Parse an ISO 8601 time string, such as 2016-12-01T23:35:06-05:00. +If DATE-STRING cannot be parsed, it falls back to +`parse-time-string'." (let* ((date-re (nth 0 parse-time-iso8601-regexp)) (time-re (nth 1 parse-time-iso8601-regexp)) (tz-re (nth 2 parse-time-iso8601-regexp)) - re-start - time seconds minute hour fractional-seconds - day month year day-of-week dst tz) + re-start + time seconds minute hour fractional-seconds + day month year day-of-week dst tz) ;; We need to populate 'time' with ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ) @@ -242,10 +245,19 @@ any values that are unknown are returned as nil." "0")) re-start (match-end 0)) (when (string-match tz-re date-string re-start) - (setq tz (match-string 1 date-string))) + (if (string= "Z" (match-string 1 date-string)) + (setq tz 0) ;; UTC timezone indicated by Z + (setq tz (+ + (* 3600 + (string-to-number (match-string 3 date-string))) + (* 60 + (string-to-number + (or (match-string 4 date-string) "0"))))) + (when (string= "-" (match-string 2 date-string)) + (setq tz (- tz))))) (setq time (list seconds minute hour day month year day-of-week dst tz)))) - ;; Fall back to having Gnus do fancy things for us. + ;; Fall back to having `parse-time-string' do fancy things for us. (when (not time) (setq time (parse-time-string date-string))) diff --git a/src/editfns.c b/src/editfns.c index 6ea8cbaf5e..ccc78e1275 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2136,7 +2136,7 @@ format_time_string (char const *format, ptrdiff_t formatlen, DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0, doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF). -The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED), +The optional TIME should be a list of (HIGH LOW . IGNORED), as from `current-time' and `file-attributes', or nil to use the current time. It can also be a single integer number of seconds since the epoch. The obsolete form (HIGH . LOW) is also still accepted. diff --git a/test/lisp/calendar/parse-time-tests.el b/test/lisp/calendar/parse-time-tests.el index 9bcf2b4a53..6dc23372f2 100644 --- a/test/lisp/calendar/parse-time-tests.el +++ b/test/lisp/calendar/parse-time-tests.el @@ -42,7 +42,23 @@ (should (equal (parse-time-string "Monday, 22 february 2016 19:35:42 +0100") '(42 35 19 22 2 2016 1 nil 3600))) (should (equal (parse-time-string "Monday, 22 february 2016 19:35:42 PDT") - '(42 35 19 22 2 2016 1 t -25200)))) + '(42 35 19 22 2 2016 1 t -25200))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-0200") + '(13818 33666))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-0230") + '(13818 35466))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-02:00") + '(13818 33666))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-02") + '(13818 33666))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54+0230") + '(13818 17466))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54+02") + '(13818 19266))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54Z") + '(13818 26466))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54") + (encode-time 54 21 12 12 9 1998)))) (provide 'parse-time-tests)