commit 18ae12e053c8e4dd7ea21f8d94a7f51a78648e64 (HEAD, refs/remotes/origin/master) Author: Stefan Kangas Date: Wed Sep 2 23:11:27 2020 +0200 Use lexical-binding in mwheel.el diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 3775eefc4f..3b93bd1d5e 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -1,4 +1,4 @@ -;;; mwheel.el --- Wheel mouse support +;;; mwheel.el --- Mouse wheel support -*- lexical-binding:t -*- ;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc. ;; Keywords: mouse commit 76e8d935a72c14037b44cff0a929b4f71b65bcf1 Author: Stefan Kangas Date: Wed Sep 2 23:10:27 2020 +0200 Simplify mwheel-mode by using alist instead of two variables * lisp/mwheel.el (mouse-wheel--remove-bindings): Update call signature to take no arguments. Doc fix. (mouse-wheel--add-binding): Break out from... (mouse-wheel-mode): ...here. Simplify by using above functions. (mouse-wheel--installed-bindings-alist): New variable. (mwheel-installed-bindings): Make obsolete. (mwheel-installed-text-scale-bindings): Make obsolete. * test/lisp/mwheel-tests.el (mwheel-test-enable/disable): New test. diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 53a5a50bad..3775eefc4f 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -344,16 +344,24 @@ non-Windows systems." (text-scale-decrease 1))) (select-window selected-window)))) -(defvar mwheel-installed-bindings nil) -(defvar mwheel-installed-text-scale-bindings nil) +(defvar mouse-wheel--installed-bindings-alist nil + "Alist of all installed mouse wheel key bindings.") -(defun mouse-wheel--remove-bindings (bindings funs) - "Remove key BINDINGS if they're bound to any function in FUNS. -BINDINGS is a list of key bindings, FUNS is a list of functions. +(defun mouse-wheel--add-binding (key fun) + "Bind mouse wheel button KEY to function FUN. +Save it for later removal by `mouse-wheel--remove-bindings'." + (global-set-key key fun) + (push (cons key fun) mouse-wheel--installed-bindings-alist)) + +(defun mouse-wheel--remove-bindings () + "Remove all mouse wheel key bindings. This is a helper function for `mouse-wheel-mode'." - (dolist (key bindings) - (when (memq (lookup-key (current-global-map) key) funs) - (global-unset-key key)))) + (dolist (binding mouse-wheel--installed-bindings-alist) + (let ((key (car binding)) + (fun (cdr binding))) + (when (eq (lookup-key (current-global-map) key) fun) + (global-unset-key key)))) + (setq mouse-wheel--installed-bindings-alist nil)) (defun mouse-wheel--create-scroll-keys (binding event) "Return list of key vectors for BINDING and EVENT. @@ -381,12 +389,7 @@ an event used for scrolling, such as `mouse-wheel-down-event'." :global t :group 'mouse ;; Remove previous bindings, if any. - (mouse-wheel--remove-bindings mwheel-installed-bindings - '(mwheel-scroll)) - (mouse-wheel--remove-bindings mwheel-installed-text-scale-bindings - '(mouse-wheel-text-scale)) - (setq mwheel-installed-bindings nil) - (setq mwheel-installed-text-scale-bindings nil) + (mouse-wheel--remove-bindings) ;; Setup bindings as needed. (when mouse-wheel-mode (dolist (binding mouse-wheel-scroll-amount) @@ -394,18 +397,16 @@ an event used for scrolling, such as `mouse-wheel-down-event'." ;; Bindings for changing font size. ((and (consp binding) (eq (cdr binding) 'text-scale)) (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event)) - ;; Add binding. - (let ((key `[,(list (caar binding) event)])) - (global-set-key key 'mouse-wheel-text-scale) - (push key mwheel-installed-text-scale-bindings)))) + (mouse-wheel--add-binding `[,(list (caar binding) event)] + 'mouse-wheel-text-scale))) ;; Bindings for scrolling. (t (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event mouse-wheel-left-event mouse-wheel-right-event)) (dolist (key (mouse-wheel--create-scroll-keys binding event)) - ;; Add binding. - (global-set-key key 'mwheel-scroll) - (push key mwheel-installed-bindings)))))))) + (mouse-wheel--add-binding key 'mwheel-scroll)))))))) + +;;; Obsolete. ;;; Compatibility entry point ;; preloaded ;;;###autoload @@ -414,6 +415,12 @@ an event used for scrolling, such as `mouse-wheel-down-event'." (declare (obsolete mouse-wheel-mode "27.1")) (mouse-wheel-mode (if uninstall -1 1))) +(defvar mwheel-installed-bindings nil) +(make-obsolete-variable 'mwheel-installed-bindings nil "28.1") + +(defvar mwheel-installed-text-scale-bindings nil) +(make-obsolete-variable 'mwheel-installed-text-scale-bindings nil "28.1") + (provide 'mwheel) ;;; mwheel.el ends here diff --git a/test/lisp/mwheel-tests.el b/test/lisp/mwheel-tests.el index 0e45b76c06..fd998fd4f0 100644 --- a/test/lisp/mwheel-tests.el +++ b/test/lisp/mwheel-tests.el @@ -22,6 +22,12 @@ (require 'ert) (require 'mwheel) +(ert-deftest mwheel-test-enable/disable () + (mouse-wheel-mode 1) + (should (eq (lookup-key (current-global-map) '[mouse-4]) 'mwheel-scroll)) + (mouse-wheel-mode -1) + (should (eq (lookup-key (current-global-map) '[mouse-4]) nil))) + (ert-deftest mwheel-test--create-scroll-keys () (should (equal (mouse-wheel--create-scroll-keys 10 'mouse-4) '([mouse-4] commit 77a5b696bbb4f70e23e94c8a731168a6673c8cd9 Author: Stefan Kangas Date: Wed Sep 2 22:54:47 2020 +0200 Fix binding mouse wheel with modifiers in buffer area * test/lisp/mwheel-tests.el (mwheel-test--create-scroll-keys): Fix binding mouse wheel with modifiers in buffer area, while ignoring them for fringes, margins, etc. My previous change mistakenly ignored all modifiers in `mouse-wheel-scroll-amount'. * lisp/mwheel.el (mouse-wheel--create-scroll-keys): Fix test to reflect the above. diff --git a/lisp/mwheel.el b/lisp/mwheel.el index d5172ba0bf..53a5a50bad 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -363,8 +363,11 @@ an event used for scrolling, such as `mouse-wheel-down-event'." 'left-fringe 'right-fringe 'vertical-scroll-bar 'horizontal-scroll-bar 'mode-line 'header-line))) - (cons (vector event) ; default case: no prefix. - (when (not (consp binding)) + (if (consp binding) + ;; With modifiers, bind only the buffer area (no prefix). + (list `[(,@(car binding) ,event)]) + ;; No modifier: bind also some non-buffer areas of the screen. + (cons (vector event) (mapcar (lambda (prefix) (vector prefix event)) prefixes))))) (define-minor-mode mouse-wheel-mode diff --git a/test/lisp/mwheel-tests.el b/test/lisp/mwheel-tests.el index f2989d608b..0e45b76c06 100644 --- a/test/lisp/mwheel-tests.el +++ b/test/lisp/mwheel-tests.el @@ -23,16 +23,18 @@ (require 'mwheel) (ert-deftest mwheel-test--create-scroll-keys () - (should (equal (mouse-wheel--create-scroll-keys 10 'mouse-1) - '([mouse-1] - [left-margin mouse-1] [right-margin mouse-1] - [left-fringe mouse-1] [right-fringe mouse-1] - [vertical-scroll-bar mouse-1] [horizontal-scroll-bar mouse-1] - [mode-line mouse-1] [header-line mouse-1]))) + (should (equal (mouse-wheel--create-scroll-keys 10 'mouse-4) + '([mouse-4] + [left-margin mouse-4] [right-margin mouse-4] + [left-fringe mouse-4] [right-fringe mouse-4] + [vertical-scroll-bar mouse-4] [horizontal-scroll-bar mouse-4] + [mode-line mouse-4] [header-line mouse-4]))) ;; Don't bind modifiers outside of buffer area (e.g. for fringes). - (should (equal (mouse-wheel--create-scroll-keys '((shift) . 1) 'mouse-1) - '([mouse-1]))) + (should (equal (mouse-wheel--create-scroll-keys '((shift) . 1) 'mouse-4) + '([(shift mouse-4)]))) (should (equal (mouse-wheel--create-scroll-keys '((control) . 9) 'mouse-7) - '([mouse-7])))) + '([(control mouse-7)]))) + (should (equal (mouse-wheel--create-scroll-keys '((meta) . 5) 'mouse-5) + '([(meta mouse-5)])))) ;;; mwheel-tests.el ends here commit 5aa5c0372dc3cccf2676d26a17b4d5f71caf8cdc Merge: c5e8254b9c 1457e84f44 Author: Ulf Jasper Date: Wed Sep 2 19:59:57 2020 +0200 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit c5e8254b9c89ac866df057fa3acd2dc44e3989ae Author: Ulf Jasper Date: Wed Sep 2 19:58:56 2020 +0200 Apply icalendar.el patch by Thomas Plass . Fix bug#34315. * lisp/calendar/icalendar.el (icalendar--convert-tz-offset): No DST when RDATE is present. * lisp/calendar/icalendar.el (icalendar--parse-vtimezone): Use `icalendar--get-most-recent-observance'. * (icalendar--get-most-recent-observance): New. * (icalendar--decode-isodatetime): Add parameters source-zone, result-zone. * (icalendar--decode-isoduration): Fix decoding days. * test/lisp/calendar/icalendar-tests.el (icalendar--decode-isoduration): Add testcases. diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index d76c110503..dab277487e 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -515,9 +515,10 @@ The strings are suitable for assembling into a TZ variable." (let* ((offsetto (car (cddr (assq 'TZOFFSETTO alist)))) (offsetfrom (car (cddr (assq 'TZOFFSETFROM alist)))) (rrule-value (car (cddr (assq 'RRULE alist)))) + (rdate-p (and (assq 'RDATE alist) t)) (dtstart (car (cddr (assq 'DTSTART alist)))) - (no-dst (equal offsetto offsetfrom))) - ;; FIXME: for now we only handle RRULE and not RDATE here. + (no-dst (or rdate-p (equal offsetto offsetfrom)))) + ;; FIXME: the presence of an RDATE is assumed to denote the first day of the year (when (and offsetto dtstart (or rrule-value no-dst)) (let* ((rrule (icalendar--split-value rrule-value)) (freq (cadr (assq 'FREQ rrule))) @@ -561,12 +562,13 @@ The strings are suitable for assembling into a TZ variable." (defun icalendar--parse-vtimezone (alist) "Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING). +Consider only the most recent date specification. Return nil if timezone cannot be parsed." (let* ((tz-id (icalendar--convert-string-for-import (icalendar--get-event-property alist 'TZID))) - (daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT)))) + (daylight (cadr (cdar (icalendar--get-most-recent-observance alist 'DAYLIGHT)))) (day (and daylight (icalendar--convert-tz-offset daylight t))) - (standard (cadr (cdar (icalendar--get-children alist 'STANDARD)))) + (standard (cadr (cdar (icalendar--get-most-recent-observance alist 'STANDARD)))) (std (and standard (icalendar--convert-tz-offset standard nil)))) (if (and tz-id std) (cons tz-id @@ -575,6 +577,28 @@ Return nil if timezone cannot be parsed." "," (cdr day) "," (cdr std)) (car std)))))) +(defun icalendar--get-most-recent-observance (alist sub-comp) + "Return the latest observance for SUB-COMP DAYLIGHT or STANDARD. +ALIST is a VTIMEZONE potentially containing historical records." +;FIXME?: "most recent" should be relative to a given date + (let ((components (icalendar--get-children alist sub-comp))) + (list + (car + (sort components + #'(lambda (a b) + (let* ((get-recent (lambda (n) + (car + (sort + (delq nil + (mapcar (lambda (p) + (and (memq (car p) '(DTSTART RDATE)) + (car (cddr p)))) + n)) + 'string-greaterp)))) + (a-recent (funcall get-recent (car (cddr a)))) + (b-recent (funcall get-recent (car (cddr b))))) + (string-greaterp a-recent b-recent)))))))) + (defun icalendar--convert-all-timezones (icalendar) "Convert all timezones in the ICALENDAR into an alist. Each element of the alist is a cons (ID . TZ-STRING), @@ -594,15 +618,18 @@ ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'." (cdr (assoc id zone-map))))) (defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift - zone) + source-zone + result-zone) "Return ISODATETIMESTRING in format like `decode-time'. Converts from ISO-8601 to Emacs representation. If ISODATETIMESTRING specifies UTC time (trailing letter Z) the decoded time is given in the local time zone! If optional parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT days. -ZONE, if provided, is the timezone, in any format understood by `encode-time'. - +SOURCE-ZONE, if provided, is the timezone for decoding the time, +in any format understood by `encode-time'. +RESULT-ZONE, if provided, is the timezone for encoding the result +in any format understood by `decode-time'. FIXME: multiple comma-separated values should be allowed!" (icalendar--dmsg isodatetimestring) (if isodatetimestring @@ -624,7 +651,10 @@ FIXME: multiple comma-separated values should be allowed!" (when (and (> (length isodatetimestring) 15) ;; UTC specifier present (char-equal ?Z (aref isodatetimestring 15))) - (setq zone t)) + (setq source-zone t + ;; decode to local time unless result-zone is explicitly given, + ;; i.e. do not decode to UTC, i.e. do not (setq result-zone t) + )) ;; shift if necessary (if day-shift (let ((mdy (calendar-gregorian-from-absolute @@ -637,9 +667,9 @@ FIXME: multiple comma-separated values should be allowed!" ;; create the decoded date-time ;; FIXME!?! (let ((decoded-time (list second minute hour day month year - nil -1 zone))) + nil -1 source-zone))) (condition-case nil - (decode-time (encode-time decoded-time)) + (decode-time (encode-time decoded-time) result-zone) (error (message "Cannot decode \"%s\"" isodatetimestring) ;; Hope for the best.... @@ -685,9 +715,9 @@ FIXME: multiple comma-separated values should be allowed!" (setq days (1- days)))) ((match-beginning 4) ;days and time (if (match-beginning 5) - (setq days (* 7 (read (substring isodurationstring - (match-beginning 6) - (match-end 6)))))) + (setq days (read (substring isodurationstring + (match-beginning 6) + (match-end 6))))) (if (match-beginning 7) (setq hours (read (substring isodurationstring (match-beginning 8) diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 2beab614c8..bce7de769e 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -590,25 +590,25 @@ END:VEVENT (should (equal '(0 0 0 7 0 0) (icalendar--decode-isoduration "P7D"))) - ;; testcase: 7 days, one second -- to be fixed with bug#34315 - ;; (should (equal '(1 0 0 7 0 0) - ;; (icalendar--decode-isoduration "P7DT1S"))) + ;; testcase: 7 days, one second -- see bug#34315 + (should (equal '(1 0 0 7 0 0) + (icalendar--decode-isoduration "P7DT1S"))) ;; testcase: 3 hours, 2 minutes, one second (should (equal '(1 2 3 0 0 0) (icalendar--decode-isoduration "PT3H2M1S"))) - ;; testcase: 99 days, 3 hours, 2 minutes, one second -- to be fixed with bug#34315 - ;; (should (equal '(1 2 3 99 0 0) - ;; (icalendar--decode-isoduration "P99DT3H2M1S"))) + ;; testcase: 99 days, 3 hours, 2 minutes, one second -- see bug#34315 + (should (equal '(1 2 3 99 0 0) + (icalendar--decode-isoduration "P99DT3H2M1S"))) ;; testcase: 2 weeks (should (equal '(0 0 0 14 0 0) (icalendar--decode-isoduration "P2W"))) - ;; testcase: rfc2445, section 4.3.6: 15 days, 5 hours and 20 seconds -- to be fixed with bug#34315 - ;; (should (equal '(20 0 5 15 0 0) - ;; (icalendar--decode-isoduration "P15DT5H0M20S"))) + ;; testcase: rfc2445, section 4.3.6: 15 days, 5 hours and 20 seconds -- see bug#34315 + (should (equal '(20 0 5 15 0 0) + (icalendar--decode-isoduration "P15DT5H0M20S"))) ;; testcase: rfc2445, section 4.3.6: 7 weeks (should (equal '(0 0 0 49 0 0) commit 1457e84f4468f4a5f2de8c182596225cb1355afa Author: Michael Albinus Date: Wed Sep 2 19:50:14 2020 +0200 Fix bug in dbus.el * lisp/net/dbus.el (dbus-register-property) (dbus-property-handler): Handle properties of the same interface at different object paths properly. (Bug#43146) diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index fdd726ff61..971d3e730e 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -1484,15 +1484,19 @@ clients from discovering the still incomplete interface." ;; Create a hash table entry. We use nil for the unique name, ;; because the property might be accessed from anybody. - (let ((key (list :property bus interface property)) - (val - (list + (let* ((key (list :property bus interface property)) + ;; Remove possible existing entry, because it must be overwritten. + (val (seq-remove + (lambda (item) + (equal (butlast item) (list nil service path))) + (gethash key dbus-registered-objects-table))) + (entry (list nil service path (cons (if emits-signal (list access :emits-signal) (list access)) - value))))) - (puthash key val dbus-registered-objects-table) + value)))) + (puthash key (cons entry val) dbus-registered-objects-table) ;; Return the object. (list key (list service path)))) @@ -1509,9 +1513,15 @@ It will be registered for all objects created by `dbus-register-property'." (cond ;; "Get" returns a variant. ((string-equal method "Get") - (let ((entry (gethash (list :property bus interface property) - dbus-registered-objects-table))) - (when (string-equal path (nth 2 (car entry))) + (let ((entry + ;; Remove entries not belonging to this case. + (seq-remove + (lambda (item) + (not (string-equal (nth 2 item) path))) + (gethash (list :property bus interface property) + dbus-registered-objects-table)))) + + (when (string-equal path (nth 2 (car entry))) `((:variant ,(cdar (last (car entry)))))))) ;; "Set" expects a variant. commit e381c2f7f07e207901d4cffa4144fcba27f8d7aa Author: Ulf Jasper Date: Wed Sep 2 19:37:45 2020 +0200 Add unit tests for icalendar.el * test/lisp/calendar/icalendar-tests.el (icalendar--parse-vtimezone, icalendar--decode-isodatetime): Add testcases. * test/lisp/calendar/icalendar-tests.el (icalendar--convert-tz-offset, icalendar--decode-isoduration): New. diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index d496878205..2beab614c8 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -183,6 +183,7 @@ (ert-deftest icalendar--parse-vtimezone () "Test method for `icalendar--parse-vtimezone'." (let (vtimezone result) + ;; testcase: valid timezone with rrule (setq vtimezone (icalendar-tests--get-ical-event "BEGIN:VTIMEZONE TZID:thename BEGIN:STANDARD @@ -204,6 +205,8 @@ END:VTIMEZONE (message (cdr result)) (should (string= "STD-02:00DST-03:00,M3.5.0/03:00:00,M10.5.0/04:00:00" (cdr result))) + + ;; testcase: name of tz contains comma (setq vtimezone (icalendar-tests--get-ical-event "BEGIN:VTIMEZONE TZID:anothername, with a comma BEGIN:STANDARD @@ -225,7 +228,8 @@ END:VTIMEZONE (message (cdr result)) (should (string= "STD-02:00DST-03:00,M3.2.1/03:00:00,M10.2.1/04:00:00" (cdr result))) - ;; offsetfrom = offsetto + + ;; testcase: offsetfrom = offsetto (setq vtimezone (icalendar-tests--get-ical-event "BEGIN:VTIMEZONE TZID:Kolkata, Chennai, Mumbai, New Delhi X-MICROSOFT-CDO-TZID:23 @@ -245,7 +249,10 @@ END:VTIMEZONE (should (string= "Kolkata, Chennai, Mumbai, New Delhi" (car result))) (message (cdr result)) (should (string= "STD-05:30DST-05:30,M1.1.1/00:00:00,M1.1.1/00:00:00" - (cdr result))))) + (cdr result))) + + ;; FIXME: add testcase that covers changes for fix of bug#34315 + )) (ert-deftest icalendar--convert-ordinary-to-ical () "Test method for `icalendar--convert-ordinary-to-ical'." @@ -482,17 +489,132 @@ END:VEVENT (should (equal '(0 0 10 1 8 2013 4 t 10800) (icalendar--decode-isodatetime "20130801T100000"))) + ;; testcase: no time zone in input, shift by -1 days + ;; 1 Jan 2013 10:00 -> 31 Dec 2012 + (should (equal '(0 0 10 31 12 2012 1 nil 7200) + (icalendar--decode-isodatetime "20130101T100000" -1))) + ;; 1 Aug 2013 10:00 (DST) -> 31 Jul 2012 (DST) + (should (equal '(0 0 10 31 7 2013 3 t 10800) + (icalendar--decode-isodatetime "20130801T100000" -1))) + + ;; testcase: UTC time zone specifier in input -> convert to local time - ;; 31 Dec 2013 23:00 UTC -> 1 Jan 2013 01:00 EET + ;; 31 Dec 2013 23:00 UTC -> 1 Jan 2014 01:00 EET (should (equal '(0 0 1 1 1 2014 3 nil 7200) (icalendar--decode-isodatetime "20131231T230000Z"))) ;; 1 Aug 2013 10:00 UTC -> 1 Aug 2013 13:00 EEST (should (equal '(0 0 13 1 8 2013 4 t 10800) (icalendar--decode-isodatetime "20130801T100000Z"))) + ;; testcase: override timezone with Central European Time, 1 Jan 2013 10:00 -> 1 Jan 2013 11:00 + (should (equal '(0 0 11 1 1 2013 2 nil 7200) + (icalendar--decode-isodatetime "20130101T100000" nil + '(3600 "CET")))) + ;; testcase: override timezone (UTC-02:00), 1 Jan 2013 10:00 -> 1 Jan 2013 14:00 + (should (equal '(0 0 14 1 1 2013 2 nil 7200) + (icalendar--decode-isodatetime "20130101T100000" nil -7200))) + + ;; FIXME: add testcase that covers changes for fix of bug#34315 + + ) + ;; restore time-zone even if something went terribly wrong + (setenv "TZ" tz)))) + +(ert-deftest icalendar--convert-tz-offset () + "Test `icalendar--convert-tz-offset'." + (let ((tz (getenv "TZ"))) + (unwind-protect + (progn + ;; Use Eastern European Time (UTC+2, UTC+3 daylight saving) + (setenv "TZ" "EET-2EEST,M3.5.0/3,M10.5.0/4") + + ;; testcase: artificial input + (should (equal '("DST-03:00" . "M5.1.1/01:23:45") + (icalendar--convert-tz-offset + '((DTSTART nil "________T012345") ; + (TZOFFSETFROM nil "+0200") + (TZOFFSETTO nil "+0300") + (RRULE nil "FREQ=YEARLY;INTERVAL=1;BYDAY=1MO;BYMONTH=5")) + t))) + + ;; testcase: Europe/Berlin Standard + (should (equal '("STD-01:00" . "M10.5.0/03:00:00") + (icalendar--convert-tz-offset + '((TZOFFSETFROM nil "+0200") + (TZOFFSETTO nil "+0100") + (TZNAME nil CET) + (DTSTART nil "19701025T030000") + (RRULE nil "FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU")) + nil))) + + ;; testcase: Europe/Berlin DST + (should (equal '("DST-02:00" . "M3.5.0/02:00:00") + (icalendar--convert-tz-offset + '((TZOFFSETFROM nil "+0100") + (TZOFFSETTO nil "+0200") + (TZNAME nil CEST) + (DTSTART nil "19700329T020000") + (RRULE nil "FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU")) + t))) + + ;; testcase: dtstart is mandatory + (should (null (icalendar--convert-tz-offset + '((TZOFFSETFROM nil "+0100") + (TZOFFSETTO nil "+0200") + (RRULE nil "FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU")) + t))) + + ;; FIXME: rrule and rdate are NOT mandatory! Must fix code + ;; before activating these testcases + ;; ;; testcase: no rrule and no rdate => no result + ;; (should (null (icalendar--convert-tz-offset + ;; '((TZOFFSETFROM nil "+0100") + ;; (TZOFFSETTO nil "+0200") + ;; (DTSTART nil "19700329T020000")) + ;; t))) + ;; ;; testcase: no rrule with rdate => no result + ;; (should (null (icalendar--convert-tz-offset + ;; '((TZOFFSETFROM nil "+0100") + ;; (TZOFFSETTO nil "+0200") + ;; (DTSTART nil "18840101T000000") + ;; (RDATE nil "18840101T000000")) + ;; t))) ) ;; restore time-zone even if something went terribly wrong - (setenv "TZ" tz))) ) + (setenv "TZ" tz)))) + +(ert-deftest icalendar--decode-isoduration () + "Test `icalendar--decode-isoduration'." + + ;; testcase: 7 days + (should (equal '(0 0 0 7 0 0) + (icalendar--decode-isoduration "P7D"))) + + ;; testcase: 7 days, one second -- to be fixed with bug#34315 + ;; (should (equal '(1 0 0 7 0 0) + ;; (icalendar--decode-isoduration "P7DT1S"))) + + ;; testcase: 3 hours, 2 minutes, one second + (should (equal '(1 2 3 0 0 0) + (icalendar--decode-isoduration "PT3H2M1S"))) + + ;; testcase: 99 days, 3 hours, 2 minutes, one second -- to be fixed with bug#34315 + ;; (should (equal '(1 2 3 99 0 0) + ;; (icalendar--decode-isoduration "P99DT3H2M1S"))) + + ;; testcase: 2 weeks + (should (equal '(0 0 0 14 0 0) + (icalendar--decode-isoduration "P2W"))) + + ;; testcase: rfc2445, section 4.3.6: 15 days, 5 hours and 20 seconds -- to be fixed with bug#34315 + ;; (should (equal '(20 0 5 15 0 0) + ;; (icalendar--decode-isoduration "P15DT5H0M20S"))) + + ;; testcase: rfc2445, section 4.3.6: 7 weeks + (should (equal '(0 0 0 49 0 0) + (icalendar--decode-isoduration "P7W"))) + ) + ;; ====================================================================== ;; Export tests commit 410b16f92d61196af54e91c9de1046246f44b28d Author: Eric Abrahamsen Date: Wed Sep 2 09:07:35 2020 -0700 Handle different IMAP server responses to COPY and MOVE * lisp/gnus/nnimap.el (nnimap-request-move-article): Need to examine different parts of the result. diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index be8ad9a672..507e12a55e 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -986,7 +986,10 @@ textual parts.") (when (and (car result) (not can-move)) (nnimap-delete-article article)) (cons internal-move-group - (or (nnimap-find-uid-response "COPYUID" (caddr result)) + (or (nnimap-find-uid-response + "COPYUID" + ;; Server gives different responses for MOVE and COPY. + (if can-move (caddr result) (cadr result))) (nnimap-find-article-by-message-id internal-move-group server message-id nnimap-request-articles-find-limit))))) commit dd2c37d0e1d5dcbcd2658b8a5b9959996a133373 Author: Stefan Kangas Date: Wed Sep 2 17:31:08 2020 +0200 Fix OBOE in flyspell-check-previous-highlighted-word * lisp/textmodes/flyspell.el (flyspell-check-previous-highlighted-word): Fix off-by-one error when word is at (point-min). (Bug#39898) Suggested by OGAWA Hirofumi . diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 9805928721..6889d7eada 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -1904,7 +1904,7 @@ before point that's highlighted as misspelled." (while (and (setq pos (previous-overlay-change pos)) (not (= pos pos1))) (setq pos1 pos) - (if (> pos (point-min)) + (if (>= pos (point-min)) (progn (setq ovs (overlays-at pos)) (while (consp ovs) commit 615c15fd859b94e9d28d2424674b7e43aa3149a5 Author: Stefan Kangas Date: Wed Sep 2 16:37:13 2020 +0200 Use lexical-binding in pcmpl-unix.el * lisp/pcmpl-unix.el: Use lexical-binding. (pcmpl-ssh-known-hosts, pcmpl-ssh-config-hosts, pcmpl-ssh-hosts): Adjust for lexical-binding. diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el index f1c8725afe..822f6f37e7 100644 --- a/lisp/pcmpl-unix.el +++ b/lisp/pcmpl-unix.el @@ -1,4 +1,4 @@ -;;; pcmpl-unix.el --- standard UNIX completions +;;; pcmpl-unix.el --- standard UNIX completions -*- lexical-binding:t -*- ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. @@ -155,12 +155,14 @@ documentation), this function returns nil." (let ((host-re "\\(?:\\([-.[:alnum:]]+\\)\\|\\[\\([-.[:alnum:]]+\\)\\]:[0-9]+\\)[, ]") ssh-hosts-list) (while (re-search-forward (concat "^ *" host-re) nil t) - (add-to-list 'ssh-hosts-list (concat (match-string 1) - (match-string 2))) + (push (concat (match-string 1) + (match-string 2)) + ssh-hosts-list) (while (and (eq (char-before) ?,) (re-search-forward host-re (line-end-position) t)) - (add-to-list 'ssh-hosts-list (concat (match-string 1) - (match-string 2))))) + (push (concat (match-string 1) + (match-string 2)) + ssh-hosts-list))) ssh-hosts-list)))) (defun pcmpl-ssh-config-hosts () @@ -173,7 +175,7 @@ documentation), this function returns nil." (case-fold-search t)) (while (re-search-forward "^ *host\\(name\\)? +\\([-.[:alnum:]]+\\)" nil t) - (add-to-list 'ssh-hosts-list (match-string 2))) + (push (match-string 2) ssh-hosts-list)) ssh-hosts-list)))) (defun pcmpl-ssh-hosts () @@ -181,7 +183,7 @@ documentation), this function returns nil." Uses both `pcmpl-ssh-config-file' and `pcmpl-ssh-known-hosts-file'." (let ((hosts (pcmpl-ssh-known-hosts))) (dolist (h (pcmpl-ssh-config-hosts)) - (add-to-list 'hosts h)) + (push h hosts)) hosts)) ;;;###autoload commit a50b8397f476b794f06aafb2b755e011566fbc2b Author: Stefan Kangas Date: Wed Sep 2 05:02:18 2020 +0200 Use lexical-binding in pcmpl-linux.el and add tests * lisp/pcmpl-linux.el: Use lexical-binding. (pcmpl-linux-fs-modules-path-format) (pcmpl-linux-mtab-file): New constants. (pcmpl-linux-fs-types, pcmpl-linux-mounted-directories): Use above new constants. * test/lisp/pcmpl-linux-resources/fs/ext4/.keep: * test/lisp/pcmpl-linux-resources/mtab: * test/lisp/pcmpl-linux-tests.el: New files. diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el index 6e036434ef..df9d24507a 100644 --- a/lisp/pcmpl-linux.el +++ b/lisp/pcmpl-linux.el @@ -1,4 +1,4 @@ -;;; pcmpl-linux.el --- functions for dealing with GNU/Linux completions +;;; pcmpl-linux.el --- functions for dealing with GNU/Linux completions -*- lexical-binding: t -*- ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. @@ -65,18 +65,22 @@ (pcomplete-opt "hVanfFrsvwt(pcmpl-linux-fs-types)o?L?U?") (while (pcomplete-here (pcomplete-entries) nil 'identity))) +(defconst pcmpl-linux-fs-modules-path-format "/lib/modules/%s/kernel/fs/") + (defun pcmpl-linux-fs-types () "Return a list of available fs modules on GNU/Linux systems." (let ((kernel-ver (pcomplete-process-result "uname" "-r"))) (directory-files - (concat "/lib/modules/" kernel-ver "/kernel/fs/")))) + (format pcmpl-linux-fs-modules-path-format kernel-ver)))) + +(defconst pcmpl-linux-mtab-file "/etc/mtab") (defun pcmpl-linux-mounted-directories () "Return a list of mounted directory names." (let (points) - (when (file-readable-p "/etc/mtab") + (when (file-readable-p pcmpl-linux-mtab-file) (with-temp-buffer - (insert-file-contents-literally "/etc/mtab") + (insert-file-contents-literally pcmpl-linux-mtab-file) (while (not (eobp)) (let* ((line (buffer-substring (point) (line-end-position))) (args (split-string line " "))) diff --git a/test/lisp/pcmpl-linux-resources/fs/ext4/.keep b/test/lisp/pcmpl-linux-resources/fs/ext4/.keep new file mode 100644 index 0000000000..e69de29bb2 diff --git a/test/lisp/pcmpl-linux-resources/mtab b/test/lisp/pcmpl-linux-resources/mtab new file mode 100644 index 0000000000..ea33abd7b0 --- /dev/null +++ b/test/lisp/pcmpl-linux-resources/mtab @@ -0,0 +1,11 @@ +/dev/sdb1 / ext3 rw,relatime,errors=remount-ro 0 0 +proc /proc proc rw,noexec,nosuid,nodev 0 0 +/sys /sys sysfs rw,noexec,nosuid,nodev 0 0 +varrun /var/run tmpfs rw,noexec,nosuid,nodev,mode=0755 0 0 +varlock /var/lock tmpfs rw,noexec,nosuid,nodev,mode=1777 0 0 +udev /dev tmpfs rw,mode=0755 0 0 +devshm /dev/shm tmpfs rw 0 0 +devpts /dev/pts devpts rw,gid=5,mode=620 0 0 +lrm /lib/modules/2.6.24-16-generic/volatile tmpfs rw 0 0 +securityfs /sys/kernel/security securityfs rw 0 0 +gvfs-fuse-daemon /home/alice/.gvfs fuse.gvfs-fuse-daemon rw,nosuid,nodev,user=alice 0 0 diff --git a/test/lisp/pcmpl-linux-tests.el b/test/lisp/pcmpl-linux-tests.el new file mode 100644 index 0000000000..cf7e6288fd --- /dev/null +++ b/test/lisp/pcmpl-linux-tests.el @@ -0,0 +1,51 @@ +;;; pcmpl-linux-tests.el --- Tests for pcmpl-linux.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 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 . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'pcmpl-linux) + +(defvar pcmpl-linux-tests-data-dir + (file-truename + (expand-file-name "pcmpl-linux-resources/" + (file-name-directory (or load-file-name + buffer-file-name)))) + "Base directory of pcmpl-linux-tests.el data files.") + +(ert-deftest pcmpl-linux-test-fs-types () + (let ((pcmpl-linux-fs-modules-path-format (expand-file-name "fs" + pcmpl-linux-tests-data-dir))) + ;; FIXME: Shouldn't return "." and ".." + (should (equal (pcmpl-linux-fs-types) + '("." ".." "ext4"))))) + +(ert-deftest pcmpl-linux-test-mounted-directories () + (let ((pcmpl-linux-mtab-file (expand-file-name "mtab" + pcmpl-linux-tests-data-dir))) + (should (equal (pcmpl-linux-mounted-directories) + '("/" "/dev" "/dev/pts" "/dev/shm" "/home/alice/.gvfs" + "/lib/modules/2.6.24-16-generic/volatile" "/proc" "/sys" + "/sys/kernel/security" "/var/lock" "/var/run"))))) + +(provide 'pcmpl-linux-tests) + +;;; pcmpl-linux-tests.el ends here