122 lines
4.8 KiB
EmacsLisp
122 lines
4.8 KiB
EmacsLisp
;;; dvc-cmenu.el --- code implementing a context menu with keyboard
|
|
|
|
;; Copyright (C) 2006 by all contributors
|
|
|
|
;; This file is part of DVC.
|
|
;;
|
|
;; DVC is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|
;; any later version.
|
|
|
|
;; DVC is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
;; Boston, MA 02110-1301, USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Generally context menu is supported only mouse pressing(or clicking).
|
|
;; In Xtla, I proposed a context menu supporting operation by keyboard:
|
|
;; an user can type C-j to pop the context menu under the point up.
|
|
;; I think it is quite useful, so I decide to separate the code from
|
|
;; xtla.el.
|
|
;; In addition dvc-cmenu supports target item highlighting during popup.
|
|
;; So during popup, a user can recognize the context of menu popup now.
|
|
|
|
;;; Code:
|
|
(eval-when-compile (require 'dvc-utils))
|
|
|
|
(defvar dvc-cmenu 'dvc-cmenu
|
|
"Name of property for embedding a context menu to text.")
|
|
|
|
(defun dvc-cmenu-beginning (point)
|
|
"Search backward the position where `dvc-cmenu' property is changed."
|
|
(previous-single-property-change point dvc-cmenu))
|
|
|
|
(defun dvc-cmenu-end (point)
|
|
"Search forward the position where `dvc-cmenu' property is changed."
|
|
(next-single-property-change point dvc-cmenu))
|
|
|
|
(defun dvc-cmenu-popup-by-mouse (event prefix)
|
|
"Generic function to popup a menu.
|
|
|
|
The menu is defined in the text property under the point which is
|
|
given by mouse. EVENT is the mouse event that called the function.
|
|
PREFIX is passed to `dvc-cmenu-popup'."
|
|
(interactive "e\nP")
|
|
(mouse-set-point event)
|
|
(dvc-cmenu-popup prefix))
|
|
|
|
;; Copied from avoid.el.
|
|
(defun dvc-cmenu-mouse-avoidance-point-position (point)
|
|
"Return the position of POINT as (FRAME X . Y).
|
|
Analogous to `mouse-position'. Copied from avoid.el."
|
|
(dvc-do-in-gnu-emacs
|
|
(let* ((w (selected-window))
|
|
(edges (window-edges w))
|
|
(list
|
|
(compute-motion (max (window-start w) (point-min)) ; start pos
|
|
;; window-start can be < point-min if the
|
|
;; latter has changed since the last redisplay
|
|
'(0 . 0) ; start XY
|
|
point ; stop pos
|
|
(cons (window-width) (window-height)) ; stop XY: none
|
|
(1- (window-width)) ; width
|
|
(cons (window-hscroll w) 0) ; 0 may not be right?
|
|
(selected-window))))
|
|
;; compute-motion returns (pos HPOS VPOS prevhpos contin)
|
|
;; we want: (frame hpos . vpos)
|
|
(cons (selected-frame)
|
|
(cons (+ (car edges) (car (cdr list)))
|
|
(+ (car (cdr edges)) (car (cdr (cdr list)))))))))
|
|
|
|
(defun dvc-cmenu-popup (prefix)
|
|
"Popup a menu defined in the text property under the point.
|
|
|
|
PREFIX is passed to `popup-menu'."
|
|
(interactive "P")
|
|
(if (get-text-property (point) dvc-cmenu)
|
|
(let* ((menu (get-text-property (point) dvc-cmenu))
|
|
(p (previous-single-property-change (point) dvc-cmenu nil
|
|
(line-beginning-position)))
|
|
(n (next-single-property-change (point) dvc-cmenu nil
|
|
(line-end-position)))
|
|
(b (if (and p (get-text-property p dvc-cmenu)) p (point)))
|
|
(e (if n n (point))))
|
|
(if (and (not (featurep 'xemacs)) (interactive-p))
|
|
(let* ((pos (dvc-cmenu-mouse-avoidance-point-position e))
|
|
(object (car pos))
|
|
(x (cadr pos))
|
|
(y (cddr pos)))
|
|
(set-mouse-position object x y)))
|
|
(dvc-cmenu-popup-with-highlight 'dvc-highlight
|
|
b e
|
|
menu
|
|
prefix))
|
|
(error "No context-menu under the point")))
|
|
|
|
(defun dvc-cmenu-popup-with-highlight (face begin end menu &optional prefix)
|
|
"Put FACE on BEGIN and END in the buffer during Popup MENU.
|
|
PREFIX is passed to `popup-menu'."
|
|
(let (o)
|
|
(unwind-protect
|
|
(progn
|
|
(setq o (make-overlay begin end))
|
|
(overlay-put o 'face face)
|
|
(sit-for 0)
|
|
(popup-menu menu prefix))
|
|
(delete-overlay o))))
|
|
|
|
(provide 'dvc-cmenu)
|
|
|
|
;; Local Variables:
|
|
;; End:
|
|
|
|
;;; dvc-cmenu.el ends here
|