[Emacs-diffs] master c676444: Add conditional operator xor to subr.el

[Mattias Engdegård]

branch: master
commit c676444a43e4634c1f98ec286b5bd9e46b23216b
Author: Mattias Engdegård <address@hidden>
Commit: Mattias Engdegård <address@hidden>

    Add conditional operator xor to subr.el
    
    Suggested by Oleh Krehel and implemented by Basil Contovounesios in
    the following thread:
    https://lists.gnu.org/archive/html/emacs-devel/2019-07/msg00547.html
    
    * lisp/array.el (xor): Move unused function from here...
    * lisp/subr.el: ...to here, and improve.
    * lisp/gnus/spam.el (spam-xor):
    * lisp/play/5x5.el (5x5-xor):
    * lisp/proced.el (proced-xor):
    * lisp/progmodes/idlwave.el (idlwave-xor):
    * lisp/vc/diff-mode.el (diff-xor): Define as obsolete aliases of,
    and replace all uses with, xor.
    * lisp/jsonrpc.el: Remove unused dependency on array.el.
    * lisp/org/org.el (org-xor): Move from here...
    * lisp/org/org-compat.el (org-xor): ...to here, as a compatibility
    shim for xor.
    * lisp/progmodes/idlw-shell.el (idlwave-shell-enable-all-bp):
    * lisp/simple.el (exchange-point-and-mark):
    * lisp/windmove.el (windmove-display-in-direction): Use xor.
    * lisp/strokes.el (strokes-xor): Remove commented-out xor
    implementation.
    
    * doc/lispref/control.texi (Control Structures): Extend menu entry
    for new combining condition.
    (Combining Conditions):
    * etc/NEWS (Lisp Changes): Document xor.
    
    * test/lisp/subr-tests.el (subr-test-xor): New test.
---
 doc/lispref/control.texi     | 15 ++++++++++++---
 etc/NEWS                     |  7 +++++++
 lisp/array.el                |  5 -----
 lisp/gnus/spam.el            |  6 ++----
 lisp/jsonrpc.el              |  1 -
 lisp/org/org-compat.el       |  8 ++++++++
 lisp/org/org.el              |  4 ----
 lisp/play/5x5.el             |  8 +++-----
 lisp/proced.el               | 11 ++++-------
 lisp/progmodes/idlw-shell.el |  2 +-
 lisp/progmodes/idlwave.el    | 25 ++++++++++++-------------
 lisp/simple.el               |  3 +--
 lisp/strokes.el              |  6 ------
 lisp/subr.el                 |  8 ++++++++
 lisp/vc/diff-mode.el         | 12 ++++++------
 lisp/windmove.el             |  2 +-
 test/lisp/subr-tests.el      |  7 +++++++
 17 files changed, 72 insertions(+), 58 deletions(-)

diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index e98daf6..31948fa 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -38,7 +38,7 @@ structure constructs (@pxref{Macros}).
 @menu
 * Sequencing::             Evaluation in textual order.
 * Conditionals::           @code{if}, @code{cond}, @code{when}, @code{unless}.
-* Combining Conditions::   @code{and}, @code{or}, @code{not}.
+* Combining Conditions::   @code{and}, @code{or}, @code{not}, and friends.
 * Pattern-Matching Conditional::  How to use @code{pcase} and friends.
 * Iteration::              @code{while} loops.
 * Generators::             Generic sequences and coroutines.
@@ -298,8 +298,8 @@ For example:
 @section Constructs for Combining Conditions
 @cindex combining conditions
 
-  This section describes three constructs that are often used together
-with @code{if} and @code{cond} to express complicated conditions.  The
+  This section describes constructs that are often used together with
+@code{if} and @code{cond} to express complicated conditions.  The
 constructs @code{and} and @code{or} can also be used individually as
 kinds of multiple conditional constructs.
 
@@ -419,6 +419,15 @@ This is not completely equivalent because it can evaluate 
@var{arg1} or
 @var{arg3})} never evaluates any argument more than once.
 @end defspec
 
