Mercurial > emacs
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)