emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] master 87bef63 2/2: Merge commit 'd08b75abe0f0cf9ade812b18


From: Stephen Leake
Subject: [Emacs-diffs] master 87bef63 2/2: Merge commit 'd08b75abe0f0cf9ade812b189c374809a2c7836e'
Date: Thu, 13 Dec 2018 17:39:41 -0500 (EST)

branch: master
commit 87bef630bf0f45e8da74e43ba614aa2292b296ef
Merge: 4d3f7b7 d08b75a
Author: Stephen Leake <address@hidden>
Commit: Stephen Leake <address@hidden>

    Merge commit 'd08b75abe0f0cf9ade812b189c374809a2c7836e'
---
 doc/emacs/maintaining.texi             |   9 ++
 doc/misc/tramp.texi                    |   2 +
 etc/NEWS                               |  10 ++
 lisp/dired.el                          |   2 +-
 lisp/emacs-lisp/map.el                 | 208 +++++++++++++++++----------------
 lisp/isearch.el                        |  25 ++--
 lisp/progmodes/flymake.el              |  21 +++-
 lisp/progmodes/ruby-mode.el            |   4 +
 lisp/vc/vc-git.el                      |   7 ++
 lisp/vc/vc.el                          |  63 +++++++---
 src/fileio.c                           |  28 +++++
 src/textprop.c                         |  87 ++++----------
 src/xdisp.c                            |   2 +-
 test/Makefile.in                       |   8 ++
 test/lisp/eshell/em-ls-tests.el        |  14 +++
 test/lisp/net/secrets-tests.el         |   7 --
 test/lisp/progmodes/ruby-mode-tests.el |  90 ++++++++++++++
 test/src/fileio-tests.el               |   4 +
 18 files changed, 381 insertions(+), 210 deletions(-)

diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 4527c23..6a848f9 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -831,6 +831,14 @@ working tree containing the current VC fileset).  If you 
invoke this
 command from a Dired buffer, it applies to the working tree containing
 the directory.
 
address@hidden vc-root-version-diff
address@hidden C-u C-x v D
+  To compare two arbitrary revisions of the whole trees, call
address@hidden with a prefix argument: @kbd{C-u C-x v D}.  This
+prompts for two revision IDs (@pxref{VCS Concepts}), and displays a
+diff between those versions of the entire version-controlled directory
+trees (RCS, SCCS, CVS, and SRC do not support this feature).
+
 @vindex vc-diff-switches
   You can customize the @command{diff} options that @kbd{C-x v =} and
 @kbd{C-x v D} use for generating diffs.  The options used are taken
@@ -963,6 +971,7 @@ and the maximum number of revisions to display.
 Directory Mode}) or a Dired buffer (@pxref{Dired}), it applies to the
 file listed on the current line.
 
address@hidden C-x v L
 @findex vc-print-root-log
 @findex log-view-toggle-entry-display
   @kbd{C-x v L} (@code{vc-print-root-log}) displays a
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 5c54021..a4946f0 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -2741,6 +2741,8 @@ proxy @samp{bird@@bastion} to a remote file on 
@samp{you@@remotehost}:
 
 Each involved method must be an inline method (@pxref{Inline methods}).
 
+Proxies can take patterns @code{%h} or @code{%u}.
+
 @value{tramp} adds the ad-hoc definitions on the fly to
 @code{tramp-default-proxies-alist} and is available for re-use
 during that Emacs session.  Subsequent @value{tramp} connections to
diff --git a/etc/NEWS b/etc/NEWS
index 6ae994d..0624c56 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -304,6 +304,12 @@ the node "(emacs) Directory Variables" of the user manual.
 
 * Changes in Specialized Modes and Packages in Emacs 27.1
 
+** map.el
+*** Now defined via generic functions that can be extended via cl-defmethod.
+*** Deprecate the 'map-put' macro in favor of a new 'map-put!' function.
+*** map-contains-key now returns a boolean rather than the key.
+*** Deprecate the 'testfn' args of 'map-elt' and 'map-contains-key'.
+
 ---
 ** Follow mode
 In the current follow group of windows, "ghost" cursors are no longer
@@ -398,6 +404,10 @@ with conflicts existed in earlier versions of Emacs, but 
incorrectly
 never detected a conflict due to invalid assumptions about cached
 values.
 
++++
+*** 'C-u C-x v D' ('vc-root-version-diff') prompts for two revisions
+and compares their entire trees.
+
 ** Diff mode
 *** Hunks are now automatically refined by default.
 To disable it, set the new defcustom 'diff-font-lock-refine' to nil.
diff --git a/lisp/dired.el b/lisp/dired.el
index e5dc862..72725dc 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1530,7 +1530,7 @@ change; the point does."
               ;; Sanity check of the point marker.
               (when (and (markerp point)
                          (eq (marker-buffer point) buffer))
-                (unless (and (nth 0 prev)
+                (unless (and (nth 1 prev)
                              (dired-goto-file (nth 1 prev)))
                   (goto-char (point-min))
                  (forward-line (1- (nth 2 prev))))
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 987521d..35759db 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -92,17 +92,17 @@ Returns the result of evaluating the form associated with 
MAP-VAR's type."
     `(cond ((listp ,map-var) ,(plist-get args :list))
            ((hash-table-p ,map-var) ,(plist-get args :hash-table))
            ((arrayp ,map-var) ,(plist-get args :array))
-           (t (error "Unsupported map: %s" ,map-var)))))
+           (t (error "Unsupported map type `%S': %S"
+                     (type-of ,map-var) ,map-var)))))
 
