From 26a22e339b71654ed417385aa27514175c67275e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
Date: Wed, 31 Jul 2019 19:45:06 +0200
Subject: [PATCH] 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 e98daf66e9..31948fa079 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -38,7 +38,7 @@ Control Structures
 @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 @@ Combining Conditions
 @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 @@ Combining Conditions
 @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 486e677539..c23feefbc3 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2480,6 +2480,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 if 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 2fffe0197e..965e97ff55 100644
--- a/lisp/array.el
+++ b/lisp/array.el
@@ -740,11 +740,6 @@ limit-index
 	((> 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 d752bf0efe..f990e0cba1 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -708,9 +708,7 @@ spam-clear-cache
   "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 @@ spam-spamoracle-learn
         (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 0fffee6866..85fd40ecd2 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 062bb4c5ca..bb927fedf9 100644
--- a/lisp/org/org-compat.el
+++ b/lisp/org/org-compat.el
@@ -362,6 +362,14 @@ 'org-texinfo-def-table-markup
 
 ;;; 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 5aa49b29d6..79725ac752 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -10068,10 +10068,6 @@ org-link-unescape-single-byte-sequence
 	       (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 28748cc351..c5d4659123 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -435,8 +435,8 @@ 5x5-make-xor-with-mutation
     (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 @@ 5x5-randomize
 
 ;; 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 5f35fa34a0..fe687a4f83 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -1194,10 +1194,7 @@ proced-time-lessp
 
 ;;; 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 @@ proced-sort-p
              (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 @@ proced-sort-p
                 (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 188ec012cf..e4f46bf882 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -2604,7 +2604,7 @@ idlwave-shell-enable-all-bp
   (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 614d73e23b..1b4b55c94f 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -8813,9 +8813,8 @@ idlwave-study-twins
 
 ;; 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 @@ idlwave-routine-twin-compare
     ;; 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 08021ce0e0..f764c176c9 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5855,8 +5855,7 @@ exchange-point-and-mark
     (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 0c671c43ac..6edf58c7b6 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -1524,12 +1524,6 @@ strokes-xpm-char-bit-p
   (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 eea4e045dd..75bf862324 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -209,6 +209,14 @@ unless
   (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 0d5dc0e1c0..a96c1bfd23 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -1770,7 +1770,7 @@ diff-find-approx-text
 	(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 out (BUF LINE-OFFSET POS SRC DST SWITCHED).
@@ -1783,7 +1783,7 @@ diff-find-source-location
 SWITCHED is non-nil if the patch is already applied.
 NOPROMPT, if non-nil, means not to prompt the user."
   (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
@@ -1909,7 +1909,7 @@ diff-apply-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))))))
 
@@ -1921,7 +1921,7 @@ diff-test-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 ()
@@ -1958,7 +1958,7 @@ diff-goto-source
       (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 ()
@@ -2253,7 +2253,7 @@ diff-delete-trailing-whitespace
   (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 ab47565dfa..f5f51480db 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -592,7 +592,7 @@ windmove-display-in-direction
 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 0023680738..b3c04cdc9a 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -125,6 +125,13 @@ 'subr-tests--parent-mode
   (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)))
-- 
2.20.1 (Apple Git-117)

