Download
(defvar *regexp-clean-cl-symbols* nil
"*An alist of repexp pairs for use with `mon-replace-region-regexp-lists'.\n
Regexp pairs generated from list elements of `*clean-cl-symbols-with-regexp*'.\n
List contains the association keys :TO-COLON and :FROM-COLON.\n
List alements associated with the :TO-COLON key have the form:\n
\(:TO-COLON
\(\"\\\\\(symbol\\\\\)\\\\_>\" \"cl::symbol\"\)
\(\"\\\\\(symbol\\\\*\\\\\)\\\\_>\" \"cl::symbol*\"\)
... \)\n
List alements assocated with the :FROM-COLON key have the form:\n
\(:FROM-COLON
\(\"\\\\\(cl::symbol\\\\\)\\\\_>\" \"symbol\"\)
\(\"\\\\\(cl::symbol\\\\*\\\\\)\\\\_>\" \"symbol*\"\)
... \)\n
The cdrs of keyed associations into this variable are used with regexp
looping procedures, e.g. as an argument to `mon-replace-region-regexp-lists'
which when called-interactively can quickly adjust elisp source for use with:
:FILE mon-cl-compat.el\n
:EXAMPLE\n\n\(cadr \(assoc :FROM-COLON *regexp-clean-cl-symbols*\)\)\n
\(cadr \(assoc :TO-COLON *regexp-clean-cl-symbols*\)\)\n
To edit or add additional regexps to this variable adjust the list in the
`*clean-cl-symbols-with-regexp*' variable (re)bind it using setq and
\(re\)evaluate `mon-CL-cln-colon-swap' with the true FORCED-COLONIC argument e.g.:\n
\(mon-CL-cln-colon-swap t\)\n
:SEE-ALSO `mon-CL-escape-star', `mon-CL-escape-regexp',
`mon-CL-namespace-colonic'.\n►►►")
(defvar *clean-cl-symbols-with-regexp*
'(("cl-test-not" "cl::test-not")
("cl-test" "cl::test")
("cl-if-not" "cl::if-not")
("cl-if" "cl::if")
("cl-alist" "cl::alist")
("cl-key" "cl::key")
("cl-parsing-keywords" "cl::parsing-keywords")
("cl-check-key" "cl::check-key")
("cl-check-test-nokey" "cl::check-test-nokey")
("cl-check-test" "cl::check-test")
("cl-check-match" "cl::check-match")
("reduce" "cl::reduce")
("fill" "cl::fill")
("replace" "cl::replace")
("remove-duplicates" "cl::remove-duplicates")
("remove-if-not" "cl::remove-if-not")
("remove-if" "cl::remove-if")
("remove*" "cl::remove")
("cl-delete-duplicates" "cl::cl-delete-duplicates")
("delete-duplicates" "cl::delete-duplicates")
("delete-if-not" "cl::delete-if-not")
("delete-if" "cl::delete-if")
("delete*" "cl::delete*")
("nsubstitute-if-not" "cl::nsubstitute-if-not")
("nsubstitute-if" "cl::nsubstitute-if")
("nsubstitute" "cl::nsubstitute")
("substitute-if-not" "cl::substitute-if-not")
("substitute-if" "cl::substitute-if")
("substitute" "cl::substitute")
("find-if-not" "cl::find-if-not")
("find-if" "cl::find-if")
("find" "cl::find")
("cl-position" "cl::cl-position")
("position-if-not" "cl::position-if-not")
("position-if" "cl::position-if")
("position" "cl::position")
("count-if-not" "cl::count-if-not")
("count-if" "cl::count-if")
("count" "cl::count")
("mismatch" "cl::mismatch")
("search" "cl::search")
("stable-sort" "cl::stable-sort")
("sort*" "cl::sort*")
("merge" "cl::merge")
("member-if-not" "cl::member-if-not")
("member-if" "cl::member-if")
("member*" "cl::member*")
("cl-member" "cl::cl-member")
("cl-adjoin" "cl::cl-adjoin")
("rassoc-if-not" "cl::rassoc-if-not")
("rassoc-if" "cl::rassoc-if")
("rassoc*" "cl::rassoc*")
("assoc-if-not" "cl::assoc-if-not")
("assoc-if" "cl::assoc-if")
("assoc*" "cl::assoc*")
("nunion" "cl::nunion")
("union" "cl::union")
("nintersection" "cl::nintersection")
("intersection" "cl::intersection")
("nset-difference" "cl::nset-difference")
("set-difference" "cl::set-difference")
("nset-exclusive-or" "cl::nset-exclusive-or")
("set-exclusive-or" "cl::set-exclusive-or")
("subsetp" "cl::subsetp")
("nsubst-if-not" "cl::nsubst-if-not")
("nsubst-if" "cl::nsubst-if")
("nsubst" "cl::nsubst")
("subst-if-not" "cl::subst-if-not")
("subst-if" "cl::subst-if")
("cl-nsublis-rec" "cl::cl-nsublis-rec")
("nsublis" "cl::nsublis")
("cl-sublis-rec" "cl::cl-sublis-rec")
("sublis" "cl::sublis")
("cl-tree-equal-rec" "cl::cl-tree-equal-rec")
("tree-equal" "cl::tree-equal")
("subseq" "cl::subseq")
("coerce" "cl::coerce")
("ldiff" "cl::ldiff")
("cl-make-type-test" "cl::cl-make-type-test")
("typep" "cl::typep")
("acons" "cl::acons")
("cl-mapcar-many" "cl::cl-mapcar-many")
("mapcar*" "cl::mapcar*")
("pairlis" "cl::parilis")
)
"*A list of string pairs to generate regexps for cl symbol transformation.\n
Regexps generated with `mon-CL-escape-star', `mon-CL-escape-regexp'
`mon-CL-cln-colon-swap', `mon-CL-namespace-colonic', are held in the
:VARIABLE `*regexp-clean-cl-symbols*'\n
Elements of list have the form:\n
\(\"symbol\" \"cl::symbol\"\)\n
:NOTE To prevent inadvertently replacing strings too soon, thereby clobbering or
otherwise doubling sub portions of a symbol name, it is necessary to ensure that
elts of regexp list are given in most -> leas specific order. IOW, where a
symbol is prefixed by the name of another like symbol with a suffix, the longer
suffixed symbol must come before the shorter prefixed symbol:\n
\(\"remove-if-not\" \"cl::remove-if-not\"\) ; :BEFORE `remove-if'
\(\"remove-if\" \"cl::remove-if\"\) ; :AFTER `remove-if-not'\n
Likewise, some symbols are prefixed with `cl-' these follow the same rule:\n
\(\"cl-position\" \"cl::cl-position\"\) ; :BEFORE `position'
\(\"position\" \"cl::position\"\) : :AFTER `cl-position'\n
Be careful with the destrucive symbols `nSYMBOL'. These need to appear
before there non-destructive counterparts.\n
:SEE-ALSO `mon-replace-region-regexp-lists'.\n►►►")
(defun mon-CL-escape-star (star-string-maybe &optional has-colon)
"Return escaped string STAR-STRING-MAYBE if it contains an asterisk.\n
When optional arg HAS-COLON is non-nil match strings prefixed by `cl::'.\n
Return values are as follows:\n
\"cl-symbol\" -> \"cl-symbol\"
\"cl-symbol*\" -> \"cl-symbol\\\\*\"
\"cl::cl-symbol\" -> \"cl::cl-symbol\"
\"cl::cl-symbol*\" -> \"cl::cl-symbol\\\\*\"\n
:EXAMPLE\n\n\(mon-CL-escape-star \"cl-symbol\"\)
\(mon-CL-escape-star \"cl-symbol*\"\)
\(mon-CL-escape-star \"cl::cl-symbol\" t\)
\(mon-CL-escape-star \"cl::cl-symbol*\" t\)\n
:SEE-ALSO `mon-CL-escape-regexp', `mon-CL-namespace-colonic',
`mon-CL-cln-colon-swap', `*regexp-clean-cl-symbols*',
`*clean-cl-symbols-with-regexp*'.\n►►►"
(let ((star-test '("[a-z-]+\\*" . "cl::[a-z-]+\\*"))
(star-rep '("\\([a-z-]+\\)\\(\\*\\)"
. "\\(cl::[a-z-]+\\)\\(\\*\\)"))
transd)
(if (string-match-p
(if has-colon
(cdr star-test)
(car star-test))
star-string-maybe)
(setq transd (replace-regexp-in-string
(if has-colon (cdr star-rep) (car star-rep))
"\\1\\\\\\2"
star-string-maybe t nil))
(setq transd star-string-maybe))
transd))
(defun mon-CL-escape-regexp (symbol-string &optional has-colon)
"Return list containing SYMBOL-STRING and a regexp to convert a CL symbol.
Default is to return a list with the form:\n
\(\"\\\\\(symbol\\\\\)\\\\_>\" \"cl::symbol\"\)
\(\"\\\\\(symbol\\\\*\\\\\)\\\\_>\" \"cl::symbol*\"\)\n
When optional arge HAS-COLON is non-nil return list with the form:\n
\(\"\\\\\(cl::symbol\\\\\)\\\\_>\" \"symbol\"\)
\(\"\\\\\(cl::symbol\\\\*\\\\\)\\\\_>\" \"symbol*\"\)\n
:NOTE The match-grouping of regexps in the car of the list isn't absolutely
neccessary and might slow things down a bit, however, their use allows manual
edits of the resulting regexp transformations should this be what is wanted.\n
:SEE-ALSO `mon-CL-escape-star', `mon-CL-namespace-colonic',
`mon-CL-cln-colon-swap', `*regexp-clean-cl-symbols*',
`*clean-cl-symbols-with-regexp*'.\n►►►"
(let ((trans-to-regexp (mon-CL-escape-star symbol-string has-colon))
(with-regexp
(if has-colon
'("\\(cl::\\)\\([a-z-]+\\)\\(\\\\\\*\\)?"
. "\\\\(\\2\\3\\\\)\\\\_>")
'("\\([a-z-]+\\)\\(\\\\\\*\\)?"
. "\\\\(cl::\\1\\2\\\\)\\\\_>"))))
(setq trans-to-regexp
(replace-regexp-in-string
(car with-regexp) (cdr with-regexp)
trans-to-regexp t nil))
`(,trans-to-regexp ,symbol-string)))
(defun mon-CL-namespace-colonic (start end &optional remove-colon)
"Prefix function symbols provided by CL packages with `cl::'.\n
Replace `symbol' with `CL::SYMBOL' in region from START to END.\n
When optional arg REMOVE-COLON is non-nil invert colon symbols to substitute
`cl::symbol' with `symbol'.\n
:SEE-ALSO `mon-CL-escape-star', `mon-CL-escape-regexp', `mon-CL-cln-colon-swap',
`*regexp-clean-cl-symbols*', `*clean-cl-symbols-with-regexp*'.\n►►►"
(interactive "r\nP")
(unless (eq (caar *regexp-clean-cl-symbols*) :TO-COLON) (mon-CL-cln-colon-swap))
(mon-replace-region-regexp-lists
start end (cdr (assoc (if remove-colon :FROM-COLON :TO-COLON) *regexp-clean-cl-symbols*))))
(defun mon-CL-cln-colon-swap (&optional forced-colonic)
"Modifify `*regexp-clean-cl-symbols*' to hold an alist of generated regexps.
Generate regexps for the CL namespace colonic adding :TO-COLON and :FROM-COLON
keys with the string pairs of `*clean-cl-symbols-with-regexp*'.\n
Keys associate regexp lists to transform cl function symbols of cl-seq.el.
The cdr of :TO-COLON contains regexp for substituting `symbol' -> `CL::symbol'.
To invert the colon use the cdr of :FROM-COLON and get `CL::symbol' -> `symbol'.
Will not rebind a pre-existing regexp list in `*regexp-clean-cl-symbols*'
unless optional arg FORCED-COLONIC is non-nil.\n
:EXAMPLE\n\n\(mon-CL-cln-colon-swap t\)\n
\(mon-CL-cln-colon-swap\)\n
:NOTE When (re)loading this package the FORCED-COLONIC arg is t.\n
:SEE-ALSO `mon-CL-escape-star', `mon-CL-escape-regexp'
`mon-CL-namespace-colonic', `*regexp-clean-cl-symbols*',
`*clean-cl-symbols-with-regexp*'.\n►►►"
(if (or forced-colonic
(not (eq (caar *regexp-clean-cl-symbols*) :TO-COLON)))
(let ((colonic-mogrifications
#'(lambda (&optional colonized)
(let ((rgxpify
(mapcar (if colonized 'cadr 'car)
*clean-cl-symbols-with-regexp*))
hold-on)
(dolist (rx rgxpify (setq hold-on
`(,(if colonized :TO-COLON :FROM-COLON)
,@(nreverse hold-on))))
(push (mon-CL-escape-regexp rx colonized) hold-on))))))
(progn
(setq *regexp-clean-cl-symbols* nil)
(push (funcall colonic-mogrifications) *regexp-clean-cl-symbols*)
(push (funcall colonic-mogrifications t) *regexp-clean-cl-symbols*)))
(message "We've given `*clean-cl-symbols-with-regexp*' her colonic already")))
(provide 'mon-cl-compat-regexps)
(eval-after-load "mon-cl-compat-regexps" '(mon-CL-cln-colon-swap t))