home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / NeXT / GnuSource / emacs-15.0.3 / lisp / sun-mouse.elc < prev    next >
Text File  |  1990-07-19  |  17KB  |  317 lines
  1.  
  2. (provide (quote sun-mouse))
  3.  
  4. (defvar extra-click-wait 150 "\
  5. *Number of milliseconds to wait for an extra click.
  6. Set this to zero if you don't want chords or double clicks.")
  7.  
  8. (defvar scrollbar-width 5 "\
  9. *The character width of the scrollbar.
  10. The cursor is deemed to be in the right edge scrollbar if it is this near the
  11. right edge, and more than two chars past the end of the indicated line.
  12. Setting to nil limits the scrollbar to the edge or vertical dividing bar.")
  13.  
  14. (defun make-mousemap nil "\
  15. Returns a new mousemap." (byte-code "ˋ¹BÇ" [nil mousemap] 2))
  16.  
  17. (defun copy-mousemap (mousemap) "\
  18. Return a copy of mousemap." (byte-code "ˋ!Ç" [mousemap copy-alist] 2))
  19.  
  20. (defun define-mouse (mousemap mouse-list def) "\
  21. Args MOUSEMAP, MOUSE-LIST, DEF.  Define MOUSE-LIST in MOUSEMAP as DEF.
  22. MOUSE-LIST is a list of atoms specifing a mouse hit according to these rules:
  23.   * One of these atoms specifies the active region of the definition.
  24.     text, scrollbar, modeline, minibuffer
  25.   * One or two or these atoms specify the button or button combination.
  26.         left, middle, right, double
  27.   * Any combination of these atoms specify the active shift keys.
  28.         control, shift, meta
  29.   * With a single unshifted button, you can add
  30.     up
  31.     to indicate an up-click.
  32. The atom `double' is used with a button designator to denote a double click.
  33. Two button chords are denoted by listing the two buttons.
  34. See sun-mouse-handler for the treatment of the form DEF." (byte-code "ˆ˜!    
  35. #Ç" [mouse-list mousemap def mousemap-set mouse-list-to-mouse-code] 5))
  36.  
  37. (defun global-set-mouse (mouse-list def) "\
  38. Give MOUSE-EVENT-LIST a local definition of DEF.
  39. See define-mouse for a description of MOUSE-EVENT-LIST and DEF.
  40. Note that if MOUSE-EVENT-LIST has a local definition in the current buffer,
  41. that local definition will continue to shadow any global definition." (interactive "xMouse event: 
  42. xDefinition: ") (byte-code "ˆÈ˜    
  43. #Ç" [current-global-mousemap mouse-list def nil define-mouse] 4))
  44.  
  45. (defun local-set-mouse (mouse-list def) "\
  46. Give MOUSE-EVENT-LIST a local definition of DEF.
  47. See define-mouse for a description of the arguments.
  48. The definition goes in the current buffer's local mousemap.
  49. Normally buffers in the same major mode share a local mousemap." (interactive "xMouse event: 
  50. xDefinition: ") (byte-code "ˆÈ?Ä ˜ Éȯ    
  51. #Ç" [current-local-mousemap mouse-list def nil make-mousemap define-mouse] 5))
  52.  
  53. (defun use-global-mousemap (mousemap) "\
  54. Selects MOUSEMAP as the global mousemap." (byte-code "    ÉÇ" [current-global-mousemap mousemap] 2))
  55.  
  56. (defun use-local-mousemap (mousemap) "\
  57. Selects MOUSEMAP as the local mousemap.
  58. nil for MOUSEMAP means no local mousemap." (byte-code "    ÉÇ" [current-local-mousemap mousemap] 2))
  59.  
  60. (defun logtest (x y) "\
  61. True if any bits set in X are also set in Y.
  62. Just like the Common Lisp function of the same name." (byte-code "´ˆ    \"!?Ç" [x y zerop logand] 4))
  63.  
  64. (defconst sm::ButtonBits 7)
  65.  
  66. (defconst sm::ShiftmaskBits 56)
  67.  
  68. (defconst sm::DoubleBits 64)
  69.  
  70. (defconst sm::UpBits 128)
  71.  
  72. (defmacro sm::hit-code (hit) (byte-code "ˋ´EÇ" [hit nth 0] 3))
  73.  
  74. (defmacro sm::hit-button (hit) (byte-code "ˋ´ˆ˜EEÇ" [hit logand sm::ButtonBits nth 0] 5))
  75.  
  76. (defmacro sm::hit-shiftmask (hit) (byte-code "ˋ´ˆ˜EEÇ" [hit logand sm::ShiftmaskBits nth 0] 5))
  77.  
  78. (defmacro sm::hit-double (hit) (byte-code "ˋ´ˆ˜EEÇ" [hit logand sm::DoubleBits nth 0] 5))
  79.  
  80. (defmacro sm::hit-up (hit) (byte-code "ˋ´ˆ˜EEÇ" [hit logand sm::UpBits nth 0] 5))
  81.  
  82. (defmacro sm::hit-x (hit) (byte-code "ˋ´EÇ" [hit nth 1] 3))
  83.  
  84. (defmacro sm::hit-y (hit) (byte-code "ˋ´EÇ" [hit nth 2] 3))
  85.  
  86. (defmacro sm::hit-delta (hit) (byte-code "ˋ´EÇ" [hit nth 3] 3))
  87.  
  88. (defmacro sm::hit-up-p (hit) (byte-code "ˋ´ˆDDDÇ" [hit not zerop sm::hit-up] 4))
  89.  
  90. (defmacro sm::loc-w (loc) (byte-code "ˋ´EÇ" [loc nth 0] 3))
  91.  
  92. (defmacro sm::loc-x (loc) (byte-code "ˋ´EÇ" [loc nth 1] 3))
  93.  
  94. (defmacro sm::loc-y (loc) (byte-code "ˋ´EÇ" [loc nth 2] 3))
  95.  
  96. (defmacro eval-in-buffer (buffer &rest forms) "Macro to switches to BUFFER, evaluates FORMS, returns to original buffer." (byte-code "´ˆ˜¯˘˙DD    \"¨EEÇ" [buffer forms let ((StartBuffer (current-buffer))) unwind-protect append progn set-buffer (set-buffer StartBuffer)] 7))
  97.  
  98. (put (quote eval-in-buffer) (quote lisp-indent-hook) 1)
  99.  
  100. (defmacro eval-in-window (window &rest forms) "Switch to WINDOW, evaluate FORMS, return to original window." (byte-code "´ˆ˜¯˘˙DD    \"¨EEÇ" [window forms let ((OriginallySelectedWindow (selected-window))) unwind-protect append progn select-window (select-window OriginallySelectedWindow)] 7))
  101.  
  102. (put (quote eval-in-window) (quote lisp-indent-hook) 1)
  103.  
  104. (defmacro eval-in-windows (form &optional yesmini) "Switches to each window and evaluates FORM.  Optional argument
  105. YESMINI says to include the minibuffer as a window.
  106. This is a macro, and does not evaluate its arguments." (byte-code "´ˆ˜¯˘˙¨²˚¸³    EDEDED˝EEÇ" [form yesmini let ((OriginallySelectedWindow (selected-window))) unwind-protect while progn not eq OriginallySelectedWindow select-window next-window nil (select-window OriginallySelectedWindow)] 13))
  107.  
  108. (put (quote eval-in-window) (quote lisp-indent-hook) 0)
  109.  
  110. (defun move-to-loc (x y) "\
  111. Move cursor to window location X, Y.
  112. Handles wrapped and horizontally scrolled lines correctly." (byte-code "˜!Èi¯˘˙ !Âi¨ ²Z ^\\Á\"˚˙ ¸¨ S ^#!
  113.     Z*Ç" [y cc nc x move-to-window-line move-to-column zerop window-hscroll window-width 2 + -1] 13))
  114.  
  115. (defun minibuffer-window-p (window) "\
  116. True iff this WINDOW is minibuffer." (byte-code "ˋ ´ˆ!8UÇ" [window screen-height 3 window-edges] 5))
  117.  
  118. (defun sun-mouse-handler (&optional hit) "\
  119. Evaluates the function or list associated with a mouse hit.
  120. Expecting to read a hit, which is a list: (button x y delta).  
  121. A form bound to button by define-mouse is found by mouse-lookup. 
  122. The variables: *mouse-window*, *mouse-x*, *mouse-y* are bound.  
  123. If the form is a symbol (symbolp), it is funcall'ed with *mouse-window*,
  124. *mouse-x*, and *mouse-y* as arguments; if the form is a list (listp),
  125. the form is eval'ed; if the form is neither of these, it is an error.
  126. Returns nil." (interactive) (byte-code "³È?Ä ˝ ÉÈ˛ˇ8—8\"±    8ˇ    8—    8¼    \"p½Î¾
  127. !qÈà!))?ÂVáâ±8\"!??ÄSãäåç!!\"ÁÄ9ÂlÉ    Èè
  128. $ÁÄ< @É    Èé!ÁÄãê\"),)È    ë=ÄÕ É    È³Ç" [hit loc *mouse-window* *mouse-x* *mouse-y* mouse-code form StartBuffer sm::UpBits this-command t last-command nil sm::combined-hits sm::window-xy 1 2 0 mouse-event-code ((byte-code "qÇ" [StartBuffer] 1)) window-buffer mouse-lookup zerop logand error "Undefined mouse event: %s" prin1-to-string mouse-code-to-mouse-list funcall eval "Mouse action must be symbol or list, but was: %s" sun-mouse-handler] 15))
  129.  
  130. (defun sm::combined-hits nil "\
  131. Read and return next mouse-hit, include possible double click" (byte-code "˘ ˙¨    ²8\"!??Ä9˚ !
  132. Ä8¸³²8²
  133. 8¨ ²8\"¨ ²
  134. 8\"UÂ5Á6²#\")È)Ç" [hit1 sm::UpBits hit2 extra-click-wait sm::ButtonBits sm::DoubleBits mouse-hit-read zerop logand 0 mouse-second-hit setcar logior] 15))
  135.  
  136. (defun mouse-hit-read nil "\
  137. Read mouse-hit list from keyboard.  Like (read 'read-char),
  138. but that uses minibuffer, and mucks up last-command." (byte-code "ˋˋˆ˜rÉ
  139. BÉÈ\"?ÄˋÈÁȯ˘˙¨!²#!*Ç" [char-list nil char equal 13 read mapconcat char-to-string nreverse ""] 7))
  140.  
  141. (defvar mouse-prefix1 24 "\
  142. First char of mouse-prefix.  Used to detect double clicks and chords.")
  143.  
  144. (defvar mouse-prefix2 0 "\
  145. Second char of mouse-prefix.  Used to detect double clicks and chords.")
  146.  
  147. (defun mouse-second-hit (hit-wait) "\
  148. Returns the next mouse hit occurring within HIT-WAIT milliseconds." (byte-code "²!Â
  149. ˋÁZr˚
  150. \"?Ų¸!Â\"
  151. ÉÈˋÁYr˚\"?Â8
  152. Éȳ ÈˋÁX˝ ˛ˇ—8\"!?ÂU±¸8Z!ÁW)))Ç" [hit-wait nil pc1 mouse-prefix1 unread-command-char pc2 mouse-prefix2 new-hit sm::UpBits sit-for-millisecs equal 3 ding mouse-hit-read zerop logand 0 mouse-second-hit] 12))
  153.  
  154. (defun sm::window-xy (x y) "\
  155. Find window containing screen coordinates X and Y.
  156. Returns list (window x y) where x and y are relative to window." (byte-code "ˆ˜ÍÅ
  157. ¹    
  158. EÇ" [nil x y found (byte-code "˚ ¸Î³˚ !˝    8˛    8ˇ    8—    8 ± UÄ% TÉȼ UÄ1TÉÈ
  159. YÄK WÄK YÄKWÄ\\½¾˚ 
  160. Z ZE\",)Èàᨲ\"!=?Äp¨ÈÁ))Ç" [OriginallySelectedWindow we le te re be x y nil t selected-window ((byte-code "ˋ!Ç" [OriginallySelectedWindow select-window] 2)) window-edges 0 1 2 3 screen-width screen-height throw found select-window next-window] 12)] 3))
  161.  
  162. (defun sm::window-region (loc) "\
  163. Parse LOC into a region symbol.
  164. Returns one of (text scrollbar modeline minibuffer)" (byte-code "¨    8²    8˚    8¸!S³!S˝! ˛ÁS YÂ*ˇÁS
  165. YÂ4—ÁSÄK
  166. ZYÄK
  167. ˚±
  168. #\\YÂR—ÁS¼*+Ç" [w loc x y right bottom scrollbar-width t 0 1 2 window-width window-height minibuffer-window-p minibuffer modeline scrollbar window-line-end text] 9))
  169.  
  170. (defun window-line-end (w x y) "\
  171. Return WINDOW column (ignore X) containing end of line Y" (byte-code "ˆ ˜Î¯    !ÈÊ˘˙ 
  172. \")))Ç" [OriginallySelectedWindow w y selected-window ((byte-code "ˋ!Ç" [OriginallySelectedWindow select-window] 2)) select-window move-to-loc screen-width] 6))
  173.  
  174. (defconst sm::keyword-alist (quote ((left . 1) (middle . 2) (right . 4) (shift . 8) (control . 16) (meta . 32) (double . 64) (up . 128) (text . 256) (scrollbar . 512) (modeline . 1024) (minibuffer . 2048))))
  175.  
  176. (defun mouse-event-code (hit loc) "\
  177. Maps MOUSE-HIT and LOC into a mouse-code." (byte-code "´ˆ8˜¯    !!\"Ç" [hit loc logior 0 mouse-region-to-code sm::window-region] 5))
  178.  
  179. (defun mouse-region-to-code (region) "\
  180. Returns partial mouse-code for specified REGION." (byte-code "´    \"AÇ" [region sm::keyword-alist assq] 3))
  181.  
  182. (defun mouse-list-to-mouse-code (mouse-list) "\
  183. Map a MOUSE-LIST to a mouse-code." (byte-code "ˋ´ˆ˜\"\"Ç" [mouse-list apply logior mapcar (lambda (x) (byte-code "´    \"AÇ" [x sm::keyword-alist assq] 3))] 5))
  184.  
  185. (defun mouse-code-to-mouse-list (mouse-code) "\
  186. Map a MOUSE-CODE to a mouse-list." (byte-code "ˋ´ˆ˜\"\"Ç" [sm::keyword-alist apply nconc mapcar (lambda (x) (byte-code "´    A\"Ä     @CÇ" [mouse-code x logtest] 3))] 5))
  187.  
  188. (defun mousemap-set (code mousemap value) (byte-code "    A¯ \"
  189. ¢
  190. \"Á˘     BB\"*Ç" [alist mousemap assq-result code value assq setcdr] 6))
  191.  
  192. (defun mousemap-get (code mousemap) (byte-code "´    A\"AÇ" [code mousemap assq] 3))
  193.  
  194. (defun mouse-lookup (mouse-code) "\
  195. Look up MOUSE-EVENT and return the definition. nil means undefined." (byte-code "ˆ    \"Å ˆ
  196. \"Ç" [mouse-code current-local-mousemap current-global-mousemap mousemap-get] 4))
  197.  
  198. (defun mouse-mask-lookup (mask list) "\
  199. Args MASK (a bit mask) and LIST (a list of (code . form) pairs).
  200. Returns a list of elements of LIST whose code or'ed with MASK is non-zero." (byte-code "ˋ
  201. Ę
  202. @@\"Ä
  203. @BÉÈ
  204. AÉÈÁÈ)Ç" [result nil list mask logtest] 4))
  205.  
  206. (defun mouse-union (l l-unique) "\
  207. Return the union of list of mouse (code . form) pairs L and L-UNIQUE,
  208. where L-UNIQUE is considered to be union'ized already." (byte-code "    
  209. Ä!
  210. @˜ @\"?Ä BÉ)È
  211. AÉÈÁÈ)Ç" [result l-unique l code-form-pair assq] 4))
  212.  
  213. (defun mouse-union-first-prefered (l1 l2) "\
  214. Return the union of lists of mouse (code . form) pairs L1 and L2,
  215. based on the code's, with preference going to elements in L1." (byte-code "ˆˆ    ´\"\"Ç" [l2 l1 nil mouse-union] 5))
  216.  
  217. (defun mouse-code-function-pairs-of-region (region) "\
  218. Return a list of (code . function) pairs, where each code is
  219. currently set in the REGION." (byte-code "˜    !¯˘
  220. A\"˘ A\"\")Ç" [mask region current-local-mousemap current-global-mousemap mouse-region-to-code mouse-union-first-prefered mouse-mask-lookup] 7))
  221.  
  222. (defun one-line-doc-string (function) "\
  223. Returns first line of documentation string for FUNCTION.
  224. If there is no documentation string, then the string
  225. \"No documentation\" is returned." (byte-code ":Ä@ÉÈÁÈ´!    ?ˆÁ&˜¯    \"È    ˘˙˘!O)Ç" [function doc documentation "No documentation." string-match "^.*$" 0 match-end] 6))
  226.  
  227. (defun print-mouse-format (binding) (byte-code "ˋ@!Èˋ´!Ȉ˜A\"ȯ Èˋ˘!Èˋ˙@!!ȯ Ç" [binding princ ": " mapcar (lambda (mouse-list) (byte-code "ˋ!Èˋ´!Ç" [mouse-list princ " "] 3)) terpri "  " one-line-doc-string] 9))
  228.  
  229. (defun print-mouse-bindings (region) "\
  230. Prints mouse-event bindings for REGION." (byte-code "ˋ´ˆ!\"Ç" [region mapcar print-mouse-format sm::event-bindings] 4))
  231.  
  232. (defun sm::event-bindings (region) "\
  233. Returns an alist of (function . (mouse-list1 ... mouse-listN)) for REGION,
  234. where each mouse-list is bound to the function in REGION." (byte-code "˘    !ˆÄ:@˙ A
  235. \"Â$¨² @!AB\"Á0 A² @!CB
  236. BÉ*ÈAÉÈÁÈ
  237. *Ç" [mouse-bindings region result nil code-function-pair current-entry mouse-code-function-pairs-of-region assoc setcdr mouse-code-to-mouse-list] 8))
  238.  
  239. (defun describe-mouse-bindings nil "\
  240. Lists all current mouse-event bindings." (interactive) (byte-code "¹Èˋдˆ!Ș È´¯!Ș È˘˙!Ș È´¨!Ș È´²!Ș È˘˚!Ș È´¸!Ș È´³!Ș È˘˝!ÑÇ" [nil "*Help*" princ "Text Region" terpri "---- ------" print-mouse-bindings text "Modeline Region" "-------- ------" modeline "Scrollbar Region" "--------- ------" scrollbar] 19))
  241.  
  242. (defun describe-mouse-briefly (mouse-list) "\
  243. Print a short description of the function bound to MOUSE-LIST." (interactive "xDescibe mouse list briefly: ") (byte-code "´Èˆ˜    !!¯˘    #Á¯˙    \")Ç" [function mouse-list nil mouse-lookup mouse-list-to-mouse-code message "%s runs the command %s" "%s is undefined"] 6))
  244.  
  245. (defun mouse-help-menu (function-and-binding) (byte-code "ˋ@!´ˆ@!CˋA!CD!BÇ" [function-and-binding prin1-to-string menu-create one-line-doc-string] 7))
  246.  
  247. (defun mouse-help-region (w x y &optional region) "\
  248. Displays a menu of mouse functions callable in this region." (byte-code "Å
  249. ˙    
  250. E!¨²K˚!\"¸³!C B!˝    ˛ $ˇ,Ç" [region w x y mlist menu item sm::window-region mapcar mouse-help-menu sm::event-bindings menu-create symbol-name sun-menu-evaluate 0 nil] 11))
  251.  
  252. (defun menu-create (items) "\
  253. Functional form for defmenu, given a list of ITEMS returns a menu.
  254. Each ITEM is a (STRING . VALUE) pair." (byte-code "ˋ´\"Ç" [items apply vector] 3))
  255.  
  256. (defmacro defmenu (menu &rest itemlist) "Defines MENU to be a menu, the ITEMS are (STRING . VALUE) pairs.
  257. See sun-menu-evaluate for interpretation of ITEMS." (byte-code "´ˆ˜    \"EÇ" [menu itemlist defconst funcall menu-create] 5))
  258.  
  259. (defun sun-menu-evaluate (*menu-window* *menu-x* *menu-y* menu) "\
  260. Display a pop-up menu in WINDOW at X Y and evaluate selected item
  261. of MENU.  MENU (or its symbol-value) should be a menu defined by defmenu.
  262.   A menu ITEM is a (STRING . FORM) pair;
  263. the FORM associated with the selected STRING is evaluated,
  264. and the resulting value is returned.  Generally these FORMs are
  265. evaluated for their side-effects rather than their values.
  266.   If the selected form is a menu or a symbol whose value is a menu, 
  267. then it is displayed and evaluated as a pullright menu item.
  268.   If the the FORM of the first ITEM is nil, the STRING of the item
  269. is used as a label for the menu, i.e. it's inverted and not selectible." (byte-code "9Ä    JÉȘ¯    
  270. ˘%!Ç" [menu *menu-window* *menu-x* *menu-y* eval sun-menu-internal 4] 7))
  271.  
  272. (defun sun-get-frame-data (code) "\
  273. Sends the tty-sub-window escape sequence CODE to terminal,
  274. and returns a cons of the two numbers in returned escape sequence.
  275. That is it returns (cons <car> <cdr>) from \"\\E[n;<car>;<cdr>t\". 
  276. CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars." (byte-code "¯˘˙!¨Q!Ȳ²²²˚¸rÉ\"?Ä$    
  277. BÉÈÁȳ˝˛
  278. !ˇ#ÉÈ—±
  279. \"È
  280. ¼½!T¾½!OÉÈ
  281. ¾½!²OÉÈ—±
  282. \"È
  283. ¼½!T¾½!OÉÈà !à !B,Ç" [code char str x y send-string-to-terminal "" int-to-string "t" nil equal 116 mapconcat char-to-string nreverse "" string-match ";[0-9]*" match-beginning 0 match-end string-to-int] 16))
  284.  
  285. (defun sm::font-size nil "\
  286. Returns font size in pixels: (cons Ysize Xsize)" (byte-code "´ˆ!´˜!¯@    @\"¯A    A\"B*Ç" [pix chr sun-get-frame-data 14 18 /] 7))
  287.  
  288. (defvar sm::menu-kludge-x nil "\
  289. Cached frame-to-window X-Offset for sm::menu-kludge")
  290.  
  291. (defvar sm::menu-kludge-y nil "\
  292. Cached frame-to-window Y-Offset for sm::menu-kludge")
  293.  
  294. (defun sm::menu-kludge nil "\
  295. If sunfns.c uses <Menu_Base_Kludge> this function must be here!" (byte-code "Ř ¯    @\\˘É)È˙¨! @\\ A
  296. \\B)Ç" [sm::menu-kludge-y fs sm::menu-kludge-x wl sm::font-size 8 4 sun-get-frame-data 13] 5))
  297.  
  298. (defun sun-yank-selection nil "\
  299. Set mark and yank the contents of the current sunwindows selection
  300. into the current buffer at point." (interactive "*") (byte-code "¹Èˋ¹!È´ˆ !Ç" [nil set-mark-command insert-string sun-get-selection] 4))
  301.  
  302. (defun sun-select-region (beg end) "\
  303. Set the sunwindows selection to the region in the current buffer." (interactive "r") (byte-code "´Èˆ˜    \"!Ç" [beg end nil sun-set-selection buffer-substring] 4))
  304.  
  305. (defun suspend-emacstool (&optional stuffstring) "\
  306. If running under as a detached process emacstool,
  307. you don't want to suspend  (there is no way to resume), 
  308. just close the window, and wait for reopening." (interactive) (byte-code "ˆÈ˜¹!Ä    Ä¯!È    Ä˘    !È˘˙!Ș´!Ä#
  309. Ä)¯
  310. !Ç" [suspend-hook stuffstring suspend-resume-hook nil boundp funcall send-string-to-terminal "t"] 7))
  311.  
  312. (make-variable-buffer-local (quote current-local-mousemap))
  313.  
  314. (setq-default current-local-mousemap nil)
  315.  
  316. (defvar current-global-mousemap (make-mousemap))
  317.