-(defun map-elt (map key &optional default testfn)
+(cl-defgeneric map-elt (map key &optional default testfn)
   "Lookup KEY in MAP and return its associated value.
 If KEY is not found, return DEFAULT which defaults to nil.
 
-If MAP is a list, `eql' is used to lookup KEY.  Optional argument
-TESTFN, if non-nil, means use its function definition instead of
-`eql'.
+TESTFN is deprecated.  Its default depends on the MAP argument.
+If MAP is a list, the default is `eql' to lookup KEY.
 
-MAP can be a list, hash-table or array."
+In the base definition, MAP can be an alist, hash-table, or array."
   (declare
    (gv-expander
     (lambda (do)
@@ -118,7 +118,7 @@ MAP can be a list, hash-table or array."
                                     ,default nil ,testfn)
                         do)
              ,(funcall do `(map-elt ,mgetter ,key ,default)
-                       (lambda (v) `(map--put ,mgetter ,key ,v)))))))))
+                       (lambda (v) `(map-put! ,mgetter ,key ,v)))))))))
   (map--dispatch map
     :list (alist-get key map default nil testfn)
     :hash-table (gethash key map default)
@@ -133,9 +133,10 @@ with VALUE.
 When MAP is a list, test equality with TESTFN if non-nil, otherwise use `eql'.
 
 MAP can be a list, hash-table or array."
+  (declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead" 
"27.1"))
   `(setf (map-elt ,map ,key nil ,testfn) ,value))
 
-(defun map-delete (map key)
+(cl-defgeneric map-delete (map key)
   "Delete KEY from MAP and return MAP.
 No error is signaled if KEY is not a key of MAP.  If MAP is an
 array, store nil at the index KEY.
@@ -160,120 +161,121 @@ Map can be a nested map composed of alists, hash-tables 
and arrays."
                   map)
       default))
 
