├── .gitignore ├── .travis.yml ├── Makefile ├── README.markdown ├── anaphora.el └── ert-tests └── anaphora-test.el /.gitignore: -------------------------------------------------------------------------------- 1 | /ert-tests/ert.el 2 | *-autoloads.el 3 | *.elc 4 | *~ 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | ### 2 | ### Notes 3 | ### 4 | ### The travis web interface may choke silently and fail to 5 | ### update when there are issues with the .travis.yml file. 6 | ### 7 | ### The "travis-lint" command-line tool does not catch all 8 | ### errors which may lead to silent failure. 9 | ### 10 | ### Shell-style comments must have "#" as the first character 11 | ### of the line. 12 | ### 13 | 14 | ### 15 | ### language 16 | ### 17 | 18 | # travis-lint no longer permits this value 19 | # language: emacs-lisp 20 | language: ruby 21 | 22 | ### 23 | ### defining the build matrix 24 | ### 25 | ### ===> <=== 26 | ### ===> each variation in env/matrix will be built and tested <=== 27 | ### ===> <=== 28 | ### 29 | ### variables under env/global are available to the build process 30 | ### but don't cause the creation of a separate variation 31 | ### 32 | 33 | env: 34 | matrix: 35 | - EMACS=emacs22 36 | - EMACS=emacs23 37 | - EMACS=emacs24 38 | - EMACS=emacs-snapshot 39 | global: 40 | - SOME_TOKEN=some_value 41 | 42 | ### 43 | ### allowing failures 44 | ### 45 | 46 | matrix: 47 | allow_failures: 48 | - env: EMACS=emacs22 49 | - env: EMACS=emacs-snapshot 50 | 51 | ### 52 | ### limit build attempts to defined branches 53 | ### 54 | 55 | # branches: 56 | # only: 57 | # - master 58 | 59 | ### 60 | ### runtime initialization 61 | ### 62 | ### notes 63 | ### 64 | ### emacs22 is extracted manually from Ubuntu Maverick. 65 | ### 66 | ### emacs23 is the stock default, but is updated anyway to 67 | ### a GUI-capable version, which will have certain additional 68 | ### functions compiled in. 69 | ### 70 | ### emacs24 (current stable release) is obtained from the 71 | ### cassou PPA: http://launchpad.net/~cassou/+archive/emacs 72 | ### 73 | ### emacs-snapshot (trunk) is obtained from the Ubuntu Emacs Lisp PPA: 74 | ### https://launchpad.net/~ubuntu-elisp/+archive/ppa 75 | ### For the emacs-snapshot build, bleeding-edge versions 76 | ### of all test dependencies are also used. 77 | ### 78 | 79 | before_install: 80 | - git submodule --quiet update --init --recursive 81 | 82 | install: 83 | - if [ "$EMACS" = 'emacs22' ]; then 84 | curl -Os http://security.ubuntu.com/ubuntu/pool/universe/e/emacs22/emacs22_22.2-0ubuntu9_i386.deb && 85 | curl -Os http://security.ubuntu.com/ubuntu/pool/universe/e/emacs22/emacs22-bin-common_22.2-0ubuntu9_i386.deb && 86 | curl -Os http://security.ubuntu.com/ubuntu/pool/universe/e/emacs22/emacs22-common_22.2-0ubuntu9_all.deb && 87 | curl -Os http://security.ubuntu.com/ubuntu/pool/universe/e/emacs22/emacs22-el_22.2-0ubuntu9_all.deb && 88 | curl -Os http://security.ubuntu.com/ubuntu/pool/universe/e/emacs22/emacs22-gtk_22.2-0ubuntu9_i386.deb && 89 | sudo apt-get -qq update && 90 | sudo apt-get -qq remove emacs emacs23-bin-common emacs23-common emacs23-nox && 91 | sudo apt-get -qq --fix-missing install install-info emacsen-common libjpeg62:i386 xaw3dg:i386 liblockfile1:i386 libasound2:i386 libgif4:i386 libncurses5:i386 libpng12-0:i386 libtiff4:i386 libxpm4:i386 libxft2:i386 libglib2.0-0:i386 libgtk2.0-0:i386 && 92 | sudo dpkg -i emacs22-common_22.2-0ubuntu9_all.deb emacs22-el_22.2-0ubuntu9_all.deb && 93 | sudo dpkg -i --force-depends emacs22-bin-common_22.2-0ubuntu9_i386.deb && 94 | sudo dpkg -i emacs22_22.2-0ubuntu9_i386.deb emacs22-gtk_22.2-0ubuntu9_i386.deb && 95 | sudo update-alternatives --set emacs22 /usr/bin/emacs22-gtk; 96 | fi 97 | - if [ "$EMACS" = 'emacs23' ]; then 98 | sudo apt-get -qq update && 99 | sudo apt-get -qq -f install && 100 | sudo apt-get -qq install emacs23-gtk emacs23-el; 101 | fi 102 | - if [ "$EMACS" = 'emacs24' ]; then 103 | sudo add-apt-repository -y ppa:cassou/emacs && 104 | sudo apt-get -qq update && 105 | sudo apt-get -qq -f install && 106 | sudo apt-get -qq install emacs24 emacs24-el; 107 | fi 108 | - if [ "$EMACS" = 'emacs-snapshot' ]; then 109 | sudo add-apt-repository -y ppa:ubuntu-elisp/ppa && 110 | sudo apt-get -qq update && 111 | sudo apt-get -qq -f install && 112 | sudo apt-get -qq install emacs-snapshot && 113 | sudo apt-get -qq install emacs-snapshot-el; 114 | fi 115 | 116 | before_script: 117 | - if [ "$EMACS" = 'emacs-snapshot' ]; then 118 | make downloads-latest; 119 | else 120 | make downloads; 121 | fi 122 | 123 | ### 124 | ### the actual build/test command 125 | ### 126 | 127 | script: 128 | $EMACS --version && ( test "$EMACS" != "emacs22" && make test EMACS="$EMACS" || make test-batch EMACS="$EMACS" ) 129 | 130 | ### 131 | ### settings 132 | ### 133 | 134 | notifications: 135 | email: false 136 | 137 | # 138 | # Emacs 139 | # 140 | # Local Variables: 141 | # indent-tabs-mode: nil 142 | # mangle-whitespace: t 143 | # require-final-newline: t 144 | # coding: utf-8 145 | # End: 146 | # 147 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | EMACS=emacs 2 | # EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs 3 | # EMACS=/Applications/Emacs23.app/Contents/MacOS/Emacs 4 | # EMACS=/Applications/Aquamacs.app/Contents/MacOS/Aquamacs 5 | # EMACS=/Applications/Macmacs.app/Contents/MacOS/Emacs 6 | # EMACS=/usr/local/bin/emacs 7 | # EMACS=/opt/local/bin/emacs 8 | # EMACS=/usr/bin/emacs 9 | 10 | INTERACTIVE_EMACS=/usr/local/bin/emacs 11 | # can't find an OS X variant that works correctly for interactive tests: 12 | # INTERACTIVE_EMACS=open -a Emacs.app --new --args 13 | # INTERACTIVE_EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs 14 | # INTERACTIVE_EMACS=/Applications/Emacs.app/Contents/MacOS/bin/emacs 15 | 16 | RESOLVED_EMACS=$(shell readlink `which $(EMACS)` || echo "$(EMACS)") 17 | RESOLVED_INTERACTIVE_EMACS=$(shell readlink `which "$(INTERACTIVE_EMACS)"` || echo "$(INTERACTIVE_EMACS)") 18 | 19 | EMACS_CLEAN=-Q 20 | EMACS_BATCH=$(EMACS_CLEAN) --batch 21 | # TESTS can be overridden to specify a subset of tests 22 | TESTS= 23 | WIKI_USERNAME=roland.walker 24 | 25 | CURL=curl --location --silent 26 | EDITOR=runemacs -no_wait 27 | WORK_DIR=$(shell pwd) 28 | PACKAGE_NAME=$(shell basename $(WORK_DIR)) 29 | PACKAGE_VERSION=$(shell perl -ne 'print "$$1\n" if m{^;+ *Version: *(\S+)}' $(PACKAGE_NAME).el) 30 | AUTOLOADS_FILE=$(PACKAGE_NAME)-autoloads.el 31 | TRAVIS_FILE=.travis.yml 32 | TEST_DIR=ert-tests 33 | TEST_DEP_1=ert 34 | TEST_DEP_1_STABLE_URL=http://git.savannah.gnu.org/cgit/emacs.git/plain/lisp/emacs-lisp/ert.el?h=emacs-24.3 35 | TEST_DEP_1_LATEST_URL=http://git.savannah.gnu.org/cgit/emacs.git/plain/lisp/emacs-lisp/ert.el?h=master 36 | 37 | .PHONY : build dist not-dirty pkg-version downloads downloads-latest autoloads \ 38 | test-autoloads test-travis test test-prep test-batch test-interactive \ 39 | test-tests clean edit run-pristine run-pristine-local upload-github \ 40 | upload-wiki upload-marmalade test-dep-1 test-dep-2 test-dep-3 test-dep-4 \ 41 | test-dep-5 test-dep-6 test-dep-7 test-dep-8 test-dep-9 42 | 43 | build : 44 | $(RESOLVED_EMACS) $(EMACS_BATCH) --eval \ 45 | "(progn \ 46 | (setq byte-compile-error-on-warn t) \ 47 | (batch-byte-compile))" *.el 48 | 49 | not-dirty : 50 | @git diff --quiet '$(PACKAGE_NAME).el' || \ 51 | ( git --no-pager diff '$(PACKAGE_NAME).el'; \ 52 | echo "Uncommitted edits - do a git stash"; \ 53 | false ) 54 | 55 | pkg-version : 56 | @test -n '$(PACKAGE_VERSION)' || \ 57 | ( echo "No package version"; false ) 58 | 59 | test-dep-1 : 60 | @cd '$(TEST_DIR)' && \ 61 | $(RESOLVED_EMACS) $(EMACS_BATCH) -L . -L .. -l '$(TEST_DEP_1)' || \ 62 | (echo "Can't load test dependency $(TEST_DEP_1).el, run 'make downloads' to fetch it" ; exit 1) 63 | 64 | downloads : 65 | $(CURL) '$(TEST_DEP_1_STABLE_URL)' > '$(TEST_DIR)/$(TEST_DEP_1).el' 66 | 67 | downloads-latest : 68 | $(CURL) '$(TEST_DEP_1_LATEST_URL)' > '$(TEST_DIR)/$(TEST_DEP_1).el' 69 | 70 | autoloads : 71 | $(RESOLVED_EMACS) $(EMACS_BATCH) --eval \ 72 | "(progn \ 73 | (setq generated-autoload-file \"$(WORK_DIR)/$(AUTOLOADS_FILE)\") \ 74 | (update-directory-autoloads \"$(WORK_DIR)\"))" 75 | 76 | test-autoloads : autoloads 77 | @$(RESOLVED_EMACS) $(EMACS_BATCH) -L . -l './$(AUTOLOADS_FILE)' || \ 78 | ( echo "failed to load autoloads: $(AUTOLOADS_FILE)" && false ) 79 | 80 | test-travis : 81 | @if test -z "$$TRAVIS" && test -e '$(TRAVIS_FILE)'; then travis-lint '$(TRAVIS_FILE)'; fi 82 | 83 | test-tests : 84 | @perl -ne 'if (m/^\s*\(\s*ert-deftest\s*(\S+)/) {die "$$1 test name duplicated in $$ARGV\n" if $$dupes{$$1}++}' '$(TEST_DIR)/'*-test.el 85 | 86 | test-prep : build test-dep-1 test-autoloads test-travis test-tests 87 | 88 | test-batch : 89 | @cd '$(TEST_DIR)' && \ 90 | (for test_lib in *-test.el; do \ 91 | $(RESOLVED_EMACS) $(EMACS_BATCH) -L . -L .. -l cl \ 92 | -l '$(TEST_DEP_1)' -l "$$test_lib" --eval \ 93 | "(progn \ 94 | (fset 'ert--print-backtrace 'ignore) \ 95 | (ert-run-tests-batch-and-exit '(and \"$(TESTS)\" (not (tag :interactive)))))" || exit 1; \ 96 | done) 97 | 98 | test-interactive : test-prep 99 | @cd '$(TEST_DIR)' && \ 100 | (for test_lib in *-test.el; do \ 101 | $(RESOLVED_INTERACTIVE_EMACS) $(EMACS_CLEAN) --eval \ 102 | "(progn \ 103 | (cd \"$(WORK_DIR)/$(TEST_DIR)\") \ 104 | (setq dired-use-ls-dired nil) \ 105 | (setq frame-title-format \"TEST SESSION $$test_lib\") \ 106 | (setq enable-local-variables :safe))" \ 107 | -L . -L .. -l cl -l '$(TEST_DEP_1)' -l "$$test_lib" \ 108 | --visit "$$test_lib" --eval \ 109 | "(progn \ 110 | (when (> (length \"$(TESTS)\") 0) \ 111 | (push \"\\\"$(TESTS)\\\"\" ert--selector-history)) \ 112 | (setq buffer-read-only t) \ 113 | (setq cursor-in-echo-area t) \ 114 | (call-interactively 'ert-run-tests-interactively) \ 115 | (ding) \ 116 | (when (y-or-n-p \"PRESS Y TO QUIT THIS TEST SESSION\") \ 117 | (with-current-buffer \"*ert*\" \ 118 | (kill-emacs \ 119 | (if (re-search-forward \"^Failed:[^\\n]+unexpected\" 500 t) 1 0)))))" || exit 1; \ 120 | done) 121 | 122 | test : test-prep test-batch 123 | 124 | run-pristine : 125 | @cd '$(TEST_DIR)' && \ 126 | $(RESOLVED_EMACS) $(EMACS_CLEAN) --eval \ 127 | "(progn \ 128 | (setq package-enable-at-startup nil) \ 129 | (setq package-load-list nil) \ 130 | (when (fboundp 'package-initialize) \ 131 | (package-initialize)) \ 132 | (cd \"$(WORK_DIR)/$(TEST_DIR)\") \ 133 | (setq dired-use-ls-dired nil) \ 134 | (setq frame-title-format \"PRISTINE SESSION $(PACKAGE_NAME)\") \ 135 | (setq enable-local-variables :safe))" \ 136 | -L .. -l '$(PACKAGE_NAME)' . 137 | 138 | run-pristine-local : 139 | @cd '$(TEST_DIR)' && \ 140 | $(RESOLVED_EMACS) $(EMACS_CLEAN) --eval \ 141 | "(progn \ 142 | (cd \"$(WORK_DIR)/$(TEST_DIR)\") \ 143 | (setq dired-use-ls-dired nil) \ 144 | (setq frame-title-format \"PRISTINE-LOCAL SESSION $(PACKAGE_NAME)\") \ 145 | (setq enable-local-variables :safe))" \ 146 | -L . -L .. -l '$(PACKAGE_NAME)' . 147 | 148 | clean : 149 | @rm -f '$(AUTOLOADS_FILE)' *.elc *~ */*.elc */*~ .DS_Store */.DS_Store *.bak */*.bak && \ 150 | cd '$(TEST_DIR)' && \ 151 | rm -f './$(TEST_DEP_1).el' './$(TEST_DEP_2).el' './$(TEST_DEP_3).el' './$(TEST_DEP_4).el' './$(TEST_DEP_5a).el' \ 152 | './$(TEST_DEP_5).el' './$(TEST_DEP_6).el' './$(TEST_DEP_7).el' './$(TEST_DEP_8).el' './$(TEST_DEP_9).el' 153 | 154 | edit : 155 | @$(EDITOR) `git ls-files` 156 | 157 | upload-github : 158 | @git push origin master 159 | 160 | upload-wiki : not-dirty 161 | @$(RESOLVED_EMACS) $(EMACS_BATCH) --eval \ 162 | "(progn \ 163 | (setq package-load-list '((yaoddmuse t))) \ 164 | (when (fboundp 'package-initialize) \ 165 | (package-initialize)) \ 166 | (require 'yaoddmuse) \ 167 | (setq yaoddmuse-username \"$(WIKI_USERNAME)\") \ 168 | (yaoddmuse-post-file \ 169 | \"$(PACKAGE_NAME).el\" \ 170 | yaoddmuse-default-wiki \ 171 | \"$(PACKAGE_NAME).el\" \ 172 | \"updated version\") \ 173 | (sleep-for 5))" 174 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | [![Build Status](https://secure.travis-ci.org/rolandwalker/anaphora.png?branch=master)](http://travis-ci.org/rolandwalker/anaphora) 2 | 3 | # Overview 4 | 5 | Anaphoric expressions for Emacs Lisp, providing implicit temporary variables. 6 | 7 | * [Quickstart](#quickstart) 8 | * [anaphora](#anaphora) 9 | * [See Also](#see-also) 10 | * [Notes](#notes) 11 | * [Compatibility and Requirements](#compatibility-and-requirements) 12 | 13 | ## Quickstart 14 | 15 | ```elisp 16 | (require 'anaphora) 17 | 18 | (awhen (big-long-calculation) 19 | (foo it) ; `it` is provided as 20 | (bar it)) ; a temporary variable 21 | 22 | ;; anonymous function to compute factorial using `self` 23 | (alambda (x) (if (= x 0) 1 (* x (self (1- x))))) 24 | 25 | ;; to fontify `it' and `self' 26 | (with-eval-after-load "lisp-mode" 27 | (anaphora-install-font-lock-keywords)) 28 | ``` 29 | 30 | ## anaphora 31 | 32 | Anaphoric expressions implicitly create one or more temporary 33 | variables which can be referred to during the expression. This 34 | technique can improve clarity in certain cases. It also enables 35 | recursion for anonymous functions. 36 | 37 | To use anaphora, place the `anaphora.el` library somewhere 38 | Emacs can find it, and add the following to your `~/.emacs` file: 39 | 40 | ```elisp 41 | (require 'anaphora) 42 | ``` 43 | 44 | The following macros are made available 45 | 46 | aand 47 | ablock 48 | acase 49 | acond 50 | aecase 51 | aetypecase 52 | apcase 53 | aif 54 | alambda 55 | alet 56 | aprog1 57 | aprog2 58 | atypecase 59 | awhen 60 | awhile 61 | a+ 62 | a- 63 | a* 64 | a/ 65 | 66 | The following macros are experimental 67 | 68 | anaphoric-set 69 | anaphoric-setq 70 | 71 | ## See Also 72 | 73 | * 74 | 75 | ## Notes 76 | 77 | Partially based on examples from the book "On Lisp", by Paul Graham. 78 | 79 | When this library is loaded, the provided anaphoric forms are 80 | registered as keywords in font-lock. This may be disabled via 81 | `customize`. 82 | 83 | ## Compatibility and Requirements 84 | 85 | GNU Emacs version 26.1 : yes 86 | GNU Emacs version 25.x : yes 87 | GNU Emacs version 24.x : yes 88 | GNU Emacs version 23.x : yes 89 | GNU Emacs version 22.x : yes 90 | GNU Emacs version 21.x and lower : unknown 91 | 92 | No external dependencies 93 | -------------------------------------------------------------------------------- /anaphora.el: -------------------------------------------------------------------------------- 1 | ;;; anaphora.el --- anaphoric macros providing implicit temp variables -*- lexical-binding: t -*- 2 | ;; 3 | ;; This code is in the public domain. 4 | ;; 5 | ;; Author: Roland Walker 6 | ;; Homepage: http://github.com/rolandwalker/anaphora 7 | ;; URL: http://raw.githubusercontent.com/rolandwalker/anaphora/master/anaphora.el 8 | ;; Version: 1.0.4 9 | ;; Last-Updated: 18 Jun 2018 10 | ;; EmacsWiki: Anaphora 11 | ;; Keywords: extensions 12 | ;; 13 | ;;; Commentary: 14 | ;; 15 | ;; Quickstart 16 | ;; 17 | ;; (require 'anaphora) 18 | ;; 19 | ;; (awhen (big-long-calculation) 20 | ;; (foo it) ; `it' is provided as 21 | ;; (bar it)) ; a temporary variable 22 | ;; 23 | ;; ;; anonymous function to compute factorial using `self' 24 | ;; (alambda (x) (if (= x 0) 1 (* x (self (1- x))))) 25 | ;; 26 | ;; ;; to fontify `it' and `self' 27 | ;; (with-eval-after-load "lisp-mode" 28 | ;; (anaphora-install-font-lock-keywords)) 29 | ;; 30 | ;; Explanation 31 | ;; 32 | ;; Anaphoric expressions implicitly create one or more temporary 33 | ;; variables which can be referred to during the expression. This 34 | ;; technique can improve clarity in certain cases. It also enables 35 | ;; recursion for anonymous functions. 36 | ;; 37 | ;; To use anaphora, place the anaphora.el library somewhere 38 | ;; Emacs can find it, and add the following to your ~/.emacs file: 39 | ;; 40 | ;; (require 'anaphora) 41 | ;; 42 | ;; The following macros are made available 43 | ;; 44 | ;; `aand' 45 | ;; `ablock' 46 | ;; `acase' 47 | ;; `acond' 48 | ;; `aecase' 49 | ;; `aetypecase' 50 | ;; `apcase' 51 | ;; `aif' 52 | ;; `alambda' 53 | ;; `alet' 54 | ;; `aprog1' 55 | ;; `aprog2' 56 | ;; `atypecase' 57 | ;; `awhen' 58 | ;; `awhile' 59 | ;; `a+' 60 | ;; `a-' 61 | ;; `a*' 62 | ;; `a/' 63 | ;; 64 | ;; See Also 65 | ;; 66 | ;; M-x customize-group RET anaphora RET 67 | ;; http://en.wikipedia.org/wiki/On_Lisp 68 | ;; http://en.wikipedia.org/wiki/Anaphoric_macro 69 | ;; 70 | ;; Notes 71 | ;; 72 | ;; Partially based on examples from the book "On Lisp", by Paul 73 | ;; Graham. 74 | ;; 75 | ;; Compatibility and Requirements 76 | ;; 77 | ;; GNU Emacs version 26.1 : yes 78 | ;; GNU Emacs version 25.x : yes 79 | ;; GNU Emacs version 24.x : yes 80 | ;; GNU Emacs version 23.x : yes 81 | ;; GNU Emacs version 22.x : yes 82 | ;; GNU Emacs version 21.x and lower : unknown 83 | ;; 84 | ;; Bugs 85 | ;; 86 | ;; TODO 87 | ;; 88 | ;; better face for it and self 89 | ;; 90 | ;;; License 91 | ;; 92 | ;; All code contributed by the author to this library is placed in the 93 | ;; public domain. It is the author's belief that the portions adapted 94 | ;; from examples in "On Lisp" are in the public domain. 95 | ;; 96 | ;; Regardless of the copyright status of individual functions, all 97 | ;; code herein is free software, and is provided without any express 98 | ;; or implied warranties. 99 | ;; 100 | ;;; Code: 101 | ;; 102 | 103 | ;;; requirements 104 | 105 | ;; for declare, labels, do, block, case, ecase, typecase, etypecase 106 | (require 'cl-lib) 107 | 108 | ;;; customizable variables 109 | 110 | ;;;###autoload 111 | (defgroup anaphora nil 112 | "Anaphoric macros providing implicit temp variables" 113 | :version "1.0.4" 114 | :link '(emacs-commentary-link :tag "Commentary" "anaphora") 115 | :link '(url-link :tag "GitHub" "http://github.com/rolandwalker/anaphora") 116 | :link '(url-link :tag "EmacsWiki" "http://emacswiki.org/emacs/Anaphora") 117 | :prefix "anaphora-" 118 | :group 'extensions) 119 | 120 | ;;;###autoload 121 | (defcustom anaphora-use-long-names-only nil 122 | "Use only long names such as `anaphoric-if' instead of traditional `aif'." 123 | :type 'boolean 124 | :group 'anaphora) 125 | 126 | ;;; font-lock 127 | 128 | (defun anaphora-install-font-lock-keywords nil 129 | "Fontify keywords `it' and `self'." 130 | (font-lock-add-keywords 'emacs-lisp-mode `((,(concat "\\<" (regexp-opt '("it" "self") 'paren) "\\>") 131 | 1 font-lock-variable-name-face)) 'append)) 132 | 133 | ;;; aliases 134 | 135 | ;;;###autoload 136 | (progn 137 | (defun anaphora--install-traditional-aliases (&optional arg) 138 | "Install traditional short aliases for anaphoric macros. 139 | 140 | With negative numeric ARG, remove traditional aliases." 141 | (let ((syms '( 142 | (if . t) 143 | (prog1 . t) 144 | (prog2 . t) 145 | (when . when) 146 | (while . t) 147 | (and . t) 148 | (cond . cond) 149 | (lambda . lambda) 150 | (block . block) 151 | (case . case) 152 | (ecase . ecase) 153 | (typecase . typecase) 154 | (etypecase . etypecase) 155 | (pcase . pcase) 156 | (let . let) 157 | (+ . t) 158 | (- . t) 159 | (* . t) 160 | (/ . t) 161 | ))) 162 | (cond 163 | ((and (numberp arg) 164 | (< arg 0)) 165 | (dolist (cell syms) 166 | (when (ignore-errors 167 | (eq (symbol-function (intern-soft (format "a%s" (car cell)))) 168 | (intern-soft (format "anaphoric-%s" (car cell))))) 169 | (fmakunbound (intern (format "a%s" (car cell))))))) 170 | (t 171 | (dolist (cell syms) 172 | (let* ((builtin (car cell)) 173 | (traditional (intern (format "a%s" builtin))) 174 | (long (intern (format "anaphoric-%s" builtin)))) 175 | (defalias traditional long) 176 | (put traditional 'lisp-indent-function 177 | (get builtin 'lisp-indent-function)) 178 | (put traditional 'edebug-form-spec (cdr cell))))))))) 179 | 180 | ;;;###autoload 181 | (unless anaphora-use-long-names-only 182 | (anaphora--install-traditional-aliases)) 183 | 184 | ;;; macros 185 | 186 | ;;;###autoload 187 | (defmacro anaphoric-if (cond then &rest else) 188 | "Like `if', but the result of evaluating COND is bound to `it'. 189 | 190 | The variable `it' is available within THEN and ELSE. 191 | 192 | COND, THEN, and ELSE are otherwise as documented for `if'." 193 | (declare (debug t) 194 | (indent 2)) 195 | `(let ((it ,cond)) 196 | (if it ,then ,@else))) 197 | 198 | ;;;###autoload 199 | (defmacro anaphoric-prog1 (first &rest body) 200 | "Like `prog1', but the result of evaluating FIRST is bound to `it'. 201 | 202 | The variable `it' is available within BODY. 203 | 204 | FIRST and BODY are otherwise as documented for `prog1'." 205 | (declare (debug t) 206 | (indent 1)) 207 | `(let ((it ,first)) 208 | (progn ,@body) 209 | it)) 210 | 211 | ;;;###autoload 212 | (defmacro anaphoric-prog2 (form1 form2 &rest body) 213 | "Like `prog2', but the result of evaluating FORM2 is bound to `it'. 214 | 215 | The variable `it' is available within BODY. 216 | 217 | FORM1, FORM2, and BODY are otherwise as documented for `prog2'." 218 | (declare (debug t) 219 | (indent 2)) 220 | `(progn 221 | ,form1 222 | (let ((it ,form2)) 223 | (progn ,@body) 224 | it))) 225 | 226 | ;;;###autoload 227 | (defmacro anaphoric-when (cond &rest body) 228 | "Like `when', but the result of evaluating COND is bound to `it'. 229 | 230 | The variable `it' is available within BODY. 231 | 232 | COND and BODY are otherwise as documented for `when'." 233 | (declare (debug when) 234 | (indent 1)) 235 | `(anaphoric-if ,cond 236 | (progn ,@body))) 237 | 238 | ;;;###autoload 239 | (defmacro anaphoric-while (test &rest body) 240 | "Like `while', but the result of evaluating TEST is bound to `it'. 241 | 242 | The variable `it' is available within BODY. 243 | 244 | TEST and BODY are otherwise as documented for `while'." 245 | (declare (debug t) 246 | (indent 1)) 247 | `(do ((it ,test ,test)) 248 | ((not it)) 249 | ,@body)) 250 | 251 | ;;;###autoload 252 | (defmacro anaphoric-and (&rest conditions) 253 | "Like `and', but the result of the previous condition is bound to `it'. 254 | 255 | The variable `it' is available within all CONDITIONS after the 256 | initial one. 257 | 258 | CONDITIONS are otherwise as documented for `and'. 259 | 260 | Note that some implementations of this macro bind only the first 261 | condition to `it', rather than each successive condition." 262 | (declare (debug t)) 263 | (cond 264 | ((null conditions) 265 | t) 266 | ((null (cdr conditions)) 267 | (car conditions)) 268 | (t 269 | `(anaphoric-if ,(car conditions) (anaphoric-and ,@(cdr conditions)))))) 270 | 271 | ;;;###autoload 272 | (defmacro anaphoric-cond (&rest clauses) 273 | "Like `cond', but the result of each condition is bound to `it'. 274 | 275 | The variable `it' is available within the remainder of each of CLAUSES. 276 | 277 | CLAUSES are otherwise as documented for `cond'." 278 | (declare (debug cond)) 279 | (if (null clauses) 280 | nil 281 | (let ((cl1 (car clauses)) 282 | (sym (gensym))) 283 | `(let ((,sym ,(car cl1))) 284 | (if ,sym 285 | (if (null ',(cdr cl1)) 286 | ,sym 287 | (let ((it ,sym)) ,@(cdr cl1))) 288 | (anaphoric-cond ,@(cdr clauses))))))) 289 | 290 | ;;;###autoload 291 | (defmacro anaphoric-lambda (args &rest body) 292 | "Like `lambda', but the function may refer to itself as `self'. 293 | 294 | ARGS and BODY are otherwise as documented for `lambda'." 295 | (declare (debug lambda) 296 | (indent defun)) 297 | `(cl-labels ((self ,args ,@body)) 298 | #'self)) 299 | 300 | ;;;###autoload 301 | (defmacro anaphoric-block (name &rest body) 302 | "Like `block', but the result of the previous expression is bound to `it'. 303 | 304 | The variable `it' is available within all expressions of BODY 305 | except the initial one. 306 | 307 | NAME and BODY are otherwise as documented for `block'." 308 | (declare (debug block) 309 | (indent 1)) 310 | `(cl-block ,name 311 | ,(funcall (anaphoric-lambda (body) 312 | (cl-case (length body) 313 | (0 nil) 314 | (1 (car body)) 315 | (t `(let ((it ,(car body))) 316 | ,(self (cdr body)))))) 317 | body))) 318 | 319 | ;;;###autoload 320 | (defmacro anaphoric-case (expr &rest clauses) 321 | "Like `case', but the result of evaluating EXPR is bound to `it'. 322 | 323 | The variable `it' is available within CLAUSES. 324 | 325 | EXPR and CLAUSES are otherwise as documented for `case'." 326 | (declare (debug case) 327 | (indent 1)) 328 | `(let ((it ,expr)) 329 | (cl-case it ,@clauses))) 330 | 331 | ;;;###autoload 332 | (defmacro anaphoric-ecase (expr &rest clauses) 333 | "Like `ecase', but the result of evaluating EXPR is bound to `it'. 334 | 335 | The variable `it' is available within CLAUSES. 336 | 337 | EXPR and CLAUSES are otherwise as documented for `ecase'." 338 | (declare (debug ecase) 339 | (indent 1)) 340 | `(let ((it ,expr)) 341 | (cl-ecase it ,@clauses))) 342 | 343 | ;;;###autoload 344 | (defmacro anaphoric-typecase (expr &rest clauses) 345 | "Like `typecase', but the result of evaluating EXPR is bound to `it'. 346 | 347 | The variable `it' is available within CLAUSES. 348 | 349 | EXPR and CLAUSES are otherwise as documented for `typecase'." 350 | (declare (debug typecase) 351 | (indent 1)) 352 | `(let ((it ,expr)) 353 | (cl-typecase it ,@clauses))) 354 | 355 | ;;;###autoload 356 | (defmacro anaphoric-etypecase (expr &rest clauses) 357 | "Like `etypecase', but result of evaluating EXPR is bound to `it'. 358 | 359 | The variable `it' is available within CLAUSES. 360 | 361 | EXPR and CLAUSES are otherwise as documented for `etypecase'." 362 | (declare (debug etypecase) 363 | (indent 1)) 364 | `(let ((it ,expr)) 365 | (cl-etypecase it ,@clauses))) 366 | 367 | ;;;###autoload 368 | (defmacro anaphoric-pcase (expr &rest clauses) 369 | "Like `pcase', but the result of evaluating EXPR is bound to `it'. 370 | 371 | The variable `it' is available within CLAUSES. 372 | 373 | EXPR and CLAUSES are otherwise as documented for `pcase'." 374 | (declare (debug pcase) 375 | (indent 1)) 376 | `(let ((it ,expr)) 377 | (pcase it ,@clauses))) 378 | 379 | ;;;###autoload 380 | (defmacro anaphoric-let (form &rest body) 381 | "Like `let', but the result of evaluating FORM is bound to `it'. 382 | 383 | FORM and BODY are otherwise as documented for `let'." 384 | (declare (debug let) 385 | (indent 1)) 386 | `(let ((it ,form)) 387 | (progn ,@body))) 388 | 389 | ;;;###autoload 390 | (defmacro anaphoric-+ (&rest numbers-or-markers) 391 | "Like `+', but the result of evaluating the previous expression is bound to `it'. 392 | 393 | The variable `it' is available within all expressions after the 394 | initial one. 395 | 396 | NUMBERS-OR-MARKERS are otherwise as documented for `+'." 397 | (declare (debug t)) 398 | (cond 399 | ((null numbers-or-markers) 400 | 0) 401 | (t 402 | `(let ((it ,(car numbers-or-markers))) 403 | (+ it (anaphoric-+ ,@(cdr numbers-or-markers))))))) 404 | 405 | ;;;###autoload 406 | (defmacro anaphoric-- (&optional number-or-marker &rest numbers-or-markers) 407 | "Like `-', but the result of evaluating the previous expression is bound to `it'. 408 | 409 | The variable `it' is available within all expressions after the 410 | initial one. 411 | 412 | NUMBER-OR-MARKER and NUMBERS-OR-MARKERS are otherwise as 413 | documented for `-'." 414 | (declare (debug t)) 415 | (cond 416 | ((null number-or-marker) 417 | 0) 418 | ((null numbers-or-markers) 419 | `(- ,number-or-marker)) 420 | (t 421 | `(let ((it ,(car numbers-or-markers))) 422 | (- ,number-or-marker (+ it (anaphoric-+ ,@(cdr numbers-or-markers)))))))) 423 | 424 | ;;;###autoload 425 | (defmacro anaphoric-* (&rest numbers-or-markers) 426 | "Like `*', but the result of evaluating the previous expression is bound to `it'. 427 | 428 | The variable `it' is available within all expressions after the 429 | initial one. 430 | 431 | NUMBERS-OR-MARKERS are otherwise as documented for `*'." 432 | (declare (debug t)) 433 | (cond 434 | ((null numbers-or-markers) 435 | 1) 436 | (t 437 | `(let ((it ,(car numbers-or-markers))) 438 | (* it (anaphoric-* ,@(cdr numbers-or-markers))))))) 439 | 440 | ;;;###autoload 441 | (defmacro anaphoric-/ (dividend divisor &rest divisors) 442 | "Like `/', but the result of evaluating the previous divisor is bound to `it'. 443 | 444 | The variable `it' is available within all expressions after the 445 | first divisor. 446 | 447 | DIVIDEND, DIVISOR, and DIVISORS are otherwise as documented for `/'." 448 | (declare (debug t)) 449 | (cond 450 | ((null divisors) 451 | `(/ ,dividend ,divisor)) 452 | (t 453 | `(let ((it ,divisor)) 454 | (/ ,dividend (* it (anaphoric-* ,@divisors))))))) 455 | 456 | (provide 'anaphora) 457 | 458 | ;; 459 | ;; Emacs 460 | ;; 461 | ;; Local Variables: 462 | ;; indent-tabs-mode: nil 463 | ;; mangle-whitespace: t 464 | ;; require-final-newline: t 465 | ;; coding: utf-8 466 | ;; byte-compile-warnings: (not cl-functions redefine) 467 | ;; End: 468 | ;; 469 | ;; LocalWords: Anaphora EXPR awhen COND ARGS alambda ecase typecase 470 | ;; LocalWords: etypecase aprog aand acond ablock acase aecase alet 471 | ;; LocalWords: atypecase aetypecase apcase 472 | ;; 473 | 474 | ;;; anaphora.el ends here 475 | -------------------------------------------------------------------------------- /ert-tests/anaphora-test.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t -*- 2 | 3 | (require 'anaphora) 4 | (anaphora--install-traditional-aliases) 5 | 6 | ;; some tests (but no code) adapted from anaphora.lisp 7 | 8 | ;;; anaphoric-if 9 | 10 | (ert-deftest anaphoric-if-01 nil 11 | (should (= 3 12 | (aif (1+ 1) 13 | (1+ it))))) 14 | 15 | (ert-deftest anaphoric-if-02 nil 16 | (should (= 3 17 | (aif (1+ 1) 18 | (progn 19 | (1+ it) 20 | (1+ it)))))) 21 | 22 | (ert-deftest anaphoric-if-03 nil 23 | (should (= 4 24 | (aif (1+ 1) 25 | (progn 26 | (incf it) 27 | (1+ it)))))) 28 | 29 | (ert-deftest anaphoric-if-04 nil 30 | (should 31 | (aif nil 32 | (+ 5 it) 33 | (null it)))) 34 | 35 | (ert-deftest anaphoric-if-05 nil 36 | (should (equal '(nil 1) 37 | (let ((x 0)) 38 | (aif (eval `(and ,(incf x) nil)) 39 | :never 40 | (list it x)))))) 41 | 42 | 43 | ;;; anaphoric-prog1 44 | 45 | (ert-deftest anaphoric-prog1-01 nil 46 | (should (= 5 47 | (aprog1 5 48 | (assert (eq it 5)) 49 | 10)))) 50 | 51 | (ert-deftest anaphoric-prog1-02 nil 52 | (should (= 6 53 | (aprog1 5 54 | (incf it) 55 | 10)))) 56 | 57 | (ert-deftest anaphoric-prog1-03 nil 58 | (should-error 59 | (aprog1 (1+ it) 60 | (1+ it)))) 61 | 62 | 63 | ;;; anaphoric-prog2 64 | 65 | (ert-deftest anaphoric-prog2-01 nil 66 | (should (= 5 67 | (aprog2 1 5 68 | (assert (eq it 5)) 69 | 10)))) 70 | 71 | (ert-deftest anaphoric-prog2-02 nil 72 | (should (= 6 73 | (aprog2 1 5 74 | (incf it) 75 | 10)))) 76 | 77 | (ert-deftest anaphoric-prog2-03 nil 78 | (should-error 79 | (aprog2 (1+ it) 1 80 | 1)) 81 | (should-error 82 | (aprog2 1 (1+ it) 83 | 1))) 84 | 85 | 86 | ;;; anaphoric-when 87 | 88 | (ert-deftest anaphoric-when-01 nil 89 | (should (= 3 90 | (awhen (1+ 1) 91 | (1+ it))))) 92 | 93 | (ert-deftest anaphoric-when-02 nil 94 | (should (= 4 95 | (awhen (1+ 1) 96 | (incf it) 97 | (1+ it))))) 98 | 99 | (ert-deftest anaphoric-when-03 nil 100 | (should (= 2 101 | (let ((x 0)) 102 | (awhen (incf x) 103 | (+ 1 it)))))) 104 | 105 | (ert-deftest anaphoric-when-04 nil 106 | (should (= 1 107 | (let ((x 0)) 108 | (or (awhen (not (incf x)) 109 | t) 110 | x))))) 111 | 112 | 113 | ;;; anaphoric-while 114 | 115 | (ert-deftest anaphoric-while-01 nil 116 | (should (equal '((4) (3 4) (2 3 4) (1 2 3 4)) 117 | (let ((list '(1 2 3 4)) 118 | (out nil)) 119 | (awhile list 120 | (push it out) 121 | (pop list)) 122 | out)))) 123 | 124 | (ert-deftest anaphoric-while-02 nil 125 | (should (equal '((5 4) (5 3 4) (5 2 3 4) (5 1 2 3 4)) 126 | (let ((list '(1 2 3 4)) 127 | (out nil)) 128 | (awhile list 129 | (push 5 it) 130 | (push it out) 131 | (pop list)) 132 | out)))) 133 | 134 | 135 | ;;; anaphoric-and 136 | 137 | (ert-deftest anaphoric-and-01 nil 138 | (should (= 3 139 | (aand (1+ 1) 140 | (1+ it))))) 141 | 142 | (ert-deftest anaphoric-and-02 nil 143 | (should (= 5 144 | (aand (1+ 1) 145 | (1+ it) 146 | (1+ it) 147 | (1+ it))))) 148 | 149 | (ert-deftest anaphoric-and-03 nil 150 | (should (= 5 151 | (aand (1+ 1) 152 | (1+ it) 153 | (incf it) 154 | (1+ it))))) 155 | 156 | (ert-deftest anaphoric-and-04 nil 157 | (should (equal '(1 2 3) 158 | (aand (1+ 1) 159 | '(1 2 3) 160 | it)))) 161 | 162 | (ert-deftest anaphoric-and-05 nil 163 | (should-error 164 | (aand (1+ it) 165 | (1+ it)))) 166 | 167 | 168 | ;;; anaphoric-cond 169 | 170 | (ert-deftest anaphoric-cond-01 nil 171 | (should (= 1 172 | (acond (1))))) 173 | 174 | (ert-deftest anaphoric-cond-02 nil 175 | (should-not 176 | (acond (1 nil)))) 177 | 178 | (ert-deftest anaphoric-cond-03 nil 179 | (should 180 | (acond (1 t)))) 181 | 182 | (ert-deftest anaphoric-cond-04 nil 183 | (should (eq :foo 184 | (acond (:foo) ("bar") (:baz))))) 185 | 186 | (ert-deftest anaphoric-cond-05 nil 187 | (should (= 1 188 | (acond (:foo 1) ("bar") (:baz))))) 189 | 190 | (ert-deftest anaphoric-cond-06 nil 191 | (should (= 1 192 | (acond (1 it))))) 193 | 194 | (ert-deftest anaphoric-cond-07 nil 195 | (should (= 2 196 | (acond (1 (1+ it)))))) 197 | 198 | (ert-deftest anaphoric-cond-08 nil 199 | (should (= 3 200 | (acond 201 | (nil 4) 202 | (2 (1+ it)))))) 203 | 204 | (ert-deftest anaphoric-cond-09 nil 205 | (should (equal '(:yes 3) 206 | (acond 207 | ((null 1) 208 | (list :no it)) 209 | ((+ 1 2) 210 | (list :yes it)) 211 | (t 212 | :nono))))) 213 | 214 | (ert-deftest anaphoric-cond-10 nil 215 | (should (eq :yes 216 | (acond 217 | ((= 1 2) 218 | :no) 219 | (nil 220 | :nono) 221 | (t 222 | :yes))))) 223 | 224 | (ert-deftest anaphoric-cond-11 nil 225 | (should (= 42 226 | (let ((foo)) 227 | (acond 228 | ((+ 2 2) 229 | (setf foo 38) 230 | (incf foo it) 231 | foo) 232 | (t 233 | nil)))))) 234 | 235 | 236 | ;;; anaphoric-lambda 237 | 238 | (ert-deftest anaphoric-lambda-01 nil 239 | (should (= 120 240 | (funcall (alambda (x) 241 | (if (= x 0) 1 (* x (self (1- x))))) 5)))) 242 | 243 | (ert-deftest anaphoric-lambda-02 nil 244 | (should (equal '(1 2 1 2) 245 | (let ((obj 'a)) 246 | (mapcar (alambda (list) 247 | (if (consp list) 248 | (+ (if (eq (car list) obj) 1 0) 249 | (self (car list)) 250 | (self (cdr list))) 251 | 0)) 252 | '((a b c) (d a r (p a)) (d a r) (a a))))))) 253 | 254 | 255 | ;;; anaphoric-block 256 | 257 | (ert-deftest anaphoric-block-01 nil 258 | (should-not 259 | (ablock testing 260 | 1 261 | (1+ it) 262 | (1+ it) 263 | (return-from testing)))) 264 | 265 | (ert-deftest anaphoric-block-02 nil 266 | (should (= 4 267 | (ablock testing 268 | 1 269 | (1+ it) 270 | (1+ it) 271 | (return-from testing (1+ it)))))) 272 | 273 | (ert-deftest anaphoric-block-03 nil 274 | (should (= 3 275 | (ablock testing 276 | 1 277 | (1+ it) 278 | (1+ it))))) 279 | 280 | (ert-deftest anaphoric-block-04 nil 281 | (should (= 0 282 | (ablock testing 283 | 1 284 | (1+ it) 285 | (1+ it) 286 | 0)))) 287 | 288 | 289 | ;;; anaphoric-case 290 | 291 | (ert-deftest anaphoric-case-01 nil 292 | (should (equal '(:yes 1) 293 | (let ((x 0)) 294 | (acase (incf x) 295 | (0 :no) 296 | (1 (list :yes it)) 297 | (2 :nono)))))) 298 | 299 | (ert-deftest anaphoric-case-02 nil 300 | (should (equal '(:yes 1) 301 | (let ((x 0)) 302 | (acase (incf x) 303 | (0 :no) 304 | ((incf it) (list :yes it)) 305 | (1 (list :yes it))))))) 306 | 307 | (ert-deftest anaphoric-case-03 nil 308 | (should (equal "bb" 309 | (acase ?b 310 | (?a "a") 311 | (?c "c") 312 | (?d "d") 313 | (otherwise (string ?b it)))))) 314 | 315 | 316 | ;;; anaphoric-ecase 317 | 318 | (ert-deftest anaphoric-ecase-01 nil 319 | (should (equal '(:yes 1) 320 | (let ((x 0)) 321 | (aecase (incf x) 322 | (0 :no) 323 | (1 (list :yes it)) 324 | (2 :nono)))))) 325 | 326 | (ert-deftest anaphoric-ecase-02 nil 327 | (should-error 328 | (aecase ?b 329 | (?a "a") 330 | (?c "c") 331 | (?d "d")))) 332 | 333 | 334 | ;;; anaphoric-typecase 335 | 336 | (ert-deftest anaphoric-typecase-01 nil 337 | (should (= 0.0 338 | (atypecase 1.0 339 | (integer 340 | (+ 2 it)) 341 | (float 342 | (1- it)))))) 343 | 344 | (ert-deftest anaphoric-typecase-02 nil 345 | (should-not 346 | (atypecase "Foo" 347 | (fixnum 348 | :no) 349 | (hash-table 350 | :nono)))) 351 | 352 | ;;; anaphoric-etypecase 353 | 354 | (ert-deftest anaphoric-etypecase-01 nil 355 | (should (= 0.0 356 | (aetypecase 1.0 357 | (integer 358 | (+ 2 it)) 359 | (float 360 | (1- it)))))) 361 | 362 | (ert-deftest anaphoric-etypecase-02 nil 363 | (should-error 364 | (aetypecase "Foo" 365 | (fixnum 366 | :no) 367 | (hash-table 368 | :nono)))) 369 | 370 | ;;; anaphoric-pcase 371 | 372 | (ert-deftest anaphoric-pcase-01 nil 373 | (should (equal '(:yes 1) 374 | (let ((x 0)) 375 | (apcase (incf x) 376 | (0 :no) 377 | (1 (list :yes it)) 378 | (2 :nono)))))) 379 | 380 | ;;; anaphoric-let 381 | 382 | (ert-deftest anaphoric-let-01 nil 383 | (should (= 1 384 | (alet 1 385 | it)))) 386 | 387 | (ert-deftest anaphoric-let-02 nil 388 | (should (= 2 389 | (alet (+ 1 1) 390 | it)))) 391 | 392 | ;;; anaphoric-+ 393 | 394 | (ert-deftest anaphoric-+-01 nil 395 | (should (= 0 396 | (a+)))) 397 | 398 | (ert-deftest anaphoric-+-02 nil 399 | (should (= 2 400 | (a+ 2)))) 401 | 402 | (ert-deftest anaphoric-+-03 nil 403 | (should-error 404 | (progn 405 | (a+ it)))) 406 | 407 | (ert-deftest anaphoric-+-04 nil 408 | (should (= 9 409 | (a+ 2 3 4)))) 410 | 411 | (ert-deftest anaphoric-+-05 nil 412 | (should (= 13 413 | (a+ 2 3 4 it)))) 414 | 415 | (ert-deftest anaphoric-+-06 nil 416 | (should (= 15 417 | (a+ 2 3 4 it 2)))) 418 | 419 | 420 | ;;; anaphoric-- 421 | 422 | (ert-deftest anaphoric---01 nil 423 | (should (= 0 424 | (a-)))) 425 | 426 | (ert-deftest anaphoric---02 nil 427 | (should (= -2 428 | (a- 2)))) 429 | 430 | (ert-deftest anaphoric---03 nil 431 | (should-error 432 | (progn 433 | (a- it)))) 434 | 435 | (ert-deftest anaphoric---04 nil 436 | (should (= 13 437 | (a- 20 3 4)))) 438 | 439 | (ert-deftest anaphoric---05 nil 440 | (should (= 9 441 | (a- 20 3 4 it)))) 442 | 443 | (ert-deftest anaphoric---06 nil 444 | (should (= 7 445 | (a- 20 3 4 it 2)))) 446 | 447 | 448 | ;;; anaphoric-* 449 | 450 | (ert-deftest anaphoric-*-01 nil 451 | (should (= 1 452 | (a*)))) 453 | 454 | (ert-deftest anaphoric-*-02 nil 455 | (should (= 2 456 | (a* 2)))) 457 | 458 | (ert-deftest anaphoric-*-03 nil 459 | (should-error 460 | (progn 461 | (a* it)))) 462 | 463 | (ert-deftest anaphoric-*-04 nil 464 | (should (= 24 465 | (a* 2 3 4)))) 466 | 467 | (ert-deftest anaphoric-*-05 nil 468 | (should (= 96 469 | (a* 2 3 4 it)))) 470 | 471 | (ert-deftest anaphoric-*-06 nil 472 | (should (= 192 473 | (a* 2 3 4 it 2)))) 474 | 475 | 476 | ;;; anaphoric-/ 477 | 478 | (ert-deftest anaphoric-/-01 nil 479 | (should-error 480 | (progn 481 | (a/)))) 482 | 483 | (ert-deftest anaphoric-/-02 nil 484 | (should-error 485 | (progn 486 | (a/ 200)))) 487 | 488 | (ert-deftest anaphoric-/-03 nil 489 | (should (= 40 490 | (a/ 200 5)))) 491 | 492 | (ert-deftest anaphoric-/-04 nil 493 | (should-error 494 | (progn 495 | (a/ 200 it)))) 496 | 497 | (ert-deftest anaphoric-/-05 nil 498 | (should (= 20 499 | (a/ 200 5 2)))) 500 | 501 | (ert-deftest anaphoric-/-06 nil 502 | (should (= 10 503 | (a/ 200 5 2 it)))) 504 | 505 | (ert-deftest anaphoric-/-07 nil 506 | (should (= 2 507 | (a/ 200 5 2 it 5)))) 508 | 509 | 510 | ;; 511 | ;; Emacs 512 | ;; 513 | ;; Local Variables: 514 | ;; indent-tabs-mode: nil 515 | ;; mangle-whitespace: t 516 | ;; require-final-newline: t 517 | ;; coding: utf-8 518 | ;; byte-compile-warnings: (not cl-functions) 519 | ;; End: 520 | ;; 521 | 522 | ;;; anaphora-test.el ends here 523 | --------------------------------------------------------------------------------