Mercurial > emacs
diff lisp/mh-e/mh-utils.el @ 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 | b52e0cc8af61 |
children | 0b84cb235f62 |
line wrap: on
line diff
--- 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)