1 |
;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*- |
;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*- |
2 |
;; |
;; |
3 |
;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. |
;; Copyright (C) 1996,97,1999,2000,01,02,2003 Free Software Foundation, Inc. |
4 |
;; |
;; |
5 |
;; Author: Per Abrahamsen <abraham@dina.kvl.dk> |
;; Author: Per Abrahamsen <abraham@dina.kvl.dk> |
6 |
;; Maintainer: FSF |
;; Maintainer: FSF |
414 |
"Execute FORM without inheriting any text properties." |
"Execute FORM without inheriting any text properties." |
415 |
`(save-restriction |
`(save-restriction |
416 |
(let ((inhibit-read-only t) |
(let ((inhibit-read-only t) |
417 |
(inhibit-modification-hooks t) |
(inhibit-modification-hooks t)) |
418 |
result) |
(narrow-to-region (point) (point)) |
419 |
(insert "<>") |
(prog1 (progn ,@form) |
420 |
(narrow-to-region (- (point) 2) (point)) |
(goto-char (point-max)))))) |
|
(goto-char (1+ (point-min))) |
|
|
(setq result (progn ,@form)) |
|
|
(delete-region (point-min) (1+ (point-min))) |
|
|
(delete-region (1- (point-max)) (point-max)) |
|
|
(goto-char (point-max)) |
|
|
result))) |
|
421 |
|
|
422 |
(defface widget-inactive-face '((((class grayscale color) |
(defface widget-inactive-face '((((class grayscale color) |
423 |
(background dark)) |
(background dark)) |
559 |
respectively." |
respectively." |
560 |
(let ((cur (point-min)) |
(let ((cur (point-min)) |
561 |
(widget nil) |
(widget nil) |
|
(parent nil) |
|
562 |
(overlays (if buffer |
(overlays (if buffer |
563 |
(with-current-buffer buffer (overlay-lists)) |
(with-current-buffer buffer (overlay-lists)) |
564 |
(overlay-lists)))) |
(overlay-lists)))) |
994 |
(or (bobp) (> arg 0) (backward-char)) |
(or (bobp) (> arg 0) (backward-char)) |
995 |
(let ((wrapped 0) |
(let ((wrapped 0) |
996 |
(number arg) |
(number arg) |
997 |
(old (widget-tabable-at)) |
(old (widget-tabable-at))) |
|
new) |
|
998 |
;; Forward. |
;; Forward. |
999 |
(while (> arg 0) |
(while (> arg 0) |
1000 |
(cond ((eobp) |
(cond ((eobp) |
2475 |
|
|
2476 |
(defun widget-editable-list-format-handler (widget escape) |
(defun widget-editable-list-format-handler (widget escape) |
2477 |
;; We recognize the insert button. |
;; We recognize the insert button. |
2478 |
;;; (let ((widget-push-button-gui widget-editable-list-gui)) |
;; (let ((widget-push-button-gui widget-editable-list-gui)) |
2479 |
(cond ((eq escape ?i) |
(cond ((eq escape ?i) |
2480 |
(and (widget-get widget :indent) |
(and (widget-get widget :indent) |
2481 |
(insert-char ?\ (widget-get widget :indent))) |
(insert-char ?\ (widget-get widget :indent))) |
2484 |
(widget-get widget :append-button-args))) |
(widget-get widget :append-button-args))) |
2485 |
(t |
(t |
2486 |
(widget-default-format-handler widget escape))) |
(widget-default-format-handler widget escape))) |
2487 |
;;; ) |
;; ) |
2488 |
) |
) |
2489 |
|
|
2490 |
(defun widget-editable-list-value-create (widget) |
(defun widget-editable-list-value-create (widget) |
2585 |
(defun widget-editable-list-entry-create (widget value conv) |
(defun widget-editable-list-entry-create (widget value conv) |
2586 |
;; Create a new entry to the list. |
;; Create a new entry to the list. |
2587 |
(let ((type (nth 0 (widget-get widget :args))) |
(let ((type (nth 0 (widget-get widget :args))) |
2588 |
;;; (widget-push-button-gui widget-editable-list-gui) |
;; (widget-push-button-gui widget-editable-list-gui) |
2589 |
child delete insert) |
child delete insert) |
2590 |
(widget-specify-insert |
(widget-specify-insert |
2591 |
(save-excursion |
(save-excursion |
2614 |
widget type (widget-default-get type))))) |
widget type (widget-default-get type))))) |
2615 |
(t |
(t |
2616 |
(error "Unknown escape `%c'" escape))))) |
(error "Unknown escape `%c'" escape))))) |
2617 |
(widget-put widget |
(let ((buttons (widget-get widget :buttons))) |
2618 |
:buttons (cons delete |
(if insert (push insert buttons)) |
2619 |
(cons insert |
(if delete (push delete buttons)) |
2620 |
(widget-get widget :buttons)))) |
(widget-put widget :buttons buttons)) |
2621 |
(let ((entry-from (point-min-marker)) |
(let ((entry-from (point-min-marker)) |
2622 |
(entry-to (point-max-marker))) |
(entry-to (point-max-marker))) |
2623 |
(set-marker-insertion-type entry-from t) |
(set-marker-insertion-type entry-from t) |
2624 |
(set-marker-insertion-type entry-to nil) |
(set-marker-insertion-type entry-to nil) |
2625 |
(widget-put child :entry-from entry-from) |
(widget-put child :entry-from entry-from) |
2626 |
(widget-put child :entry-to entry-to))) |
(widget-put child :entry-to entry-to))) |
2627 |
(widget-put insert :widget child) |
(if insert (widget-put insert :widget child)) |
2628 |
(widget-put delete :widget child) |
(if delete (widget-put delete :widget child)) |
2629 |
child)) |
child)) |
2630 |
|
|
2631 |
;;; The `group' Widget. |
;;; The `group' Widget. |
3242 |
:value-to-internal (lambda (widget value) |
:value-to-internal (lambda (widget value) |
3243 |
(list (car value) (cdr value))) |
(list (car value) (cdr value))) |
3244 |
:value-to-external (lambda (widget value) |
:value-to-external (lambda (widget value) |
3245 |
(cons (nth 0 value) (nth 1 value)))) |
(apply 'cons value))) |
3246 |
|
|
3247 |
(defun widget-cons-match (widget value) |
(defun widget-cons-match (widget value) |
3248 |
(and (consp value) |
(and (consp value) |
3465 |
(prompt (concat tag ": ")) |
(prompt (concat tag ": ")) |
3466 |
(value (widget-value widget)) |
(value (widget-value widget)) |
3467 |
(start (widget-field-start widget)) |
(start (widget-field-start widget)) |
|
(pos (cond ((< (point) start) |
|
|
0) |
|
|
((> (point) (+ start (length value))) |
|
|
(length value)) |
|
|
(t |
|
|
(- (point) start)))) |
|
3468 |
(answer (facemenu-read-color prompt))) |
(answer (facemenu-read-color prompt))) |
3469 |
(unless (zerop (length answer)) |
(unless (zerop (length answer)) |
3470 |
(widget-value-set widget answer) |
(widget-value-set widget answer) |