.emacs.d.git - Gitblit

Chizi123

2018-11-18 21067e7cbe6d7a0f65ff5c317a96b5c337b0b3d8

commit \| author \| age
5cb5f7	1	;;; anaphora.el --- anaphoric macros providing implicit temp variables -- lexical-binding: t --
C	2	;;
	3	;; This code is in the public domain.
	4	;;
	5	;; Author: Roland Walker <walker@pobox.com>
	6	;; Homepage: http://github.com/rolandwalker/anaphora
	7	;; URL: http://raw.githubusercontent.com/rolandwalker/anaphora/master/anaphora.el
	8	;; Package-Version: 20180618.2200
	9	;; Version: 1.0.4
	10	;; Last-Updated: 18 Jun 2018
	11	;; EmacsWiki: Anaphora
	12	;; Keywords: extensions
	13	;;
	14	;;; Commentary:
	15	;;
	16	;; Quickstart
	17	;;
	18	;; (require 'anaphora)
	19	;;
	20	;; (awhen (big-long-calculation)
	21	;; (foo it) ; `it' is provided as
	22	;; (bar it)) ; a temporary variable
	23	;;
	24	;; ;; anonymous function to compute factorial using `self'
	25	;; (alambda (x) (if (= x 0) 1 (* x (self (1- x)))))
	26	;;
	27	;; ;; to fontify `it' and `self'
	28	;; (with-eval-after-load "lisp-mode"
	29	;; (anaphora-install-font-lock-keywords))
	30	;;
	31	;; Explanation
	32	;;
	33	;; Anaphoric expressions implicitly create one or more temporary
	34	;; variables which can be referred to during the expression. This
	35	;; technique can improve clarity in certain cases. It also enables
	36	;; recursion for anonymous functions.
	37	;;
	38	;; To use anaphora, place the anaphora.el library somewhere
	39	;; Emacs can find it, and add the following to your ~/.emacs file:
	40	;;
	41	;; (require 'anaphora)
	42	;;
	43	;; The following macros are made available
	44	;;
	45	;; `aand'
	46	;; `ablock'
	47	;; `acase'
	48	;; `acond'
	49	;; `aecase'
	50	;; `aetypecase'
	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	(let . let)
	156	(+ . t)
	157	(- . t)
	158	(* . t)
	159	(/ . t)
	160	)))
	161	(cond
	162	((and (numberp arg)
	163	(< arg 0))
	164	(dolist (cell syms)
	165	(when (ignore-errors
	166	(eq (symbol-function (intern-soft (format "a%s" (car cell))))
	167	(intern-soft (format "anaphoric-%s" (car cell)))))
	168	(fmakunbound (intern (format "a%s" (car cell)))))))
	169	(t
	170	(dolist (cell syms)
	171	(let* ((builtin (car cell))
	172	(traditional (intern (format "a%s" builtin)))
	173	(long (intern (format "anaphoric-%s" builtin))))
	174	(defalias traditional long)
	175	(put traditional 'lisp-indent-function
	176	(get builtin 'lisp-indent-function))
	177	(put traditional 'edebug-form-spec (cdr cell)))))))))
	178
	179	;;;###autoload
	180	(unless anaphora-use-long-names-only
	181	(anaphora--install-traditional-aliases))
	182
	183	;;; macros
	184
	185	;;;###autoload
	186	(defmacro anaphoric-if (cond then &rest else)
	187	"Like `if', but the result of evaluating COND is bound to `it'.
	188
	189	The variable `it' is available within THEN and ELSE.
	190
	191	COND, THEN, and ELSE are otherwise as documented for `if'."
	192	(declare (debug t)
	193	(indent 2))
	194	`(let ((it ,cond))
	195	(if it ,then ,@else)))
	196
	197	;;;###autoload
	198	(defmacro anaphoric-prog1 (first &rest body)
	199	"Like `prog1', but the result of evaluating FIRST is bound to `it'.
	200
	201	The variable `it' is available within BODY.
	202
	203	FIRST and BODY are otherwise as documented for `prog1'."
	204	(declare (debug t)
	205	(indent 1))
	206	`(let ((it ,first))
	207	(progn ,@body)
	208	it))
	209
	210	;;;###autoload
	211	(defmacro anaphoric-prog2 (form1 form2 &rest body)
	212	"Like `prog2', but the result of evaluating FORM2 is bound to `it'.
	213
	214	The variable `it' is available within BODY.
	215
	216	FORM1, FORM2, and BODY are otherwise as documented for `prog2'."
	217	(declare (debug t)
	218	(indent 2))
	219	`(progn
	220	,form1
	221	(let ((it ,form2))
	222	(progn ,@body)
	223	it)))
	224
	225	;;;###autoload
	226	(defmacro anaphoric-when (cond &rest body)
	227	"Like `when', but the result of evaluating COND is bound to `it'.
	228
	229	The variable `it' is available within BODY.
	230
	231	COND and BODY are otherwise as documented for `when'."
	232	(declare (debug when)
	233	(indent 1))
	234	`(anaphoric-if ,cond
	235	(progn ,@body)))
	236
	237	;;;###autoload
	238	(defmacro anaphoric-while (test &rest body)
	239	"Like `while', but the result of evaluating TEST is bound to `it'.
	240
	241	The variable `it' is available within BODY.
	242
	243	TEST and BODY are otherwise as documented for `while'."
	244	(declare (debug t)
	245	(indent 1))
	246	`(do ((it ,test ,test))
	247	((not it))
	248	,@body))
	249
	250	;;;###autoload
	251	(defmacro anaphoric-and (&rest conditions)
	252	"Like `and', but the result of the previous condition is bound to `it'.
	253
	254	The variable `it' is available within all CONDITIONS after the
	255	initial one.
	256
	257	CONDITIONS are otherwise as documented for `and'.
	258
	259	Note that some implementations of this macro bind only the first
	260	condition to `it', rather than each successive condition."
	261	(declare (debug t))
	262	(cond
	263	((null conditions)
	264	t)
	265	((null (cdr conditions))
	266	(car conditions))
	267	(t
	268	`(anaphoric-if ,(car conditions) (anaphoric-and ,@(cdr conditions))))))
	269
	270	;;;###autoload
	271	(defmacro anaphoric-cond (&rest clauses)
	272	"Like `cond', but the result of each condition is bound to `it'.
	273
	274	The variable `it' is available within the remainder of each of CLAUSES.
	275
	276	CLAUSES are otherwise as documented for `cond'."
	277	(declare (debug cond))
	278	(if (null clauses)
	279	nil
	280	(let ((cl1 (car clauses))
	281	(sym (gensym)))
	282	`(let ((,sym ,(car cl1)))
	283	(if ,sym
	284	(if (null ',(cdr cl1))
	285	,sym
	286	(let ((it ,sym)) ,@(cdr cl1)))
	287	(anaphoric-cond ,@(cdr clauses)))))))
	288
	289	;;;###autoload
	290	(defmacro anaphoric-lambda (args &rest body)
	291	"Like `lambda', but the function may refer to itself as `self'.
	292
	293	ARGS and BODY are otherwise as documented for `lambda'."
	294	(declare (debug lambda)
	295	(indent defun))
	296	`(cl-labels ((self ,args ,@body))
	297	#'self))
	298
	299	;;;###autoload
	300	(defmacro anaphoric-block (name &rest body)
	301	"Like `block', but the result of the previous expression is bound to `it'.
	302
	303	The variable `it' is available within all expressions of BODY
	304	except the initial one.
	305
	306	NAME and BODY are otherwise as documented for `block'."
	307	(declare (debug block)
	308	(indent 1))
	309	`(cl-block ,name
	310	,(funcall (anaphoric-lambda (body)
	311	(cl-case (length body)
	312	(0 nil)
	313	(1 (car body))
	314	(t `(let ((it ,(car body)))
	315	,(self (cdr body))))))
	316	body)))
	317
	318	;;;###autoload
	319	(defmacro anaphoric-case (expr &rest clauses)
	320	"Like `case', but the result of evaluating EXPR is bound to `it'.
	321
	322	The variable `it' is available within CLAUSES.
	323
	324	EXPR and CLAUSES are otherwise as documented for `case'."
	325	(declare (debug case)
	326	(indent 1))
	327	`(let ((it ,expr))
	328	(cl-case it ,@clauses)))
	329
	330	;;;###autoload
	331	(defmacro anaphoric-ecase (expr &rest clauses)
	332	"Like `ecase', but the result of evaluating EXPR is bound to `it'.
	333
	334	The variable `it' is available within CLAUSES.
	335
	336	EXPR and CLAUSES are otherwise as documented for `ecase'."
	337	(declare (debug ecase)
	338	(indent 1))
	339	`(let ((it ,expr))
	340	(cl-ecase it ,@clauses)))
	341
	342	;;;###autoload
	343	(defmacro anaphoric-typecase (expr &rest clauses)
	344	"Like `typecase', but the result of evaluating EXPR is bound to `it'.
	345
	346	The variable `it' is available within CLAUSES.
	347
	348	EXPR and CLAUSES are otherwise as documented for `typecase'."
	349	(declare (debug typecase)
	350	(indent 1))
	351	`(let ((it ,expr))
	352	(cl-typecase it ,@clauses)))
	353
	354	;;;###autoload
	355	(defmacro anaphoric-etypecase (expr &rest clauses)
	356	"Like `etypecase', but result of evaluating EXPR is bound to `it'.
	357
	358	The variable `it' is available within CLAUSES.
	359
	360	EXPR and CLAUSES are otherwise as documented for `etypecase'."
	361	(declare (debug etypecase)
	362	(indent 1))
	363	`(let ((it ,expr))
	364	(cl-etypecase it ,@clauses)))
	365
	366	;;;###autoload
	367	(defmacro anaphoric-let (form &rest body)
	368	"Like `let', but the result of evaluating FORM is bound to `it'.
	369
	370	FORM and BODY are otherwise as documented for `let'."
	371	(declare (debug let)
	372	(indent 1))
	373	`(let ((it ,form))
	374	(progn ,@body)))
	375
	376	;;;###autoload
	377	(defmacro anaphoric-+ (&rest numbers-or-markers)
	378	"Like `+', but the result of evaluating the previous expression is bound to `it'.
	379
	380	The variable `it' is available within all expressions after the
	381	initial one.
	382
	383	NUMBERS-OR-MARKERS are otherwise as documented for `+'."
	384	(declare (debug t))
	385	(cond
	386	((null numbers-or-markers)
	387	0)
	388	(t
	389	`(let ((it ,(car numbers-or-markers)))
	390	(+ it (anaphoric-+ ,@(cdr numbers-or-markers)))))))
	391
	392	;;;###autoload
	393	(defmacro anaphoric-- (&optional number-or-marker &rest numbers-or-markers)
	394	"Like `-', but the result of evaluating the previous expression is bound to `it'.
	395
	396	The variable `it' is available within all expressions after the
	397	initial one.
	398
	399	NUMBER-OR-MARKER and NUMBERS-OR-MARKERS are otherwise as
	400	documented for `-'."
	401	(declare (debug t))
	402	(cond
	403	((null number-or-marker)
	404	0)
	405	((null numbers-or-markers)
	406	`(- ,number-or-marker))
	407	(t
	408	`(let ((it ,(car numbers-or-markers)))
	409	(- ,number-or-marker (+ it (anaphoric-+ ,@(cdr numbers-or-markers))))))))
	410
	411	;;;###autoload
	412	(defmacro anaphoric-* (&rest numbers-or-markers)
	413	"Like `*', but the result of evaluating the previous expression is bound to `it'.
	414
	415	The variable `it' is available within all expressions after the
	416	initial one.
	417
	418	NUMBERS-OR-MARKERS are otherwise as documented for `*'."
	419	(declare (debug t))
	420	(cond
	421	((null numbers-or-markers)
	422	1)
	423	(t
	424	`(let ((it ,(car numbers-or-markers)))
	425	(* it (anaphoric-* ,@(cdr numbers-or-markers)))))))
	426
	427	;;;###autoload
	428	(defmacro anaphoric-/ (dividend divisor &rest divisors)
	429	"Like `/', but the result of evaluating the previous divisor is bound to `it'.
	430
	431	The variable `it' is available within all expressions after the
	432	first divisor.
	433
	434	DIVIDEND, DIVISOR, and DIVISORS are otherwise as documented for `/'."
	435	(declare (debug t))
	436	(cond
	437	((null divisors)
	438	`(/ ,dividend ,divisor))
	439	(t
	440	`(let ((it ,divisor))
	441	(/ ,dividend (* it (anaphoric-* ,@divisors)))))))
	442
	443	(provide 'anaphora)
	444
	445	;;
	446	;; Emacs
	447	;;
	448	;; Local Variables:
	449	;; indent-tabs-mode: nil
	450	;; mangle-whitespace: t
	451	;; require-final-newline: t
	452	;; coding: utf-8
	453	;; byte-compile-warnings: (not cl-functions redefine)
	454	;; End:
	455	;;
	456	;; LocalWords: Anaphora EXPR awhen COND ARGS alambda ecase typecase
	457	;; LocalWords: etypecase aprog aand acond ablock acase aecase alet
	458	;; LocalWords: atypecase aetypecase
	459	;;
	460
	461	;;; anaphora.el ends here