Re: Pixel position of a window point

I wrote: You know, that piece of functionality isn't, strictly speaking, necessary. After all, before a mouse event can cause any effects in a buffer, its location has to be translated into a point in the buffer. With a keypress, I already have a buffer and a point, so I just need to skip the event->location translation. I'll paste below an attempt I just made at doing that. It had farther-reaching consequences than I had hoped, but at least they are all confined to the lisp tree in the source directory. (I grepped through the packages for references to the affected variables and functions; there were none.) This was made harder by the absence of generic pixel position <-> buffer position mapping facilities; all we have is the ability to grab a buffer point out of an event with X-Y coordinates. Would something like this be acceptable? More work would have to be done first, since the popup menu does not respond to key events. I want it to recognize, at a minimum, the arrow keys, enter (to choose an entry), and ESC (to make the window go away). ;; This stuff is from lisp/menubar.el (defvar last-popup-menu-location nil "The window, buffer, and point of the last popup menu invocation. NOTE: This is EXPERIMENTAL and may change at any time.") (defun popup-mode-menu-kbd () "Pop up a menu of global and mode-specific commands. The menu is computed by combining `global-popup-menu' and `mode-popup-menu' with any items derived from the `context-menu' property of the extent containing point. This function can be bound to a key." (interactive) (let* ((win (selected-window)) (buf (current-buffer)) (p (point buf))) (setq last-popup-menu-location (list win buf p)) (popup-mode-menu-helper win p))) (defun popup-mode-menu (&optional event) "Pop up a menu of global and mode-specific commands. The menu is computed by combining `global-popup-menu' and `mode-popup-menu' with any items derived from the `context-menu' property of the extent where the button was clicked." (interactive "_e") (let* ((ev (or (and (button-event-p event) ev) ;; We could skip all this if we could map X-Y coordinates ;; to a buffer position directly (let* ((mouse-pos (mouse-position)) (win (car mouse-pos)) (x (cadr mouse-pos)) (y (cddr mouse-pos)) (edges (window-pixel-edges win)) (winx (first edges)) (winy (second edges)) (x (+ x winx)) (y (+ y winy))) (make-event 'button-press `(button 3 x ,x y ,y channel ,(window-frame win) timestamp ,(current-event-timestamp (cdfw-console win))))))) (win (event-window ev)) (buf (event-buffer ev)) (p (event-point ev))) (setq last-popup-menu-location (list win buf p)) (popup-mode-menu-helper win p))) (defun popup-mode-menu-helper (context-window context-point) "Popup a window in the context of extents at a window and point. CONTEXT-WINDOW is the window to examine. CONTEXT-POINT is the location within that window." (run-hooks 'activate-popup-menu-hook) (let* ((context-extents (and context-window context-point (extents-at context-point (window-buffer context-window) 'context-menu))) (context-menu-items (apply 'append (mapcar #'(lambda (extent) (extent-property extent 'context-menu)) context-extents)))) (popup-menu (progn ;; Merge global-popup-menu and mode-popup-menu (and mode-popup-menu (check-menu-syntax mode-popup-menu)) (let* ((mode-title (and (stringp (car mode-popup-menu)) (car mode-popup-menu))) (mode-items (if mode-title (cdr mode-popup-menu) mode-popup-menu)) (global-title (and (stringp (car global-popup-menu)) (car global-popup-menu))) (global-items (if global-title (cdr global-popup-menu) global-popup-menu)) mode-filters) ;; Strip keywords from local menu for attaching them at the top (while (and mode-items (keywordp (car mode-items))) ;; Push both keyword and its argument. (push (pop mode-items) mode-filters) (push (pop mode-items) mode-filters)) (setq mode-filters (nreverse mode-filters)) ;; If mode-filters contains a keyword already present in ;; `global-popup-menu', you will probably lose. (append (cond ((not popup-menu-titles) (list "")) (mode-title (list mode-title)) (global-title (list global-title)) (t (list ""))) mode-filters context-menu-items (and context-menu-items mode-items '("---")) mode-items (and (or context-menu-items mode-items) global-items '("---" "---")) (and global-title (list global-title)) global-items)))) (while (popup-up-p) (dispatch-event (next-event))))) (defun menu-call-at-location (form &optional buf p default-behavior-fallback) "Call FORM while temporarily setting point to the position in BUF and P. NOTE: This is EXPERIMENTAL and may change at any time. FORM is called the way forms in menu specs are: i.e. if a symbol, it's called with `call-interactively', otherwise with `eval'. BUF and P default to the contents of `last-popup-menu-location', making this function especially useful in popup menus. The buffer and point are set temporarily within a `save-excursion'. If BUF is not a valid buffer, nothing happens unless DEFAULT-BEHAVIOR-FALLBACK is non-nil, in which case the FORM is called normally." (if (null buf) (setq buf (cadr last-popup-menu-location) p (caddr last-popup-menu-location))) (cond ((and buf p (> p 0)) (save-excursion (set-buffer buf) (goto-char p) (if (symbolp form) (call-interactively form) (eval form)))) (default-behavior-fallback (if (symbolp form) (call-interactively form) (eval form))))) ;; This stuff is from lisp/help.el (defun function-at-event (event) "Return the function whose name is around the position of EVENT. EVENT should be a mouse event. When calling from a popup or context menu, use `last-popup-menu-location' to find out where the mouse was clicked. If the event contains no position, or the position is not over text, or there is no function around that point, nil is returned." (if (and event (event-buffer event) (event-point event)) (save-excursion (set-buffer (event-buffer event)) (goto-char (event-point event)) (function-at-point)))) (defun help-symbol-run-function-1 (win buf ex fun) (let ((help-sticky-window ;; if we were called from a help buffer, make sure the new help ;; goes in the same window. (if (and buf (symbol-value-in-buffer 'help-window-config buf)) win help-sticky-window))) (funcall fun (extent-property ex 'help-symbol)))) (defun help-symbol-run-function (fun) (let* ((win (car last-popup-menu-location)) (buf (cadr last-popup-menu-location)) (p (caddr last-popup-menu-location)) (ex (extent-at p buf 'help-symbol))) (when ex (help-symbol-run-function-1 win buf ex fun)))) (defun frob-help-extents (buffer) ;; Look through BUFFER, starting at the buffer's point and continuing ;; till end of file, and find documented functions and variables. ;; any such symbol found is tagged with an extent, that sets up these ;; properties: ;; 1. mouse-face is 'highlight (so the extent gets highlighted on mouse over) ;; 2. help-symbol is the name of the symbol. ;; 3. face is 'hyper-apropos-hyperlink. ;; 4. context-menu is a list of context menu items, specific to whether ;; the symbol is a function, variable, or both. ;; 5. activate-function will cause the function or variable to be described, ;; replacing the existing help contents. (save-excursion (set-buffer buffer) (let (b e name) (while (re-search-forward help-symbol-regexp nil t) (setq b (or (match-beginning 2) (match-beginning 4))) (setq e (or (match-end 2) (match-end 4))) (setq name (buffer-substring b e)) (let* ((sym (intern-soft name)) (var (and sym (boundp sym) (documentation-property sym 'variable-documentation t))) (fun (and sym (fboundp sym) (documentation sym t)))) (when (or var fun) (let ((ex (make-extent b e))) (require 'hyper-apropos) (set-extent-property ex 'mouse-face 'highlight) (set-extent-property ex 'help-symbol sym) (set-extent-property ex 'face 'hyper-apropos-hyperlink) (set-extent-property ex 'context-menu (cond ((and var fun) help-symbol-function-and-variable-context-menu) (var help-symbol-variable-context-menu) (fun help-symbol-function-context-menu))) (set-extent-property ex 'activate-function (if fun #'(lambda (ev ex) (help-symbol-run-function-1 (event-window ev) (event-buffer ev) ex 'describe-function)) #'(lambda (ev ex) (help-symbol-run-function-1 (event-window ev) (event-buffer ev) ex 'describe-variable)))) ))))))) ;; 11 parentheses! (defun variable-at-event (event) "Return the variable whose name is around the position of EVENT. EVENT should be a mouse event. When calling from a popup or context menu, use `last-popup-menu-location' to find out where the mouse was clicked. If the event contains no position, or the position is not over text, or there is no variable around that point, nil is returned." (if (and event (event-buffer event) (event-point event)) (save-excursion (set-buffer (event-buffer event)) (goto-char (event-point event)) (variable-at-point)))) ;; This stuff is from lisp/lisp-mode.el (defun construct-lisp-mode-menu (popup-p emacs-lisp-p) (flet ((popup-wrap (form) (if popup-p `(menu-call-at-location ',form) form))) `(,＠(if emacs-lisp-p `(["%_Byte-Compile This File" ,(popup-wrap 'emacs-lisp-byte-compile)] ["B%_yte-Compile/Load This File" ,(popup-wrap 'emacs-lisp-byte-compile-and-load)] ["Byte-%_Recompile Directory..." ,(popup-wrap 'byte-recompile-directory)] "---")) ["%_Evaluate Region or Defun" ,(popup-wrap '(if (region-exists-p) (call-interactively 'eval-region) (call-interactively 'eval-defun)))] ["Evaluate %_Whole Buffer" ,(popup-wrap 'eval-current-buffer)] ["Evaluate Last %_S-expression" ,(popup-wrap 'eval-last-sexp)] "---" ,＠(if popup-p '(["%_Find Function" (find-function (menu-call-at-location '(function-at-point))) :suffix (let ((fun (menu-call-at-location '(function-at-point)))) (if fun (symbol-name fun) "")) :active (and (fboundp 'find-function) (menu-call-at-location '(function-at-point)))] ["%_Find Variable" (find-variable (menu-call-at-location '(variable-at-point))) :suffix (let ((fun (menu-call-at-location '(variable-at-point)))) (if fun (symbol-name fun) "")) :active (and (fboundp 'find-variable) (menu-call-at-location '(variable-at-point)))] ["%_Help on Function" (describe-function (menu-call-at-location '(function-at-point))) :suffix (let ((fun (menu-call-at-location '(function-at-point)))) (if fun (symbol-name fun) "")) :active (and (fboundp 'describe-function) (menu-call-at-location '(function-at-point)))] ["%_Help on Variable" (describe-variable (menu-call-at-location '(variable-at-point))) :suffix (let ((fun (menu-call-at-location '(variable-at-point)))) (if fun (symbol-name fun) "")) :active (and (fboundp 'describe-variable) (menu-call-at-location '(variable-at-point)))]) '(["Find %_Function..." find-function :active (fboundp 'find-function)] ["Find %_Variable..." find-variable :active (fboundp 'find-variable)] ["%_Help on Function..." describe-function :active (fboundp 'describe-function)] ["Hel%_p on Variable..." describe-variable :active (fboundp 'describe-variable)])) "---" ["Instrument This Defun for %_Debugging" ,(popup-wrap 'edebug-defun)] ["%_Trace Function..." trace-function-background] ["%_Untrace All Functions" untrace-all :active (fboundp 'untrace-all)] "---" ["%_Comment Out Region" comment-region :active (region-exists-p)] "---" ["%_Indent Region or Balanced Expression" ,(popup-wrap '(if (region-exists-p) (call-interactively 'indent-region) (call-interactively 'indent-sexp)))] ["I%_ndent Defun" ,(popup-wrap '(progn (beginning-of-defun) (indent-sexp)))] "---" "Look for debug-on-error under Options->Troubleshooting" ))) ;; Have to modify lisp/msw-init.el and lisp/x-init.el for 21.4 ;; Have to modify keydefs.el for 21.5 (define-key global-map 'menu #'popup-mode-menu-kbd) -- Jerry James http://www.ittc.ku.edu/~james/