Mercurial > emacs
comparison 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 |
comparison
equal
deleted
inserted
replaced
69277:ffbb561abb59 | 69278:ade4a047af1b |
---|---|
78 | 78 |
79 ;;;###mh-autoload | 79 ;;;###mh-autoload |
80 (defun mh-delete-line (lines) | 80 (defun mh-delete-line (lines) |
81 "Delete the next LINES lines." | 81 "Delete the next LINES lines." |
82 (delete-region (point) (progn (forward-line lines) (point)))) | 82 (delete-region (point) (progn (forward-line lines) (point)))) |
83 | |
84 ;;;###mh-autoload | |
85 (defun mh-image-load-path-for-library (library image &optional path) | |
86 "Return a suitable search path for images of LIBRARY. | |
87 | |
88 Images for LIBRARY are searched for in \"../../etc/images\" and | |
89 \"../etc/images\" relative to the files in \"lisp/LIBRARY\", in | |
90 `image-load-path', or in `load-path'. | |
91 | |
92 This function returns value of `load-path' augmented with the | |
93 path to IMAGE. If PATH is given, it is used instead of | |
94 `load-path'. | |
95 | |
96 Here is an example that uses a common idiom to provide | |
97 compatibility with versions of Emacs that lack the variable | |
98 `image-load-path': | |
99 | |
100 (let ((load-path | |
101 (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\" 'load-path)) | |
102 (image-load-path | |
103 (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\" 'image-load-path))) | |
104 (mh-tool-bar-folder-buttons-init))" | |
105 (unless library (error "No library specified")) | |
106 (unless image (error "No image specified")) | |
107 (let ((image-directory)) | |
108 (cond | |
109 ;; Try relative setting. | |
110 ((let (library-name d1ei d2ei) | |
111 ;; First, find library in the load-path. | |
112 (setq library-name (locate-library library)) | |
113 (if (not library-name) | |
114 (error "Cannot find library %s in load-path" library)) | |
115 ;; And then set image-directory relative to that. | |
116 (setq | |
117 ;; Go down 2 levels. | |
118 d2ei (expand-file-name | |
119 (concat (file-name-directory library-name) "../../etc/images")) | |
120 ;; Go down 1 level. | |
121 d1ei (expand-file-name | |
122 (concat (file-name-directory library-name) "../etc/images"))) | |
123 (setq image-directory | |
124 ;; Set it to nil if image is not found. | |
125 (cond ((file-exists-p (expand-file-name image d2ei)) d2ei) | |
126 ((file-exists-p (expand-file-name image d1ei)) d1ei))))) | |
127 ;; Check for images in image-load-path or load-path. | |
128 ((let ((img image) | |
129 (dir (or | |
130 ;; Images in image-load-path. | |
131 (mh-image-search-load-path image) | |
132 ;; Images in load-path. | |
133 (locate-library image))) | |
134 parent) | |
135 ;; Since the image might be in a nested directory (for | |
136 ;; example, mail/attach.pbm), adjust `image-directory' | |
137 ;; accordingly. | |
138 (and dir | |
139 (setq dir (file-name-directory dir)) | |
140 (progn | |
141 (while (setq parent (file-name-directory img)) | |
142 (setq img (directory-file-name parent) | |
143 dir (expand-file-name "../" dir))) | |
144 (setq image-directory dir))))) | |
145 (t | |
146 (error "Could not find image %s for library %s" image library))) | |
147 | |
148 ;; Return augmented `image-load-path' or `load-path'. | |
149 (cond ((and path (symbolp path)) | |
150 (nconc (list image-directory) | |
151 (delete image-directory | |
152 (if (boundp path) | |
153 (copy-sequence (symbol-value path)) | |
154 nil)))) | |
155 (t | |
156 (nconc (list image-directory) | |
157 (delete image-directory (copy-sequence load-path))))))) | |
158 | 83 |
159 ;;;###mh-autoload | 84 ;;;###mh-autoload |
160 (defun mh-make-local-vars (&rest pairs) | 85 (defun mh-make-local-vars (&rest pairs) |
161 "Initialize local variables according to the variable-value PAIRS." | 86 "Initialize local variables according to the variable-value PAIRS." |
162 (while pairs | 87 (while pairs |
488 (loop for x in (gethash grand-parent mh-sub-folders-cache) | 413 (loop for x in (gethash grand-parent mh-sub-folders-cache) |
489 when (equal (car x) child2) | 414 when (equal (car x) child2) |
490 do (progn (setf (cdr x) t) (return))))))) | 415 do (progn (setf (cdr x) t) (return))))))) |
491 | 416 |
492 (defun mh-normalize-folder-name (folder &optional empty-string-okay | 417 (defun mh-normalize-folder-name (folder &optional empty-string-okay |
493 dont-remove-trailing-slash) | 418 dont-remove-trailing-slash |
419 return-nil-if-folder-empty) | |
494 "Normalizes FOLDER name. | 420 "Normalizes FOLDER name. |
495 | 421 |
496 Makes sure that two '/' characters never occur next to each | 422 Makes sure that two '/' characters never occur next to each |
497 other. Also all occurrences of \"..\" and \".\" are suitably | 423 other. Also all occurrences of \"..\" and \".\" are suitably |
498 processed. So \"+inbox/../news\" will be normalized to \"+news\". | 424 processed. So \"+inbox/../news\" will be normalized to \"+news\". |
501 at the front if FOLDER lacks one. If non-nil and FOLDER is the | 427 at the front if FOLDER lacks one. If non-nil and FOLDER is the |
502 empty string then nothing is added. | 428 empty string then nothing is added. |
503 | 429 |
504 If optional argument DONT-REMOVE-TRAILING-SLASH is non-nil then a | 430 If optional argument DONT-REMOVE-TRAILING-SLASH is non-nil then a |
505 trailing '/' if present is retained (if present), otherwise it is | 431 trailing '/' if present is retained (if present), otherwise it is |
506 removed." | 432 removed. |
507 (when (stringp folder) | 433 |
434 If optional argument RETURN-NIL-IF-FOLDER-EMPTY is non-nil, then | |
435 return nil if FOLDER is \"\" or \"+\". This is useful when | |
436 normalizing the folder for the \"folders\" command which displays | |
437 the directories in / if passed \"+\". This is usually not | |
438 desired. If this argument is non-nil, then EMPTY-STRING-OKAY has | |
439 no effect." | |
440 (cond | |
441 ((if (and (or (equal folder "+") (equal folder "")) | |
442 return-nil-if-folder-empty) | |
443 (setq folder nil))) | |
444 ((stringp folder) | |
508 ;; Replace two or more consecutive '/' characters with a single '/' | 445 ;; Replace two or more consecutive '/' characters with a single '/' |
509 (while (string-match "//" folder) | 446 (while (string-match "//" folder) |
510 (setq folder (replace-match "/" nil t folder))) | 447 (setq folder (replace-match "/" nil t folder))) |
511 (let* ((length (length folder)) | 448 (let* ((length (length folder)) |
512 (trailing-slash-present (and (> length 0) | 449 (trailing-slash-present (and (> length 0) |
515 (equal (aref folder 0) ?/)))) | 452 (equal (aref folder 0) ?/)))) |
516 (when (and (> length 0) (equal (aref folder 0) ?@) | 453 (when (and (> length 0) (equal (aref folder 0) ?@) |
517 (stringp mh-current-folder-name)) | 454 (stringp mh-current-folder-name)) |
518 (setq folder (format "%s/%s/" mh-current-folder-name | 455 (setq folder (format "%s/%s/" mh-current-folder-name |
519 (substring folder 1)))) | 456 (substring folder 1)))) |
520 ;; XXX: Purge empty strings from the list that split-string returns. In | 457 ;; XXX: Purge empty strings from the list that split-string |
521 ;; XEmacs, (split-string "+foo/" "/") returns ("+foo" "") while in GNU | 458 ;; returns. In XEmacs, (split-string "+foo/" "/") returns |
522 ;; Emacs it returns ("+foo"). In the code it is assumed that the | 459 ;; ("+foo" "") while in GNU Emacs it returns ("+foo"). In the |
523 ;; components list has no empty strings. | 460 ;; code it is assumed that the components list has no empty |
461 ;; strings. | |
524 (let ((components (delete "" (split-string folder "/"))) | 462 (let ((components (delete "" (split-string folder "/"))) |
525 (result ())) | 463 (result ())) |
526 ;; Remove .. and . from the pathname. | 464 ;; Remove .. and . from the pathname. |
527 (dolist (component components) | 465 (dolist (component components) |
528 (cond ((and (equal component "..") result) | 466 (cond ((and (equal component "..") result) |
538 (when (not (equal folder "")) | 476 (when (not (equal folder "")) |
539 (setq folder (substring folder 0 (1- (length folder)))))) | 477 (setq folder (substring folder 0 (1- (length folder)))))) |
540 (when leading-slash-present | 478 (when leading-slash-present |
541 (setq folder (concat "/" folder))))) | 479 (setq folder (concat "/" folder))))) |
542 (cond ((and empty-string-okay (equal folder ""))) | 480 (cond ((and empty-string-okay (equal folder ""))) |
543 ((equal folder "") (setq folder "+")) | 481 ((equal folder "") |
544 ((not (equal (aref folder 0) ?+)) (setq folder (concat "+" folder))))) | 482 (setq folder "+")) |
483 ((not (equal (aref folder 0) ?+)) | |
484 (setq folder (concat "+" folder)))))) | |
545 folder) | 485 folder) |
546 | 486 |
547 (defmacro mh-children-p (folder) | 487 (defmacro mh-children-p (folder) |
548 "Return t if FOLDER from sub-folders cache has children. | 488 "Return t if FOLDER from sub-folders cache has children. |
549 The car of folder is the name, and the cdr is either t or some | 489 The car of folder is the name, and the cdr is either t or some |
569 | 509 |
570 Respects the value of `mh-recursive-folders-flag'. If this flag | 510 Respects the value of `mh-recursive-folders-flag'. If this flag |
571 is nil, and the sub-folders have not been explicitly viewed, then | 511 is nil, and the sub-folders have not been explicitly viewed, then |
572 they will not be returned." | 512 they will not be returned." |
573 (let ((folder-list)) | 513 (let ((folder-list)) |
574 ;; Normalize folder. Strip leading +. Add trailing slash (done in | 514 ;; Normalize folder. Strip leading + and trailing slash(es). If no |
575 ;; two steps to avoid infinite loops when replacing "/*$" with "/" | 515 ;; folder is specified, ensure it is nil to avoid adding the |
576 ;; in XEmacs). If no folder is specified, ensure it is nil to | 516 ;; folder to the folder-list and adding a slash to it. |
577 ;; ensure we get the top-level folders; otherwise mh-sub-folders | |
578 ;; returns all the files in / if given an empty string or +. | |
579 (when folder | 517 (when folder |
580 (setq folder (mh-replace-regexp-in-string "^\+" "" folder)) | 518 (setq folder (mh-replace-regexp-in-string "^\+" "" folder)) |
581 (setq folder (mh-replace-regexp-in-string "/+$" "" folder))) | 519 (setq folder (mh-replace-regexp-in-string "/+$" "" folder)) |
520 (if (equal folder "") | |
521 (setq folder nil))) | |
582 ;; Add provided folder to list, unless all folders are asked for. | 522 ;; Add provided folder to list, unless all folders are asked for. |
523 ;; Then append slash to separate sub-folders. | |
583 (unless (null folder) | 524 (unless (null folder) |
584 (setq folder-list (list folder))) | 525 (setq folder-list (list folder)) |
526 (setq folder (concat folder "/"))) | |
585 (loop for f in (mh-sub-folders folder) do | 527 (loop for f in (mh-sub-folders folder) do |
586 (setq folder-list | 528 (setq folder-list |
587 (append folder-list | 529 (append folder-list |
588 (if (mh-children-p f) | 530 (if (mh-children-p f) |
589 (mh-folder-list (concat folder "/" (car f))) | 531 (mh-folder-list (concat folder (car f))) |
590 (list (concat folder "/" (car f))))))) | 532 (list (concat folder (car f))))))) |
591 folder-list)) | 533 folder-list)) |
592 | 534 |
593 ;;;###mh-autoload | 535 ;;;###mh-autoload |
594 (defun mh-sub-folders (folder &optional add-trailing-slash-flag) | 536 (defun mh-sub-folders (folder &optional add-trailing-slash-flag) |
595 "Find the subfolders of FOLDER. | 537 "Find the subfolders of FOLDER. |
597 results of the actual folders call. | 539 results of the actual folders call. |
598 | 540 |
599 If optional argument ADD-TRAILING-SLASH-FLAG is non-nil then a | 541 If optional argument ADD-TRAILING-SLASH-FLAG is non-nil then a |
600 slash is added to each of the sub-folder names that may have | 542 slash is added to each of the sub-folder names that may have |
601 nested folders within them." | 543 nested folders within them." |
602 (let* ((folder (mh-normalize-folder-name folder)) | 544 (let* ((folder (mh-normalize-folder-name folder nil nil t)) |
603 (match (gethash folder mh-sub-folders-cache 'no-result)) | 545 (match (gethash folder mh-sub-folders-cache 'no-result)) |
604 (sub-folders (cond ((eq match 'no-result) | 546 (sub-folders (cond ((eq match 'no-result) |
605 (setf (gethash folder mh-sub-folders-cache) | 547 (setf (gethash folder mh-sub-folders-cache) |
606 (mh-sub-folders-actual folder))) | 548 (mh-sub-folders-actual folder))) |
607 (t match)))) | 549 (t match)))) |