;; Copyright (c) 1994, 1995, 1996 Free Software Foundation, Inc.
-;; Author: Boris Goldowsky <boris@gnu.ai.mit.edu>
+;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: faces
;; This file is part of GNU Emacs.
(defcustom facemenu-unlisted-faces
'(modeline region secondary-selection highlight scratch-face
- "^font-lock-" "^gnus-" "^message-" "^ediff-" "^term-" "^vc-"
- "^widget-" "^custom-" "^vm-")
+ (purecopy "^font-lock-") (purecopy "^gnus-") (purecopy "^message-")
+ (purecopy "^ediff-") (purecopy "^term-") (purecopy "^vc-")
+ (purecopy "^widget-") (purecopy "^custom-") (purecopy "^vm-"))
"*List of faces not to include in the Face menu.
Each element may be either a symbol, which is the name of a face, or a string,
which is a regular expression to be matched against face names. Matching
(let ((map (make-sparse-keymap "Background Color")))
(define-key map "o" (cons "Other..." 'facemenu-set-background))
map)
- "Menu keymap for background colors")
+ "Menu keymap for background colors.")
;;;###autoload
(defalias 'facemenu-background-menu facemenu-background-menu)
;;;###autoload
(defvar facemenu-special-menu
(let ((map (make-sparse-keymap "Special")))
- (define-key map [?s] (cons "Remove Special" 'facemenu-remove-special))
- (define-key map [?t] (cons "Intangible" 'facemenu-set-intangible))
- (define-key map [?v] (cons "Invisible" 'facemenu-set-invisible))
- (define-key map [?r] (cons "Read-Only" 'facemenu-set-read-only))
+ (define-key map [?s] (cons (purecopy "Remove Special")
+ 'facemenu-remove-special))
+ (define-key map [?t] (cons (purecopy "Intangible")
+ 'facemenu-set-intangible))
+ (define-key map [?v] (cons (purecopy "Invisible")
+ 'facemenu-set-invisible))
+ (define-key map [?r] (cons (purecopy "Read-Only")
+ 'facemenu-set-read-only))
map)
"Menu keymap for non-face text-properties.")
;;;###autoload
;;;###autoload
(defvar facemenu-justification-menu
(let ((map (make-sparse-keymap "Justification")))
- (define-key map [?c] (cons "Center" 'set-justification-center))
- (define-key map [?b] (cons "Full" 'set-justification-full))
- (define-key map [?r] (cons "Right" 'set-justification-right))
- (define-key map [?l] (cons "Left" 'set-justification-left))
- (define-key map [?u] (cons "Unfilled" 'set-justification-none))
+ (define-key map [?c] (cons (purecopy "Center") 'set-justification-center))
+ (define-key map [?b] (cons (purecopy "Full") 'set-justification-full))
+ (define-key map [?r] (cons (purecopy "Right") 'set-justification-right))
+ (define-key map [?l] (cons (purecopy "Left") 'set-justification-left))
+ (define-key map [?u] (cons (purecopy "Unfilled") 'set-justification-none))
map)
"Submenu for text justification commands.")
;;;###autoload
(defvar facemenu-indentation-menu
(let ((map (make-sparse-keymap "Indentation")))
(define-key map [decrease-right-margin]
- (cons "Indent Right Less" 'decrease-right-margin))
+ (cons (purecopy "Indent Right Less") 'decrease-right-margin))
(define-key map [increase-right-margin]
- (cons "Indent Right More" 'increase-right-margin))
+ (cons (purecopy "Indent Right More") 'increase-right-margin))
(define-key map [decrease-left-margin]
- (cons "Indent Less" 'decrease-left-margin))
+ (cons (purecopy "Indent Less") 'decrease-left-margin))
(define-key map [increase-left-margin]
- (cons "Indent More" 'increase-left-margin))
+ (cons (purecopy "Indent More") 'increase-left-margin))
map)
"Submenu for indentation commands.")
;;;###autoload
(setq facemenu-menu (make-sparse-keymap "Text Properties"))
;;;###autoload
(let ((map facemenu-menu))
- (define-key map [dc] (cons "Display Colors" 'list-colors-display))
- (define-key map [df] (cons "Display Faces" 'list-faces-display))
- (define-key map [dp] (cons "List Properties" 'list-text-properties-at))
- (define-key map [ra] (cons "Remove Text Properties" 'facemenu-remove-all))
- (define-key map [rm] (cons "Remove Face Properties" 'facemenu-remove-face-props))
- (define-key map [s1] (list "-----------------")))
+ (define-key map [dc] (cons (purecopy "Display Colors") 'list-colors-display))
+ (define-key map [df] (cons (purecopy "Display Faces") 'list-faces-display))
+ (define-key map [dp] (cons (purecopy "List Properties")
+ 'list-text-properties-at))
+ (define-key map [ra] (cons (purecopy "Remove Text Properties")
+ 'facemenu-remove-all))
+ (define-key map [rm] (cons (purecopy "Remove Face Properties")
+ 'facemenu-remove-face-props))
+ (define-key map [s1] (list (purecopy "--"))))
;;;###autoload
(let ((map facemenu-menu))
- (define-key map [in] (cons "Indentation" 'facemenu-indentation-menu))
- (define-key map [ju] (cons "Justification" 'facemenu-justification-menu))
- (define-key map [s2] (list "-----------------"))
- (define-key map [sp] (cons "Special Properties" 'facemenu-special-menu))
- (define-key map [bg] (cons "Background Color" 'facemenu-background-menu))
- (define-key map [fg] (cons "Foreground Color" 'facemenu-foreground-menu))
- (define-key map [fc] (cons "Face" 'facemenu-face-menu)))
+ (define-key map [in] (cons (purecopy "Indentation")
+ 'facemenu-indentation-menu))
+ (define-key map [ju] (cons (purecopy "Justification")
+ 'facemenu-justification-menu))
+ (define-key map [s2] (list (purecopy "--")))
+ (define-key map [sp] (cons (purecopy "Special Properties")
+ 'facemenu-special-menu))
+ (define-key map [bg] (cons (purecopy "Background Color")
+ 'facemenu-background-menu))
+ (define-key map [fg] (cons (purecopy "Foreground Color")
+ 'facemenu-foreground-menu))
+ (define-key map [fc] (cons (purecopy "Face")
+ 'facemenu-face-menu)))
;;;###autoload
(defalias 'facemenu-menu facemenu-menu)
(defvar facemenu-keymap
(let ((map (make-sparse-keymap "Set face")))
- (define-key map "o" (cons "Other..." 'facemenu-set-face))
+ (define-key map "o" (cons (purecopy "Other...") 'facemenu-set-face))
map)
"Keymap for face-changing commands.
`Facemenu-update' fills in the keymap according to the bindings
(defcustom facemenu-add-face-function nil
- "Function called at beginning of text to change or `nil'.
+ "Function called at beginning of text to change or nil.
This function is passed the FACE to set and END of text to change, and must
return a string which is inserted. It may set `facemenu-end-add-face'."
:type '(choice (const :tag "None" nil)
:group 'facemenu)
(defcustom facemenu-end-add-face nil
- "String to insert or function called at end of text to change or `nil'.
+ "String to insert or function called at end of text to change or nil.
This function is passed the FACE to set, and must return a string which is
inserted."
:type '(choice (const :tag "None" nil)
(defcustom facemenu-remove-face-function nil
"When non-nil, this is a function called to remove faces.
This function is passed the START and END of text to change.
-May also be `t' meaning to use `facemenu-add-face-function'."
+May also be t meaning to use `facemenu-add-face-function'."
:type '(choice (const :tag "None" nil)
(const :tag "Use add-face" t)
function)
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."
- (interactive (list (read-face-name "Use face: ")))
+ (interactive (list (read-face-name "Use face")))
(barf-if-buffer-read-only)
(facemenu-add-new-face face)
(if (and mark-active (not current-prefix-arg))
;;;###autoload
(defun facemenu-set-foreground (color &optional start end)
- "Set the foreground color of the region or next character typed.
+ "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
;;;###autoload
(defun facemenu-set-background (color &optional start end)
- "Set the background color of the region or next character typed.
+ "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
;;;###autoload
(defun facemenu-set-face-from-menu (face start end)
- "Set the face of the region or next character typed.
+ "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.
(message "%s" str)
(with-output-to-temp-buffer "*Text Properties*"
(princ (format "Text properties at %d:\n\n" p))
+ (setq help-xref-stack nil)
(while props
(if (eq (car props) 'category)
(setq category (car (cdr props))))
"Read a color using the minibuffer."
(let ((col (completing-read (or prompt "Color: ")
(or facemenu-color-alist
- (if window-system
- (mapcar 'list (x-defined-colors))
- (mapcar 'list (tty-defined-colors))))
+ (mapcar 'list (defined-colors)))
nil t)))
(if (equal "" col)
nil
of colors that the current display can handle."
(interactive)
(when (null list)
- (setq list (if window-system
- (x-defined-colors)
- (tty-defined-colors)))
+ (setq list (defined-colors))
;; Delete duplicate colors.
(let ((l list))
(while (cdr l)
(defun facemenu-color-equal (a b)
"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
+This function queries the display system to find out what the color
+names mean. It returns nil if the colors differ or if it can't
determine the correct answer."
(cond ((equal a b) t)
- ((and (memq window-system '(x w32))
- (equal (x-color-values a) (x-color-values b))))
- ((eq window-system 'pc)
- (and (x-color-defined-p a) (x-color-defined-p b)
- (eq (msdos-color-translate a) (msdos-color-translate b))))))
+ ((equal (color-values a) (color-values b)))))
(defun facemenu-add-face (face &optional start end)
"Add FACE to text between START and END.
-If START is `nil' or START to END is empty, add FACE to next typed character
+If START is nil or START to END is empty, add FACE to next typed character
instead. 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.
(defun facemenu-get-face (symbol)
"Make sure FACE exists.
-If not, create it and add it to the appropriate menu. Return the symbol.
+If not, create it and add it to the appropriate menu. Return the SYMBOL.
If a window system is in use, and this function creates a face named
`fg:color', then it sets the foreground to that color. Likewise, `bg:color'
no color is set and a warning is issued."
(let ((name (symbol-name symbol))
foreground)
- (cond ((internal-find-face symbol))
- ((and window-system
+ (cond ((facep symbol))
+ ((and (display-color-p)
(or (setq foreground (string-match "^fg:" name))
(string-match "^bg:" name)))
(let ((face (make-face symbol))
(nreverse (face-list)))
list))
-(defun facemenu-iterate (func iterate-list)
+(defun facemenu-iterate (func list)
"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."
- (while (and iterate-list (not (funcall func (car iterate-list))))
- (setq iterate-list (cdr iterate-list)))
- (car iterate-list))
+ (while (and list (not (funcall func (car list))))
+ (setq list (cdr list)))
+ (car list))
(facemenu-update)