Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-toolbar.el @ 146:2af401a6ecca r20-2p1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-2p1
author cvs
date Mon, 13 Aug 2007 09:34:46 +0200
parents 1370575f1259
children 43dd3413c7c7
comparison
equal deleted inserted replaced
145:e13feca31ba6 146:2af401a6ecca
317 317
318 (defun vm-toolbar-install-toolbar () 318 (defun vm-toolbar-install-toolbar ()
319 (vm-toolbar-initialize) 319 (vm-toolbar-initialize)
320 (let ((height (+ 4 (glyph-height (car vm-toolbar-help-icon)))) 320 (let ((height (+ 4 (glyph-height (car vm-toolbar-help-icon))))
321 (width (+ 4 (glyph-width (car vm-toolbar-help-icon)))) 321 (width (+ 4 (glyph-width (car vm-toolbar-help-icon))))
322 (frame (selected-frame))
323 (buffer (current-buffer))
324 (tag-set '(win))
322 (myframe (vm-created-this-frame-p)) 325 (myframe (vm-created-this-frame-p))
323 toolbar ) 326 toolbar )
324 ;; glyph-width and glyph-height return 0 at startup sometimes 327 ;; glyph-width and glyph-height return 0 at startup sometimes
325 ;; use reasonable values if they fail. 328 ;; use reasonable values if they fail.
326 (if (= width 4) 329 (if (= width 4)
334 (setq toolbar (vm-toolbar-make-toolbar-spec) 337 (setq toolbar (vm-toolbar-make-toolbar-spec)
335 vm-toolbar toolbar)) 338 vm-toolbar toolbar))
336 (cond ((eq vm-toolbar-orientation 'right) 339 (cond ((eq vm-toolbar-orientation 'right)
337 (setq vm-toolbar-specifier right-toolbar) 340 (setq vm-toolbar-specifier right-toolbar)
338 (if myframe 341 (if myframe
339 (set-specifier right-toolbar (cons (selected-frame) toolbar))) 342 (set-specifier right-toolbar toolbar frame tag-set))
340 (set-specifier right-toolbar (cons (current-buffer) toolbar)) 343 (set-specifier right-toolbar toolbar buffer)
341 (set-specifier right-toolbar-width 344 (set-specifier right-toolbar-width width frame tag-set))
342 (cons (selected-frame) width)))
343 ((eq vm-toolbar-orientation 'left) 345 ((eq vm-toolbar-orientation 'left)
344 (setq vm-toolbar-specifier left-toolbar) 346 (setq vm-toolbar-specifier left-toolbar)
345 (if myframe 347 (if myframe
346 (set-specifier left-toolbar (cons (selected-frame) toolbar))) 348 (set-specifier left-toolbar toolbar frame tag-set))
347 (set-specifier left-toolbar (cons (current-buffer) toolbar)) 349 (set-specifier left-toolbar toolbar buffer)
348 (set-specifier left-toolbar-width 350 (set-specifier left-toolbar-width width frame tag-set))
349 (cons (selected-frame) width)))
350 ((eq vm-toolbar-orientation 'bottom) 351 ((eq vm-toolbar-orientation 'bottom)
351 (setq vm-toolbar-specifier bottom-toolbar) 352 (setq vm-toolbar-specifier bottom-toolbar)
352 (if myframe 353 (if myframe
353 (set-specifier bottom-toolbar (cons (selected-frame) toolbar))) 354 (set-specifier bottom-toolbar toolbar frame tag-set))
354 (set-specifier bottom-toolbar (cons (current-buffer) toolbar)) 355 (set-specifier bottom-toolbar toolbar buffer)
355 (set-specifier bottom-toolbar-height 356 (set-specifier bottom-toolbar-height height frame tag-set))
356 (cons (selected-frame) height)))
357 (t 357 (t
358 (setq vm-toolbar-specifier top-toolbar) 358 (setq vm-toolbar-specifier top-toolbar)
359 (if myframe 359 (if myframe
360 (set-specifier top-toolbar (cons (selected-frame) toolbar))) 360 (set-specifier top-toolbar toolbar frame tag-set))
361 (set-specifier top-toolbar (cons (current-buffer) toolbar)) 361 (set-specifier top-toolbar toolbar buffer)
362 (set-specifier top-toolbar-height 362 (set-specifier top-toolbar-height height frame tag-set)))))
363 (cons (selected-frame) height))))))
364 363
365 (defun vm-toolbar-make-toolbar-spec () 364 (defun vm-toolbar-make-toolbar-spec ()
366 (let ((button-alist '( 365 (let ((button-alist '(
367 (autofile . vm-toolbar-autofile-button) 366 (autofile . vm-toolbar-autofile-button)
368 (compose . vm-toolbar-compose-button) 367 (compose . vm-toolbar-compose-button)
399 (cond 398 (cond
400 ((null vm-toolbar-help-icon) 399 ((null vm-toolbar-help-icon)
401 (let ((tuples 400 (let ((tuples
402 (if (featurep 'xpm) 401 (if (featurep 'xpm)
403 (list 402 (list
404 (if (>= (device-bitplanes) 16) 403 (if (and (device-on-window-system-p)
404 (>= (device-bitplanes) 16))
405 '(vm-toolbar-decode-mime-icon "mime-colorful-up.xpm" 405 '(vm-toolbar-decode-mime-icon "mime-colorful-up.xpm"
406 "mime-colorful-dn.xpm" 406 "mime-colorful-dn.xpm"
407 "mime-colorful-xx.xpm") 407 "mime-colorful-xx.xpm")
408 '(vm-toolbar-decode-mime-icon "mime-simple-up.xpm" 408 '(vm-toolbar-decode-mime-icon "mime-simple-up.xpm"
409 "mime-simple-dn.xpm" 409 "mime-simple-dn.xpm"