;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*-
;;
-;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Wishlist items (from widget.texi):
:type 'integer)
(defcustom widget-menu-minibuffer-flag nil
- "*Control how to ask for a choice from the keyboard.
+ "Control how to ask for a choice from the keyboard.
Non-nil means use the minibuffer;
nil means read a single character."
:group 'widgets
(or (not widget-field-add-space) (widget-get widget :size))))
(if (functionp help-echo)
(setq help-echo 'widget-mouse-help))
- (when (= (char-before to) ?\n)
+ (when (and (> to (1+ from))
+ (= (char-before to) ?\n))
;; When the last character in the field is a newline, we want to
;; give it a `field' char-property of `boundary', which helps the
;; C-n/C-p act more naturally when entering/leaving the field. We
- ;; do this by making a small secondary overlay to contain just that
+ ;; do this by making a small secondary overlay to contain just that
;; one character.
+ ;; We DON'T do this if the field just consists of a newline, eg
+ ;; when specifying a character, since it breaks things (below
+ ;; does 1- to, which results in to = from). Bug#2689.
(let ((overlay (make-overlay (1- to) to nil t nil)))
(overlay-put overlay 'field 'boundary)
;; We need the real field for tabbing.
;;; Images.
(defcustom widget-image-directory (file-name-as-directory
- (expand-file-name "custom" data-directory))
+ (expand-file-name "images/custom" data-directory))
"Where widget button images are located.
If this variable is nil, widget will try to locate the directory
automatically."
(if (and (display-graphic-p)
(setq image (widget-image-find image)))
(progn (widget-put widget :suppress-face t)
- (insert-image image
- (propertize
- ;; Use a `list' so it's unique and won't get
- ;; accidentally merged with neighbouring images.
- tag 'mouse-face (list widget-button-pressed-face))))
+ (insert-image image tag))
(insert tag)))
(defun widget-move-and-invoke (event)
;;; Keymap and Commands.
-;;;###autoload
+;; This alias exists only so that one can choose in doc-strings (e.g.
+;; Custom-mode) which key-binding of widget-keymap one wants to refer to.
+;; http://lists.gnu.org/archive/html/emacs-devel/2008-11/msg00480.html
(defalias 'advertised-widget-backward 'widget-backward)
;;;###autoload
(define-key map [backtab] 'widget-backward)
(define-key map [down-mouse-2] 'widget-button-click)
(define-key map [down-mouse-1] 'widget-button-click)
- (define-key map "\C-m" 'widget-button-press)
+ ;; The following definition needs to avoid using escape sequences that
+ ;; might get converted to ^M when building loaddefs.el
+ (define-key map [(control ?m)] 'widget-button-press)
map)
"Keymap containing useful binding for buffers containing widgets.
Recommended as a parent keymap for modes using widgets.")
"An embedded link."
:button-prefix 'widget-link-prefix
:button-suffix 'widget-link-suffix
- :follow-link "\C-m"
+ :follow-link 'mouse-face
:help-echo "Follow the link."
:format "%[%t%]")
(set-buffer buffer)
(while (and size
(not (zerop size))
- (> to from)
+ ;; Bug#2689. Don't allow this loop to reduce a
+ ;; character field to zero size if it contains a space.
+ (> to (1+ from))
(eq (char-after (1- to)) ?\s))
(setq to (1- to)))
(let ((result (buffer-substring-no-properties from to)))
:complete-function 'ispell-complete-word
:prompt-history 'widget-string-prompt-value-history)
-(eval-when-compile (defvar widget))
+(defvar widget)
(defun widget-string-complete ()
"Complete contents of string field.
;; Replace field with completion in case its case is different.
(delete-region (widget-field-start widget)
(widget-field-end widget))
- (insert-and-inherit (car (assoc-ignore-case prefix alist))))
+ (insert-and-inherit (car (assoc-string prefix alist t))))
(message "Only match"))
((null completion)
(error "No match"))
- ((not (eq t (compare-strings prefix nil nil completion nil nil
+ ((not (eq t (compare-strings prefix nil nil completion nil nil
completion-ignore-case)))
(when completion-ignore-case
;; Replace field with completion in case its case is different.
(setq unread-command-events (cons ev unread-command-events)
ev (read-quoted-char (format "Enter code (radix %d)" read-quoted-char-radix))
tr nil)
- (if (and (integerp ev) (not (char-valid-p ev)))
+ (if (and (integerp ev) (not (characterp ev)))
(insert (char-to-string ev)))) ;; throw invalid char error
(setq ev (key-description (list ev)))
(when (arrayp tr)
:value 0
:size 1
:format "%{%t%}: %v\n"
- :valid-regexp "\\`.\\'"
+ ;; `.' does not match newline, but newline is a valid character.
+ :valid-regexp "\\`\\(.\\|\n\\)\\'"
:error "This field should contain a single character"
:value-to-internal (lambda (widget value)
(if (stringp value)
(require 'facemenu) ; for facemenu-color-alist
(let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
(point)))
- (list (or facemenu-color-alist (defined-colors)))
+ (list (or facemenu-color-alist
+ (sort (defined-colors) 'string-lessp)))
(completion (try-completion prefix list)))
(cond ((eq completion t)
(message "Exact match."))
(provide 'wid-edit)
-;;; arch-tag: a076e75e-18a1-4b46-8be5-3f317bcbc707
+;; arch-tag: a076e75e-18a1-4b46-8be5-3f317bcbc707
;;; wid-edit.el ends here