Mercurial > hg > xemacs-beta

comparison lisp/custom/wid-edit.el @ 179:9ad43877534d r20-3b16

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b16
author cvs
date Mon, 13 Aug 2007 09:52:19 +0200
parents 8eaf7971accc
children bfd6434d15b3
comparison
equal deleted inserted replaced
178:e703507b8a00 179:9ad43877534d
2 ;; 2 ;;
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
4 ;; 4 ;;
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6 ;; Keywords: extensions 6 ;; Keywords: extensions
7 ;; Version: 1.9951 7 ;; Version: 1.9953
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10 ;; This file is part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
11 11
12 ;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;; GNU Emacs is free software; you can redistribute it and/or modify
278 ;; Construct a menu of the choices 278 ;; Construct a menu of the choices
279 ;; and then use it for prompting for a single character. 279 ;; and then use it for prompting for a single character.
280 (let* ((overriding-terminal-local-map 280 (let* ((overriding-terminal-local-map
281 (make-sparse-keymap)) 281 (make-sparse-keymap))
282 map choice (next-digit ?0) 282 map choice (next-digit ?0)
283 some-choice-enabled
283 value) 284 value)
284 ;; Define SPC as a prefix char to get to this menu. 285 ;; Define SPC as a prefix char to get to this menu.
285 (define-key overriding-terminal-local-map " " 286 (define-key overriding-terminal-local-map " "
286 (setq map (make-sparse-keymap title))) 287 (setq map (make-sparse-keymap title)))
287 (save-excursion 288 (save-excursion
292 (setq choice (car items) items (cdr items)) 293 (setq choice (car items) items (cdr items))
293 (if (consp choice) 294 (if (consp choice)
294 (let* ((name (car choice)) 295 (let* ((name (car choice))
295 (function (cdr choice))) 296 (function (cdr choice)))
296 (insert (format "%c = %s\n" next-digit name)) 297 (insert (format "%c = %s\n" next-digit name))
297 (define-key map (vector next-digit) function))) 298 (define-key map (vector next-digit) function)
299 (setq some-choice-enabled t)))
298 ;; Allocate digits to disabled alternatives 300 ;; Allocate digits to disabled alternatives
299 ;; so that the digit of a given alternative never varies. 301 ;; so that the digit of a given alternative never varies.
300 (setq next-digit (1+ next-digit))) 302 (setq next-digit (1+ next-digit)))
301 (insert "\nC-g = Quit")) 303 (insert "\nC-g = Quit"))
304 (or some-choice-enabled
305 (error "None of the choices is currently meaningful"))
302 (define-key map [?\C-g] 'keyboard-quit) 306 (define-key map [?\C-g] 'keyboard-quit)
303 (define-key map [t] 'keyboard-quit) 307 (define-key map [t] 'keyboard-quit)
304 (setcdr map (nreverse (cdr map))) 308 (setcdr map (nreverse (cdr map)))
305 ;; Unread a SPC to lead to our new menu. 309 ;; Unread a SPC to lead to our new menu.
306 (setq unread-command-events (cons ?\ unread-command-events)) 310 (setq unread-command-events (cons ?\ unread-command-events))
327 ;;; Widget text specifications. 331 ;;; Widget text specifications.
328 ;; 332 ;;
329 ;; These functions are for specifying text properties. 333 ;; These functions are for specifying text properties.
330 334
331 (defcustom widget-field-add-space 335 (defcustom widget-field-add-space
332 (or (< emacs-major-version 20) 336 (or t
337 ;; It shouldn't be necessary in 20.3, but I need to debug it first.
338 (< emacs-major-version 20)
333 (and (eq emacs-major-version 20) 339 (and (eq emacs-major-version 20)
334 (< emacs-minor-version 3)) 340 (< emacs-minor-version 3))
335 (not (string-match "XEmacs" emacs-version))) 341 (not (string-match "XEmacs" emacs-version)))
336 "Non-nil means add extra space at the end of editable text fields. 342 "Non-nil means add extra space at the end of editable text fields.
337 343
352 :type 'boolean 358 :type 'boolean
353 :group 'widgets) 359 :group 'widgets)
354 360
355 (defun widget-specify-field (widget from to) 361 (defun widget-specify-field (widget from to)
356 "Specify editable button for WIDGET between FROM and TO." 362 "Specify editable button for WIDGET between FROM and TO."
357 ;; Terminating space is not part of the field, but necessary in
358 ;; order for local-map to work. Remove next sexp if local-map works
359 ;; at the end of the overlay.
360 (save-excursion 363 (save-excursion
361 (goto-char to) 364 (goto-char to)
362 (cond ((null (widget-get widget :size)) 365 (cond ((null (widget-get widget :size))
363 (forward-char 1)) 366 (forward-char 1))
367 ;; Terminating space is not part of the field, but necessary in
368 ;; order for local-map to work. Remove next sexp if local-map works
369 ;; at the end of the overlay.
364 (widget-field-add-space 370 (widget-field-add-space
365 (insert-and-inherit " "))) 371 (insert-and-inherit " ")))
366 (setq to (point))) 372 (setq to (point)))
367 (let ((map (widget-get widget :keymap)) 373 (let ((map (widget-get widget :keymap))
368 (face (or (widget-get widget :value-face) 'widget-field-face)) 374 (face (or (widget-get widget :value-face) 'widget-field-face))
591 597
592 The arguments MAPARG, and BUFFER default to nil and (current-buffer), 598 The arguments MAPARG, and BUFFER default to nil and (current-buffer),
593 respectively." 599 respectively."
594 (let ((cur (point-min)) 600 (let ((cur (point-min))
595 (widget nil) 601 (widget nil)
596 (parent nil) 602 ;; (parent nil)
597 (overlays (if buffer 603 (overlays (if buffer
598 (save-excursion (set-buffer buffer) (overlay-lists)) 604 (save-excursion (set-buffer buffer) (overlay-lists))
599 (overlay-lists)))) 605 (overlay-lists))))
600 (setq overlays (append (car overlays) (cdr overlays))) 606 (setq overlays (append (car overlays) (cdr overlays)))
601 (while (setq cur (pop overlays)) 607 (while (setq cur (pop overlays))
839 845
840 (defun widget-insert (&rest args) 846 (defun widget-insert (&rest args)
841 "Call `insert' with ARGS and make the text read only." 847 "Call `insert' with ARGS and make the text read only."
842 (let ((inhibit-read-only t) 848 (let ((inhibit-read-only t)
843 before-change-functions 849 before-change-functions
844 after-change-functions 850 after-change-functions)
845 (from (point)))
846 (apply 'insert args))) 851 (apply 'insert args)))
847 852
848 (defun widget-convert-text (type from to 853 (defun widget-convert-text (type from to
849 &optional button-from button-to 854 &optional button-from button-to
850 &rest args) 855 &rest args)
1093 "Move point to the ARG next field or button. 1098 "Move point to the ARG next field or button.
1094 ARG may be negative to move backward." 1099 ARG may be negative to move backward."
1095 (or (bobp) (> arg 0) (backward-char)) 1100 (or (bobp) (> arg 0) (backward-char))
1096 (let ((pos (point)) 1101 (let ((pos (point))
1097 (number arg) 1102 (number arg)
1098 (old (widget-tabable-at)) 1103 (old (widget-tabable-at)))
1099 new)
1100 ;; Forward. 1104 ;; Forward.
1101 (while (> arg 0) 1105 (while (> arg 0)
1102 (cond ((eobp) 1106 (cond ((eobp)
1103 (goto-char (point-min))) 1107 (goto-char (point-min)))
1104 (widget-use-overlay-change 1108 (widget-use-overlay-change