;;; arithemtic-replace.el --- arithmetic search and replace commands for [X]Emacs.

;; Copyright (C) 2003 Peter Ballard 

; This is very much an alpha release, so please email the author at
; pballard@ozemail.com.au with any feedback or suggestions.

;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; It is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;;; History
; 0.1 4-May-2003
; 0.2 5-May 2003 : same file for xemacs and GNU emacs;
;   check for whitespace before "n" and "c" in arithmetic-fix-sexp


;;; Commentary:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This code adds provision to do quick arithmetic replacements when editing.
;
; By tying in with the replace.el code, it allows all the nifty options
; (like y / n / ! / etc) which are available during query-replace.
;
; The main function, arithmetic-query-replace, 
; is used in a very similar way to query-replace.
; However it only searches for numbers, and it does arithmetic on those numbers.
;
; The user does not need to specify how to find a number: this is set
; by the variable arithmetic-number-def, and defaults to the most common
; case: the regexp "[0-9]+", i.e. it treats any sequence of digits
; like a non-negative integer. Set it to "\-?[0-9]+" if you need to
; treat negative numbers correctly.
;
; The only thing the user is prompted for is the s-expression descibing
; the arithmetic, with "n" being the number. The default is "(+ n 1)"
; which is an increment by 1. Any legal elisp arithmetic expression is allowed.
; 
; Often it is useful to change the increment on each replace, so the
; s-expression can also include "c", which is the count of replacements done.
; (In fact it is the emacs variable replace-count). 
;
; There are 3 other user-visible functions:
; 1. arithmetic-replace: the non-query version of arithmetic-query-replace
;
; 2. arithmetic-query-increment: in which the user is only prompted for
; the number by which to increment. This is redundant, but I thought it
; would be handy for users to be able to increment without having to
; learn even the simplest bit of elisp.
;
; 3. arithmetic-increment, the non-query version of arithmetic-increment
;
; One feature which is missing is the ability to define context for searches.
; i.e., you must search for every number: you cannot tell emacs to only
; look for numbers inside a certain pattern. Maybe one day.
; In the mean time, this can be done in two steps
; inside a macro, but it's still a bit ugly. Also, repeating macros
; cannot be done as neatly as query-replaces (with its y / n / ! choice).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Code:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defcustom arithmetic-number-def "[0-9]+"
  "*Regexp which defines what a number is for the arithmetic- functions."
  :type 'string)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; user-callable functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; The basic arithmetic function (query and non-query versions)

(defun arithmetic-query-replace (arithmetic-sexp &optional delimited)
  "Perform arithmetic on some numbers after point."

  (interactive (arithmetic-read-sexp "Query replace"))
  (arithmetic-perform-replace arithmetic-number-def "not-used" 
			      t t delimited nil nil arithmetic-sexp))

(defun arithmetic-replace (arithmetic-sexp &optional delimited)
  "Perform arithmetic on all numbers after point."

  (interactive (arithmetic-read-sexp "Replace"))
  (arithmetic-perform-replace arithmetic-number-def "not-used" 
			      nil t delimited nil nil arithmetic-sexp))

; These next 2 functions are not strictly necessary,
; but I thought it'd be nice to provide for the most common function
; (incrementing) without the user needing to learn how to make an s-expression
; (Again, there is the query and non-query version)

(defun arithmetic-query-increment (arithmetic-sexp &optional delimited)
  "Increment some numbers after point by base-increment."
  (interactive (arithmetic-read-increment "Query increment"))
  (arithmetic-perform-replace arithmetic-number-def "not-used" 
			      t t delimited nil nil arithmetic-sexp))

