;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Jun 16 09:22:32 1995 ;;; from file /home/fsf/rms/e19/lisp/facemenu.el ;;; emacs version 19.28.94.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`facemenu.el' was compiled for Emacs 19.29 or later")) (provide (quote facemenu)) #@42 Prefix key to use for facemenu commands. (defvar facemenu-key "ç" (#$ . 504)) #@591 Alist of interesting faces and keybindings. Each element is itself a list: the car is the name of the face, the next element is the key to use as a keyboard equivalent of the menu item; the binding is made in facemenu-keymap. The faces specifically mentioned in this list are put at the top of the menu, in the order specified. All other faces which are defined, except for those in `facemenu-unlisted-faces', are listed after them, but get no keyboard equivalents. If you change this variable after loading facemenu.el, you will need to call `facemenu-update' to make it take effect. (defvar facemenu-keybindings (quote ((default . "d") (bold . "b") (italic . "i") (bold-italic . "l") (underline . "u"))) (#$ . 589)) #@154 Where in the menu to insert newly-created faces. This should be nil to put them at the top of the menu, or t to put them just before "Other" at the end. (defvar facemenu-new-faces-at-end t (#$ . 1319)) #@311 List of faces not to include in the Face menu. Set this before loading facemenu.el, or call `facemenu-update' after changing it. If this variable is t, no faces will be added to the menu. This is useful for temporarily turning off the feature that automatically adds faces to the menu when they are created. (defvar facemenu-unlisted-faces (quote (modeline region secondary-selection highlight scratch-face font-lock-comment-face font-lock-string-face font-lock-keyword-face font-lock-function-name-face font-lock-variable-name-face font-lock-type-face font-lock-reference-face)) (#$ . 1528)) #@24 Menu keymap for faces. (defvar facemenu-face-menu (byte-code "ÀÁ!Ã\nÄÅÆB#ˆ\n)‡" [make-sparse-keymap "Face" map define-key "o" "Other..." facemenu-set-face] 5) (#$ . 2129)) (defalias (quote facemenu-face-menu) facemenu-face-menu) #@36 Menu keymap for foreground colors. (defvar facemenu-foreground-menu (byte-code "ÀÁ!Ã\nÄÅÆB#ˆ\n)‡" [make-sparse-keymap "Foreground Color" map define-key "o" "Other..." facemenu-set-foreground] 5) (#$ . 2365)) (defalias (quote facemenu-foreground-menu) facemenu-foreground-menu) #@35 Menu keymap for background colors (defvar facemenu-background-menu (byte-code "ÀÁ!Ã\nÄÅÆB#ˆ\n)‡" [make-sparse-keymap "Background Color" map define-key "o" "Other..." facemenu-set-background] 5) (#$ . 2649)) (defalias (quote facemenu-background-menu) facemenu-background-menu) #@43 Menu keymap for non-face text-properties. (defvar facemenu-special-menu (byte-code "ÀÁ!Ã\nÄÅÆB#ˆÃ\nÇÈÉB#ˆÃ\nÊËÌB#ˆÃ\nÍÎÏB#ˆ\n)‡" [make-sparse-keymap "Special" map define-key [115] "Remove Special" facemenu-remove-special [116] "Intangible" facemenu-set-intangible [118] "Invisible" facemenu-set-invisible [114] "Read-Only" facemenu-set-read-only] 5) (#$ . 2932)) (defalias (quote facemenu-special-menu) facemenu-special-menu) #@42 Submenu for text justification commands. (defvar facemenu-justification-menu (byte-code "ÀÁ!Ã\nÄÅÆB#ˆÃ\nÇÈÉB#ˆÃ\nÊËÌB#ˆÃ\nÍÎÏB#ˆÃ\nÐÑÒB#ˆ\n)‡" [make-sparse-keymap "Justification" map define-key [99] "Center" set-justification-center [98] "Full" set-justification-full [114] "Right" set-justification-right [108] "Left" set-justification-left [117] "Unfilled" set-justification-none] 5) (#$ . 3365)) (defalias (quote facemenu-justification-menu) facemenu-justification-menu) #@35 Submenu for indentation commands. (defvar facemenu-indentation-menu (byte-code "ÀÁ!Ã\nÄÅÆB#ˆÃ\nÇÈÉB#ˆÃ\nÊËÌB#ˆÃ\nÍÎÏB#ˆ\n)‡" [make-sparse-keymap "Indentation" map define-key [decrease-right-margin] "Indent Right Less" decrease-right-margin [increase-right-margin] "Indent Right More" increase-right-margin [decrease-left-margin] "Indent Less" decrease-left-margin [increase-left-margin] "Indent More" increase-left-margin] 5) (#$ . 3846)) (defalias (quote facemenu-indentation-menu) facemenu-indentation-menu) #@33 Facemenu top-level menu keymap. (defvar facemenu-menu nil (#$ . 4363)) (byte-code "ÀÁ!‰Ä ÅÆÇB#ˆÄ ÈÉÊB#ˆÄ ËÌÍB#ˆÄ ÎÏÐB#ˆÄ ÑÒÓB#ˆÄ ÔÕC#ˆ)\nÄ Ö×ØB#ˆÄ ÙÚÛB#ˆÄ ÜÕC#ˆÄ ÝÞßB#ˆÄ àáâB#ˆÄ ãäåB#ˆÄ æçèB#ˆ)éÂ\n\"‡" [make-sparse-keymap "Text Properties" facemenu-menu map define-key [dc] "Display Colors" list-colors-display [df] "Display Faces" list-faces-display [dp] "List Properties" list-text-properties-at [ra] "Remove All" facemenu-remove-all [rm] "Remove Properties" facemenu-remove-props [s1] "-----------------" [in] "Indentation" facemenu-indentation-menu [ju] "Justification" facemenu-justification-menu [s2] [sp] "Special Properties" facemenu-special-menu [bg] "Background Color" facemenu-background-menu [fg] "Foreground Color" facemenu-foreground-menu [fc] "Face" facemenu-face-menu defalias] 6) #@137 Keymap for face-changing commands. `Facemenu-update' fills in the keymap according to the bindings requested in `facemenu-keybindings'. (defvar facemenu-keymap (byte-code "ÀÁ!Ã\nÄÅÆB#ˆ\n)‡" [make-sparse-keymap "Set face" map define-key "o" "Other..." facemenu-set-face] 5) (#$ . 5170)) (defalias (quote facemenu-keymap) facemenu-keymap) #@83 Alist of colors, used for completion. If null, `facemenu-read-color' will set it. (defvar facemenu-color-alist nil (#$ . 5514)) #@138 Add or update the "Face" menu in the menu bar. You can call this to update things if you change any of the menu configuration variables. (defalias 'facemenu-update #[nil "À ÂÃ#ˆ\fƒÀ \fÅ#ˆÆÇÈ !\"‡" [define-key global-map [C-down-mouse-2] facemenu-menu facemenu-key facemenu-keymap facemenu-iterate facemenu-add-new-face facemenu-complete-face-list facemenu-keybindings] 4 (#$ . 5649) nil]) #@524 Add FACE to the region or next character typed. It will be added to the top of the face list; any faces lower on the list that will not show through at all will be removed. Interactively, the face to be used is read with the minibuffer. If the region is active and there is no prefix argument, this command sets the region to the requested face. Otherwise, this command specifies the face for the next character inserted. Moving point or switching buffers before typing a character to insert cancels the specification. (defalias 'facemenu-set-face #[(face &optional start end) "À ˆÁ\n!ˆ ƒ'\f„' †Æ †È É\n #*‡Ê\n!‡" [barf-if-buffer-read-only facemenu-add-new-face face mark-active current-prefix-arg start region-beginning end region-end facemenu-add-face facemenu-self-insert-face] 4 (#$ . 6048) (list (read-face-name "Use face: "))]) #@437 Set the foreground color of the region or next character typed. The color is prompted for. A face named `fg:color' is used (or created). If the region is active, it will be set to the requested face. If it is inactive (even if mark-even-if-inactive is set) the next character that is typed (via `self-insert-command') will be set to the selected face. Moving point or switching buffers before typing a character cancels the request. (defalias 'facemenu-set-foreground #[(color &optional start end) "ÀÁ\nP!Ä !„ÅÆ\n\"ˆÇ  #)‡" [intern "fg:" color face facemenu-get-face error "Unknown color: %s" facemenu-set-face start end] 4 (#$ . 6906) (list (facemenu-read-color "Foreground color: "))]) #@437 Set the background color of the region or next character typed. The color is prompted for. A face named `bg:color' is used (or created). If the region is active, it will be set to the requested face. If it is inactive (even if mark-even-if-inactive is set) the next character that is typed (via `self-insert-command') will be set to the selected face. Moving point or switching buffers before typing a character cancels the request. (defalias 'facemenu-set-background #[(color &optional start end) "ÀÁ\nP!Ä !„ÅÆ\n\"ˆÇ  #)‡" [intern "bg:" color face facemenu-get-face error "Unknown color: %s" facemenu-set-face start end] 4 (#$ . 7610) (list (facemenu-read-color "Background color: "))]) #@431 Set the face of the region or next character typed. This function is designed to be called from a menu; the face to use is the menu item's name. If the region is active and there is no prefix argument, this command sets the region to the requested face. Otherwise, this command specifies the face for the next character inserted. Moving point or switching buffers before typing a character to insert cancels the specification. (defalias 'facemenu-set-face-from-menu #[(face start end) "À ˆÁ\n!ˆ ƒÄ\n #‡Æ\n!‡" [barf-if-buffer-read-only facemenu-get-face face start facemenu-add-face end facemenu-self-insert-face] 4 (#$ . 8314) (list last-command-event (if (and mark-active (not current-prefix-arg)) (region-beginning)) (if (and mark-active (not current-prefix-arg)) (region-end)))]) (defalias 'facemenu-self-insert-face #[(face) " =ƒ\n <ƒ ‚ CB‚\n\f‰‡" [last-command self-insert-face-command face self-insert-face this-command] 2]) #@118 Make the region invisible. This sets the `invisible' text property; it can be undone with `facemenu-remove-special'. (defalias 'facemenu-set-invisible #[(start end) "À \nÃÄ$‡" [put-text-property start end invisible t] 5 (#$ . 9269) "r"]) #@145 Make the region intangible: disallow moving into it. This sets the `intangible' text property; it can be undone with `facemenu-remove-special'. (defalias 'facemenu-set-intangible #[(start end) "À \nÃÄ$‡" [put-text-property start end intangible t] 5 (#$ . 9514) "r"]) #@121 Make the region unmodifiable. This sets the `read-only' text property; it can be undone with `facemenu-remove-special'. (defalias 'facemenu-set-read-only #[(start end) "À \nÃÄ$‡" [put-text-property start end read-only t] 5 (#$ . 9788) "r"]) #@59 Remove all text properties that facemenu added to region. (defalias 'facemenu-remove-props #[(start end) "À \fÅ#)‡" [t inhibit-read-only remove-text-properties start end (face nil invisible nil intangible nil read-only nil category nil)] 4 (#$ . 10035) "*r"]) #@45 Remove all text properties from the region. (defalias 'facemenu-remove-all #[(start end) "À \fÅ#)‡" [t inhibit-read-only set-text-properties start end nil] 4 (#$ . 10303) "*r"]) #@135 Remove all the "special" text properties from the region. These special properties include `invisible', `intangible' and `read-only'. (defalias 'facemenu-remove-special #[(start end) "À \fÅ#)‡" [t inhibit-read-only remove-text-properties start end (invisible nil intangible nil read-only nil)] 4 (#$ . 10490) "*r"]) #@54 Pop up a buffer listing text-properties at LOCATION. (defalias 'list-text-properties-at #[(p) "À !‰„ÃÄ!‚0ÅÆÇÈ \"!ˆ\n…/ÆÇÉ\n@\nA@#!ˆ\nAA‰„Ê‘)‡" [text-properties-at p props message "None" "*Text Properties*" princ format "Text properties at %d:\n\n" "%-20s %S\n" nil] 7 (#$ . 10814) "d"]) #@36 Read a color using the minibuffer. (defalias 'facemenu-read-color #[(&optional prompt) "À † †\fÅ=…ÆÇÈ \"ÉÊ$‰ Ìš?…# )‡" [completing-read prompt "Color: " facemenu-color-alist window-system x mapcar list x-defined-colors nil t col ""] 6 (#$ . 11116)]) #@236 Display names of defined colors, and show what they look like. If the optional argument LIST is non-nil, it should be a list of colors to display. Otherwise, this command computes a list of colors that the current display can handle. (defalias 'list-colors-display #[(&optional list) "„/ Â=ƒ/à ‰\fAƒ.Å\f@\fA@\"ƒ'\f‰AA¡ˆ‚\fA‰‚)ÆŠqˆÈÉ\n …z`\n@cˆÌjˆÍ\n`ÎÏÐÑ@P!!$ˆ`\nÒ@Ó±ˆÍ\n`ÎÏÐÔ@P!!$ˆA‰„@É+‘‡" [list window-system x x-defined-colors l facemenu-color-equal "*Colors*" standard-output t nil s facemenu-unlisted-faces 20 put-text-property face facemenu-get-face intern "bg:" " " "\n" "fg:"] 10 (#$ . 11383) nil]) #@257 Return t if colors A and B are the same color. A and B should be strings naming colors. This function queries the window-system server to find out what the color names mean. It returns nil if the colors differ or if it can't determine the correct answer. (defalias 'facemenu-color-equal #[(a b) " šƒ‡ Ä=…Å!Å !š‡" [a b t window-system x x-color-values] 3 (#$ . 12031)]) #@380 Add FACE to text between START and END. For each section of that region that has a different face property, FACE will be consed onto it, and other faces that are completely hidden by that will be removed from the list. As a special case, if FACE is `default', then the region is left with NO face text property. Otherwise, selecting the default face would not have any effect. (defalias 'facemenu-add-face #[(face start end) "Á=ƒ\f \fÅ#‡ Ɖ\fU?…UÉÀÆ\f$ÊÀ\" ÌÀ „8‚JÍ <ƒE ‚H CB!$ˆ)‰‚*‡" [face default remove-text-properties start end (face default) nil part-end part-start next-single-property-change get-text-property prev put-text-property facemenu-discard-redundant-faces] 8 (#$ . 12415) "*xFace:\nr"]) #@143 Remove from FACE-LIST any faces that won't show at all. This means they have no non-nil elements that aren't also non-nil in an earlier face. (defalias 'facemenu-discard-redundant-faces #[(face-list &optional mask) "À\n„\nÀ‚b „\n@Ä\nAÅÆ\n@!!\"B‚b GÆ\n@!S‰ÉYƒMHƒ( H„(Ê ÊIˆ‚( *ƒ]\n@Ä\nA \"B‚bÄ\nA \")‡" [nil useful face-list mask facemenu-discard-redundant-faces copy-sequence internal-get-face face i 0 t] 6 (#$ . 13163)]) #@276 Make sure FACE exists. If not, it is created. If it is created and is of the form `fg:color', then set the foreground to that color. If of the form `bg:color', set the background. In any case, add it to the appropriate menu. Returns the face, or nil if given a bad color. (defalias 'facemenu-get-face #[(symbol) "À !„O !Ä !‰ÆÇOÉÊ \"ƒ/Ë \"ˆ\fÍ=…KÎ!‚KÉÏ \"ƒJÐ \"ˆ\fÍ=…KÎ!‚KÑ+…P ‡" [internal-find-face symbol make-face face symbol-name name 3 nil color string-match "^fg:" set-face-foreground window-system x x-color-defined-p "^bg:" set-face-background t] 4 (#$ . 13621)]) #@91 Add a FACE to the appropriate Face menu. Automatically called when a new face is created. (defalias 'facemenu-add-new-face #[(face) "À !ÃÄ\n\"ƒ\nÅÆOÇ‚%ÃÈ\n\"ƒ$\nÅÆOÉ‚%Ê Ì  \"AÆÆÒ=„¹ >„¹ƒsÓÔ\nP!‰ÕÆÖ×Ø DDFMˆÙÚ\nB#ˆÙ \nB#ˆ‚¹ÛÜ KA\"„¹Ý !Þ Kƒ®GÅVƒ®à\nBGÅZ8@$ˆ‚¹Ù \nB#ˆ-Ƈ" [symbol-name face name string-match "^fg:" 3 nil facemenu-foreground-menu "^bg:" facemenu-background-menu facemenu-face-menu menu assoc facemenu-keybindings key function menu-val facemenu-unlisted-faces t intern "facemenu-set-" lambda (interactive) facemenu-set-face quote define-key facemenu-keymap facemenu-iterate #[(m) "<…@9…Á@\n\"‡" [m face-equal face] 3] vector facemenu-set-face-from-menu facemenu-new-faces-at-end define-key-after] 8 (#$ . 14224)]) #@255 Return list of all faces that are look different. Starts with given ALIST of faces, and adds elements only if they display differently from any face already on the list. The faces on ALIST will end up at the end of the returned list, in reverse order. (defalias 'facemenu-complete-face-list #[(&optional oldlist) "ÀÁ\n\"ŸÄÅÆ Ÿ\"ˆ )‡" [mapcar car oldlist list facemenu-iterate #[(new-face) " >„\n B‡" [new-face list nil] 2] face-list] 3 (#$ . 15031)]) #@123 Apply FUNC to each element of LIST until one returns non-nil. Returns the non-nil value it found, or nil if all were nil. (defalias 'facemenu-iterate #[(func iterate-list) "ƒ @!„A‰„@‡" [iterate-list func] 3 (#$ . 15497)]) (facemenu-update)