Mercurial > emacs

comparison lisp/menu-bar.el @ 7150:b78bfe054561

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Make a sub-keymap for the Buffers menu bar item. (menu-bar-select-buffer, menu-bar-select-frame): New commands for that subkeymap. (menu-bar-update-buffers): New function, on menu-bar-update-hook, made partly out of mouse-menu-bar-buffers.
author Richard M. Stallman <rms@gnu.org>
date Thu, 28 Apr 1994 03:44:48 +0000
parents 54b252f540ea
children 4e0683b070f8
comparison
equal deleted inserted replaced
7149:b505aca567e0 7150:b78bfe054561
222 (if (interactive-p) 222 (if (interactive-p)
223 (message "The next yank will insert the selected text.") 223 (message "The next yank will insert the selected text.")
224 (current-kill 0)))))) 224 (current-kill 0))))))
225 (put 'mouse-menu-choose-yank 'menu-enable 'kill-ring) 225 (put 'mouse-menu-choose-yank 'menu-enable 'kill-ring)
226 226
227 (define-key global-map [menu-bar buffer] '("Buffers" . mouse-menu-bar-buffers)) 227 (define-key global-map [menu-bar buffer] '("Buffers" . menu-bar-buffers))
228
229 (defalias 'menu-bar-buffers (make-sparse-keymap "Buffers"))
228 230
229 (defvar complex-buffers-menu-p nil 231 (defvar complex-buffers-menu-p nil
230 "*Non-nil says, offer a choice of actions after you pick a buffer. 232 "*Non-nil says, offer a choice of actions after you pick a buffer.
231 This applies to the Buffers menu from the menu bar.") 233 This applies to the Buffers menu from the menu bar.")
232 234
236 If this is nil, then all buffers are shown. 238 If this is nil, then all buffers are shown.
237 A large number or nil slows down menu responsiveness.") 239 A large number or nil slows down menu responsiveness.")
238 240
239 (defvar list-buffers-directory nil) 241 (defvar list-buffers-directory nil)
240 242
241 (defun mouse-menu-bar-buffers (event) 243 (defun menu-bar-select-buffer ()
242 "Pop up a menu of buffers for selection with the mouse. 244 (interactive)
243 This switches buffers in the window that you clicked on, 245 (switch-to-buffer last-command-event))
244 and selects that window." 246
245 (interactive "e") 247 (defun menu-bar-select-frame ()
248 (interactive)
249 (make-frame-visible last-command-event)
250 (raise-frame last-command-event)
251 (select-frame last-command-event))
252
253 (defun menu-bar-update-buffers ()
246 (let ((buffers (buffer-list)) 254 (let ((buffers (buffer-list))
247 menu) 255 buffers-menu frames-menu)
248 ;; If requested, list only the N most recently selected buffers. 256 ;; If requested, list only the N most recently selected buffers.
249 (if (and (integerp buffers-menu-max-size) 257 (if (and (integerp buffers-menu-max-size)
250 (> buffers-menu-max-size 1)) 258 (> buffers-menu-max-size 1))
251 (if (> (length buffers) buffers-menu-max-size) 259 (if (> (length buffers) buffers-menu-max-size)
252 (setcdr (nthcdr buffers-menu-max-size buffers) nil))) 260 (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
253 (setq menu 261
262 ;; Make the menu of buffers proper.
263 (setq buffers-menu
254 (cons "Select Buffer" 264 (cons "Select Buffer"
255 (let ((tail buffers) 265 (let ((tail buffers)
256 (maxbuf 0) 266 (maxbuf 0)
257 (maxlen 0) 267 (maxlen 0)
268 alist
258 head) 269 head)
259 (while tail 270 (while tail
260 (or (eq ?\ (aref (buffer-name (car tail)) 0)) 271 (or (eq ?\ (aref (buffer-name (car tail)) 0))
261 (setq maxbuf 272 (setq maxbuf
262 (max maxbuf 273 (max maxbuf
265 (setq tail buffers) 276 (setq tail buffers)
266 (while tail 277 (while tail
267 (let ((elt (car tail))) 278 (let ((elt (car tail)))
268 (if (not (string-match "^ " 279 (if (not (string-match "^ "
269 (buffer-name elt))) 280 (buffer-name elt)))
270 (setq head (cons 281 (setq alist (cons
271 (cons 282 (cons
272 (format 283 (format
273 (format "%%%ds %%s%%s %%s" 284 (format "%%%ds %%s%%s %%s"
274 maxbuf) 285 maxbuf)
275 (buffer-name elt) 286 (buffer-name elt)
276 (if (buffer-modified-p elt) 287 (if (buffer-modified-p elt)
277 "*" " ") 288 "*" " ")
278 (save-excursion 289 (save-excursion
279 (set-buffer elt) 290 (set-buffer elt)
280 (if buffer-read-only "%" " ")) 291 (if buffer-read-only "%" " "))
281 (or (buffer-file-name elt) 292 (or (buffer-file-name elt)
282 (save-excursion 293 (save-excursion
283 (set-buffer elt) 294 (set-buffer elt)
284 list-buffers-directory) 295 list-buffers-directory)
285 "")) 296 ""))
286 elt) 297 elt)
287 head))) 298 alist)))
288 (and head (> (length (car (car head))) maxlen) 299 (and alist (> (length (car (car alist))) maxlen)
289 (setq maxlen (length (car (car head)))))) 300 (setq maxlen (length (car (car alist))))))
290 (setq tail (cdr tail))) 301 (setq tail (cdr tail)))
291 (nconc (nreverse head) 302 (setq alist (nreverse alist))
292 (list (cons 303 (nconc (mapcar '(lambda (pair)
293 (concat (make-string (max (- (/ maxlen 304 ;; This is somewhat risque, to use
294 2) 305 ;; the buffer name itself as the event type
295 8) 306 ;; to define, but it works.
296 0) ?\ ) 307 ;; It would not work to use the buffer
297 "List All Buffers") 308 ;; since a buffer as an event has its
298 'list-buffers)))))) 309 ;; own meaning.
310 (nconc (list (buffer-name (cdr pair))
311 (car pair)
312 (cons nil nil))
313 'menu-bar-select-buffer))
314 alist)
315 (list (cons 'list-buffers
316 (cons
317 (concat (make-string (max (- (/ maxlen
318 2)
319 8)
320 0) ?\ )
321 "List All Buffers")
322 'list-buffers)))))))
323
324 ;; Make a Frames menu if we have more than one frame.
299 (if (cdr (frame-list)) 325 (if (cdr (frame-list))
300 (setq menu 326 (setq frames-menu
301 (list menu 327 (cons "Select Frame"
302 (cons "Select Frame" 328 (mapcar '(lambda (frame)
303 (mapcar (lambda (frame) 329 (nconc (list frame
304 (cons (cdr (assq 'name 330 (cdr (assq 'name
305 (frame-parameters frame))) 331 (frame-parameters frame)))
306 frame)) 332 (cons nil nil))
307 (frame-list))))) 333 'menu-bar-select-frame))
308 (setq menu (list menu))) 334 (frame-list)))))
309 335 (if buffers-menu
310 (setq menu (cons "Buffer and Frame Menu" menu)) 336 (setq buffers-menu (cons 'keymap buffers-menu)))
311 337 (if frames-menu
312 (let ((buf (x-popup-menu (if (listp event) event 338 (setq frames-menu (cons 'keymap frames-menu)))
313 (list '(0 0) (selected-frame))) 339 (setq foo1 buffers-menu foo2 frames-menu foo3
314 menu)) 340 (cons "Buffers"
315 (window (and (listp event) (posn-window (event-start event))))) 341 (if (and buffers-menu frames-menu)
316 (cond ((framep buf) 342 (list 'keymap "Buffers and Frames"
317 (make-frame-visible buf) 343 (cons "Buffers" buffers-menu)
318 (raise-frame buf) 344 (cons "Frames" frames-menu))
319 (select-frame buf)) 345 (or buffers-menu frames-menu 'undefined))))
320 ((eq buf 'list-buffers) 346 (define-key global-map [menu-bar buffer]
321 (list-buffers)) 347 (cons "Buffers"
322 (buf 348 (if (and buffers-menu frames-menu)
323 (if complex-buffers-menu-p 349 (list 'keymap "Buffers and Frames"
324 (let ((action (x-popup-menu 350 (cons 'buffers (cons "Buffers" buffers-menu))
325 (if (listp event) event 351 (cons 'frames (cons "Frames" frames-menu)))
326 (list '(0 0) (selected-frame))) 352 (or buffers-menu frames-menu 'undefined))))))
327 '("Buffer Action" 353
328 ("" 354 (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
329 ("Save Buffer" . save-buffer)
330 ("Kill Buffer" . kill-buffer)
331 ("Select Buffer" . switch-to-buffer))))))
332 (if (eq action 'save-buffer)
333 (save-excursion
334 (set-buffer buf)
335 (save-buffer))
336 (funcall action buf)))
337 (and (windowp window)
338 (select-window window))
339 (switch-to-buffer buf)))))))
340 355
341 ;; this version is too slow 356 ;; this version is too slow
342 ;;;(defun format-buffers-menu-line (buffer) 357 ;;;(defun format-buffers-menu-line (buffer)
343 ;;; "Returns a string to represent the given buffer in the Buffer menu. 358 ;;; "Returns a string to represent the given buffer in the Buffer menu.
344 ;;;nil means the buffer shouldn't be listed. You can redefine this." 359 ;;;nil means the buffer shouldn't be listed. You can redefine this."