comparison lisp/wid-edit.el @ 18598:e12b4c195b2b

Synched with 1.9944.

18597:515b7c955cd8

;;
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <[e-mail]>
;; Keywords: extensions
;; Version: 1.9942
;; 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

(defgroup widgets nil
  "Customization support for the Widget Library."
  :link '(custom-manual "(widget)Top")
  :link '(url-link :tag "Development Page" 
		   "http://www.dina.kvl.dk/~abraham/custom/")
  :prefix "widget-"
  :group 'extensions
  :group 'hypermedia)

(defgroup widget-documentation 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
  ;; at the end of the overlay.
  (save-excursion
    (goto-char to)
    (when widget-field-add-space
      (insert-and-inherit " "))
    (setq to (point)))
  (if widget-field-add-space
      (add-text-properties (1- to) to
			   '(front-sticky nil start-open t read-only to))
    (add-text-properties to (1+ to) 
			 '(front-sticky nil start-open t read-only to)))
  (add-text-properties (1- from) from 
		       '(rear-nonsticky t end-open t read-only from))
  (let ((map (widget-get widget :keymap))
	(face (or (widget-get widget :value-face) 'widget-field-face))
	(help-echo (widget-get widget :help-echo))
	(overlay (make-overlay from to nil nil t)))
    (unless (or (stringp help-echo) (null help-echo))
      (setq help-echo 'widget-mouse-help))    
    (widget-put widget :field-overlay overlay)
    (overlay-put overlay 'detachable nil)
    (overlay-put overlay 'field widget)

(defun widget-field-end (widget)
  "Return the end of WIDGET's editing field."
  (let ((overlay (widget-get widget :field-overlay)))
    ;; Don't subtract one if local-map works at the end of the overlay.
    (and overlay (if widget-field-add-space
		     (1- (overlay-end overlay))
		   (overlay-end overlay)))))

(defun widget-field-find (pos)
  "Return the field at POS.

(defun widget-url-link-action (widget &optional event)
  "Open the url specified by WIDGET."
  (require 'browse-url)
  (funcall browse-url-browser-function (widget-value widget)))

;;; The `editable-field' Widget.

(define-widget 'editable-field 'default
  "An editable text field."
  :convert-widget 'widget-value-convert-widget

18598:e12b4c195b2b

;;
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <[e-mail]>
;; Keywords: extensions
;; Version: 1.9944
;; 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

(defgroup widgets nil
  "Customization support for the Widget Library."
  :link '(custom-manual "(widget)Top")
  :link '(url-link :tag "Development Page" 
		   "http://www.dina.kvl.dk/~abraham/custom/")
  :link '(emacs-library-link :tag "Lisp File" "widget.el")
  :prefix "widget-"
  :group 'extensions
  :group 'hypermedia)

(defgroup widget-documentation 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
  ;; at the end of the overlay.
  (save-excursion
    (goto-char to)
    (cond ((null (widget-get widget :size))
	   (forward-char 1))
	  (widget-field-add-space
	   (insert-and-inherit " ")))
    (setq to (point)))
  (if (or widget-field-add-space
	  (null (widget-get widget :size)))
      (add-text-properties (1- to) to
			   '(front-sticky nil start-open t read-only to))
    (add-text-properties to (1+ to) 
			 '(front-sticky nil start-open t read-only to)))
  (add-text-properties (1- from) from 
		       '(rear-nonsticky t end-open t read-only from))
  (let ((map (widget-get widget :keymap))
	(face (or (widget-get widget :value-face) 'widget-field-face))
	(help-echo (widget-get widget :help-echo))
	(overlay (make-overlay from to nil 
			       nil (or (not widget-field-add-space)
				       (widget-get widget :size)))))
    (unless (or (stringp help-echo) (null help-echo))
      (setq help-echo 'widget-mouse-help))    
    (widget-put widget :field-overlay overlay)
    (overlay-put overlay 'detachable nil)
    (overlay-put overlay 'field widget)

(defun widget-field-end (widget)
  "Return the end of WIDGET's editing field."
  (let ((overlay (widget-get widget :field-overlay)))
    ;; Don't subtract one if local-map works at the end of the overlay.
    (and overlay (if (or widget-field-add-space
			 (null (widget-get widget :size)))
		     (1- (overlay-end overlay))
		   (overlay-end overlay)))))

(defun widget-field-find (pos)
  "Return the field at POS.

(defun widget-url-link-action (widget &optional event)
  "Open the url specified by WIDGET."
  (require 'browse-url)
  (funcall browse-url-browser-function (widget-value widget)))

;;; The `file-link' Widget.

(define-widget 'file-link 'link
  "A link to a file."
  :action 'widget-file-link-action)

(defun widget-file-link-action (widget &optional event)
  "Find the file specified by WIDGET."
  (find-file (widget-value widget)))

;;; The `emacs-library-link' Widget.

(define-widget 'emacs-library-link 'link
  "A link to an Emacs Lisp library file."
  :action 'widget-emacs-library-link-action)

(defun widget-emacs-library-link-action (widget &optional event)
  "Find the Emacs Library file specified by WIDGET."
  (find-file (locate-library (widget-value widget))))

;;; The `editable-field' Widget.

(define-widget 'editable-field 'default
  "An editable text field."
  :convert-widget 'widget-value-convert-widget