(defvar hyperb:epoch-p (if (boundp (quote epoch::version)) (if (string< epoch::version "Epoch 4") "V3" "V4")) "\ Simplified Epoch version string, e.g. \"V4\", else nil.") (defvar hyperb:lemacs-p (let ((case-fold-search t)) (if (string-match "Lucid" emacs-version) emacs-version)) "\ Lucid Emacs version string.") (defvar hyperb:emacs19-p (let ((case-fold-search t)) (if (string-match "^19\\." emacs-version) emacs-version)) "\ GNU Emacs 19 version string.") (defun sm-window-sys-term nil "\ Returns the first part of the term-type if running under a window system, else nil. Where a part in the term-type is delimited by a '-' or an '_'." (byte-code " Æ=ƒ\" ƒÇ‚ ƒÈ‚ ƒÉ‚Ê‚TËÌ!†.ÍÎÏ!Ð\"ƒ5Ñ‚T †NËÒ!†NËÓ!†NËÔ!†NËÕ!…TÎÏ!…`Ö×Ø\"O)‡" [term window-system hyperb:emacs19-p hyperb:lemacs-p hyperb:epoch-p t x "emacs19" "lemacs" "epoch" "xterm" featurep eterm-fns equal getenv "TERM" "eterm" "next" mouse x-mouse sun-mouse apollo 0 string-match "[-_]"] 13)) (defvar hyperb:window-system (sm-window-sys-term) "\ String name for window system or term type under which Emacs was run.") (eval (cdr (assoc hyperb:window-system (quote (("emacs19" require (quote mouse)) ("lemacs" require (quote x-mouse)) ("xterm" require (quote x-mouse)) ("epoch" require (quote mouse)) ("next" require (quote eterm-fns)) ("sun" require (quote sun-fns)) ("apollo" require (quote apollo))))))) (defun sm-mouse-get-bindings nil "\ Returns list of bindings for mouse keys prior to their use as Smart Keys." (eval (cdr (assoc hyperb:window-system (quote (("emacs19" mapcar (function (lambda (key) (cons key (lookup-key global-map key)))) (quote ([down-mouse-2] [mouse-2] [down-mouse-3] [mouse-3] [mode-line down-mouse-2] [mode-line mouse-2] [mode-line down-mouse-3] [mode-line mouse-3]))) ("lemacs" mapcar (function (lambda (key) (cons key (lookup-key global-map key)))) (quote (button2 button2up button3 button3up))) ("xterm" mapcar (function (lambda (key) (cons key (lookup-key mouse-map key)))) (list x-button-middle x-button-middle-up x-button-right x-button-right-up)) ("epoch" mapcar (function (lambda (key) (cons key (aref mouse::global-map key)))) (list (mouse::index mouse-middle mouse-down) (mouse::index mouse-middle mouse-up) (mouse::index mouse-right mouse-down) (mouse::index mouse-right mouse-up) (mouse::index mouse-mode-middle mouse-down) (mouse::index mouse-mode-middle mouse-up) (mouse::index mouse-mode-right mouse-down) (mouse::index mouse-mode-right mouse-up))) ("next" mapcar (function (lambda (key) (cons key (mousemap-get (mouse-list-to-mouse-code key) current-global-mousemap)))) (apply (quote nconc) (mapcar (function (lambda (region) (mapcar (function (lambda (key) (cons region key))) (quote ((left) (up left) (shift left) (right) (up right)))))) (quote (text scrollbar modeline minibuffer))))) ("sun" mapcar (function (lambda (key) (setq key (mouse-list-to-mouse-code key)) (cons key (mousemap-get key current-global-mousemap)))) (apply (quote nconc) (mapcar (function (lambda (region) (mapcar (function (lambda (key) (cons region key))) (quote ((middle) (up middle) (right) (up right)))))) (quote (text scrollbar modeline minibuffer))))) ("apollo" mapcar (function (lambda (key-str) (apollo-mouse-key-and-binding key-str))) (quote ("M2D" "M2U" "M3D" "M3U"))))))))) (defun sm-mouse-set-bindings (key-binding-list) "\ Sets mouse keys used as Smart Keys to bindings in KEY-BINDING-LIST. KEY-BINDING-LIST is the value returned by 'sm-mouse-get-bindings' prior to Smart Key setup." (byte-code "ÃÄ\"† ÃÅ\"ƒÆÇ \"‚_ÃÈ\"ƒ#ÆÉ \"‚_ÃÊ\"ƒ1ÆË \"‚_ÃÌ\"†<ÃÍ\"ƒFÆÎ \"‚_ÃÏ\"…_Ð Ñ\"ƒ[ÆÒ \"‚_ÆÓ \"‡" [hyperb:window-system key-binding-list emacs-version equal "emacs19" "lemacs" mapcar (lambda (key-and-binding) (global-set-key (car key-and-binding) (cdr key-and-binding))) "xterm" (lambda (key-and-binding) (define-key mouse-map (car key-and-binding) (cdr key-and-binding))) "epoch" (lambda (key-and-binding) (aset mouse::global-map (car key-and-binding) (cdr key-and-binding))) "next" "sun" (lambda (key-and-binding) (global-set-mouse (car key-and-binding) (cdr key-and-binding))) "apollo" string< "18.58" (lambda (key-and-binding) (global-set-key (car key-and-binding) (cdr key-and-binding))) (lambda (key-and-binding) (byte-code "ÁÂ@A#‡" [key-and-binding define-key apollo-prefix] 4))] 16)) (defun sm-mouse-setup nil "\ Binds mouse keys for use as Smart Keys." (interactive) (byte-code "†Ó ‰ˆÃ‰ˆÔ Õ\"ƒBÖ‰ˆ×ØÙ\"ˆ×ÚÛ\"ˆ×ÜÝ\"ˆ×Þß\"ˆ×àÙ\"ˆ×áÛ\"ˆ×âÝ\"ˆ×ãß\"‚%Ô ä\"ƒc剈×æç\"ˆ×èé\"ˆ×êë\"ˆ×ìí\"‚%Ô î\"ƒï‰ˆðç#ˆðé#ˆð ë#ˆð í#‚%Ô ñ\"ƒÝò‰ˆó  ç#ˆó  é#ˆó ë#ˆó í#ˆó ç#ˆó é#ˆó ë#ˆó í#‚%Ô ô\"ƒïõ‰ˆö÷ø\"‚%Ô ù\"ƒõ‰ˆöúû\"‚%Ô ü\"…%ý‰ˆþÿç\"ˆþ@é\"ˆþAë\"ˆþBí\"ˆÓ Ò‰‡" [sm-mouse-bindings-p sm-mouse-previous-bindings Info-mouse-support nil hyperb:window-system mouse-set-point-command mouse-map x-button-middle x-button-middle-up x-button-right x-button-right-up mouse-middle mouse-down mouse-up mouse-right mouse-mode-middle mouse-mode-right sm-mouse-bindings t sm-mouse-get-bindings equal "emacs19" mouse-set-point global-set-key [down-mouse-2] sm-depress-emacs19 [mouse-2] smart-key-mouse-emacs19 [down-mouse-3] sm-depress-meta-emacs19 [mouse-3] smart-key-mouse-meta-emacs19 [mode-line down-mouse-2] [mode-line mouse-2] [mode-line down-mouse-3] [mode-line mouse-3] "lemacs" sm-lemacs-move-point button2 sm-depress button2up smart-key-mouse button3 sm-depress-meta button3up smart-key-mouse-meta "xterm" x-mouse-set-point define-key "epoch" mouse::set-point global-set-mouse "next" sm-eterm-move-point mapcar (lambda (region) (byte-code "ÁÂBÃ\"ˆÁÄBÅ\"ˆÁÆBÇ\"ˆÁÈBÉ\"ˆÁÊBË\"‡" [region global-set-mouse (shift left) mouse-move-point (left) sm-depress (up left) smart-key-mouse (right) sm-depress-meta (up right) smart-key-mouse-meta] 7)) (text scrollbar modeline minibuffer) "sun" (lambda (region) (byte-code "ÁÂBÃ\"ˆÁÄBÅ\"ˆÁÆBÇ\"ˆÁÈBÉ\"‡" [region global-set-mouse (middle) sm-depress (up middle) smart-key-mouse (right) sm-depress-meta (up right) smart-key-mouse-meta] 6)) (text scrollbar modeline minibuffer) "apollo" apollo-mouse-move-point bind-apollo-mouse-button "M2D" "M2U" "M3D" "M3U"] 41)) (defun sm-mouse-toggle-bindings nil "\ Toggles between Smart Key mouse settings and their prior bindings." (interactive) (byte-code " ƒ ‚ ƒÂƒ3 Å LˆÆ!ˆÇÈ ?‰ƒ.É‚/Ê\"‚7ËÌ \"*‡" [key-binding-list sm-mouse-bindings-p sm-mouse-previous-bindings sm-mouse-bindings other-list-var sm-mouse-get-bindings sm-mouse-set-bindings message "%s mouse bindings in use." "Smart Key" "Personal" error "(sm-mouse-toggle-bindings): Null %s."] 6)) (if (fboundp (quote bind-apollo-mouse-button)) (progn (if (string< emacs-version "18.58") (defun apollo-mouse-key-and-binding (mouse-button) "Returns binding for an Apollo MOUSE-BUTTON (a string) or nil if none." (interactive "sMouse Button: ") (byte-code "Ä \"A?…ÅÆ \"ˆ;…Ä \"A‰ˆÇÈ!P É !B))‡" [numeric-code mouse-button *apollo-mouse-buttons* key-sequence assoc error "(hmouse-key): %s is not a valid Apollo mouse key name." "ª" char-to-string global-key-binding] 7)) (defun apollo-mouse-key-and-binding (mouse-button) "Returns binding for an Apollo MOUSE-BUTTON (a string) or nil if none." (interactive "sMouse Button: ") (byte-code "Ä \"A?…ÅÆ \"ˆ;…Ä \"A‰ˆÇ! ÈÉ \"B))‡" [numeric-code mouse-button *apollo-mouse-buttons* key-sequence assoc error "(hmouse-key): %s is not a valid Apollo mouse key name." char-to-string lookup-key apollo-prefix] 8))) (defun apollo-mouse-move-point (&optional no-mark) "Used so that pressing the left mouse button, moving the cursor, and releasing the left mouse button leaves the mark set to the initial position and the point set to the final position. Useful for easily marking regions of text. If the left mouse button is pressed and released at the same place, the mark is left at the original position of the character cursor. Returns (x y) screen coordinates of point in columns and lines." (interactive) (byte-code "`Ì rÍZrÍZÎ Ë Ì =?…7 Ï 8W†7 Ð 8Y†7 Ñ 8W†7 Ò 8Y…IÓ !‰ˆÎ !‰ˆ‚ˆ …S Ì =?…r?…aÌ Ô =…gÕÖ!ˆ Ô =…rÕ×!ˆ …zØ !ˆÙ Ï 8Z!ˆÚ !SÛi\"Ì Ô =ƒÜ ‚žÑ ÝÞ Ñ 8 #ß\"\\!+ˆ ƒÜÌ ‰ˆ =ƒÏà`\"…Ìá ‚ÙØ !ˆá ˆØ !‚ßâË!ˆ D.‡" [opoint owindow x y edges window *apollo-mouse-move-point-allow-minibuffer-exit* width-1 wraps prompt-length no-mark nil selected-window 8 window-edges 1 3 0 2 next-window minibuffer-window error "Cannot use mouse to leave minibuffer!" "Cannot use mouse to enter minibuffer!" select-window move-to-window-line window-width / minibuffer-prompt-length move-to-column - * equal pop-mark set-mark-command] 30)))) (defun sm-depress (&rest args) (interactive) (byte-code "Í ÂÎ !Ï ÇÇlj ˆ …% †%‰ ‡" [smart-key-depress-prev-point *smart-key-depressed* t *smart-key-depress-args* args smart-key-depress-window *smart-key-release-args* nil smart-key-release-window smart-key-release-prev-point *smart-key-meta-depressed* *smart-key-help-p* *smart-key-meta-help-p* point-marker smart-key-mouse-set-point selected-window] 5)) (defun sm-depress-meta (&rest args) (interactive) (byte-code "Í ÂÎ !Ï ÇÇlj ˆ …% †%‰ ‡" [smart-key-meta-depress-prev-point *smart-key-meta-depressed* t *smart-key-meta-depress-args* args smart-key-meta-depress-window *smart-key-meta-release-args* nil smart-key-meta-release-window smart-key-meta-release-prev-point *smart-key-depressed* *smart-key-meta-help-p* *smart-key-help-p* point-marker smart-key-mouse-set-point selected-window] 5)) (defun sm-depress-emacs19 (event) (interactive "e") (sm-depress event)) (defun sm-depress-meta-emacs19 (event) (interactive "e") (sm-depress-meta event)) (defun smart-key-mouse-emacs19 (event) "\ Set point to the current mouse cursor position and execute 'smart-key'. EVENT will be passed to 'smart-key-mouse-func'." (interactive "e") (smart-key-mouse (sm-release-args-emacs19 event))) (defun smart-key-mouse-meta-emacs19 (event) "\ Set point to the current mouse cursor position and execute 'smart-key'. EVENT will be passed to 'smart-key-mouse-func'." (interactive "e") (smart-key-mouse-meta (sm-release-args-emacs19 event))) (defun sm-release-args-emacs19 (event) (byte-code "GÁUƒ@Â8D‚‡" [event 3 2] 3)) (defun sm-lemacs-move-point nil (condition-case nil (mouse-set-point current-mouse-event) (error nil))) (defun sm-eterm-move-point (arg-list) (apply (quote mouse-move-point) arg-list)) (defvar sm-mouse-bindings nil "\ List of (key . binding) pairs for Smart Mouse Keys.") (defvar sm-mouse-bindings-p nil "\ True if Smart Key mouse bindings are in use, else nil.") (defvar sm-mouse-previous-bindings nil "\ List of previous (key . binding) pairs for mouse keys used as Smart Keys.") (provide (quote hmouse-key))