Mercurial > hg > xemacs-beta
diff lisp/custom/wid-edit.el @ 134:34a5b81f86ba r20-2b1
Import from CVS: tag r20-2b1
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:30:11 +0200 |
parents | 9b50b4588a93 |
children | b980b6286996 |
line wrap: on
line diff
--- a/lisp/custom/wid-edit.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/custom/wid-edit.el Mon Aug 13 09:30:11 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.84 +;; Version: 1.89 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -58,7 +58,7 @@ ;; We have the old custom-library, hack around it! (defmacro defgroup (&rest args) nil) (defmacro defcustom (var value doc &rest args) - `(defvar ,var ,value ,doc)) + (` (defvar (, var) (, value) (, doc)))) (defmacro defface (&rest args) nil) (define-widget-keywords :prefix :tag :load :link :options :type :group) (when (fboundp 'copy-face) @@ -117,7 +117,7 @@ (defface widget-field-face '((((class grayscale color) (background light)) - (:background "light gray")) + (:background "gray85")) (((class grayscale color) (background dark)) (:background "dark gray")) @@ -167,7 +167,9 @@ "Choose an item from a list. First argument TITLE is the name of the list. -Second argument ITEMS is an alist (NAME . VALUE). +Second argument ITEMS is an list whose members are either + (NAME . VALUE), to indicate selectable items, or just strings to + indicate unselectable items. Optional third argument EVENT is an input event. The user is asked to choose between each NAME from the items alist, @@ -188,7 +190,9 @@ (mapcar (function (lambda (x) - (vector (car x) (list (car x)) t))) + (if (stringp x) + (vector x nil nil) + (vector (car x) (list (car x)) t)))) items))))) (setq val (and val (listp (event-object val)) @@ -196,6 +200,7 @@ (car (event-object val)))) (cdr (assoc val items)))) (t + (setq items (remove-if 'stringp items)) (let ((val (completing-read (concat title ": ") items nil t))) (if (stringp val) (let ((try (try-completion val items))) @@ -371,7 +376,8 @@ (defmacro widget-specify-insert (&rest form) ;; Execute FORM without inheriting any text properties. - `(save-restriction + (` + (save-restriction (let ((inhibit-read-only t) result after-change-functions) @@ -379,11 +385,11 @@ (narrow-to-region (- (point) 2) (point)) (widget-specify-none (point-min) (point-max)) (goto-char (1+ (point-min))) - (setq result (progn ,@form)) + (setq result (progn (,@ form))) (delete-region (point-min) (1+ (point-min))) (delete-region (1- (point-max)) (point-max)) (goto-char (point-max)) - result))) + result)))) (defface widget-inactive-face '((((class grayscale color) (background dark)) @@ -401,7 +407,8 @@ (unless (widget-get widget :inactive) (let ((overlay (make-overlay from to nil t nil))) (overlay-put overlay 'face 'widget-inactive-face) - (overlay-put overlay 'evaporate 't) + (overlay-put overlay 'evaporate t) + (overlay-put overlay 'priority 100) (overlay-put overlay (if (string-match "XEmacs" emacs-version) 'read-only 'modification-hooks) '(widget-overlay-inactive)) @@ -783,8 +790,9 @@ (t (error "No buttons or fields found")))))) (setq button (widget-at (point))) - (if (and button (widget-get button :tab-order) - (< (widget-get button :tab-order) 0)) + (if (or (and button (widget-get button :tab-order) + (< (widget-get button :tab-order) 0)) + (and button (not (widget-apply button :active)))) (setq arg (1+ arg)))))) (while (< arg 0) (if (= (point-min) (point)) @@ -821,8 +829,9 @@ (button (goto-char button)) (field (goto-char field))) (setq button (widget-at (point))) - (if (and button (widget-get button :tab-order) - (< (widget-get button :tab-order) 0)) + (if (or (and button (widget-get button :tab-order) + (< (widget-get button :tab-order) 0)) + (and button (not (widget-apply button :active)))) (setq arg (1- arg))))) (widget-echo-help (point)) (run-hooks 'widget-move-hook)) @@ -1070,7 +1079,8 @@ (set-marker-insertion-type from t) (set-marker-insertion-type to nil) (widget-put widget :from from) - (widget-put widget :to to)))) + (widget-put widget :to to))) + (widget-clear-undo)) (defun widget-default-format-handler (widget escape) ;; We recognize the %h escape by default. @@ -1132,7 +1142,8 @@ ;; Kludge: this doesn't need to be true for empty formats. (delete-region from to)) (set-marker from nil) - (set-marker to nil))) + (set-marker to nil)) + (widget-clear-undo)) (defun widget-default-value-set (widget value) ;; Recreate widget with new value. @@ -1280,7 +1291,17 @@ (defun widget-info-link-action (widget &optional event) "Open the info node specified by WIDGET." - (Info-goto-node (widget-value widget))) + (Info-goto-node (widget-value widget)) + ;; Steal button release event. + (if (and (fboundp 'button-press-event-p) + (fboundp 'next-command-event)) + ;; XEmacs + (and event + (button-press-event-p event) + (next-command-event)) + ;; Emacs + (when (memq 'down (event-modifiers event)) + (read-event)))) ;;; The `url-link' Widget. @@ -1490,11 +1511,8 @@ (widget-value-set widget (widget-apply current :value-to-external (widget-get current :value))) - (widget-apply widget :notify widget event) - (widget-setup))) - ;; Notify parent. - (widget-apply widget :notify widget event) - (widget-clear-undo)) + (widget-apply widget :notify widget event) + (widget-setup)))) (defun widget-choice-validate (widget) ;; Valid if we have made a valid choice. @@ -1550,7 +1568,7 @@ ;; Toggle value. (widget-value-set widget (not (widget-value widget))) (widget-apply widget :notify widget event)) - + ;;; The `checkbox' Widget. (define-widget 'checkbox 'toggle