changeset 69278:ade4a047af1b

* mh-compat.el (mh-image-load-path-for-library): Move here from mh-utils.el and wrap with mh-defun-compat since this function will be soon added to image.el. * mh-utils.el (mh-image-load-path-for-library): Move to mh-compat.el. (mh-normalize-folder-name): Add return-nil-if-folder-empty argument which is useful when calling mh-normalize-folder-name to process the folder argument for the folders command. (mh-sub-folders): Use new flag to mh-normalize-folder-name to make this function more robust. It could too easily list the folders in /. (mh-folder-list): Fix a couple of problems pointed out by Thomas Baumann. Set folder to nil if empty. Don't append "/" if folder nil.
author Bill Wohler <wohler@newt.com>
date Sat, 04 Mar 2006 21:23:21 +0000
parents ffbb561abb59
children 45a2e01db282
files lisp/mh-e/ChangeLog lisp/mh-e/mh-compat.el lisp/mh-e/mh-utils.el
diffstat 3 files changed, 134 insertions(+), 96 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/mh-e/ChangeLog	Sat Mar 04 16:07:12 2006 +0000
+++ b/lisp/mh-e/ChangeLog	Sat Mar 04 21:23:21 2006 +0000
@@ -1,3 +1,21 @@
+2006-03-04  Bill Wohler  <wohler@newt.com>
+
+	* mh-compat.el (mh-image-load-path-for-library): Move here from
+	mh-utils.el and wrap with mh-defun-compat since this function will
+	be soon added to image.el.
+	
+	* mh-utils.el (mh-image-load-path-for-library): Move to
+	mh-compat.el.
+	(mh-normalize-folder-name): Add return-nil-if-folder-empty
+	argument which is useful when calling mh-normalize-folder-name to
+	process the folder argument for the folders command.
+	(mh-sub-folders): Use new flag to mh-normalize-folder-name to make
+	this function more robust. It could too easily list the folders in
+	/.
+	(mh-folder-list): Fix a couple of problems pointed out by Thomas
+	Baumann. Set folder to nil if empty. Don't append "/" if folder
+	nil.
+
 2006-03-03  Bill Wohler  <wohler@newt.com>
 
 	* mh-folder.el (mh-folder-mode):  Rename mh-image-load-path to
@@ -36,8 +54,8 @@
 	(mh-tool-bar-letter-buttons-init): Don't call mh-image-load-path.
 	(mh-tool-bar-define call): Format.
 
-	* mh-utils.el (mh-image-directory,
-	mh-image-load-path-called-flag): Delete.
+	* mh-utils.el (mh-image-directory)
+	(mh-image-load-path-called-flag): Delete.
 	(mh-image-load-path): Incorporate changes from Gnus team. Biggest
 	changes are that it no longer uses/sets mh-image-directory or
 	mh-image-load-path-called-flag, and returns the updated path
--- a/lisp/mh-e/mh-compat.el	Sat Mar 04 16:07:12 2006 +0000
+++ b/lisp/mh-e/mh-compat.el	Sat Mar 04 21:23:21 2006 +0000
@@ -115,6 +115,84 @@
       `(face-background ,face ,frame)
     `(face-background ,face ,frame ,inherit)))
 
