Mercurial > hg > xemacs-beta

comparison lisp/mouse.el @ 5118:e0db3c197671 ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge up to latest default branch, doesn't compile yet
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 21:18:49 -0600
parents bc4f2511bbea
children f00192e1cd49 308d34e9f07d
comparison
equal deleted inserted replaced
5117:3742ea8250b5 5118:e0db3c197671
229 "Begin a drag-n-drop operation. 229 "Begin a drag-n-drop operation.
230 EVENT should be the button event that initiated the drag. 230 EVENT should be the button event that initiated the drag.
231 Returns whether a drag was begun." 231 Returns whether a drag was begun."
232 ;; #### barely implemented. 232 ;; #### barely implemented.
233 (when (click-inside-selection-p event) 233 (when (click-inside-selection-p event)
234 (cond ((featurep 'offix) 234 (cond ((featurep 'cde)
235 (declare-fboundp
236 (offix-start-drag-region
237 event
238 (extent-start-position zmacs-region-extent)
239 (extent-end-position zmacs-region-extent)))
240 t)
241 ((featurep 'cde)
242 ;; should also work with CDE
243 (declare-fboundp 235 (declare-fboundp
244 (cde-start-drag-region event 236 (cde-start-drag-region event
245 (extent-start-position zmacs-region-extent) 237 (extent-start-position zmacs-region-extent)
246 (extent-end-position zmacs-region-extent))) 238 (extent-end-position zmacs-region-extent)))
247 t)))) 239 t))))
276 (setq unread-command-event (next-command-event)) 268 (setq unread-command-event (next-command-event))
277 (delete-extent oo)) 269 (delete-extent oo))
278 (message "Regex \"%s\" not found" exp) 270 (message "Regex \"%s\" not found" exp)
279 (ding nil 'quiet))) 271 (ding nil 'quiet)))
280 (t (setq val (if (fboundp 'eval-interactive) 272 (t (setq val (if (fboundp 'eval-interactive)
281 (eval-interactive exp) 273 (eval-interactive exp)
282 (eval exp))))) 274 (list (eval exp))))))
283 (setq result-str (prin1-to-string val)) 275 (setq result-str (mapconcat #'prin1-to-string val " ;\n"))
284 ;; #### -- need better test 276 ;; #### -- need better test
285 (if (and (not force-window) 277 (if (and (not force-window)
286 (<= (length result-str) (window-width (selected-window)))) 278 (<= (length result-str) (window-width (selected-window)))
279 (not (string-match "\n" result-str)))
287 (message "%s" result-str) 280 (message "%s" result-str)
288 (with-output-to-temp-buffer "*Mouse-Eval*" 281 (with-output-to-temp-buffer "*Mouse-Eval*"
289 (if-fboundp 'pprint 282 (loop
290 (pprint val) 283 for value in val
291 (prin1 val))) 284 with seen-first = nil
292 ))) 285 do
286 (if seen-first
287 (princ " ;\n")
288 (setq seen-first t))
289 (cl-prettyprint value))))))
293 290
294 (defun mouse-line-length (event) 291 (defun mouse-line-length (event)
295 "Print the length of the line indicated by the pointer." 292 "Print the length of the line indicated by the pointer."
296 (interactive "@e") 293 (interactive "@e")
297 (save-excursion 294 (save-excursion
996 (defun default-mouse-track-next-move-rect (start end extents &optional pad-p) 993 (defun default-mouse-track-next-move-rect (start end extents &optional pad-p)
997 (if (< end start) 994 (if (< end start)
998 (let ((tmp start)) (setq start end end tmp))) 995 (let ((tmp start)) (setq start end end tmp)))
999 (cond 996 (cond
1000 ((= start end) ; never delete the last remaining extent 997 ((= start end) ; never delete the last remaining extent
1001 (mapcar 'delete-extent (cdr extents)) 998 (mapc 'delete-extent (cdr extents))
1002 (setcdr extents nil) 999 (setcdr extents nil)
1003 (set-extent-endpoints (car extents) start start)) 1000 (set-extent-endpoints (car extents) start start))
1004 (t 1001 (t
1005 (let ((indent-tabs-mode nil) ; if pad-p, don't use tabs 1002 (let ((indent-tabs-mode nil) ; if pad-p, don't use tabs
1006 (rest extents) 1003 (rest extents)
1042 (if (not (eobp)) 1039 (if (not (eobp))
1043 (move-to-column left pad-p)) 1040 (move-to-column left pad-p))
1044 (setq last rest 1041 (setq last rest
1045 rest (cdr rest))) 1042 rest (cdr rest)))
1046 (cond (rest 1043 (cond (rest
1047 (mapcar 'delete-extent rest) 1044 (mapc 'delete-extent rest)
1048 (setcdr last nil)) 1045 (setcdr last nil))
1049 ((not (eobp)) 1046 ((not (eobp))
1050 (while (not (eobp)) 1047 (while (not (eobp))
1051 (setq p (point)) 1048 (setq p (point))
1052 (move-to-column right pad-p) 1049 (move-to-column right pad-p)
1313 (func #'(lambda (e) 1310 (func #'(lambda (e)
1314 (and (extent-live-p e) 1311 (and (extent-live-p e)
1315 (set-extent-face e 'primary-selection))))) 1312 (set-extent-face e 'primary-selection)))))
1316 (add-hook 'pre-command-hook 'default-mouse-track-cleanup-extents-hook) 1313 (add-hook 'pre-command-hook 'default-mouse-track-cleanup-extents-hook)
1317 (if (consp extent) ; rectangle-p 1314 (if (consp extent) ; rectangle-p
1318 (mapcar func extent) 1315 (mapc func extent)
1319 (if extent 1316 (if extent
1320 (funcall func extent))))) 1317 (funcall func extent)))))
1321 t) 1318 t)
1322 1319
1323 (defun default-mouse-track-cleanup-extent () 1320 (defun default-mouse-track-cleanup-extent ()
1327 (extent-detached-p x))))) 1324 (extent-detached-p x)))))
1328 (extent default-mouse-track-extent)) 1325 (extent default-mouse-track-extent))
1329 (if (consp extent) 1326 (if (consp extent)
1330 (if (funcall dead-func extent) 1327 (if (funcall dead-func extent)
1331 (let (newval) 1328 (let (newval)
1332 (mapcar (function (lambda (x) 1329 (mapc (function (lambda (x)
1333 (if (not (funcall dead-func x)) 1330 (if (not (funcall dead-func x))
1334 (setq newval (cons x newval))))) 1331 (setq newval (cons x newval)))))
1335 extent) 1332 extent)
1336 (setq default-mouse-track-extent (nreverse newval)))) 1333 (setq default-mouse-track-extent (nreverse newval))))
1337 (if (funcall dead-func extent) 1334 (if (funcall dead-func extent)
1338 (setq default-mouse-track-extent nil))))) 1335 (setq default-mouse-track-extent nil)))))
1339 1336
1340 (defun default-mouse-track-drag-hook (event click-count was-timeout) 1337 (defun default-mouse-track-drag-hook (event click-count was-timeout)