1 ;;; x-popup-menu.el --- Mimic x-popup-menu in FSF Emacs
3 ;; Copyright (C) 1998 by Free Software Foundation, Inc.
5 ;; Author: Jeff Miller <jmiller@smart.net>
8 ;; This file is part of XEmacs.
10 ;; XEmacs is free software; you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; XEmacs is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
25 ;;; Synched up with: Not in FSF
32 (defun x-popup-menu (event menu)
33 "Pop up menu for Mouse-2 for selected date in the calendar window."
35 (let ((title (car menu))
36 ;; try to ignore just a "" string, XEmacs will typically add two
37 ;; horizontal lines after the title. A "" just adds a third
38 (mb-items (if (string-match "" (car (car (cdr menu))))
39 (cdr (car (cdr menu)))
43 ;; pop up menu & get the selection
44 (setq selection (get-popup-menu-response
45 (cons title (convert_fsf_popup mb-items)) event))
47 ;; normally, we'll get a <#event (call-intercatively function)>
48 ;; return, but if nothing was selected, we'll have <#event
49 ;; (run-hooks menu-no-select-hook. So, if something is selected,
50 ;; return it, other run the hook
51 (if (string-match (symbol-name (event-function selection))
53 (setq selection (event-object selection))
54 (funcall (event-function selection) (event-object selection))
58 (defun convert_fsf_popup (menu)
59 "Convert FSF style menu notation to the XEmacs format."
60 ;; map over list, converting cons cells to vectors. Strings will be
61 ;; turned into vectors as well, just with a nil function
63 (cond (;; Solitary string
64 (and (stringp (car x))
68 (and (stringp (car x))
69 (not (true-list-p x)))
70 (vector (car x) (cdr x)))
72 (and (stringp (car x))
73 (true-list-p (cdr x)))
74 (cons (car x) (convert_fsf_popup (cdr x))))
79 (provide 'x-popup-menu)
80 ;;; x-popup-menu.el ends here