Package: emacs;
Reported by: "Drew Adams" <drew.adams <at> oracle.com>
Date: Fri, 6 May 2011 00:31:02 UTC
Severity: wishlist
Found in version 24.0.50
Done: Chong Yidong <cyd <at> stupidchicken.com>
Bug is archived. No further changes may be made.
Message #42 received at 8628 <at> debbugs.gnu.org (full text, mbox):
From: "Drew Adams" <drew.adams <at> oracle.com> To: "'Chong Yidong'" <cyd <at> stupidchicken.com> Cc: 8628 <at> debbugs.gnu.org Subject: RE: bug#8628: 24.0.50; `thing-at-point-bounds-of-list-at-point' - no good Date: Fri, 8 Jul 2011 17:10:54 -0700
FWIW, you can find new definitions of the list-at-point functions, which work
correctly, in my library thingatpt+.el:
http://www.emacswiki.org/emacs/download/thingatpt%2b.el
The definitions are general.
They handle correctly all cases; i.e., where point is:
a. within a list,
b. just after/before or at a list end/beginning, and
c. outside any list.
They return the non-nil list in (a) and (b), and nil in (c).
For the current question, which concerns (bounds-of-thing-at-point 'list), this
is the code I use, in case you want to test:
(put 'list 'bounds-of-thing-at-point 'bounds-of-list-at-point)
(defun bounds-of-list-at-point (&optional up unquotedp)
"Return (START . END), boundaries of the `list-at-point'.
Return nil if no non-empty list is found.
UP (default: 0) is the number of list levels to go up to start with.
Non-nil UNQUOTEDP means remove the car if it is `quote' or
`backquote-backquote-symbol'."
(let ((thing+bds (list-at-point-with-bounds up unquotedp)))
(and thing+bds (cdr thing+bds))))
(defun list-at-point-with-bounds (&optional up unquotedp)
"Return (LIST START . END), boundaries of the `list-at-point'.
Return nil if no non-empty list is found.
UP (default: 0) is the number of list levels to go up to start with.
Non-nil UNQUOTEDP means remove the car if it is `quote' or
`backquote-backquote-symbol'."
(list-at/nearest-point-with-bounds
'sexp-at-point-with-bounds up unquotedp))
(defun list-at/nearest-point-with-bounds (at/near &optional up unquotedp)
"Helper for `list-at-point-with-bounds' and similar functions.
AT/NEAR is a function called to grab the initial list and its bounds.
UP (default: 0) is the number of list levels to go up to start with.
Non-nil UNQUOTEDP means remove the car if it is `quote' or
`backquote-backquote-symbol'.
Return (LIST START . END) with START and END of the LIST.
Return nil if no non-empty list is found."
(save-excursion
(unless (eq at/near 'sexp-at-point-with-bounds)
(cond ((looking-at "\\s-*\\s(") (skip-syntax-forward "-"))
((looking-at "\\s)\\s-*") (skip-syntax-backward "-"))))
(let ((sexp+bnds (funcall at/near)))
(condition-case nil ; Handle an `up-list' error.
(progn
(when up
(up-list (- up))
(setq sexp+bnds (sexp-at-point-with-bounds)))
(while (not (consp (car sexp+bnds)))
(up-list -1)
(setq sexp+bnds (sexp-at-point-with-bounds)))
(when (and unquotedp (consp (car sexp+bnds))
(memq (caar sexp+bnds)
(list backquote-backquote-symbol 'quote)))
(cond ((eq 'quote (caar sexp+bnds))
(setq sexp+bnds
(cons (cadr (car sexp+bnds))
(cons (+ 5 (cadr sexp+bnds))
(cddr sexp+bnds)))))
((eq backquote-backquote-symbol (caar sexp+bnds))
(setq sexp+bnds (cons (cadr (car sexp+bnds))
(cons (+ 1 (cadr sexp+bnds))
(cddr sexp+bnds)))))))
(while (not (consp (car sexp+bnds)))
(up-list -1)
(setq sexp+bnds (sexp-at-point-with-bounds))))
(error (setq sexp+bnds nil)))
sexp+bnds)))
(defun sexp-at-point-with-bounds (&optional pred syntax-table)
"Return (SEXP START . END), boundaries of the `sexp-at-point'.
Return nil if no sexp is found.
Optional args are the same as for `form-at-point-with-bounds'."
(form-at-point-with-bounds 'sexp pred syntax-table))
(defun form-at-point-with-bounds (&optional thing pred syntax-table)
"Return (FORM START . END), START and END the char positions of FORM.
FORM is the `form-at-point'. Return nil if no form is found.
Optional arguments:
THING is the kind of form desired (default: `sexp').
PRED is a predicate that THING must satisfy to qualify.
SYNTAX-TABLE is a syntax table to use."
(condition-case nil ; E.g. error if tries to read `.'.
(let* ((thing+bds (thing-at-point-with-bounds
(or thing 'sexp) syntax-table))
(bounds (cdr thing+bds))
(sexp (and bounds (read-from-whole-string
(car thing+bds)))))
(and bounds (or (not pred) (funcall pred sexp))
(cons sexp bounds)))
(error nil)))
(defun thing-at-point-with-bounds (thing &optional syntax-table)
"Return (THING START . END) with START and END of THING.
Return nil if no such THING is found.
THING is the `thing-at-point' (which see).
START and END are the car and cdr of the `bounds-of-thing-at-point'.
SYNTAX-TABLE is a syntax table to use."
(let ((bounds (bounds-of-thing-at-point thing syntax-table)))
(and bounds
(cons (buffer-substring (car bounds) (cdr bounds)) bounds))))
(defun bounds-of-thing-at-point (thing &optional syntax-table)
"Determine the start and end buffer locations for the THING at point.
Return a consp `(START . END)' giving the START and END positions,
where START /= END. Return nil if no such THING is found.
THING is an entity for which there is a either a corresponding
`forward-'THING operation, or corresponding `beginning-of-'THING and
`end-of-'THING operations. THING examples include `word', `sentence',
`defun'.
SYNTAX-TABLE is a syntax table to use.
See the commentary of library `thingatpt.el' for how to define a
symbol as a valid THING."
(if syntax-table
(let ((buffer-syntax (syntax-table)))
(unwind-protect
(progn (set-syntax-table syntax-table)
(bounds-of-thing-at-point-1 thing))
(set-syntax-table buffer-syntax)))
(bounds-of-thing-at-point-1 thing)))
;; This is the original `bounds-of-thing-at-point',
;; but with bug #8667 fixed.
(defun bounds-of-thing-at-point-1 (thing)
"Helper for `bounds-of-thing-at-point'.
Do all except handle the optional SYNTAX-TABLE arg."
(if (get thing 'bounds-of-thing-at-point)
(funcall (get thing 'bounds-of-thing-at-point))
(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))))
(funcall (or (get thing 'beginning-op) ; Move to beg.
(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))))
(and (<= orig real-end) (< beg real-end)
(cons beg real-end)))
(goto-char orig)
;; Try a second time, moving first backward 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))))
(funcall (or (get thing 'end-op) ; Move to end.
(lambda () (forward-thing thing 1))))
(let ((end (point))
(real-beg (progn
(funcall
(or (get thing 'beginning-op)
(lambda ()
(forward-thing thing -1))))
(point))))
(and (<= real-beg orig) (<= orig end) (< real-beg end)
(cons real-beg end))))))
(error nil)))))
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.