+@defun xor condition1 condition2
+This function returns the boolean exclusive-or of @var{condition1} and
+@var{condition2}.  That is, @code{xor} returns @code{nil} if either
+both arguments are @code{nil}, or both are non-@code{nil}.  Otherwise,
+it returns the value of that argument which is non-@code{nil}.
+
+Note that in contrast to @code{or}, both arguments are always evaluated.
+@end defun
+
 @node Pattern-Matching Conditional
 @section Pattern-Matching Conditional
 @cindex pcase
diff --git a/etc/NEWS b/etc/NEWS
index a078bce..818875f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2512,6 +2512,13 @@ parameter to control descending into subdirectories, and 
a
 FOLLOW-SYMLINK parameter to say that symbolic links that point to
 other directories should be followed.
 
++++
+** New function 'xor' returns the boolean exclusive-or of its args.
+The function was previously defined in array.el, but has been moved to
+subr.el so that it is available by default.  It now always returns the
+non-nil argument when the other is nil.  Several duplicates of 'xor'
+in other packages are now obsolete aliases of 'xor'.
+
 
 * Changes in Emacs 27.1 on Non-Free Operating Systems
 
diff --git a/lisp/array.el b/lisp/array.el
index 2fffe01..965e97f 100644
--- a/lisp/array.el
+++ b/lisp/array.el
@@ -740,11 +740,6 @@ of `array-rows-numbered'."
        ((> index limit) limit)
        (t index)))
 
-(defun xor (pred1 pred2)
-  "Return the logical exclusive or of predicates PRED1 and PRED2."
-  (and (or pred1 pred2)
-       (not (and pred1 pred2))))
-
 (defun current-line ()
   "Return the current buffer line at point.  The first line is 0."
   (count-lines (point-min) (line-beginning-position)))
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index d752bf0..f990e0c 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -708,9 +708,7 @@ finds ham or spam.")
   "Clear the `spam-caches' entry for a check."
   (remhash symbol spam-caches))
 