(defun arithmetic-increment (arithmetic-sexp &optional delimited)
  "Increment all numbers after point by base-increment."
  (interactive (arithmetic-read-increment "Increment"))
  (arithmetic-perform-replace arithmetic-number-def "not-used" 
			      nil t delimited nil nil arithmetic-sexp))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; functions not callable by the user
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; A variant of query-replace-read-args
; This reads the parameter for arithmetic-[query-]increment
(defun arithmetic-read-increment (operation)
  (let (increment )
    (setq increment (read-from-minibuffer 
		     (format "%s each number by : " operation)
		     nil nil nil
		     'query-replace-history))
    (list (concat "(+ " increment " n)")  current-prefix-arg)))

; A variant of query-replace-read-args
; This reads the sexp for arithmetic-[query-]replace
; It suggests the simplest (increment by 1), to give the
; user the idea of how to make an sexp.
(defun arithmetic-read-sexp (operation)
  (setq arithmetic-read-sexp (list (read-from-minibuffer 
				    (format "%s number n with : "
					    operation)
				    "(+ n 1)" nil nil
				    'query-replace-history)
				   current-prefix-arg)))

; return s with these changes:
; replace "n" with the matched-string, and "c" with count-string
; (in both cases, only if preceded by whitespace.
(defun arithmetic-fix-sexp (s matched-string count-string)
  (let (snew s-index thischar prevchar preceding-whitespace)
    (setq s-index 0)
    (setq snew "")
    ; build snew one char at a time
    (while (< s-index (length s))
      (progn
	(if (= s-index 0)
	    (setq preceding-whitespace nil)
	  (progn
	    (setq prevchar (aref s (+ s-index -1)))
	    (setq preceding-whitespace (or (char-equal prevchar ?\ )
					   (char-equal prevchar ?\t)
					   (char-equal prevchar ?\n)
					   (char-equal prevchar ?\v)
					   (char-equal prevchar ?\f)
					   (char-equal prevchar ?\r)))))
	(setq thischar (aref s s-index))
	(setq snew (concat snew 
			   (if (and preceding-whitespace
				    (or (char-equal thischar ?n) 
					(char-equal thischar ?N)))
			       matched-string
			     (if (and preceding-whitespace
				      (or (char-equal thischar ?c) 
					  (char-equal thischar ?C)))
				 count-string
			       (char-to-string thischar)))))
	(setq s-index (1+ s-index))))
    (setq arithmetic-fix-sexp snew)))

(defun arithmetic-replacement 
  (arithmetic-sexp matched-string replace-count)
  (setq arithmetic-replacement
	(number-to-string
	 (eval (read (arithmetic-fix-sexp 
		      arithmetic-sexp
		      matched-string 
		      (number-to-string replace-count)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; End of new functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; arithemtic-perform-replace is a slight variant on perform-replace 
; in replace.el
;
; Only some very minor changes to allow arithmetic:
; 1. Add the parameter arithmetic-sexp
; 2. Add one (if arithmetic-sexp ...) clause
; 3. Add the internal variable quoted-from-string
;  Because, when doing arithmetic replace, I think is more useful to 
; quote the "from-string" as the NUMBER being replaced, not the regexp 
; which is used for searching.
;
; If the emacs team want, this can replace perform-replace
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(if (string-match "XEmacs\\|Lucid" emacs-version)

; This version of arithmetic-perform-replace for Xemacs,
; modified from perform-replace in replace.el in Xemacs 21.5.11

    (defun arithmetic-perform-replace (from-string replacements
						   query-flag regexp-flag delimited-flag
						   &optional repeat-count map
						   arithmetic-sexp)
      "Subroutine of `query-replace'.  Its complexity handles interactive queries.
Don't use this in your own program unless you want to query and set the mark
just as `query-replace' does.  Instead, write a simple loop like this:
  (while (re-search-forward \"foo[ \t]+bar\" nil t)
    (replace-match \"foobar\" nil nil))
which will run faster and probably do exactly what you want.
When searching for a match, this function uses
`replace-search-function' and `replace-re-search-function'."
      (or map (setq map query-replace-map))
      (let* ((event (make-event))
	     (nocasify (not (and case-fold-search case-replace
				 (string-equal from-string
					       (downcase from-string)))))
	     (literal (not regexp-flag))
	     (search-function (if regexp-flag
				  replace-re-search-function
				replace-search-function))
	     (search-string from-string)
	     (quoted-from-string from-string)
	     (real-match-data nil)	; the match data for the current match
	     (next-replacement nil)
	     (replacement-index 0)
	     (keep-going t)
	     (stack nil)
	     (next-rotate-count 0)
	     (replace-count 0)
	     (lastrepl nil)		;Position after last match considered.
	     ;; If non-nil, it is marker saying where in the buffer to
	     ;; stop.
	     (limit nil)
	     (match-again t)
	     ;; XEmacs addition
	     (qr-case-fold-search
	      (if (and case-fold-search search-caps-disable-folding)
		  (no-upper-case-p search-string regexp-flag)
		case-fold-search))
	     (message
	      (if query-flag
		  (substitute-command-keys
		   "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) "))))
	;; If the region is active, operate on region.
	(when (region-active-p)
	  ;; Original Per Abrahamsen's code simply narrowed the region,
	  ;; thus providing a visual indication of the search boundary.
	  ;; Stallman, on the other hand, handles it like this.
	  (setq limit (copy-marker (region-end)))
	  (goto-char (region-beginning))
	  (zmacs-deactivate-region))
	(if (stringp replacements)
	    (setq next-replacement replacements)
	  (or repeat-count (setq repeat-count 1)))
	(if delimited-flag
	    (setq search-function replace-re-search-function
		  search-string (concat "\\b"
					(if regexp-flag from-string
					  (regexp-quote from-string))
					"\\b")))
	(push-mark)
	(undo-boundary)
	(unwind-protect
	    ;; Loop finding occurrences that perhaps should be replaced.
	    (while (and keep-going
			(not (eobp))
			(or (null limit) (< (point) limit))
			(let ((case-fold-search qr-case-fold-search))
			  (funcall search-function search-string limit))
			;; If the search string matches immediately after
			;; the previous match, but it did not match there
			;; before the replacement was done, ignore the match.
			(if (or (eq lastrepl (point))
				(and regexp-flag
				     (eq lastrepl (match-beginning 0))
				     (not match-again)))
			    (if (or (eobp)
				    (and limit (>= (point) limit)))
				nil
			      ;; Don't replace the null string
			      ;; right after end of previous replacement.
			      (forward-char 1)
			      (let ((case-fold-search qr-case-fold-search))
				(funcall search-function search-string limit)))
			  t))

	      ;; Save the data associated with the real match.
	      (setq real-match-data (match-data))

	      ;; Before we make the replacement, decide whether the search string
	      ;; can match again just after this match.
	      (if regexp-flag
		  (progn
		    (setq match-again (looking-at search-string))
		    ;; XEmacs addition
		    (store-match-data real-match-data)))
	      ;; If time for a change, advance to next replacement string.
	      (if (and (listp replacements)
		       (= next-rotate-count replace-count))
		  (progn
		    (setq next-rotate-count
			  (+ next-rotate-count repeat-count))
		    (setq next-replacement (nth replacement-index replacements))
		    (setq replacement-index (% (1+ replacement-index) (length replacements)))))
	      (if arithmetic-sexp
		  (progn 
		    (setq next-replacement 
			  (arithmetic-replacement arithmetic-sexp
						  (match-string 0) replace-count))
		    (setq quoted-from-string (match-string 0))))
	      (if (not query-flag)
		  (progn
		    (store-match-data real-match-data)
		    (replace-match next-replacement nocasify literal)
		    (setq replace-count (1+ replace-count)))
		(undo-boundary)
		(let ((help-form
		       '(concat (format "Query replacing %s%s with %s.\n\n"
					(if regexp-flag (gettext "regexp ") "")
					quoted-from-string next-replacement)
				(substitute-command-keys query-replace-help)))
		      done replaced def)
		  ;; Loop reading commands until one of them sets done,
		  ;; which means it has finished handling this occurrence.
		  (while (not done)
		    ;; Don't fill up the message log
		    ;; with a bunch of identical messages.
		    ;; XEmacs change
		    (display-message 'prompt
				     (format message quoted-from-string next-replacement))
		    (perform-replace-next-event event)
		    (setq def (lookup-key map (vector event)))
		    ;; Restore the match data while we process the command.
		    (store-match-data real-match-data)
		    (cond ((eq def 'help)
			   (with-output-to-temp-buffer (gettext "*Help*")
			     (princ (concat
				     (format "Query replacing %s%s with %s.\n\n"
					     (if regexp-flag "regexp " "")
					     quoted-from-string next-replacement)
				     (substitute-command-keys
				      query-replace-help)))
			     (save-excursion
			       (set-buffer standard-output)
			       (help-mode))))
			  ((eq def 'exit)
			   (setq keep-going nil)
			   (setq done t))
			  ((eq def 'backup)
			   (if stack
			       (let ((elt (car stack)))
				 (goto-char (car elt))
				 (setq replaced (eq t (cdr elt)))
				 (or replaced
				     (store-match-data (cdr elt)))
				 (setq stack (cdr stack)))
			     (message "No previous match")
			     (ding 'no-terminate)
			     (sit-for 1)))
			  ((eq def 'act)
			   (or replaced
			       (replace-match next-replacement nocasify literal))
			   (setq done t replaced t))
			  ((eq def 'act-and-exit)
			   (or replaced
			       (replace-match next-replacement nocasify literal))
			   (setq keep-going nil)
			   (setq done t replaced t))
			  ((eq def 'act-and-show)
			   (if (not replaced)
			       (progn
				 (replace-match next-replacement nocasify literal)
				 (store-match-data nil)
				 (setq replaced t))))
			  ((eq def 'automatic)
			   (or replaced
			       (replace-match next-replacement nocasify literal))
			   (setq done t query-flag nil replaced t))
			  ((eq def 'skip)
			   (setq done t))
			  ((eq def 'recenter)
			   (recenter nil))
			  ((eq def 'edit)
			   (store-match-data
			    (prog1 (match-data)
			      (save-excursion (recursive-edit))))
			   ;; Before we make the replacement,
			   ;; decide whether the search string
			   ;; can match again just after this match.
			   (if regexp-flag
			       (setq match-again (looking-at search-string))))
			  ((eq def 'delete-and-edit)
			   (delete-region (match-beginning 0) (match-end 0))
			   (store-match-data (prog1 (match-data)
					       (save-excursion (recursive-edit))))
			   (setq replaced t))
			  ;; Note: we do not need to treat `exit-prefix'
			  ;; specially here, since we reread
			  ;; any unrecognized character.
			  (t
			   (setq this-command 'mode-exited)
			   (setq keep-going nil)
			   (setq unread-command-events
				 (cons event unread-command-events))
			   (setq done t))))
		  ;; Record previous position for ^ when we move on.
		  ;; Change markers to numbers in the match data
		  ;; since lots of markers slow down editing.
		  (setq stack
			(cons (cons (point)
				    (or replaced
					(match-data t)))
			      stack))
		  (if replaced (setq replace-count (1+ replace-count)))))
	      (setq lastrepl (point)))
	  ;; Useless in XEmacs.  We handle (de)highlighting through
	  ;; perform-replace-next-event.
					;(replace-dehighlight)
	  )
	(or unread-command-events
	    (message "Replaced %d occurrence%s"
		     replace-count
		     (if (= replace-count 1) "" "s")))
	(and keep-going stack)))

; This version of arithmetic-perform-replace for GNU emacs,
; modified from perform-replace in replace.el in GNU emacs 20.5

  (defun arithmetic-perform-replace (from-string replacements
						 query-flag regexp-flag delimited-flag
						 &optional repeat-count map arithmetic-sexp)
    "Subroutine of `query-replace'.  Its complexity handles interactive queries.
Don't use this in your own program unless you want to query and set the mark
just as `query-replace' does.  Instead, write a simple loop like this:
  (while (re-search-forward \"foo[ \t]+bar\" nil t)
    (replace-match \"foobar\" nil nil))
which will run faster and probably do exactly what you want."
    (or map (setq map query-replace-map))
    (and query-flag minibuffer-auto-raise
	 (raise-frame (window-frame (minibuffer-window))))
    (let ((nocasify (not (and case-fold-search case-replace
			      (string-equal from-string
					    (downcase from-string)))))
	  (case-fold-search (and case-fold-search
				 (string-equal from-string
					       (downcase from-string))))
	  (literal (not regexp-flag))
	  (search-function (if regexp-flag 're-search-forward 'search-forward))
	  (search-string from-string)
	  (quoted-from-string from-string)
	  (real-match-data nil)		; the match data for the current match
	  (next-replacement nil)
	  (replacement-index 0)
	  (keep-going t)
	  (stack nil)
	  (next-rotate-count 0)
	  (replace-count 0)
	  (nonempty-match nil)

	  ;; If non-nil, it is marker saying where in the buffer to stop.
	  (limit nil)

	  ;; Data for the next match.  If a cons, it has the same format as
	  ;; (match-data); otherwise it is t if a match is possible at point.
	  (match-again t)

	  (message
	   (if query-flag
	       (substitute-command-keys
		"Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) "))))

      ;; If region is active, in Transient Mark mode, operate on region.
      (if (and transient-mark-mode mark-active)
	  (progn
	    (setq limit (copy-marker (region-end)))
	    (goto-char (region-beginning))
	    (deactivate-mark)))
      (if (stringp replacements)
	  (setq next-replacement replacements)
	(or repeat-count (setq repeat-count 1)))
      (if delimited-flag
	  (setq search-function 're-search-forward
		search-string (concat "\\b"
				      (if regexp-flag from-string
					(regexp-quote from-string))
				      "\\b")))
      (push-mark)
      (undo-boundary)
      (unwind-protect
	  ;; Loop finding occurrences that perhaps should be replaced.
	  (while (and keep-going
		      (not (eobp))
		      ;; Use the next match if it is already known;
		      ;; otherwise, search for a match after moving forward
		      ;; one char if progress is required.
		      (setq real-match-data
			    (if (consp match-again)
				(progn (goto-char (nth 1 match-again))
				       match-again)
			      (and (or match-again
				       (progn
					 (forward-char 1)
					 (not (eobp))))
				   (funcall search-function search-string limit t)
				   ;; For speed, use only integers and
				   ;; reuse the list used last time.
				   (match-data t real-match-data)))))

	    ;; Record whether the match is nonempty, to avoid an infinite loop
	    ;; repeatedly matching the same empty string.
	    (setq nonempty-match
		  (/= (nth 0 real-match-data) (nth 1 real-match-data)))

	    ;; If the match is empty, record that the next one can't be adjacent.
	    ;; Otherwise, if matching a regular expression, do the next
	    ;; match now, since the replacement for this match may
	    ;; affect whether the next match is adjacent to this one.
	    (setq match-again
		  (and nonempty-match
		       (or (not regexp-flag)
			   (and (looking-at search-string)
				(match-data)))))

	    ;; If time for a change, advance to next replacement string.
	    (if (and (listp replacements)
		     (= next-rotate-count replace-count))
		(progn
		  (setq next-rotate-count
			(+ next-rotate-count repeat-count))
		  (setq next-replacement (nth replacement-index replacements))
		  (setq replacement-index (% (1+ replacement-index) (length replacements)))))
	    (if arithmetic-sexp
		(progn 
		  (setq next-replacement 
			(arithmetic-replacement arithmetic-sexp
						(match-string 0) replace-count))
		  (setq quoted-from-string (match-string 0))))
	    (if (not query-flag)
		(progn
		  (set-match-data real-match-data)
		  (replace-match next-replacement nocasify literal)
		  (setq replace-count (1+ replace-count)))
	      (undo-boundary)
	      (let (done replaced key def)
		;; Loop reading commands until one of them sets done,
		;; which means it has finished handling this occurrence.
		(while (not done)
		  (set-match-data real-match-data)
		  (replace-highlight (match-beginning 0) (match-end 0))
		  ;; Bind message-log-max so we don't fill up the message log
		  ;; with a bunch of identical messages.
		  (let ((message-log-max nil))
		    (message message quoted-from-string next-replacement))
		  (setq key (read-event))
		  ;; Necessary in case something happens during read-event
		  ;; that clobbers the match data.
		  (set-match-data real-match-data)
		  (setq key (vector key))
		  (setq def (lookup-key map key))
		  ;; Restore the match data while we process the command.
		  (cond ((eq def 'help)
			 (with-output-to-temp-buffer "*Help*"
			   (princ
			    (concat "Query replacing "
				    (if regexp-flag "regexp " "")
				    quoted-from-string " with "
				    next-replacement ".\n\n"
				    (substitute-command-keys
				     query-replace-help)))
			   (save-excursion
			     (set-buffer standard-output)
			     (help-mode))))
			((eq def 'exit)
			 (setq keep-going nil)
			 (setq done t))
			((eq def 'backup)
			 (if stack
			     (let ((elt (car stack)))
			       (goto-char (car elt))
			       (setq replaced (eq t (cdr elt)))
			       (or replaced
				   (set-match-data (cdr elt)))
			       (setq stack (cdr stack)))
			   (message "No previous match")
			   (ding 'no-terminate)
			   (sit-for 1)))
			((eq def 'act)
			 (or replaced
			     (progn
			       (replace-match next-replacement nocasify literal)
			       (setq replace-count (1+ replace-count))))
			 (setq done t replaced t))
			((eq def 'act-and-exit)
			 (or replaced
			     (progn
			       (replace-match next-replacement nocasify literal)
			       (setq replace-count (1+ replace-count))))
			 (setq keep-going nil)
			 (setq done t replaced t))
			((eq def 'act-and-show)
			 (if (not replaced)
			     (progn
			       (replace-match next-replacement nocasify literal)
			       (setq replace-count (1+ replace-count))
			       (setq replaced t))))
			((eq def 'automatic)
			 (or replaced
			     (progn
			       (replace-match next-replacement nocasify literal)
			       (setq replace-count (1+ replace-count))))
			 (setq done t query-flag nil replaced t))
			((eq def 'skip)
			 (setq done t))
			((eq def 'recenter)
			 (recenter nil))
			((eq def 'edit)
			 (let ((opos (point-marker)))
			   (goto-char (match-beginning 0))
			   (save-excursion
			     (funcall search-function search-string limit t)
			     (setq real-match-data (match-data)))
			   (save-excursion (recursive-edit))
			   (goto-char opos))
			 (set-match-data real-match-data)
			 ;; Before we make the replacement,
			 ;; decide whether the search string
			 ;; can match again just after this match.
			 (if (and regexp-flag nonempty-match)
			     (setq match-again (and (looking-at search-string)
						    (match-data)))))
			((eq def 'delete-and-edit)
			 (delete-region (match-beginning 0) (match-end 0))
			 (set-match-data
			  (prog1 (match-data)
			    (save-excursion (recursive-edit))))
			 (setq replaced t))
			;; Note: we do not need to treat `exit-prefix'
			;; specially here, since we reread
			;; any unrecognized character.
			(t
			 (setq this-command 'mode-exited)
			 (setq keep-going nil)
			 (setq unread-command-events
			       (append (listify-key-sequence key)
				       unread-command-events))
			 (setq done t))))
		;; Record previous position for ^ when we move on.
		;; Change markers to numbers in the match data
		;; since lots of markers slow down editing.
		(setq stack
		      (cons (cons (point)
				  (or replaced (match-data t)))
			    stack)))))
	(replace-dehighlight))
      (or unread-command-events
	  (message "Replaced %d occurrence%s"
		   replace-count
		   (if (= replace-count 1) "" "s")))
      (and keep-going stack)))

  ) ; end of the giant (if (string-match "XEmacs\\|Lucid" emacs-version) ...)