Mercurial > emacs

comparison lisp/emulation/viper-mous.el @ 13212:73b3decace33

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* viper-mous.el (vip-surrounding-word): modified to understand tripple clicks.
author Michael Kifer <kifer@cs.stonybrook.edu>
date Sat, 14 Oct 1995 02:26:46 +0000
parents e5d4ba91148f
children 84acc3adcd63
comparison
equal deleted inserted replaced
13211:76308c9753ab 13212:73b3decace33
82 For convenience, in Lisp modes, `-' is considered alphanumeric. 82 For convenience, in Lisp modes, `-' is considered alphanumeric.
83 83
84 If CLICK-COUNT is 3 or more, returns the line clicked on with leading and 84 If CLICK-COUNT is 3 or more, returns the line clicked on with leading and
85 trailing space and tabs removed. In that case, the first argument, COUNT, 85 trailing space and tabs removed. In that case, the first argument, COUNT,
86 is ignored." 86 is ignored."
87 (let ((basic-alpha "_a-zA-Z0-9") ; it is important for `_' to come first 87 (let ((modifiers "")
88 (basic-alpha-B "[_a-zA-Z0-9]")
89 (basic-nonalphasep-B vip-NONALPHASEP-B)
90 (end-modifiers "")
91 (start-modifiers "")
92 vip-ALPHA vip-ALPHA-B
93 vip-NONALPHA vip-NONALPHA-B
94 vip-ALPHASEP vip-ALPHASEP-B
95 vip-NONALPHASEP vip-NONALPHASEP-B
96 beg skip-flag result 88 beg skip-flag result
97 one-char-word-func word-function-forw word-function-back word-beg) 89 word-beg)
98 (if (> click-count 2) 90 (if (> click-count 2)
99 (save-excursion 91 (save-excursion
100 (beginning-of-line) 92 (beginning-of-line)
101 (skip-chars-forward " \t") 93 (vip-skip-all-separators-forward 'within-line)
102 (setq beg (point)) 94 (setq beg (point))
103 (end-of-line) 95 (end-of-line)
104 (setq result (buffer-substring beg (point)))) 96 (setq result (buffer-substring beg (point))))
105 97
106 (if (and (looking-at basic-nonalphasep-B) 98 (if (and (not (vip-looking-at-alphasep))
107 (or (save-excursion (vip-backward-char-carefully) 99 (or (save-excursion (vip-backward-char-carefully)
108 (looking-at basic-alpha-B)) 100 (vip-looking-at-alpha))
109 (save-excursion (vip-forward-char-carefully) 101 (save-excursion (vip-forward-char-carefully)
110 (looking-at basic-alpha-B)))) 102 (vip-looking-at-alpha))))
111 (setq start-modifiers 103 (setq modifiers
112 (cond ((looking-at "\\\\") "\\\\") 104 (cond ((looking-at "\\\\") "\\\\")
113 ((looking-at "-") "") 105 ((looking-at "-") "C-C-")
114 ((looking-at "[][]") "][") 106 ((looking-at "[][]") "][")
115 ((looking-at "[()]") ")(") 107 ((looking-at "[()]") ")(")
116 ((looking-at "[{}]") "{}") 108 ((looking-at "[{}]") "{}")
117 ((looking-at "[<>]") "<>") 109 ((looking-at "[<>]") "<>")
118 ((looking-at "[`']") "`'") 110 ((looking-at "[`']") "`'")
119 ((looking-at "\\^") "") 111 ((looking-at "\\^") "\\^")
120 ((looking-at vip-SEP-B) "") 112 ((vip-looking-at-separator) "")
121 (t (char-to-string (following-char)))) 113 (t (char-to-string (following-char))))
122 end-modifiers 114 ))
123 (cond ((looking-at "-") "C-C-") ;; note the C-C trick
124 ((looking-at "\\^") "^")
125 (t ""))))
126 115
127 ;; Add `-' to alphanum, if it wasn't added and in we are in Lisp 116 ;; Add `-' to alphanum, if it wasn't added and if we are in Lisp
128 (or (looking-at "-") 117 (or (looking-at "-")
129 (not (string-match "lisp" (symbol-name major-mode))) 118 (not (string-match "lisp" (symbol-name major-mode)))
130 (setq end-modifiers (concat end-modifiers "C-C-"))) 119 (setq modifiers (concat modifiers "C-C-")))
131 120
132 (setq vip-ALPHA
133 (format "%s%s%s" start-modifiers basic-alpha end-modifiers)
134 vip-ALPHA-B
135 (format "[%s%s%s]" start-modifiers basic-alpha end-modifiers)
136 vip-NONALPHA (concat "^" vip-ALPHA)
137 vip-NONALPHA-B (concat "[" vip-NONALPHA "]")
138 vip-ALPHASEP (concat vip-ALPHA vip-SEP)
139 vip-ALPHASEP-B
140 (format "[%s%s%s%s]"
141 start-modifiers basic-alpha vip-SEP end-modifiers)
142 vip-NONALPHASEP (format "^%s%s" vip-SEP vip-ALPHA)
143 vip-NONALPHASEP-B (format "[^%s%s]" vip-SEP vip-ALPHA)
144 )
145
146 (if (> click-count 1)
147 (setq one-char-word-func 'vip-one-char-Word-p
148 word-function-forw 'vip-end-of-Word
149 word-function-back 'vip-backward-Word)
150 (setq one-char-word-func 'vip-one-char-word-p
151 word-function-forw 'vip-end-of-word
152 word-function-back 'vip-backward-word))
153 121
154 (save-excursion 122 (save-excursion
155 (cond ((> click-count 1) (skip-chars-backward vip-NONSEP)) 123 (cond ((> click-count 1) (vip-skip-nonseparators 'backward))
156 ((looking-at vip-ALPHA-B) (skip-chars-backward vip-ALPHA)) 124 ((vip-looking-at-alpha modifiers)
157 ((looking-at vip-NONALPHASEP-B) 125 (vip-skip-alpha-backward modifiers))
158 (skip-chars-backward vip-NONALPHASEP)) 126 ((not (vip-looking-at-alphasep modifiers))
159 (t (funcall word-function-back 1))) 127 (vip-skip-nonalphasep-backward))
160 128 (t (if (> click-count 1)
129 (vip-skip-nonseparators 'backward)
130 (vip-skip-alpha-backward modifiers))))
131
161 (setq word-beg (point)) 132 (setq word-beg (point))
162 133
163 (setq skip-flag t) 134 (setq skip-flag nil) ; don't move 1 char forw the first time
164 (while (> count 0) 135 (while (> count 0)
165 ;; skip-flag and the test for 1-char word takes care of the 136 (if skip-flag (vip-forward-char-carefully 1))
166 ;; special treatment that vip-end-of-word gives to 1-character 137 (setq skip-flag t) ; now always move 1 char forward
167 ;; words. Otherwise, clicking once on such a word will insert two 138 (if (> click-count 1)
168 ;; words. 139 (vip-skip-nonseparators 'forward)
169 (if (and skip-flag (funcall one-char-word-func)) 140 (vip-skip-alpha-forward modifiers))
170 (setq skip-flag (not skip-flag))
171 (funcall word-function-forw 1))
172 (setq count (1- count))) 141 (setq count (1- count)))
173 142
174 (vip-forward-char-carefully)
175 (setq result (buffer-substring word-beg (point)))) 143 (setq result (buffer-substring word-beg (point))))
176 ) ; if 144 ) ; if
177 ;; XEmacs doesn't have set-text-propertiesr, but there buffer-substring 145 ;; XEmacs doesn't have set-text-properties, but there buffer-substring
178 ;; doesn't return properties together with the string, so it's not needed. 146 ;; doesn't return properties together with the string, so it's not needed.
179 (if vip-emacs-p 147 (if vip-emacs-p
180 (set-text-properties 0 (length result) nil result)) 148 (set-text-properties 0 (length result) nil result))
181 result 149 result
182 )) 150 ))
430 (setq last-command 'handle-switch-frame 398 (setq last-command 'handle-switch-frame
431 vip-current-frame-saved (selected-frame))) 399 vip-current-frame-saved (selected-frame)))
432 400
433 401
434 (cond ((vip-window-display-p) 402 (cond ((vip-window-display-p)
435 (let* ((search-key (if vip-xemacs-p [(meta button1up)] [S-mouse-1])) 403 (let* ((search-key (if vip-xemacs-p
404 [(meta shift button1up)] [S-mouse-1]))
436 (search-key-catch (if vip-xemacs-p 405 (search-key-catch (if vip-xemacs-p
437 [(meta button1)] [S-down-mouse-1])) 406 [(meta shift button1)] [S-down-mouse-1]))
438 (insert-key (if vip-xemacs-p [(meta button2up)] [S-mouse-2])) 407 (insert-key (if vip-xemacs-p
408 [(meta shift button2up)] [S-mouse-2]))
439 (insert-key-catch (if vip-xemacs-p 409 (insert-key-catch (if vip-xemacs-p
440 [(meta button2)] [S-down-mouse-2])) 410 [(meta shift button2)] [S-down-mouse-2]))
441 (search-key-unbound (and (not (key-binding search-key)) 411 (search-key-unbound (and (not (key-binding search-key))
442 (not (key-binding search-key-catch)))) 412 (not (key-binding search-key-catch))))
443 (insert-key-unbound (and (not (key-binding insert-key)) 413 (insert-key-unbound (and (not (key-binding insert-key))
444 (not (key-binding insert-key-catch)))) 414 (not (key-binding insert-key-catch))))
445 ) 415 )