emacs: lisp/thingatpt.el comparison

comparison lisp/thingatpt.el @ 49597:e88404e8f2cf

Trailing whitespace deleted.

author	Juanma Barranquero <lekktu@gmail.com>
date	Tue, 04 Feb 2003 12:29:42 +0000
parents	b8c5db4dbb2b
children	695cf19ef79e d7ddb3e565de

comparison

equal deleted inserted replaced

-:b06535145619
+:e88404e8f2cf
 ;; 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.
 (funcall (get thing 'bounds-of-thing-at-point))
 (let ((orig (point)))
 (condition-case nil
 	  (save-excursion
 	    ;; Try moving forward, then back.
 	    (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 (not (and beg (> 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.
 		  (let ((real-end
 			 (progn
 			   (funcall
 			    (or (get thing 'end-op)
 				(function (lambda () (forward-thing thing 1)))))
 			   (point))))
 		    (if (and beg real-end (<= beg orig) (<= orig 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.
 		(let ((beg (progn
 			     (funcall
 			      (or (get thing 'beginning-op)
 				  (function (lambda () (forward-thing thing -1)))))
 			     (point)))
 		      (end (progn
 			     (funcall
 			      (or (get thing 'end-op)
 				  (function (lambda () (forward-thing thing 1)))))
 			     (point)))
 		      (real-beg
 		       (progn
 			 (funcall
 			  (or (get thing 'beginning-op)
 			      (function (lambda () (forward-thing thing -1)))))
 			 (point))))
 		  (if (and real-beg end (<= real-beg orig) (<= orig end))
 		      (cons real-beg end))))))
 	(error nil)))))
 See the file `thingatpt.el' for documentation on how to define
 a symbol as a valid THING."
 (if (get thing 'thing-at-point)
 (funcall (get thing 'thing-at-point))
 (let ((bounds (bounds-of-thing-at-point thing)))
 (if bounds
 	  (buffer-substring (car bounds) (cdr bounds))))))
 ;; Go to beginning/end
 (defun beginning-of-thing (thing)
 (defun end-of-thing (thing)
 (let ((bounds (bounds-of-thing-at-point thing)))
 (or bounds (error "No %s here" thing))
 (goto-char (cdr bounds))))
 ;;  Special cases
 ;;  Lines
 ;; 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)))))
 ;;  Sexps
 (defun in-string-p ()
 (let ((orig (point)))
 (save-excursion
 (beginning-of-defun)
 	(forward-char -1)
 (forward-sexp -1))))
 (put 'sexp 'beginning-op 'beginning-of-sexp)
 ;;  Lists
 (put 'list 'end-op (function (lambda () (up-list 1))))
 (put 'list 'beginning-op 'backward-sexp)
 ;;  Filenames and URLs  www.com/foo%32bar
 (defvar thing-at-point-file-name-chars "-~/[:alnum:]_.${}#%,:"
 "Characters allowable in filenames.")
 (put 'filename 'end-op
 (lambda ()
 (re-search-forward (concat "\\=[" thing-at-point-file-name-chars "]*")
 			  nil t)))
 (put 'filename 'beginning-op
 (lambda ()
 		 (let ((bounds (thing-at-point-bounds-of-url-at-point)))
 		   (if bounds
 		       (goto-char (car bounds))
 		     (error "No URL here"))))))
 ;;  Whitespace
 (defun forward-whitespace (arg)
 (interactive "p")
 (if (natnump arg)
 (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)
 	      (skip-chars-backward " \t")))
 (setq arg (1+ arg)))))
 ;;  Buffer
 (put 'buffer 'end-op (lambda () (goto-char (point-max))))
 (put 'buffer 'beginning-op (lambda () (goto-char (point-min))))
 ;;  Symbols
 (defun forward-symbol (arg)
 (interactive "p")
 (if (natnump arg)
 (re-search-forward "\\(\\sw\\|\\s_\\)+" nil 'move arg)
 (while (< arg 0)
 (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move)
 	  (skip-syntax-backward "w_"))
 (setq arg (1+ arg)))))
 ;;  Syntax blocks
 (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))))
 ;;  Aliases
 (defun word-at-point () (thing-at-point 'word))
 (defun sentence-at-point () (thing-at-point 'sentence))
 (defun read-from-whole-string (str)
 "Read a lisp expression from STR.
 Signal an error if the entire string was not used."
 (let* ((read-data (read-from-string str))
 	 (more-left
 	  (condition-case nil
 	      ;; The call to `ignore' suppresses a compiler warning.
 	      (progn (ignore (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)))
 ;;;###autoload

Mercurial > emacs

comparison lisp/thingatpt.el @ 49597:e88404e8f2cf