+(mh-defun-compat mh-image-load-path-for-library
+  image-load-path-for-library (library image &optional path)
+  "Return a suitable search path for images relative to LIBRARY.
+
+Images for LIBRARY are searched for in \"../../etc/images\" and
+\"../etc/images\" relative to the files in \"lisp/LIBRARY\" as
+well as in `image-load-path' and `load-path'.
+
+This function returns the value of `load-path' augmented with the
+path to IMAGE. If PATH is given, it is used instead of
+`load-path'.
+
+Here is an example that uses a common idiom to provide
+compatibility with versions of Emacs that lack the variable
+`image-load-path':
+
+  (let ((load-path
+         (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
+        (image-load-path
+         (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\" 'image-load-path)))
+    (mh-tool-bar-folder-buttons-init))
+
+This function is used by Emacs versions that don't have
+`image-load-path-for-library'."
+  (unless library (error "No library specified"))
+  (unless image   (error "No image specified"))
+  (let ((image-directory))
+    (cond
+     ;; Try relative setting.
+     ((let (library-name d1ei d2ei)
+        ;; First, find library in the load-path.
+        (setq library-name (locate-library library))
+        (if (not library-name)
+            (error "Cannot find library %s in load-path" library))
+        ;; And then set image-directory relative to that.
+        (setq
+         ;; Go down 2 levels.
+         d2ei (expand-file-name
+               (concat (file-name-directory library-name) "../../etc/images"))
+         ;; Go down 1 level.
+         d1ei (expand-file-name
+               (concat (file-name-directory library-name) "../etc/images")))
+        (setq image-directory
+              ;; Set it to nil if image is not found.
+              (cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
+                    ((file-exists-p (expand-file-name image d1ei)) d1ei)))))
+     ;; Check for images in image-load-path or load-path.
+     ((let ((img image)
+            (dir (or
+                  ;; Images in image-load-path.
+                  (mh-image-search-load-path image)
+                  ;; Images in load-path.
+                  (locate-library image)))
+            parent)
+        ;; Since the image might be in a nested directory (for
+        ;; example, mail/attach.pbm), adjust `image-directory'
+        ;; accordingly.
+        (and dir
+             (setq dir (file-name-directory dir))
+             (progn
+               (while (setq parent (file-name-directory img))
+                 (setq img (directory-file-name parent)
+                       dir (expand-file-name "../" dir)))
+               (setq image-directory dir)))))
+     (t
+      (error "Could not find image %s for library %s" image library)))
+
+    ;; Return augmented `image-load-path' or `load-path'.
+    (cond ((and path (symbolp path))
+           (nconc (list image-directory)
+                  (delete image-directory
+                          (if (boundp path)
+                              (copy-sequence (symbol-value path))
+                            nil))))
+          (t
+           (nconc (list image-directory)
+                  (delete image-directory (copy-sequence load-path)))))))
+
 (mh-defun-compat mh-image-search-load-path
   image-search-load-path (file &optional path)
   "Emacs 21 and XEmacs don't have `image-search-load-path'.
--- a/lisp/mh-e/mh-utils.el	Sat Mar 04 16:07:12 2006 +0000
+++ b/lisp/mh-e/mh-utils.el	Sat Mar 04 21:23:21 2006 +0000
@@ -82,81 +82,6 @@
   (delete-region (point) (progn (forward-line lines) (point))))
 
 ;;;###mh-autoload
-(defun mh-image-load-path-for-library (library image &optional path)
-  "Return a suitable search path for images of LIBRARY.
-
-Images for LIBRARY are searched for in \"../../etc/images\" and
-\"../etc/images\" relative to the files in \"lisp/LIBRARY\", in
-`image-load-path', or in `load-path'.
-
-This function returns value of `load-path' augmented with the
-path to IMAGE.  If PATH is given, it is used instead of
-`load-path'.
-
-Here is an example that uses a common idiom to provide
-compatibility with versions of Emacs that lack the variable
-`image-load-path':
-
-  (let ((load-path
-         (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\" 'load-path))
-        (image-load-path
-         (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\" 'image-load-path)))
-    (mh-tool-bar-folder-buttons-init))"
-  (unless library (error "No library specified"))
-  (unless image   (error "No image specified"))
-  (let ((image-directory))
-    (cond
-     ;; Try relative setting.
-     ((let (library-name d1ei d2ei)
-        ;; First, find library in the load-path.
-        (setq library-name (locate-library library))
-        (if (not library-name)
-            (error "Cannot find library %s in load-path" library))
-        ;; And then set image-directory relative to that.
-        (setq
-         ;; Go down 2 levels.
-         d2ei (expand-file-name
-               (concat (file-name-directory library-name) "../../etc/images"))
-         ;; Go down 1 level.
-         d1ei (expand-file-name
-               (concat (file-name-directory library-name) "../etc/images")))
-        (setq image-directory
-              ;; Set it to nil if image is not found.
-              (cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
-                    ((file-exists-p (expand-file-name image d1ei)) d1ei)))))
-     ;; Check for images in image-load-path or load-path.
-     ((let ((img image)
-            (dir (or
-                  ;; Images in image-load-path.
-                  (mh-image-search-load-path image)
-                  ;; Images in load-path.
-                  (locate-library image)))
-            parent)
-        ;; Since the image might be in a nested directory (for
-        ;; example, mail/attach.pbm), adjust `image-directory'
-        ;; accordingly.
-        (and dir
-             (setq dir (file-name-directory dir))
-             (progn
-               (while (setq parent (file-name-directory img))
-                 (setq img (directory-file-name parent)
-                       dir (expand-file-name "../" dir)))
-               (setq image-directory dir)))))
-     (t
-      (error "Could not find image %s for library %s" image library)))
-
-    ;; Return augmented `image-load-path' or `load-path'.
-    (cond ((and path (symbolp path))
-           (nconc (list image-directory)
-                  (delete image-directory
-                          (if (boundp path)
-                              (copy-sequence (symbol-value path))
-                            nil))))
-          (t
-           (nconc (list image-directory)
-                  (delete image-directory (copy-sequence load-path)))))))
-
-;;;###mh-autoload
 (defun mh-make-local-vars (&rest pairs)
   "Initialize local variables according to the variable-value PAIRS."
   (while pairs
@@ -490,7 +415,8 @@
               do (progn (setf (cdr x) t) (return)))))))
 
 (defun mh-normalize-folder-name (folder &optional empty-string-okay
-                                        dont-remove-trailing-slash)
+                                        dont-remove-trailing-slash
+                                        return-nil-if-folder-empty)
   "Normalizes FOLDER name.
 
 Makes sure that two '/' characters never occur next to each
