>From 78a4b6153315b6c83af5d802a71eb15734c0a07f Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Tue, 9 Apr 2019 02:23:41 +0100 Subject: [PATCH] Add conditional operators xor and equiv to subr.el MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Suggested by Oleh Krehel and provided by Mattias Engdegård 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. (equiv): New macro. * 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): Use equiv. * lisp/strokes.el (strokes-xor): Remove commented-out xor implementation. * lisp/windmove.el (windmove-display-in-direction): Use xor. * doc/lispref/control.texi (Control Structures): Extend menu entry for new combining conditions. (Combining Conditions): * etc/NEWS (Lisp Changes): Document xor and equiv. * test/lisp/subr-tests.el (subr-test-xor, subr-test-equiv): New tests. --- doc/lispref/control.texi | 64 ++++++++++++++++++++++++++++++++++-- etc/NEWS | 12 +++++++ 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 | 20 +++++++++++ lisp/vc/diff-mode.el | 12 +++---- lisp/windmove.el | 2 +- test/lisp/subr-tests.el | 22 +++++++++++++ 17 files changed, 153 insertions(+), 58 deletions(-) diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index de6cd9301f..49ad44932b 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,64 @@ Combining Conditions @var{arg3})} never evaluates any argument more than once. @end defspec +@defmac equiv &rest conditions +The @code{equiv} macro tests whether all the @var{conditions} are +logically equivalent, i.e., either all @code{nil} or all +non-@code{nil}. It works by evaluating the @var{conditions} one by +one in the order written. + +If any of the @var{conditions} evaluates to a value logically +different from its preceding @var{conditions}, then the result of the +@code{equiv} must be @code{nil} regardless of the remaining +@var{conditions}; so @code{equiv} returns @code{nil} right away, +ignoring the remaining @var{conditions}. + +If all the @var{conditions} turn out non-@code{nil}, then the +@code{equiv} expression returns the value of the last one. Otherwise, +if all the @var{conditions} turn out @code{nil}, @code{equiv} returns +@code{t}. Just @code{(equiv)}, with no @var{conditions}, also returns +@code{t}, appropriate because all the @var{conditions} turned out +logically equivalent. (Think about it; which one did not?) + +For example, the following expression tests whether either some state +is enabled (@var{enabled} is non-@code{nil}) and should be disabled +(@var{disable} is also non-@code{nil}), or the state is disabled +(@var{enabled} is @code{nil}) and should be enabled (@var{disable} is +also @code{nil}); if either of these conditions holds, the state +should subsequently be toggled: + +@example +(when (equiv enabled disable) + ;; Toggle state + @dots{}) +@end example + +Like the @code{and} construct, @code{equiv} can be written in terms of +@code{if} or @code{cond}, though not quite as naturally. Here's how: + +@example +@group +(equiv @var{arg1} @var{arg2} @var{arg3}) +@equiv{} +(if @var{arg1} (if @var{arg2} @var{arg3}) + (if @var{arg2} nil + (if @var{arg3} nil t))) +@equiv{} +(cond (@var{arg1} (cond (@var{arg2} @var{arg3}))) + (@var{arg2} nil) + (@var{arg3} nil) + (t)) +@end group +@end example +@end defmac + +@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}. +@end defun + @node Pattern-Matching Conditional @section Pattern-Matching Conditional @cindex pcase diff --git a/etc/NEWS b/etc/NEWS index 5313270411..25e5fe9574 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2390,6 +2390,18 @@ the Emacs Lisp manual. ** `directory-files-recursively' can now take an optional PREDICATE parameter to control descending into subdirectories. ++++ +** 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. Several duplicates of +'xor' in other packages are now obsolete aliases of 'xor'. + ++++ +** New macro 'equiv' tests whether its args are logically equivalent. +If its arguments are all non-nil, 'equiv' returns the value of the +last one; if they are all nil, it returns t; otherwise, its evaluation +short-circuits and returns nil. + * 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 b05046bfbd..f8685d3c2f 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 3bd99620d0..568479c822 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 (equiv 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 e33709e8ad..bc5a802930 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5847,8 +5847,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)))) + ((equiv arg (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 f1a4e8bb29..e922fe739f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -209,6 +209,26 @@ 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 equiv (&rest conditions) + "Return non-nil if all CONDITIONS are logically equivalent. +That is, they are either all nil, or all non-nil. Arguments are +evaluated in turn until one of them yields a logically different +value; the remaining arguments are not evaluated. If no argument +yields nil, return the last argument's value." + (if (cdr conditions) + `(if ,(car conditions) + (and ,@(cdr conditions)) + (not (or ,@(cdr conditions)))) + `(or ,(car conditions) t))) + (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 06db8f5c90..f834c6a862 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -125,6 +125,28 @@ subr-test-when (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-equiv () + "Test `equiv'." + (should (equiv)) + (should (equiv nil)) + (should (equiv nil nil)) + (should (equiv nil nil nil)) + (should (eq (equiv 'true) 'true)) + (should (eq (equiv t 'true) 'true)) + (let (x) + (should-not (equiv nil t (setq x t))) + (should-not (equiv t nil (setq x t))) + (should-not x) + (should (eq (equiv t t (setq x 'true)) 'true)) + (should (eq x 'true)))) + (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