aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog48
-rw-r--r--lisp/cus-edit.el3
-rw-r--r--lisp/ffap.el2
-rw-r--r--lisp/ido.el119
-rw-r--r--lisp/jka-compr.el9
-rw-r--r--lisp/ls-lisp.el21
-rw-r--r--lisp/textmodes/texnfo-upd.el39
-rw-r--r--lisp/wid-edit.el110
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 @@
12003-12-27 Kim F. Storm <storm@cua.dk>
2
3 * ido.el: Handle non-readable directories.
4 (ido-decorations): Add 9th element for non-readable directory.
5 (ido-directory-nonreadable): New dynamic var.
6 (ido-set-current-directory): Set it.
7 (ido-read-buffer, ido-file-internal):
8 (ido-read-file-name, ido-read-directory-name): Let-bind it.
9 (ido-file-name-all-completions1): Return empty list for
10 non-readable directory.
11 (ido-exhibit): Print [Not readable] if directory is not readable.
12 (ido-expand-directory): New defun (based on tiny fix from Karl Chen).
13 (ido-read-file-name, ido-file-internal, ido-read-directory-name):
14 Use it.
15
162003-12-27 Lars Hansen <larsh@math.ku.dk>
17
18 * ls-lisp.el (ls-lisp-insert-directory): Add parameter 'string in
19 calls to directory-files-and-attributes and file-attributes.
20 (ls-lisp-format): Remove system dependent handling of user and
21 group id's.
22
232003-12-25 Luc Teirlinck <teirllm@auburn.edu>
24
25 * ffap.el (ffap-read-file-or-url): Revert previous change.
26
272003-12-25 Andreas Schwab <schwab@suse.de>
28
29 * jka-compr.el (jka-compr-insert-file-contents): Avoid error when
30 file not found.
31
12003-12-08 Miles Bader <miles@gnu.org> 322003-12-08 Miles Bader <miles@gnu.org>
2 33
3 * dired.el (dired-between-files): Always use dired-move-to-filename, 34 * dired.el (dired-between-files): Always use dired-move-to-filename,
@@ -67,6 +98,23 @@
67 * info.el (Info-unescape-quotes, Info-split-parameter-string) 98 * info.el (Info-unescape-quotes, Info-split-parameter-string)
68 (Info-goto-emacs-command-node): Doc fixes. 99 (Info-goto-emacs-command-node): Doc fixes.
69 100
1012003-12-12 Jesper Harder <harder@ifa.au.dk>
102
103 * cus-edit.el (custom-add-parent-links): Define "many".
104
1052003-12-08 Per Abrahamsen <abraham@dina.kvl.dk>
106
107 * wid-edit.el (widget-child-value-get, widget-child-value-inline)
108 (widget-child-validate, widget-type-value-create)
109 (widget-type-default-get, widget-type-match): New functions.
110 (lazy): New widget.
111 (menu-choice, checklist, radio-button-choice, editable-list)
112 (group, documentation-string): Removed redundant (per 2003-10-25
113 change) calls to `widget-children-value-delete'.
114 (widget-choice-value-get, widget-choice-value-inline): Removed
115 functions.
116 (menu-choice): Updated widget.
117
702003-12-03 Kenichi Handa <handa@m17n.org> 1182003-12-03 Kenichi Handa <handa@m17n.org>
71 119
72 * language/cyrillic.el: Register "microsoft-cp1251" in 120 * 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:\"."
1970 (setq parents (cons symbol parents)))))) 1970 (setq parents (cons symbol parents))))))
1971 (and (null (get symbol 'custom-links)) ;No links of its own. 1971 (and (null (get symbol 'custom-links)) ;No links of its own.
1972 (= (length parents) 1) ;A single parent. 1972 (= (length parents) 1) ;A single parent.
1973 (let ((links (get (car parents) 'custom-links))) 1973 (let* ((links (get (car parents) 'custom-links))
1974 (many (> (length links) 2)))
1974 (when links 1975 (when links
1975 (insert "\nParent documentation: ") 1976 (insert "\nParent documentation: ")
1976 (while links 1977 (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."
1216 'ffap-read-file-or-url-internal 1216 'ffap-read-file-or-url-internal
1217 dir 1217 dir
1218 nil 1218 nil
1219 (if dir (cons guess (1+ (length dir))) guess) 1219 (if dir (cons guess (length dir)) guess)
1220 (list 'file-name-history)))) 1220 (list 'file-name-history))))
1221 ;; Do file substitution like (interactive "F"), suggested by MCOOK. 1221 ;; Do file substitution like (interactive "F"), suggested by MCOOK.
1222 (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess))) 1222 (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."
685 :type '(choice string (const nil)) 685 :type '(choice string (const nil))
686 :group 'ido) 686 :group 'ido)
687 687
688(defcustom ido-decorations '( "{" "}" " | " " | ..." "[" "]" " [No match]" " [Matched]") 688(defcustom ido-decorations '( "{" "}" " | " " | ..." "[" "]" " [No match]" " [Matched]" " [Not readable]")
689 "*List of strings used by ido to display the alternatives in the minibuffer. 689 "*List of strings used by ido to display the alternatives in the minibuffer.
690There are 8 elements in this list, each is a pair of strings: 690There are 9 elements in this list:
6911st and 2nd elements are used as brackets around the prospect list, 6911st and 2nd elements are used as brackets around the prospect list,
6923rd element is the separator between prospects (ignored if ido-separator is set), 6923rd element is the separator between prospects (ignored if ido-separator is set),
6934th element is the string inserted at the end of a truncated list of prospects, 6934th element is the string inserted at the end of a truncated list of prospects,
6945th and 6th elements are used as brackets around the common match string which 6945th and 6th elements are used as brackets around the common match string which
695can be completed using TAB, 695can be completed using TAB,
6967th element is the string displayed when there are a no matches, and 6967th element is the string displayed when there are a no matches, and
6978th element displayed if there is a single match (and faces are not used)." 6978th element is displayed if there is a single match (and faces are not used).
6989th element is displayed when the current directory is non-readable."
698 :type '(repeat string) 699 :type '(repeat string)
699 :group 'ido) 700 :group 'ido)
700 701
@@ -931,6 +932,9 @@ it doesn't interfere with other minibuffer usage.")
931;; `ido-cur-list'. It is in no specific order. 932;; `ido-cur-list'. It is in no specific order.
932(defvar ido-ignored-list) 933(defvar ido-ignored-list)
933 934
935;; Remember if current directory is non-readable (so we cannot do completion).
936(defvar ido-directory-nonreadable)
937
934;; Keep current item list if non-nil. 938;; Keep current item list if non-nil.
935(defvar ido-keep-item-list) 939(defvar ido-keep-item-list)
936 940
@@ -1406,6 +1410,7 @@ This function also adds a hook to the minibuffer."
1406 (setq ido-current-directory dir) 1410 (setq ido-current-directory dir)
1407 (if (get-buffer ido-completion-buffer) 1411 (if (get-buffer ido-completion-buffer)
1408 (kill-buffer ido-completion-buffer)) 1412 (kill-buffer ido-completion-buffer))
1413 (setq ido-directory-nonreadable (not (file-readable-p dir)))
1409 t)) 1414 t))
1410 1415
1411(defun ido-set-current-home (&optional dir) 1416(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
1812buffer to be selected, which will go to the front of the list. 1817buffer to be selected, which will go to the front of the list.
1813If REQUIRE-MATCH is non-nil, an existing-buffer must be selected. 1818If REQUIRE-MATCH is non-nil, an existing-buffer must be selected.
1814If INITIAL is non-nil, it specifies the initial input string." 1819If INITIAL is non-nil, it specifies the initial input string."
1815 (let ((ido-current-directory nil)) 1820 (let ((ido-current-directory nil)
1821 (ido-directory-nonreadable nil))
1816 (ido-read-internal 'buffer prompt 'ido-buffer-history default require-match initial))) 1822 (ido-read-internal 'buffer prompt 'ido-buffer-history default require-match initial)))
1817 1823
1818(defun ido-record-work-directory (&optional dir) 1824(defun ido-record-work-directory (&optional dir)
@@ -1851,12 +1857,18 @@ If INITIAL is non-nil, it specifies the initial input string."
1851 (if (> (length ido-work-file-list) ido-max-work-file-list) 1857 (if (> (length ido-work-file-list) ido-max-work-file-list)
1852 (setcdr (nthcdr (1- ido-max-work-file-list) ido-work-file-list) nil)))) 1858 (setcdr (nthcdr (1- ido-max-work-file-list) ido-work-file-list) nil))))
1853 1859
1860(defun ido-expand-directory (dir)
1861 ;; Expand DIR or use DEFAULT-DIRECTORY if nil.
1862 ;; Add final slash to result in case it was missing from DEFAULT-DIRECTORY.
1863 (ido-final-slash (expand-file-name (or dir default-directory)) t))
1864
1854(defun ido-file-internal (method &optional fallback default prompt item initial) 1865(defun ido-file-internal (method &optional fallback default prompt item initial)
1855 ;; Internal function for ido-find-file and friends 1866 ;; Internal function for ido-find-file and friends
1856 (unless item 1867 (unless item
1857 (setq item 'file)) 1868 (setq item 'file))
1858 (let ((ido-current-directory (expand-file-name (or default default-directory))) 1869 (let* ((ido-current-directory (ido-expand-directory default))
1859 filename) 1870 (ido-directory-nonreadable (not (file-readable-p ido-current-directory)))
1871 filename)
1860 1872
1861 (cond 1873 (cond
1862 ((or (not ido-mode) (ido-is-slow-ftp-host)) 1874 ((or (not ido-mode) (ido-is-slow-ftp-host))
@@ -2693,30 +2705,33 @@ for first matching file."
2693 (setq ido-temp-list items))) 2705 (setq ido-temp-list items)))
2694 2706
2695(defun ido-file-name-all-completions1 (dir) 2707(defun ido-file-name-all-completions1 (dir)
2696 (if (and ido-enable-tramp-completion 2708 (cond
2697 (string-match "\\`/\\([^/:]+:\\([^/:@]+@\\)?\\)\\'" dir)) 2709 ((not (file-readable-p dir)) '())
2698 2710 ((and ido-enable-tramp-completion
2699 ;; Trick tramp's file-name-all-completions handler to DTRT, as it 2711 (string-match "\\`/\\([^/:]+:\\([^/:@]+@\\)?\\)\\'" dir))
2700 ;; has some pretty obscure requirements. This seems to work... 2712
2701 ;; /ftp: => (f-n-a-c "/ftp:" "") 2713 ;; Trick tramp's file-name-all-completions handler to DTRT, as it
2702 ;; /ftp:kfs: => (f-n-a-c "" "/ftp:kfs:") 2714 ;; has some pretty obscure requirements. This seems to work...
2703 ;; /ftp:kfs@ => (f-n-a-c "ftp:kfs@" "/") 2715 ;; /ftp: => (f-n-a-c "/ftp:" "")
2704 ;; /ftp:kfs@kfs: => (f-n-a-c "" "/ftp:kfs@kfs:") 2716 ;; /ftp:kfs: => (f-n-a-c "" "/ftp:kfs:")
2705 ;; Currently no attempt is made to handle multi: stuff. 2717 ;; /ftp:kfs@ => (f-n-a-c "ftp:kfs@" "/")
2706 2718 ;; /ftp:kfs@kfs: => (f-n-a-c "" "/ftp:kfs@kfs:")
2707 (let* ((prefix (match-string 1 dir)) 2719 ;; Currently no attempt is made to handle multi: stuff.
2708 (user-flag (match-beginning 2)) 2720
2709 (len (and prefix (length prefix))) 2721 (let* ((prefix (match-string 1 dir))
2710 compl) 2722 (user-flag (match-beginning 2))
2711 (if user-flag 2723 (len (and prefix (length prefix)))
2712 (setq dir (substring dir 1))) 2724 compl)
2713 (require 'tramp nil t) 2725 (if user-flag
2714 (ido-trace "tramp complete" dir) 2726 (setq dir (substring dir 1)))
2715 (setq compl (file-name-all-completions dir (if user-flag "/" ""))) 2727 (require 'tramp nil t)
2716 (if (> len 0) 2728 (ido-trace "tramp complete" dir)
2717 (mapcar (lambda (c) (substring c len)) compl) 2729 (setq compl (file-name-all-completions dir (if user-flag "/" "")))
2718 compl)) 2730 (if (> len 0)
2719 (file-name-all-completions "" dir))) 2731 (mapcar (lambda (c) (substring c len)) compl)
2732 compl)))
2733 (t
2734 (file-name-all-completions "" dir))))
2720 2735
2721(defun ido-file-name-all-completions (dir) 2736(defun ido-file-name-all-completions (dir)
2722 ;; Return name of all files in DIR 2737 ;; Return name of all files in DIR
@@ -3518,6 +3533,11 @@ For details of keybindings, do `\\[describe-function] ido-find-file'."
3518 (expand-file-name "/" ido-current-directory) 3533 (expand-file-name "/" ido-current-directory)
3519 "/")) 3534 "/"))
3520 (setq refresh t)) 3535 (setq refresh t))
3536 ((and ido-directory-nonreadable
3537 (file-directory-p (concat ido-current-directory (file-name-directory contents))))
3538 (ido-set-current-directory
3539 (concat ido-current-directory (file-name-directory contents)))
3540 (setq refresh t))
3521 (t 3541 (t
3522 (ido-trace "try single dir") 3542 (ido-trace "try single dir")
3523 (setq try-single-dir-match t)))) 3543 (setq try-single-dir-match t))))
@@ -3574,6 +3594,7 @@ For details of keybindings, do `\\[describe-function] ido-find-file'."
3574 (exit-minibuffer)) 3594 (exit-minibuffer))
3575 3595
3576 (when (and (not ido-matches) 3596 (when (and (not ido-matches)
3597 (not ido-directory-nonreadable)
3577 ;; ido-rescan ? 3598 ;; ido-rescan ?
3578 ido-process-ignore-lists 3599 ido-process-ignore-lists
3579 ido-ignored-list) 3600 ido-ignored-list)
@@ -3596,7 +3617,8 @@ For details of keybindings, do `\\[describe-function] ido-find-file'."
3596 (memq ido-cur-item '(file dir)) 3617 (memq ido-cur-item '(file dir))
3597 (not (ido-is-root-directory)) 3618 (not (ido-is-root-directory))
3598 (> (length contents) 1) 3619 (> (length contents) 1)
3599 (not (string-match "[$]" contents))) 3620 (not (string-match "[$]" contents))
3621 (not ido-directory-nonreadable))
3600 (ido-trace "merge?") 3622 (ido-trace "merge?")
3601 (if ido-use-merged-list 3623 (if ido-use-merged-list
3602 (ido-undo-merge-work-directory contents nil) 3624 (ido-undo-merge-work-directory contents nil)
@@ -3658,9 +3680,12 @@ For details of keybindings, do `\\[describe-function] ido-find-file'."
3658 (setq comps (cons first (cdr comps))))) 3680 (setq comps (cons first (cdr comps)))))
3659 3681
3660 (cond ((null comps) 3682 (cond ((null comps)
3661 (if ido-report-no-match 3683 (cond
3662 (nth 6 ido-decorations) ;; [No Match] 3684 (ido-directory-nonreadable
3663 "")) 3685 (or (nth 8 ido-decorations) " [Not readable]"))
3686 (ido-report-no-match
3687 (nth 6 ido-decorations)) ;; [No match]
3688 (t "")))
3664 3689
3665 ((null (cdr comps)) ;one match 3690 ((null (cdr comps)) ;one match
3666 (concat (if (> (length (ido-name (car comps))) (length name)) 3691 (concat (if (> (length (ido-name (car comps))) (length name))
@@ -3771,13 +3796,14 @@ See `read-file-name' for additional parameters."
3771 (ido-read-directory-name prompt dir default-filename mustmatch initial)) 3796 (ido-read-directory-name prompt dir default-filename mustmatch initial))
3772 ((and (not (memq this-command ido-read-file-name-non-ido)) 3797 ((and (not (memq this-command ido-read-file-name-non-ido))
3773 (or (null predicate) (eq predicate 'file-exists-p))) 3798 (or (null predicate) (eq predicate 'file-exists-p)))
3774 (let (filename 3799 (let* (filename
3775 ido-saved-vc-hb 3800 ido-saved-vc-hb
3776 (vc-handled-backends (and (boundp 'vc-handled-backends) vc-handled-backends)) 3801 (vc-handled-backends (and (boundp 'vc-handled-backends) vc-handled-backends))
3777 (ido-current-directory (expand-file-name (or dir default-directory))) 3802 (ido-current-directory (ido-expand-directory dir))
3778 (ido-work-directory-index -1) 3803 (ido-directory-nonreadable (not (file-readable-p ido-current-directory)))
3779 (ido-work-file-index -1) 3804 (ido-work-directory-index -1)
3780 (ido-find-literal nil)) 3805 (ido-work-file-index -1)
3806 (ido-find-literal nil))
3781 (setq filename 3807 (setq filename
3782 (ido-read-internal 'file prompt 'ido-file-history default-filename mustmatch initial)) 3808 (ido-read-internal 'file prompt 'ido-file-history default-filename mustmatch initial))
3783 (if filename 3809 (if filename
@@ -3790,11 +3816,12 @@ See `read-file-name' for additional parameters."
3790(defun ido-read-directory-name (prompt &optional dir default-dirname mustmatch initial) 3816(defun ido-read-directory-name (prompt &optional dir default-dirname mustmatch initial)
3791 "Read directory name, prompting with PROMPT and completing in directory DIR. 3817 "Read directory name, prompting with PROMPT and completing in directory DIR.
3792See `read-file-name' for additional parameters." 3818See `read-file-name' for additional parameters."
3793 (let (filename 3819 (let* (filename
3794 ido-saved-vc-hb 3820 ido-saved-vc-hb
3795 (ido-current-directory (expand-file-name (or dir default-directory))) 3821 (ido-current-directory (ido-expand-directory dir))
3796 (ido-work-directory-index -1) 3822 (ido-directory-nonreadable (not (file-readable-p ido-current-directory)))
3797 (ido-work-file-index -1)) 3823 (ido-work-directory-index -1)
3824 (ido-work-file-index -1))
3798 (setq filename 3825 (setq filename
3799 (ido-read-internal 'dir prompt 'ido-file-history default-dirname mustmatch initial)) 3826 (ido-read-internal 'dir prompt 'ido-file-history default-dirname mustmatch initial))
3800 (if filename 3827 (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 `/'."
590 (file-exists-p local-copy) 590 (file-exists-p local-copy)
591 (delete-file local-copy))) 591 (delete-file local-copy)))
592 592
593 (decode-coding-inserted-region 593 (unless notfound
594 (point) (+ (point) size) 594 (decode-coding-inserted-region
595 (jka-compr-byte-compiler-base-file-name file) 595 (point) (+ (point) size)
596 visit beg end replace) 596 (jka-compr-byte-compiler-base-file-name file)
597 visit beg end replace))
597 598
598 (and 599 (and
599 visit 600 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."
267 (let* ((dir (file-name-as-directory file)) 267 (let* ((dir (file-name-as-directory file))
268 (default-directory dir) ; so that file-attributes works 268 (default-directory dir) ; so that file-attributes works
269 (file-alist 269 (file-alist
270 (directory-files-and-attributes dir nil wildcard-regexp t)) 270 (directory-files-and-attributes dir nil wildcard-regexp t 'string))
271 (now (current-time)) 271 (now (current-time))
272 (sum 0) 272 (sum 0)
273 ;; do all bindings here for speed 273 ;; do all bindings here for speed
@@ -329,7 +329,7 @@ not contain `d', so that a full listing is expected."
329 ;; so must make it a relative filename as ls does: 329 ;; so must make it a relative filename as ls does:
330 (if (eq (aref file (1- (length file))) ?/) 330 (if (eq (aref file (1- (length file))) ?/)
331 (setq file (substring file 0 -1))) 331 (setq file (substring file 0 -1)))
332 (let ((fattr (file-attributes file))) 332 (let ((fattr (file-attributes file 'string)))
333 (if fattr 333 (if fattr
334 (insert (ls-lisp-format file fattr (nth 7 fattr) 334 (insert (ls-lisp-format file fattr (nth 7 fattr)
335 switches time-index (current-time))) 335 switches time-index (current-time)))
@@ -522,23 +522,14 @@ SWITCHES, TIME-INDEX and NOW give the full switch list and time data."
522 ;; They tend to be bogus on non-UNIX platforms anyway so 522 ;; They tend to be bogus on non-UNIX platforms anyway so
523 ;; optionally hide them. 523 ;; optionally hide them.
524 (if (memq 'uid ls-lisp-verbosity) 524 (if (memq 'uid ls-lisp-verbosity)
525 ;; (user-login-name uid) works on Windows NT but not 525 ;; uid can be a sting or an integer
526 ;; on 9x and maybe not on some other platforms, so...
527 (let ((uid (nth 2 file-attr))) 526 (let ((uid (nth 2 file-attr)))
528 (if (= uid (user-uid)) 527 (format (if (stringp uid) " %-8s" " %-8d") uid)))
529 (format " %-8s" (user-login-name))
530 (format " %-8d" uid))))
531 (if (not (memq ?G switches)) ; GNU ls -- shows group by default 528 (if (not (memq ?G switches)) ; GNU ls -- shows group by default
532 (if (or (memq ?g switches) ; UNIX ls -- no group by default 529 (if (or (memq ?g switches) ; UNIX ls -- no group by default
533 (memq 'gid ls-lisp-verbosity)) 530 (memq 'gid ls-lisp-verbosity))
534 (if (memq system-type '(macos windows-nt ms-dos)) 531 (let ((gid (nth 3 file-attr)))
535 ;; No useful concept of group... 532 (format (if (stringp gid) " %-8s" " %-8d") gid))))
536 " root"
537 (let* ((gid (nth 3 file-attr))
538 (group (user-login-name gid)))
539 (if group
540 (format " %-8s" group)
541 (format " %-8d" gid))))))
542 (ls-lisp-format-file-size file-size (memq ?h switches)) 533 (ls-lisp-format-file-size file-size (memq ?h switches))
543 " " 534 " "
544 (ls-lisp-format-time file-attr time-index now) 535 (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 @@
1;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files 1;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files
2 2
3;; Copyright (C) 1989, 1990, 1991, 1992, 2001, 2002 Free Software Foundation, Inc. 3;; Copyright (C) 1989, 1990, 1991, 1992, 2001, 2002, 2003 Free Software Foundation, Inc.
4 4
5;; Author: Robert J. Chassell 5;; Author: Robert J. Chassell
6;; Maintainer: bug-texinfo@gnu.org 6;; Maintainer: bug-texinfo@gnu.org
@@ -1795,25 +1795,34 @@ Thus, normally, each included file contains one, and only one, chapter."
1795;; description slot of a menu as a description. 1795;; description slot of a menu as a description.
1796 1796
1797 (let ((case-fold-search t) 1797 (let ((case-fold-search t)
1798 menu-list next-node-name previous-node-name) 1798 menu-list next-node-name previous-node-name files-with-node-lines)
1799 1799
1800 ;; Find the name of the first node of the first included file. 1800 ;; Create a new list of included files that only have node lines
1801 (set-buffer (find-file-noselect (car (cdr files)))) 1801 (while files
1802 (set-buffer (find-file-noselect (car files)))
1803 (widen)
1804 (goto-char (point-min))
1805 (when (re-search-forward "^@node" nil t)
1806 (setq files-with-node-lines (cons (car files) files-with-node-lines)))
1807 (setq files (cdr files)))
1808 (setq files-with-node-lines (nreverse files-with-node-lines))
1809
1810 ;; Find the name of the first node in a subsequent file
1811 ;; and copy it into the variable next-node-name
1812 (set-buffer (find-file-noselect (car (cdr files-with-node-lines))))
1802 (widen) 1813 (widen)
1803 (goto-char (point-min)) 1814 (goto-char (point-min))
1804 (if (not (re-search-forward "^@node" nil t))
1805 (error "No `@node' line found in %s" (buffer-name)))
1806 (beginning-of-line) 1815 (beginning-of-line)
1807 (texinfo-check-for-node-name) 1816 (texinfo-check-for-node-name)
1808 (setq next-node-name (texinfo-copy-node-name)) 1817 (setq next-node-name (texinfo-copy-node-name))
1809
1810 (push (cons next-node-name (prog1 "" (forward-line 1))) 1818 (push (cons next-node-name (prog1 "" (forward-line 1)))
1811 ;; Use following to insert section titles automatically. 1819 ;; Use following to insert section titles automatically.
1812 ;; (texinfo-copy-next-section-title) 1820 ;; (texinfo-copy-next-section-title)
1813 menu-list) 1821 menu-list)
1814 1822
1815 ;; Go to outer file 1823 ;; Go to outer file
1816 (set-buffer (find-file-noselect (pop files))) 1824 ;; `pop' is analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE)))
1825 (set-buffer (find-file-noselect (pop files-with-node-lines)))
1817 (goto-char (point-min)) 1826 (goto-char (point-min))
1818 (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t)) 1827 (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t))
1819 (error "This buffer needs a Top node")) 1828 (error "This buffer needs a Top node"))
@@ -1824,18 +1833,16 @@ Thus, normally, each included file contains one, and only one, chapter."
1824 (beginning-of-line) 1833 (beginning-of-line)
1825 (setq previous-node-name "Top") 1834 (setq previous-node-name "Top")
1826 1835
1827 (while files 1836 (while files-with-node-lines
1828 1837
1829 (if (not (cdr files)) 1838 (if (not (cdr files-with-node-lines))
1830 ;; No next file 1839 ;; No next file
1831 (setq next-node-name "") 1840 (setq next-node-name "")
1832 ;; Else, 1841 ;; Else,
1833 ;; find the name of the first node in the next file. 1842 ;; find the name of the first node in the next file.
1834 (set-buffer (find-file-noselect (car (cdr files)))) 1843 (set-buffer (find-file-noselect (car (cdr files-with-node-lines))))
1835 (widen) 1844 (widen)
1836 (goto-char (point-min)) 1845 (goto-char (point-min))
1837 (if (not (re-search-forward "^@node" nil t))
1838 (error "No `@node' line found in %s" (buffer-name)))
1839 (beginning-of-line) 1846 (beginning-of-line)
1840 (texinfo-check-for-node-name) 1847 (texinfo-check-for-node-name)
1841 (setq next-node-name (texinfo-copy-node-name)) 1848 (setq next-node-name (texinfo-copy-node-name))
@@ -1845,10 +1852,8 @@ Thus, normally, each included file contains one, and only one, chapter."
1845 menu-list)) 1852 menu-list))
1846 1853
1847 ;; Go to node to be updated. 1854 ;; Go to node to be updated.
1848 (set-buffer (find-file-noselect (car files))) 1855 (set-buffer (find-file-noselect (car files-with-node-lines)))
1849 (goto-char (point-min)) 1856 (goto-char (point-min))
1850 (if (not (re-search-forward "^@node" nil t))
1851 (error "No `@node' line found in %s" (buffer-name)))
1852 (beginning-of-line) 1857 (beginning-of-line)
1853 1858
1854 ;; Update other menus and nodes if requested. 1859 ;; Update other menus and nodes if requested.
@@ -1862,7 +1867,7 @@ Thus, normally, each included file contains one, and only one, chapter."
1862 (beginning-of-line) 1867 (beginning-of-line)
1863 (setq previous-node-name (texinfo-copy-node-name)) 1868 (setq previous-node-name (texinfo-copy-node-name))
1864 1869
1865 (setq files (cdr files))) 1870 (setq files-with-node-lines (cdr files-with-node-lines)))
1866 (nreverse menu-list))) 1871 (nreverse menu-list)))
1867 1872
1868(defun texinfo-multi-files-insert-main-menu (menu-list) 1873(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."
1267 found (widget-apply child :validate))) 1267 found (widget-apply child :validate)))
1268 found)) 1268 found))
1269 1269
1270(defun widget-child-value-get (widget)
1271 "Get the value of the first member of :children in WIDGET."
1272 (widget-value (car (widget-get widget :children))))
1273
1274(defun widget-child-value-inline (widget)
1275 "Get the inline value of the first member of :children in WIDGET."
1276 (widget-apply (car (widget-get widget :children)) :value-inline))
1277
1278(defun widget-child-validate (widget)
1279 "The result of validating the first member of :children in WIDGET."
1280 (widget-apply (car (widget-get widget :children)) :validate))
1281
1282(defun widget-type-value-create (widget)
1283 "Convert and instantiate the value of the :type attribute of WIDGET.
1284Store the newly created widget in the :children attribute.
1285
1286The value of the :type attribute should be an unconverted widget type."
1287 (let ((value (widget-get widget :value))
1288 (type (widget-get widget :type)))
1289 (widget-put widget :children
1290 (list (widget-create-child-value widget
1291 (widget-convert type)
1292 value)))))
1293
1294(defun widget-type-default-get (widget)
1295 "Get default value from the :type attribute of WIDGET.
1296
1297The value of the :type attribute should be an unconverted widget type."
1298 (widget-default-get (widget-convert (widget-get widget :type))))
1299
1300(defun widget-type-match (widget value)
1301 "Non-nil if the :type value of WIDGET matches VALUE.
1302
1303The value of the :type attribute should be an unconverted widget type."
1304 (widget-apply (widget-convert (widget-get widget :type)) :match value))
1305
1270(defun widget-types-copy (widget) 1306(defun widget-types-copy (widget)
1271 "Copy :args as widget types in WIDGET." 1307 "Copy :args as widget types in WIDGET."
1272 (widget-put widget :args (mapcar 'widget-copy (widget-get widget :args))) 1308 (widget-put widget :args (mapcar 'widget-copy (widget-get widget :args)))
@@ -1862,9 +1898,8 @@ the earlier input."
1862 :tag "choice" 1898 :tag "choice"
1863 :void '(item :format "invalid (%t)\n") 1899 :void '(item :format "invalid (%t)\n")
1864 :value-create 'widget-choice-value-create 1900 :value-create 'widget-choice-value-create
1865 :value-delete 'widget-children-value-delete 1901 :value-get 'widget-child-value-get
1866 :value-get 'widget-choice-value-get 1902 :value-inline 'widget-child-value-inline
1867 :value-inline 'widget-choice-value-inline
1868 :default-get 'widget-choice-default-get 1903 :default-get 'widget-choice-default-get
1869 :mouse-down-action 'widget-choice-mouse-down-action 1904 :mouse-down-action 'widget-choice-mouse-down-action
1870 :action 'widget-choice-action 1905 :action 'widget-choice-action
@@ -1901,14 +1936,6 @@ the earlier input."
1901 widget void :value value))) 1936 widget void :value value)))
1902 (widget-put widget :choice void)))))) 1937 (widget-put widget :choice void))))))
1903 1938
1904(defun widget-choice-value-get (widget)
1905 ;; Get value of the child widget.
1906 (widget-value (car (widget-get widget :children))))
1907
1908(defun widget-choice-value-inline (widget)
1909 ;; Get value of the child widget.
1910 (widget-apply (car (widget-get widget :children)) :value-inline))
1911
1912(defun widget-choice-default-get (widget) 1939(defun widget-choice-default-get (widget)
1913 ;; Get default for the first choice. 1940 ;; Get default for the first choice.
1914 (widget-default-get (car (widget-get widget :args)))) 1941 (widget-default-get (car (widget-get widget :args))))
@@ -2099,7 +2126,6 @@ when he invoked the menu."
2099 :entry-format "%b %v" 2126 :entry-format "%b %v"
2100 :greedy nil 2127 :greedy nil
2101 :value-create 'widget-checklist-value-create 2128 :value-create 'widget-checklist-value-create
2102 :value-delete 'widget-children-value-delete
2103 :value-get 'widget-checklist-value-get 2129 :value-get 'widget-checklist-value-get
2104 :validate 'widget-checklist-validate 2130 :validate 'widget-checklist-validate
2105 :match 'widget-checklist-match 2131 :match 'widget-checklist-match
@@ -2276,7 +2302,6 @@ Return an alist of (TYPE MATCH)."
2276 :format "%v" 2302 :format "%v"
2277 :entry-format "%b %v" 2303 :entry-format "%b %v"
2278 :value-create 'widget-radio-value-create 2304 :value-create 'widget-radio-value-create
2279 :value-delete 'widget-children-value-delete
2280 :value-get 'widget-radio-value-get 2305 :value-get 'widget-radio-value-get
2281 :value-inline 'widget-radio-value-inline 2306 :value-inline 'widget-radio-value-inline
2282 :value-set 'widget-radio-value-set 2307 :value-set 'widget-radio-value-set
@@ -2466,7 +2491,6 @@ Return an alist of (TYPE MATCH)."
2466 :format-handler 'widget-editable-list-format-handler 2491 :format-handler 'widget-editable-list-format-handler
2467 :entry-format "%i %d %v" 2492 :entry-format "%i %d %v"
2468 :value-create 'widget-editable-list-value-create 2493 :value-create 'widget-editable-list-value-create
2469 :value-delete 'widget-children-value-delete
2470 :value-get 'widget-editable-list-value-get 2494 :value-get 'widget-editable-list-value-get
2471 :validate 'widget-children-validate 2495 :validate 'widget-children-validate
2472 :match 'widget-editable-list-match 2496 :match 'widget-editable-list-match
@@ -2637,7 +2661,6 @@ Return an alist of (TYPE MATCH)."
2637 :copy 'widget-types-copy 2661 :copy 'widget-types-copy
2638 :format "%v" 2662 :format "%v"
2639 :value-create 'widget-group-value-create 2663 :value-create 'widget-group-value-create
2640 :value-delete 'widget-children-value-delete
2641 :value-get 'widget-editable-list-value-get 2664 :value-get 'widget-editable-list-value-get
2642 :default-get 'widget-group-default-get 2665 :default-get 'widget-group-default-get
2643 :validate 'widget-children-validate 2666 :validate 'widget-children-validate
@@ -2803,7 +2826,6 @@ link for that string."
2803 "A documentation string." 2826 "A documentation string."
2804 :format "%v" 2827 :format "%v"
2805 :action 'widget-documentation-string-action 2828 :action 'widget-documentation-string-action
2806 :value-delete 'widget-children-value-delete
2807 :value-create 'widget-documentation-string-value-create) 2829 :value-create 'widget-documentation-string-value-create)
2808 2830
2809(defun widget-documentation-string-value-create (widget) 2831(defun widget-documentation-string-value-create (widget)
@@ -3250,6 +3272,62 @@ To use this type, you must define :match or :match-alternatives."
3250 (widget-group-match widget 3272 (widget-group-match widget
3251 (widget-apply widget :value-to-internal value)))) 3273 (widget-apply widget :value-to-internal value))))
3252 3274
3275;;; The `lazy' Widget.
3276;;
3277;; Recursive datatypes.
3278
3279(define-widget 'lazy 'default
3280 "Base widget for recursive datastructures.
3281
3282The `lazy' widget will, when instantiated, contain a single inferior
3283widget, of the widget type specified by the :type parameter. The
3284value of the `lazy' widget is the same as the value of the inferior
3285widget. When deriving a new widget from the 'lazy' widget, the :type
3286parameter is allowed to refer to the widget currently being defined,
3287thus allowing recursive datastructures to be described.
3288
3289The :type parameter takes the same arguments as the defcustom
3290parameter with the same name.
3291
3292Most composite widgets, i.e. widgets containing other widgets, does
3293not allow recursion. That is, when you define a new widget type, none
3294of the inferior widgets may be of the same type you are currently
3295defining.
3296
3297In Lisp, however, it is custom to define datastructures in terms of
3298themselves. A list, for example, is defined as either nil, or a cons
3299cell whose cdr itself is a list. The obvious way to translate this
3300into a widget type would be
3301
3302 (define-widget 'my-list 'choice
3303 \"A list of sexps.\"
3304 :tag \"Sexp list\"
3305 :args '((const nil) (cons :value (nil) sexp my-list)))
3306
3307Here we attempt to define my-list as a choice of either the constant
3308nil, or a cons-cell containing a sexp and my-lisp. This will not work
3309because the `choice' widget does not allow recursion.
3310
3311Using the `lazy' widget you can overcome this problem, as in this
3312example:
3313
3314 (define-widget 'sexp-list 'lazy
3315 \"A list of sexps.\"
3316 :tag \"Sexp list\"
3317 :type '(choice (const nil) (cons :value (nil) sexp sexp-list)))"
3318 :format "%{%t%}: %v"
3319 ;; We don't convert :type because we want to allow recursive
3320 ;; datastructures. This is slow, so we should not create speed
3321 ;; critical widgets by deriving from this.
3322 :convert-widget 'widget-value-convert-widget
3323 :value-create 'widget-type-value-create
3324 :value-get 'widget-child-value-get
3325 :value-inline 'widget-child-value-inline
3326 :default-get 'widget-type-default-get
3327 :match 'widget-type-match
3328 :validate 'widget-child-validate)
3329
3330
3253;;; The `plist' Widget. 3331;;; The `plist' Widget.
3254;; 3332;;
3255;; Property lists. 3333;; Property lists.