aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBill Wohler2006-03-03 00:27:49 +0000
committerBill Wohler2006-03-03 00:27:49 +0000
commitefc27af6c4a0bcbca4a93e6a5d6964ad38735fce (patch)
tree63fb3dc957a18ff69ee7a0f6640b85aad158ba94
parent7e50c0333fb7eeee7171030ea0a7e71ee2ad41ae (diff)
downloademacs-efc27af6c4a0bcbca4a93e6a5d6964ad38735fce.tar.gz
emacs-efc27af6c4a0bcbca4a93e6a5d6964ad38735fce.zip
* mh-folder.el (mh-tool-bar-init): Autoload.
(mh-folder-mode): Call mh-tool-bar-init conditionally in XEmacs. Set scoped variables image-load-path and load-path with updated mh-image-load-path before calling mh-tool-bar-folder-buttons-init. * mh-letter.el (mh-tool-bar-init): Autoload. (mh-letter-mode): Call mh-tool-bar-init conditionally in XEmacs. Set scoped variables image-load-path and load-path with updated mh-image-load-path before calling mh-tool-bar-letter-buttons-init. * mh-show.el (mh-tool-bar-init): Autoload. (mh-show-mode): Perform tool bar stuff conditionally in XEmacs and GNU Emacs. * mh-tool-bar.el (mh-tool-bar-define): Don't quote stuff in error messages per conventions. (mh-tool-bar-folder-buttons-init) (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-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 rather than change it. (mh-logo-display): Change usage of mh-image-load-path.
-rw-r--r--lisp/mh-e/ChangeLog30
-rw-r--r--lisp/mh-e/mh-folder.el18
-rw-r--r--lisp/mh-e/mh-letter.el18
-rw-r--r--lisp/mh-e/mh-show.el9
-rw-r--r--lisp/mh-e/mh-tool-bar.el154
-rw-r--r--lisp/mh-e/mh-utils.el157
6 files changed, 220 insertions, 166 deletions
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index fa39c7988f4..f7b88a05d29 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,33 @@
12006-03-02 Bill Wohler <wohler@newt.com>
2
3 * mh-folder.el (mh-tool-bar-init): Autoload.
4 (mh-folder-mode): Call mh-tool-bar-init conditionally in XEmacs.
5 Set scoped variables image-load-path and load-path with updated
6 mh-image-load-path before calling mh-tool-bar-folder-buttons-init.
7
8 * mh-letter.el (mh-tool-bar-init): Autoload.
9 (mh-letter-mode): Call mh-tool-bar-init conditionally in XEmacs.
10 Set scoped variables image-load-path and load-path with updated
11 mh-image-load-path before calling mh-tool-bar-letter-buttons-init.
12
13 * mh-show.el (mh-tool-bar-init): Autoload.
14 (mh-show-mode): Perform tool bar stuff conditionally in XEmacs and
15 GNU Emacs.
16
17 * mh-tool-bar.el (mh-tool-bar-define): Don't quote stuff in error
18 messages per conventions.
19 (mh-tool-bar-folder-buttons-init)
20 (mh-tool-bar-letter-buttons-init): Don't call mh-image-load-path.
21 (mh-tool-bar-define call): Format.
22
23 * mh-utils.el (mh-image-directory,
24 mh-image-load-path-called-flag): Delete.
25 (mh-image-load-path): Incorporate changes from Gnus team. Biggest
26 changes are that it no longer uses/sets mh-image-directory or
27 mh-image-load-path-called-flag, and returns the updated path
28 rather than change it.
29 (mh-logo-display): Change usage of mh-image-load-path.
30
12006-02-28 Bill Wohler <wohler@newt.com> 312006-02-28 Bill Wohler <wohler@newt.com>
2 32
3 * mh-limit.el (mh-narrow-to-cc, mh-narrow-to-from) 33 * mh-limit.el (mh-narrow-to-cc, mh-narrow-to-from)
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index 59526986d35..c25d3bc973f 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -36,8 +36,9 @@
36(require 'mh-scan) 36(require 'mh-scan)
37(mh-require-cl) 37(mh-require-cl)
38 38
39;; Dynamically-created function not found in mh-loaddefs.el. 39;; Dynamically-created functions not found in mh-loaddefs.el.
40(autoload 'mh-tool-bar-folder-buttons-init "mh-tool-bar") 40(autoload 'mh-tool-bar-folder-buttons-init "mh-tool-bar")
41(autoload 'mh-tool-bar-init "mh-tool-bar")
41 42
42(require 'gnus-util) 43(require 'gnus-util)
43(autoload 'message-fetch-field "message") 44(autoload 'message-fetch-field "message")
@@ -589,9 +590,16 @@ perform the operation on all messages in that region.
589 590
590\\{mh-folder-mode-map}" 591\\{mh-folder-mode-map}"
591 (mh-do-in-gnu-emacs 592 (mh-do-in-gnu-emacs
592 (unless mh-folder-buttons-init-flag 593 (unless mh-folder-buttons-init-flag
593 (mh-tool-bar-folder-buttons-init) 594 (let ((load-path
594 (setq mh-folder-buttons-init-flag t))) 595 (mh-image-load-path "mh-e" "mh-logo.xpm" 'load-path))
596 (image-load-path
597 (mh-image-load-path "mh-e" "mh-logo.xpm" 'image-load-path)))
598 (mh-tool-bar-folder-buttons-init)
599 (setq mh-folder-buttons-init-flag t)))
600 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
601 (mh-do-in-xemacs
602 (mh-tool-bar-init :folder))
595 (make-local-variable 'font-lock-defaults) 603 (make-local-variable 'font-lock-defaults)
596 (setq font-lock-defaults '(mh-folder-font-lock-keywords t)) 604 (setq font-lock-defaults '(mh-folder-font-lock-keywords t))
597 (make-local-variable 'desktop-save-buffer) 605 (make-local-variable 'desktop-save-buffer)
@@ -652,8 +660,6 @@ perform the operation on all messages in that region.
652 (easy-menu-add mh-folder-message-menu) 660 (easy-menu-add mh-folder-message-menu)
653 (easy-menu-add mh-folder-folder-menu) 661 (easy-menu-add mh-folder-folder-menu)
654 (mh-inc-spool-make) 662 (mh-inc-spool-make)
655 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)
656 (mh-funcall-if-exists mh-tool-bar-init :folder)
657 (mh-set-help mh-folder-mode-help-messages) 663 (mh-set-help mh-folder-mode-help-messages)
658 (if (and mh-xemacs-flag 664 (if (and mh-xemacs-flag
659 font-lock-auto-fontify) 665 font-lock-auto-fontify)
diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el
index c6af5c323a9..535cbb8e242 100644
--- a/lisp/mh-e/mh-letter.el
+++ b/lisp/mh-e/mh-letter.el
@@ -42,8 +42,9 @@
42 42
43(require 'gnus-util) 43(require 'gnus-util)
44 44
45;; Dynamically-created function not found in mh-loaddefs.el. 45;; Dynamically-created functions not found in mh-loaddefs.el.
46(autoload 'mh-tool-bar-letter-buttons-init "mh-tool-bar") 46(autoload 'mh-tool-bar-letter-buttons-init "mh-tool-bar")
47(autoload 'mh-tool-bar-init "mh-tool-bar")
47 48
48(autoload 'mml-insert-tag "mml") 49(autoload 'mml-insert-tag "mml")
49 50
@@ -311,9 +312,16 @@ order).
311 (make-local-variable 'mh-sent-from-folder) 312 (make-local-variable 'mh-sent-from-folder)
312 (make-local-variable 'mh-sent-from-msg) 313 (make-local-variable 'mh-sent-from-msg)
313 (mh-do-in-gnu-emacs 314 (mh-do-in-gnu-emacs
314 (unless mh-letter-buttons-init-flag 315 (unless mh-letter-buttons-init-flag
315 (mh-tool-bar-letter-buttons-init) 316 (let ((load-path
316 (setq mh-letter-buttons-init-flag t))) 317 (mh-image-load-path "mh-e" "mh-logo.xpm" 'load-path))
318 (image-load-path
319 (mh-image-load-path "mh-e" "mh-logo.xpm" 'image-load-path)))
320 (mh-tool-bar-letter-buttons-init)
321 (setq mh-letter-buttons-init-flag t)))
322 (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map))
323 (mh-do-in-xemacs
324 (mh-tool-bar-init :letter))
317 ;; Set the local value of mh-mail-header-separator according to what is 325 ;; Set the local value of mh-mail-header-separator according to what is
318 ;; present in the buffer... 326 ;; present in the buffer...
319 (set (make-local-variable 'mh-mail-header-separator) 327 (set (make-local-variable 'mh-mail-header-separator)
@@ -328,8 +336,6 @@ order).
328 336
329 ;; Enable undo since a show-mode buffer might have been reused. 337 ;; Enable undo since a show-mode buffer might have been reused.
330 (buffer-enable-undo) 338 (buffer-enable-undo)
331 (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)
332 (mh-funcall-if-exists mh-tool-bar-init :letter)
333 (make-local-variable 'font-lock-defaults) 339 (make-local-variable 'font-lock-defaults)
334 (cond 340 (cond
335 ((or (equal mh-highlight-citation-style 'font-lock) 341 ((or (equal mh-highlight-citation-style 'font-lock)
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index 3ae609d9204..d7b656d3462 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -36,6 +36,9 @@
36(require 'mh-e) 36(require 'mh-e)
37(require 'mh-scan) 37(require 'mh-scan)
38 38
39;; Dynamically-created function not found in mh-loaddefs.el.
40(autoload 'mh-tool-bar-init "mh-tool-bar")
41
39(require 'font-lock) 42(require 'font-lock)
40(require 'gnus-cite) 43(require 'gnus-cite)
41(require 'gnus-util) 44(require 'gnus-util)
@@ -830,6 +833,10 @@ The hook `mh-show-mode-hook' is called upon entry to this mode.
830See also `mh-folder-mode'. 833See also `mh-folder-mode'.
831 834
832\\{mh-show-mode-map}" 835\\{mh-show-mode-map}"
836 (mh-do-in-gnu-emacs
837 (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map))
838 (mh-do-in-xemacs
839 (mh-tool-bar-init :show))
833 (set (make-local-variable 'mail-header-separator) mh-mail-header-separator) 840 (set (make-local-variable 'mail-header-separator) mh-mail-header-separator)
834 (setq paragraph-start (default-value 'paragraph-start)) 841 (setq paragraph-start (default-value 'paragraph-start))
835 (mh-show-unquote-From) 842 (mh-show-unquote-From)
@@ -853,8 +860,6 @@ See also `mh-folder-mode'.
853 (if (and mh-xemacs-flag 860 (if (and mh-xemacs-flag
854 font-lock-auto-fontify) 861 font-lock-auto-fontify)
855 (turn-on-font-lock)) 862 (turn-on-font-lock))
856 (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)
857 (mh-funcall-if-exists mh-tool-bar-init :show)
858 (when mh-decode-mime-flag 863 (when mh-decode-mime-flag
859 (mh-make-local-hook 'kill-buffer-hook) 864 (mh-make-local-hook 'kill-buffer-hook)
860 (add-hook 'kill-buffer-hook 'mh-mime-cleanup nil t)) 865 (add-hook 'kill-buffer-hook 'mh-mime-cleanup nil t))
diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el
index 20b239189fa..d72fe8e06ce 100644
--- a/lisp/mh-e/mh-tool-bar.el
+++ b/lisp/mh-e/mh-tool-bar.el
@@ -204,10 +204,10 @@ where,
204 letter-vectors (nreverse letter-vectors)) 204 letter-vectors (nreverse letter-vectors))
205 (dolist (x folder-defaults) 205 (dolist (x folder-defaults)
206 (unless (memq x folder-buttons) 206 (unless (memq x folder-buttons)
207 (error "Folder defaults contains unknown button '%s'" x))) 207 (error "Folder defaults contains unknown button %s" x)))
208 (dolist (x letter-defaults) 208 (dolist (x letter-defaults)
209 (unless (memq x letter-buttons) 209 (unless (memq x letter-buttons)
210 (error "Letter defaults contains unknown button '%s'" x))) 210 (error "Letter defaults contains unknown button %s" x)))
211 `(eval-when (compile load eval) 211 `(eval-when (compile load eval)
212 (defun mh-buffer-exists-p (mode) 212 (defun mh-buffer-exists-p (mode)
213 "Test whether a buffer with major mode MODE is present." 213 "Test whether a buffer with major mode MODE is present."
@@ -222,7 +222,6 @@ where,
222 ;; Tool bar initialization functions 222 ;; Tool bar initialization functions
223 (defun mh-tool-bar-folder-buttons-init () 223 (defun mh-tool-bar-folder-buttons-init ()
224 (when (mh-buffer-exists-p 'mh-folder-mode) 224 (when (mh-buffer-exists-p 'mh-folder-mode)
225 (mh-image-load-path)
226 (setq mh-folder-tool-bar-map 225 (setq mh-folder-tool-bar-map
227 (let ((tool-bar-map (make-sparse-keymap))) 226 (let ((tool-bar-map (make-sparse-keymap)))
228 ,@(nreverse folder-button-setter) 227 ,@(nreverse folder-button-setter)
@@ -241,7 +240,6 @@ where,
241 tool-bar-map)))) 240 tool-bar-map))))
242 (defun mh-tool-bar-letter-buttons-init () 241 (defun mh-tool-bar-letter-buttons-init ()
243 (when (mh-buffer-exists-p 'mh-letter-mode) 242 (when (mh-buffer-exists-p 'mh-letter-mode)
244 (mh-image-load-path)
245 (setq mh-letter-tool-bar-map 243 (setq mh-letter-tool-bar-map
246 (let ((tool-bar-map (make-sparse-keymap))) 244 (let ((tool-bar-map (make-sparse-keymap)))
247 ,@(nreverse letter-button-setter) 245 ,@(nreverse letter-button-setter)
@@ -334,84 +332,82 @@ where,
334 collect `(const :tag ,y ,x))))))) 332 collect `(const :tag ,y ,x)))))))
335 333
336(mh-tool-bar-define 334(mh-tool-bar-define
337 ((:folder mh-inc-folder mh-mime-save-parts mh-previous-undeleted-msg 335 ((:folder mh-inc-folder mh-mime-save-parts mh-previous-undeleted-msg
338 mh-page-msg mh-next-undeleted-msg mh-delete-msg mh-refile-msg 336 mh-page-msg mh-next-undeleted-msg mh-delete-msg mh-refile-msg
339 mh-undo mh-execute-commands mh-toggle-tick mh-reply 337 mh-undo mh-execute-commands mh-toggle-tick mh-reply
340 mh-alias-grab-from-field mh-send mh-rescan-folder 338 mh-alias-grab-from-field mh-send mh-rescan-folder
341 mh-tool-bar-search mh-visit-folder 339 mh-tool-bar-search mh-visit-folder
342 mh-tool-bar-customize mh-tool-bar-folder-help mh-widen) 340 mh-tool-bar-customize mh-tool-bar-folder-help mh-widen)
343 (:letter mh-send-letter mh-compose-insertion ispell-message save-buffer 341 (:letter mh-send-letter mh-compose-insertion ispell-message save-buffer
344 undo kill-region menu-bar-kill-ring-save yank mh-fully-kill-draft 342 undo kill-region menu-bar-kill-ring-save yank mh-fully-kill-draft
345 mh-tool-bar-customize mh-tool-bar-letter-help)) 343 mh-tool-bar-customize mh-tool-bar-letter-help))
346 ;; Folder/Show buffer buttons 344 ;; Folder/Show buffer buttons
347 (mh-inc-folder (folder) "mail" 345 (mh-inc-folder (folder) "mail" "Incorporate new mail in Inbox
348 "Incorporate new mail in Inbox
349This button runs `mh-inc-folder' which drags any 346This button runs `mh-inc-folder' which drags any
350new mail into your Inbox folder.") 347new mail into your Inbox folder")
351 (mh-mime-save-parts (folder) "attach" 348 (mh-mime-save-parts (folder) "attach" "Save MIME parts from this message
352 "Save MIME parts from this message
353This button runs `mh-mime-save-parts' which saves a message's 349This button runs `mh-mime-save-parts' which saves a message's
354different parts into separate files.") 350different parts into separate files")
355 (mh-previous-undeleted-msg (folder) "left-arrow" 351 (mh-previous-undeleted-msg (folder) "left-arrow"
356 "Go to the previous undeleted message 352 "Go to the previous undeleted message
357This button runs `mh-previous-undeleted-msg'") 353This button runs `mh-previous-undeleted-msg'")
358 (mh-page-msg (folder) "page-down" 354 (mh-page-msg (folder) "page-down" "Page the current message forwards
359 "Page the current message forwards\nThis button runs `mh-page-msg'") 355This button runs `mh-page-msg'")
360 (mh-next-undeleted-msg (folder) "right-arrow" 356 (mh-next-undeleted-msg (folder) "right-arrow" "Go to the next undeleted message
361 "Go to the next undeleted message\nThe button runs `mh-next-undeleted-msg'") 357The button runs `mh-next-undeleted-msg'")
362 (mh-delete-msg (folder) "close" 358 (mh-delete-msg (folder) "close" "Mark this message for deletion
363 "Mark this message for deletion\nThis button runs `mh-delete-msg'") 359This button runs `mh-delete-msg'")
364 (mh-refile-msg (folder) "mail/refile" 360 (mh-refile-msg (folder) "mail/refile" "Refile this message
365 "Refile this message\nThis button runs `mh-refile-msg'") 361This button runs `mh-refile-msg'")
366 (mh-undo (folder) "undo" "Undo last operation\nThis button runs `undo'" 362 (mh-undo (folder) "undo" "Undo last operation
367 (mh-outstanding-commands-p)) 363This button runs `undo'"
368 (mh-execute-commands (folder) "execute" 364 (mh-outstanding-commands-p))
369 "Perform moves and deletes\nThis button runs `mh-execute-commands'" 365 (mh-execute-commands (folder) "execute" "Perform moves and deletes
370 (mh-outstanding-commands-p)) 366This button runs `mh-execute-commands'"
371 (mh-toggle-tick (folder) "highlight" 367 (mh-outstanding-commands-p))
372 "Toggle tick mark\nThis button runs `mh-toggle-tick'") 368 (mh-toggle-tick (folder) "highlight" "Toggle tick mark
373 (mh-toggle-showing (folder) "show" 369This button runs `mh-toggle-tick'")
374 "Toggle showing message\nThis button runs `mh-toggle-showing'") 370 (mh-toggle-showing (folder) "show" "Toggle showing message
375 (mh-tool-bar-reply-from (folder) "mail/reply-from" "Reply to \"from\"") 371This button runs `mh-toggle-showing'")
376 (mh-tool-bar-reply-to (folder) "mail/reply-to" "Reply to \"to\"") 372 (mh-tool-bar-reply-from (folder) "mail/reply-from" "Reply to \"from\"")
377 (mh-tool-bar-reply-all (folder) "mail/reply-all" "Reply to \"all\"") 373 (mh-tool-bar-reply-to (folder) "mail/reply-to" "Reply to \"to\"")
378 (mh-reply (folder) "mail/reply" 374 (mh-tool-bar-reply-all (folder) "mail/reply-all" "Reply to \"all\"")
379 "Reply to this message\nThis button runs `mh-reply'") 375 (mh-reply (folder) "mail/reply" "Reply to this message
380 (mh-alias-grab-from-field (folder) "mail/alias" 376This button runs `mh-reply'")
381 "Grab From alias\nThis button runs `mh-alias-grab-from-field'" 377 (mh-alias-grab-from-field (folder) "mail/alias" "Grab From alias
382 (and (mh-extract-from-header-value) (not (mh-alias-for-from-p)))) 378This button runs `mh-alias-grab-from-field'"
383 (mh-send (folder) "mail/compose" 379 (and (mh-extract-from-header-value)
384 "Compose new message\nThis button runs `mh-send'") 380 (not (mh-alias-for-from-p))))
385 (mh-rescan-folder (folder) "refresh" 381 (mh-send (folder) "mail/compose" "Compose new message
386 "Rescan this folder\nThis button runs `mh-rescan-folder'") 382This button runs `mh-send'")
387 (mh-pack-folder (folder) "mail/repack" 383 (mh-rescan-folder (folder) "refresh" "Rescan this folder
388 "Repack this folder\nThis button runs `mh-pack-folder'") 384This button runs `mh-rescan-folder'")
389 (mh-tool-bar-search (folder) "search" 385 (mh-pack-folder (folder) "mail/repack" "Repack this folder
390 "Search\nThis button runs `mh-tool-bar-search-function'") 386This button runs `mh-pack-folder'")
391 (mh-visit-folder (folder) "fld-open" 387 (mh-tool-bar-search (folder) "search" "Search
392 "Visit other folder\nThis button runs `mh-visit-folder'") 388This button runs `mh-tool-bar-search-function'")
393 ;; Letter buffer buttons 389 (mh-visit-folder (folder) "fld-open" "Visit other folder
394 (mh-send-letter (letter) "mail/send" "Send this letter") 390This button runs `mh-visit-folder'")
395 (mh-compose-insertion (letter) "attach" "Insert attachment") 391 ;; Letter buffer buttons
396 (ispell-message (letter) "spell" "Check spelling") 392 (mh-send-letter (letter) "mail/send" "Send this letter")
397 (save-buffer (letter) "save" "Save current buffer to its file" 393 (mh-compose-insertion (letter) "attach" "Insert attachment")
398 (buffer-modified-p)) 394 (ispell-message (letter) "spell" "Check spelling")
399 (undo (letter) "undo" "Undo last operation") 395 (save-buffer (letter) "save" "Save current buffer to its file"
400 (kill-region (letter) "cut" 396 (buffer-modified-p))
401 "Cut (kill) text in region between mark and current position") 397 (undo (letter) "undo" "Undo last operation")
402 (menu-bar-kill-ring-save (letter) "copy" 398 (kill-region (letter) "cut" "Cut (kill) text in region")
403 "Copy text in region between mark and current position") 399 (menu-bar-kill-ring-save (letter) "copy" "Copy text in region")
404 (yank (letter) "paste" "Paste (yank) text cut or copied earlier") 400 (yank (letter) "paste" "Paste (yank) text cut or copied earlier")
405 (mh-fully-kill-draft (letter) "close" "Kill this draft") 401 (mh-fully-kill-draft (letter) "close" "Kill this draft")
406 ;; Common buttons 402 ;; Common buttons
407 (mh-tool-bar-customize (folder letter) "preferences" "MH-E Preferences") 403 (mh-tool-bar-customize (folder letter) "preferences" "MH-E Preferences")
408 (mh-tool-bar-folder-help (folder) "help" 404 (mh-tool-bar-folder-help (folder) "help" "Help! (general help)
409 "Help! (general help)\nThis button runs `info'") 405This button runs `info'")
410 (mh-tool-bar-letter-help (letter) "help" 406 (mh-tool-bar-letter-help (letter) "help" "Help! (general help)
411 "Help! (general help)\nThis button runs `info'") 407This button runs `info'")
412 ;; Folder narrowed to sequence buttons 408 ;; Folder narrowed to sequence buttons
413 (mh-widen (sequence) "widen" 409 (mh-widen (sequence) "widen" "Widen from the sequence
414 "Widen from the sequence\nThis button runs `mh-widen'")) 410This button runs `mh-widen'"))
415 411
416(provide 'mh-tool-bar) 412(provide 'mh-tool-bar)
417 413
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 6ffaf6d499d..5f882e84020 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -81,69 +81,77 @@ used in lieu of `search' in the CL package."
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 83
84(defvar mh-image-directory nil
85 "Directory where images for MH-E are found.
86If nil, then the function `mh-image-load-path' will search for
87the images in \"../../etc/images\" relative to the files in
88\"lisp/mh-e\".")
89
90(defvar mh-image-load-path-called-flag nil
91 "Non-nil means that the function `mh-image-load-path' has been called.
92This variable is used by that function to avoid doing the work repeatedly.")
93
94;;;###mh-autoload 84;;;###mh-autoload
95(defun mh-image-load-path () 85(defun mh-image-load-path (library image &optional path)
96 "Ensure that the MH-E images are accessible by `find-image'. 86 "Return a suitable search path for images of LIBRARY.
97 87
98Images for MH-E are found in \"../../etc/images\" relative to the 88Images for LIBRARY are searched for in \"../../etc/images\" and
99files in \"lisp/mh-e\", in `image-load-path', or in `load-path'. 89\"../etc/images\" relative to the files in \"lisp/LIBRARY\", in
100This function saves the actual location found in the variable 90`image-load-path', or in `load-path'.
101`mh-image-directory'. If the images on your system are actually 91
102located elsewhere, then set the variable `mh-image-directory' 92This function returns value of `load-path' augmented with the
103before starting MH-E. 93path to IMAGE. If PATH is given, it is used instead of
104 94`load-path'."
105If `image-load-path' exists (since Emacs 22), then the contents 95 (unless library (error "No library specified"))
106of the variable `mh-image-directory' is added to it if isn't 96 (unless image (error "No image specified"))
107already there. Otherwise, the contents of the variable 97 (let ((mh-image-directory))
108`mh-image-directory' is added to the `load-path' if it isn't
109already there.
110
111See also variable `mh-image-load-path-called-flag'."
112 (unless mh-image-load-path-called-flag
113 (cond 98 (cond
114 (mh-image-directory) ; user setting exists 99 ;; Try relative setting.
115 ((let (mh-library-name) ; try relative setting 100 ((let (mh-library-name d1ei d2ei)
116 ;; First, find mh-e in the load-path. 101 ;; First, find library in the load-path.
117 (setq mh-library-name (locate-library "mh-e")) 102 (setq mh-library-name (locate-library library))
118 (if (not mh-library-name) 103 (if (not mh-library-name)
119 (error "Can not find MH-E in load-path")) 104 (error "Cannot find library %s in load-path" library))
120 ;; And then set mh-image-directory relative to that. 105 ;; And then set mh-image-directory relative to that.
106 (setq
107 ;; Go down 2 levels.
108 d2ei (expand-file-name
109 (concat (file-name-directory mh-library-name)
110 "../../etc/images"))
111 ;; Go down 1 level.
112 d1ei (expand-file-name
113 (concat (file-name-directory mh-library-name)
114 "../etc/images")))
121 (setq mh-image-directory 115 (setq mh-image-directory
122 (expand-file-name (concat 116 ;; Set it to nil if image is not found.
123 (file-name-directory mh-library-name) 117 (cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
124 "../../etc/images"))) 118 ((file-exists-p (expand-file-name image d1ei)) d1ei)))))
125 (file-exists-p (expand-file-name "mh-logo.xpm" mh-image-directory)))) 119 ;; Check for images in image-load-path or load-path.
126 ((mh-image-search-load-path "mh-logo.xpm") 120 ((let ((img image)
127 ;; Images in image-load-path. 121 (dir (or
128 (setq mh-image-directory 122 ;; Images in image-load-path.
129 (file-name-directory (mh-image-search-load-path "mh-logo.xpm")))) 123 (mh-image-search-load-path image)
130 ((locate-library "mh-logo.xpm") 124 ;; Images in load-path.
131 ;; Images in load-path. 125 (locate-library image)))
132 (setq mh-image-directory 126 parent)
133 (file-name-directory (locate-library "mh-logo.xpm"))))) 127 ;; Since the image might be in a nested directory
134 128 ;; (for example, mail/attach.pbm), adjust `mh-image-directory'
135 (if (not (file-exists-p mh-image-directory)) 129 ;; accordingly.
136 (error "Directory %s in mh-image-directory does not exist" 130 (and dir
137 mh-image-directory)) 131 (setq dir (file-name-directory dir))
138 (if (not (file-exists-p 132 (progn
139 (expand-file-name "mh-logo.xpm" mh-image-directory))) 133 (while (setq parent (file-name-directory img))
140 (error "Directory %s in mh-image-directory does not contain MH-E images" 134 (setq img (directory-file-name parent)
141 mh-image-directory)) 135 dir (expand-file-name "../" dir)))
142 (if (boundp 'image-load-path) 136 (setq mh-image-directory dir))))))
143 (add-to-list 'image-load-path mh-image-directory) 137 ;;
144 (add-to-list 'load-path mh-image-directory)) 138 (unless (file-exists-p mh-image-directory)
145 139 (error "Directory %s in mh-image-directory does not exist"
146 (setq mh-image-load-path-called-flag t))) 140 mh-image-directory))
141 (unless (file-exists-p (expand-file-name image mh-image-directory))
142 (error "Directory %s in mh-image-directory does not contain image %s"
143 mh-image-directory image))
144 ;; Return augmented `image-load-path' or `load-path'.
145 (cond ((and path (symbolp path))
146 (nconc (list mh-image-directory)
147 (delete mh-image-directory
148 (if (boundp path)
149 (copy-sequence (symbol-value path))
150 nil))))
151 (t
152 (nconc (list mh-image-directory)
153 (delete mh-image-directory
154 (copy-sequence load-path)))))))
147 155
148;;;###mh-autoload 156;;;###mh-autoload
149(defun mh-make-local-vars (&rest pairs) 157(defun mh-make-local-vars (&rest pairs)
@@ -194,23 +202,26 @@ Ignores case when searching for OLD."
194;;;###mh-autoload 202;;;###mh-autoload
195(defun mh-logo-display () 203(defun mh-logo-display ()
196 "Modify mode line to display MH-E logo." 204 "Modify mode line to display MH-E logo."
197 (mh-image-load-path)
198 (mh-do-in-gnu-emacs 205 (mh-do-in-gnu-emacs
199 (add-text-properties 206 (let ((load-path
200 0 2 207 (mh-image-load-path "mh-e" "mh-logo.xpm" 'load-path))
201 `(display ,(or mh-logo-cache 208 (image-load-path
202 (setq mh-logo-cache 209 (mh-image-load-path "mh-e" "mh-logo.xpm" 'image-load-path)))
203 (mh-funcall-if-exists 210 (add-text-properties
204 find-image '((:type xpm :ascent center 211 0 2
205 :file "mh-logo.xpm")))))) 212 `(display ,(or mh-logo-cache
206 (car mode-line-buffer-identification))) 213 (setq mh-logo-cache
214 (mh-funcall-if-exists
215 find-image '((:type xpm :ascent center
216 :file "mh-logo.xpm"))))))
217 (car mode-line-buffer-identification))))
207 (mh-do-in-xemacs 218 (mh-do-in-xemacs
208 (setq modeline-buffer-identification 219 (setq modeline-buffer-identification
209 (list 220 (list
210 (if mh-modeline-glyph 221 (if mh-modeline-glyph
211 (cons modeline-buffer-id-left-extent mh-modeline-glyph) 222 (cons modeline-buffer-id-left-extent mh-modeline-glyph)
212 (cons modeline-buffer-id-left-extent "XEmacs%N:")) 223 (cons modeline-buffer-id-left-extent "XEmacs%N:"))
213 (cons modeline-buffer-id-right-extent " %17b"))))) 224 (cons modeline-buffer-id-right-extent " %17b")))))
214 225
215 226
216 227