comparison lisp/facemenu.el @ 12014:e4932082046a

(facemenu-special-menu): Use characters, not symbols. Add Remove Special menu item. (facemenu-remove-special): New function. (facemenu-set-face-from-menu): If prefix arg, treat region as inactive. (facemenu-set-face): Likewise. (facemenu-keymap, facemenu-foreground-menu, facemenu-background-menu): Add ... after Other. (facemenu-menu): Change name to Text Properties. (facemenu-remove-really-all): New function. (facemenu-special-menu): Add Remove All menu item. (facemenu-indentation-menu): Make item names clearer. Pick new key names too. (facemenu-menu): Split up definition. Move `Remove All' item here. (facemenu-special-menu): Delete `Remove All' item. (facemenu-remove-all): Renamed from facemenu-remove-really-all. (facemenu-remove-props): Renamed from facemenu-remove-all.

12013:0d5bb768982e

(defalias 'facemenu-face-menu facemenu-face-menu)

;;;###autoload
(defvar facemenu-foreground-menu 
  (let ((map (make-sparse-keymap "Foreground Color")))
    (define-key map "o" (cons "Other" 'facemenu-set-foreground))
    map)
  "Menu keymap for foreground colors.")
;;;###autoload
(defalias 'facemenu-foreground-menu facemenu-foreground-menu)

;;;###autoload
(defvar facemenu-background-menu
  (let ((map (make-sparse-keymap "Background Color")))
    (define-key map "o" (cons "Other" 'facemenu-set-background))
    map)
  "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 [read-only] (cons "Read-Only" 'facemenu-set-read-only))
    (define-key map [invisible] (cons "Invisible" 'facemenu-set-invisible))
    (define-key map [intangible] (cons "Intangible" 'facemenu-set-intangible))
    map)
  "Menu keymap for non-face text-properties.")
;;;###autoload
(defalias 'facemenu-special-menu facemenu-special-menu)

(defalias 'facemenu-justification-menu facemenu-justification-menu)

;;;###autoload
(defvar facemenu-indentation-menu
  (let ((map (make-sparse-keymap "Indentation")))
    (define-key map [UnIndentRight] 
      (cons "UnIndentRight" 'decrease-right-margin))
    (define-key map [IndentRight]
      (cons "IndentRight" 'increase-right-margin))
    (define-key map [Unindent]
      (cons "UnIndent" 'decrease-left-margin))
    (define-key map [Indent]
      (cons "Indent" 'increase-left-margin))
    map)
  "Submenu for indentation commands.")
;;;###autoload
(defalias 'facemenu-indentation-menu facemenu-indentation-menu)

;;;###autoload
(defvar facemenu-menu 
  (let ((map (make-sparse-keymap "Face")))
    (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 [rm] (cons "Remove Properties" 'facemenu-remove-all))
    (define-key map [s1] (list "-----------------"))
    (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 Props" '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))
    map)
  "Facemenu top-level menu keymap.")
;;;###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))
    map)
  "Keymap for face-changing commands.
`Facemenu-update' fills in the keymap according to the bindings
requested in `facemenu-keybindings'.")
(defalias 'facemenu-keymap facemenu-keymap)

(defun facemenu-set-face (face &optional start end)
  "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 prompted for.
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 \(or otherwise inserted) will be set to
the selected face.  Moving point or switching buffers before
typing a character cancels the request." 
  (interactive (list (read-face-name "Use face: ")))
  (barf-if-buffer-read-only)
  (facemenu-add-new-face face)
  (if mark-active
      (let ((start (or start (region-beginning)))
	    (end (or end (region-end))))
	(facemenu-add-face face start end))
    (facemenu-self-insert-face face)))

;;;###autoload
(defun facemenu-set-face-from-menu (face start end)
  "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, 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 \(or otherwise inserted) will be set to
the selected face.  Moving point or switching buffers before
typing a character cancels the request." 
  (interactive (list last-command-event
		     (if mark-active (region-beginning))
		     (if mark-active (region-end))))
  (barf-if-buffer-read-only)
  (facemenu-get-face face)
  (if start 
      (facemenu-add-face face start end)
    (facemenu-self-insert-face face)))

;;;###autoload
(defun facemenu-set-invisible (start end)
  "Make the region invisible.
This sets the `invisible' text property; it can be undone with
`facemenu-remove-all'."
  (interactive "r")
  (put-text-property start end 'invisible t))

;;;###autoload
(defun facemenu-set-intangible (start end)
  "Make the region intangible: disallow moving into it.
This sets the `intangible' text property; it can be undone with
`facemenu-remove-all'."
  (interactive "r")
  (put-text-property start end 'intangible t))

;;;###autoload
(defun facemenu-set-read-only (start end)
  "Make the region unmodifiable.
This sets the `read-only' text property; it can be undone with
`facemenu-remove-all'."
  (interactive "r")
  (put-text-property start end 'read-only t))

;;;###autoload
(defun facemenu-remove-all (start end)
  "Remove all text properties that facemenu added to region."
  (interactive "*r") ; error if buffer is read-only despite the next line.
  (let ((inhibit-read-only t))
    (remove-text-properties 
     start end '(face nil invisible nil intangible nil 
		      read-only nil category nil))))

;;;###autoload
(defun list-text-properties-at (p)
  "Pop up a buffer listing text-properties at LOCATION."
  (interactive "d")

12014:e4932082046a

(defalias 'facemenu-face-menu facemenu-face-menu)

;;;###autoload
(defvar facemenu-foreground-menu 
  (let ((map (make-sparse-keymap "Foreground Color")))
    (define-key map "o" (cons "Other..." 'facemenu-set-foreground))
    map)
  "Menu keymap for foreground colors.")
;;;###autoload
(defalias 'facemenu-foreground-menu facemenu-foreground-menu)

;;;###autoload
(defvar facemenu-background-menu
  (let ((map (make-sparse-keymap "Background Color")))
    (define-key map "o" (cons "Other..." 'facemenu-set-background))
    map)
  "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))
    map)
  "Menu keymap for non-face text-properties.")
;;;###autoload
(defalias 'facemenu-special-menu facemenu-special-menu)

(defalias 'facemenu-justification-menu facemenu-justification-menu)

;;;###autoload
(defvar facemenu-indentation-menu
  (let ((map (make-sparse-keymap "Indentation")))
    (define-key map [decrease-right-margin] 
      (cons "Indent Right Less" 'decrease-right-margin))
    (define-key map [increase-right-margin]
      (cons "Indent Right More" 'increase-right-margin))
    (define-key map [decrease-left-margin]
      (cons "Indent Less" 'decrease-left-margin))
    (define-key map [increase-left-margin]
      (cons "Indent More" 'increase-left-margin))
    map)
  "Submenu for indentation commands.")
;;;###autoload
(defalias 'facemenu-indentation-menu facemenu-indentation-menu)

;; This is split up to avoid an overlong line in loaddefs.el.
;;;###autoload
(defvar facemenu-menu nil
  "Facemenu top-level menu keymap.")
;;;###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 All" 'facemenu-remove-all))
  (define-key map [rm] (cons "Remove Properties" 'facemenu-remove-props))
  (define-key map [s1] (list "-----------------")))
;;;###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 Props" '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)))
;;;###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))
    map)
  "Keymap for face-changing commands.
`Facemenu-update' fills in the keymap according to the bindings
requested in `facemenu-keybindings'.")
(defalias 'facemenu-keymap facemenu-keymap)

(defun facemenu-set-face (face &optional start end)
  "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." 
  (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))
      (let ((start (or start (region-beginning)))
	    (end (or end (region-end))))
	(facemenu-add-face face start end))
    (facemenu-self-insert-face face)))

;;;###autoload
(defun facemenu-set-face-from-menu (face start end)
  "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." 
  (interactive (list last-command-event
		     (if (and mark-active (not current-prefix-arg))
			 (region-beginning))
		     (if (and mark-active (not current-prefix-arg))
			 (region-end))))
  (barf-if-buffer-read-only)
  (facemenu-get-face face)
  (if start 
      (facemenu-add-face face start end)
    (facemenu-self-insert-face face)))

;;;###autoload
(defun facemenu-set-invisible (start end)
  "Make the region invisible.
This sets the `invisible' text property; it can be undone with
`facemenu-remove-special'."
  (interactive "r")
  (put-text-property start end 'invisible t))

;;;###autoload
(defun facemenu-set-intangible (start end)
  "Make the region intangible: disallow moving into it.
This sets the `intangible' text property; it can be undone with
`facemenu-remove-special'."
  (interactive "r")
  (put-text-property start end 'intangible t))

;;;###autoload
(defun facemenu-set-read-only (start end)
  "Make the region unmodifiable.
This sets the `read-only' text property; it can be undone with
`facemenu-remove-special'."
  (interactive "r")
  (put-text-property start end 'read-only t))

;;;###autoload
(defun facemenu-remove-props (start end)
  "Remove all text properties that facemenu added to region."
  (interactive "*r") ; error if buffer is read-only despite the next line.
  (let ((inhibit-read-only t))
    (remove-text-properties 
     start end '(face nil invisible nil intangible nil 
		      read-only nil category nil))))

;;;###autoload
(defun facemenu-remove-all (start end)
  "Remove all text properties from the region."
  (interactive "*r") ; error if buffer is read-only despite the next line.
  (let ((inhibit-read-only t))
    (set-text-properties start end nil)))

;;;###autoload
(defun facemenu-remove-special (start end)
  "Remove all the \"special\" text properties from the region.
These special properties include `invisible', `intangible' and `read-only'."
  (interactive "*r") ; error if buffer is read-only despite the next line.
  (let ((inhibit-read-only t))
    (remove-text-properties 
     start end '(invisible nil intangible nil read-only nil))))

;;;###autoload
(defun list-text-properties-at (p)
  "Pop up a buffer listing text-properties at LOCATION."
  (interactive "d")