-(defun spam-xor (a b)
-  "Logical A xor B."
-  (and (or a b) (not (and a b))))
+(define-obsolete-function-alias 'spam-xor 'xor "27.1")
 
 (defun spam-set-difference (list1 list2)
   "Return a set difference of LIST1 and LIST2.
@@ -2550,7 +2548,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
         (goto-char (point-min))
         (dolist (article articles)
           (insert (spam-get-article-as-string article)))
-        (let* ((arg (if (spam-xor unregister article-is-spam-p)
+        (let* ((arg (if (xor unregister article-is-spam-p)
                         "-spam"
                       "-good"))
                (status
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 0fffee6..85fd40e 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -43,7 +43,6 @@
 (require 'warnings)
 (require 'pcase)
 (require 'ert) ; to escape a `condition-case-unless-debug'
-(require 'array) ; xor
 
 
 ;;; Public API
diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el
index 062bb4c..bb927fe 100644
--- a/lisp/org/org-compat.el
+++ b/lisp/org/org-compat.el
@@ -362,6 +362,14 @@ use of this function is for the stuck project list."
 
 ;;; Miscellaneous functions
 
+;; `xor' was added in Emacs 27.1.
+(defalias 'org-xor
+  (if (fboundp 'xor)
+      #'xor
+    (lambda (a b)
+      "Exclusive or."
+      (if a (not b) b))))
+
 (defun org-version-check (version feature level)
   (let* ((v1 (mapcar 'string-to-number (split-string version "[.]")))
          (v2 (mapcar 'string-to-number (split-string emacs-version "[.]")))
diff --git a/lisp/org/org.el b/lisp/org/org.el
index e4c075f..336c413 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -10068,10 +10068,6 @@ Note: this function also decodes single byte encodings 
like
               (char-to-string (string-to-number byte 16)))
             (cdr (split-string hex "%")) ""))
 
-(defun org-xor (a b)
-  "Exclusive or."
-  (if a (not b) b))
-
 (defun org-fixup-message-id-for-http (s)
   "Replace special characters in a message id, so it can be used in an http 
query."
   (when (string-match "%" s)
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 28748cc..c5d4659 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -435,8 +435,8 @@ should return a grid vector array that is the new solution."
     (dotimes (y 5x5-grid-size)
       (dotimes (x 5x5-grid-size)
         (5x5-set-cell xored y x
-                      (5x5-xor (5x5-cell current y x)
-                               (5x5-cell best    y x)))))
+                      (xor (5x5-cell current y x)
+                           (5x5-cell best    y x)))))
     (5x5-mutate-solution xored)))
 
 (defun 5x5-mutate-solution (solution)
@@ -931,9 +931,7 @@ lest."
 
 ;; Support functions
 
-(defun 5x5-xor (x y)
-  "Boolean exclusive-or of X and Y."
-  (and (or x y) (not (and x y))))
+(define-obsolete-function-alias '5x5-xor 'xor "27.1")
 
 (defun 5x5-y-or-n-p (prompt)
   "5x5 wrapper for `y-or-n-p' which respects the `5x5-hassle-me' setting."
diff --git a/lisp/proced.el b/lisp/proced.el
index db8bdb5..24bc321 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -1194,10 +1194,7 @@ Return `equal' if T1 equals T2.  Return nil otherwise."
 
 ;;; Sorting
 
-(defsubst proced-xor (b1 b2)
-  "Return the logical exclusive or of args B1 and B2."
-  (and (or b1 b2)
-       (not (and b1 b2))))
+(define-obsolete-function-alias 'proced-xor 'xor "27.1")
 
 (defun proced-sort-p (p1 p2)
   "Predicate for sorting processes P1 and P2."
@@ -1208,8 +1205,8 @@ Return `equal' if T1 equals T2.  Return nil otherwise."
              (k2 (cdr (assq (car sorter) (cdr p2)))))
         ;; if the attributes are undefined, we should really abort sorting
         (if (and k1 k2)
-            (proced-xor (funcall (nth 1 sorter) k1 k2)
-                        (nth 2 sorter))))
+            (xor (funcall (nth 1 sorter) k1 k2)
+                 (nth 2 sorter))))
     (let ((sort-list proced-sort-internal) sorter predicate k1 k2)
       (catch 'done
         (while (setq sorter (pop sort-list))
@@ -1219,7 +1216,7 @@ Return `equal' if T1 equals T2.  Return nil otherwise."
                 (if (and k1 k2)
                     (funcall (nth 1 sorter) k1 k2)))
           (if (not (eq predicate 'equal))
-              (throw 'done (proced-xor predicate (nth 2 sorter)))))
+              (throw 'done (xor predicate (nth 2 sorter)))))
         (eq t predicate)))))
 
 (defun proced-sort (process-alist sorter descend)
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index 188ec01..e4f46bf 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -2604,7 +2604,7 @@ If ENABLE is non-nil, enable them instead."
   (let  ((bpl (or bpl idlwave-shell-bp-alist)) disabled modified)
     (while bpl
       (setq disabled (idlwave-shell-bp-get (car bpl) 'disabled))
-      (when (idlwave-xor (not disabled) (eq enable 'enable))
+      (when (xor (not disabled) (eq enable 'enable))
        (idlwave-shell-toggle-enable-current-bp
         (car bpl) (if (eq enable 'enable) 'enable 'disable) no-update)
        (push (car bpl) modified))
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 614d73e..1b4b55c 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -8813,9 +8813,8 @@ routines, and may have been scanned."
 
 ;; FIXME: Dynamically scoped vars need to use the `idlwave-' prefix.
 ;; (defvar type)
-(defmacro idlwave-xor (a b)
-  `(and (or ,a ,b)
-       (not (and ,a ,b))))
+
+(define-obsolete-function-alias 'idlwave-xor 'xor "27.1")
 
 (defun idlwave-routine-entry-compare (a b)
   "Compare two routine info entries for sorting.
@@ -8919,17 +8918,17 @@ This expects NAME TYPE IDLWAVE-TWIN-CLASS to be bound 
to the right values."
     ;; Now: follow JD's ideas about sorting.  Looks really simple now,
     ;; doesn't it?  The difficult stuff is hidden above...
     (cond
-     ((idlwave-xor asysp  bsysp)       asysp)  ; System entries first
-     ((idlwave-xor aunresp bunresp)    bunresp) ; Unresolved last
+     ((xor asysp   bsysp)     asysp)        ; System entries first
+     ((xor aunresp bunresp)   bunresp)      ; Unresolved last
      ((and idlwave-sort-prefer-buffer-info
-          (idlwave-xor abufp bbufp))  abufp)   ; Buffers before non-buffers
-     ((idlwave-xor acompp bcompp)      acompp) ; Compiled entries
-     ((idlwave-xor apathp bpathp)      apathp) ; Library before non-library
-     ((idlwave-xor anamep bnamep)      anamep) ; Correct file names first
-     ((and idlwave-twin-class anamep bnamep     ; both file names match ->
-          (idlwave-xor adefp bdefp))  bdefp)   ; __define after __method
-     ((> anpath bnpath)                t)      ; Who is first on path?
-     (t                                nil)))) ; Default
+           (xor abufp bbufp)) abufp)        ; Buffers before non-buffers
+     ((xor acompp bcompp)     acompp)       ; Compiled entries
+     ((xor apathp bpathp)     apathp)       ; Library before non-library
+     ((xor anamep bnamep)     anamep)       ; Correct file names first
+     ((and idlwave-twin-class anamep bnamep ; both file names match ->
+           (xor adefp bdefp)) bdefp)        ; __define after __method
+     ((> anpath bnpath)       t)            ; Who is first on path?
+     (t                       nil))))       ; Default
 
 (defun idlwave-routine-source-file (source)
   (if (nth 2 source)
diff --git a/lisp/simple.el b/lisp/simple.el
index 26b8247..da20de4 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5857,8 +5857,7 @@ mode temporarily."
     (goto-char omark)
     (cond (temp-highlight
           (setq-local transient-mark-mode (cons 'only transient-mark-mode)))
-         ((or (and arg (region-active-p)) ; (xor arg (not (region-active-p)))
-              (not (or arg (region-active-p))))
+         ((xor arg (not (region-active-p)))
           (deactivate-mark))
          (t (activate-mark)))
     nil))
diff --git a/lisp/strokes.el b/lisp/strokes.el
index 0c671c4..6edf58c 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -1524,12 +1524,6 @@ Encode/decode your strokes with 
\\[strokes-encode-buffer],
   (or (eq char ?\s)
       (eq char ?*)))
 
-;;(defsubst strokes-xor (a b)  ### Should I make this an inline function? ###
-;;  "T if one and only one of A and B is non-nil; otherwise, returns nil.
-;;NOTE: Don't use this as a numeric xor since it treats all non-nil
-;;      values as t including `0' (zero)."
-;;  (eq (null a) (not (null b))))
-
 (defsubst strokes-xpm-encode-length-as-string (length)
   "Given some LENGTH in [0,62) do a fast lookup of its encoding."
   (aref strokes-base64-chars length))
diff --git a/lisp/subr.el b/lisp/subr.el
index 518575f..b22db65 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -209,6 +209,14 @@ value of last one, or nil if there are none.
   (declare (indent 1) (debug t))
   (cons 'if (cons cond (cons nil body))))
 
+(defsubst xor (cond1 cond2)
+  "Return the boolean exclusive-or of COND1 and COND2.
+If only one of the arguments is non-nil, return it; otherwise
+return nil."
+  (declare (pure t) (side-effect-free error-free))
+  (cond ((not cond1) cond2)
+        ((not cond2) cond1)))
+
 (defmacro dolist (spec &rest body)
   "Loop over a list.
 Evaluate BODY with VAR bound to each car from LIST, in turn.
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 81662ca..c4812e8 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -1771,7 +1771,7 @@ Whitespace differences are ignored."
        (if (> (- (car forw) orig) (- orig (car back))) back forw)
       (or back forw))))
 
-(defsubst diff-xor (a b) (if a (if (not b) a) b))
+(define-obsolete-function-alias 'diff-xor 'xor "27.1")
 
 (defun diff-find-source-location (&optional other-file reverse noprompt)
   "Find current diff location within the source file.
@@ -1791,7 +1791,7 @@ SRC and DST are the two variants of text as returned by 
`diff-hunk-text'.
   SRC is the variant that was found in the buffer.
 SWITCHED is non-nil if the patch is already applied."
   (save-excursion
-    (let* ((other (diff-xor other-file diff-jump-to-old-file))
+    (let* ((other (xor other-file diff-jump-to-old-file))
           (char-offset (- (point) (diff-beginning-of-hunk t)))
            ;; Check that the hunk is well-formed.  Otherwise diff-mode and
            ;; the user may disagree on what constitutes the hunk
@@ -1917,7 +1917,7 @@ With a prefix argument, REVERSE the hunk."
        (insert (car new)))
       ;; Display BUF in a window
       (set-window-point (display-buffer buf) (+ (car pos) (cdr new)))
-      (diff-hunk-status-msg line-offset (diff-xor switched reverse) nil)
+      (diff-hunk-status-msg line-offset (xor switched reverse) nil)
       (when diff-advance-after-apply-hunk
        (diff-hunk-next))))))
 
@@ -1929,7 +1929,7 @@ With a prefix argument, try to REVERSE the hunk."
   (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
                (diff-find-source-location nil reverse)))
     (set-window-point (display-buffer buf) (+ (car pos) (cdr src)))
-    (diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))
+    (diff-hunk-status-msg line-offset (xor reverse switched) t)))
 
 
 (defun diff-kill-applied-hunks ()
@@ -1966,7 +1966,7 @@ revision of the file otherwise."
       (pop-to-buffer buf)
       (goto-char (+ (car pos) (cdr src)))
       (when buffer (next-error-found buffer (current-buffer)))
-      (diff-hunk-status-msg line-offset (diff-xor reverse switched) t))))
+      (diff-hunk-status-msg line-offset (xor reverse switched) t))))
 
 
 (defun diff-current-defun ()
@@ -2376,7 +2376,7 @@ fixed, visit it in a buffer."
   (interactive "P")
   (save-excursion
     (goto-char (point-min))
-    (let* ((other (diff-xor other-file diff-jump-to-old-file))
+    (let* ((other (xor other-file diff-jump-to-old-file))
           (modified-buffers nil)
           (style (save-excursion
                    (when (re-search-forward diff-hunk-header-re nil t)
diff --git a/lisp/windmove.el b/lisp/windmove.el
index ab47565..f5f5148 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -592,7 +592,7 @@ select the window with a displayed buffer, and the meaning 
of
 the prefix argument is reversed.
 When `switch-to-buffer-obey-display-actions' is non-nil,
 `switch-to-buffer' commands are also supported."
-  (let* ((no-select (not (eq (consp arg) windmove-display-no-select))) ; xor
+  (let* ((no-select (xor (consp arg) windmove-display-no-select))
          (old-window (or (minibuffer-selected-window) (selected-window)))
          (new-window)
          (minibuffer-depth (minibuffer-depth))
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 0023680..b3c04cd 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -125,6 +125,13 @@
   (should (equal (macroexpand-all '(when a b c d))
                  '(if a (progn b c d)))))
 
+(ert-deftest subr-test-xor ()
+  "Test `xor'."
+  (should-not (xor nil nil))
+  (should (eq (xor nil 'true) 'true))
+  (should (eq (xor 'true nil) 'true))
+  (should-not (xor t t)))
+
 (ert-deftest subr-test-version-parsing ()
   (should (equal (version-to-list ".5") '(0 5)))
   (should (equal (version-to-list "0.9 alpha1") '(0 9 -3 1)))