/[emacs]/emacs/lisp/thingatpt.el
ViewVC logotype

Diff of /emacs/lisp/thingatpt.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.31 by fx, Mon Jan 27 11:38:18 2003 UTC revision 1.32 by lektu, Tue Feb 4 12:08:42 2003 UTC
# Line 32  Line 32 
32  ;; forward-"thing" operator (eg. forward-word, forward-line).  ;; forward-"thing" operator (eg. forward-word, forward-line).
33  ;;  ;;
34  ;; Special cases are allowed for using properties associated with the named  ;; Special cases are allowed for using properties associated with the named
35  ;; "thing":  ;; "thing":
36  ;;  ;;
37  ;;   forward-op         Function to call to skip forward over a "thing" (or  ;;   forward-op         Function to call to skip forward over a "thing" (or
38  ;;                      with a negative argument, backward).  ;;                      with a negative argument, backward).
39  ;;                        ;;
40  ;;   beginning-op       Function to call to skip to the beginning of a "thing".  ;;   beginning-op       Function to call to skip to the beginning of a "thing".
41  ;;   end-op             Function to call to skip to the end of a "thing".  ;;   end-op             Function to call to skip to the end of a "thing".
42  ;;  ;;
# Line 80  of the textual entity that was found." Line 80  of the textual entity that was found."
80        (condition-case nil        (condition-case nil
81            (save-excursion            (save-excursion
82              ;; Try moving forward, then back.              ;; Try moving forward, then back.
83              (let ((end (progn              (let ((end (progn
84                           (funcall                           (funcall
85                            (or (get thing 'end-op)                            (or (get thing 'end-op)
86                                (function (lambda () (forward-thing thing 1)))))                                (function (lambda () (forward-thing thing 1)))))
87                           (point)))                           (point)))
88                    (beg (progn                    (beg (progn
89                           (funcall                           (funcall
90                            (or (get thing 'beginning-op)                            (or (get thing 'beginning-op)
91                                (function (lambda () (forward-thing thing -1)))))                                (function (lambda () (forward-thing thing -1)))))
92                           (point))))                           (point))))
93                (if (not (and beg (> beg orig)))                (if (not (and beg (> beg orig)))
# Line 95  of the textual entity that was found." Line 95  of the textual entity that was found."
95                    ;; it worked.  But END may not be the real end.                    ;; it worked.  But END may not be the real end.
96                    ;; So find the real end that corresponds to BEG.                    ;; So find the real end that corresponds to BEG.
97                    (let ((real-end                    (let ((real-end
98                           (progn                           (progn
99                             (funcall                             (funcall
100                              (or (get thing 'end-op)                              (or (get thing 'end-op)
101                                  (function (lambda () (forward-thing thing 1)))))                                  (function (lambda () (forward-thing thing 1)))))
102                             (point))))                             (point))))
103                      (if (and beg real-end (<= beg orig) (<= orig real-end))                      (if (and beg real-end (<= beg orig) (<= orig real-end))
# Line 105  of the textual entity that was found." Line 105  of the textual entity that was found."
105                  (goto-char orig)                  (goto-char orig)
106                  ;; Try a second time, moving backward first and then forward,                  ;; Try a second time, moving backward first and then forward,
107                  ;; so that we can find a thing that ends at ORIG.                  ;; so that we can find a thing that ends at ORIG.
108                  (let ((beg (progn                  (let ((beg (progn
109                               (funcall                               (funcall
110                                (or (get thing 'beginning-op)                                (or (get thing 'beginning-op)
111                                    (function (lambda () (forward-thing thing -1)))))                                    (function (lambda () (forward-thing thing -1)))))
112                               (point)))                               (point)))
113                        (end (progn                        (end (progn
114                               (funcall                               (funcall
115                                (or (get thing 'end-op)                                (or (get thing 'end-op)
116                                    (function (lambda () (forward-thing thing 1)))))                                    (function (lambda () (forward-thing thing 1)))))
117                               (point)))                               (point)))
118                        (real-beg                        (real-beg
119                         (progn                         (progn
120                           (funcall                           (funcall
121                            (or (get thing 'beginning-op)                            (or (get thing 'beginning-op)
122                                (function (lambda () (forward-thing thing -1)))))                                (function (lambda () (forward-thing thing -1)))))
123                           (point))))                           (point))))
124                    (if (and real-beg end (<= real-beg orig) (<= orig end))                    (if (and real-beg end (<= real-beg orig) (<= orig end))
# Line 137  a symbol as a valid THING." Line 137  a symbol as a valid THING."
137    (if (get thing 'thing-at-point)    (if (get thing 'thing-at-point)
138        (funcall (get thing 'thing-at-point))        (funcall (get thing 'thing-at-point))
139      (let ((bounds (bounds-of-thing-at-point thing)))      (let ((bounds (bounds-of-thing-at-point thing)))
140        (if bounds        (if bounds
141            (buffer-substring (car bounds) (cdr bounds))))))            (buffer-substring (car bounds) (cdr bounds))))))
142    
143  ;; Go to beginning/end  ;; Go to beginning/end
# Line 152  a symbol as a valid THING." Line 152  a symbol as a valid THING."
152      (or bounds (error "No %s here" thing))      (or bounds (error "No %s here" thing))
153      (goto-char (cdr bounds))))      (goto-char (cdr bounds))))
154    
155  ;;  Special cases  ;;  Special cases
156    
157  ;;  Lines  ;;  Lines
158    
159  ;; bolp will be false when you click on the last line in the buffer  ;; bolp will be false when you click on the last line in the buffer
160  ;; and it has no final newline.  ;; and it has no final newline.
# Line 162  a symbol as a valid THING." Line 162  a symbol as a valid THING."
162  (put 'line 'beginning-op  (put 'line 'beginning-op
163       (function (lambda () (if (bolp) (forward-line -1) (beginning-of-line)))))       (function (lambda () (if (bolp) (forward-line -1) (beginning-of-line)))))
164    
165  ;;  Sexps  ;;  Sexps
166    
167  (defun in-string-p ()  (defun in-string-p ()
168    (let ((orig (point)))    (let ((orig (point)))
# Line 188  a symbol as a valid THING." Line 188  a symbol as a valid THING."
188    
189  (put 'sexp 'beginning-op 'beginning-of-sexp)  (put 'sexp 'beginning-op 'beginning-of-sexp)
190    
191  ;;  Lists  ;;  Lists
192    
193  (put 'list 'end-op (function (lambda () (up-list 1))))  (put 'list 'end-op (function (lambda () (up-list 1))))
194  (put 'list 'beginning-op 'backward-sexp)  (put 'list 'beginning-op 'backward-sexp)
# Line 198  a symbol as a valid THING." Line 198  a symbol as a valid THING."
198  (defvar thing-at-point-file-name-chars "-~/[:alnum:]_.${}#%,:"  (defvar thing-at-point-file-name-chars "-~/[:alnum:]_.${}#%,:"
199    "Characters allowable in filenames.")    "Characters allowable in filenames.")
200    
201  (put 'filename 'end-op      (put 'filename 'end-op
202       (lambda ()       (lambda ()
203         (re-search-forward (concat "\\=[" thing-at-point-file-name-chars "]*")         (re-search-forward (concat "\\=[" thing-at-point-file-name-chars "]*")
204                            nil t)))                            nil t)))
# Line 339  point." Line 339  point."
339                         (goto-char (car bounds))                         (goto-char (car bounds))
340                       (error "No URL here"))))))                       (error "No URL here"))))))
341    
342  ;;  Whitespace  ;;  Whitespace
343    
344  (defun forward-whitespace (arg)  (defun forward-whitespace (arg)
345    (interactive "p")    (interactive "p")
346    (if (natnump arg)    (if (natnump arg)
347        (re-search-forward "[ \t]+\\|\n" nil 'move arg)        (re-search-forward "[ \t]+\\|\n" nil 'move arg)
348      (while (< arg 0)      (while (< arg 0)
349        (if (re-search-backward "[ \t]+\\|\n" nil 'move)        (if (re-search-backward "[ \t]+\\|\n" nil 'move)
# Line 351  point." Line 351  point."
351                (skip-chars-backward " \t")))                (skip-chars-backward " \t")))
352        (setq arg (1+ arg)))))        (setq arg (1+ arg)))))
353    
354  ;;  Buffer  ;;  Buffer
355    
356  (put 'buffer 'end-op (lambda () (goto-char (point-max))))  (put 'buffer 'end-op (lambda () (goto-char (point-max))))
357  (put 'buffer 'beginning-op (lambda () (goto-char (point-min))))  (put 'buffer 'beginning-op (lambda () (goto-char (point-min))))
358    
359  ;;  Symbols  ;;  Symbols
360    
361  (defun forward-symbol (arg)  (defun forward-symbol (arg)
362    (interactive "p")    (interactive "p")
363    (if (natnump arg)    (if (natnump arg)
364        (re-search-forward "\\(\\sw\\|\\s_\\)+" nil 'move arg)        (re-search-forward "\\(\\sw\\|\\s_\\)+" nil 'move arg)
365      (while (< arg 0)      (while (< arg 0)
366        (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move)        (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move)
367            (skip-syntax-backward "w_"))            (skip-syntax-backward "w_"))
368        (setq arg (1+ arg)))))        (setq arg (1+ arg)))))
369    
370  ;;  Syntax blocks  ;;  Syntax blocks
371    
372  (defun forward-same-syntax (&optional arg)  (defun forward-same-syntax (&optional arg)
373    (interactive "p")    (interactive "p")
374    (while (< arg 0)    (while (< arg 0)
375      (skip-syntax-backward      (skip-syntax-backward
376       (char-to-string (char-syntax (char-after (1- (point))))))       (char-to-string (char-syntax (char-after (1- (point))))))
377      (setq arg (1+ arg)))      (setq arg (1+ arg)))
378    (while (> arg 0)    (while (> arg 0)
379      (skip-syntax-forward (char-to-string (char-syntax (char-after (point)))))      (skip-syntax-forward (char-to-string (char-syntax (char-after (point)))))
380      (setq arg (1- arg))))      (setq arg (1- arg))))
381    
382  ;;  Aliases  ;;  Aliases
383    
384  (defun word-at-point () (thing-at-point 'word))  (defun word-at-point () (thing-at-point 'word))
385  (defun sentence-at-point () (thing-at-point 'sentence))  (defun sentence-at-point () (thing-at-point 'sentence))
# Line 388  point." Line 388  point."
388    "Read a lisp expression from STR.    "Read a lisp expression from STR.
389  Signal an error if the entire string was not used."  Signal an error if the entire string was not used."
390    (let* ((read-data (read-from-string str))    (let* ((read-data (read-from-string str))
391           (more-left           (more-left
392            (condition-case nil            (condition-case nil
393                ;; The call to `ignore' suppresses a compiler warning.                ;; The call to `ignore' suppresses a compiler warning.
394                (progn (ignore (read-from-string (substring str (cdr read-data))))                (progn (ignore (read-from-string (substring str (cdr read-data))))
# Line 398  Signal an error if the entire string was Line 398  Signal an error if the entire string was
398          (error "Can't read whole string")          (error "Can't read whole string")
399        (car read-data))))        (car read-data))))
400    
401  (defun form-at-point (&optional thing pred)  (defun form-at-point (&optional thing pred)
402    (let ((sexp (condition-case nil    (let ((sexp (condition-case nil
403                    (read-from-whole-string (thing-at-point (or thing 'sexp)))                    (read-from-whole-string (thing-at-point (or thing 'sexp)))
404                  (error nil))))                  (error nil))))
405      (if (or (not pred) (funcall pred sexp)) sexp)))      (if (or (not pred) (funcall pred sexp)) sexp)))

Legend:
Removed from v.1.31  
changed lines
  Added in v.1.32

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26