Download
(require 'thingatpt)
(defgroup thing-at-point-plus nil
"Enhancements to `thingatpt.el'."
:prefix "tap-" :group 'applications :group 'development :group 'help
:link `(url-link :tag "Send Bug Report"
,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
Thingatpt+ bug: \
&body=Describe bug here, starting with `emacs -Q'. \
Don't forget to mention your Emacs and library versions."))
:link '(url-link :tag "Download" "http://www.emacswiki.org/thingatpt+.el")
:link '(url-link :tag "Description" "http://www.emacswiki.org/ThingAtPointPlus")
:link '(emacs-commentary-link :tag "Commentary" "thingatpt+"))
(defcustom tap-near-point-x-distance 50
"*Maximum number of characters from point to search, left and right.
Used typically by functions that invoke
`tap-thing/form-nearest-point-with-bounds', and which provide default
text for minibuffer input. Such functions can also ignore or override
this setting temporarily."
:type 'integer :group 'thing-at-point-plus :group 'minibuffer)
(defcustom tap-near-point-y-distance 5
"*Maximum number of lines from point to search, up and down.
To constrain search to the same line as point, set this to zero.
Used typically by functions that invoke
`tap-thing/form-nearest-point-with-bounds', and which provide default
text for minibuffer input. Such functions can also ignore or override
this setting temporarily."
:type 'integer :group 'thing-at-point-plus :group 'minibuffer)
(unless (fboundp 'constrain-to-field) (defun constrain-to-field (&rest _ignore) (point)))
(unless (fboundp 'field-beginning) (defalias 'field-beginning (symbol-function 'ignore)))
(unless (fboundp 'field-end) (defalias 'field-end (symbol-function 'ignore)))
(if (fboundp 'string-match-p)
(defalias 'tap-string-match-p 'string-match-p)
(defun tap-string-match-p (regexp string &optional start)
"Like `string-match', but this saves and restores the match data."
(save-match-data (string-match regexp string start))))
(if (fboundp 'looking-at-p)
(defalias 'tap-looking-at-p 'looking-at-p)
(defun tap-looking-at-p (regexp)
"Like `looking-at', but this saves and restores the match data."
(save-match-data (looking-at regexp))))
(defun tap-looking-back-p (regexp &optional limit greedy)
"Like `looking-back', but this does not change the match data."
(save-match-data
(let ((start (point))
(pos (save-excursion
(and (re-search-backward
(if (> emacs-major-version 21)
(concat "\\(?:" regexp "\\)\\=")
(concat "\\(" regexp "\\)\\="))
limit t)
(point)))))
(if (and greedy pos)
(save-restriction
(narrow-to-region (point-min) start)
(while (and (> pos (point-min))
(save-excursion (goto-char pos)
(backward-char 1)
(tap-looking-at-p
(if (> emacs-major-version 21)
(concat "\\(?:" regexp "\\)\\'")
(concat "\\(" regexp "\\)\\'")))))
(setq pos (1- pos)))
(save-excursion (goto-char pos)
(tap-looking-at-p
(if (> emacs-major-version 21)
(concat "\\(?:" regexp "\\)\\'")
(concat "\\(" regexp "\\)\\'"))))))
(not (null pos)))))
(defun tap-bounds-of-thing-at-point (thing &optional syntax-table)
"Return the start and end locations for the THING at point.
Return a consp (START . END), where START /= END.
Return nil if no THING is found.
THING is an Emacs Lisp symbol that specifies a type of syntactic
entity. THING examples include `word', `sentence', `defun'. See the
commentary of library `thingatpt.el' for how to define a symbol as a
valid THING.
Optional arg SYNTAX-TABLE is a syntax table to use."
(if syntax-table
(let ((buffer-syntax (syntax-table)))
(unwind-protect
(progn (set-syntax-table syntax-table)
(tap-bounds-of-thing-at-point-1 thing))
(set-syntax-table buffer-syntax)))
(tap-bounds-of-thing-at-point-1 thing)))
(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
(funcall (or (get thing 'end-op)
(lambda () (forward-thing thing 1))))
(constrain-to-field nil orig)
(funcall (or (get thing 'beginning-op)
(lambda () (forward-thing thing -1))))
(constrain-to-field nil orig)
(let ((beg (point)))
(if (<= beg orig)
(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)
(funcall (or (get thing 'beginning-op)
(lambda () (forward-thing thing -1))))
(constrain-to-field nil orig)
(funcall (or (get thing 'end-op)
(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))))))
(defun tap-thing-at-point-with-bounds (thing &optional syntax-table)
"Return the thing of type THING at point, plus its bounds.
Return nil if no such thing is found.
If found, return a cons (THE-THING START . END), where THE-THING is
the `tap-thing-at-point', a string. START and END are the buffer
positions of THE-THING.
See `tap-bounds-of-thing-at-point'.
Optional arg SYNTAX-TABLE is a syntax table to use."
(let ((bounds (tap-bounds-of-thing-at-point thing syntax-table)))
(and bounds (cons (buffer-substring (car bounds) (cdr bounds)) bounds))))
(defun tap-thing-at-point (thing &optional syntax-table)
"Return the THING at point as a string.
If no THING is present at point then return nil.
THING is an Emacs Lisp symbol that specifies a type of syntactic
entity. THING examples include `word', `sentence', `defun'. See the
commentary of library `thingatpt.el' for how to define a symbol as a
valid THING.
If THING has property `thing-at-point' then the property value should
be a function. The function is called with no arguments. If the
return value of that function is a string or nil then that value is
returned by this function also. Otherwise, that value is converted to
a string and returned.
Optional arg SYNTAX-TABLE is a syntax table to use."
(let ((thing-fn (or (get thing 'tap-thing-at-point) (get thing 'thing-at-point))))
(if thing-fn
(let* ((opoint (point))
(thg (prog1 (funcall thing-fn)
(constrain-to-field nil opoint))))
(if (stringp thg)
thg
(and thg (format "%s" thing))))
(let ((bounds (tap-bounds-of-thing-at-point thing syntax-table)))
(and bounds (buffer-substring (car bounds) (cdr bounds)))))))
(defun tap-thing-nearest-point-with-bounds (thing &optional syntax-table)
"Return the THING nearest point, plus its bounds: (THING START . END).
Return nil if no such THING is found.
THING is the `tap-thing-nearest-point', a string.
START and END are the buffer positions of THING - see
`tap-bounds-of-thing-nearest-point'.
Optional arg SYNTAX-TABLE is a syntax table to use."
(tap-thing/form-nearest-point-with-bounds #'tap-thing-at-point-with-bounds
thing nil syntax-table))
(defun tap-thing/form-nearest-point-with-bounds (fn thing predicate syntax-table)
"Thing or form nearest point, plus bounds: (THING-OR-FORM START . END).
Helper for `tap-thing-nearest-point-with-bounds'
and `tap-form-nearest-point-with-bounds'.
FN is a function returning a thing or a form at point, and its bounds.
Other args are as for `tap-thing-nearest-point-with-bounds'."
(let ((opoint (point)))
(let ((f-or-t+bds (prog1 (if predicate
(funcall fn thing predicate syntax-table)
(funcall fn thing syntax-table))
(constrain-to-field nil opoint)))
(ind1 0)
(ind2 0)
(updown 1)
(bobp (or (eq (field-beginning nil) (point)) (bobp)))
(eobp (or (eq (field-end nil) (point)) (eobp)))
(bolp (or (eq (field-beginning nil) (point)) (bolp)))
(eolp (or (eq (field-end nil) (point)) (eolp)))
(max-x (abs tap-near-point-x-distance))
(max-y (if (zerop (save-excursion
(goto-char (point-max))
(prog1 (forward-line -1)
(constrain-to-field nil opoint))))
(abs tap-near-point-y-distance)
1)))
(while (and (<= ind2 max-y) (not f-or-t+bds) (not (and bobp eobp)))
(setq updown (- updown))
(save-excursion
(when (> max-y 1)
(condition-case ()
(prog1 (previous-line (* updown ind2))
(constrain-to-field nil opoint))
(beginning-of-buffer (setq bobp t))
(end-of-buffer (setq eobp t))
(error nil)))
(unless (or (and bobp (> (* updown ind2) 0))
(and eobp (< updown 0)))
(setq f-or-t+bds (prog1 (if predicate
(funcall fn thing predicate syntax-table)
(funcall fn thing syntax-table))
(constrain-to-field nil opoint))
bolp (or (eq (field-beginning nil) (point)) (bolp))
eolp (or (eq (field-end nil) (point)) (eolp))
ind1 0)
(save-excursion
(while (and (not (and bolp eolp)) (<= ind1 max-x) (not f-or-t+bds))
(unless bolp (save-excursion
(setq bolp (prog1 (forward-char-same-line (- ind1))
(constrain-to-field nil opoint))
f-or-t+bds (if predicate
(funcall fn thing predicate syntax-table)
(funcall fn thing syntax-table)))
(constrain-to-field nil opoint)))
(unless (or f-or-t+bds eolp)
(save-excursion
(setq eolp (prog1 (forward-char-same-line ind1)
(constrain-to-field nil opoint))
f-or-t+bds (if predicate
(funcall fn thing predicate syntax-table)
(funcall fn thing syntax-table)))
(constrain-to-field nil opoint)))
(setq ind1 (1+ ind1)))
(setq bobp (or (eq (field-beginning nil) (point))
(bobp)
(< max-y 2))
eobp (or (eq (field-end nil) (point))
(eobp)
(< max-y 2))))))
(when (and (> max-y 1) (or (< updown 0) (zerop ind2)))
(setq ind2 (1+ ind2))))
f-or-t+bds)))
(defun tap-bounds-of-thing-nearest-point (thing &optional syntax-table)
"Return the start and end locations for the THING nearest point.
See `tap-thing-nearest-point'.
Return a consp (START . END), where START /= END.
Return nil if no such THING is found.
Optional arg SYNTAX-TABLE is a syntax table to use."
(let ((thing+bds (tap-thing-nearest-point-with-bounds thing syntax-table)))
(and thing+bds
(cdr thing+bds))))
(defun tap-thing-nearest-point (thing &optional syntax-table)
"Return the THING nearest point, if any, else nil.
See also `tap-thing-at-point'.
\"Nearest\" to point is determined as follows:
The nearest THING on the same line is returned, if there is any.
Between two THINGs equidistant from point on the same line, the
leftmost is considered nearer.
Otherwise, neighboring lines are tried in sequence:
previous, next, 2nd previous, 2nd next, 3rd previous, 3rd next, etc.
This means that between two THINGs equidistant from point in
lines above and below it, the THING in the line above point
(previous Nth) is considered nearer to it.
However, for some THINGs whitespace between THINGs might be considered
insignificant, as well as the amount of it. This means that if point
is between two THINGs and surrounded by whitespace then the \"nearest\"
THING returned might not be the one that is absolutely closest.
Optional arg SYNTAX-TABLE is a syntax table to use."
(let ((thing+bds (tap-thing-nearest-point-with-bounds thing syntax-table)))
(and thing+bds
(car thing+bds))))
(defun tap-form-at-point-with-bounds (&optional thing predicate syntax-table)
"Return the Lisp THING at point, plus its bounds: (FORM START . END).
Return nil if no form is found.
THING must be readable as a Lisp entity, to give FORM - see
`tap-form-at-point'.
START and END are the buffer positions of FORM.
Optional args:
THING is the kind of form desired (default: `sexp').
PREDICATE is a predicate that the form must satisfy to qualify.
SYNTAX-TABLE is a syntax table to use."
(condition-case nil
(let* ((thing+bds (tap-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 predicate) (funcall predicate sexp))
(cons sexp bounds)))
(error nil)))
(defun tap-sexp-at-point-with-bounds (&optional predicate syntax-table)
"Return the sexp at point, plus its bounds: (SEXP START . END)
Return nil if no sexp is found.
SEXP is an Emacs Lisp entity, the result of reading the textual sexp
at point. See `sexp-at-point'.
START and END are the buffer positions of SEXP.
Optional args are the same as for `tap-form-at-point-with-bounds'."
(tap-form-at-point-with-bounds 'sexp predicate syntax-table))
(defun tap-bounds-of-form-at-point (&optional thing predicate syntax-table)
"Return the start and end locations for the THING at point.
THING must be readable as a Lisp entity - see `tap-form-at-point'.
Return a consp (START . END), where START /= END.
Return nil if no such THING is found.
Optional args:
THING is the kind of form desired (default: `sexp').
PREDICATE is a predicate that the form must satisfy to qualify.
SYNTAX-TABLE is a syntax table to use."
(let ((form+bds (tap-form-at-point-with-bounds thing predicate syntax-table)))
(and form+bds
(cdr form+bds))))
(defun tap-bounds-of-sexp-at-point (&optional predicate syntax-table)
"Return the start and end locations for the sexp at point.
SEXP is an Emacs Lisp entity, the result of reading the textual sexp
at point. See `sexp-at-point'.
Return a consp (START . END), where START /= END.
Return nil if no sexp is found.
Optional args are the same as for `tap-bounds-of-form-at-point'."
(tap-bounds-of-form-at-point 'sexp predicate syntax-table))
(defun tap-form-at-point (&optional thing predicate syntax-table)
"Return the form at point, if any, else nil.
This is an Emacs Lisp entity, not necessarily a string. THING must be
readable as a Lisp entity, or else nil is returned.
Reading THING and returning the resulting Lisp entity is the main
difference between this function and `tap-thing-at-point'. The other
difference is the use of PREDICATE.
Optional args:
THING is the kind of form desired (default: `sexp').
PREDICATE is a predicate that the form must satisfy to qualify.
SYNTAX-TABLE is a syntax table to use."
(let ((form (condition-case nil
(read-from-whole-string (tap-thing-at-point (or thing 'sexp) syntax-table))
(error nil))))
(and (or (not predicate) (funcall predicate form))
form)))
(defun tap-form-nearest-point-with-bounds (&optional thing predicate syntax-table)
"Return the form nearest point, plus its bounds: (FORM START . END).
Return nil if no form is found.
FORM is from `tap-form-nearest-point'.
START and END are the buffer positions of FORM.
Optional args:
THING is the kind of form desired (default: `sexp').
PREDICATE is a predicate that the form must satisfy to qualify.
SYNTAX-TABLE is a syntax table to use."
(tap-thing/form-nearest-point-with-bounds #'tap-form-at-point-with-bounds
thing predicate syntax-table))
(defun tap-sexp-nearest-point-with-bounds (&optional predicate syntax-table)
"Return the sexp nearest point, plus its bounds: (SEXP START . END).
Return nil if no sexp is found.
SEXP is an Emacs Lisp entity, the result of reading a textual sexp
near point. See `tap-sexp-nearest-point'.
START and END are the buffer positions of SEXP.
Optional args are the same as for
`tap-form-nearest-point-with-bounds'."
(tap-form-nearest-point-with-bounds 'sexp predicate syntax-table))
(defun tap-bounds-of-form-nearest-point (&optional thing predicate syntax-table)
"Return the start and end locations for the THING nearest point.
See `tap-form-nearest-point'.
Return a consp (START . END), where START /= END.
Return nil if no form is found.
Optional args are the same as for
`tap-form-nearest-point-with-bounds'."
(let ((form+bds (tap-form-nearest-point-with-bounds thing predicate syntax-table)))
(and form+bds
(cdr form+bds))))
(defun tap-bounds-of-sexp-nearest-point (&optional predicate syntax-table)
"Return the start and end locations for the sexp nearest point.
See `tap-sexp-nearest-point'.
Return a consp (START . END), where START /= END.
Return nil if no form is found.
Optional args are the same as for `tap-bounds-of-sexp-nearest-point'."
(tap-bounds-of-form-nearest-point 'sexp predicate syntax-table))
(defun tap-form-nearest-point (&optional thing predicate syntax-table)
"Return the form nearest point, if any, else nil.
This is an Emacs Lisp entity, not necessarily a string. THING must be
readable as a Lisp entity, or else nil is returned.
Reading THING and returning the resulting Lisp entity is the main
difference between this function and `tap-thing-nearest-point'. The
other difference is the use of PREDICATE.
Optional args:
THING is the kind of form desired (default: `sexp').
PREDICATE is a predicate that the form must satisfy to qualify.
SYNTAX-TABLE is a syntax table to use."
(let ((form+bds (tap-form-nearest-point-with-bounds thing predicate syntax-table)))
(and form+bds
(car form+bds))))
(defun tap-symbol-at-point-with-bounds ()
"Return the Emacs Lisp symbol nearest point, plus its bounds.
Return (SYMBOL START . END), or nil if no symbol is found.
Note that nil is also returned if the symbol at point is `nil'.
SYMBOL is the symbol from `tap-symbol-at-point'.
START and END are the buffer positions of SYMBOL."
(tap-form-at-point-with-bounds 'symbol 'symbolp emacs-lisp-mode-syntax-table))
(defun tap-bounds-of-symbol-at-point ()
"Return the start and end locations for the Emacs Lisp symbol at point.
See `tap-symbol-at-point'.
Return a consp (START . END), where START /= END.
Return nil if no symbol is found or if the symbol at point is `nil'."
(let ((symb+bds (tap-symbol-at-point-with-bounds)))
(and symb+bds
(cdr symb+bds))))
(defun tap-symbol-at-point ()
"Return the Emacs Lisp symbol at point, or nil if none.
Note that nil is also returned if the symbol at point is `nil'.
Some related functions:
`tap-symbol-nearest-point' returns the symbol nearest point,
or nil if none.
`tap-symbol-name-nearest-point' returns the name of
`tap-symbol-nearest-point' as a string,
or nil if none.
`symbol-name-before-point' returns the string naming the symbol at or
before point (even if it is on a previous line).
`word-at-point' returns the word at point,
or nil if none.
`word-before-point' returns the word (a string) at or before cursor.
`tap-word-nearest-point' returns the word nearest point,
or nil if none.
All but the first return strings, not (non-nil) symbols."
(tap-form-at-point 'symbol 'symbolp emacs-lisp-mode-syntax-table))
(defun tap-symbol-nearest-point-with-bounds (&optional non-nil)
"Return (SYMBOL START . END) with START and END of SYMBOL.
SYMBOL is the `tap-symbol-nearest-point'.
If optional arg NON-NIL is non-nil, then the nearest symbol other
than `nil' is sought.
Return nil if no such Emacs Lisp symbol is found."
(tap-form-nearest-point-with-bounds 'symbol
(if non-nil
(lambda (sym) (and sym (symbolp sym)))
'symbolp)
emacs-lisp-mode-syntax-table))
(defun tap-bounds-of-symbol-nearest-point (&optional non-nil)
"Return the start and end locations for the Lisp symbol nearest point.
See `tap-symbol-nearest-point'.
Return a consp (START . END), where START /= END.
Return nil if no such Emacs Lisp symbol is found.
If optional arg NON-NIL is non-nil, then seek the nearest symbol other
than `nil'."
(let ((symb+bds (tap-symbol-nearest-point-with-bounds non-nil)))
(and symb+bds
(cdr symb+bds))))
(defun tap-symbol-nearest-point (&optional non-nil)
"Return the Emacs Lisp symbol nearest point, or nil if none.
\"Nearest\" to point is determined as for `tap-thing-nearest-point'.
If optional arg NON-NIL is non-nil, then seek the nearest symbol other
than `nil'.
Some related functions:
`tap-symbol-at-point' returns the symbol under the cursor,
or nil if none.
`tap-symbol-name-nearest-point' returns the name of
`tap-symbol-nearest-point' as a string,
or nil if none.
`symbol-name-before-point' returns the string naming the symbol at or
before the cursor (even if it is on a previous line).
`word-at-point' returns the word at point,
or nil if none.
`word-before-point' returns the word at or before point as a string.
`tap-word-nearest-point' returns the word nearest point,
or nil if none.
All but the first return strings, not (non-nil) symbols."
(let ((symb+bds (tap-symbol-nearest-point-with-bounds non-nil)))
(and symb+bds
(car symb+bds))))
(defun tap-non-nil-symbol-nearest-point ()
"Return the Emacs Lisp symbol other than `nil' nearest point.
Return nil if none is found.
\"Nearest\" to point is determined as for `tap-thing-nearest-point'.
Some related functions:
`tap-symbol-at-point' returns the symbol under the cursor,
or nil if none.
`tap-symbol-name-nearest-point' returns the name of
`tap-symbol-nearest-point' as a string,
or nil if none.
`symbol-name-before-point' returns the string naming the symbol at or
before the cursor (even if it is on a previous line).
`word-at-point' returns the word at point,
or nil if none.
`tap-word-nearest-point' returns the word nearest point,
or nil if none.
`word-before-point' returns the word at or before point as a string.
All but the first return strings, not (non-nil) symbols."
(let ((symb+bds (tap-symbol-nearest-point-with-bounds t)))
(and symb+bds
(car symb+bds))))
(defun tap-list-at/nearest-point-with-bounds (at/near &optional up unquotedp)
"Helper for `tap-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 non-empty LIST.
Return nil if no non-empty list is found."
(save-excursion
(unless (eq at/near 'tap-sexp-at-point-with-bounds)
(cond ((tap-looking-at-p "\\(\\s-*\\|[\n]*\\)\\s(") (skip-syntax-forward "->"))
((tap-looking-back-p "\\s)\\(\\s-*\\|[\n]*\\)") (skip-syntax-backward "->"))))
(let (strg-end)
(while (setq strg-end (in-string-p))
(skip-syntax-forward "^\"")
(skip-syntax-forward "\"")))
(let ((sexp+bnds (funcall at/near)))
(condition-case nil
(progn
(when up
(up-list (- up))
(setq sexp+bnds (tap-sexp-at-point-with-bounds)))
(while (or (not (consp (car sexp+bnds)))
(and (memq (caar sexp+bnds) (list backquote-backquote-symbol 'quote))
(not (listp (cadr (car sexp+bnds))))))
(up-list -1)
(setq sexp+bnds (tap-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 (tap-sexp-at-point-with-bounds))))
(error (setq sexp+bnds nil)))
sexp+bnds)))
(defun tap-list-at-point-with-bounds (&optional up unquotedp)
"Return (LIST START . END), boundaries of the `tap-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'."
(tap-list-at/nearest-point-with-bounds 'tap-sexp-at-point-with-bounds up unquotedp))
(defun tap-list-nearest-point-with-bounds (&optional up unquotedp)
"Return (LIST START . END), boundaries of the `tap-list-nearest-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'."
(tap-list-at/nearest-point-with-bounds 'tap-sexp-nearest-point-with-bounds up unquotedp))
(defun tap-bounds-of-list-at-point (&optional up unquotedp)
"Return the start and end locations for the non-empty list at point.
See `tap-list-at-point'.
Return a consp (START . END), where START /= END.
Return nil if no non-empty list is found.
Optional args:
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 (tap-list-at-point-with-bounds up unquotedp)))
(and thing+bds
(cdr thing+bds))))
(defun tap-bounds-of-list-nearest-point (&optional up unquotedp)
"Return start and end locations for the non-empty list nearest point.
See `tap-list-nearest-point'.
Return a consp (START . END), where START /= END.
Return nil if no non-empty list is found.
Optional args:
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 (tap-list-nearest-point-with-bounds up unquotedp)))
(and thing+bds
(cdr thing+bds))))
(put 'list 'tap-thing-at-point 'tap-list-at-point)
(put 'list 'tap-bounds-of-thing-at-point 'tap-bounds-of-list-at-point)
(defun tap-list-at-point (&optional up)
"Return the non-nil list at point, or nil if none.
If inside a list, return the enclosing list.
UP (default: 0) is the number of list levels to go up to start with.
Note: If point is inside a string that is inside a list:
This can sometimes return nil.
This can sometimes return an incorrect list value if the string or
nearby strings contain parens.
(These are limitations of function `up-list'.)"
(let ((list+bds (tap-list-at-point-with-bounds up)))
(and list+bds
(car list+bds))))
(put 'unquoted-list 'thing-at-point 'tap-unquoted-list-at-point)
(put 'unquoted-list 'tap-thing-at-point 'tap-unquoted-list-at-point)
(defun tap-unquoted-list-at-point (&optional up)
"Return the non-nil list at point, or nil if none.
Same as `tap-list-at-point', but removes the car if it is `quote' or
`backquote-backquote-symbol' (\`).
UP (default: 0) is the number of list levels to go up to start with."
(let ((list+bds (tap-list-at-point-with-bounds up 'UNQUOTED)))
(and list+bds
(car list+bds))))
(defun tap-list-nearest-point (&optional up)
"Return the non-nil list nearest point, or nil if none.
Same as `tap-list-at-point', but returns the nearest list.
UP (default: 0) is the number of list levels to go up to start with."
(let ((list+bds (tap-list-nearest-point-with-bounds up)))
(and list+bds
(car list+bds))))
(defun tap-unquoted-list-nearest-point (&optional up)
"Return the non-nil list nearest point, or nil if none.
UP (default: 0) is the number of list levels to go up to start with.
Same as `tap-list-nearest-point', but removes the car if it is
`quote' or `backquote-backquote-symbol' (\`)."
(let ((list+bds (tap-list-nearest-point-with-bounds up 'UNQUOTED)))
(and list+bds
(car list+bds))))
(defun tap-list-nearest-point-as-string (&optional up)
"Return a string of the non-nil list nearest point, or \"\" if none.
If not \"\", the list in the string is what is returned by
`tap-list-nearest-point'.
UP (default: 0) is the number of list levels to go up to start with."
(let ((list+bds (tap-list-nearest-point-with-bounds up)))
(if list+bds (format "%s" (car list+bds)) "")))
(defun tap-unquoted-list-nearest-point-as-string (&optional up)
"Return a string of the non-nil list nearest point, or \"\" if none.
If not \"\", the list in the string is what is returned by
`tap-unquoted-list-nearest-point'.
UP (default: 0) is the number of list levels to go up to start with."
(let ((list+bds (tap-list-nearest-point-with-bounds up 'UNQUOTED)))
(if list+bds (format "%s" (car list+bds)) "")))
(put 'non-nil-symbol-name 'thing-at-point 'tap-non-nil-symbol-name-at-point)
(put 'non-nil-symbol-name 'tap-thing-at-point 'tap-non-nil-symbol-name-at-point)
(defun tap-non-nil-symbol-name-at-point ()
"String naming a non-nil Emacs Lisp symbol at point, or nil if none."
(let ((name (tap-thing-at-point 'symbol emacs-lisp-mode-syntax-table)))
(and (not (equal "nil" name)) name)))
(put 'symbol-name 'thing-at-point 'tap-symbol-name-at-point)
(put 'symbol-name 'tap-thing-at-point 'tap-symbol-name-at-point)
(defun tap-symbol-name-at-point ()
"String naming the Emacs Lisp symbol at point, or nil if none.
The symbol might be `nil', so that \"nil\" is returned.
See also `tap-non-nil-symbol-name-at-point'."
(tap-thing-at-point 'symbol emacs-lisp-mode-syntax-table))
(defun tap-symbol-name-nearest-point ()
"String naming the Emacs Lisp symbol nearest point, or nil if none.
\"Nearest\" to point is determined as for `tap-thing-nearest-point'."
(let ((symb+bds (tap-symbol-nearest-point-with-bounds nil)))
(and symb+bds (symbol-name (car symb+bds)))))
(defun tap-non-nil-symbol-name-nearest-point ()
"String naming the Emacs Lisp symbol nearest point, or nil if none.
Returns the name of the nearest symbol other than `nil'.
\"Nearest\" to point is determined as for `tap-thing-nearest-point'."
(let ((symb+bds (tap-symbol-nearest-point-with-bounds t)))
(and symb+bds (symbol-name (car symb+bds)))))
(defun tap-region-or-non-nil-symbol-name-nearest-point (&optional quote-it-p)
"Return non-empty active region or symbol nearest point, or nil if none.
Non-nil QUOTE-IT-P means wrap the region text in double-quotes (\").
The name of the nearest symbol other than `nil' is used.
See `tap-non-nil-symbol-name-nearest-point'."
(if (and transient-mark-mode mark-active
(not (eq (region-beginning) (region-end))))
(let ((region-text (buffer-substring-no-properties (region-beginning) (region-end))))
(if quote-it-p
(concat "\"" region-text "\"")
region-text))
(tap-non-nil-symbol-name-nearest-point)))
(defun tap-word-nearest-point (&optional syntax-table)
"Return the word (a string) nearest to point, if any, else nil.
\"Nearest\" to point is determined as for `tap-thing-nearest-point'.
Optional arg SYNTAX-TABLE is a syntax table to use."
(tap-thing-nearest-point 'word syntax-table))
(defun tap-region-or-word-nearest-point (&optional syntax-table)
"Return non-empty active region or word nearest point.
See `tap-word-nearest-point'."
(if (and transient-mark-mode mark-active
(not (eq (region-beginning) (region-end))))
(buffer-substring-no-properties (region-beginning) (region-end))
(tap-word-nearest-point syntax-table)))
(put 'region-or-word 'thing-at-point 'tap-region-or-word-at-point)
(put 'region-or-word 'tap-thing-at-point 'tap-region-or-word-at-point)
(defun tap-region-or-word-at-point ()
"Return non-empty active region or word at point."
(if (and transient-mark-mode mark-active
(not (eq (region-beginning) (region-end))))
(buffer-substring-no-properties (region-beginning) (region-end))
(current-word)))
(when (fboundp 'color-defined-p)
(put 'color 'thing-at-point 'tap-color-at-point)
(put 'color 'tap-thing-at-point 'tap-color-at-point)
(put 'color 'bounds-of-thing-at-point 'tap-bounds-of-color-at-point)
(put 'color 'tap-bounds-of-thing-at-point 'tap-bounds-of-color-at-point)
(defun tap-color-at-point ()
"Return the color name or RGB code (with prefix `#') at point."
(let ((word (with-syntax-table (copy-syntax-table (syntax-table))
(modify-syntax-entry ?# "w")
(word-at-point))))
(and word (color-defined-p word) word)))
(defun tap-bounds-of-color-at-point ()
"Return the bounds of the color name at point.
The color name can also be an RGB code (with prefix `#').
Return nil if no color name is found."
(let ((word+bnds (with-syntax-table (copy-syntax-table (syntax-table))
(modify-syntax-entry ?# "w")
(thing-at-point-with-bounds 'word))))
(and word+bnds (color-defined-p (car word+bnds)) (cdr word+bnds))))
(defun tap-color-nearest-point-with-bounds ()
"Return the color name nearest point, plus its bounds: (COLOR START . END).
Return nil if no color name is found.
COLOR is a color name or RGB code (with prefix `#').
See `tap-color-nearest-point'.
START and END are the buffer positions of COLOR."
(tap-thing-nearest-point-with-bounds 'color))
(defun tap-color-nearest-point ()
"Return the color name or RGB code (with prefix `#') nearest point."
(let ((color+bds (tap-color-nearest-point-with-bounds)))
(and color+bds (car color+bds)))))
(defun tap-sentence-nearest-point (&optional syntax-table)
"Return the sentence (a string) nearest to point, if any, else \"\".
\"Nearest\" to point is determined as for `tap-thing-nearest-point'.
Optional arg SYNTAX-TABLE is a syntax table to use."
(tap-thing-nearest-point 'sentence syntax-table))
(defun tap-sexp-nearest-point (&optional syntax-table)
"Return the sexp nearest point, if any, else \"\".
This is an Emacs Lisp entity, the result of reading a textual sexp
near point. \"Nearest\" to point is determined as for
`tap-thing-nearest-point'.
Optional arg SYNTAX-TABLE is a syntax table to use."
(tap-form-nearest-point 'sexp nil syntax-table))
(defun tap-number-nearest-point (&optional syntax-table)
"Return the number nearest to point, if any, else nil.
\"Nearest\" to point is determined as for `tap-thing-nearest-point'.
Optional arg SYNTAX-TABLE is a syntax table to use."
(tap-form-nearest-point 'sexp 'numberp syntax-table))
(unless (get 'defun 'beginning-op) (put 'defun 'beginning-op 'beginning-of-defun))
(unless (get 'defun 'end-op) (put 'defun 'end-op 'end-of-defun))
(unless (get 'defun 'forward-op) (put 'defun 'forward-op 'end-of-defun))
(put 'number 'tap-bounds-of-thing-at-point 'tap-bounds-of-number-at-point)
(defun tap-bounds-of-number-at-point ()
"Return the bounds of the number represented by the numeral at point.
Return nil if none is found."
(and (number-at-point) (tap-bounds-of-thing-at-point 'sexp)))
(put 'decimal-number 'bounds-of-thing-at-point 'tap-bounds-of-number-at-point-decimal)
(put 'decimal-number 'tap-bounds-of-thing-at-point 'tap-bounds-of-number-at-point-decimal)
(defun tap-bounds-of-number-at-point-decimal ()
"Return bounds of number represented by the decimal numeral at point.
Return nil if none is found."
(and (tap-number-at-point-decimal) (tap-bounds-of-thing-at-point 'sexp)))
(put 'decimal-number 'thing-at-point 'tap-number-at-point-decimal)
(put 'decimal-number 'tap-thing-at-point 'tap-number-at-point-decimal)
(defalias 'decimal-number-at-point 'tap-number-at-point-decimal)
(defun tap-number-at-point-decimal ()
"Return the number represented by the decimal numeral at point.
Return nil if none is found."
(let ((strg (tap-thing-at-point 'sexp)))
(and (stringp strg)
(tap-string-match-p "\\`[0-9]+\\'" strg)
(string-to-number strg))))
(put 'hex-number 'bounds-of-thing-at-point 'tap-bounds-of-number-at-point-hex)
(put 'hex-number 'tap-bounds-of-thing-at-point 'tap-bounds-of-number-at-point-hex)
(defun tap-bounds-of-number-at-point-hex ()
"Return bounds of number represented by the hexadecimal numeral at point.
Return nil if none is found."
(and (tap-number-at-point-hex) (tap-bounds-of-thing-at-point 'sexp)))
(put 'hex-number 'thing-at-point 'tap-number-at-point-hex)
(put 'hex-number 'tap-thing-at-point 'tap-number-at-point-hex)
(defalias 'hex-number-at-point 'tap-number-at-point-hex)
(defun tap-number-at-point-hex ()
"Return the number represented by the hex numeral at point.
Return nil if none is found."
(let ((strg (tap-thing-at-point 'sexp)))
(and (stringp strg)
(tap-string-match-p "\\`[0-9a-fA-F]+\\'" strg)
(string-to-number strg 16))))
(when (fboundp 'syntax-ppss)
(put 'string 'bounds-of-thing-at-point 'tap-bounds-of-string-at-point)
(put 'string 'tap-bounds-of-thing-at-point 'tap-bounds-of-string-at-point)
(defun tap-bounds-of-string-at-point ()
"Return the start and end locations for the string at point.
Return a consp (START . END), where START /= END.
Return nil if no string is found at point.
See `tap-string-at-point'."
(save-excursion
(let ((syntax (syntax-ppss))
beg end)
(and (nth 3 syntax)
(condition-case ()
(setq beg (1+ (nth 8 syntax))
end (progn (goto-char (nth 8 syntax)) (forward-sexp) (1- (point))))
(error nil))
(cons beg end)))))
(put 'string 'thing-at-point 'tap-string-at-point)
(put 'string 'tap-thing-at-point 'tap-string-at-point)
(defun tap-string-at-point ()
"Return the string at point, or nil if there is not string at point.
Put roughly, there is a string at point if point is between \" and \"."
(let ((bounds (tap-bounds-of-string-at-point)))
(and bounds
(buffer-substring (car bounds) (cdr bounds)))))
(defun tap-string-nearest-point ()
"Return the string nearest point, or nil if there is none.
See also `tap-string-at-point'."
(tap-thing-nearest-point 'string)))
(defun tap-put-thing-at-point-props ()
"Change `(bounds-of-)thing-at-point' properties for standard things.
This makes some things normally handled by `thingatpt.el' be handled
instead by functions defined in `thingatpt+.el'.
This also affects some things that are handled by `thingatpt.el' in
another way, not by setting these properties."
(interactive)
(put 'list 'bounds-of-thing-at-point 'tap-bounds-of-list-at-point)
(put 'list 'thing-at-point 'tap-list-at-point)
(put 'number 'thing-at-point 'number-at-point)
(put 'number 'bounds-of-thing-at-point 'tap-bounds-of-number-at-point)
t)
(defun tap-redefine-std-fns ()
"Redefine some standard `thingatpt.el' functions, to fix them.
The standard functions replaced are these:
`bounds-of-thing-at-point' - Better behavior.
Accept optional arg SYNTAX-TABLE.
`form-at-point' - Accept optional arg SYNTAX-TABLE.
`list-at-point' - Better behavior.
Accept optional arg SYNTAX-TABLE.
`symbol-at-point' - Use `emacs-lisp-mode-syntax-table'.
`thing-at-point' - Ensure it returns a string or nil.
Accept optional arg SYNTAX-TABLE.
`thing-at-point-bounds-of-list-at-point'
- Better behavior. Accept optional
args UP and UNQUOTEDP."
(interactive)
(defalias 'bounds-of-thing-at-point 'tap-bounds-of-thing-at-point)
(defalias 'form-at-point 'tap-form-at-point)
(defalias 'list-at-point 'tap-list-at-point)
(defalias 'symbol-at-point 'tap-symbol-at-point)
(defalias 'thing-at-point 'tap-thing-at-point)
(when (fboundp 'thing-at-point-bounds-of-list-at-point)
(defalias 'thing-at-point-bounds-of-list-at-point 'tap-bounds-of-list-at-point))
t)
(defun tap-define-aliases-wo-prefix ()
"Provide aliases for `tap-' functions and variables, without prefix."
(defalias 'bounds-of-form-at-point 'tap-bounds-of-form-at-point)
(defalias 'bounds-of-form-nearest-point 'tap-bounds-of-form-nearest-point)
(defalias 'bounds-of-list-nearest-point 'tap-bounds-of-list-nearest-point)
(defalias 'bounds-of-sexp-at-point 'tap-bounds-of-sexp-at-point)
(defalias 'bounds-of-sexp-nearest-point 'tap-bounds-of-sexp-nearest-point)
(when (fboundp 'tap-bounds-of-string-at-point)
(defalias 'bounds-of-string-at-point 'tap-bounds-of-string-at-point))
(defalias 'bounds-of-symbol-at-point 'tap-bounds-of-symbol-at-point)
(defalias 'bounds-of-symbol-nearest-point 'tap-bounds-of-symbol-nearest-point)
(defalias 'bounds-of-thing-nearest-point 'tap-bounds-of-thing-nearest-point)
(defalias 'form-at-point-with-bounds 'tap-form-at-point-with-bounds)
(defalias 'form-nearest-point 'tap-form-nearest-point)
(defalias 'form-nearest-point-with-bounds 'tap-form-nearest-point-with-bounds)
(defalias 'list-at/nearest-point-with-bounds 'tap-list-at/nearest-point-with-bounds)
(defalias 'list-at-point-with-bounds 'tap-list-at-point-with-bounds)
(defalias 'list-nearest-point 'tap-list-nearest-point)
(defalias 'list-nearest-point-with-bounds 'tap-list-nearest-point-with-bounds)
(defalias 'list-nearest-point-as-string 'tap-list-nearest-point-as-string)
(defalias 'non-nil-symbol-name-at-point 'tap-non-nil-symbol-name-at-point)
(defalias 'non-nil-symbol-name-nearest-point 'tap-non-nil-symbol-name-nearest-point)
(defalias 'non-nil-symbol-nearest-point 'tap-non-nil-symbol-nearest-point)
(defalias 'number-at-point-decimal 'tap-number-at-point-decimal)
(defalias 'number-at-point-hex 'tap-number-at-point-hex)
(defalias 'number-nearest-point 'tap-number-nearest-point)
(defalias 'region-or-word-at-point 'tap-region-or-word-at-point)
(defalias 'region-or-word-nearest-point 'tap-region-or-word-nearest-point)
(defalias 'region-or-non-nil-symbol-name-nearest-point
'tap-region-or-non-nil-symbol-name-nearest-point)
(defalias 'sentence-nearest-point 'tap-sentence-nearest-point)
(defalias 'sexp-at-point-with-bounds 'tap-sexp-at-point-with-bounds)
(defalias 'sexp-nearest-point 'tap-sexp-nearest-point)
(defalias 'sexp-nearest-point-with-bounds 'tap-sexp-nearest-point-with-bounds)
(when (fboundp 'tap-string-at-point)
(defalias 'string-at-point 'tap-string-at-point))
(when (fboundp 'tap-string-nearest-point)
(defalias 'string-nearest-point 'tap-string-nearest-point))
(defalias 'symbol-at-point-with-bounds 'tap-symbol-at-point-with-bounds)
(defalias 'symbol-name-at-point 'tap-symbol-name-at-point)
(defalias 'symbol-name-nearest-point 'tap-symbol-name-nearest-point)
(defalias 'symbol-nearest-point 'tap-symbol-nearest-point)
(defalias 'symbol-nearest-point-with-bounds 'tap-symbol-nearest-point-with-bounds)
(defalias 'thing-at-point-with-bounds 'tap-thing-at-point-with-bounds)
(defalias 'thing/form-nearest-point-with-bounds 'tap-thing/form-nearest-point-with-bounds)
(defalias 'thing-nearest-point 'tap-thing-nearest-point)
(defalias 'thing-nearest-point-with-bounds 'tap-thing-nearest-point-with-bounds)
(defalias 'unquoted-list-at-point 'tap-unquoted-list-at-point)
(defalias 'unquoted-list-nearest-point 'tap-unquoted-list-nearest-point)
(defalias 'unquoted-list-nearest-point-as-string 'tap-unquoted-list-nearest-point-as-string)
(defalias 'word-nearest-point 'tap-word-nearest-point)
(when (fboundp 'tap-color-at-point)
(defalias 'color-at-point 'tap-color-at-point)
(defalias 'bounds-of-color-at-point 'tap-bounds-of-color-at-point)
(defalias 'color-nearest-point 'tap-color-nearest-point)
(defalias 'color-nearest-point-with-bounds 'tap-color-nearest-point-with-bounds))
(when (fboundp 'defvaralias)
(defvaralias 'near-point-x-distance 'tap-near-point-x-distance)
(defvaralias 'near-point-y-distance 'tap-near-point-y-distance))
t)
(intern "whitespace-&-newlines")
(defun forward-whitespace-&-newlines (arg)
"Move forward over contiguous whitespace to non-whitespace.
Unlike `forward-whitespace', this moves over multiple contiguous
newlines."
(interactive "p")
(if (natnump arg)
(re-search-forward "[ \t]+\\|\n+" nil 'move arg)
(while (< arg 0)
(when (re-search-backward "[ \t]+\\|\n+" nil 'move) (skip-chars-backward " \t\n"))
(setq arg (1+ arg)))))
(intern "char-same-line")
(unless (fboundp 'forward-char-same-line)
(defun forward-char-same-line (&optional arg)
"Move forward a max of ARG chars on the same line, or backward if ARG < 0.
Return the signed number of chars moved if /= ARG, else return nil."
(interactive "p")
(let* ((start (point))
(fwd-p (natnump arg))
(inhibit-field-text-motion t)
(max (save-excursion
(if fwd-p (end-of-line) (beginning-of-line))
(- (point) start))))
(forward-char (if fwd-p (min max arg) (max max arg)))
(and (< (abs max) (abs arg))
max))))
(defun find-fn-or-var-nearest-point (&optional confirmp)
"Go to the definition of the function or variable nearest the cursor.
With a prefix arg, or if no function or variable is near the cursor,
prompt for the function or variable to find, instead."
(interactive "P")
(let* ((symb (tap-symbol-nearest-point))
(var (and (boundp symb) symb))
(fn (or (and (fboundp symb) symb)
(function-called-at-point))))
(condition-case nil
(progn (push-mark nil t)
(cond ((or confirmp (not (or var fn)))
(when (not (or var fn))
(message "Symbol nearest cursor is not a function or variable")
(sit-for 1))
(call-interactively
(if (y-or-n-p "Find function? (n means find variable) ")
'find-function
'find-variable)))
(var (find-variable var))
((and (fboundp 'help-C-file-name)
fn (subrp (symbol-function fn)))
(let ((buf+pos (find-function-search-for-symbol
fn nil (help-C-file-name (symbol-function fn) 'subr))))
(when (car buf+pos) (pop-to-buffer (car buf+pos)))))
(fn (find-function fn))
(t (call-interactively 'find-function))))
(quit (pop-mark)))))
(provide 'thingatpt+)