Mercurial > hg > xemacs-beta
diff lisp/custom/widget-edit.el @ 20:859a2309aef8 r19-15b93
Import from CVS: tag r19-15b93
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:50:05 +0200 |
parents | d95e72db5c07 |
children | 8fc7fe29b841 |
line wrap: on
line diff
--- a/lisp/custom/widget-edit.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/custom/widget-edit.el Mon Aug 13 08:50:05 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.24 +;; Version: 1.30 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -190,6 +190,20 @@ items nil t) items))))) +(defun widget-get-sibling (widget) + "Get the item WIDGET is assumed to toggle. +This is only meaningful for radio buttons or checkboxes in a list." + (let* ((parent (widget-get widget :parent)) + (children (widget-get parent :children)) + child) + (catch 'child + (while children + (setq child (car children) + children (cdr children)) + (when (eq (widget-get child :button) widget) + (throw 'child child))) + nil))) + ;;; Widget text specifications. ;; ;; These functions are for specifying text properties. @@ -288,9 +302,9 @@ (unless (widget-get widget :size) (add-text-properties to (1+ to) (list 'field widget - 'face face - 'local-map map - 'keymap map))))) + 'face face))) + (add-text-properties to (1+ to) (list 'local-map map + 'keymap map)))) (defun widget-specify-button (widget from to) ;; Specify button for WIDGET between FROM and TO. @@ -332,6 +346,10 @@ ;;; Widget Properties. +(defsubst widget-name (widget) + "Return the name of WIDGET, asymbol." + (car widget)) + (defun widget-put (widget property value) "In WIDGET set PROPERTY to VALUE. The value can later be retrived with `widget-get'." @@ -491,6 +509,7 @@ (unless widget-keymap (setq widget-keymap (make-sparse-keymap)) + (define-key widget-keymap "\C-k" 'widget-kill-line) (define-key widget-keymap "\t" 'widget-forward) (define-key widget-keymap "\M-\t" 'widget-backward) (define-key widget-keymap [(shift tab)] 'widget-backward) @@ -512,6 +531,8 @@ (unless widget-field-keymap (setq widget-field-keymap (copy-keymap widget-keymap)) (define-key widget-field-keymap "\C-m" 'widget-field-activate) + (define-key widget-field-keymap "\C-a" 'widget-beginning-of-line) + (define-key widget-field-keymap "\C-e" 'widget-end-of-line) (set-keymap-parent widget-field-keymap global-map)) (defvar widget-text-keymap nil @@ -519,6 +540,8 @@ (unless widget-text-keymap (setq widget-text-keymap (copy-keymap widget-keymap)) + (define-key widget-text-keymap "\C-a" 'widget-beginning-of-line) + (define-key widget-text-keymap "\C-e" 'widget-end-of-line) (set-keymap-parent widget-text-keymap global-map)) (defun widget-field-activate (pos &optional event) @@ -625,6 +648,61 @@ (run-hooks 'widget-backward-hook) (widget-move (- arg))) +(defun widget-beginning-of-line () + "Go to beginning of field or beginning of line, whichever is first." + (interactive) + (let ((bol (save-excursion (beginning-of-line) (point))) + (prev (previous-single-property-change (point) 'field))) + (goto-char (max bol (or prev bol))))) + +(defun widget-end-of-line () + "Go to end of field or end of line, whichever is first." + (interactive) + (let ((bol (save-excursion (end-of-line) (point))) + (prev (next-single-property-change (point) 'field))) + (goto-char (min bol (or prev bol))))) + +(defun widget-kill-line () + "Kill to end of field or end of line, whichever is first." + (interactive) + (let ((field (get-text-property (point) 'field)) + (newline (save-excursion (search-forward "\n"))) + (next (next-single-property-change (point) 'field))) + (if (and field (> newline next)) + (kill-region (point) next) + (call-interactively 'kill-line)))) + +(defun widget-identify (pos) + "Identify the widget under point." + (interactive "d") + (let* ((field (get-text-property pos 'field)) + (button (get-text-property pos 'button)) + (doc (get-text-property pos 'widget-doc)) + (widget (or field button doc))) + (with-output-to-temp-buffer "*Widget Identity*" + (princ (cond (field "This is an editable text area.\n") + (button "This is an active area.\n") + (doc "This is documentation text.\n") + (t "This is unidentified text.\n"))) + (while widget + (princ "It is part of a `") + (princ (car widget)) + (princ "' widget (value: ") + (prin1 (condition-case nil + (widget-value widget) + (error 'error))) + (princ ").\n") + (when (eq (car widget) 'radio-button) + (let ((sibling (widget-get-sibling widget))) + (if (not sibling) + (princ "It doesn't seem to control anything.\n") + (princ "The value of its sibling is: ") + (prin1 (condition-case nil + (widget-value sibling) + (error 'error))) + (princ ".\n")))) + (setq widget (widget-get widget :parent)))))) + ;;; Setting up the buffer. (defvar widget-field-new nil) @@ -1231,36 +1309,33 @@ ;;; The `toggle' Widget. -(define-widget 'toggle 'menu-choice +(define-widget 'toggle 'item "Toggle between two states." - :convert-widget 'widget-toggle-convert-widget - :format "%v" + :format "%[%v%]\n" + :value-create 'widget-toggle-value-create + :action 'widget-toggle-action + :match (lambda (widget value) t) :on "on" :off "off") -(defun widget-toggle-convert-widget (widget) - ;; Create the types representing the `on' and `off' states. - (let ((on-type (widget-get widget :on-type)) - (off-type (widget-get widget :off-type))) - (unless on-type - (setq on-type - (list 'choice-item - :value t - :match (lambda (widget value) value) - :tag (widget-get widget :on)))) - (unless off-type - (setq off-type - (list 'choice-item :value nil :tag (widget-get widget :off)))) - (widget-put widget :args (list on-type off-type))) - widget) +(defun widget-toggle-value-create (widget) + ;; Insert text representing the `on' and `off' states. + (if (widget-value widget) + (insert (widget-get widget :on)) + (insert (widget-get widget :off)))) +(defun widget-toggle-action (widget &optional event) + ;; Toggle value. + (widget-value-set widget (not (widget-value widget))) + (widget-apply widget :notify widget event)) + ;;; The `checkbox' Widget. (define-widget 'checkbox 'toggle "A checkbox toggle." - :convert-widget 'widget-item-convert-widget - :on-type '(choice-item :format "%[[X]%]" t) - :off-type '(choice-item :format "%[[ ]%]" nil)) + :format "%[%v%]" + :on "[X]" + :off "[ ]") ;;; The `checklist' Widget. @@ -1427,11 +1502,12 @@ (define-widget 'radio-button 'toggle "A radio button for use in the `radio' widget." :notify 'widget-radio-button-notify - :on-type '(choice-item :format "%[(*)%]" t) - :off-type '(choice-item :format "%[( )%]" nil)) + :format "%[%v%]" + :on "(*)" + :off "( )") (defun widget-radio-button-notify (widget child &optional event) - ;; Notify the parent. + ;; Tell daddy. (widget-apply (widget-get widget :parent) :action widget event)) ;;; The `radio-button-choice' Widget. @@ -2074,7 +2150,7 @@ (define-widget 'boolean 'toggle "To be nil or non-nil, that is the question." :tag "Boolean" - :format "%{%t%}: %v") + :format "%{%t%}: %[%v%]") ;;; The `color' Widget.