mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-23 10:34:07 +00:00
Synched with 1.9914.
This commit is contained in:
Per Abrahamsen
parent
996169356b
commit
6aaedd1230
137
lisp/cus-edit.el
137
lisp/cus-edit.el
@ -4,7 +4,7 @@
|
||||
;;
|
||||
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
|
||||
;; Keywords: help, faces
|
||||
;; Version: 1.9908
|
||||
;; Version: 1.9914
|
||||
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
@ -246,6 +246,16 @@
|
||||
:group 'customize
|
||||
:group 'faces)
|
||||
|
||||
(defgroup custom-buffer nil
|
||||
"Control the customize buffers."
|
||||
:prefix "custom-"
|
||||
:group 'customize)
|
||||
|
||||
(defgroup custom-menu nil
|
||||
"Control how the customize menus."
|
||||
:prefix "custom-"
|
||||
:group 'customize)
|
||||
|
||||
(defgroup abbrev-mode nil
|
||||
"Word abbreviations mode."
|
||||
:group 'abbrev)
|
||||
@ -401,7 +411,7 @@ WIDGET is the widget to apply the filter entries of MENU on."
|
||||
|
||||
(defcustom custom-unlispify-menu-entries t
|
||||
"Display menu entries as words instead of symbols if non nil."
|
||||
:group 'customize
|
||||
:group 'custom-menu
|
||||
:type 'boolean)
|
||||
|
||||
(defun custom-unlispify-menu-entry (symbol &optional no-suffix)
|
||||
@ -440,7 +450,7 @@ WIDGET is the widget to apply the filter entries of MENU on."
|
||||
|
||||
(defcustom custom-unlispify-tag-names t
|
||||
"Display tag names as words instead of symbols if non nil."
|
||||
:group 'customize
|
||||
:group 'custom-buffer
|
||||
:type 'boolean)
|
||||
|
||||
(defun custom-unlispify-tag-name (symbol)
|
||||
@ -518,49 +528,59 @@ if that fails, the doc string with `custom-guess-doc-alist'."
|
||||
|
||||
;;; Sorting.
|
||||
|
||||
(defcustom custom-buffer-sort-predicate 'custom-buffer-sort-alphabetically
|
||||
(defcustom custom-buffer-sort-predicate 'ignore
|
||||
"Function used for sorting group members in buffers.
|
||||
The value should be useful as a predicate for `sort'.
|
||||
The list to be sorted is the value of the groups `custom-group' property."
|
||||
:type '(radio (function-item custom-buffer-sort-alphabetically)
|
||||
:type '(radio (const :tag "Unsorted" ignore)
|
||||
(const :tag "Alphabetic" custom-sort-items-alphabetically)
|
||||
(function :tag "Other"))
|
||||
:group 'customize)
|
||||
:group 'custom-buffer)
|
||||
|
||||
(defun custom-buffer-sort-alphabetically (a b)
|
||||
"Return t iff is A should be before B.
|
||||
A and B should be members of a `custom-group' property.
|
||||
The members are sorted alphabetically, except that all groups are
|
||||
sorted after all non-groups."
|
||||
(cond ((and (eq (nth 1 a) 'custom-group)
|
||||
(not (eq (nth 1 b) 'custom-group)))
|
||||
nil)
|
||||
((and (eq (nth 1 b) 'custom-group)
|
||||
(not (eq (nth 1 a) 'custom-group)))
|
||||
t)
|
||||
(t
|
||||
(string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b))))))
|
||||
(defcustom custom-buffer-order-predicate 'custom-sort-groups-last
|
||||
"Function used for sorting group members in buffers.
|
||||
The value should be useful as a predicate for `sort'.
|
||||
The list to be sorted is the value of the groups `custom-group' property."
|
||||
:type '(radio (const :tag "Groups first" custom-sort-groups-first)
|
||||
(const :tag "Groups last" custom-sort-groups-last)
|
||||
(function :tag "Other"))
|
||||
:group 'custom-buffer)
|
||||
|
||||
(defcustom custom-menu-sort-predicate 'custom-menu-sort-alphabetically
|
||||
(defcustom custom-menu-sort-predicate 'ignore
|
||||
"Function used for sorting group members in menus.
|
||||
The value should be useful as a predicate for `sort'.
|
||||
The list to be sorted is the value of the groups `custom-group' property."
|
||||
:type '(radio (function-item custom-menu-sort-alphabetically)
|
||||
:type '(radio (const :tag "Unsorted" ignore)
|
||||
(const :tag "Alphabetic" custom-sort-items-alphabetically)
|
||||
(function :tag "Other"))
|
||||
:group 'customize)
|
||||
:group 'custom-menu)
|
||||
|
||||
(defun custom-menu-sort-alphabetically (a b)
|
||||
"Return t iff is A should be before B.
|
||||
A and B should be members of a `custom-group' property.
|
||||
The members are sorted alphabetically, except that all groups are
|
||||
sorted before all non-groups."
|
||||
(cond ((and (eq (nth 1 a) 'custom-group)
|
||||
(not (eq (nth 1 b) 'custom-group)))
|
||||
t)
|
||||
((and (eq (nth 1 b) 'custom-group)
|
||||
(not (eq (nth 1 a) 'custom-group)))
|
||||
nil)
|
||||
(t
|
||||
(string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b))))))
|
||||
(defcustom custom-menu-order-predicate 'custom-sort-groups-first
|
||||
"Function used for sorting group members in menus.
|
||||
The value should be useful as a predicate for `sort'.
|
||||
The list to be sorted is the value of the groups `custom-group' property."
|
||||
:type '(radio (const :tag "Groups first" custom-sort-groups-first)
|
||||
(const :tag "Groups last" custom-sort-groups-last)
|
||||
(function :tag "Other"))
|
||||
:group 'custom-menu)
|
||||
|
||||
(defun custom-sort-items-alphabetically (a b)
|
||||
"Return t iff A is alphabetically before B and the same custom type.
|
||||
A and B should be members of a `custom-group' property."
|
||||
(and (eq (nth 1 a) (nth 1 b))
|
||||
(string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b)))))
|
||||
|
||||
(defun custom-sort-groups-first (a b)
|
||||
"Return t iff A a custom group and B is a not.
|
||||
A and B should be members of a `custom-group' property."
|
||||
(and (eq (nth 1 a) 'custom-group)
|
||||
(not (eq (nth 1 b) 'custom-group))))
|
||||
|
||||
(defun custom-sort-groups-last (a b)
|
||||
"Return t iff B a custom group and A is a not.
|
||||
A and B should be members of a `custom-group' property."
|
||||
(and (eq (nth 1 b) 'custom-group)
|
||||
(not (eq (nth 1 a) 'custom-group))))
|
||||
|
||||
;;; Custom Mode Commands.
|
||||
|
||||
@ -897,7 +917,7 @@ that option."
|
||||
"If non-nil, only show a single reset button in customize buffers.
|
||||
This button will have a menu with all three reset operations."
|
||||
:type 'boolean
|
||||
:group 'customize)
|
||||
:group 'custom-buffer)
|
||||
|
||||
(defun custom-buffer-create-internal (options)
|
||||
(message "Creating customization buffer...")
|
||||
@ -1017,38 +1037,49 @@ Reset all visible items in this buffer to their standard settings."
|
||||
|
||||
;;; The `custom-magic' Widget.
|
||||
|
||||
(defgroup custom-magic-faces nil
|
||||
"Faces used by the magic button."
|
||||
:group 'custom-faces
|
||||
:group 'custom-buffer)
|
||||
|
||||
(defface custom-invalid-face '((((class color))
|
||||
(:foreground "yellow" :background "red"))
|
||||
(t
|
||||
(:bold t :italic t :underline t)))
|
||||
"Face used when the customize item is invalid.")
|
||||
"Face used when the customize item is invalid."
|
||||
:group 'custom-magic-faces)
|
||||
|
||||
(defface custom-rogue-face '((((class color))
|
||||
(:foreground "pink" :background "black"))
|
||||
(t
|
||||
(:underline t)))
|
||||
"Face used when the customize item is not defined for customization.")
|
||||
"Face used when the customize item is not defined for customization."
|
||||
:group 'custom-magic-faces)
|
||||
|
||||
(defface custom-modified-face '((((class color))
|
||||
(:foreground "white" :background "blue"))
|
||||
(t
|
||||
(:italic t :bold)))
|
||||
"Face used when the customize item has been modified.")
|
||||
"Face used when the customize item has been modified."
|
||||
:group 'custom-magic-faces)
|
||||
|
||||
(defface custom-set-face '((((class color))
|
||||
(:foreground "blue" :background "white"))
|
||||
(t
|
||||
(:italic t)))
|
||||
"Face used when the customize item has been set.")
|
||||
"Face used when the customize item has been set."
|
||||
:group 'custom-magic-faces)
|
||||
|
||||
(defface custom-changed-face '((((class color))
|
||||
(:foreground "white" :background "blue"))
|
||||
(t
|
||||
(:italic t)))
|
||||
"Face used when the customize item has been changed.")
|
||||
"Face used when the customize item has been changed."
|
||||
:group 'custom-magic-faces)
|
||||
|
||||
(defface custom-saved-face '((t (:underline t)))
|
||||
"Face used when the customize item has been saved.")
|
||||
"Face used when the customize item has been saved."
|
||||
:group 'custom-magic-faces)
|
||||
|
||||
(defconst custom-magic-alist '((nil "#" underline "\
|
||||
uninitialized, you should not see this.")
|
||||
@ -1123,7 +1154,7 @@ If non-nil and not the symbol `long', only show first word."
|
||||
:type '(choice (const :tag "no" nil)
|
||||
(const short)
|
||||
(const long))
|
||||
:group 'customize)
|
||||
:group 'custom-buffer)
|
||||
|
||||
(defcustom custom-magic-show-hidden '(option face)
|
||||
"Control whether the state button is shown for hidden items.
|
||||
@ -1131,12 +1162,12 @@ The value should be a list with the custom categories where the state
|
||||
button should be visible. Possible categories are `group', `option',
|
||||
and `face'."
|
||||
:type '(set (const group) (const option) (const face))
|
||||
:group 'customize)
|
||||
:group 'custom-buffer)
|
||||
|
||||
(defcustom custom-magic-show-button nil
|
||||
"Show a magic button indicating the state of each customization option."
|
||||
:type 'boolean
|
||||
:group 'customize)
|
||||
:group 'custom-buffer)
|
||||
|
||||
(define-widget 'custom-magic 'default
|
||||
"Show and manipulate state for a customization option."
|
||||
@ -2176,8 +2207,9 @@ and so forth. The remaining group tags are shown with
|
||||
(custom-load-widget widget)
|
||||
(let* ((level (widget-get widget :custom-level))
|
||||
(symbol (widget-value widget))
|
||||
(members (sort (get symbol 'custom-group)
|
||||
custom-buffer-sort-predicate))
|
||||
(members (sort (sort (copy-sequence (get symbol 'custom-group))
|
||||
custom-buffer-sort-predicate)
|
||||
custom-buffer-order-predicate))
|
||||
(prefixes (widget-get widget :custom-prefixes))
|
||||
(custom-prefix-list (custom-prefix-add symbol prefixes))
|
||||
(length (length members))
|
||||
@ -2199,7 +2231,6 @@ and so forth. The remaining group tags are shown with
|
||||
(unless (eq (preceding-char) ?\n)
|
||||
(widget-insert "\n"))))
|
||||
members)))
|
||||
(put symbol 'custom-group members)
|
||||
(message "Creating group magic...")
|
||||
(mapcar 'custom-magic-reset children)
|
||||
(message "Creating group state...")
|
||||
@ -2465,7 +2496,7 @@ Leave point at the location of the call, or after the last expression."
|
||||
(defcustom custom-menu-nesting 2
|
||||
"Maximum nesting in custom menus."
|
||||
:type 'integer
|
||||
:group 'customize)
|
||||
:group 'custom-menu)
|
||||
|
||||
(defun custom-face-menu-create (widget symbol)
|
||||
"Ignoring WIDGET, create a menu entry for customization face SYMBOL."
|
||||
@ -2518,9 +2549,9 @@ The menu is in a format applicable to `easy-menu-define'."
|
||||
(< (length (get symbol 'custom-group)) widget-menu-max-size))
|
||||
(let ((custom-prefix-list (custom-prefix-add symbol
|
||||
custom-prefix-list))
|
||||
(members (sort (get symbol 'custom-group)
|
||||
custom-menu-sort-predicate)))
|
||||
(put symbol 'custom-group members)
|
||||
(members (sort (sort (copy-sequence (get symbol 'custom-group))
|
||||
custom-menu-sort-predicate)
|
||||
custom-menu-order-predicate)))
|
||||
(custom-load-symbol symbol)
|
||||
`(,(custom-unlispify-menu-entry symbol t)
|
||||
,item
|
||||
@ -2579,7 +2610,7 @@ The format is suitable for use with `easy-menu-define'."
|
||||
(defcustom custom-mode-hook nil
|
||||
"Hook called when entering custom-mode."
|
||||
:type 'hook
|
||||
:group 'customize)
|
||||
:group 'custom-buffer )
|
||||
|
||||
(defun custom-mode ()
|
||||
"Major mode for editing customization buffers.
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
;;
|
||||
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
|
||||
;; Keywords: extensions
|
||||
;; Version: 1.9905
|
||||
;; Version: 1.9914
|
||||
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
@ -282,7 +282,7 @@ With arg, turn widget mode on if and only if arg is positive."
|
||||
(interactive "P")
|
||||
(cond ((null arg)
|
||||
(setq widget-minor-mode (not widget-minor-mode)))
|
||||
((<= 0 arg)
|
||||
((<= arg 0)
|
||||
(setq widget-minor-mode nil))
|
||||
(t
|
||||
(setq widget-minor-mode t)))
|
||||
|
||||
176
lisp/wid-edit.el
176
lisp/wid-edit.el
@ -4,7 +4,7 @@
|
||||
;;
|
||||
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
|
||||
;; Keywords: extensions
|
||||
;; Version: 1.9908
|
||||
;; Version: 1.9914
|
||||
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
@ -123,17 +123,21 @@ is the string or buffer containing the text."
|
||||
"http://www.dina.kvl.dk/~abraham/custom/")
|
||||
:prefix "widget-"
|
||||
:group 'extensions
|
||||
:group 'faces
|
||||
:group 'hypermedia)
|
||||
|
||||
(defgroup widget-faces nil
|
||||
"Faces used by the widget library."
|
||||
:group 'widgets
|
||||
:group 'faces)
|
||||
|
||||
(defface widget-button-face '((t (:bold t)))
|
||||
"Face used for widget buttons."
|
||||
:group 'widgets)
|
||||
:group 'widget-faces)
|
||||
|
||||
(defcustom widget-mouse-face 'highlight
|
||||
"Face used for widget buttons when the mouse is above them."
|
||||
:type 'face
|
||||
:group 'widgets)
|
||||
:group 'widget-faces)
|
||||
|
||||
(defface widget-field-face '((((class grayscale color)
|
||||
(background light))
|
||||
@ -144,7 +148,7 @@ is the string or buffer containing the text."
|
||||
(t
|
||||
(:italic t)))
|
||||
"Face used for editable fields."
|
||||
:group 'widgets)
|
||||
:group 'widget-faces)
|
||||
|
||||
;;; Utility functions.
|
||||
;;
|
||||
@ -347,14 +351,15 @@ minibuffer."
|
||||
(t
|
||||
(:italic t)))
|
||||
"Face used for inactive widgets."
|
||||
:group 'widgets)
|
||||
:group 'widget-faces)
|
||||
|
||||
(defun widget-specify-inactive (widget from to)
|
||||
"Make WIDGET inactive for user modifications."
|
||||
(unless (widget-get widget :inactive)
|
||||
(let ((overlay (make-overlay from to nil t nil)))
|
||||
(overlay-put overlay 'face 'widget-inactive-face)
|
||||
(overlay-put overlay 'mouse-face 'widget-inactive-face)
|
||||
;; This is disabled, as it makes the mouse cursor change shape.
|
||||
;; (overlay-put overlay 'mouse-face 'widget-inactive-face)
|
||||
(overlay-put overlay 'evaporate t)
|
||||
(overlay-put overlay 'priority 100)
|
||||
(overlay-put overlay (if (string-match "XEmacs" emacs-version)
|
||||
@ -474,6 +479,26 @@ This is only meaningful for radio buttons or checkboxes in a list."
|
||||
(throw 'child child)))
|
||||
nil)))
|
||||
|
||||
(defun widget-map-buttons (function &optional buffer maparg)
|
||||
"Map FUNCTION over the buttons in BUFFER.
|
||||
FUNCTION is called with the arguments WIDGET and MAPARG.
|
||||
|
||||
If FUNCTION returns non-nil, the walk is cancelled.
|
||||
|
||||
The arguments MAPARG, and BUFFER default to nil and (current-buffer),
|
||||
respectively."
|
||||
(let ((cur (point-min))
|
||||
(widget nil)
|
||||
(parent nil)
|
||||
(overlays (if buffer
|
||||
(save-excursion (set-buffer buffer) (overlay-lists))
|
||||
(overlay-lists))))
|
||||
(setq overlays (append (car overlays) (cdr overlays)))
|
||||
(while (setq cur (pop overlays))
|
||||
(setq widget (overlay-get cur 'button))
|
||||
(if (and widget (funcall function widget maparg))
|
||||
(setq overlays nil)))))
|
||||
|
||||
;;; Glyphs.
|
||||
|
||||
(defcustom widget-glyph-directory (concat data-directory "custom/")
|
||||
@ -720,6 +745,31 @@ The optional ARGS are additional keyword arguments."
|
||||
(apply 'insert args)
|
||||
(widget-specify-text from (point))))
|
||||
|
||||
(defun widget-convert-text (type from to &optional button-from button-to)
|
||||
"Return a widget of type TYPE with endpoint FROM TO.
|
||||
No text will be inserted to the buffer, instead the text between FROM
|
||||
and TO will be used as the widgets end points. If optional arguments
|
||||
BUTTON-FROM and BUTTON-TO are given, these will be used as the widgets
|
||||
button end points."
|
||||
(let ((widget (widget-convert type))
|
||||
(from (copy-marker from))
|
||||
(to (copy-marker to)))
|
||||
(widget-specify-text from to)
|
||||
(set-marker-insertion-type from t)
|
||||
(set-marker-insertion-type to nil)
|
||||
(widget-put widget :from from)
|
||||
(widget-put widget :to to)
|
||||
(when button-from
|
||||
(widget-specify-button widget button-from button-to))
|
||||
widget))
|
||||
|
||||
(defun widget-convert-button (type from to)
|
||||
"Return a widget of type TYPE with endpoint FROM TO.
|
||||
No text will be inserted to the buffer, instead the text between FROM
|
||||
and TO will be used as the widgets end points, as well as the widgets
|
||||
button end points."
|
||||
(widget-convert-text type from to from to))
|
||||
|
||||
;;; Keymap and Commands.
|
||||
|
||||
(defvar widget-keymap nil
|
||||
@ -783,7 +833,7 @@ Recommended as a parent keymap for modes using widgets.")
|
||||
(t
|
||||
(:bold t :underline t)))
|
||||
"Face used for pressed buttons."
|
||||
:group 'widgets)
|
||||
:group 'widget-faces)
|
||||
|
||||
(defun widget-button-click (event)
|
||||
"Invoke button below mouse pointer."
|
||||
@ -1017,7 +1067,8 @@ When not inside a field, move to the previous button or field."
|
||||
widget-field-list (cons field widget-field-list))
|
||||
(let ((from (car (widget-get field :field-overlay)))
|
||||
(to (cdr (widget-get field :field-overlay))))
|
||||
(widget-specify-field field from to)
|
||||
(widget-specify-field field
|
||||
(marker-position from) (marker-position to))
|
||||
(set-marker from nil)
|
||||
(set-marker to nil))))
|
||||
(widget-clear-undo)
|
||||
@ -1037,16 +1088,19 @@ When not inside a field, move to the previous button or field."
|
||||
|
||||
(defun widget-field-buffer (widget)
|
||||
"Return the start of WIDGET's editing field."
|
||||
(overlay-buffer (widget-get widget :field-overlay)))
|
||||
(let ((overlay (widget-get widget :field-overlay)))
|
||||
(and overlay (overlay-buffer overlay))))
|
||||
|
||||
(defun widget-field-start (widget)
|
||||
"Return the start of WIDGET's editing field."
|
||||
(overlay-start (widget-get widget :field-overlay)))
|
||||
(let ((overlay (widget-get widget :field-overlay)))
|
||||
(and overlay (overlay-start overlay))))
|
||||
|
||||
(defun widget-field-end (widget)
|
||||
"Return the end of WIDGET's editing field."
|
||||
;; Don't subtract one if local-map works at the end of the overlay.
|
||||
(1- (overlay-end (widget-get widget :field-overlay))))
|
||||
(let ((overlay (widget-get widget :field-overlay)))
|
||||
;; Don't subtract one if local-map works at the end of the overlay.
|
||||
(and overlay (1- (overlay-end overlay)))))
|
||||
|
||||
(defun widget-field-find (pos)
|
||||
"Return the field at POS.
|
||||
@ -1253,32 +1307,34 @@ If that does not exists, call the value of `widget-complete-field'."
|
||||
|
||||
(defun widget-default-format-handler (widget escape)
|
||||
;; We recognize the %h escape by default.
|
||||
(let* ((buttons (widget-get widget :buttons))
|
||||
(doc-property (widget-get widget :documentation-property))
|
||||
(doc-try (cond ((widget-get widget :doc))
|
||||
((symbolp doc-property)
|
||||
(documentation-property (widget-get widget :value)
|
||||
doc-property))
|
||||
(t
|
||||
(funcall doc-property (widget-get widget :value)))))
|
||||
(doc-text (and (stringp doc-try)
|
||||
(> (length doc-try) 1)
|
||||
doc-try)))
|
||||
(let* ((buttons (widget-get widget :buttons)))
|
||||
(cond ((eq escape ?h)
|
||||
(when doc-text
|
||||
(and (eq (preceding-char) ?\n)
|
||||
(widget-get widget :indent)
|
||||
(insert-char ? (widget-get widget :indent)))
|
||||
;; The `*' in the beginning is redundant.
|
||||
(when (eq (aref doc-text 0) ?*)
|
||||
(setq doc-text (substring doc-text 1)))
|
||||
;; Get rid of trailing newlines.
|
||||
(when (string-match "\n+\\'" doc-text)
|
||||
(setq doc-text (substring doc-text 0 (match-beginning 0))))
|
||||
(push (widget-create-child-and-convert
|
||||
widget 'documentation-string
|
||||
doc-text)
|
||||
buttons)))
|
||||
(let* ((doc-property (widget-get widget :documentation-property))
|
||||
(doc-try (cond ((widget-get widget :doc))
|
||||
((symbolp doc-property)
|
||||
(documentation-property
|
||||
(widget-get widget :value)
|
||||
doc-property))
|
||||
(t
|
||||
(funcall doc-property
|
||||
(widget-get widget :value)))))
|
||||
(doc-text (and (stringp doc-try)
|
||||
(> (length doc-try) 1)
|
||||
doc-try)))
|
||||
(when doc-text
|
||||
(and (eq (preceding-char) ?\n)
|
||||
(widget-get widget :indent)
|
||||
(insert-char ? (widget-get widget :indent)))
|
||||
;; The `*' in the beginning is redundant.
|
||||
(when (eq (aref doc-text 0) ?*)
|
||||
(setq doc-text (substring doc-text 1)))
|
||||
;; Get rid of trailing newlines.
|
||||
(when (string-match "\n+\\'" doc-text)
|
||||
(setq doc-text (substring doc-text 0 (match-beginning 0))))
|
||||
(push (widget-create-child-and-convert
|
||||
widget 'documentation-string
|
||||
doc-text)
|
||||
buttons))))
|
||||
(t
|
||||
(error "Unknown escape `%c'" escape)))
|
||||
(widget-put widget :buttons buttons)))
|
||||
@ -2476,7 +2532,7 @@ when he invoked the menu."
|
||||
(:foreground "dark green"))
|
||||
(t nil))
|
||||
"Face used for documentation text."
|
||||
:group 'widgets)
|
||||
:group 'widget-faces)
|
||||
|
||||
(define-widget 'documentation-string 'item
|
||||
"A documentation string."
|
||||
@ -2488,11 +2544,11 @@ when he invoked the menu."
|
||||
(defun widget-documentation-string-value-create (widget)
|
||||
;; Insert documentation string.
|
||||
(let ((doc (widget-value widget))
|
||||
(shown (widget-get (widget-get widget :parent) :documentation-shown)))
|
||||
(shown (widget-get (widget-get widget :parent) :documentation-shown))
|
||||
(start (point)))
|
||||
(if (string-match "\n" doc)
|
||||
(let ((before (substring doc 0 (match-beginning 0)))
|
||||
(after (substring doc (match-beginning 0)))
|
||||
(start (point))
|
||||
buttons)
|
||||
(insert before " ")
|
||||
(widget-specify-doc widget start (point))
|
||||
@ -2507,7 +2563,8 @@ when he invoked the menu."
|
||||
(insert after)
|
||||
(widget-specify-doc widget start (point)))
|
||||
(widget-put widget :buttons buttons))
|
||||
(insert doc)))
|
||||
(insert doc)
|
||||
(widget-specify-doc widget start (point))))
|
||||
(insert "\n"))
|
||||
|
||||
(defun widget-documentation-string-action (widget &rest ignore)
|
||||
@ -2666,6 +2723,41 @@ It will read a directory name from the minibuffer when invoked."
|
||||
:prompt-history 'widget-variable-prompt-value-history
|
||||
:tag "Variable")
|
||||
|
||||
(when (featurep 'mule)
|
||||
(defvar widget-coding-system-prompt-value-history nil
|
||||
"History of input to `widget-coding-system-prompt-value'.")
|
||||
|
||||
(define-widget 'coding-system 'symbol
|
||||
"A MULE coding-system."
|
||||
:format "%{%t%}: %v"
|
||||
:tag "Coding system"
|
||||
:prompt-history 'widget-coding-system-prompt-value-history
|
||||
:prompt-value 'widget-coding-system-prompt-value
|
||||
:action 'widget-coding-system-action)
|
||||
|
||||
(defun widget-coding-system-prompt-value (widget prompt value unbound)
|
||||
;; Read coding-system from minibuffer.
|
||||
(intern
|
||||
(completing-read (format "%s (default %s) " prompt value)
|
||||
(mapcar (function
|
||||
(lambda (sym)
|
||||
(list (symbol-name sym))
|
||||
))
|
||||
(coding-system-list)))))
|
||||
|
||||
(defun widget-coding-system-action (widget &optional event)
|
||||
;; Read a file name from the minibuffer.
|
||||
(let ((answer
|
||||
(widget-coding-system-prompt-value
|
||||
widget
|
||||
(widget-apply widget :menu-tag-get)
|
||||
(widget-value widget)
|
||||
t)))
|
||||
(widget-value-set widget answer)
|
||||
(widget-apply widget :notify widget event)
|
||||
(widget-setup)))
|
||||
)
|
||||
|
||||
(define-widget 'sexp 'editable-field
|
||||
"An arbitrary lisp expression."
|
||||
:tag "Lisp expression"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user