[nongnu] elpa/prop-menu 01ae5d4 1/9: Initial commit

[ELPA Syncer]

branch: elpa/prop-menu
commit 01ae5d470dd160654cb6506112a0a657fe5d9d34
Author: David Raymond Christiansen <david@davidchristiansen.dk>
Commit: David Raymond Christiansen <david@davidchristiansen.dk>

    Initial commit
---
 .gitignore   |   1 +
 README.org   |  27 +++++++++++++++
 prop-menu.el | 110 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 138 insertions(+)

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..b25c15b
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+*~
diff --git a/README.org b/README.org
new file mode 100644
index 0000000..a847450
--- /dev/null
+++ b/README.org
@@ -0,0 +1,27 @@
+* Pop-up menus based on text properties
+
+This is a library for computing context menus based on text
+properties and overlays. The intended use is to have tools that
+annotate source code and others that use these annotations, without
+requiring a direct coupling between them, but maintaining
+discoverability.
+
+Major modes that wish to use this library should first define an
+appropriate value for =prop-menu-item-functions=. Then, they should
+bind =prop-menu-by-completing-read= to an appropriate
+key. Optionally, a mouse pop-up can be added by binding
+=prop-menu-show-menu= to a mouse event.
+
+For example, the following value for =prop-menu-item-functions=
+creates a popup menu that will describe faces that are set in either
+text or overlay properties:
+#+BEGIN_SRC elisp
+  (setq-local prop-menu-item-functions
+              (list (lambda (plist)
+                      (let ((face (plist-get plist 'face)))
+                        (when face
+                          (list (list "Describe face" (lambda ()
+                                                        (interactive)
+                                                        (describe-face 
face)))))))))
+#+END_SRC
+Note that this setting requires lexical scope.
diff --git a/prop-menu.el b/prop-menu.el
new file mode 100644
index 0000000..079e3e6
--- /dev/null
+++ b/prop-menu.el
@@ -0,0 +1,110 @@
+;;; prop-menu.el --- Create and display a context menu based on text and 
overlay properties  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015  David Raymond Christiansen
+
+;; Author: David Christiansen <david@davidchristiansen.dk>
+;; URL: https://github.com/david-christiansen/prop-menu-el
+;; Package-Requires:  ((emacs "24.3") (cl-lib "0.5"))
+;; Version: 0.1
+;; Keywords: convenience
+
+;; This program 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 3 of the License, or
+;; (at your option) any later version.
+
+;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a library for computing context menus based on text
+;; properties and overlays. The intended use is to have tools that
+;; annotate source code and others that use these annotations, without
+;; requiring a direct coupling between them, but maintaining
+;; discoverability.
+
+;; Major modes that wish to use this library should first define an
+;; appropriate value for `prop-menu-item-functions'. Then, they should
+;; bind `prop-menu-by-completing-read' to an appropriate
+;; key. Optionally, a mouse pop-up can be added by binding
+;; `prop-menu-show-menu' to a mouse event.
+
+;;; Code:
+(require 'cl-lib)
+
+(defun prop-menu--merge-plists (plists)
+  "Merge PLISTS, resolving conflicts to the left."
+  (let ((res (pop plists))
+        this-plist k v)
+    (while plists
+      (setq this-plist (pop plists))
+      (while this-plist
+        (setq k (pop this-plist))
+        (setq v (pop this-plist))
+        (unless (plist-get res k)
+          (plist-put res k v))))
+    res))
+
+(defvar-local prop-menu-item-functions nil
+  "A list of functions to compute menu items from text and overlay properties.
+
+Each function should take a plist as its argument and return a
+list of menu items. A menu item consists of a string to be
+displayed to the user and a command to be executed if that item
+is selected. Separators can be added by using \"--\" as the string.
+
+Major modes that provide context menus are expected to populate
+this variable with appropriate functions.")
+
+(let ((counter 0))
+  (defun prop-menu--unique-val ()
+    (cl-incf counter)))
+
+(defun prop-menu--items-for-location (where)
+  "Return the menu items based on the text properties and overlays at WHERE."
+  (let* ((text-props (text-properties-at where))
+         (overlays (overlays-at where t))
+         (overlay-props-list (mapcar #'overlay-properties overlays))
+         (props (prop-menu--merge-plists (cons text-props 
overlay-props-list))))
+    (apply #'append
+           (cl-loop for fun in prop-menu-item-functions
+                    collecting (funcall fun props)))))
+
+(defun prop-menu-by-completing-read (where)
+  "Show a text menu for WHERE, based on the text properties and overlays.
+
+When called interactively, WHERE defaults to point."
+  (interactive "d")
+  (let* ((menu-items (prop-menu--items-for-location where))
+         (selection (completing-read "Command: " menu-items nil t)))
+    (when selection
+      (let ((cmd (assoc selection menu-items)))
+        (when cmd (funcall (cadr cmd)))))))
+
+(defun prop-menu-show-menu (click)
+  "Show a menu based on the location of CLICK, computed from the value of 
`prop-menu-item-functions'."
+  (interactive "e")
+  (let* ((where (posn-point (event-end click)))
+         (menu-items (prop-menu--items-for-location where)))
+    (when menu-items
+      (let* ((menu (make-sparse-keymap))
+             (todo (cl-loop for (str action) in menu-items
+                            collecting (let ((sym (prop-menu--unique-val)))
+                                         (define-key-after menu `[,sym]
+                                           `(menu-item ,str (lambda () 
(interactive)))
+                                           t)
+                                         (cons sym action))))
+             (selection (x-popup-menu t menu)))
+        (when selection
+          (funcall (cdr (assoc (car selection) todo))))))))
+
+(local-set-key (kbd "<mouse-3>") 'prop-menu-show-menu)
+
+(provide 'prop-menu)
+;;; prop-menu.el ends here