Jeff Clough | 27 Feb 01:07 2015
Picon

Help with contributing first change (patch for debbugs 354)

Hello,

TL;DR: I am attempting to contribute my first change to GNU Emacs and am
looking for a little hand-holding concerning the tools to use, and
someone to review my change.

I find myself with a surplus of free time and would like to spend some
of it contributing to GNU Emacs. As my knowledge of its guts is years
out of date (and was never that good to begin with), and I have only the
most *remedial* understanding of the tools involved, I decided to start
with a wishlist item and found debbugs:354
(http://debbugs.gnu.org/db/35/354.html).

This is a (seemingly well-received) proposal from 2008 which suggests
that append-to-file should output the number of characters appended in
addition to the name of the target file.

So, I did the following...

1. git checkout master
2. git pull
3. git checkout -b wishlist-354 (is this overkill for a small change?)
4. Changed write-region in "fileio.c"
5. Tested my change (is building in place advised?)
6. Created "wishlist354log.txt" with my commit message
7. git commit -a -F /path/to/wishlist354log.txt
8. git format-patch -1 (is using this advised?)

The last command created a file/email message which looks more or less
like what's between these lines of hyphens...
(Continue reading)

Jan D. | 26 Feb 16:43 2015
Picon

Re: Latest Emacs trunk doesn't compile

Damien Wyart skrev den 2015-02-26 11:35:
> Hi,
>
> a few OUTER_TO_INNER_DIFF macros remain in src/xmenu.c, preventing
> latest trunk to compile.
>
> Could you plese have a look?
>

Fixed in trunk.
However, nobody seems to use the non-toolkit menus, they don't work, not 
in emacs-24 either.

	Jan D.

Glenn Morris | 25 Feb 22:17 2015
Picon

merging emacs-24


For the upcoming 24.5 to get more testing, changes should be merged from
emacs-24 to master more frequently (it seems not to have been done at
all this month?). Please could someone(s) take care of it. Thanks.

Jackson Hamilton | 25 Feb 11:35 2015

Requesting review for change to lisp/textmodes/sgml-mode.el

Hello comrades,

I made an adjustment (fix?) to the way SGML attributes are indented.

Previously, if one wrote a form like the following:

<element attribute="value">

He could break the attribute onto a new line and it would be indented like so:

<element
   attribute="value">

But sgml-basic-offset defaults to 2, not 3, so it doesn't make much sense that
the attribute is indented by 3 spaces.

And if I (setq sgml-basic-offset 4), now my attributes are indented by 5
spaces. Personally I do not expect this behavior, I expect the indentation to
match.

Perhaps it could be argued that the extra space helps to improve readability;
maybe so, but it still seems to contradict the offset value. In teams where many
people use editors that insert multiples of N spaces or tabs, this +1
indentation strategy feels rather alienating. I think it would be better to
stick to a multiple of the specified offset when an attribute is sitting on its
own line.

Hence the attached patch to remove the +1 indentation behavior.

Thanks for reviewing,
Jackson
Glenn Brown | 24 Feb 18:56 2015
Picon

Re: Use of dedicated windows in gdb-mi.el

I applaud the efforts to make gdb-mode more friendly to novices.

However, as as 20+ year users of 'M-x gdb' in emacs, I, too, find recent changes to the default 'M-x gdb' behavior frustrating and counter-productive for my own work: I miss inline output in the *gud* frame: I am daily annoyed at output opening a new window I didn't ask for, which I must manually close or 'Ctrl-x o' (other-window) past, since I am often in 'emacs -nw' (No mouse) on remote machines.  I am annoyed that the new window-that-I-never-asked-for won't let me 'Ctrl-x b' (switch-to-buffer) to the buffer I actually want to see.

I understand that novices tend to use print-debugging and the new input/output buffer can be useful to them.  I appreciate that the default configuration should be optimized for novices doing native development in a windowed environment.
But please understand that many professionals develop code where stdout-in-its-own-window is counter-productive.  (In my daily use, the only output is from the testing framework I use.)  Please understand that not everyone has access to a mouse when doing remote and/or embedded development.

So please, gdb-mode maintainers, if you are going to change the default behaviour of gdb-mode, give us an easy way to get back access the old output-in-the-*gud*-buffer behavior, which is more productive for some of us professionals.

Thanks for your consideration,
--Glenn

Stephen Leake | 24 Feb 18:46 2015

emacs 25 broken?

Whenever I try to use emacs 25, something doesn't work right, and when
trying to debug it I always run into bug #19611; "e (current-buffer)" in
edebug returns the wrong buffer.

Does anyone else see this problem? It's blocking all my work on master.

--

-- 
-- Stephe

Agustin Martin | 24 Feb 18:04 2015
Picon

Which from and envelope addresses should be used for git commits?

Hi,

I noticed that messages sent to emacs-diffs after a commit to the git repo
seem to use the address in savannah as from and envelope address instead of
the committer address as was aparently done for the bzr repo. Noticed when
pushing a7254bbf99d9c9a55c93aae840c9d97598d4ce73 to the emacs-24 branch.

Most times they will match, but I wonder if if should default to use the
committer address as before.

Regards,

--

-- 
Agustin

Daiki Ueno | 24 Feb 09:05 2015
Picon

on-the-fly D-Bus proxy creation

Hello,

There are several programming languages with support for D-Bus client
implementation.  For example, with the following code:
https://git.gnome.org/browse/gnome-shell/tree/js/ui/keyboard.js#n56

  const CaribouDaemonIface = '<node> \
  <interface name="org.gnome.Caribou.Daemon"> \
  <method name="Run" /> \
  <method name="Quit" /> \
  </interface> \
  </node>';

  const CaribouDaemonProxy = Gio.DBusProxy.makeProxyWrapper(CaribouDaemonIface);

One can call a D-Bus method as a normal method of CaribouDaemonProxy.
This is really handy and I wished to have similar feature in Elisp
(though I haven't ever written any practical D-Bus code in Elisp).

Thanks to cl-generic, I gave it a try.  With the attached code (far from
complete though), a client can be implemented as:

  (dbus-define-proxy search-provider "\
  <node>
    <interface name=\"org.gnome.Shell.SearchProvider2\">
      <method name=\"GetInitialResultSet\">
        <arg type=\"as\" name=\"terms\" direction=\"in\" />
        <arg type=\"as\" name=\"results\" direction=\"out\" />
      </method>
      <!-- actually, there are more methods in this interface -->
    </interface>
  </node>")

Then you can create a client and call D-Bus methods:

  (setq search-provider
        (search-provider-make :session
                              "org.gnome.Weather.BackgroundService"
                              "/org/gnome/Weather/BackgroundService"))
  (search-provider-call-GetInitialResultSet search-provider '("tokyo"))

If this seems to be useful, I can finish it off as a patch.

Thanks,
--
Daiki Ueno
(require 'dbus)

(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'xml))

(cl-defstruct dbus-proxy
  (bus :read-only t)
  (service :read-only t)
  (path :read-only t))

(defmacro dbus-define-proxy (name xml)
  (let* ((node (car (with-temp-buffer
		      (insert xml)
		      (xml-parse-region (point-min) (point-max)))))
	 (interface (car (xml-get-children node 'interface)))
	 (methods (xml-get-children interface 'method))
	 (interface-name (xml-get-attribute-or-nil interface 'name)))
    `(progn
       (cl-defstruct (,name (:include dbus-proxy)
			    (:constructor nil)
			    (:constructor ,(intern (format "%s-make" name))
			     (bus service path)))
	 ;; FIXME: slots for cached properties?
	 )
       , <at> (mapcar
	  (lambda (method)
	    (let ((method-name (xml-get-attribute-or-nil method 'name))
		  ;; FIXME: parse argument types?
		  (in-args
		   (mapcar #'intern
			   (delq nil
				 (mapcar
				  (lambda (arg)
				    (let ((direction (xml-get-attribute-or-nil
						      arg 'direction)))
				      (if (or (null direction)
					      (not (equal direction "out")))
					  (xml-get-attribute-or-nil
					   arg 'name))))
				  (xml-get-children method 'arg))))))
	      ;; FIXME: un-CamelCasify method-name?
	      `(cl-defmethod ,(intern (format "%s-call-%s" name method-name))
			     ((proxy ,name) , <at> in-args &rest args)
		 (apply #'dbus-call-method
			(dbus-proxy-bus proxy)
			(dbus-proxy-service proxy)
			(dbus-proxy-path proxy)
			,interface-name
			,method-name
			, <at> in-args
			args))))
	  methods)
       ;; FIXME: asynchronous method calls, signals?
       )))

(dbus-define-proxy search-provider "\
<node>
  <interface name=\"org.gnome.Shell.SearchProvider2\">
    <method name=\"GetInitialResultSet\">
      <arg type=\"as\" name=\"terms\" direction=\"in\" />
      <arg type=\"as\" name=\"results\" direction=\"out\" />
    </method>
    <!-- actually, there are more methods in this interface -->
  </interface>
</node>")

;; (setq search-provider
;;       (search-provider-make :session
;;                             "org.gnome.Weather.BackgroundService"
;;                             "/org/gnome/Weather/BackgroundService"))
;; (search-provider-call-GetInitialResultSet search-provider '("tokyo"))
Alan Mackenzie | 23 Feb 19:12 2015
Picon

Fixing ill-conditioned regular expressions. Proof of concept.

Hello, Emacs.

Please refer to Martin Rudalics's bug #19846.  Briefly, in a C Mode
buffer, with auto-fill-mode enabled, auto-repeating the spacebar at the
beginning of a comment line caused Emacs to freeze for a long time (up to
several minutes).

The reason for the freeze was an ill-conditioned regexp being constructed
by CC Mode and forward-paragraph, and this being used in regexp searches.
Here, ill-conditioned means the regexp had several subexpressions
concatenated, each of which matches arbitrary amounts of whitespace.
This causes the backtracking algorithm in the regexp engine to go crazy.

One solution would be for hackers to write better regexps.  But since the
pertinent one here is constructed partly from a user configuration, this
is difficult to enforce.  It's also difficult when a core function like
forward-paragraph uses strings supplied by arbitrary packages.

Another solution is to fix these ill-conditioned regexps, which is the
approach taken here.  The supplied file fix-re.el contains algorithms
which convert the regexp to an internal tree form, analyse and, if
necessary, correct the tree, then convert back to a regexp string.

There are two entry points to the code:
(i) fix-re, which given a regexp returns either the corrected form or
  the same regex; it caches supplied regexps, so that fixing/non-fixing
  only need be done once for each supplied regexp.
(ii) fix-re-test, a slightly lower level function bypasses the cache and
  simply tests the regexp, returning the corrected version or nil.

The runtime of fix-re is minimal - around 2ms, as measured by elp.

To use fix-re.el, byte-compile and load it.  Apply the following patch to
.../textmodes/paragraphs.el:

diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index 8bcc71e..45aa95d 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
 <at>  <at>  -247,7 +247,8  <at>  <at>  Returns the count of paragraphs left to move."
 		      fill-prefix-regexp "[ \t]*$")
 	    parsep))
 	 ;; This is used for searching.
-	 (sp-parstart (concat "^[ \t]*\\(?:" parstart "\\|" parsep "\\)"))
+	 (sp-parstart (fix-re
+	  (concat "^[ \t]*\\(?:" parstart "\\|" parsep "\\)")))
 	 start found-start)
     (while (and (< arg 0) (not (bobp)))
       (if (and (not (looking-at parsep))

.  With this in place, the freezing observed in bug #19846 no longer
happens.

The particular ill-conditioned sp-parstart which caused bug #19846 was

                           2             1    1            3             1
    ^[ \t]*\(?:[ \t]*\(//+\|\**\)[ \t]*$\|^^L\|[ \t]*\(//+\|\**\)[ \t]*$\|^^L\)
            1         2         2                     3         3             1
	                      ^                               ^

.  Note the two expressions matching arbitrary amounts of WS sandwiching
\(//+\|\**), which also matches the empty string.  Note in particular,
the marked character.  (N.B. Note also the repetition which results from
the way the regexp was constructed, which will double the execution time
of the RE engine here.)

Here is this regexp after processing by fix-re:

                         3                1    1                           1
    ^[ \t]*\(?:\(?:\(//+\|\*+\)[ \t]*\)?$\|^^L\|\(?:\(//+\|\*+\)[ \t]*\)?$\|^^L\)
            1   2   3       ^ 3       2          4   5      ^  5       4        1

.  Note how the subexpression 3 has become  <at> dfn{de-emptified} - it no
longer matches the empty string, but matches everything else that the
original subexp did (and nothing more).

Abstractly, R*(R*ER*).... (where E is the subexp matching the empty
string) has been converted to R*((E <at> R*)?....), where E <at>  is the
de-emptification of E.

fix-re.el is currently a proof of concept, and is in a somewhat rough
state.  Comments and doc strings need attention, and the coding style is
not consistent throughout the file.  An additional transformation to
remove repeated alternatives from within \(..\) is also wanted.  But most
importantly, \{..\} expressions aren't handled at all.

I suggest that fix-re.el get incorporated into Emacs, after being tidied
up.

Comments?

-- 
Alan Mackenzie (Nuremberg, Germany).

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; f i x - r e . e l
;;
;; Fix ill-conditioned regular expressions.
;; 
;; Written by Alan Mackenzie, 2015-02.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;; Format of the Abstract Syntax Table
;;
;; The AST is an internal representation of the regular expression string.
;; Elements are represented as follows:
;; 
;; 1. Ordinary characters are represented as themselves.  So "abc" will be
;; (?a ?b ?c)
;; 
;; 2. Enclosing parentheses are represented as a list whose car is a symbol
;; whose print-name is the start of the list, and each of whose alternatives
;; is itself a list.  So "\\(ab\\|cd\\)" will be ('\\( (?a ?b) (?c ?d)).  Neither
;; "\\|" or "\\)" is explicitly represented.  Openers like "\\(?6:" are
;; handled.
;;
;; 3. The top level of the AST is a special case of 2. whose symbol is '|.
;; Thus the entire regexp "ab\|cd" is represented by ('| (?a ?b) (?c ?d)).
;;
;; 4. Character alternatives have '[ in the car, and the internals of the
;; brackets in the cdr.  So "[^])]" becomes ('[ . (?^ ?] ?\)).  In place of a
;; character there may be an "escape list".  Character classes (like
;; [:alnum:]) are handled vaguely properly.  The terminating "]" is not
;; explicitly represented.
;;
;; 5. +, *, and ? are represented by conses with the pertinent symbol in the
;; car and the repreated/optional expression in the cdr.  So "a+" becomes
;; ('+ . ?a), \\(foo\\|bar\\)* would be ('* . ('\\( (?f ?o ?o) (?b ?a ?r)))).
;;
;; 6. Backslashed characters are represented by a list whose first element is
;; <esc>.  So "\_<foo" becomes ((?\e ?_ ?<) ?f ?o ?o).  Such a list may appear
;; in any position where a plain character can be.
;;
;; 7. The repetition operators like "\{2,3\}" are currently (2015-02-20) not
;; handled.  FIXME!!!
;;
;; There follow the routines for conversion from regexp to AST and back
;; again.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar fix-re--i 0)
(defvar fix-re--len 0)
(defvar fix-re--re nil)

(defmacro fix-re--next-ch ()
  '(progn (setq ch (aref fix-re--re fix-re--i)
		fix-re--i (1+ fix-re--i))
	  ch))
(defmacro fix-re--peek-ch ()
  '(aref fix-re--re fix-re--i))
(defmacro fix-re--append-ch (c)
  ;; N.B. Here c need not be a character.  It might instead be a list or
  ;; symbol.
  `(setcar tree (cons ,c (car tree))))

(defmacro fix-re--is-\( (l)
  `(and (consp ,l)
	(symbolp (car ,l))
	(string-match "|\\|\\\\(\\(\\?[0-9]*:\\)?" (symbol-name (car ,l)))
	(car ,l)))

(defun fix-re--build-AST-char-alt (tree)
  (let (ch)
    (fix-re--next-ch)
    (when (eq ch ?^)
      (fix-re--append-ch ch)
      (fix-re--next-ch))
    (while (progn	     ; The first character might be ].  Don't test it!
	     (when (and (eq ch ?\[) (eq (fix-re--peek-ch) ?:)) ; e.g. [:alnum:]
	       (fix-re--append-ch ch) (fix-re--next-ch) (fix-re--append-ch ch) (fix-re--next-ch) ; the [:
	       (while (not (eq ch ?:))
		 (fix-re--append-ch ch) (fix-re--next-ch))
	       (fix-re--append-ch ch) (fix-re--next-ch)) ; leave the ] till later.
	     (when (eq ch ?\\)
	       (fix-re--append-ch ?\\)
	       (fix-re--next-ch)) ; Closing :
	     (fix-re--append-ch ch)
	     (fix-re--next-ch)
	     (not (eq ch ?\]))))
    (setcar tree (nreverse (car tree)))
    tree))

(defun fix-re--subbuild-AST (tree)
  "The recursive part of `fix-re--build-AST'.
TREE is a non-empty list, onto which we push the AST."
  (let (ch sym)
    (catch 'done
      (while (< fix-re--i fix-re--len)
	(fix-re--next-ch)
	(cond
	 ((eq ch ?\\)
	  (fix-re--next-ch)
	  (cond
	   ((eq ch ?\()
	    (setq sym '\\\()
	    (when (eq (fix-re--peek-ch) ??) ; shy group or explicitly numbered group
	      (fix-re--next-ch)		    ; ??
	      (fix-re--next-ch)		    ; 0-9 or ?:
	      (let ((str (concat "\\\(\?" (string ch))))
		  (while (not (eq ch ?:))
		    (fix-re--next-ch)
		    (setq str (concat str (string ch))))
		  (setq sym (intern str))))
	    (let ((subtree (list nil)))
	      (fix-re--append-ch `(,sym , <at> (fix-re--subbuild-AST subtree)))))
	   ((eq ch ?\|)
	    (setcar tree (nreverse (car tree)))
	    (push nil tree))
	   ((eq ch ?\))
	    (setcar tree (nreverse (car tree)))
	    (setq tree (nreverse tree))
	    (throw 'done tree))
	   ((memq ch '(?_ ?s ?S ?c ?C))	; \_< or \s., etc.
	    (fix-re--append-ch (list ?\\ ch (fix-re--next-ch))))
	   (t
	    (fix-re--append-ch (list ?\\ ch)))))

	 ((memq ch '(?* ?+ ??))
	  (setq sym (intern (string ch)))
	  (setcar (car tree) (cons sym (caar tree))))

	  ((eq ch ?\[)
	   (let ((subtree (list nil)))
	     (fix-re--append-ch `(\[ , <at> (car (fix-re--build-AST-char-alt subtree))))))

	  (t				; ordinary character
	   (fix-re--append-ch ch))))
      (setcar tree (nreverse (car tree)))
      (nreverse tree))))
	   
(defun fix-re--build-AST (regexp)
  "Construct the AST corresponding to the input regexp REGEXP.
REGEXP is assumed to be syntactically correct."
  (let ((tree (list nil))
	)
    (setq fix-re--i 0
	  fix-re--len (length regexp)
	  fix-re--re regexp)
    `(| , <at> (fix-re--subbuild-AST tree))))

(defun fix-re--dump-AST (s)
  "Convert the AST S to a regexp string and return it."
  (cond
   ((null s)
    "")
   ((numberp s)				; i.e. a character
    (string s))
   ((eq (car s) '|)
    (mapconcat 'fix-re--dump-AST (cdr s) "\\|"))
   ((fix-re--is-\( s)
    (concat (symbol-name (car s)) (mapconcat 'fix-re--dump-AST (cdr s) "\\|") "\\)"))
   ((memq (car s) '(* + \?))
    (concat (fix-re--dump-AST (cdr s)) (symbol-name (car s))))
   ((eq (car s) '\[)
    (concat "[" (fix-re--dump-AST (cdr s)) "]"))
   ((consp (car s))
    (concat (fix-re--dump-AST (car s)) (fix-re--dump-AST (cdr s))))
   ((numberp (car s))			; i.e. a character
    (concat (string (car s)) (fix-re--dump-AST (cdr s))))
   (t (error "(car s) is %s" (car s)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PTR and AD
;; ----------
;;
;; Whilst building and transforming trees, what we really need is pointers to
;; either the car or cdr of a cons cell, to enable us to overwrite them.  The
;; only tools we have for this job are `setcar' and `setcdr', but these
;; primitives, unadorned, are too cumbersome for the manipulations we will be
;; doing.  Enter `ptr' and `ad'.  Together, these emulate the notion of
;; pointer.
;;
;; `ad' takes one of the values 'car, 'cdr, or 'cadr.  'ptr' is always a cons
;; cell, `ad' specifiying how to reach the element we're interested in.  For
;; example, if we needed an overwrite routine `fix-re--overwrite-via-ptr' (we don't
;; seem to), the overwrite operation would be one of:
;; car:  (setcar ptr val);
;; cdr:  (setcdr ptr val);
;; cadr: (setcar (cdr ptr) val).
;;
;; Note that when `ptr'/`ad' are used for list operations, `ad' may not be
;; 'cdr.
;; 
;; A set of tree access primitives follows.  Throughout the rest of this
;; source file, `ptr' and `ad' will not be further extensively documented.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro fix-re--ptr-get (ptr ad)
  "Get the element pointed to by PTR and AD."
  `(cond ((eq ,ad 'car) (car ,ptr))
	 ((eq ,ad 'cdr) (cdr ,ptr))
	 (t (cadr ,ptr))))

(defmacro fix-re--ptr-next (ptr ad)
  "Advance PTR/AD to the next in the list, and return what it then points to.
Here, PTR and AD must both be variables."
  `(cond
    ((eq ,ad 'car)
     (setq ,ad 'cadr)
     (cadr ,ptr))
    ((eq ,ad 'cadr)
     (setq ,ptr (cdr ,ptr))
     (cadr ,ptr))
    (t (error "'fix-re--ptr-next called with 'cdr"))))

(defun fix-re--bind-link-nil (ptr ad)
  "\"Bind\" PTR/AD's \"next field\" to nil, returning the old value."
  (cond
   ((eq ad 'car)
    (prog1
	(cdr ptr)
      (setcdr ptr nil)))
   ((eq ad 'cadr)
    (prog1
	(cddr ptr)
      (setcdr (cdr ptr) nil)))
   (t (error "fix-re--bind-link-nil called with 'cdr"))))

(defun fix-re--restore-link (lnk ptr ad)
  "Restore PTR/AD's \"next field\" to LNK."
  (cond
   ((eq ad 'car) (setcdr ptr lnk))
   ((eq ad 'cadr) (setcdr (cdr ptr) lnk))
   (t (error "fix-re--restore-link called with 'cdr"))))

(defmacro fix-re--chop (ptr ad)
  "Remove from the tree the element pointed to by PTR and AD.  Return the element."
  `(cond
    ((eq ,ad 'car)
     (prog1
	 (car ,ptr)
       (setcar ,ptr (cadr ,ptr))
       (setcdr ,ptr (cddr ,ptr))))
    ((eq ,ad 'cadr)
     (prog1
	 (cadr ,ptr)
       (setcdr ,ptr (cddr ,ptr))))
    (t (error "fix-re--chop called with 'cdr"))))

(defmacro fix-re--insert (elt ptr ad)
  "Insert ELT into the tree, just before the element point to by PTR and AD."
  `(cond
    ((eq ,ad 'car)
     (progn
       (setcdr ,ptr (cons (car ,ptr) (cdr ,ptr)))
       (setcar ,ptr ,elt)))
    ((eq ,ad 'cadr)
     (setcdr ,ptr (cons ,elt (cdr ,ptr))))
    (t (error "fix-re--insert called with 'cdr"))))

(defun fix-re--insert-after (elt ptr ad)
  "Insert ELT into the tree, just after the element pointed to by PTR/AD."
  (cond
   ((eq ad 'car)
    (setcdr ptr (cons elt (cdr ptr))))
   ((eq ad 'cadr)
    (setcdr (cdr ptr) (cons elt (cddr ptr))))
   (t (error "fix-re--insert-after called with 'cdr"))))

(defmacro fix-re--chop-+* (ptr ad)
  "Change R+, R*, or R? to R.
PTR points to a cons like (* . R).  Change it to R."
  `(cond
    ;; Remember: we have a dotted list here like ('+ . ?a)
    ((eq ,ad 'car)
     (setcar ,ptr (cdar ,ptr)))
    ((eq ,ad 'cdr)
     (setcdr ,ptr (cddr ,ptr)))
    (t (setcar (cdr ,ptr) (cdadr ,ptr)))))

(defmacro fix-re--+*ify (sym ptr ad)
  "Change R to R+, R*, or R?, where SYM is '+, '*, or '?"
  `(cond
    ((eq ,ad 'car)
     (setcar ,ptr (cons ,sym (car ,ptr))))
    ((eq ,ad 'cdr)
     (setcdr ,ptr (cons ,sym (cdr ,ptr))))
    (t (setcar (cdr ,ptr) (cons ,sym (cadr ,ptr))))))

(defmacro fix-re--splice-list (lst ptr ad)
  "Splice the list LST into the tree, just before the element pointed to by
  PTR and AD."
  `(when ,lst
     (cond
      ((eq ,ad 'car)
       (progn
	 (setcdr ,ptr (append (cdr ,lst) (cons (car ,ptr) (cdr ,ptr))))
	 (setcar ,ptr (car ,lst))))
      ((eq ,ad 'cadr)
       (setcdr ,ptr (append ,lst (cdr ,ptr))))
      (t (error "fix-re--splice-list called with 'cdr")))))

(defmacro fix-re--chop-\( (ptr ad)
  "PTR AD points to a \( construct with only one alternative.  Remove the
\(..\) from it."
  (error "fix-re--chop-\( hasn't been tested yet!!!  FIXME!!!")
  `(cond
    ((eq ,ad 'car)
     (setcar ,ptr (caadar ,ptr)))
    ((eq ,ad 'cdr)
     (setcdr ,ptr (caaddr ,ptr)))
    (t (setcar (caadr (cadr ,ptr))))))

;; (defmacro fix-re--wrap-in-\( (sym ptr ad)
;;   "Transform R to \\(R\\), where R is the element pointed to by PTR and AD.
;; SYM is a valid symbol to open such an expression, such as '\\\(, '\\\(\?6: or
;; '|."
;;   `(cond
;;     ((eq ,ad 'car)
;;      (setcar ,ptr (list ,sym (list (car ,ptr)))))
;;     ((eq ,ad 'cdr)
;;      (setcdr ,ptr (list ,sym (list (cdr ,ptr)))))
;;     (t (setcar (cdr ,ptr) (list ,sym (list (cadr ,ptr)))))))

(defun fix-re--wrap-in-\( (sym ptr ad)
  "Transform R to \\(R\\), where R is the element pointed to by PTR and AD.
SYM is a valid symbol to open such an expression, such as '\\\(, '\\\(\?6: or
'|."
  (cond
   ((eq ad 'car)
    (setcar ptr (list sym (list (car ptr)))))
   ((eq ad 'cdr)
    (setcdr ptr (list sym (list (cdr ptr)))))
   (t (setcar (cdr ptr) (list sym (list (cadr ptr)))))))

(defun fix-re--wrap-list-in-\( (sym ptr ad)
  "PTR points to the first element of a list.  Wrap that list in \\(..\\),
  without adding an extra layer of parentheses."
  (cond
   ((eq ad 'car)
    (setcar ptr (list sym (cons (car ptr) (cdr ptr))))
    (setcdr ptr nil))
   ((eq ad 'cadr)
    (setcar (cdr ptr) (list sym (cons (cadr ptr) (cddr ptr))))
    (setcdr (cdr ptr) nil))
   (t (error "fix-re--wrap-list-in-\( was called with 'cdr"))))

(defmacro fix-re--setres (call)
  "Call CALL, and set `res' to t if the result is non-nil."
  `(if ,call (setq res t)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun fix-re--common-head-from-alts (e)
  "E is a tree element begining with \(, etc.  Calculate the common head of all subelements."
  (let* ((elts (cdr e))
	 (head (copy-tree (car elts)))
	 elt)
    (while (and (> (length elts) 1)
		head)
      (setq elts (cdr elts)
	    elt (car elts))
      (setq head (fix-re--common-head head elt)))
    head))

(defun fix-re--common-head (e0 e1)
  "E0 and E1 could be any type of element."
  (let (
	)
    (cond
     ((or (atom e0) (atom e1))
      (and (equal e0 e1) e0))
     ((and (fix-re--is-\( e0)
	   (eq (car e0) (car e1)))
      (let* ((e0-common (fix-re--common-head-from-alts e0))
	     (e1-common (fix-re--common-head-from-alts e1)))
	(cons (car e0)
	      (fix-re--common-head e0-common e1-common))))
     ((and (symbolp (car e0))
	   (eq (car e0) (car e1)))
      (and (equal e0 e1) e0))
     ((not (or (symbolp (car e0)) (symbolp (car e1))))
      (let (acc elt)
	(while
	    (and e0 e1
		 (setq elt (fix-re--common-head (car e0) (car e1)))
		 (equal elt (car e0)))
	  (push elt acc)
	  (setq elt nil)
	  (setq e0 (cdr e0)
		e1 (cdr e1)))
	(if elt (push elt acc))
	(nreverse acc)))
     (t nil))))

(defun fix-re--remove-head (head ptr)
  "Remove HEAD from front of element which is the cadr of PTR, returning the remains.
HEAD is a list of elements which are known to match the
head of ELT."
  (let ((elt (cadr ptr))
	)
    (while head
       (cond
	((equal (car head) (car elt))
	 (setq head (cdr head)  elt (cdr elt))
	 (fix-re--chop (cadr ptr) 'car))
	((fix-re--is-\( (car elt))
	 (mapc (lambda (e)
		 (fix-re--remove-head head e))
	       (cdar elt))
	 (setq head nil))
	(t (error "fix-re--remove-head: head = %s, ptr = %s" head ptr))))
    ))

(defun fix-re--RA|RB->R\(A|B\) (ptr ad in-alt)
  "Transform any \(RA\|RB\|RC\) into R\(A\|B\|C\), or
\(R\(?:A\|B\|C\)\).  FIXME!!! Correct this doc string, since *ptr
isn't necessarily an alternatives list.

Extract the head common to all the alternatives in the list which
is pointed to by PTR and AD, and insert it into the tree
structure before that list.  If IN-ALT is non-nil, additionally wrap the final
expression in \(..\).  (We need to do this when the enclosing tree element is
itself a \( construct.  Otherwise, rather than creating a sequence, we would
end up with alternatives.)

Return non-nil when a transformation was done, else nil."
  (let ((alt-list (fix-re--ptr-get ptr ad))
	)
    (when (and
	   (fix-re--is-\( alt-list)
	   (> (length alt-list) 2))	; i.e. the construct has a \|
      (let ((head (fix-re--common-head-from-alts alt-list))
	     (inner-ptr ptr)
	     (inner-ad ad)
	    )
	(when head
	  (mapl (lambda (elt-ptr)
		  (when (cdr elt-ptr)
		    (fix-re--remove-head head elt-ptr)))
		alt-list)
	  (when in-alt
	    (fix-re--wrap-in-\( (car alt-list) ptr ad)
	    (setcar alt-list '\\\(\?:)
	    (setq inner-ptr (cadar ptr))
	    (setq inner-ad 'car))
	  (fix-re--splice-list head inner-ptr inner-ad)
	  t
	  )))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun fix-re--R+R*->R+ (ptr ad)
  "Transform any R+R* to R+.
All combinations of +, *, and ? are handled.
Return 'shortened, t or nil.
...
"
  (if (eq ad 'cdr) (error "fix-re--R+R*->R+ got 'cdr"))
  (let ((e0 (if (eq ad 'car) (car ptr) (cadr ptr)))
	(e1 (if (eq ad 'car) (cadr ptr) (caddr ptr))))
    (when (and (consp e0) (consp e1))
      (let ((op0 (car e0))
	    (op1 (car e1))
	    ;; (link (if (eq ad 'car) (cddr ptr) (cdddr ptr)))
	    op
	    )
	(when
	    (and (memq op0 '(+ * \?))
		 (memq op1 '(+ * \?))
		 (equal (cdr e0) (cdr e1))) ; Both Rs are the same.
	  (cond
	   ((and (eq op0 '\?) (eq op1 '\?)) ; Cant combine R?R?
	    nil)
	   ((and (eq op0 '+) (eq op1 '+)) ; R+R+ -> RR+
	    (fix-re--chop-+* ptr 'car)
	    t)
	   (t
	    (setq op
		    (cond
		     ((or (eq op0 '+) (eq op1 '+)) '+)
		     ((or (eq op0 '*) (eq op1 '*)) '*)))
	    (setcar e0 op)
	    (fix-re--chop (if (eq ad 'car) ptr (cdr ptr)) 'cadr)
	    'shortened))
	  )))))

(defun fix-re--multi-R+R*->R+ (ptr ad)
  "Transform R+R*R?.... into R+.  PTR/AD point at the first R."
  (let (res result
	)
    (while
	(and (>= (length ptr) (if (eq ad 'car) 2 3))
	     (setq res (fix-re--R+R*->R+ ptr ad))
	     (if res (setq result t))
	     (eq res 'shortened)))
    result))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun fix-re--matches-empty-p (tree)
  "Return non-nil when the empty string matches TREE."
  (let (cur
	)
    (cond
     ((fix-re--is-\( tree)
      (or (null (cdr tree))
	  (progn
	    (setq cur (cdr tree))
	    (while (and cur
			(not (or
			      (null cur)
			      (fix-re--matches-empty-p (car cur)))))
	      (setq cur (cdr cur)))
	    cur)))
     ((atom tree)
      (not tree))
     ((memq (car tree) '(* \?)))
     ((eq (car tree) '+)
      (fix-re--matches-empty-p (cdr tree)))
     ((eq (car tree) '\[) nil)
     ((eq (car tree) ?\\) nil)
     (t					; Sequntial element.
      (setq cur tree)
      (while (and cur
		  (fix-re--matches-empty-p (car cur)))
	(setq cur (cdr cur)))
      (not cur)))))

(defun fix-re--de-emptify (ptr ad)
  "Destructively change PTR so that the tree it points to no longer matches the empty string,
but matches any non-empty string, and no others, that the original PTR did.

Expresssions like ^, $, \<, ...., which \"match the empty string\"
at particular places, are left unchanged."
  (let ((tree (fix-re--ptr-get ptr ad))
	cur cur-ptr cur-ad
	)
    (cond
     ((or
       (null tree)
       (atom tree)
       (memq (car tree) '(?\[))
       )
      nil)
     ((fix-re--is-\( tree)
      (setq cur-ptr tree
	    cur-ad 'car)
      (while (setq cur (fix-re--ptr-next cur-ptr cur-ad))
	(fix-re--de-emptify cur-ptr cur-ad))
      )
     ((eq (car tree) '+)
      (fix-re--de-emptify tree 'cdr))
     ((eq (car tree) '*)
      (fix-re--de-emptify tree 'cdr)
      (setcar tree '+))			; <-------
     ((eq (car tree) '\?)
      (fix-re--de-emptify tree 'cdr)
      (fix-re--chop-+* ptr ad))		; <-------
     ((eq (car tree) ?\\)
      nil)
     (t					; Sequential element.
      (when (fix-re--matches-empty-p tree) ; i.e. all elements match the empty string.
	(if (cdr tree)		      ; EF -> (EF <at> |E <at> ), (where E <at>  is de-emptified E).
	    (let ((new (list (copy-tree (car tree))))); E   EF
	      (fix-re--de-emptify new 'car)		      ; E <at>     EF
	      (fix-re--de-emptify tree 'cdr)		      ; E <at>     EF <at> 
	      (fix-re--wrap-list-in-\( '\\\(\?: tree 'car) ; E <at>     \(EF <at> \)
	      (setq tree (car (fix-re--ptr-get ptr ad)))
	      (fix-re--insert-after new tree 'cadr))       ; \(EF <at> \|E <at> \)
	  (fix-re--de-emptify tree 'car)))))))

(defun fix-re--do-R*ER*-transform (R0-ptr R0-ad empty0-ptr empty1-ptr R1-ptr)
  "Transformation R*ER* -> R*(E <at> R*)? or R*ER+ -> R*(E <at> R+|R).
Here, empty0/1-ad and R1-ad are always 'cadr, so we omit these from the
parameter list.
R0/R1-ptr point to the enclosing R*, R+ expressions,
empty0/1-ptr to the first and last expressions between them,
all of which match the empty string."
  (let* ((R0 (fix-re--ptr-get R0-ptr R0-ad))
	 (R0-R (cdr R0))
	 (R0-+* (car R0))
	 (R1-+* (car (fix-re--ptr-get R1-ptr 'cadr)))
	 new link
	 )
    ;; First "de-emptify" the empty expression sequence.
    (if (eq empty0-ptr empty1-ptr)
	;; Special case: just one empty matcher
	(fix-re--de-emptify empty0-ptr 'cadr)
      ;; General case: temporarily chop off the link on the last of
      ;; the list of empty matchers, so as to de-emptify them as a
      ;; sequence.
      (setq link (fix-re--bind-link-nil empty1-ptr 'cadr))
      (fix-re--de-emptify empty0-ptr 'cdr)
      (fix-re--restore-link link empty0-ptr 'cadr)
      ;; We've now lost R1-ptr.  Restore it.  The deemptification will have
      ;; left everything between empty0 and empty1 as a single list element.
      ;; So what now follows empty0 is R1.
      ;; We have also lost empty1-ptr, but we don't need it any more.
      (setq R1-ptr (cdr empty0-ptr)))	; R1-ad remains 'cadr.

    ;; Now transform according to whether we have R* or R+ or a mixture.
    ;; Do ER* -> (E <at> R*).
    ;; First set the link on R* to nil, to "terminate" the list.  This link
    ;; will be set on the newly formed \(..\) construct.
    (setq link (fix-re--bind-link-nil R1-ptr 'cadr))
    (fix-re--wrap-list-in-\( '\\\(\?: empty0-ptr 'cadr)
    ;; empty0-ptr/ad now points at the new \(..\).
    (fix-re--restore-link link empty0-ptr 'cadr)

    (if (eq R1-+* '*)
	;; Apply ? to \(..\) to give R*(E <at> R*)?
	(fix-re--+*ify '\? empty0-ptr 'cadr)
      ;; Change R*(E <at> R+) to R*(E <at> R+|R)
      (setq new (copy-tree R0-R))	; R   R*(E <at> R+)
      (fix-re--insert-after new (cadr empty0-ptr) 'cadr) ; R*(E <at> R+|R)
      )))

(defun fix-re--R+ER*->R+\(E <at> R*\)\? (ptr ad)
  "Do R+ER* -> R+(E <at> R*)? or R+ER+ -> R+(E <at> R+|R) on the whole list.
PTR/AD point at the first element of the sequential list.

Here, E is a non-empty sequence of elements which are matched by
the empty string, E <at>  is the \"de-emptified\" version of E."
  ;; We must perform the loop rightmost transformations first.  To see this,
  ;; consider R*ER*FR* done leftmost first.  The first transformation takes us
  ;; to R*(E <at> R*)?FR*.  We're now stuck, as the middle R* is no longer
  ;; "exposed" to the last R*, and the end expression is still ill-formed.
  ;; Done rightmost first, R*ER*FR* -> R*ER*(F <at> R*)? -> R*(E <at> R*)?(F <at> R*)?, which
  ;; is well-formed.
  (let (res)
    (let ((ptr ptr) (ad ad))
      (when (fix-re--ptr-next ptr ad)
	(setq res (fix-re--R+ER*->R+\(E <at> R*\)\? ptr ad))))

    (let* ((elt-ptr ptr)
	   (elt-ad ad)
	   (elt (fix-re--ptr-get elt-ptr elt-ad))
	   R0-R
	   empty0-ptr empty1-ptr R1-ptr	; No need for ..-ad's, since
					; these will always be 'cadr.
	   R1-+*
	   )
      (or
      ;; Isy `elt' R+ or R*?
       (when (and (consp elt)
		  (memq (car elt) '(+ *)))
	 (setq R0-R (cdr elt))
	 ;; Is the next element one matching the empty string, and which
	 ;; isn't R+ or R*?
	 (setq elt (fix-re--ptr-next elt-ptr elt-ad))
	 (when (and elt
		    (fix-re--matches-empty-p elt)
		    (not (and (consp elt)
			      (memq (car elt) '(+ *))
			      (equal (cdr elt) R0-R))))
	   (setq empty0-ptr elt-ptr ; Remember first empty. -ad is implicitly 'cadr
		 empty1-ptr elt-ptr )	; Remember last empty.
	   ;; Read the elements which match empty, but aren't R+ or R*.
	   (while (and (setq elt (fix-re--ptr-next elt-ptr elt-ad))
		       (fix-re--matches-empty-p elt)
		       (not (and (consp elt)
				 (memq (car elt) '(+ *))
				 (equal (cdr elt) R0-R))))
	     (setq empty1-ptr elt-ptr))
	   ;; Have we found the matching R+ or R*?
	   (when (and elt
		      (consp elt)
		      (memq (car elt) '(+ *))
		      (equal (cdr elt) R0-R))
	     ;; Yes.  We're in business.
	     (fix-re--do-R*ER*-transform ptr ad empty0-ptr empty1-ptr elt-ptr)
	     t)))
       res))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; R*(R*A|B) -> R*(A|B)
(defun fix-re--do-R+\(R*A|B\)-transform (R-rep alt)
  "Attempt a R+(R*A|B) -> R+(A|B) transformation.
R-REP is a cons representing either R+ or R*.  ALT represents a
form of the form \(..\|..\|...\).
"
  (let* ((R-R (cdr R-rep))
	 (R-+* (car R-rep))
	 (ptr alt)
	 (ad 'cadr) ; Point to the second elt. of the list, the first being '\\\(
	 (elt (fix-re--ptr-get ptr ad))
	 res car-elt elt-+*
	 )
    (while elt				; (R*A)
      (when (and (consp elt)		; This should always be true
		 (setq car-elt (car elt)) ; This is now R*A
		 (consp car-elt)
		 (memq (car car-elt) '(+ *))
		 (equal (cdr car-elt) R-R))
	(setq elt-+* (car car-elt))
	(if (eq elt-+* '*)
	    (fix-re--chop elt 'car)
	  (fix-re--chop-+* elt 'car))
	(setq res t))
      (setq elt (fix-re--ptr-next ptr ad)))
    res))
	

(defun fix-re--R+\(R*A|B\)->R*\(A|B\) (ptr ad)
  "Do the transition on every pertinent element pairs in the sequence.
PTR/AD point to the first element in the sequential list."
  (let ((elt (fix-re--ptr-get ptr ad))
	R-rep res)
    (while elt
      (if (and (consp elt)
	       (memq (car elt) '(+ *)))
	  (progn
	    (setq R-rep elt
		  elt (fix-re--ptr-next ptr ad))
	    (when (fix-re--is-\( elt)
	      (if (fix-re--do-R+\(R*A|B\)-transform R-rep elt)
		  (setq res t))
	      (setq elt (fix-re--ptr-next ptr ad))))
	(setq elt (fix-re--ptr-next ptr ad))))
    res))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Top level AST transformation routines.
(defun fix-re--transform (ptr ad in-alt)
  "Transform the expression pointed at by PTR/AD.  Return non-nil when we did something.
IN-ALT is non-zero iff the expression is directly contained in \(..\)."
  (let ((e (fix-re--ptr-get ptr ad))
	cur res cur-ptr cur-ad
	)

    (when (and (consp e)
	       (not (eq (car e) ?\[))  ; character alternative, nothing to do.
	       (not (eq (car e) ?\e))) ; escape pair/triple, nothing to do.
      ;; First recurse on all subexpressions
      (cond
       ((fix-re--is-\( e)
	(setq cur e)
	(while (cdr cur)
	  (fix-re--setres (fix-re--transform cur 'cadr t))
	  (setq cur (cdr cur))))
       ((symbolp (car e))		; +, *, ?.
	(fix-re--setres (fix-re--transform e 'cdr nil)))
       (t				; Sequential list.
	(fix-re--setres (fix-re--transform e 'car nil))
	(setq cur e)
	(while (cdr cur)
	  (fix-re--setres (fix-re--transform cur 'cadr nil))
	  (setq cur (cdr cur)))))

      ;; Now operate on the supplied list.
      (cond
       ((fix-re--is-\( e)
	;; Extract any common head from inside \(..\).
	;; We're sending in a pointer to e to fix-re--RA|RB...
	(fix-re--setres (fix-re--RA|RB->R\(A|B\) ptr ad in-alt))
	)
       ((symbolp (car e))		; +, *, ?
	)				; Nothing to do here - 
       (t				; Sequential list.
	(setq cur-ptr e  cur-ad 'car)
	(while
	    (progn
	      (fix-re--setres (fix-re--multi-R+R*->R+ cur-ptr cur-ad))
	      (fix-re--ptr-next cur-ptr cur-ad)))
	(setq cur-ptr e  cur-ad 'car)
	(fix-re--setres (fix-re--R+ER*->R+\(E <at> R*\)\? e 'car))
	(fix-re--setres (fix-re--R+\(R*A|B\)->R*\(A|B\) e 'car)))))
	
    res))

(defun fix-re--transform-AST (tree)
  "The top-level transformation function.  TREE will have '| as its car.
Return the transformed (or newly expanded) tree.
"
   (let ((ptr (list tree)))
     (fix-re--transform ptr 'car t)))
	

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Entry point routines.
(defun fix-re-test (re)
  "Attempt to fix the regexp RE.
If no fix is needed, return nil, otherwise return the fixed
regexp.

Note: this function doesn't touch the cache `fix-re--cache'."
  (string-match re "")			; Throw an error if re is invalid.
  (let* ((ast (fix-re--build-AST re)))
    (and (fix-re--transform-AST ast)
	 (fix-re--dump-AST ast))))

(defcustom fix-re-cache-limit 40
  "Maximum number of entries in the cache for `fix-re'."
  :type 'integer
  :group 'isearch)
(defvar fix-re--cache-overflowed nil
  "Non-nil when the association list `fix-re--cache' has overflowed its size limit `fix-re--cache-limit'")
(defvar fix-re--cache nil
  "An association list linking input regexps with fixed regexps.
The key of each element is the input regexp.  The value is nil if the key
regexp is OK, otherwise it's the replacement regexp.")

(defun fix-re (re)
  "Check the regexp RE for certain solecisms, and if any are found, fix them.
Return the fixed regexp, if a fix was done, otherwise RE.

Regexps passed to `fix-re' for the first time are inserted into a
cache `fix-re--cache', so that calling `fix-re' repeatedly with an
argument is fast.  The limit on `fix-re--cache''s size is the
configurable option `fix-re-cache-limit'.

The typical errors corrected are ......  FIXME!!!

If any fixes were needed, return the fixed regexp, otherwise return RE."
  (let ((elt (assoc re fix-re--cache)) fix)
    (if elt
	(progn
	  (unless (eq elt (car fix-re--cache))
	    (setq fix-re--cache (delq elt fix-re--cache))
	    (push elt fix-re--cache))
	  (or (cdr elt) re))
      (setq fix (fix-re-test re))
      (when (> (length fix-re--cache) (max fix-re-cache-limit 1))
	(or fix-re--cache-overflowed (setq fix-re--cache-overflowed re))
	(setq fix-re--cache (butlast fix-re--cache)))
      (push (cons re fix) fix-re--cache)
      (or fix re))))
Stefan Monnier | 23 Feb 05:44 2015
Picon

save-excursion and the mark


`save-excursion' is defined to save&restore the mark (as well as its
being active or not).

But I'm having a hard time finding a piece of code where we actually
make use of this.  Can someone point me to such code (either in Emacs or
in some external package)?  I.e. point me to code which would misbehave
if save-excursion were to stop saving&restoring the mark (and/or its
activation status).

        Stefan

raman | 22 Feb 17:31 2015
Picon

widget type: command?

I  was surprized to see that in the predefined widget types  we dont
appear to have something for use to  typecheck  user input  for
"interactive-command" -- we have 'function and 'symbol.

I added this to emacspeak -- but it might be nice to get it into
wid-edit with a suitable renaming.
(defun emacspeak-keymap-command-p (s)
  "Check if `s' is suitable to be bound to a key."
  (or (commandp s) (keymapp s)))
;;; rename to either 'command or 'interactive-command 
(define-widget 'ems-interactive-command 'restricted-sexp
  "An interactive command."
  :completions
  (apply-partially #'completion-table-with-predicate obarray 'emacspeak-keymap-command-p 'strict)
  :prompt-value 'widget-field-prompt-value
  :prompt-internal 'widget-symbol-prompt-internal
  :prompt-match 'emacspeak-keymap-command-p
  :prompt-history 'widget-function-prompt-value-history
  :action 'widget-field-action
  :match-alternatives '(emacspeak-keymap-command-p)
  :validate (lambda (widget)
              (unless (emacspeak-keymap-command-p (widget-value widget))
                (widget-put widget :error (format "Invalid interactive command : %S"
                                                  (widget-value widget)))
                widget))
  :value 'ignore
  :tag "Interactive Command")


Gmane