diff options
Diffstat (limited to 'lisp/mh-e/mh-utils.el')
| -rw-r--r-- | lisp/mh-e/mh-utils.el | 222 |
1 files changed, 129 insertions, 93 deletions
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index c00558860d1..b23a8f3f613 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -81,69 +81,80 @@ used in lieu of `search' in the CL package." "Delete the next LINES lines." (delete-region (point) (progn (forward-line lines) (point)))) -(defvar mh-image-load-path nil - "Directory where images for MH-E are found. -If nil, then the function `mh-image-load-path' will search for -the images in \"../../etc/images\" relative to the files in -\"lisp/mh-e\".") - -(defvar mh-image-load-path-called-flag nil - "Non-nil means that the function `mh-image-load-path' has been called. -This variable is used by that function to avoid doing the work repeatedly.") - ;;;###mh-autoload -(defun mh-image-load-path () - "Ensure that the MH-E images are accessible by `find-image'. - -Images for MH-E are found in \"../../etc/images\" relative to the -files in \"lisp/mh-e\", in `image-load-path', or in `load-path'. -This function saves the actual location found in the variable -`mh-image-load-path'. If the images on your system are actually -located elsewhere, then set the variable `mh-image-load-path' -before starting MH-E. - -If `image-load-path' exists (since Emacs 22), then the contents -of the variable `mh-image-load-path' is added to it if isn't -already there. Otherwise, the contents of the variable -`mh-image-load-path' is added to the `load-path' if it isn't -already there. - -See also variable `mh-image-load-path-called-flag'." - (unless mh-image-load-path-called-flag +(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 - (mh-image-load-path) ; user setting exists - ((let (mh-library-name) ; try relative setting - ;; First, find mh-e in the load-path. - (setq mh-library-name (locate-library "mh-e")) - (if (not mh-library-name) - (error "Can not find MH-E in load-path")) - ;; And then set mh-image-load-path relative to that. - (setq mh-image-load-path - (expand-file-name (concat - (file-name-directory mh-library-name) - "../../etc/images"))) - (file-exists-p (expand-file-name "mh-logo.xpm" mh-image-load-path)))) - ((mh-image-search-load-path "mh-logo.xpm") - ;; Images in image-load-path. - (setq mh-image-load-path - (file-name-directory (mh-image-search-load-path "mh-logo.xpm")))) - ((locate-library "mh-logo.xpm") - ;; Images in load-path. - (setq mh-image-load-path - (file-name-directory (locate-library "mh-logo.xpm"))))) - - (if (not (file-exists-p mh-image-load-path)) - (error "Directory %s in mh-image-load-path does not exist" - mh-image-load-path)) - (if (not (file-exists-p - (expand-file-name "mh-logo.xpm" mh-image-load-path))) - (error "Directory %s in mh-image-load-path does not contain MH-E images" - mh-image-load-path)) - (if (boundp 'image-load-path) - (add-to-list 'image-load-path mh-image-load-path) - (add-to-list 'load-path mh-image-load-path)) - - (setq mh-image-load-path-called-flag t))) + ;; 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) @@ -159,6 +170,23 @@ See also variable `mh-image-load-path-called-flag'." (funcall function (car list)) (setq list (cdr list)))) +(defvar mh-pick-regexp-chars ".*$[" + "List of special characters in pick regular expressions.") + +;;;###mh-autoload +(defun mh-quote-pick-expr (pick-expr) + "Quote `mh-pick-regexp-chars' in PICK-EXPR. +PICK-EXPR is a list of strings. Return nil if PICK-EXPR is nil." + (let ((quoted-pick-expr)) + (dolist (string pick-expr) + (when (and string + (not (string-equal string ""))) + (loop for i from 0 to (1- (length mh-pick-regexp-chars)) do + (let ((s (string ?\\ (aref mh-pick-regexp-chars i)))) + (setq string (mh-replace-regexp-in-string s s string t t)))) + (setq quoted-pick-expr (append quoted-pick-expr (list string))))) + quoted-pick-expr)) + ;;;###mh-autoload (defun mh-replace-string (old new) "Replace all occurrences of OLD with NEW in the current buffer. @@ -177,23 +205,26 @@ Ignores case when searching for OLD." ;;;###mh-autoload (defun mh-logo-display () "Modify mode line to display MH-E logo." - (mh-image-load-path) (mh-do-in-gnu-emacs - (add-text-properties - 0 2 - `(display ,(or mh-logo-cache - (setq mh-logo-cache - (mh-funcall-if-exists - find-image '((:type xpm :ascent center - :file "mh-logo.xpm")))))) - (car mode-line-buffer-identification))) + (let ((load-path (mh-image-load-path-for-library + "mh-e" "mh-logo.xpm" 'load-path)) + (image-load-path (mh-image-load-path-for-library + "mh-e" "mh-logo.xpm" 'image-load-path))) + (add-text-properties + 0 2 + `(display ,(or mh-logo-cache + (setq mh-logo-cache + (mh-funcall-if-exists + find-image '((:type xpm :ascent center + :file "mh-logo.xpm")))))) + (car mode-line-buffer-identification)))) (mh-do-in-xemacs - (setq modeline-buffer-identification - (list - (if mh-modeline-glyph - (cons modeline-buffer-id-left-extent mh-modeline-glyph) - (cons modeline-buffer-id-left-extent "XEmacs%N:")) - (cons modeline-buffer-id-right-extent " %17b"))))) + (setq modeline-buffer-identification + (list + (if mh-modeline-glyph + (cons modeline-buffer-id-left-extent mh-modeline-glyph) + (cons modeline-buffer-id-left-extent "XEmacs%N:")) + (cons modeline-buffer-id-right-extent " %17b"))))) @@ -526,14 +557,19 @@ number of sub-folders. XXX" ;;;###mh-autoload (defun mh-folder-list (folder) "Return FOLDER and its descendents. -Returns a list of strings. For example, - - '(\"inbox\" \"lists\" \"lists/mh-e\"). - -If folder is nil, then all folders are considered. Respects the -value of `mh-recursive-folders-flag'. If this flag is nil, and -the sub-folders have not been explicitly viewed, then they will -not be returned." +FOLDER may have a + prefix. Returns a list of strings without the ++ prefix. If FOLDER is nil, then all folders are considered. For +example, if your Mail directory only contains the folders +inbox, ++outbox, +lists, and +lists/mh-e, then + + (mh-folder-list nil) + => (\"inbox\" \"lists\" \"lists/mh-e\" \"outbox\") + (mh-folder-list \"+lists\") + => (\"lists/mh-e\") + +Respects the value of `mh-recursive-folders-flag'. If this flag +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 "/" @@ -542,16 +578,16 @@ not be returned." ;; returns all the files in / if given an empty string or +. (when folder (setq folder (mh-replace-regexp-in-string "^\+" "" folder)) - (setq folder (mh-replace-regexp-in-string "/+$" "" folder)) - (setq folder (concat folder "/")) - (if (equal folder "") - (setq folder nil))) + (setq folder (mh-replace-regexp-in-string "/+$" "" folder))) + ;; Add provided folder to list, unless all folders are asked for. + (unless (null folder) + (setq folder-list (list folder))) (loop for f in (mh-sub-folders folder) do - (setq folder-list (append folder-list (list (concat folder (car f))))) - (if (mh-children-p f) - (setq folder-list - (append folder-list - (mh-folder-list (concat folder (car f))))))) + (setq folder-list + (append folder-list + (if (mh-children-p f) + (mh-folder-list (concat folder "/" (car f))) + (list (concat folder "/" (car f))))))) folder-list)) ;;;###mh-autoload |