X-Git-Url: http://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-emacs.el;h=a22ecac845d61a944cb7625d88d4e8c9202ae827;hp=e46f8c509d0aa66b959925b496d041fcc04d1e47;hb=4006a97f4992512ecd83e7a72f690b21d5bccd92;hpb=005a2a7642c9f43d699922799801124a77d56f5d diff --git a/lisp/riece-emacs.el b/lisp/riece-emacs.el index e46f8c5..a22ecac 100644 --- a/lisp/riece-emacs.el +++ b/lisp/riece-emacs.el @@ -27,6 +27,58 @@ (defalias 'riece-set-case-syntax-pair 'set-case-syntax-pair) +;;; stolen (and renamed) from gnus-ems.el. +;;; In GNU Emacs, user can intercept whole mouse tracking events by +;;; assigning [mouse-X]. In XEmacs, however, which causes different +;;; effect, that is, the command assigned to [mouse-X] only catches +;;; button-release events. +(defvar riece-mouse-2 [mouse-2]) + +;;; popup-menu compatibility stuff, stolen (and renamed) from +;;; semi-def.el. +(defmacro riece-popup-menu-bogus-filter-constructor (menu) + ;; #### Kludge for FSF Emacs-style menu. + (let ((bogus-menu (make-symbol "bogus-menu"))) + `(let (,bogus-menu selection function) + (easy-menu-define ,bogus-menu nil nil ,menu) + (setq selection (x-popup-menu t ,bogus-menu)) + (when selection + (setq function (lookup-key ,bogus-menu (apply #'vector selection))) + ;; If a callback entry has no name, easy-menu wraps its value. + ;; See `easy-menu-make-symbol'. + (if (eq t (compare-strings "menu-function-" 0 nil + (symbol-name function) 0 14)) + (car (last (symbol-function function))) + function))))) + +(defun riece-popup-menu-popup (menu event) + (let ((function (riece-popup-menu-bogus-filter-constructor menu))) + (if function + (funcall function)))) + +(defun riece-event-buffer (event) + "Return the buffer of the window over which mouse event EVENT occurred." + (window-buffer (posn-window (event-start event)))) + +(defun riece-event-point (event) + "Return the character position of the mouse event EVENT." + (posn-point (event-start event))) + +;;; stolen (and renamed) from gnus-ems.el. +(defun riece-region-active-p () + "Say whether the region is active." + (and (boundp 'transient-mark-mode) + transient-mark-mode + (boundp 'mark-active) + mark-active)) + +(defalias 'riece-make-overlay 'make-overlay) +(defalias 'riece-overlay-put 'overlay-put) +(defalias 'riece-overlay-start 'overlay-start) +(defalias 'riece-overlay-buffer 'overlay-buffer) + +(defalias 'riece-run-at-time 'run-at-time) + (provide 'riece-emacs) ;;; riece-emacs.el ends here