X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1bad168e59601c1c843a38b2962e77b29f497f11..6420d28b9ab9c09b69992e05e0e63c3bbaf2646d:/lisp/thingatpt.el diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index ce3a3a5bfd..8f797d1310 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -1,7 +1,6 @@ ;;; thingatpt.el --- get the `thing' at point -;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1991-1998, 2000-2011 Free Software Foundation, Inc. ;; Author: Mike Williams ;; Maintainer: FSF @@ -10,16 +9,19 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + ;;; Commentary: ;; This file provides routines for getting the "thing" at the location of @@ -87,18 +89,19 @@ of the textual entity that was found." (or (get thing 'beginning-op) (lambda () (forward-thing thing -1)))) (let ((beg (point))) - (if (not (and beg (> beg orig))) + (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)))) - (if (and beg real-end (<= beg orig) (<= orig real-end)) - (cons beg real-end))) + (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. @@ -115,7 +118,7 @@ of the textual entity that was found." (or (get thing 'beginning-op) (lambda () (forward-thing thing -1)))) (point)))) - (if (and real-beg end (<= real-beg orig) (<= orig end)) + (if (and (<= real-beg orig) (<= orig end) (< real-beg end)) (cons real-beg end)))))) (error nil))))) @@ -165,7 +168,7 @@ a symbol as a valid THING." (nth 3 (parse-partial-sexp (point) orig))))) (defun end-of-sexp () - (let ((char-syntax (char-syntax (char-after (point))))) + (let ((char-syntax (char-syntax (char-after)))) (if (or (eq char-syntax ?\)) (and (eq char-syntax ?\") (in-string-p))) (forward-char 1) @@ -174,7 +177,7 @@ a symbol as a valid THING." (put 'sexp 'end-op 'end-of-sexp) (defun beginning-of-sexp () - (let ((char-syntax (char-syntax (char-before (point))))) + (let ((char-syntax (char-syntax (char-before)))) (if (or (eq char-syntax ?\() (and (eq char-syntax ?\") (in-string-p))) (forward-char -1) @@ -184,8 +187,32 @@ a symbol as a valid THING." ;; Lists -(put 'list 'end-op (lambda () (up-list 1))) -(put 'list 'beginning-op 'backward-sexp) +(put 'list 'bounds-of-thing-at-point 'thing-at-point-bounds-of-list-at-point) + +(defun thing-at-point-bounds-of-list-at-point () + (save-excursion + (let ((opoint (point)) + (beg (condition-case nil + (progn (up-list -1) + (point)) + (error nil)))) + (condition-case nil + (if beg + (progn (forward-sexp) + (cons beg (point))) + ;; Are we are at the beginning of a top-level sexp? + (forward-sexp) + (let ((end (point))) + (backward-sexp) + (if (>= opoint (point)) + (cons opoint end)))) + (error nil))))) + +;; Defuns + +(put 'defun 'beginning-op 'beginning-of-defun) +(put 'defun 'end-op 'end-of-defun) +(put 'defun 'forward-op 'end-of-defun) ;; Filenames and URLs www.com/foo%32bar @@ -204,7 +231,7 @@ a symbol as a valid THING." (goto-char (point-min))))) (defvar thing-at-point-url-path-regexp - "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+" + "[^]\t\n \"'<>[^`{}]*[^]\t\n \"'<>[^`{}.,;]+" "A regular expression probably matching the host and filename or e-mail part of a URL.") (defvar thing-at-point-short-url-regexp @@ -375,7 +402,7 @@ with angle brackets.") (re-search-forward "[ \t]+\\|\n" nil 'move arg) (while (< arg 0) (if (re-search-backward "[ \t]+\\|\n" nil 'move) - (or (eq (char-after (match-beginning 0)) 10) + (or (eq (char-after (match-beginning 0)) ?\n) (skip-chars-backward " \t"))) (setq arg (1+ arg))))) @@ -401,10 +428,10 @@ with angle brackets.") (interactive "p") (while (< arg 0) (skip-syntax-backward - (char-to-string (char-syntax (char-after (1- (point)))))) + (char-to-string (char-syntax (char-before)))) (setq arg (1+ arg))) (while (> arg 0) - (skip-syntax-forward (char-to-string (char-syntax (char-after (point))))) + (skip-syntax-forward (char-to-string (char-syntax (char-after)))) (setq arg (1- arg)))) ;; Aliases @@ -433,15 +460,21 @@ Signal an error if the entire string was not used." (if (or (not pred) (funcall pred sexp)) sexp))) ;;;###autoload -(defun sexp-at-point () (form-at-point 'sexp)) +(defun sexp-at-point () + "Return the sexp at point, or nil if none is found." + (form-at-point 'sexp)) ;;;###autoload (defun symbol-at-point () + "Return the symbol at point, or nil if none is found." (let ((thing (thing-at-point 'symbol))) (if thing (intern thing)))) ;;;###autoload -(defun number-at-point () (form-at-point 'sexp 'numberp)) +(defun number-at-point () + "Return the number at point, or nil if none is found." + (form-at-point 'sexp 'numberp)) ;;;###autoload -(defun list-at-point () (form-at-point 'list 'listp)) +(defun list-at-point () + "Return the Lisp list at point, or nil if none is found." + (form-at-point 'list 'listp)) -;; arch-tag: bb65a163-dae2-4055-aedc-fe11f497f698 ;;; thingatpt.el ends here