Mercurial > hg > xemacs-beta
diff lisp/mouse.el @ 5118:e0db3c197671 ben-lisp-object
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 |
line wrap: on
line diff
--- a/lisp/mouse.el Sat Dec 26 00:20:27 2009 -0600 +++ b/lisp/mouse.el Sat Dec 26 21:18:49 2009 -0600 @@ -231,15 +231,7 @@ Returns whether a drag was begun." ;; #### barely implemented. (when (click-inside-selection-p event) - (cond ((featurep 'offix) - (declare-fboundp - (offix-start-drag-region - event - (extent-start-position zmacs-region-extent) - (extent-end-position zmacs-region-extent))) - t) - ((featurep 'cde) - ;; should also work with CDE + (cond ((featurep 'cde) (declare-fboundp (cde-start-drag-region event (extent-start-position zmacs-region-extent) @@ -278,18 +270,23 @@ (message "Regex \"%s\" not found" exp) (ding nil 'quiet))) (t (setq val (if (fboundp 'eval-interactive) - (eval-interactive exp) - (eval exp))))) - (setq result-str (prin1-to-string val)) + (eval-interactive exp) + (list (eval exp)))))) + (setq result-str (mapconcat #'prin1-to-string val " ;\n")) ;; #### -- need better test (if (and (not force-window) - (<= (length result-str) (window-width (selected-window)))) + (<= (length result-str) (window-width (selected-window))) + (not (string-match "\n" result-str))) (message "%s" result-str) (with-output-to-temp-buffer "*Mouse-Eval*" - (if-fboundp 'pprint - (pprint val) - (prin1 val))) - ))) + (loop + for value in val + with seen-first = nil + do + (if seen-first + (princ " ;\n") + (setq seen-first t)) + (cl-prettyprint value)))))) (defun mouse-line-length (event) "Print the length of the line indicated by the pointer." @@ -998,7 +995,7 @@ (let ((tmp start)) (setq start end end tmp))) (cond ((= start end) ; never delete the last remaining extent - (mapcar 'delete-extent (cdr extents)) + (mapc 'delete-extent (cdr extents)) (setcdr extents nil) (set-extent-endpoints (car extents) start start)) (t @@ -1044,7 +1041,7 @@ (setq last rest rest (cdr rest))) (cond (rest - (mapcar 'delete-extent rest) + (mapc 'delete-extent rest) (setcdr last nil)) ((not (eobp)) (while (not (eobp)) @@ -1315,7 +1312,7 @@ (set-extent-face e 'primary-selection))))) (add-hook 'pre-command-hook 'default-mouse-track-cleanup-extents-hook) (if (consp extent) ; rectangle-p - (mapcar func extent) + (mapc func extent) (if extent (funcall func extent))))) t) @@ -1329,10 +1326,10 @@ (if (consp extent) (if (funcall dead-func extent) (let (newval) - (mapcar (function (lambda (x) - (if (not (funcall dead-func x)) - (setq newval (cons x newval))))) - extent) + (mapc (function (lambda (x) + (if (not (funcall dead-func x)) + (setq newval (cons x newval))))) + extent) (setq default-mouse-track-extent (nreverse newval)))) (if (funcall dead-func extent) (setq default-mouse-track-extent nil)))))