;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
;;
;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
"Front-ends/assistants for, or emulators of, UNIX features."
:group 'environment)
-(defgroup vms nil
- "Support code for vms."
- :group 'environment)
-
(defgroup i18n nil
"Internationalization and alternate character-set support."
:link '(custom-manual "(emacs)International")
:link '(custom-manual "(emacs)Windows")
:group 'environment)
-(defgroup mac nil
- "Mac specific features."
- :link '(custom-manual "(emacs)Mac OS")
- :group 'environment
- :version "22.1"
- :prefix "mac-")
-
;;; Custom mode keymaps
(defvar custom-mode-map
;;; Custom Mode Commands.
;; This variable is used by `custom-tool-bar-map', or directly by
-;; `custom-buffer-create-internal' if the toolbar is not present and
-;; `custom-buffer-verbose-help' is non-nil.
+;; `custom-buffer-create-internal' if `custom-buffer-verbose-help' is non-nil.
(defvar custom-commands
'(("Set for current session" Custom-set t
;;;###autoload
(defun customize-apropos-options (regexp &optional arg)
"Customize all loaded customizable options matching REGEXP.
-With prefix arg, include variables that are not customizable options
+With prefix ARG, include variables that are not customizable options
\(but it is better to use `apropos-variable' if you want to find those)."
(interactive "sCustomize options (regexp): \nP")
(customize-apropos regexp (or arg 'options)))
:group 'custom-buffer)
(defcustom custom-buffer-done-kill nil
- "*Non-nil means exiting a Custom buffer should kill it."
+ "Non-nil means exiting a Custom buffer should kill it."
:type 'boolean
:version "22.1"
:group 'custom-buffer)
:help-echo "Read the Emacs manual."
"(emacs)Top")
(widget-insert "."))
- ;; Insert custom command buttons if the toolbar is not in use.
-
(widget-insert "\n")
- ;; tool-bar is not dumped in builds without x.
- (when (not (and (bound-and-true-p tool-bar-mode) (display-graphic-p)))
- (if custom-buffer-verbose-help
- (widget-insert "\n
+ ;; The custom command buttons are also in the toolbar, so for a
+ ;; time they were not inserted in the buffer if the toolbar was in use.
+ ;; But it can be a little confusing for the buffer layout to
+ ;; change according to whether or nor the toolbar is on, not to
+ ;; mention that a custom buffer can in theory be created in a
+ ;; frame with a toolbar, then later viewed in one without.
+ ;; So now the buttons are always inserted in the buffer. (Bug#1326)
+;;; (when (not (and (bound-and-true-p tool-bar-mode) (display-graphic-p)))
+ (if custom-buffer-verbose-help
+ (widget-insert "\n
Operate on all settings in this buffer that are not marked HIDDEN:\n"))
- (let ((button (lambda (tag action active help icon)
- (widget-insert " ")
- (if (eval active)
- (widget-create 'push-button :tag tag
- :help-echo help :action action))))
- (commands custom-commands))
- (apply button (pop commands)) ; Set for current session
- (apply button (pop commands)) ; Save for future sessions
- (if custom-reset-button-menu
- (progn
- (widget-insert " ")
- (widget-create 'push-button
- :tag "Reset buffer"
- :help-echo "Show a menu with reset operations."
- :mouse-down-action 'ignore
- :action 'custom-reset))
- (widget-insert "\n")
- (apply button (pop commands)) ; Undo edits
- (apply button (pop commands)) ; Reset to saved
- (apply button (pop commands)) ; Erase customization
- (widget-insert " ")
- (pop commands) ; Help (omitted)
- (apply button (pop commands))))) ; Exit
+ (let ((button (lambda (tag action active help icon)
+ (widget-insert " ")
+ (if (eval active)
+ (widget-create 'push-button :tag tag
+ :help-echo help :action action))))
+ (commands custom-commands))
+ (apply button (pop commands)) ; Set for current session
+ (apply button (pop commands)) ; Save for future sessions
+ (if custom-reset-button-menu
+ (progn
+ (widget-insert " ")
+ (widget-create 'push-button
+ :tag "Reset buffer"
+ :help-echo "Show a menu with reset operations."
+ :mouse-down-action 'ignore
+ :action 'custom-reset))
+ (widget-insert "\n")
+ (apply button (pop commands)) ; Undo edits
+ (apply button (pop commands)) ; Reset to saved
+ (apply button (pop commands)) ; Erase customization
+ (widget-insert " ")
+ (pop commands) ; Help (omitted)
+ (apply button (pop commands)))) ; Exit
(widget-insert "\n\n"))
;; Now populate the custom buffer.
;;; The `custom' Widget.
(defface custom-button
- '((((type x w32 mac) (class color)) ; Like default modeline
+ '((((type x w32 ns) (class color)) ; Like default modeline
(:box (:line-width 2 :style released-button)
:background "lightgrey" :foreground "black"))
(t
(put 'custom-button-face 'face-alias 'custom-button)
(defface custom-button-mouse
- '((((type x w32 mac) (class color))
+ '((((type x w32 ns) (class color))
(:box (:line-width 2 :style released-button)
:background "grey90" :foreground "black"))
(t
- nil))
+ ;; This is for text terminals that support mouse, like GPM mouse
+ ;; or the MS-DOS terminal: inverse-video makes the button stand
+ ;; out on mouse-over.
+ (:inverse-video t)))
"Mouse face for custom buffer buttons if `custom-raised-buttons' is non-nil."
:version "22.1"
:group 'custom-faces)
(if custom-raised-buttons 'custom-button-mouse 'highlight))
(defface custom-button-pressed
- '((((type x w32 mac) (class color))
+ '((((type x w32 ns) (class color))
(:box (:line-width 2 :style pressed-button)
:background "lightgrey" :foreground "black"))
(t
"Toggle visibility of WIDGET."
(custom-load-widget widget)
(let ((state (widget-get widget :custom-state)))
- (cond ((memq state '(invalid modified))
- (error "There are unset changes"))
+ (cond ((memq state '(invalid modified set))
+ (error "There are unsaved changes"))
((eq state 'hidden)
(widget-put widget :custom-state 'unknown))
(t
:background "dim gray")
(t
:slant italic))
- "Face used for comments on variables or faces"
+ "Face used for comments on variables or faces."
:version "21.1"
:group 'custom-faces)
;; backward-compatibility alias
(((class grayscale) (background dark))
(:foreground "LightGray" :weight bold :slant italic))
(t (:weight bold)))
- "Face used for variables or faces comment tags"
+ "Face used for the comment tag on variables or faces."
:group 'custom-faces)
;; backward-compatibility alias
(put 'custom-comment-tag-face 'face-alias 'custom-comment-tag)
"User comment."
:tag "Comment"
:help-echo "Edit a comment here."
- :sample-face 'custom-comment-tag-face
- :value-face 'custom-comment-face
+ :sample-face 'custom-comment-tag
+ :value-face 'custom-comment
:shown nil
:create 'custom-comment-create)
(push (widget-create-child-and-convert
widget 'item
:format "%{%t%}: "
- :sample-face 'custom-variable-tag-face
+ :sample-face 'custom-variable-tag
:tag tag
:parent widget)
buttons)
:action 'custom-tag-action
:help-echo "Change value of this option."
:mouse-down-action 'custom-tag-mouse-down-action
- :button-face 'custom-variable-button-face
- :sample-face 'custom-variable-tag-face
+ :button-face 'custom-variable-button
+ :sample-face 'custom-variable-tag
tag)
buttons)
(insert " ")
(defun custom-face-edit-attribute-tag (widget)
- "Returns the first :tag property in WIDGET or one of its children."
+ "Return the first :tag property in WIDGET or one of its children."
(let ((tag (widget-get widget :tag)))
(or (and (not (equal tag "")) tag)
(let ((children (widget-get widget :children)))
:sibling-args (:help-echo "\
Windows NT/9X.")
w32)
- (const :format "MAC "
+ (const :format "NS "
:sibling-args (:help-echo "\
-Macintosh OS.")
- mac)
+GNUstep or Macintosh OS Cocoa interface.")
+ ns)
(const :format "DOS "
:sibling-args (:help-echo "\
Plain MS-DOS.")
;;; The `custom-face' Widget.
(defface custom-face-tag
- `((t (:weight bold :height 1.2 :inherit variable-pitch)))
+ `((t :inherit custom-variable-tag))
"Face used for face tags."
:group 'custom-faces)
;; backward-compatibility alias
(define-widget 'custom-face 'custom
"Customize face."
- :sample-face 'custom-face-tag-face
+ :sample-face 'custom-face-tag
:help-echo "Set or reset this face."
:documentation-property #'face-doc-string
:value-create 'custom-face-value-create
(let ((start (point)))
(insert tag " group: ")
(widget-specify-sample widget start (point)))
- (insert (widget-docstring widget))
+ (if (< (length (widget-docstring widget)) 50)
+ (insert (widget-docstring widget)))
;; Create visibility indicator.
(unless (eq custom-buffer-style 'links)
(insert "--------")
;; Update buttons.
(widget-put widget :buttons buttons)
;; Insert documentation.
- (widget-add-documentation-string-button
- widget :visibility-widget 'custom-visibility)
+ (if (>= (length (widget-docstring widget)) 50)
+ (widget-add-documentation-string-button
+ widget :visibility-widget 'custom-visibility))
;; Parent groups.
(if nil ;;; This should test that the buffer
:doc
"Please read entire docstring below before setting \
this through Custom.
-Click om \"More\" \(or position point there and press RETURN)
+Click on \"More\" \(or position point there and press RETURN)
if only the first line of the docstring is shown."))
:group 'customize)
(recentf-expand-file-name (custom-file)))
"\\'")
recentf-exclude)))
- (old-buffer (find-buffer-visiting filename)))
+ (old-buffer (find-buffer-visiting filename))
+ old-buffer-name)
+
(with-current-buffer (let ((find-file-visit-truename t))
(or old-buffer (find-file-noselect filename)))
+ ;; We'll save using file-precious-flag, so avoid destroying
+ ;; symlinks. (If we're not already visiting the buffer, this is
+ ;; handled by find-file-visit-truename, above.)
+ (when old-buffer
+ (setq old-buffer-name (buffer-file-name))
+ (set-visited-file-name (file-chase-links filename)))
+
(unless (eq major-mode 'emacs-lisp-mode)
(emacs-lisp-mode))
(let ((inhibit-read-only t))
(custom-save-faces))
(let ((file-precious-flag t))
(save-buffer))
- (unless old-buffer
+ (if old-buffer
+ (progn
+ (set-visited-file-name old-buffer-name)
+ (set-buffer-modified-p nil))
(kill-buffer (current-buffer))))))
;;;###autoload
if that value is non-nil."
(use-local-map custom-mode-map)
(easy-menu-add Custom-mode-menu)
- (when (display-graphic-p)
- (set (make-local-variable 'tool-bar-map)
- (or custom-tool-bar-map
- ;; Set up `custom-tool-bar-map'.
- (let ((map (make-sparse-keymap)))
- (mapc
- (lambda (arg)
- (tool-bar-local-item-from-menu
- (nth 1 arg) (nth 4 arg) map custom-mode-map))
- custom-commands)
- (setq custom-tool-bar-map map)))))
+ (set (make-local-variable 'tool-bar-map)
+ (or custom-tool-bar-map
+ ;; Set up `custom-tool-bar-map'.
+ (let ((map (make-sparse-keymap)))
+ (mapc
+ (lambda (arg)
+ (tool-bar-local-item-from-menu
+ (nth 1 arg) (nth 4 arg) map custom-mode-map))
+ custom-commands)
+ (setq custom-tool-bar-map map))))
(make-local-variable 'custom-options)
(make-local-variable 'custom-local-buffer)
(make-local-variable 'widget-documentation-face)