From c676444a43e4634c1f98ec286b5bd9e46b23216b Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= 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 e98daf66e98..31948fa079f 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 a078bcebfc1..818875f7a03 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 2fffe0197e8..965e97ff553 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 d752bf0efee..f990e0cba16 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 0fffee68664..85fd40ecd26 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 062bb4c5ca9..bb927fedf93 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 e4c075f8cdd..336c413c8c7 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 28748cc3514..c5d46591231 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 db8bdb5ac80..24bc321f434 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 188ec012cf7..e4f46bf8825 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 614d73e23b7..1b4b55c94f3 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 26b82479ff1..da20de4ad9c 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 0c671c43ac2..6edf58c7b6b 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 518575f6b4a..b22db65bb64 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 81662cafeda..c4812e81d40 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 ab47565dfae..f5f51480db2 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 0023680738d..b3c04cdc9a8 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))) -- 2.39.2