Mercurial > hg > xemacs-beta

comparison lisp/wid-edit.el @ 436:080151679be2 r21-2-26

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-26
author cvs
date Mon, 13 Aug 2007 11:31:24 +0200
parents 3ecd8885ac67
children 8de8e3f6228a
comparison
equal deleted inserted replaced
435:53cf74a9db44 436:080151679be2
1896 (defcustom widget-push-button-gui widget-glyph-enable 1896 (defcustom widget-push-button-gui widget-glyph-enable
1897 "If non nil, use GUI push buttons when available." 1897 "If non nil, use GUI push buttons when available."
1898 :group 'widgets 1898 :group 'widgets
1899 :type 'boolean) 1899 :type 'boolean)
1900 1900
1901 ;; Cache already created GUI objects.
1902 (defvar widget-push-button-cache nil)
1903
1904 (defcustom widget-push-button-prefix "[" 1901 (defcustom widget-push-button-prefix "["
1905 "String used as prefix for buttons." 1902 "String used as prefix for buttons."
1906 :type 'string 1903 :type 'string
1907 :group 'widget-button) 1904 :group 'widget-button)
1908 1905
1923 (let* ((tag (or (widget-get widget :tag) 1920 (let* ((tag (or (widget-get widget :tag)
1924 (widget-get widget :value))) 1921 (widget-get widget :value)))
1925 (tag-glyph (widget-get widget :tag-glyph)) 1922 (tag-glyph (widget-get widget :tag-glyph))
1926 (text (concat widget-push-button-prefix 1923 (text (concat widget-push-button-prefix
1927 tag widget-push-button-suffix)) 1924 tag widget-push-button-suffix))
1928 (gui-glyphs (lax-plist-get widget-push-button-cache tag))) 1925 gui)
1929 (cond (tag-glyph 1926 (cond (tag-glyph
1930 (widget-glyph-insert widget text tag-glyph)) 1927 (widget-glyph-insert widget text tag-glyph))
1931 ;; We must check for console-on-window-system-p here, 1928 ;; We must check for console-on-window-system-p here,
1932 ;; because GUI will not work otherwise (it needs RGB 1929 ;; because GUI will not work otherwise (it needs RGB
1933 ;; components for colors, and they are not known on TTYs). 1930 ;; components for colors, and they are not known on TTYs).
1934 ((and widget-push-button-gui 1931 ((and widget-push-button-gui
1935 (console-on-window-system-p)) 1932 (console-on-window-system-p))
1936 (unless gui-glyphs 1933 (let* ((gui-button-shadow-thickness 1))
1937 (let* ((gui-button-shadow-thickness 1) 1934 (setq gui (make-glyph
1938 (gui (make-glyph 1935 (make-gui-button tag 'widget-gui-action widget))))
1939 (make-gui-button tag 'widget-gui-action widget)))) 1936 (widget-glyph-insert-glyph widget gui))
1940 (setq gui-glyphs gui)
1941 (laxputf widget-push-button-cache tag gui-glyphs)))
1942 (widget-glyph-insert-glyph widget gui-glyphs))
1943 (t 1937 (t
1944 (insert text))))) 1938 (insert text)))))
1945 1939
1946 (defun widget-gui-action (widget) 1940 (defun widget-gui-action (widget)
1947 "Apply :action for WIDGET." 1941 "Apply :action for WIDGET."