@@ -503,8 +429,19 @@
 
 If optional argument DONT-REMOVE-TRAILING-SLASH is non-nil then a
 trailing '/' if present is retained (if present), otherwise it is
-removed."
-  (when (stringp folder)
+removed.
+
+If optional argument RETURN-NIL-IF-FOLDER-EMPTY is non-nil, then
+return nil if FOLDER is \"\" or \"+\". This is useful when
+normalizing the folder for the \"folders\" command which displays
+the directories in / if passed \"+\". This is usually not
+desired. If this argument is non-nil, then EMPTY-STRING-OKAY has
+no effect."
+  (cond
+   ((if (and (or (equal folder "+") (equal folder ""))
+             return-nil-if-folder-empty)
+        (setq folder nil)))
+   ((stringp folder)
     ;; Replace two or more consecutive '/' characters with a single '/'
     (while (string-match "//" folder)
       (setq folder (replace-match "/" nil t folder)))
@@ -517,10 +454,11 @@
                  (stringp mh-current-folder-name))
         (setq folder (format "%s/%s/" mh-current-folder-name
                              (substring folder 1))))
-      ;; XXX: Purge empty strings from the list that split-string returns. In
-      ;;  XEmacs, (split-string "+foo/" "/") returns ("+foo" "") while in GNU
-      ;;  Emacs it returns ("+foo"). In the code it is assumed that the
-      ;; components list has no empty strings.
+      ;; XXX: Purge empty strings from the list that split-string
+      ;; returns. In XEmacs, (split-string "+foo/" "/") returns
+      ;; ("+foo" "") while in GNU Emacs it returns ("+foo"). In the
+      ;; code it is assumed that the components list has no empty
+      ;; strings.
       (let ((components (delete "" (split-string folder "/")))
             (result ()))
         ;; Remove .. and . from the pathname.
@@ -540,8 +478,10 @@
         (when leading-slash-present
           (setq folder (concat "/" folder)))))
     (cond ((and empty-string-okay (equal folder "")))
-          ((equal folder "") (setq folder "+"))
-          ((not (equal (aref folder 0) ?+)) (setq folder (concat "+" folder)))))
+          ((equal folder "")
+           (setq folder "+"))
+          ((not (equal (aref folder 0) ?+))
+           (setq folder (concat "+" folder))))))
   folder)
 
 (defmacro mh-children-p (folder)
@@ -571,23 +511,25 @@
 is nil, and the sub-folders have not been explicitly viewed, then
 they will not be returned."
   (let ((folder-list))
-    ;; Normalize folder. Strip leading +. Add trailing slash (done in
-    ;; two steps to avoid infinite loops when replacing "/*$" with "/"
-    ;; in XEmacs). If no folder is specified, ensure it is nil to
-    ;; ensure we get the top-level folders; otherwise mh-sub-folders
-    ;; returns all the files in / if given an empty string or +.
+    ;; Normalize folder. Strip leading + and trailing slash(es). If no
+    ;; folder is specified, ensure it is nil to avoid adding the
+    ;; folder to the folder-list and adding a slash to it.
     (when folder
       (setq folder (mh-replace-regexp-in-string "^\+" "" folder))
-      (setq folder (mh-replace-regexp-in-string "/+$" "" folder)))
+      (setq folder (mh-replace-regexp-in-string "/+$" "" folder))
+      (if (equal folder "")
+          (setq folder nil)))
     ;; Add provided folder to list, unless all folders are asked for.
+    ;; Then append slash to separate sub-folders.
     (unless (null folder)
-      (setq folder-list (list folder)))
+      (setq folder-list (list folder))
+      (setq folder (concat folder "/")))
     (loop for f in (mh-sub-folders folder) do
           (setq folder-list
                 (append folder-list
                         (if (mh-children-p f)
-                            (mh-folder-list (concat folder "/" (car f)))
-                          (list (concat folder "/" (car f)))))))
+                            (mh-folder-list (concat folder (car f)))
+                          (list (concat folder (car f)))))))
     folder-list))
 
 ;;;###mh-autoload
@@ -599,7 +541,7 @@
 If optional argument ADD-TRAILING-SLASH-FLAG is non-nil then a
 slash is added to each of the sub-folder names that may have
 nested folders within them."
-  (let* ((folder (mh-normalize-folder-name folder))
+  (let* ((folder (mh-normalize-folder-name folder nil nil t))
          (match (gethash folder mh-sub-folders-cache 'no-result))
          (sub-folders (cond ((eq match 'no-result)
                              (setf (gethash folder mh-sub-folders-cache)