diff options
Diffstat (limited to 'lisp/facemenu.el')
| -rw-r--r-- | lisp/facemenu.el | 139 |
1 files changed, 69 insertions, 70 deletions
diff --git a/lisp/facemenu.el b/lisp/facemenu.el index dc5f8f46aba..7229d6163df 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -85,22 +85,17 @@ ;;; Code: -;; Global bindings: -(define-key global-map [C-down-mouse-2] 'facemenu-menu) -(define-key global-map "\M-o" 'facemenu-keymap) - (defgroup facemenu nil "Create a face menu for interactively adding fonts to text." :group 'faces :prefix "facemenu-") (defcustom facemenu-keybindings - (mapcar 'purecopy '((default . "d") (bold . "b") (italic . "i") - (bold-italic . "l") ; {bold} intersect {italic} = {l} - (underline . "u"))) + (bold-italic . "l") ; {bold} intersect {italic} = {l} + (underline . "u")) "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; @@ -151,7 +146,7 @@ it will remove any faces not explicitly in the list." (defvar facemenu-face-menu (let ((map (make-sparse-keymap "Face"))) - (define-key map "o" (cons (purecopy "Other...") 'facemenu-set-face)) + (define-key map "o" (cons "Other..." 'facemenu-set-face)) map) "Menu keymap for faces.") (defalias 'facemenu-face-menu facemenu-face-menu) @@ -159,7 +154,7 @@ it will remove any faces not explicitly in the list." (defvar facemenu-foreground-menu (let ((map (make-sparse-keymap "Foreground Color"))) - (define-key map "o" (cons (purecopy "Other...") 'facemenu-set-foreground)) + (define-key map "o" (cons "Other..." 'facemenu-set-foreground)) map) "Menu keymap for foreground colors.") (defalias 'facemenu-foreground-menu facemenu-foreground-menu) @@ -167,12 +162,20 @@ it will remove any faces not explicitly in the list." (defvar facemenu-background-menu (let ((map (make-sparse-keymap "Background Color"))) - (define-key map "o" (cons (purecopy "Other...") 'facemenu-set-background)) + (define-key map "o" (cons "Other..." 'facemenu-set-background)) map) "Menu keymap for background colors.") (defalias 'facemenu-background-menu facemenu-background-menu) (put 'facemenu-background-menu 'menu-enable '(facemenu-enable-faces-p)) +(defcustom facemenu-add-face-function 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) + function) + :group 'facemenu) + ;;; Condition for enabling menu items that set faces. (defun facemenu-enable-faces-p () ;; Enable the facemenu if facemenu-add-face-function is defined @@ -182,27 +185,22 @@ it will remove any faces not explicitly in the list." (defvar facemenu-special-menu (let ((map (make-sparse-keymap "Special"))) - (define-key map [?s] (cons (purecopy "Remove Special") - 'facemenu-remove-special)) - (define-key map [?c] (cons (purecopy "Charset") - 'facemenu-set-charset)) - (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)) + (define-key map [?s] (cons "Remove Special" 'facemenu-remove-special)) + (define-key map [?c] (cons "Charset" 'facemenu-set-charset)) + (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)) map) "Menu keymap for non-face text-properties.") (defalias 'facemenu-special-menu facemenu-special-menu) (defvar facemenu-justification-menu (let ((map (make-sparse-keymap "Justification"))) - (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)) + (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)) map) "Submenu for text justification commands.") (defalias 'facemenu-justification-menu facemenu-justification-menu) @@ -210,13 +208,13 @@ it will remove any faces not explicitly in the list." (defvar facemenu-indentation-menu (let ((map (make-sparse-keymap "Indentation"))) (define-key map [decrease-right-margin] - (cons (purecopy "Indent Right Less") 'decrease-right-margin)) + (cons "Indent Right Less" 'decrease-right-margin)) (define-key map [increase-right-margin] - (cons (purecopy "Indent Right More") 'increase-right-margin)) + (cons "Indent Right More" 'increase-right-margin)) (define-key map [decrease-left-margin] - (cons (purecopy "Indent Less") 'decrease-left-margin)) + (cons "Indent Less" 'decrease-left-margin)) (define-key map [increase-left-margin] - (cons (purecopy "Indent More") 'increase-left-margin)) + (cons "Indent More" 'increase-left-margin)) map) "Submenu for indentation commands.") (defalias 'facemenu-indentation-menu facemenu-indentation-menu) @@ -226,36 +224,37 @@ it will remove any faces not explicitly in the list." "Facemenu top-level menu keymap.") (setq facemenu-menu (make-sparse-keymap "Text Properties")) (let ((map facemenu-menu)) - (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 "Describe Properties") - 'describe-text-properties)) - (define-key map [ra] (list 'menu-item (purecopy "Remove Text Properties") + (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 "Describe Properties" 'describe-text-properties)) + (define-key map [ra] (list 'menu-item "Remove Text Properties" 'facemenu-remove-all :enable 'mark-active)) - (define-key map [rm] (list 'menu-item (purecopy "Remove Face Properties") + (define-key map [rm] (list 'menu-item "Remove Face Properties" 'facemenu-remove-face-props :enable 'mark-active)) - (define-key map [s1] (list (purecopy "--")))) + (define-key map [s1] (list "--"))) (let ((map facemenu-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))) + (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))) (defalias 'facemenu-menu facemenu-menu) +;;;###autoload (autoload 'facemenu-menu "facemenu" nil nil 'keymap) +;;;###autoload +(define-key global-map [C-down-mouse-2] 'facemenu-menu) + +(easy-menu-add-item + menu-bar-edit-menu nil + ["Text Properties" facemenu-menu]) + (defvar facemenu-keymap (let ((map (make-sparse-keymap "Set face"))) - (define-key map "o" (cons (purecopy "Other...") 'facemenu-set-face)) + (define-key map "o" (cons "Other..." 'facemenu-set-face)) (define-key map "\M-o" 'font-lock-fontify-block) map) "Keymap for face-changing commands. @@ -264,14 +263,6 @@ requested in `facemenu-keybindings'.") (defalias 'facemenu-keymap facemenu-keymap) -(defcustom facemenu-add-face-function 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) - function) - :group 'facemenu) - (defcustom facemenu-end-add-face 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 @@ -295,6 +286,7 @@ May also be t meaning to use `facemenu-add-face-function'." (defvar facemenu-color-alist nil "Alist of colors, used for completion. If this is nil, then the value of (defined-colors) is used.") +(make-obsolete-variable 'facemenu-color-alist nil "28.1") (defun facemenu-update () "Add or update the \"Face\" menu in the menu bar. @@ -542,6 +534,7 @@ filter out the color from the output." This is installed as a `revert-buffer-function' in the *Colors* buffer." (list-colors-display nil (buffer-name) list-colors-callback)) +;;;###autoload (defun list-colors-display (&optional list buffer-name callback) "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 @@ -725,7 +718,13 @@ they are used to set the face information. 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. See `facemenu-remove-face-function'." - (interactive "*xFace: \nr") + (interactive (list (progn + (barf-if-buffer-read-only) + (read-face-name "Use face" (face-at-point t))) + (if (and mark-active (not current-prefix-arg)) + (region-beginning)) + (if (and mark-active (not current-prefix-arg)) + (region-end)))) (cond ((and (eq face 'default) (not (eq facemenu-remove-face-function t))) @@ -821,11 +820,11 @@ This is called whenever you create a new face, and at other times." symbol (intern name))) (setq menu 'facemenu-face-menu) (setq docstring - (purecopy (format "Select face `%s' for subsequent insertion. + (format "Select face `%s' for subsequent insertion. If the mark is active and there is no prefix argument, apply face `%s' to the region instead. This command was defined by `facemenu-add-new-face'." - name name))) + name name)) (cond ((facemenu-iterate ; check if equivalent face is already in the menu (lambda (m) (and (listp m) (symbolp (car m)) @@ -838,15 +837,15 @@ This command was defined by `facemenu-add-new-face'." (key (setq function (intern (concat "facemenu-set-" name))) (fset function - `(lambda () - ,docstring - (interactive) - (facemenu-set-face - (quote ,symbol) - (if (and mark-active (not current-prefix-arg)) - (region-beginning)) - (if (and mark-active (not current-prefix-arg)) - (region-end))))) + (lambda () + (:documentation docstring) + (interactive) + (facemenu-set-face + symbol + (if (and mark-active (not current-prefix-arg)) + (region-beginning)) + (if (and mark-active (not current-prefix-arg)) + (region-end))))) (define-key 'facemenu-keymap key (cons name function)) (define-key menu key (cons name function))) ;; Faces with no keyboard equivalent. Figure out where to put it: |