├── .gitignore ├── .travis.yml ├── Makefile ├── README.org ├── prop-menu-tests.el └── prop-menu.el /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: emacs-lisp 2 | sudo: false 3 | 4 | cache: 5 | directories: 6 | - $HOME/emacs-24.3 7 | - $HOME/emacs-24.4 8 | - $HOME/emacs-24.5 9 | 10 | before_install: 11 | # Emacs 24.3 12 | - wget http://ftpmirror.gnu.org/emacs/emacs-24.3.tar.xz 13 | - tar -xf emacs-24.3.tar.xz 14 | - cd emacs-24.3 15 | - if [ ! -e bin/emacs ]; then ./configure --prefix=$HOME/emacs-24.3 --with-xpm=no --with-gif=no ; make ; make install ; fi 16 | - cd .. 17 | 18 | # Emacs 24.4 19 | - wget http://ftpmirror.gnu.org/emacs/emacs-24.4.tar.xz 20 | - tar -xf emacs-24.4.tar.xz 21 | - cd emacs-24.4 22 | - if [ ! -e bin/emacs ]; then ./configure --prefix=$HOME/emacs-24.4 --with-xpm=no --with-gif=no ; make ; make install ; fi 23 | - cd .. 24 | 25 | # Emacs 24.5 26 | - wget http://ftpmirror.gnu.org/emacs/emacs-24.5.tar.xz 27 | - tar -xf emacs-24.5.tar.xz 28 | - cd emacs-24.5 29 | - if [ ! -e bin/emacs ]; then ./configure --prefix=$HOME/emacs-24.5 --with-xpm=no --with-gif=no ; make ; make install ; fi 30 | - cd .. 31 | 32 | before_script: true 33 | 34 | script: 35 | # emacs 24.3 36 | - make getdeps EMACS=$HOME/emacs-24.3/bin/emacs 37 | - make build EMACS=$HOME/emacs-24.3/bin/emacs 38 | - make test EMACS=$HOME/emacs-24.3/bin/emacs 39 | - make clean 40 | 41 | # emacs 24.4 42 | - make getdeps EMACS=$HOME/emacs-24.4/bin/emacs 43 | - make build EMACS=$HOME/emacs-24.4/bin/emacs 44 | - make test EMACS=$HOME/emacs-24.4/bin/emacs 45 | - make clean 46 | 47 | # emacs 24.5 48 | - make getdeps EMACS=$HOME/emacs-24.5/bin/emacs 49 | - make build EMACS=$HOME/emacs-24.5/bin/emacs 50 | - make test EMACS=$HOME/emacs-24.5/bin/emacs 51 | - make clean 52 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | EMACS=emacs24 2 | 3 | BATCHEMACS=$(EMACS) --batch --no-site-file -q -eval '(add-to-list (quote load-path) "${PWD}/")' -eval '(require (quote package))' -eval '(add-to-list (quote package-archives) (quote ("melpa" . "http://melpa.org/packages/")) t)' -eval '(package-initialize)' 4 | 5 | BYTECOMP = $(BATCHEMACS) -eval '(progn (require (quote bytecomp)) (setq byte-compile-warnings t) (setq byte-compile-error-on-warn t))' -f batch-byte-compile 6 | 7 | OBJS = prop-menu.elc 8 | 9 | .el.elc: 10 | $(BYTECOMP) $< 11 | 12 | build: $(OBJS) 13 | 14 | test: 15 | $(BATCHEMACS) -l ert -l prop-menu-tests.el -f ert-run-tests-batch-and-exit 16 | 17 | clean: 18 | -rm -f $(OBJS) 19 | 20 | getdeps: 21 | $(BATCHEMACS) -eval '(progn (package-refresh-contents))' 22 | 23 | .PHONY: clean build test 24 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | * Pop-up menus based on text properties 2 | 3 | This is a library for computing context menus based on text 4 | properties and overlays. The intended use is to have tools that 5 | annotate source code and others that use these annotations, without 6 | requiring a direct coupling between them, but maintaining 7 | discoverability. 8 | 9 | Major modes that wish to use this library should first define an 10 | appropriate value for =prop-menu-item-functions=. Then, they should 11 | bind =prop-menu-by-completing-read= to an appropriate 12 | key. Optionally, a mouse pop-up can be added by binding 13 | =prop-menu-show-menu= to a mouse event. 14 | 15 | For example, the following value for =prop-menu-item-functions= 16 | creates a popup menu that will describe faces that are set in either 17 | text or overlay properties: 18 | #+BEGIN_SRC elisp 19 | (setq-local prop-menu-item-functions 20 | (list (lambda (plist) 21 | (let ((face (plist-get plist 'face))) 22 | (when face 23 | (list (list "Describe face" (lambda () 24 | (interactive) 25 | (describe-face face))))))))) 26 | #+END_SRC 27 | Note that this setting requires lexical scope. 28 | -------------------------------------------------------------------------------- /prop-menu-tests.el: -------------------------------------------------------------------------------- 1 | ;;; prop-menu-tests.el --- Tests for prop-menu -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2015 David Christiansen 4 | 5 | ;; Author: David Christiansen 6 | ;; Keywords: 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; Simple tests for prop-menu 24 | 25 | ;;; Code: 26 | 27 | (require 'cl-lib) 28 | (require 'prop-menu) 29 | 30 | (ert-deftest trivial-test () 31 | (should t)) 32 | 33 | 34 | (provide 'prop-menu-tests) 35 | ;;; prop-menu-tests.el ends here 36 | -------------------------------------------------------------------------------- /prop-menu.el: -------------------------------------------------------------------------------- 1 | ;;; prop-menu.el --- Create and display a context menu based on text and overlay properties -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2015 David Raymond Christiansen 4 | 5 | ;; Author: David Christiansen 6 | ;; URL: https://github.com/david-christiansen/prop-menu-el 7 | ;; Package-Requires: ((emacs "24.3") (cl-lib "0.5")) 8 | ;; Version: 0.1.2 9 | ;; Keywords: convenience 10 | 11 | ;; This program is free software; you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation, either version 3 of the License, or 14 | ;; (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | 26 | ;; This is a library for computing context menus based on text 27 | ;; properties and overlays. The intended use is to have tools that 28 | ;; annotate source code and others that use these annotations, without 29 | ;; requiring a direct coupling between them, but maintaining 30 | ;; discoverability. 31 | 32 | ;; Major modes that wish to use this library should first define an 33 | ;; appropriate value for `prop-menu-item-functions'. Then, they should 34 | ;; bind `prop-menu-by-completing-read' to an appropriate 35 | ;; key. Optionally, a mouse pop-up can be added by binding 36 | ;; `prop-menu-show-menu' to a mouse event. 37 | 38 | ;;; Code: 39 | (require 'cl-lib) 40 | 41 | (defun prop-menu--merge-plists (plists) 42 | "Merge PLISTS, resolving conflicts to the left." 43 | (let ((res (pop plists)) 44 | this-plist k v) 45 | (while plists 46 | (setq this-plist (pop plists)) 47 | (while this-plist 48 | (setq k (pop this-plist)) 49 | (setq v (pop this-plist)) 50 | (unless (plist-get res k) 51 | (plist-put res k v)))) 52 | res)) 53 | 54 | (defvar prop-menu-item-functions nil 55 | "A list of functions to compute menu items from text and overlay properties. 56 | 57 | Each function should take a plist as its argument and return a 58 | list of menu items. A menu item consists of a string to be 59 | displayed to the user and a command to be executed if that item 60 | is selected. Separators can be added by using \"--\" as the string. 61 | 62 | Major modes that provide context menus are expected to populate 63 | this variable with appropriate functions.") 64 | (make-variable-buffer-local 'prop-menu-item-functions) 65 | 66 | (defvar prop-menu--unique-val-counter 0 67 | "A global counter for unique values for prop-menu.") 68 | (defun prop-menu--unique-val () 69 | "Get a unique value for internal tagging." 70 | (cl-incf prop-menu--unique-val-counter)) 71 | 72 | (defun prop-menu--overlays-at (where) 73 | "Return the overlays at location WHERE, sorted in order of priority." 74 | (cond ((< emacs-major-version 24) 75 | (error "Can't get overlays for prop-menu in Emacs versions < 24")) 76 | ((and (= emacs-major-version 24) 77 | (< emacs-minor-version 4)) 78 | ;; The SORTED argument to `overlays-at' was added in Emacs 24.4. Here, we fake it. 79 | (let ((overlays (overlays-at where))) 80 | (sort overlays 81 | #'(lambda (o1 o2) 82 | (let ((p1 (or (overlay-get o1 'priority) 0)) 83 | (p2 (or (overlay-get o2 'priority) 0))) 84 | (when (not (numberp p1)) (setq p1 0)) 85 | (when (not (numberp p2)) (setq p2 0)) 86 | (or (> p1 p2) 87 | (and (= p1 p2) 88 | (> (overlay-start o1) (overlay-start o2))))))))) 89 | ;; In Emacs 24.4 and up, we can just have Emacs do the sorting. 90 | ;; Warnings are disabled here to not break CI for Emacs 24.3. 91 | (t (with-no-warnings (overlays-at where t))))) 92 | 93 | (defun prop-menu--items-for-location (where) 94 | "Return the menu items based on the text properties and overlays at WHERE." 95 | (let* ((text-props (text-properties-at where)) 96 | (overlays (prop-menu--overlays-at where)) 97 | (overlay-props-list (mapcar #'overlay-properties overlays)) 98 | (props (prop-menu--merge-plists (cons text-props overlay-props-list)))) 99 | (apply #'append 100 | (cl-loop for fun in prop-menu-item-functions 101 | collecting (funcall fun props))))) 102 | 103 | (defun prop-menu-by-completing-read (where) 104 | "Show a text menu for WHERE, based on the text properties and overlays. 105 | 106 | When called interactively, WHERE defaults to point." 107 | (interactive "d") 108 | (let ((menu-items (prop-menu--items-for-location where))) 109 | (when menu-items 110 | (let ((selection (completing-read "Command: " menu-items nil t))) 111 | (when selection 112 | (let ((cmd (assoc selection menu-items))) 113 | (when cmd (funcall (cadr cmd))))))))) 114 | 115 | (defun prop-menu-show-menu (click) 116 | "Show a menu based on the location of CLICK, computed from the value of `prop-menu-item-functions'. 117 | 118 | When calling `prop-menu-item-functions', point is at the clicked 119 | location." 120 | (interactive "e") 121 | (let* ((window (posn-window (event-end click))) 122 | (buffer (window-buffer window)) 123 | (where (posn-point (event-end click))) 124 | (menu-items (with-current-buffer buffer 125 | (save-excursion 126 | (goto-char where) 127 | (prop-menu--items-for-location where))))) 128 | (when menu-items 129 | (let* ((menu (make-sparse-keymap)) 130 | (todo (cl-loop for (str action) in menu-items 131 | collecting (let ((sym (prop-menu--unique-val))) 132 | (define-key-after menu `[,sym] 133 | `(menu-item ,str (lambda () (interactive))) 134 | t) 135 | (cons sym action)))) 136 | (selection (x-popup-menu t menu))) 137 | (when selection 138 | (funcall (cdr (assoc (car selection) todo)))))))) 139 | 140 | (provide 'prop-menu) 141 | ;;; prop-menu.el ends here 142 | --------------------------------------------------------------------------------