thingatpt.el 6.56 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1 2
;;; thingatpt.el --- Get the `thing' at point

3
;; Copyright (C) 1991,1992,1993,1994,1995 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
4 5

;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
Richard M. Stallman's avatar
Richard M. Stallman committed
6
;; Keywords: extensions, matching, mouse
Richard M. Stallman's avatar
Richard M. Stallman committed
7 8 9 10 11 12 13 14 15 16 17 18 19 20
;; Created: Thu Mar 28 13:48:23 1991

;; This file is part of GNU Emacs.

;; 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 2, 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.

Richard M. Stallman's avatar
Richard M. Stallman committed
21
;;; Commentary:
Erik Naggum's avatar
Erik Naggum committed
22

Richard M. Stallman's avatar
Richard M. Stallman committed
23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
;; This file provides routines for getting the `thing' at the location of
;; point, whatever that `thing' happens to be.  The `thing' is defined by
;; it's beginning and end positions in the buffer.
;;
;; The function bounds-of-thing-at-point finds the beginning and end
;; positions by moving first forward to the end of the `thing', and then
;; backwards to the beginning.  By default, it uses the corresponding
;; forward-`thing' operator (eg. forward-word, forward-line).
;;
;; Special cases are allowed for using properties associated with the named
;; `thing': 
;;
;;   forward-op		Function to call to skip forward over a `thing' (or
;;                      with a negative argument, backward).
;;                      
;;   beginning-op	Function to call to skip to the beginning of a `thing'.
;;   end-op		Function to call to skip to the end of a `thing'.
;;
;; Reliance on existing operators means that many `things' can be accessed
;; without further code:  eg.
;;     (thing-at-point 'line)
;;     (thing-at-point 'page)

Erik Naggum's avatar
Erik Naggum committed
46
;;; Code:
Richard M. Stallman's avatar
Richard M. Stallman committed
47 48 49

(provide 'thingatpt)

Erik Naggum's avatar
Erik Naggum committed
50
;; Basic movement
Richard M. Stallman's avatar
Richard M. Stallman committed
51 52 53 54 55 56 57 58 59 60

;;;###autoload
(defun forward-thing (THING &optional N)
  "Move forward to the end of the next THING."
  (let ((forward-op (or (get THING 'forward-op)
			(intern-soft (format "forward-%s" THING)))))
    (if (fboundp forward-op)
	(funcall forward-op (or N 1))
      (error "Can't determine how to move over %ss" THING))))

Erik Naggum's avatar
Erik Naggum committed
61
;; General routines
Richard M. Stallman's avatar
Richard M. Stallman committed
62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94

;;;###autoload
(defun bounds-of-thing-at-point (THING)
  "Determine the start and end buffer locations for the THING at point,
where 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, eg. 'word, 'sentence, 'defun.
  Return a cons cell '(start . end) giving the start and end positions."
  (let ((orig (point)))
    (condition-case nil
	(save-excursion
	  (let ((end (progn 
		       (funcall 
			(or (get THING 'end-op) 
			    (function (lambda () (forward-thing THING 1)))))
		       (point)))
		(beg (progn 
		       (funcall 
			(or (get THING 'beginning-op) 
			    (function (lambda () (forward-thing THING -1)))))
		       (point))))
	    (if (and beg end (<= beg orig) (< orig end))
		(cons beg end))))
      (error nil))))

;;;###autoload
(defun thing-at-point (THING)
  "Return the THING at point, where THING is an entity defined by
bounds-of-thing-at-point."
  (let ((bounds (bounds-of-thing-at-point THING)))
    (if bounds 
	(buffer-substring (car bounds) (cdr bounds)))))

Erik Naggum's avatar
Erik Naggum committed
95
;; Go to beginning/end
Richard M. Stallman's avatar
Richard M. Stallman committed
96 97 98 99 100 101 102 103 104 105 106

(defun beginning-of-thing (THING)
  (let ((bounds (bounds-of-thing-at-point THING)))
    (or bounds (error "No %s here" THING))
    (goto-char (car bounds))))

(defun end-of-thing (THING)
  (let ((bounds (bounds-of-thing-at-point THING)))
    (or bounds (error "No %s here" THING))
    (goto-char (cdr bounds))))

Erik Naggum's avatar
Erik Naggum committed
107
;;  Special cases 
Richard M. Stallman's avatar
Richard M. Stallman committed
108

Erik Naggum's avatar
Erik Naggum committed
109
;;  Lines 
110 111 112 113 114 115 116

;; bolp will be false when you click on the last line in the buffer
;; and it has no final newline.

(put 'line 'beginning-op
     (function (lambda () (if (bolp) (forward-line -1) (beginning-of-line)))))

Erik Naggum's avatar
Erik Naggum committed
117
;;  Sexps 
Richard M. Stallman's avatar
Richard M. Stallman committed
118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133

(defun in-string-p ()
  (let ((orig (point)))
    (save-excursion
      (beginning-of-defun)
      (nth 3 (parse-partial-sexp (point) orig)))))

(defun end-of-sexp ()
  (let ((char-syntax (char-syntax (char-after (point)))))
    (if (or (eq char-syntax ?\))
	    (and (eq char-syntax ?\") (in-string-p)))
	(forward-char 1)
      (forward-sexp 1))))

(put 'sexp 'end-op 'end-of-sexp)

Erik Naggum's avatar
Erik Naggum committed
134
;;  Lists 
Richard M. Stallman's avatar
Richard M. Stallman committed
135 136 137 138

(put 'list 'end-op (function (lambda () (up-list 1))))
(put 'list 'beginning-op 'backward-sexp)

Erik Naggum's avatar
Erik Naggum committed
139
;;  Filenames 
Richard M. Stallman's avatar
Richard M. Stallman committed
140 141 142 143 144 145 146 147 148

(defvar file-name-chars "~/A-Za-z0-9---_.${}#%,"
  "Characters allowable in filenames.")

(put 'filename 'end-op    
     (function (lambda () (skip-chars-forward file-name-chars))))
(put 'filename 'beginning-op
     (function (lambda () (skip-chars-backward file-name-chars (point-min)))))

Erik Naggum's avatar
Erik Naggum committed
149
;;  Whitespace 
Richard M. Stallman's avatar
Richard M. Stallman committed
150 151 152 153 154 155 156 157 158 159 160

(defun forward-whitespace (ARG)
  (interactive "p")
  (if (natnump ARG) 
      (re-search-forward "[ \t]+\\|\n" nil nil ARG)
    (while (< ARG 0)
      (if (re-search-backward "[ \t]+\\|\n" nil nil)
	  (or (eq (char-after (match-beginning 0)) 10)
	      (skip-chars-backward " \t")))
      (setq ARG (1+ ARG)))))

Erik Naggum's avatar
Erik Naggum committed
161
;;  Buffer 
Richard M. Stallman's avatar
Richard M. Stallman committed
162 163 164 165

(put 'buffer 'end-op 'end-of-buffer)
(put 'buffer 'beginning-op 'beginning-of-buffer)

Erik Naggum's avatar
Erik Naggum committed
166
;;  Symbols 
Richard M. Stallman's avatar
Richard M. Stallman committed
167 168 169 170 171 172 173 174 175 176

(defun forward-symbol (ARG)
  (interactive "p")
  (if (natnump ARG) 
      (re-search-forward "\\(\\sw\\|\\s_\\)+" nil nil ARG)
    (while (< ARG 0)
      (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil nil)
	  (skip-syntax-backward "w_"))
      (setq ARG (1+ ARG)))))

Erik Naggum's avatar
Erik Naggum committed
177
;;  Syntax blocks 
178 179 180 181 182 183 184 185 186 187 188

(defun forward-same-syntax (&optional arg)
  (interactive "p")
  (while (< arg 0)
    (skip-syntax-backward 
     (char-to-string (char-syntax (char-after (1- (point))))))
    (setq arg (1+ arg)))
  (while (> arg 0)
    (skip-syntax-forward (char-to-string (char-syntax (char-after (point)))))
    (setq arg (1- arg))))

Erik Naggum's avatar
Erik Naggum committed
189
;;  Aliases 
Richard M. Stallman's avatar
Richard M. Stallman committed
190 191 192 193 194

(defun word-at-point () (thing-at-point 'word))
(defun sentence-at-point () (thing-at-point 'sentence))

(defun read-from-whole-string (STR)
195
  "Read a lisp expression from STR, signaling an error if the entire string
Richard M. Stallman's avatar
Richard M. Stallman committed
196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218
was not used."
  (let* ((read-data (read-from-string STR))
	 (more-left 
	  (condition-case nil
	      (progn (read-from-string (substring STR (cdr read-data)))
		     t)
	    (end-of-file nil))))
    (if more-left
	(error "Can't read whole string")
      (car read-data))))

(defun form-at-point (&optional THING PRED) 
  (let ((sexp (condition-case nil 
		  (read-from-whole-string (thing-at-point (or THING 'sexp)))
		(error nil))))
    (if (or (not PRED) (funcall PRED sexp)) sexp)))

(defun sexp-at-point ()   (form-at-point 'sexp))
(defun symbol-at-point () (form-at-point 'sexp 'symbolp))
(defun number-at-point () (form-at-point 'sexp 'numberp))
(defun list-at-point ()   (form-at-point 'list 'listp))

;; thingatpt.el ends here.