Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/wrolo-menu.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 85ec50267440
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;!emacs
2 ;;
3 ;; FILE: wrolo-menu.el
4 ;; SUMMARY: Pulldown and popup menus of Hyperbole rolodex commands.
5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: hypermedia, matching, mouse
7 ;;
8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Motorola, Inc., PPG
10 ;;
11 ;; ORIG-DATE: 28-Oct-94 at 10:59:44
12 ;; LAST-MOD: 31-Oct-95 at 18:45:24 by Bob Weiner
13 ;;
14 ;; Copyright (C) 1994-1995 Free Software Foundation, Inc.
15 ;;
16 ;; This file is part of Hyperbole.
17 ;;
18 ;; DESCRIPTION:
19 ;; DESCRIP-END.
20
21 ;;; ************************************************************************
22 ;;; Public variables
23 ;;; ************************************************************************
24
25 ;;; This definition is used by InfoDock and XEmacs.
26 (defconst infodock-wrolo-menu
27 '("Rolodex"
28 ["Manual" (id-tool-invoke id-man-rolodex) t]
29 "----"
30 ["Add-Entry" (id-tool-invoke 'rolo-add) t]
31 ["Delete-Entry" (id-tool-invoke 'rolo-kill) t]
32 ["Display-Prior-Matches" (id-tool-invoke 'rolo-display-matches) t]
33 ["Edit-Entry" (id-tool-invoke 'rolo-edit) t]
34 ["Edit-Rolodex" (id-tool-invoke
35 '(progn (require 'wrolo)
36 (find-file (car rolo-file-list))
37 (setq buffer-read-only nil)))
38 t]
39 ["Insert-Entry-at-Point" (id-tool-invoke 'rolo-yank) t]
40 ["Mail-to-Address" (id-tool-invoke 'rolo-mail-to) t]
41 ["Search-for-Regexp" (id-tool-invoke 'rolo-grep) t]
42 ["Search-for-String" (id-tool-invoke 'rolo-fgrep) t]
43 ["Search-for-Word" (id-tool-invoke 'rolo-word) t]
44 ["Sort-Entries" (id-tool-invoke 'rolo-sort) t]
45 ))
46
47 ;;; This definition is used by InfoDock only.
48 (defconst id-menubar-wrolo
49 (list
50 '("Wrolo"
51 ["Help" describe-mode t]
52 ["Manual" (id-info "(hyperbole.info)Rolo Keys") t]
53 "----"
54 ["Toggle-Read-Only" toggle-read-only t]
55 ["Write (Save as)" write-file t]
56 "----"
57 ["Quit" (id-tool-quit '(kill-buffer nil)) t]
58 )
59 '["Edit-Entry-at-Point" rolo-edit-entry t]
60 ["Mail-to-Address" (id-tool-invoke 'rolo-mail-to) t]
61 '("Move"
62 ["Scroll-Backward" scroll-down t]
63 ["Scroll-Forward" scroll-up t]
64 ["To-Beginning" beginning-of-buffer t]
65 ["To-End" end-of-buffer t]
66 "----"
67 ["To-Next-Entry" outline-next-visible-heading t]
68 ["To-Next-Same-Level" outline-forward-same-level t]
69 ["To-Previous-Entry" outline-previous-visible-heading t]
70 ["To-Previous-Same-Level" outline-backward-same-level t]
71 ["Up-a-Level" outline-up-heading t]
72 )
73 '("Outline"
74 ["Hide (Collapse)" hide-subtree t]
75 ["Show (Expand)" show-subtree t]
76 ["Show-All" show-all t]
77 ["Show-Only-First-Line" hide-body t]
78 )
79 '["Next-Match" rolo-next-match t]
80 '["Previous-Match" rolo-previous-match t]
81 infodock-wrolo-menu
82 ))
83
84 ;;; This definition is used by InfoDock and XEmacs.
85 (defconst id-popup-wrolo-menu
86 (list
87 "Wrolo"
88 '["Help" describe-mode t]
89 '["Manual" (id-info "(hyperbole.info)Rolo Keys") t]
90 "----"
91 '["Edit-Entry-at-Point" rolo-edit-entry t]
92 "----"
93 '["Next-Match" rolo-next-match t]
94 '["Previous-Match" rolo-previous-match t]
95 "----"
96 '("Move"
97 ["Scroll-Backward" scroll-down t]
98 ["Scroll-Forward" scroll-up t]
99 ["To-Beginning" beginning-of-buffer t]
100 ["To-End" end-of-buffer t]
101 "----"
102 ["To-Next-Entry" outline-next-visible-heading t]
103 ["To-Next-Same-Level" outline-forward-same-level t]
104 ["To-Previous-Entry" outline-previous-visible-heading t]
105 ["To-Previous-Same-Level" outline-backward-same-level t]
106 ["Up-a-Level" outline-up-heading t]
107 )
108 '("Outline"
109 ["Hide (Collapse)" hide-subtree t]
110 ["Show (Expand)" show-subtree t]
111 ["Show-All" show-all t]
112 ["Show-Only-First-Line" hide-body t]
113 )
114 infodock-wrolo-menu
115 "----"
116 '["Quit" (id-tool-quit 'rolo-quit) t]
117 ))
118
119 ;;; ************************************************************************
120 ;;; Public functions
121 ;;; ************************************************************************
122
123 ;;; This definition is used only by XEmacs and Emacs19.
124 (defun wrolo-menubar-menu ()
125 "Add a Hyperbole Rolodex menu to the rolodex match buffer menubar."
126 (cond ((fboundp 'popup-mode-menu)
127 (setq mode-popup-menu id-popup-wrolo-menu))
128 (hyperb:lemacs-p
129 (define-key wrolo-mode-map 'button3 'wrolo-popup-menu))
130 (t ;; hyperb:emacs19-p
131 (define-key wrolo-mode-map [down-mouse-3] 'wrolo-popup-menu)
132 (define-key wrolo-mode-map [mouse-3] nil)))
133 (if (and (boundp 'current-menubar)
134 (or hyperb:emacs19-p current-menubar)
135 (not (car (find-menu-item current-menubar '("Wrolo")))))
136 (progn
137 (set-buffer-menubar (copy-sequence current-menubar))
138 (if (fboundp 'add-submenu)
139 (add-submenu nil id-popup-wrolo-menu)
140 (add-menu nil (car id-popup-wrolo-menu)
141 (cdr id-popup-wrolo-menu))))))
142
143 ;;; This definition is used only by XEmacs and Emacs19.
144 (defun wrolo-popup-menu (event)
145 "Popup the Hyperbole Rolodex match buffer menu."
146 (interactive "@e")
147 (mouse-set-point event)
148 (if (fboundp 'popup-mode-menu)
149 (popup-mode-menu)
150 (popup-menu id-popup-wrolo-menu)))
151
152 (cond ((null hyperb:window-system))
153 ((fboundp 'id-menubar-set)
154 ;; InfoDock under a window system
155 (require 'id-menubars)
156 (id-menubar-set 'wrolo-mode 'id-menubar-wrolo))
157 (hyperb:lemacs-p
158 ;; XEmacs under a window system
159 (add-hook 'wrolo-mode-hook 'wrolo-menubar-menu))
160 (hyperb:emacs19-p
161 ;; Emacs 19 under a window system
162 (require 'lmenu)
163 (add-hook 'wrolo-mode-hook 'wrolo-menubar-menu)))
164
165 (provide 'wrolo-menu)