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 |
;; |
;; |
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))) |
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)) |
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)) |
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 |
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. |
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))) |
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) |
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))) |
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) |
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)) |
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)))) |
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))) |