comparison lisp/wid-edit.el @ 18451:8eb08560287b

Synched with 1.9936.

18450:327eba076416

;;
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <[e-mail]>
;; Keywords: extensions
;; Version: 1.9929
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify

If you don't add the space, it will become impossible to edit a zero
size field."
  :type 'boolean
  :group 'widgets)

(defun widget-specify-field (widget from to)
  "Specify editable button for WIDGET between FROM and TO."
  (put-text-property from to 'read-only nil)
  ;; Terminating space is not part of the field, but necessary in
  ;; order for local-map to work.  Remove next sexp if local-map works

(defun widget-glyph-insert-glyph (widget glyph &optional down inactive)
  "In WIDGET, insert GLYPH.
If optional arguments DOWN and INACTIVE are given, they should be
glyphs used when the widget is pushed and inactive, respectively."
  (set-glyph-property glyph 'widget widget)
  (when down
    (set-glyph-property down 'widget widget))
  (when inactive
    (set-glyph-property inactive 'widget widget))
  (insert "*")
  (let ((ext (make-extent (point) (1- (point))))
	(help-echo (widget-get widget :help-echo)))
    (set-extent-property ext 'invisible t)
    (set-extent-property ext 'start-open t)
    (set-extent-property ext 'end-open t)
    (set-extent-end-glyph ext glyph)
    (when help-echo
      (set-extent-property ext 'balloon-help help-echo)
      (set-extent-property ext 'help-echo help-echo)))
  (widget-put widget :glyph-up glyph)
  (when down (widget-put widget :glyph-down down))
  (when inactive (widget-put widget :glyph-inactive inactive)))

;;; Buttons.

(defgroup widget-button nil
  "The look of various kinds of buttons."

		       (when (and pos 
				  (eq (get-char-property pos 'button) button))
			 (widget-apply-action button event)))
		   (overlay-put overlay 'face face)
		   (overlay-put overlay 'mouse-face mouse-face)))
	     (let (command up)
	       ;; Find the global command to run, and check whether it
	       ;; is bound to an up event.
	       (cond ((setq command	;down event
			    (lookup-key widget-global-map [ button2 ])))
		     ((setq command	;down event
			    (lookup-key widget-global-map [ down-mouse-2 ])))
		     ((setq command	;up event
			    (lookup-key widget-global-map [ button2up ]))
		      (setq up t))
		     ((setq command	;up event
			    (lookup-key widget-global-map [ mouse-2]))
		      (setq up t)))
	       (when command
		 ;; Don't execute up events twice.
		 (when up
		   (while (not (button-release-event-p event))
		     (setq event (widget-read-event))))
		 (call-interactively command))))))
	(t
	 (message "You clicked somewhere weird."))))

(defun widget-button1-click (event)

	(set-marker from nil)
	(set-marker to nil))))
  (widget-clear-undo)
  ;; We need to maintain text properties and size of the editing fields.
  (make-local-variable 'after-change-functions)
  (make-local-variable 'before-change-functions)
  (setq after-change-functions
	(if widget-field-list '(widget-after-change) nil))
  (setq before-change-functions
	(if widget-field-list '(widget-before-change) nil)))

(defvar widget-field-last nil)
;; Last field containing point.
(make-variable-buffer-local 'widget-field-last)

(defun widget-push-button-value-create (widget)
  ;; Insert text representing the `on' and `off' states.
  (let* ((tag (or (widget-get widget :tag)
		  (widget-get widget :value)))
	 (text (concat widget-push-button-prefix
		       tag widget-push-button-suffix))
	 (gui (cdr (assoc tag widget-push-button-cache))))
    (if (and (fboundp 'make-gui-button)
	     (fboundp 'make-glyph)
	     widget-push-button-gui
	     (fboundp 'device-on-window-system-p)
	     (device-on-window-system-p)
	     (string-match "XEmacs" emacs-version))
	(progn 
	  (unless gui
	    (setq gui (make-gui-button tag 'widget-gui-action widget))
	    (push (cons tag gui) widget-push-button-cache))
	  (widget-glyph-insert-glyph widget
				     (make-glyph
				      (list (nth 0 (aref gui 1))
					    (vector 'string ':data text)))
				     (make-glyph
				      (list (nth 1 (aref gui 1))
					    (vector 'string ':data text)))
				     (make-glyph
				      (list (nth 2 (aref gui 1))
					    (vector 'string ':data text)))))
      (insert text))))

(defun widget-gui-action (widget)
  "Apply :action for WIDGET."
  (widget-apply-action widget (this-command-keys)))

18451:8eb08560287b

;;
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <[e-mail]>
;; Keywords: extensions
;; Version: 1.9936
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify

If you don't add the space, it will become impossible to edit a zero
size field."
  :type 'boolean
  :group 'widgets)

(defcustom widget-field-use-before-change
  (or (> emacs-minor-version 34)
      (> emacs-major-version 20)
      (string-match "XEmacs" emacs-version))
  "Non-nil means use `before-change-functions' to track editable fields.
This enables the use of undo, but doesn'f work on Emacs 19.34 and earlier. 
Using before hooks also means that the :notify function can't know the
new value."
  :type 'boolean
  :group 'widgets)

(defun widget-specify-field (widget from to)
  "Specify editable button for WIDGET between FROM and TO."
  (put-text-property from to 'read-only nil)
  ;; Terminating space is not part of the field, but necessary in
  ;; order for local-map to work.  Remove next sexp if local-map works

(defun widget-glyph-insert-glyph (widget glyph &optional down inactive)
  "In WIDGET, insert GLYPH.
If optional arguments DOWN and INACTIVE are given, they should be
glyphs used when the widget is pushed and inactive, respectively."
  (when widget
    (set-glyph-property glyph 'widget widget)
    (when down
      (set-glyph-property down 'widget widget))
    (when inactive
      (set-glyph-property inactive 'widget widget)))
  (insert "*")
  (let ((ext (make-extent (point) (1- (point))))
	(help-echo (and widget (widget-get widget :help-echo))))
    (set-extent-property ext 'invisible t)
    (set-extent-property ext 'start-open t)
    (set-extent-property ext 'end-open t)
    (set-extent-end-glyph ext glyph)
    (when help-echo
      (set-extent-property ext 'balloon-help help-echo)
      (set-extent-property ext 'help-echo help-echo)))
  (when widget
    (widget-put widget :glyph-up glyph)
    (when down (widget-put widget :glyph-down down))
    (when inactive (widget-put widget :glyph-inactive inactive))))

;;; Buttons.

(defgroup widget-button nil
  "The look of various kinds of buttons."

		       (when (and pos 
				  (eq (get-char-property pos 'button) button))
			 (widget-apply-action button event)))
		   (overlay-put overlay 'face face)
		   (overlay-put overlay 'mouse-face mouse-face)))
	     (let ((up t)
		   command)
	       ;; Find the global command to run, and check whether it
	       ;; is bound to an up event.
	       (cond ((setq command	;down event
			    (lookup-key widget-global-map [ button2 ]))
		      (setq up nil))
		     ((setq command	;down event
			    (lookup-key widget-global-map [ down-mouse-2 ]))
		      (setq up nil))
		     ((setq command	;up event
			    (lookup-key widget-global-map [ button2up ])))
		     ((setq command	;up event
			    (lookup-key widget-global-map [ mouse-2]))))
	       (when up
		 ;; Don't execute up events twice.
		 (while (not (button-release-event-p event))
		   (setq event (widget-read-event))))
	       (when command
		 (call-interactively command))))))
	(t
	 (message "You clicked somewhere weird."))))

(defun widget-button1-click (event)

	(set-marker from nil)
	(set-marker to nil))))
  (widget-clear-undo)
  ;; We need to maintain text properties and size of the editing fields.
  (make-local-variable 'after-change-functions)
  (setq after-change-functions
	(if widget-field-list '(widget-after-change) nil))
  (when widget-field-use-before-change
    (make-local-variable 'before-change-functions)
    (setq before-change-functions
	  (if widget-field-list '(widget-before-change) nil))))

(defvar widget-field-last nil)
;; Last field containing point.
(make-variable-buffer-local 'widget-field-last)

(defun widget-push-button-value-create (widget)
  ;; Insert text representing the `on' and `off' states.
  (let* ((tag (or (widget-get widget :tag)
		  (widget-get widget :value)))
	 (tag-glyph (widget-get widget :tag-glyph))
	 (text (concat widget-push-button-prefix
		       tag widget-push-button-suffix))
	 (gui (cdr (assoc tag widget-push-button-cache))))
    (cond (tag-glyph
	   (widget-glyph-insert widget text tag-glyph))
	  ((and (fboundp 'make-gui-button)
	     (fboundp 'make-glyph)
	     widget-push-button-gui
	     (fboundp 'device-on-window-system-p)
	     (device-on-window-system-p)
	     (string-match "XEmacs" emacs-version))
	   (unless gui
	     (setq gui (make-gui-button tag 'widget-gui-action widget))
	     (push (cons tag gui) widget-push-button-cache))
	   (widget-glyph-insert-glyph widget
				      (make-glyph
				       (list (nth 0 (aref gui 1))
					     (vector 'string ':data text)))
				      (make-glyph
				       (list (nth 1 (aref gui 1))
					     (vector 'string ':data text)))
				      (make-glyph
				       (list (nth 2 (aref gui 1))
					     (vector 'string ':data text)))))
	  (t
	   (insert text)))))

(defun widget-gui-action (widget)
  "Apply :action for WIDGET."
  (widget-apply-action widget (this-command-keys)))