-(defun map-keys (map)
-  "Return the list of keys in MAP.
-
-MAP can be a list, hash-table or array."
+(cl-defgeneric map-keys (map)
+  "Return the list of keys in MAP."
   (map-apply (lambda (key _) key) map))
 
-(defun map-values (map)
-  "Return the list of values in MAP.
-
-MAP can be a list, hash-table or array."
+(cl-defgeneric map-values (map)
+  "Return the list of values in MAP."
   (map-apply (lambda (_ value) value) map))
 
-(defun map-pairs (map)
-  "Return the elements of MAP as key/value association lists.
-
-MAP can be a list, hash-table or array."
+(cl-defgeneric map-pairs (map)
+  "Return the elements of MAP as key/value association lists."
   (map-apply #'cons map))
 
-(defun map-length (map)
-  "Return the length of MAP.
-
-MAP can be a list, hash-table or array."
-  (length (map-keys map)))
+(cl-defgeneric map-length (map)
+  ;; FIXME: Should we rename this to `map-size'?
+  "Return the number of elements in the map."
+  (cond
+   ((hash-table-p map) (hash-table-count map))
+   ((or (listp map) (arrayp map)) (length map))
+   (t (length (map-keys map)))))
 
-(defun map-copy (map)
-  "Return a copy of MAP.
-
-MAP can be a list, hash-table or array."
+(cl-defgeneric map-copy (map)
+  "Return a copy of MAP."
   (map--dispatch map
     :list (seq-copy map)
     :hash-table (copy-hash-table map)
     :array (seq-copy map)))
 
-(defun map-apply (function map)
+(cl-defgeneric map-apply (function map)
   "Apply FUNCTION to each element of MAP and return the result as a list.
 FUNCTION is called with two arguments, the key and the value.
+The default implementation delegates to `map-do'."
+  (let ((res '()))
+    (map-do (lambda (k v) (push (funcall function k v) res)) map)
+    (nreverse res)))
 
-MAP can be a list, hash-table or array."
-  (funcall (map--dispatch map
-             :list #'map--apply-alist
-             :hash-table #'map--apply-hash-table
-             :array #'map--apply-array)
-           function
-           map))
-
-(defun map-do (function map)
+(cl-defgeneric map-do (function map)
   "Apply FUNCTION to each element of MAP and return nil.
-FUNCTION is called with two arguments, the key and the value."
-  (funcall (map--dispatch map
-             :list #'map--do-alist
-             :hash-table #'maphash
-             :array #'map--do-array)
-           function
-           map))
+FUNCTION is called with two arguments, the key and the value.")
 
-(defun map-keys-apply (function map)
-  "Return the result of applying FUNCTION to each key of MAP.
+;; FIXME: I wish there was a way to avoid this η-redex!
+(cl-defmethod map-do (function (map hash-table)) (maphash function map))
 
-MAP can be a list, hash-table or array."
+(cl-defgeneric map-keys-apply (function map)
+  "Return the result of applying FUNCTION to each key of MAP.
+The default implementation delegates to `map-apply'."
   (map-apply (lambda (key _)
                (funcall function key))
              map))
 
-(defun map-values-apply (function map)
+(cl-defgeneric map-values-apply (function map)
   "Return the result of applying FUNCTION to each value of MAP.
-
-MAP can be a list, hash-table or array."
+The default implementation delegates to `map-apply'."
   (map-apply (lambda (_ val)
                (funcall function val))
              map))
 
-(defun map-filter (pred map)
+(cl-defgeneric map-filter (pred map)
   "Return an alist of key/val pairs for which (PRED key val) is non-nil in MAP.
-
-MAP can be a list, hash-table or array."
+The default implementation delegates to `map-apply'."
   (delq nil (map-apply (lambda (key val)
                          (if (funcall pred key val)
                              (cons key val)
                            nil))
                        map)))
 
-(defun map-remove (pred map)
+(cl-defgeneric map-remove (pred map)
   "Return an alist of the key/val pairs for which (PRED key val) is nil in MAP.
-
-MAP can be a list, hash-table or array."
+The default implementation delegates to `map-filter'."
   (map-filter (lambda (key val) (not (funcall pred key val)))
               map))
 
-(defun mapp (map)
-  "Return non-nil if MAP is a map (list, hash-table or array)."
+(cl-defgeneric mapp (map)
+  "Return non-nil if MAP is a map (alist, hash-table, array, ...)."
   (or (listp map)
       (hash-table-p map)
       (arrayp map)))
 
-(defun map-empty-p (map)
+(cl-defgeneric map-empty-p (map)
   "Return non-nil if MAP is empty.
+The default implementation delegates to `map-length'."
+  (zerop (map-length map)))
+
+(cl-defgeneric map-contains-key (map key &optional testfn)
+  ;; FIXME: The test function to use generally depends on the map object,
+  ;; so specifying `testfn' here is problematic: e.g. for hash-tables
+  ;; we shouldn't use `gethash' unless `testfn' is the same as the map's own
+  ;; test function!
+  "Return non-nil If and only if MAP contains KEY.
+TESTFN is deprecated.  Its default depends on MAP.
+The default implementation delegates to `map-do'."
+  (unless testfn (setq testfn #'equal))
+  (catch 'map--catch
+    (map-do (lambda (k _v)
+              (if (funcall testfn key k) (throw 'map--catch t)))
+            map)
+    nil))
 
-MAP can be a list, hash-table or array."
-  (map--dispatch map
-    :list (null map)
-    :array (seq-empty-p map)
-    :hash-table (zerop (hash-table-count map))))
-
-(defun map-contains-key (map key &optional testfn)
-  "If MAP contain KEY return KEY, nil otherwise.
-Equality is defined by TESTFN if non-nil or by `equal' if nil.
+(cl-defmethod map-contains-key ((map list) key &optional testfn)
+  (alist-get key map nil nil (or testfn #'equal)))
 
-MAP can be a list, hash-table or array."
-  (seq-contains (map-keys map) key testfn))
+(cl-defmethod map-contains-key ((map array) key &optional _testfn)
+  (and (integerp key)
+       (>= key 0)
+       (< key (length map))))
 
-(defun map-some (pred map)
-  "Return a non-nil if (PRED key val) is non-nil for any key/value pair in MAP.
+(cl-defmethod map-contains-key ((map hash-table) key &optional _testfn)
+  (let ((v '(nil)))
+    (not (eq v (gethash key map v)))))
 
-MAP can be a list, hash-table or array."
+(cl-defgeneric map-some (pred map)
+  "Return the first non-nil (PRED key val) in MAP.
+The default implementation delegates to `map-apply'."
+  ;; FIXME: Not sure if there's much benefit to defining it as defgeneric,
+  ;; since as defined, I can't think of a map-type where we could provide an
+  ;; algorithmically more efficient algorithm than the default.
   (catch 'map--break
     (map-apply (lambda (key value)
                  (let ((result (funcall pred key value)))
@@ -282,10 +284,12 @@ MAP can be a list, hash-table or array."
                map)
     nil))
 
-(defun map-every-p (pred map)
+(cl-defgeneric map-every-p (pred map)
   "Return non-nil if (PRED key val) is non-nil for all elements of the map MAP.
-
-MAP can be a list, hash-table or array."
+The default implementation delegates to `map-apply'."
+  ;; FIXME: Not sure if there's much benefit to defining it as defgeneric,
+  ;; since as defined, I can't think of a map-type where we could provide an
+  ;; algorithmically more efficient algorithm than the default.
   (catch 'map--break
     (map-apply (lambda (key value)
               (or (funcall pred key value)
@@ -294,9 +298,7 @@ MAP can be a list, hash-table or array."
     t))
 
 (defun map-merge (type &rest maps)
-  "Merge into a map of type TYPE all the key/value pairs in MAPS.
-
-MAP can be a list, hash-table or array."
+  "Merge into a map of type TYPE all the key/value pairs in MAPS."
   (let ((result (map-into (pop maps) type)))
     (while maps
       ;; FIXME: When `type' is `list', we get an O(N^2) behavior.
@@ -310,7 +312,7 @@ MAP can be a list, hash-table or array."
 
 (defun map-merge-with (type function &rest maps)
   "Merge into a map of type TYPE all the key/value pairs in MAPS.
-When two maps contain the same key, call FUNCTION on the two
+When two maps contain the same key (`eql'), call FUNCTION on the two
 values and use the value returned by it.
 MAP can be a list, hash-table or array."
   (let ((result (map-into (pop maps) type))
@@ -318,24 +320,22 @@ MAP can be a list, hash-table or array."
     (while maps
       (map-apply (lambda (key value)
                    (cl-callf (lambda (old)
-                               (if (eq old not-found)
+                               (if (eql old not-found)
                                    value
                                  (funcall function old value)))
                        (map-elt result key not-found)))
                  (pop maps)))
     result))
 
-(defun map-into (map type)
-  "Convert the map MAP into a map of type TYPE.
+(cl-defgeneric map-into (map type)
+  "Convert the map MAP into a map of type TYPE.")
+;; FIXME: I wish there was a way to avoid this η-redex!
+(cl-defmethod map-into (map (_type (eql list))) (map-pairs map))
 
-TYPE can be one of the following symbols: list or hash-table.
-MAP can be a list, hash-table or array."
-  (pcase type
-    ('list (map-pairs map))
-    ('hash-table (map--into-hash-table map))
-    (_ (error "Not a map type name: %S" type))))
-
-(defun map--put (map key v)
+(cl-defgeneric map-put! (map key v)
+  "Associate KEY with VALUE in MAP and return VALUE.
+If KEY is already present in MAP, replace the associated value
+with VALUE."
   (map--dispatch map
     :list (let ((p (assoc key map)))
             (if p (setcdr p v)
@@ -343,24 +343,26 @@ MAP can be a list, hash-table or array."
     :hash-table (puthash key v map)
     :array (aset map key v)))
 
-(defun map--apply-alist (function map)
-  "Private function used to apply FUNCTION over MAP, MAP being an alist."
+;; There shouldn't be old source code referring to `map--put', yet we do
+;; need to keep it for backward compatibility with .elc files where the
+;; expansion of `setf' may call this function.
+(define-obsolete-function-alias 'map--put #'map-put! "27.1")
+
+(cl-defmethod map-apply (function (map list))
   (seq-map (lambda (pair)
              (funcall function
                       (car pair)
                       (cdr pair)))
            map))
 
-(defun map--apply-hash-table (function map)
-  "Private function used to apply FUNCTION over MAP, MAP being a hash-table."
+(cl-defmethod map-apply (function (map hash-table))
   (let (result)
     (maphash (lambda (key value)
                (push (funcall function key value) result))
              map)
     (nreverse result)))
 
-(defun map--apply-array (function map)
-  "Private function used to apply FUNCTION over MAP, MAP being an array."
+(cl-defmethod map-apply (function (map array))
   (let ((index 0))
     (seq-map (lambda (elt)
                (prog1
@@ -368,7 +370,7 @@ MAP can be a list, hash-table or array."
                  (setq index (1+ index))))
              map)))
 
-(defun map--do-alist (function alist)
+(cl-defmethod map-do (function (alist list))
   "Private function used to iterate over ALIST using FUNCTION."
   (seq-do (lambda (pair)
             (funcall function
@@ -376,14 +378,16 @@ MAP can be a list, hash-table or array."
                      (cdr pair)))
           alist))
 
-(defun map--do-array (function array)
+(cl-defmethod map-do (function (array array))
   "Private function used to iterate over ARRAY using FUNCTION."
   (seq-do-indexed (lambda (elt index)
                      (funcall function index elt))
                    array))
 
-(defun map--into-hash-table (map)
+(cl-defmethod map-into (map (_type (eql hash-table)))
   "Convert MAP into a hash-table."
+  ;; FIXME: Just knowing we want a hash-table is insufficient, since that
+  ;; doesn't tell us the test function to use with it!
   (let ((ht (make-hash-table :size (map-length map)
                              :test 'equal)))
     (map-apply (lambda (key value)
diff --git a/lisp/isearch.el b/lisp/isearch.el
index dcd119a..dd0973d 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -2811,10 +2811,10 @@ the bottom."
 If `shift', extend the search string by motion commands while holding down
 the shift key.  The search string is extended by yanking text that
 ends at the new position after moving point in the current buffer.
-If t, extend the search string without the shift key pressed
-by motion commands that have the `isearch-move' property on their
-symbols equal to `enabled', or for which the shift-translated command
-is not disabled by the value `disabled' of property `isearch-move'."
+If t, extend the search string without the shift key pressed.
+To enable motion commands, put the `isearch-move' property on their
+symbols to `enabled', or to disable an automatically detected
+shift-translated command, use the property value `disabled'."
   :type '(choice (const :tag "Motion keys exit Isearch" nil)
                  (const :tag "Motion keys extend the search string" t)
                  (const :tag "Shifted motion keys extend the search string" 
shift))
@@ -2864,14 +2864,15 @@ See more for options in `search-exit-option'."
       (read-event)
       (setq this-command 'isearch-edit-string))
      ;; Don't terminate the search for motion commands.
-     ((or (and (eq isearch-yank-on-move t)
-               (symbolp this-command)
-               (or (eq (get this-command 'isearch-move) 'enabled)
-                   (and (not (eq (get this-command 'isearch-move) 'disabled))
-                        (stringp (nth 1 (interactive-form this-command)))
-                        (string-match-p "^^" (nth 1 (interactive-form 
this-command))))))
-          (and (eq isearch-yank-on-move 'shift)
-               this-command-keys-shift-translated))
+     ((and isearch-yank-on-move
+           (symbolp this-command)
+           (not (eq (get this-command 'isearch-move) 'disabled))
+           (or (eq (get this-command 'isearch-move) 'enabled)
+               (and (eq isearch-yank-on-move t)
+                    (stringp (nth 1 (interactive-form this-command)))
+                    (string-match-p "^^" (nth 1 (interactive-form 
this-command))))
+               (and (eq isearch-yank-on-move 'shift)
+                    this-command-keys-shift-translated)))
       (setq this-command-keys-shift-translated nil)
       (setq isearch-pre-move-point (point)))
      ;; Append control characters to the search string
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index ad8f50c..7b100da 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -4,7 +4,7 @@
 
 ;; Author:  Pavel Kobyakov <address@hidden>
 ;; Maintainer: João Távora <address@hidden>
-;; Version: 1.0.2
+;; Version: 1.0.3
 ;; Package-Requires: ((emacs "26.1"))
 ;; Keywords: c languages tools
 
@@ -293,7 +293,7 @@ generated it."
 
 (cl-defstruct (flymake--diag
                (:constructor flymake--diag-make))
-  buffer beg end type text backend data overlay)
+  buffer beg end type text backend data overlay-properties overlay)
 
 ;;;###autoload
 (defun flymake-make-diagnostic (buffer
@@ -301,13 +301,20 @@ generated it."
                                 end
                                 type
                                 text
-                                &optional data)
+                                &optional data
+                                overlay-properties)
   "Make a Flymake diagnostic for BUFFER's region from BEG to END.
 TYPE is a key to symbol and TEXT is a description of the problem
 detected in this region.  DATA is any object that the caller
-wishes to attach to the created diagnostic for later retrieval."
+wishes to attach to the created diagnostic for later retrieval.
+
+OVERLAY-PROPERTIES is an an alist of properties attached to the
+created diagnostic, overriding the default properties and any
+properties of `flymake-overlay-control' of the diagnostic's
+type."
   (flymake--diag-make :buffer buffer :beg beg :end end
-                      :type type :text text :data data))
+                      :type type :text text :data data
+                      :overlay-properties overlay-properties))
 
 ;;;###autoload
 (defun flymake-diagnostics (&optional beg end)
@@ -600,7 +607,9 @@ associated `flymake-category' return DEFAULT."
     ;; properties.
     (cl-loop
      for (ov-prop . value) in
-     (append (reverse ; ensure ealier props override later ones
+     (append (reverse
+              (flymake--diag-overlay-properties diagnostic))
+             (reverse ; ensure ealier props override later ones
               (flymake--lookup-type-property type 'flymake-overlay-control))
              (alist-get type flymake-diagnostic-types-alist))
      do (overlay-put ov ov-prop value))
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 2f68f00..d60899c 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -517,6 +517,9 @@ It is used when `ruby-encoding-magic-comment-style' is set 
to `custom'."
              ((ruby-smie--opening-pipe-p) "opening-|")
              ((ruby-smie--closing-pipe-p) "closing-|")
              (t tok)))
+           ((string-match "\\`[^|]+|\\'" tok)
+            (forward-char -1)
+            (substring tok 0 -1))
            ((and (equal tok "") (looking-at "\\\\\n"))
             (goto-char (match-end 0)) (ruby-smie--forward-token))
            ((equal tok "do")
@@ -559,6 +562,7 @@ It is used when `ruby-encoding-magic-comment-style' is set 
to `custom'."
            ((ruby-smie--opening-pipe-p) "opening-|")
            ((ruby-smie--closing-pipe-p) "closing-|")
            (t tok)))
+         ((string-match-p "\\`[^|]+|\\'" tok) "closing-|")
          ((string-match-p "\\`|[*&]\\'" tok)
           (forward-char 1)
           (substring tok 1))
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index f317400..aa6809f 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -757,6 +757,11 @@ the commit message."
   (interactive)
   (log-edit-toggle-header "Sign-Off" "yes"))
 
+(defun vc-git-log-edit-toggle-no-verify ()
+  "Toggle whether to bypass the pre-commit and commit-msg hooks."
+  (interactive)
+  (log-edit-toggle-header "No-Verify" "yes"))
+
 (defun vc-git-log-edit-toggle-amend ()
   "Toggle whether this will amend the previous commit.
 If toggling on, also insert its message into the buffer."
@@ -782,6 +787,7 @@ If toggling on, also insert its message into the buffer."
 (defvar vc-git-log-edit-mode-map
   (let ((map (make-sparse-keymap "Git-Log-Edit")))
     (define-key map "\C-c\C-s" 'vc-git-log-edit-toggle-signoff)
+    (define-key map "\C-c\C-n" 'vc-git-log-edit-toggle-no-verify)
     (define-key map "\C-c\C-e" 'vc-git-log-edit-toggle-amend)
     map))
 
@@ -825,6 +831,7 @@ It is based on `log-edit-mode', and has Git-specific 
extensions.")
                             `(("Author" . "--author")
                               ("Date" . "--date")
                               ("Amend" . ,(boolean-arg-fn "--amend"))
+                              ("No-Verify" . ,(boolean-arg-fn "--no-verify"))
                               ("Sign-Off" . ,(boolean-arg-fn "--signoff")))
                             comment)))
                       (when msg-file
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index dbbc3e2..48b7c98 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1817,7 +1817,7 @@ Return t if the buffer had changes, nil otherwise."
 
 ;;;###autoload
 (defun vc-version-diff (_files rev1 rev2)
-  "Report diffs between revisions of the fileset in the repository history."
+  "Report diffs between REV1 and REV2 revisions of the fileset."
   (interactive (vc-diff-build-argument-list-internal))
   ;; All that was just so we could do argument completion!
   (when (and (not rev1) rev2)
@@ -1828,6 +1828,28 @@ Return t if the buffer had changes, nil otherwise."
                    (called-interactively-p 'interactive)))
 
 ;;;###autoload
+(defun vc-root-version-diff (_files rev1 rev2)
+  "Report diffs between REV1 and REV2 revisions of the whole tree."
+  (interactive (vc-diff-build-argument-list-internal))
+  ;; This is a mix of `vc-root-diff' and `vc-version-diff'
+  (when (and (not rev1) rev2)
+    (error "Not a valid revision range"))
+  (let ((backend (vc-deduce-backend))
+        (default-directory default-directory)
+        rootdir)
+    (if backend
+        (setq rootdir (vc-call-backend backend 'root default-directory))
+      (setq rootdir (read-directory-name "Directory for VC root-diff: "))
+      (setq backend (vc-responsible-backend rootdir))
+      (if backend
+          (setq default-directory rootdir)
+        (error "Directory is not version controlled")))
+    (let ((default-directory rootdir))
+      (vc-diff-internal
+       t (list backend (list rootdir)) rev1 rev2
+       (called-interactively-p 'interactive)))))
+
+;;;###autoload
 (defun vc-diff (&optional historic not-urgent)
   "Display diffs between file revisions.
 Normally this compares the currently selected fileset with their
@@ -1900,10 +1922,8 @@ The optional argument NOT-URGENT non-nil means it is ok 
to say no to
 saving the buffer."
   (interactive (list current-prefix-arg t))
   (if historic
-      ;; FIXME: this does not work right, `vc-version-diff' ends up
-      ;; calling `vc-deduce-fileset' to find the files to diff, and
-      ;; that's not what we want here, we want the diff for the VC root dir.
-      (call-interactively 'vc-version-diff)
+      ;; We want the diff for the VC root dir.
+      (call-interactively 'vc-root-version-diff)
     (when buffer-file-name (vc-buffer-sync not-urgent))
     (let ((backend (vc-deduce-backend))
          (default-directory default-directory)
@@ -2013,20 +2033,25 @@ Unlike `vc-find-revision-save', doesn't save the buffer 
to the file."
       (with-current-buffer filebuf
        (let ((failed t))
          (unwind-protect
-             (let ((coding-system-for-read 'no-conversion)
-                    (coding-system-for-write 'no-conversion))
-               (with-current-buffer (or buffer (create-file-buffer filename))
-                  (unless buffer (setq buffer-file-name filename))
-                 (let ((outbuf (current-buffer)))
-                   (with-current-buffer filebuf
-                     (if backend
-                         (vc-call-backend backend 'find-revision file revision 
outbuf)
-                       (vc-call find-revision file revision outbuf))))
-                  (goto-char (point-min))
-                  (if buffer (let ((buffer-file-name file)) (normal-mode)) 
(normal-mode))
-                 (set-buffer-modified-p nil)
-                  (setq buffer-read-only t))
-               (setq failed nil))
+             (with-current-buffer (or buffer (create-file-buffer filename))
+                (unless buffer (setq buffer-file-name filename))
+               (let ((outbuf (current-buffer)))
+                 (with-current-buffer filebuf
+                   (if backend
+                       (vc-call-backend backend 'find-revision file revision 
outbuf)
+                     (vc-call find-revision file revision outbuf))))
+                (decode-coding-inserted-region (point-min) (point-max) file)
+                (after-insert-file-set-coding (- (point-max) (point-min)))
+                (goto-char (point-min))
+                (if buffer
+                    ;; For non-interactive, skip any questions
+                    (let ((enable-local-variables :safe) ;; to find `mode:'
+                          (buffer-file-name file))
+                      (ignore-errors (set-auto-mode)))
+                  (normal-mode))
+               (set-buffer-modified-p nil)
+                (setq buffer-read-only t))
+               (setq failed nil)
            (when (and failed (unless buffer (get-file-buffer filename)))
              (with-current-buffer (get-file-buffer filename)
                (set-buffer-modified-p nil))
diff --git a/src/fileio.c b/src/fileio.c
index d979571..687f6ec 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -1692,6 +1692,34 @@ get_homedir (void)
       if (!home)
        return "";
     }
+#ifdef DOS_NT
+  /* If home is a drive-relative directory, expand it.  */
+  if (IS_DRIVE (*home)
+      && IS_DEVICE_SEP (home[1])
+      && !IS_DIRECTORY_SEP (home[2]))
+    {
+# ifdef WINDOWSNT
+      static char hdir[MAX_UTF8_PATH];
+# else
+      static char hdir[MAXPATHLEN];
+# endif
+      if (!getdefdir (c_toupper (*home) - 'A' + 1, hdir))
+       {
+         hdir[0] = c_toupper (*home);
+         hdir[1] = ':';
+         hdir[2] = '/';
+         hdir[3] = '\0';
+       }
+      if (home[2])
+       {
+         size_t homelen = strlen (hdir);
+         if (!IS_DIRECTORY_SEP (hdir[homelen - 1]))
+           strcat (hdir, "/");
+         strcat (hdir, home + 2);
+       }
+      home = hdir;
+    }
+#endif
   if (IS_ABSOLUTE_FILE_NAME (home))
     return home;
   if (!emacs_wd)
diff --git a/src/textprop.c b/src/textprop.c
index 8e8baf4..8a06f0f 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -111,9 +111,6 @@ CHECK_STRING_OR_BUFFER (Lisp_Object x)
    to by BEGIN and END may be integers or markers; if the latter, they
    are coerced to integers.
 
-   When OBJECT is a string, we increment *BEGIN and *END
-   to make them origin-one.
-
    Note that buffer points don't correspond to interval indices.
    For example, point-max is 1 greater than the index of the last
    character.  This difference is handled in the caller, which uses
@@ -175,9 +172,6 @@ validate_interval_range (Lisp_Object object, Lisp_Object 
*begin,
       if (! (0 <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end)
             && XFIXNUM (*end) <= len))
        args_out_of_range (*begin, *end);
-      XSETFASTINT (*begin, XFIXNAT (*begin));
-      if (begin != end)
-       XSETFASTINT (*end, XFIXNAT (*end));
       i = string_intervals (object);
 
       if (len == 0)
@@ -1348,13 +1342,9 @@ Lisp_Object
 set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object 
properties,
                     Lisp_Object object, Lisp_Object coherent_change_p)
 {
-  register INTERVAL i;
-  Lisp_Object ostart, oend;
+  INTERVAL i;
   bool first_time = true;
 
-  ostart = start;
-  oend = end;
-
   properties = validate_plist (properties);
 
   if (NILP (object))
@@ -1382,11 +1372,6 @@ set_text_properties (Lisp_Object start, Lisp_Object end, 
Lisp_Object properties,
       if (NILP (properties))
        return Qnil;
 
-      /* Restore the original START and END values
-        because validate_interval_range increments them for strings.  */
-      start = ostart;
-      end = oend;
-
       i = validate_interval_range (object, &start, &end, hard);
       /* This can return if start == end.  */
       if (!i)
@@ -1421,34 +1406,25 @@ set_text_properties (Lisp_Object start, Lisp_Object 
end, Lisp_Object properties,
 /* Replace properties of text from START to END with new list of
    properties PROPERTIES.  OBJECT is the buffer or string containing
    the text.  This does not obey any hooks.
-   You should provide the interval that START is located in as I.
-   START and END can be in any order.  */
+   I is the interval that START is located in.  */
 
 void
-set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object 
properties, Lisp_Object object, INTERVAL i)
+set_text_properties_1 (Lisp_Object start, Lisp_Object end,
+                      Lisp_Object properties, Lisp_Object object, INTERVAL i)
 {
-  register INTERVAL prev_changed = NULL;
-  register ptrdiff_t s, len;
-  INTERVAL unchanged;
+  INTERVAL prev_changed = NULL;
+  ptrdiff_t s = XFIXNUM (start);
+  ptrdiff_t len = XFIXNUM (end) - s;
 
-  if (XFIXNUM (start) < XFIXNUM (end))
-    {
-      s = XFIXNUM (start);
-      len = XFIXNUM (end) - s;
-    }
-  else if (XFIXNUM (end) < XFIXNUM (start))
-    {
-      s = XFIXNUM (end);
-      len = XFIXNUM (start) - s;
-    }
-  else
+  if (len == 0)
     return;
+  eassert (0 < len);
 
   eassert (i);
 
   if (i->position != s)
     {
-      unchanged = i;
+      INTERVAL unchanged = i;
       i = split_interval_right (unchanged, s - unchanged->position);
 
       if (LENGTH (i) > len)
@@ -1896,45 +1872,30 @@ Lisp_Object
 copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src,
                      Lisp_Object pos, Lisp_Object dest, Lisp_Object prop)
 {
-  INTERVAL i;
-  Lisp_Object res;
-  Lisp_Object stuff;
-  Lisp_Object plist;
-  ptrdiff_t s, e, e2, p, len;
-  bool modified = false;
-
-  i = validate_interval_range (src, &start, &end, soft);
+  INTERVAL i = validate_interval_range (src, &start, &end, soft);
   if (!i)
     return Qnil;
 
   CHECK_FIXNUM_COERCE_MARKER (pos);
-  {
-    Lisp_Object dest_start, dest_end;
-
-    e = XFIXNUM (pos) + (XFIXNUM (end) - XFIXNUM (start));
-    if (MOST_POSITIVE_FIXNUM < e)
-      args_out_of_range (pos, end);
-    dest_start = pos;
-    XSETFASTINT (dest_end, e);
-    /* Apply this to a copy of pos; it will try to increment its arguments,
-       which we don't want.  */
-    validate_interval_range (dest, &dest_start, &dest_end, soft);
-  }
 
-  s = XFIXNUM (start);
-  e = XFIXNUM (end);
-  p = XFIXNUM (pos);
+  EMACS_INT dest_e = XFIXNUM (pos) + (XFIXNUM (end) - XFIXNUM (start));
+  if (MOST_POSITIVE_FIXNUM < dest_e)
+    args_out_of_range (pos, end);
+  Lisp_Object dest_end = make_fixnum (dest_e);
+  validate_interval_range (dest, &pos, &dest_end, soft);
+
+  ptrdiff_t s = XFIXNUM (start), e = XFIXNUM (end), p = XFIXNUM (pos);
 
-  stuff = Qnil;
+  Lisp_Object stuff = Qnil;
 
   while (s < e)
     {
-      e2 = i->position + LENGTH (i);
+      ptrdiff_t e2 = i->position + LENGTH (i);
       if (e2 > e)
        e2 = e;
-      len = e2 - s;
+      ptrdiff_t len = e2 - s;
 
-      plist = i->plist;
+      Lisp_Object plist = i->plist;
       if (! NILP (prop))
        while (! NILP (plist))
          {
@@ -1959,9 +1920,11 @@ copy_text_properties (Lisp_Object start, Lisp_Object 
end, Lisp_Object src,
       s = i->position;
     }
 
+  bool modified = false;
+
   while (! NILP (stuff))
     {
-      res = Fcar (stuff);
+      Lisp_Object res = Fcar (stuff);
       res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
                                  Fcar (Fcdr (Fcdr (res))), dest);
       if (! NILP (res))
diff --git a/src/xdisp.c b/src/xdisp.c
index 4d9990c..cb21397 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -23041,7 +23041,7 @@ Emacs UBA implementation, in particular with the test 
suite.  */)
     }
   else
     {
-      CHECK_FIXNUM_COERCE_MARKER (vpos);
+      CHECK_FIXNUM (vpos);
       nrow = XFIXNUM (vpos);
     }
 
diff --git a/test/Makefile.in b/test/Makefile.in
index adb316c..4548323 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -190,6 +190,12 @@ else
 maybe_exclude_module_tests := -name emacs-module-tests.el -prune -o
 endif
 
+## Optional list of .el files to exclude from testing.
+## Intended for use in automated testing where one or more files
+## has some problem and needs to be excluded.
+## To avoid writing full name, can use eg %foo-tests.el.
+EXCLUDE_TESTS =
+
 ## To speed up parallel builds, put these slow test files (which can
 ## take longer than all the rest combined) at the start of the list.
 SLOW_TESTS = ${srcdir}/lisp/net/tramp-tests.el
@@ -202,6 +208,8 @@ ELFILES := $(sort $(shell find ${srcdir} -path 
"${srcdir}/manual" -prune -o \
 
 $(foreach slow,${SLOW_TESTS},$(eval ELFILES:= ${slow} $(filter-out 
${slow},${ELFILES})))
 
+$(foreach exclude,${EXCLUDE_TESTS},$(eval ELFILES:= $(filter-out 
${exclude},${ELFILES})))
+
 ## .log files may be in a different directory for out of source builds
 LOGFILES := $(patsubst %.el,%.log, \
                $(patsubst $(srcdir)/%,%,$(ELFILES)))
diff --git a/test/lisp/eshell/em-ls-tests.el b/test/lisp/eshell/em-ls-tests.el
index c5c9eac..b89a546 100644
--- a/test/lisp/eshell/em-ls-tests.el
+++ b/test/lisp/eshell/em-ls-tests.el
@@ -78,6 +78,11 @@
 
 (ert-deftest em-ls-test-bug27844 ()
   "Test for https://debbugs.gnu.org/27844 ."
+  ;; FIXME: it would be better to use something other than source-directory
+  ;; in this test.
+  (skip-unless (and source-directory
+                    (file-exists-p
+                     (expand-file-name "lisp/subr.el" source-directory))))
   (let ((orig eshell-ls-use-in-dired)
         (dired-use-ls-dired 'unspecified)
         buf insert-directory-program)
@@ -89,6 +94,15 @@
           (should (cdr (dired-get-marked-files)))
           (kill-buffer buf)
           (setq buf (dired (expand-file-name "lisp/subr.el" source-directory)))
+          (when (getenv "EMACS_HYDRA_CI")
+            (message "X1%s" (buffer-substring-no-properties
+                             (point-min) (point-max)))
+            (message "X2%s" (buffer-substring-no-properties
+                             (line-beginning-position)
+                             (line-end-position)))
+            (message "X3%s" (buffer-substring-no-properties
+                             (point)
+                             (line-end-position))))
           (should (looking-at "subr\\.el")))
       (customize-set-variable 'eshell-ls-use-in-dired orig)
       (and (buffer-live-p buf) (kill-buffer)))))
diff --git a/test/lisp/net/secrets-tests.el b/test/lisp/net/secrets-tests.el
index de3ce73..d34b002 100644
--- a/test/lisp/net/secrets-tests.el
+++ b/test/lisp/net/secrets-tests.el
@@ -90,10 +90,6 @@
   (unwind-protect
       (progn
        (should (secrets-open-session))
-
-       ;; There must be at least the collections "Login" and "session".
-       (should (or (member "Login" (secrets-list-collections))
-                    (member "login" (secrets-list-collections))))
        (should (member "session" (secrets-list-collections)))
 
        ;; Create a random collection.  This asks for a password
@@ -160,9 +156,6 @@
 
        ;; There shall be no items in the "session" collection.
        (should-not (secrets-list-items "session"))
-       ;; There shall be items in the "Login" collection.
-       (should (or (secrets-list-items "Login")
-                    (secrets-list-items "login")))
 
        ;; Create a new item.
        (should (setq item-path (secrets-create-item "session" "foo" "secret")))
diff --git a/test/lisp/progmodes/ruby-mode-tests.el 
b/test/lisp/progmodes/ruby-mode-tests.el
index 72d83af..afd6d65 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -718,6 +718,96 @@ VALUES-PLIST is a list with alternating index and value 
elements."
     (ruby-backward-sexp)
     (should (= 2 (line-number-at-pos)))))
 
+(ert-deftest ruby-forward-sexp-jumps-do-end-block-with-no-args ()
+  (ruby-with-temp-buffer
+    (ruby-test-string
+     "proc do
+     |end")
+    (search-backward "do\n")
+    (ruby-forward-sexp)
+    (should (eobp))))
+
+(ert-deftest ruby-backward-sexp-jumps-do-end-block-with-no-args ()
+  (ruby-with-temp-buffer
+    (ruby-test-string
+     "proc do
+     |end")
+    (goto-char (point-max))
+    (ruby-backward-sexp)
+    (should (looking-at "do$"))))
+
+(ert-deftest ruby-forward-sexp-jumps-do-end-block-with-empty-args ()
+  (ruby-with-temp-buffer
+    (ruby-test-string
+     "proc do ||
+     |end")
+    (search-backward "do ")
+    (ruby-forward-sexp)
+    (should (eobp))))
+
+(ert-deftest ruby-backward-sexp-jumps-do-end-block-with-empty-args ()
+  (ruby-with-temp-buffer
+    (ruby-test-string
+     "proc do ||
+     |end")
+    (goto-char (point-max))
+    (ruby-backward-sexp)
+    (should (looking-at "do "))))
+
+(ert-deftest ruby-forward-sexp-jumps-do-end-block-with-args ()
+  (ruby-with-temp-buffer
+    (ruby-test-string
+     "proc do |a,b|
+     |end")
+    (search-backward "do ")
+    (ruby-forward-sexp)
+    (should (eobp))))
+
+(ert-deftest ruby-backward-sexp-jumps-do-end-block-with-args ()
+  (ruby-with-temp-buffer
+    (ruby-test-string
+     "proc do |a,b|
+     |end")
+    (goto-char (point-max))
+    (ruby-backward-sexp)
+    (should (looking-at "do "))))
+
+(ert-deftest ruby-forward-sexp-jumps-do-end-block-with-any-args ()
+  (ruby-with-temp-buffer
+    (ruby-test-string
+     "proc do |*|
+     |end")
+    (search-backward "do ")
+    (ruby-forward-sexp)
+    (should (eobp))))
+
+(ert-deftest ruby-forward-sexp-jumps-do-end-block-with-expanded-one-arg ()
+  (ruby-with-temp-buffer
+    (ruby-test-string
+     "proc do |a,|
+     |end")
+    (search-backward "do ")
+    (ruby-forward-sexp)
+    (should (eobp))))
+
+(ert-deftest ruby-forward-sexp-jumps-do-end-block-with-one-and-any-args ()
+  (ruby-with-temp-buffer
+    (ruby-test-string
+     "proc do |a,*|
+     |end")
+    (search-backward "do ")
+    (ruby-forward-sexp)
+    (should (eobp))))
+
+(ert-deftest ruby-backward-sexp-jumps-do-end-block-with-one-and-any-args ()
+  (ruby-with-temp-buffer
+    (ruby-test-string
+     "proc do |a,*|
+     |end")
+    (goto-char (point-max))
+    (ruby-backward-sexp)
+    (should (looking-at "do "))))
+
 (ert-deftest ruby-toggle-string-quotes-quotes-correctly ()
   (let ((pairs
          '(("puts '\"foo\"\\''" . "puts \"\\\"foo\\\"'\"")
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
index b7b78bb..a74bcea 100644
--- a/test/src/fileio-tests.el
+++ b/test/src/fileio-tests.el
@@ -102,4 +102,8 @@ Also check that an encoding error can appear in a symlink."
     (setenv "HOME" "a/b/c")
     (should (equal (expand-file-name "~/foo")
                    (expand-file-name "a/b/c/foo")))
+    (when (memq system-type '(ms-dos windows-nt))
+      ;; Test expansion of drive-relative file names.
+      (setenv "HOME" "x:foo")
+      (should (equal (expand-file-name "~/bar") "x:/foo/bar")))
     (setenv "HOME" old-home)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]