diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 48 | ||||
| -rw-r--r-- | lisp/cus-edit.el | 3 | ||||
| -rw-r--r-- | lisp/ffap.el | 2 | ||||
| -rw-r--r-- | lisp/ido.el | 119 | ||||
| -rw-r--r-- | lisp/jka-compr.el | 9 | ||||
| -rw-r--r-- | lisp/ls-lisp.el | 21 | ||||
| -rw-r--r-- | lisp/textmodes/texnfo-upd.el | 39 | ||||
| -rw-r--r-- | lisp/wid-edit.el | 110 |
8 files changed, 251 insertions, 100 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5c667e0b353..c737c003eb9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,34 @@ +2003-12-27 Kim F. Storm <storm@cua.dk> + + * ido.el: Handle non-readable directories. + (ido-decorations): Add 9th element for non-readable directory. + (ido-directory-nonreadable): New dynamic var. + (ido-set-current-directory): Set it. + (ido-read-buffer, ido-file-internal): + (ido-read-file-name, ido-read-directory-name): Let-bind it. + (ido-file-name-all-completions1): Return empty list for + non-readable directory. + (ido-exhibit): Print [Not readable] if directory is not readable. + (ido-expand-directory): New defun (based on tiny fix from Karl Chen). + (ido-read-file-name, ido-file-internal, ido-read-directory-name): + Use it. + +2003-12-27 Lars Hansen <larsh@math.ku.dk> + + * ls-lisp.el (ls-lisp-insert-directory): Add parameter 'string in + calls to directory-files-and-attributes and file-attributes. + (ls-lisp-format): Remove system dependent handling of user and + group id's. + +2003-12-25 Luc Teirlinck <teirllm@auburn.edu> + + * ffap.el (ffap-read-file-or-url): Revert previous change. + +2003-12-25 Andreas Schwab <schwab@suse.de> + + * jka-compr.el (jka-compr-insert-file-contents): Avoid error when + file not found. + 2003-12-08 Miles Bader <miles@gnu.org> * dired.el (dired-between-files): Always use dired-move-to-filename, @@ -67,6 +98,23 @@ * info.el (Info-unescape-quotes, Info-split-parameter-string) (Info-goto-emacs-command-node): Doc fixes. +2003-12-12 Jesper Harder <harder@ifa.au.dk> + + * cus-edit.el (custom-add-parent-links): Define "many". + +2003-12-08 Per Abrahamsen <abraham@dina.kvl.dk> + + * wid-edit.el (widget-child-value-get, widget-child-value-inline) + (widget-child-validate, widget-type-value-create) + (widget-type-default-get, widget-type-match): New functions. + (lazy): New widget. + (menu-choice, checklist, radio-button-choice, editable-list) + (group, documentation-string): Removed redundant (per 2003-10-25 + change) calls to `widget-children-value-delete'. + (widget-choice-value-get, widget-choice-value-inline): Removed + functions. + (menu-choice): Updated widget. + 2003-12-03 Kenichi Handa <handa@m17n.org> * language/cyrillic.el: Register "microsoft-cp1251" in diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index bf92e8df9cf..fc5e7ecb8af 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1970,7 +1970,8 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (setq parents (cons symbol parents)))))) (and (null (get symbol 'custom-links)) ;No links of its own. (= (length parents) 1) ;A single parent. - (let ((links (get (car parents) 'custom-links))) + (let* ((links (get (car parents) 'custom-links)) + (many (> (length links) 2))) (when links (insert "\nParent documentation: ") (while links diff --git a/lisp/ffap.el b/lisp/ffap.el index b249ce8daa0..668700a5c1f 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1216,7 +1216,7 @@ which may actually result in an url rather than a filename." 'ffap-read-file-or-url-internal dir nil - (if dir (cons guess (1+ (length dir))) guess) + (if dir (cons guess (length dir)) guess) (list 'file-name-history)))) ;; Do file substitution like (interactive "F"), suggested by MCOOK. (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess))) diff --git a/lisp/ido.el b/lisp/ido.el index 57736ae7d26..165142ea222 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -685,16 +685,17 @@ Obsolete. Set 3rd element of `ido-decorations' instead." :type '(choice string (const nil)) :group 'ido) -(defcustom ido-decorations '( "{" "}" " | " " | ..." "[" "]" " [No match]" " [Matched]") +(defcustom ido-decorations '( "{" "}" " | " " | ..." "[" "]" " [No match]" " [Matched]" " [Not readable]") "*List of strings used by ido to display the alternatives in the minibuffer. -There are 8 elements in this list, each is a pair of strings: +There are 9 elements in this list: 1st and 2nd elements are used as brackets around the prospect list, 3rd element is the separator between prospects (ignored if ido-separator is set), 4th element is the string inserted at the end of a truncated list of prospects, 5th and 6th elements are used as brackets around the common match string which can be completed using TAB, 7th element is the string displayed when there are a no matches, and -8th element displayed if there is a single match (and faces are not used)." +8th element is displayed if there is a single match (and faces are not used). +9th element is displayed when the current directory is non-readable." :type '(repeat string) :group 'ido) @@ -931,6 +932,9 @@ it doesn't interfere with other minibuffer usage.") ;; `ido-cur-list'. It is in no specific order. (defvar ido-ignored-list) +;; Remember if current directory is non-readable (so we cannot do completion). +(defvar ido-directory-nonreadable) + ;; Keep current item list if non-nil. (defvar ido-keep-item-list) @@ -1406,6 +1410,7 @@ This function also adds a hook to the minibuffer." (setq ido-current-directory dir) (if (get-buffer ido-completion-buffer) (kill-buffer ido-completion-buffer)) + (setq ido-directory-nonreadable (not (file-readable-p dir))) t)) (defun ido-set-current-home (&optional dir) @@ -1812,7 +1817,8 @@ PROMPT is the prompt to give to the user. DEFAULT if given is the default buffer to be selected, which will go to the front of the list. If REQUIRE-MATCH is non-nil, an existing-buffer must be selected. If INITIAL is non-nil, it specifies the initial input string." - (let ((ido-current-directory nil)) + (let ((ido-current-directory nil) + (ido-directory-nonreadable nil)) (ido-read-internal 'buffer prompt 'ido-buffer-history default require-match initial))) (defun ido-record-work-directory (&optional dir) @@ -1851,12 +1857,18 @@ If INITIAL is non-nil, it specifies the initial input string." (if (> (length ido-work-file-list) ido-max-work-file-list) (setcdr (nthcdr (1- ido-max-work-file-list) ido-work-file-list) nil)))) +(defun ido-expand-directory (dir) + ;; Expand DIR or use DEFAULT-DIRECTORY if nil. + ;; Add final slash to result in case it was missing from DEFAULT-DIRECTORY. + (ido-final-slash (expand-file-name (or dir default-directory)) t)) + (defun ido-file-internal (method &optional fallback default prompt item initial) ;; Internal function for ido-find-file and friends (unless item (setq item 'file)) - (let ((ido-current-directory (expand-file-name (or default default-directory))) - filename) + (let* ((ido-current-directory (ido-expand-directory default)) + (ido-directory-nonreadable (not (file-readable-p ido-current-directory))) + filename) (cond ((or (not ido-mode) (ido-is-slow-ftp-host)) @@ -2693,30 +2705,33 @@ for first matching file." (setq ido-temp-list items))) (defun ido-file-name-all-completions1 (dir) - (if (and ido-enable-tramp-completion - (string-match "\\`/\\([^/:]+:\\([^/:@]+@\\)?\\)\\'" dir)) - - ;; Trick tramp's file-name-all-completions handler to DTRT, as it - ;; has some pretty obscure requirements. This seems to work... - ;; /ftp: => (f-n-a-c "/ftp:" "") - ;; /ftp:kfs: => (f-n-a-c "" "/ftp:kfs:") - ;; /ftp:kfs@ => (f-n-a-c "ftp:kfs@" "/") - ;; /ftp:kfs@kfs: => (f-n-a-c "" "/ftp:kfs@kfs:") - ;; Currently no attempt is made to handle multi: stuff. - - (let* ((prefix (match-string 1 dir)) - (user-flag (match-beginning 2)) - (len (and prefix (length prefix))) - compl) - (if user-flag - (setq dir (substring dir 1))) - (require 'tramp nil t) - (ido-trace "tramp complete" dir) - (setq compl (file-name-all-completions dir (if user-flag "/" ""))) - (if (> len 0) - (mapcar (lambda (c) (substring c len)) compl) - compl)) - (file-name-all-completions "" dir))) + (cond + ((not (file-readable-p dir)) '()) + ((and ido-enable-tramp-completion + (string-match "\\`/\\([^/:]+:\\([^/:@]+@\\)?\\)\\'" dir)) + + ;; Trick tramp's file-name-all-completions handler to DTRT, as it + ;; has some pretty obscure requirements. This seems to work... + ;; /ftp: => (f-n-a-c "/ftp:" "") + ;; /ftp:kfs: => (f-n-a-c "" "/ftp:kfs:") + ;; /ftp:kfs@ => (f-n-a-c "ftp:kfs@" "/") + ;; /ftp:kfs@kfs: => (f-n-a-c "" "/ftp:kfs@kfs:") + ;; Currently no attempt is made to handle multi: stuff. + + (let* ((prefix (match-string 1 dir)) + (user-flag (match-beginning 2)) + (len (and prefix (length prefix))) + compl) + (if user-flag + (setq dir (substring dir 1))) + (require 'tramp nil t) + (ido-trace "tramp complete" dir) + (setq compl (file-name-all-completions dir (if user-flag "/" ""))) + (if (> len 0) + (mapcar (lambda (c) (substring c len)) compl) + compl))) + (t + (file-name-all-completions "" dir)))) (defun ido-file-name-all-completions (dir) ;; Return name of all files in DIR @@ -3518,6 +3533,11 @@ For details of keybindings, do `\\[describe-function] ido-find-file'." (expand-file-name "/" ido-current-directory) "/")) (setq refresh t)) + ((and ido-directory-nonreadable + (file-directory-p (concat ido-current-directory (file-name-directory contents)))) + (ido-set-current-directory + (concat ido-current-directory (file-name-directory contents))) + (setq refresh t)) (t (ido-trace "try single dir") (setq try-single-dir-match t)))) @@ -3574,6 +3594,7 @@ For details of keybindings, do `\\[describe-function] ido-find-file'." (exit-minibuffer)) (when (and (not ido-matches) + (not ido-directory-nonreadable) ;; ido-rescan ? ido-process-ignore-lists ido-ignored-list) @@ -3596,7 +3617,8 @@ For details of keybindings, do `\\[describe-function] ido-find-file'." (memq ido-cur-item '(file dir)) (not (ido-is-root-directory)) (> (length contents) 1) - (not (string-match "[$]" contents))) + (not (string-match "[$]" contents)) + (not ido-directory-nonreadable)) (ido-trace "merge?") (if ido-use-merged-list (ido-undo-merge-work-directory contents nil) @@ -3658,9 +3680,12 @@ For details of keybindings, do `\\[describe-function] ido-find-file'." (setq comps (cons first (cdr comps))))) (cond ((null comps) - (if ido-report-no-match - (nth 6 ido-decorations) ;; [No Match] - "")) + (cond + (ido-directory-nonreadable + (or (nth 8 ido-decorations) " [Not readable]")) + (ido-report-no-match + (nth 6 ido-decorations)) ;; [No match] + (t ""))) ((null (cdr comps)) ;one match (concat (if (> (length (ido-name (car comps))) (length name)) @@ -3771,13 +3796,14 @@ See `read-file-name' for additional parameters." (ido-read-directory-name prompt dir default-filename mustmatch initial)) ((and (not (memq this-command ido-read-file-name-non-ido)) (or (null predicate) (eq predicate 'file-exists-p))) - (let (filename - ido-saved-vc-hb - (vc-handled-backends (and (boundp 'vc-handled-backends) vc-handled-backends)) - (ido-current-directory (expand-file-name (or dir default-directory))) - (ido-work-directory-index -1) - (ido-work-file-index -1) - (ido-find-literal nil)) + (let* (filename + ido-saved-vc-hb + (vc-handled-backends (and (boundp 'vc-handled-backends) vc-handled-backends)) + (ido-current-directory (ido-expand-directory dir)) + (ido-directory-nonreadable (not (file-readable-p ido-current-directory))) + (ido-work-directory-index -1) + (ido-work-file-index -1) + (ido-find-literal nil)) (setq filename (ido-read-internal 'file prompt 'ido-file-history default-filename mustmatch initial)) (if filename @@ -3790,11 +3816,12 @@ See `read-file-name' for additional parameters." (defun ido-read-directory-name (prompt &optional dir default-dirname mustmatch initial) "Read directory name, prompting with PROMPT and completing in directory DIR. See `read-file-name' for additional parameters." - (let (filename - ido-saved-vc-hb - (ido-current-directory (expand-file-name (or dir default-directory))) - (ido-work-directory-index -1) - (ido-work-file-index -1)) + (let* (filename + ido-saved-vc-hb + (ido-current-directory (ido-expand-directory dir)) + (ido-directory-nonreadable (not (file-readable-p ido-current-directory))) + (ido-work-directory-index -1) + (ido-work-file-index -1)) (setq filename (ido-read-internal 'dir prompt 'ido-file-history default-dirname mustmatch initial)) (if filename diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index dd56c9c0f31..aae0f0f85c1 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -590,10 +590,11 @@ There should be no more than seven characters after the final `/'." (file-exists-p local-copy) (delete-file local-copy))) - (decode-coding-inserted-region - (point) (+ (point) size) - (jka-compr-byte-compiler-base-file-name file) - visit beg end replace) + (unless notfound + (decode-coding-inserted-region + (point) (+ (point) size) + (jka-compr-byte-compiler-base-file-name file) + visit beg end replace)) (and visit diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 7554bce0a3b..521729b764f 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -267,7 +267,7 @@ not contain `d', so that a full listing is expected." (let* ((dir (file-name-as-directory file)) (default-directory dir) ; so that file-attributes works (file-alist - (directory-files-and-attributes dir nil wildcard-regexp t)) + (directory-files-and-attributes dir nil wildcard-regexp t 'string)) (now (current-time)) (sum 0) ;; do all bindings here for speed @@ -329,7 +329,7 @@ not contain `d', so that a full listing is expected." ;; so must make it a relative filename as ls does: (if (eq (aref file (1- (length file))) ?/) (setq file (substring file 0 -1))) - (let ((fattr (file-attributes file))) + (let ((fattr (file-attributes file 'string))) (if fattr (insert (ls-lisp-format file fattr (nth 7 fattr) switches time-index (current-time))) @@ -522,23 +522,14 @@ SWITCHES, TIME-INDEX and NOW give the full switch list and time data." ;; They tend to be bogus on non-UNIX platforms anyway so ;; optionally hide them. (if (memq 'uid ls-lisp-verbosity) - ;; (user-login-name uid) works on Windows NT but not - ;; on 9x and maybe not on some other platforms, so... + ;; uid can be a sting or an integer (let ((uid (nth 2 file-attr))) - (if (= uid (user-uid)) - (format " %-8s" (user-login-name)) - (format " %-8d" uid)))) + (format (if (stringp uid) " %-8s" " %-8d") uid))) (if (not (memq ?G switches)) ; GNU ls -- shows group by default (if (or (memq ?g switches) ; UNIX ls -- no group by default (memq 'gid ls-lisp-verbosity)) - (if (memq system-type '(macos windows-nt ms-dos)) - ;; No useful concept of group... - " root" - (let* ((gid (nth 3 file-attr)) - (group (user-login-name gid))) - (if group - (format " %-8s" group) - (format " %-8d" gid)))))) + (let ((gid (nth 3 file-attr))) + (format (if (stringp gid) " %-8s" " %-8d") gid)))) (ls-lisp-format-file-size file-size (memq ?h switches)) " " (ls-lisp-format-time file-attr time-index now) diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el index fb44acbff4f..17b0affac92 100644 --- a/lisp/textmodes/texnfo-upd.el +++ b/lisp/textmodes/texnfo-upd.el @@ -1,6 +1,6 @@ ;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files -;; Copyright (C) 1989, 1990, 1991, 1992, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1989, 1990, 1991, 1992, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Robert J. Chassell ;; Maintainer: bug-texinfo@gnu.org @@ -1795,25 +1795,34 @@ Thus, normally, each included file contains one, and only one, chapter." ;; description slot of a menu as a description. (let ((case-fold-search t) - menu-list next-node-name previous-node-name) + menu-list next-node-name previous-node-name files-with-node-lines) - ;; Find the name of the first node of the first included file. - (set-buffer (find-file-noselect (car (cdr files)))) + ;; Create a new list of included files that only have node lines + (while files + (set-buffer (find-file-noselect (car files))) + (widen) + (goto-char (point-min)) + (when (re-search-forward "^@node" nil t) + (setq files-with-node-lines (cons (car files) files-with-node-lines))) + (setq files (cdr files))) + (setq files-with-node-lines (nreverse files-with-node-lines)) + + ;; Find the name of the first node in a subsequent file + ;; and copy it into the variable next-node-name + (set-buffer (find-file-noselect (car (cdr files-with-node-lines)))) (widen) (goto-char (point-min)) - (if (not (re-search-forward "^@node" nil t)) - (error "No `@node' line found in %s" (buffer-name))) (beginning-of-line) (texinfo-check-for-node-name) (setq next-node-name (texinfo-copy-node-name)) - (push (cons next-node-name (prog1 "" (forward-line 1))) ;; Use following to insert section titles automatically. ;; (texinfo-copy-next-section-title) menu-list) ;; Go to outer file - (set-buffer (find-file-noselect (pop files))) + ;; `pop' is analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))) + (set-buffer (find-file-noselect (pop files-with-node-lines))) (goto-char (point-min)) (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t)) (error "This buffer needs a Top node")) @@ -1824,18 +1833,16 @@ Thus, normally, each included file contains one, and only one, chapter." (beginning-of-line) (setq previous-node-name "Top") - (while files + (while files-with-node-lines - (if (not (cdr files)) + (if (not (cdr files-with-node-lines)) ;; No next file (setq next-node-name "") ;; Else, ;; find the name of the first node in the next file. - (set-buffer (find-file-noselect (car (cdr files)))) + (set-buffer (find-file-noselect (car (cdr files-with-node-lines)))) (widen) (goto-char (point-min)) - (if (not (re-search-forward "^@node" nil t)) - (error "No `@node' line found in %s" (buffer-name))) (beginning-of-line) (texinfo-check-for-node-name) (setq next-node-name (texinfo-copy-node-name)) @@ -1845,10 +1852,8 @@ Thus, normally, each included file contains one, and only one, chapter." menu-list)) ;; Go to node to be updated. - (set-buffer (find-file-noselect (car files))) + (set-buffer (find-file-noselect (car files-with-node-lines))) (goto-char (point-min)) - (if (not (re-search-forward "^@node" nil t)) - (error "No `@node' line found in %s" (buffer-name))) (beginning-of-line) ;; Update other menus and nodes if requested. @@ -1862,7 +1867,7 @@ Thus, normally, each included file contains one, and only one, chapter." (beginning-of-line) (setq previous-node-name (texinfo-copy-node-name)) - (setq files (cdr files))) + (setq files-with-node-lines (cdr files-with-node-lines))) (nreverse menu-list))) (defun texinfo-multi-files-insert-main-menu (menu-list) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 4c70334e908..63a254d1d67 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1267,6 +1267,42 @@ Optional EVENT is the event that triggered the action." found (widget-apply child :validate))) found)) +(defun widget-child-value-get (widget) + "Get the value of the first member of :children in WIDGET." + (widget-value (car (widget-get widget :children)))) + +(defun widget-child-value-inline (widget) + "Get the inline value of the first member of :children in WIDGET." + (widget-apply (car (widget-get widget :children)) :value-inline)) + +(defun widget-child-validate (widget) + "The result of validating the first member of :children in WIDGET." + (widget-apply (car (widget-get widget :children)) :validate)) + +(defun widget-type-value-create (widget) + "Convert and instantiate the value of the :type attribute of WIDGET. +Store the newly created widget in the :children attribute. + +The value of the :type attribute should be an unconverted widget type." + (let ((value (widget-get widget :value)) + (type (widget-get widget :type))) + (widget-put widget :children + (list (widget-create-child-value widget + (widget-convert type) + value))))) + +(defun widget-type-default-get (widget) + "Get default value from the :type attribute of WIDGET. + +The value of the :type attribute should be an unconverted widget type." + (widget-default-get (widget-convert (widget-get widget :type)))) + +(defun widget-type-match (widget value) + "Non-nil if the :type value of WIDGET matches VALUE. + +The value of the :type attribute should be an unconverted widget type." + (widget-apply (widget-convert (widget-get widget :type)) :match value)) + (defun widget-types-copy (widget) "Copy :args as widget types in WIDGET." (widget-put widget :args (mapcar 'widget-copy (widget-get widget :args))) @@ -1862,9 +1898,8 @@ the earlier input." :tag "choice" :void '(item :format "invalid (%t)\n") :value-create 'widget-choice-value-create - :value-delete 'widget-children-value-delete - :value-get 'widget-choice-value-get - :value-inline 'widget-choice-value-inline + :value-get 'widget-child-value-get + :value-inline 'widget-child-value-inline :default-get 'widget-choice-default-get :mouse-down-action 'widget-choice-mouse-down-action :action 'widget-choice-action @@ -1901,14 +1936,6 @@ the earlier input." widget void :value value))) (widget-put widget :choice void)))))) -(defun widget-choice-value-get (widget) - ;; Get value of the child widget. - (widget-value (car (widget-get widget :children)))) - -(defun widget-choice-value-inline (widget) - ;; Get value of the child widget. - (widget-apply (car (widget-get widget :children)) :value-inline)) - (defun widget-choice-default-get (widget) ;; Get default for the first choice. (widget-default-get (car (widget-get widget :args)))) @@ -2099,7 +2126,6 @@ when he invoked the menu." :entry-format "%b %v" :greedy nil :value-create 'widget-checklist-value-create - :value-delete 'widget-children-value-delete :value-get 'widget-checklist-value-get :validate 'widget-checklist-validate :match 'widget-checklist-match @@ -2276,7 +2302,6 @@ Return an alist of (TYPE MATCH)." :format "%v" :entry-format "%b %v" :value-create 'widget-radio-value-create - :value-delete 'widget-children-value-delete :value-get 'widget-radio-value-get :value-inline 'widget-radio-value-inline :value-set 'widget-radio-value-set @@ -2466,7 +2491,6 @@ Return an alist of (TYPE MATCH)." :format-handler 'widget-editable-list-format-handler :entry-format "%i %d %v" :value-create 'widget-editable-list-value-create - :value-delete 'widget-children-value-delete :value-get 'widget-editable-list-value-get :validate 'widget-children-validate :match 'widget-editable-list-match @@ -2637,7 +2661,6 @@ Return an alist of (TYPE MATCH)." :copy 'widget-types-copy :format "%v" :value-create 'widget-group-value-create - :value-delete 'widget-children-value-delete :value-get 'widget-editable-list-value-get :default-get 'widget-group-default-get :validate 'widget-children-validate @@ -2803,7 +2826,6 @@ link for that string." "A documentation string." :format "%v" :action 'widget-documentation-string-action - :value-delete 'widget-children-value-delete :value-create 'widget-documentation-string-value-create) (defun widget-documentation-string-value-create (widget) @@ -3250,6 +3272,62 @@ To use this type, you must define :match or :match-alternatives." (widget-group-match widget (widget-apply widget :value-to-internal value)))) +;;; The `lazy' Widget. +;; +;; Recursive datatypes. + +(define-widget 'lazy 'default + "Base widget for recursive datastructures. + +The `lazy' widget will, when instantiated, contain a single inferior +widget, of the widget type specified by the :type parameter. The +value of the `lazy' widget is the same as the value of the inferior +widget. When deriving a new widget from the 'lazy' widget, the :type +parameter is allowed to refer to the widget currently being defined, +thus allowing recursive datastructures to be described. + +The :type parameter takes the same arguments as the defcustom +parameter with the same name. + +Most composite widgets, i.e. widgets containing other widgets, does +not allow recursion. That is, when you define a new widget type, none +of the inferior widgets may be of the same type you are currently +defining. + +In Lisp, however, it is custom to define datastructures in terms of +themselves. A list, for example, is defined as either nil, or a cons +cell whose cdr itself is a list. The obvious way to translate this +into a widget type would be + + (define-widget 'my-list 'choice + \"A list of sexps.\" + :tag \"Sexp list\" + :args '((const nil) (cons :value (nil) sexp my-list))) + +Here we attempt to define my-list as a choice of either the constant +nil, or a cons-cell containing a sexp and my-lisp. This will not work +because the `choice' widget does not allow recursion. + +Using the `lazy' widget you can overcome this problem, as in this +example: + + (define-widget 'sexp-list 'lazy + \"A list of sexps.\" + :tag \"Sexp list\" + :type '(choice (const nil) (cons :value (nil) sexp sexp-list)))" + :format "%{%t%}: %v" + ;; We don't convert :type because we want to allow recursive + ;; datastructures. This is slow, so we should not create speed + ;; critical widgets by deriving from this. + :convert-widget 'widget-value-convert-widget + :value-create 'widget-type-value-create + :value-get 'widget-child-value-get + :value-inline 'widget-child-value-inline + :default-get 'widget-type-default-get + :match 'widget-type-match + :validate 'widget-child-validate) + + ;;; The `plist' Widget. ;; ;; Property lists. |