Mercurial > hg > xemacs-beta

comparison lisp/prim/menubar.el @ 175:2d532a89d707 r20-3b14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b14
author cvs
date Mon, 13 Aug 2007 09:50:14 +0200
parents 131b0175ea99
children a2f645c6b9f8
comparison
equal deleted inserted replaced
174:bb3568571b84 175:2d532a89d707
64 (list "menu name (first element) must be a string" menu))) 64 (list "menu name (first element) must be a string" menu)))
65 ;;(or (cdr menu) (signal 'error (list "menu is empty" menu))) 65 ;;(or (cdr menu) (signal 'error (list "menu is empty" menu)))
66 (setq menu (cdr menu))) 66 (setq menu (cdr menu)))
67 (let (menuitem item) 67 (let (menuitem item)
68 (while (keywordp (setq item (car menu))) 68 (while (keywordp (setq item (car menu)))
69 (or (memq item '(:config :included :filter)) 69 (or (memq item '(:config :included :filter :accelerator))
70 (signal 'error 70 (signal 'error
71 (list "menu keyword must be :config, :included, or :filter" 71 (list "menu keyword must be :config, :included, :accelerator or :filter"
72 item))) 72 item)))
73 (if (or (not (cdr menu)) 73 (if (or (not (cdr menu))
74 (vectorp (nth 1 menu)) 74 (vectorp (nth 1 menu))
75 (keywordp (nth 1 menu))) 75 (keywordp (nth 1 menu)))
76 (signal 'error (list "strange keyword value" item (nth 1 menu)))) 76 (signal 'error (list "strange keyword value" item (nth 1 menu))))
131 style 131 style
132 item) 132 item)
133 (while (< i L) 133 (while (< i L)
134 (setq item (aref menuitem i)) 134 (setq item (aref menuitem i))
135 (cond ((not (memq item '(:active :suffix :keys :style 135 (cond ((not (memq item '(:active :suffix :keys :style
136 :full :included :selected))) 136 :full :included :selected
137 :accelerator)))
137 (signal 'error 138 (signal 'error
138 (list (if (keywordp item) 139 (list (if (keywordp item)
139 "unknown menu item keyword" 140 "unknown menu item keyword"
140 "not a keyword") 141 "not a keyword")
141 item menuitem))) 142 item menuitem)))
489 (select-window (if (windowp event) event 490 (select-window (if (windowp event) event
490 (event-window event))) 491 (event-window event)))
491 (funcall (event-function response) 492 (funcall (event-function response)
492 (event-object response)))))) 493 (event-object response))))))
493 494
495 ;; provide default bindings for menu accelerator map
496 (and (boundp 'menu-accelerator-map)
497 (keymapp menu-accelerator-map)
498 (progn
499 (define-key menu-accelerator-map "\e" 'menu-escape)
500 (define-key menu-accelerator-map [left] 'menu-left)
501 (define-key menu-accelerator-map [right] 'menu-right)
502 (define-key menu-accelerator-map [up] 'menu-up)
503 (define-key menu-accelerator-map [down] 'menu-down)
504 (define-key menu-accelerator-map [return] 'menu-select)
505 (define-key menu-accelerator-map [kp_down] 'menu-down)
506 (define-key menu-accelerator-map [kp_up] 'menu-down)
507 (define-key menu-accelerator-map [kp_left] 'menu-left)
508 (define-key menu-accelerator-map [kp_right] 'menu-right)
509 (define-key menu-accelerator-map [kp_enter] 'menu-select)
510 (define-key menu-accelerator-map "\C-g" 'menu-quit)))
511
494 512
495 (provide 'menubar) 513 (provide 'menubar)