bug#9454: 24.0.50; thingatpt.el should be updated to respect field boundaries

[Drew Adams <drew.adams@oracle.com>]

[-- Attachment #1: Type: text/plain, Size: 786 bytes --]

> Do you have a test case to reproduce this bug?

No.

See the original report.  It points you to my
code that fixes the problem by sprinkling
`constrain-to-field' everywhere.

To give an idea, attached are two functions,
my version and the vanilla version.  Ediff
them.  See the additions of this:

 (constrain-to-field nil orig)

I believe that the vanilla function needs
similar protection.  For you to decide.

That's just one thingatpt.el function.  I
also added `constraint-to-field to other
such functions.

See thingatpt+.el if you want to see the
occurrences, to maybe save some time when
checking where thingatpt.el might need the
same treatment.

I think you get the idea.  Thing-at-point
should respect fields.  Do it or don't do
it; your choice.

[-- Attachment #2: throw-my-thg.el --]
[-- Type: application/octet-stream, Size: 2701 bytes --]

(defun tap-bounds-of-thing-at-point-1 (thing)
  "Helper for `tap-bounds-of-thing-at-point'.
Do everything except handle the optional SYNTAX-TABLE arg."
  (let ((bounds-fn  (or (get thing 'tap-bounds-of-thing-at-point)
                        (get thing 'bounds-of-thing-at-point))))
    (if bounds-fn
        (funcall bounds-fn)
      (let ((orig  (point)))
        (condition-case nil
            (save-excursion
              ;; Try moving forward, then back.
              (funcall (or (get thing 'end-op) ; Move to end.
                           (lambda () (forward-thing thing 1))))
              (constrain-to-field nil orig)
              (funcall (or (get thing 'beginning-op) ; Move to beg.
                           (lambda () (forward-thing thing -1))))
              (constrain-to-field nil orig)
              (let ((beg  (point)))
                (if (<= beg orig)
                    ;; If that brings us all the way back to ORIG,
                    ;; it worked.  But END may not be the real end.
                    ;; So find the real end that corresponds to BEG.
                    ;; FIXME: in which cases can `real-end' differ from `end'?
                    (let ((real-end  (progn (funcall
                                             (or (get thing 'end-op)
                                                 (lambda () (forward-thing thing 1))))
                                            (constrain-to-field nil orig)
                                            (point))))
                      (and (< orig real-end)  (< beg real-end)
                           (cons beg real-end)))
                  (goto-char orig)
                  ;; Try a second time, moving first backward and then forward,
                  ;; so that we can find a thing that ends at ORIG.
                  (funcall (or (get thing 'beginning-op) ; Move to beg.
                               (lambda () (forward-thing thing -1))))
                  (constrain-to-field nil orig)
                  (funcall (or (get thing 'end-op) ; Move to end.
                               (lambda () (forward-thing thing 1))))
                  (constrain-to-field nil orig)
                  (let ((end       (point))
                        (real-beg  (progn (funcall
                                           (or (get thing 'beginning-op)
                                               (lambda () (forward-thing thing -1))))
                                          (constrain-to-field nil orig)
                                          (point))))
                    (and (<= real-beg orig)  (< orig end)  (< real-beg end)
                         (cons real-beg end))))))
          (error nil))))))

[-- Attachment #3: throw-vanilla-thg.el --]
[-- Type: application/octet-stream, Size: 2034 bytes --]

(defun bounds-of-thing-at-point (thing)
  "Determine the start and end buffer locations for the THING at point.
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
`filename', `url', `email', `word', `sentence', `whitespace',
`line', and `page'.

See the file `thingatpt.el' for documentation on how to define a
valid THING.

Return a cons cell (START . END) giving the start and end
positions of the thing found."
  (if (get thing 'bounds-of-thing-at-point)
      (funcall (get thing 'bounds-of-thing-at-point))
    (let ((orig (point)))
      (ignore-errors
	(save-excursion
	  ;; Try moving forward, then back.
	  (funcall ;; First move to end.
	   (or (get thing 'end-op)
	       (lambda () (forward-thing thing 1))))
	  (funcall ;; Then move to beg.
	   (or (get thing 'beginning-op)
	       (lambda () (forward-thing thing -1))))
	  (let ((beg (point)))
	    (if (<= beg orig)
		;; If that brings us all the way back to ORIG,
		;; it worked.  But END may not be the real end.
		;; So find the real end that corresponds to BEG.
		;; FIXME: in which cases can `real-end' differ from `end'?
		(let ((real-end
		       (progn
			 (funcall
			  (or (get thing 'end-op)
			      (lambda () (forward-thing thing 1))))
			 (point))))
		  (when (and (<= orig real-end) (< beg real-end))
		    (cons beg real-end)))
	      (goto-char orig)
	      ;; Try a second time, moving backward first and then forward,
	      ;; so that we can find a thing that ends at ORIG.
	      (funcall ;; First, move to beg.
	       (or (get thing 'beginning-op)
		   (lambda () (forward-thing thing -1))))
	      (funcall ;; Then move to end.
	       (or (get thing 'end-op)
		   (lambda () (forward-thing thing 1))))
	      (let ((end (point))
		    (real-beg
		     (progn
		       (funcall
			(or (get thing 'beginning-op)
			    (lambda () (forward-thing thing -1))))
		       (point))))
		(if (and (<= real-beg orig) (<= orig end) (< real-beg end))
		    (cons real-beg end))))))))))