Commit efc27af6 authored by Bill Wohler's avatar Bill Wohler

* 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.
parent 7e50c033
2006-03-02 Bill Wohler <wohler@newt.com>
* 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.
2006-02-28 Bill Wohler <wohler@newt.com>
* mh-limit.el (mh-narrow-to-cc, mh-narrow-to-from)
......
......@@ -36,8 +36,9 @@
(require 'mh-scan)
(mh-require-cl)
;; Dynamically-created function not found in mh-loaddefs.el.
;; Dynamically-created functions not found in mh-loaddefs.el.
(autoload 'mh-tool-bar-folder-buttons-init "mh-tool-bar")
(autoload 'mh-tool-bar-init "mh-tool-bar")
(require 'gnus-util)
(autoload 'message-fetch-field "message")
......@@ -589,9 +590,16 @@ perform the operation on all messages in that region.
\\{mh-folder-mode-map}"
(mh-do-in-gnu-emacs
(unless mh-folder-buttons-init-flag
(mh-tool-bar-folder-buttons-init)
(setq mh-folder-buttons-init-flag t)))
(unless mh-folder-buttons-init-flag
(let ((load-path
(mh-image-load-path "mh-e" "mh-logo.xpm" 'load-path))
(image-load-path
(mh-image-load-path "mh-e" "mh-logo.xpm" 'image-load-path)))
(mh-tool-bar-folder-buttons-init)
(setq mh-folder-buttons-init-flag t)))
(set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
(mh-do-in-xemacs
(mh-tool-bar-init :folder))
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(mh-folder-font-lock-keywords t))
(make-local-variable 'desktop-save-buffer)
......@@ -652,8 +660,6 @@ perform the operation on all messages in that region.
(easy-menu-add mh-folder-message-menu)
(easy-menu-add mh-folder-folder-menu)
(mh-inc-spool-make)
(set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)
(mh-funcall-if-exists mh-tool-bar-init :folder)
(mh-set-help mh-folder-mode-help-messages)
(if (and mh-xemacs-flag
font-lock-auto-fontify)
......
......@@ -42,8 +42,9 @@
(require 'gnus-util)
;; Dynamically-created function not found in mh-loaddefs.el.
;; Dynamically-created functions not found in mh-loaddefs.el.
(autoload 'mh-tool-bar-letter-buttons-init "mh-tool-bar")
(autoload 'mh-tool-bar-init "mh-tool-bar")
(autoload 'mml-insert-tag "mml")
......@@ -311,9 +312,16 @@ order).
(make-local-variable 'mh-sent-from-folder)
(make-local-variable 'mh-sent-from-msg)
(mh-do-in-gnu-emacs
(unless mh-letter-buttons-init-flag
(mh-tool-bar-letter-buttons-init)
(setq mh-letter-buttons-init-flag t)))
(unless mh-letter-buttons-init-flag
(let ((load-path
(mh-image-load-path "mh-e" "mh-logo.xpm" 'load-path))
(image-load-path
(mh-image-load-path "mh-e" "mh-logo.xpm" 'image-load-path)))
(mh-tool-bar-letter-buttons-init)
(setq mh-letter-buttons-init-flag t)))
(set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map))
(mh-do-in-xemacs
(mh-tool-bar-init :letter))
;; Set the local value of mh-mail-header-separator according to what is
;; present in the buffer...
(set (make-local-variable 'mh-mail-header-separator)
......@@ -328,8 +336,6 @@ order).
;; Enable undo since a show-mode buffer might have been reused.
(buffer-enable-undo)
(set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)
(mh-funcall-if-exists mh-tool-bar-init :letter)
(make-local-variable 'font-lock-defaults)
(cond
((or (equal mh-highlight-citation-style 'font-lock)
......
......@@ -36,6 +36,9 @@
(require 'mh-e)
(require 'mh-scan)
;; Dynamically-created function not found in mh-loaddefs.el.
(autoload 'mh-tool-bar-init "mh-tool-bar")
(require 'font-lock)
(require 'gnus-cite)
(require 'gnus-util)
......@@ -830,6 +833,10 @@ The hook `mh-show-mode-hook' is called upon entry to this mode.
See also `mh-folder-mode'.
\\{mh-show-mode-map}"
(mh-do-in-gnu-emacs
(set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map))
(mh-do-in-xemacs
(mh-tool-bar-init :show))
(set (make-local-variable 'mail-header-separator) mh-mail-header-separator)
(setq paragraph-start (default-value 'paragraph-start))
(mh-show-unquote-From)
......@@ -853,8 +860,6 @@ See also `mh-folder-mode'.
(if (and mh-xemacs-flag
font-lock-auto-fontify)
(turn-on-font-lock))
(set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)
(mh-funcall-if-exists mh-tool-bar-init :show)
(when mh-decode-mime-flag
(mh-make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook 'mh-mime-cleanup nil t))
......
......@@ -204,10 +204,10 @@ where,
letter-vectors (nreverse letter-vectors))
(dolist (x folder-defaults)
(unless (memq x folder-buttons)
(error "Folder defaults contains unknown button '%s'" x)))
(error "Folder defaults contains unknown button %s" x)))
(dolist (x letter-defaults)
(unless (memq x letter-buttons)
(error "Letter defaults contains unknown button '%s'" x)))
(error "Letter defaults contains unknown button %s" x)))
`(eval-when (compile load eval)
(defun mh-buffer-exists-p (mode)
"Test whether a buffer with major mode MODE is present."
......@@ -222,7 +222,6 @@ where,
;; Tool bar initialization functions
(defun mh-tool-bar-folder-buttons-init ()
(when (mh-buffer-exists-p 'mh-folder-mode)
(mh-image-load-path)
(setq mh-folder-tool-bar-map
(let ((tool-bar-map (make-sparse-keymap)))
,@(nreverse folder-button-setter)
......@@ -241,7 +240,6 @@ where,
tool-bar-map))))
(defun mh-tool-bar-letter-buttons-init ()
(when (mh-buffer-exists-p 'mh-letter-mode)
(mh-image-load-path)
(setq mh-letter-tool-bar-map
(let ((tool-bar-map (make-sparse-keymap)))
,@(nreverse letter-button-setter)
......@@ -334,84 +332,82 @@ where,
collect `(const :tag ,y ,x)))))))
(mh-tool-bar-define
((:folder mh-inc-folder mh-mime-save-parts mh-previous-undeleted-msg
mh-page-msg mh-next-undeleted-msg mh-delete-msg mh-refile-msg
mh-undo mh-execute-commands mh-toggle-tick mh-reply
mh-alias-grab-from-field mh-send mh-rescan-folder
mh-tool-bar-search mh-visit-folder
mh-tool-bar-customize mh-tool-bar-folder-help mh-widen)
(:letter mh-send-letter mh-compose-insertion ispell-message save-buffer
undo kill-region menu-bar-kill-ring-save yank mh-fully-kill-draft
mh-tool-bar-customize mh-tool-bar-letter-help))
;; Folder/Show buffer buttons
(mh-inc-folder (folder) "mail"
"Incorporate new mail in Inbox
((:folder mh-inc-folder mh-mime-save-parts mh-previous-undeleted-msg
mh-page-msg mh-next-undeleted-msg mh-delete-msg mh-refile-msg
mh-undo mh-execute-commands mh-toggle-tick mh-reply
mh-alias-grab-from-field mh-send mh-rescan-folder
mh-tool-bar-search mh-visit-folder
mh-tool-bar-customize mh-tool-bar-folder-help mh-widen)
(:letter mh-send-letter mh-compose-insertion ispell-message save-buffer
undo kill-region menu-bar-kill-ring-save yank mh-fully-kill-draft
mh-tool-bar-customize mh-tool-bar-letter-help))
;; Folder/Show buffer buttons
(mh-inc-folder (folder) "mail" "Incorporate new mail in Inbox
This button runs `mh-inc-folder' which drags any
new mail into your Inbox folder.")
(mh-mime-save-parts (folder) "attach"
"Save MIME parts from this message
new mail into your Inbox folder")
(mh-mime-save-parts (folder) "attach" "Save MIME parts from this message
This button runs `mh-mime-save-parts' which saves a message's
different parts into separate files.")
(mh-previous-undeleted-msg (folder) "left-arrow"
"Go to the previous undeleted message
different parts into separate files")
(mh-previous-undeleted-msg (folder) "left-arrow"
"Go to the previous undeleted message
This button runs `mh-previous-undeleted-msg'")
(mh-page-msg (folder) "page-down"
"Page the current message forwards\nThis button runs `mh-page-msg'")
(mh-next-undeleted-msg (folder) "right-arrow"
"Go to the next undeleted message\nThe button runs `mh-next-undeleted-msg'")
(mh-delete-msg (folder) "close"
"Mark this message for deletion\nThis button runs `mh-delete-msg'")
(mh-refile-msg (folder) "mail/refile"
"Refile this message\nThis button runs `mh-refile-msg'")
(mh-undo (folder) "undo" "Undo last operation\nThis button runs `undo'"
(mh-outstanding-commands-p))
(mh-execute-commands (folder) "execute"
"Perform moves and deletes\nThis button runs `mh-execute-commands'"
(mh-outstanding-commands-p))
(mh-toggle-tick (folder) "highlight"
"Toggle tick mark\nThis button runs `mh-toggle-tick'")
(mh-toggle-showing (folder) "show"
"Toggle showing message\nThis button runs `mh-toggle-showing'")
(mh-tool-bar-reply-from (folder) "mail/reply-from" "Reply to \"from\"")
(mh-tool-bar-reply-to (folder) "mail/reply-to" "Reply to \"to\"")
(mh-tool-bar-reply-all (folder) "mail/reply-all" "Reply to \"all\"")
(mh-reply (folder) "mail/reply"
"Reply to this message\nThis button runs `mh-reply'")
(mh-alias-grab-from-field (folder) "mail/alias"
"Grab From alias\nThis button runs `mh-alias-grab-from-field'"
(and (mh-extract-from-header-value) (not (mh-alias-for-from-p))))
(mh-send (folder) "mail/compose"
"Compose new message\nThis button runs `mh-send'")
(mh-rescan-folder (folder) "refresh"
"Rescan this folder\nThis button runs `mh-rescan-folder'")
(mh-pack-folder (folder) "mail/repack"
"Repack this folder\nThis button runs `mh-pack-folder'")
(mh-tool-bar-search (folder) "search"
"Search\nThis button runs `mh-tool-bar-search-function'")
(mh-visit-folder (folder) "fld-open"
"Visit other folder\nThis button runs `mh-visit-folder'")
;; Letter buffer buttons
(mh-send-letter (letter) "mail/send" "Send this letter")
(mh-compose-insertion (letter) "attach" "Insert attachment")
(ispell-message (letter) "spell" "Check spelling")
(save-buffer (letter) "save" "Save current buffer to its file"
(buffer-modified-p))
(undo (letter) "undo" "Undo last operation")
(kill-region (letter) "cut"
"Cut (kill) text in region between mark and current position")
(menu-bar-kill-ring-save (letter) "copy"
"Copy text in region between mark and current position")
(yank (letter) "paste" "Paste (yank) text cut or copied earlier")
(mh-fully-kill-draft (letter) "close" "Kill this draft")
;; Common buttons
(mh-tool-bar-customize (folder letter) "preferences" "MH-E Preferences")
(mh-tool-bar-folder-help (folder) "help"
"Help! (general help)\nThis button runs `info'")
(mh-tool-bar-letter-help (letter) "help"
"Help! (general help)\nThis button runs `info'")
;; Folder narrowed to sequence buttons
(mh-widen (sequence) "widen"
"Widen from the sequence\nThis button runs `mh-widen'"))
(mh-page-msg (folder) "page-down" "Page the current message forwards
This button runs `mh-page-msg'")
(mh-next-undeleted-msg (folder) "right-arrow" "Go to the next undeleted message
The button runs `mh-next-undeleted-msg'")
(mh-delete-msg (folder) "close" "Mark this message for deletion
This button runs `mh-delete-msg'")
(mh-refile-msg (folder) "mail/refile" "Refile this message
This button runs `mh-refile-msg'")
(mh-undo (folder) "undo" "Undo last operation
This button runs `undo'"
(mh-outstanding-commands-p))
(mh-execute-commands (folder) "execute" "Perform moves and deletes
This button runs `mh-execute-commands'"
(mh-outstanding-commands-p))
(mh-toggle-tick (folder) "highlight" "Toggle tick mark
This button runs `mh-toggle-tick'")
(mh-toggle-showing (folder) "show" "Toggle showing message
This button runs `mh-toggle-showing'")
(mh-tool-bar-reply-from (folder) "mail/reply-from" "Reply to \"from\"")
(mh-tool-bar-reply-to (folder) "mail/reply-to" "Reply to \"to\"")
(mh-tool-bar-reply-all (folder) "mail/reply-all" "Reply to \"all\"")
(mh-reply (folder) "mail/reply" "Reply to this message
This button runs `mh-reply'")
(mh-alias-grab-from-field (folder) "mail/alias" "Grab From alias
This button runs `mh-alias-grab-from-field'"
(and (mh-extract-from-header-value)
(not (mh-alias-for-from-p))))
(mh-send (folder) "mail/compose" "Compose new message
This button runs `mh-send'")
(mh-rescan-folder (folder) "refresh" "Rescan this folder
This button runs `mh-rescan-folder'")
(mh-pack-folder (folder) "mail/repack" "Repack this folder
This button runs `mh-pack-folder'")
(mh-tool-bar-search (folder) "search" "Search
This button runs `mh-tool-bar-search-function'")
(mh-visit-folder (folder) "fld-open" "Visit other folder
This button runs `mh-visit-folder'")
;; Letter buffer buttons
(mh-send-letter (letter) "mail/send" "Send this letter")
(mh-compose-insertion (letter) "attach" "Insert attachment")
(ispell-message (letter) "spell" "Check spelling")
(save-buffer (letter) "save" "Save current buffer to its file"
(buffer-modified-p))
(undo (letter) "undo" "Undo last operation")
(kill-region (letter) "cut" "Cut (kill) text in region")
(menu-bar-kill-ring-save (letter) "copy" "Copy text in region")
(yank (letter) "paste" "Paste (yank) text cut or copied earlier")
(mh-fully-kill-draft (letter) "close" "Kill this draft")
;; Common buttons
(mh-tool-bar-customize (folder letter) "preferences" "MH-E Preferences")
(mh-tool-bar-folder-help (folder) "help" "Help! (general help)
This button runs `info'")
(mh-tool-bar-letter-help (letter) "help" "Help! (general help)
This button runs `info'")
;; Folder narrowed to sequence buttons
(mh-widen (sequence) "widen" "Widen from the sequence
This button runs `mh-widen'"))
(provide 'mh-tool-bar)
......
......@@ -81,69 +81,77 @@ 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-directory 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-directory'. If the images on your system are actually
located elsewhere, then set the variable `mh-image-directory'
before starting MH-E.
If `image-load-path' exists (since Emacs 22), then the contents
of the variable `mh-image-directory' is added to it if isn't
already there. Otherwise, the contents of the variable
`mh-image-directory' 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 (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'."
(unless library (error "No library specified"))
(unless image (error "No image specified"))
(let ((mh-image-directory))
(cond
(mh-image-directory) ; 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"))
;; Try relative setting.
((let (mh-library-name d1ei d2ei)
;; First, find library in the load-path.
(setq mh-library-name (locate-library library))
(if (not mh-library-name)
(error "Can not find MH-E in load-path"))
(error "Cannot find library %s in load-path" library))
;; And then set mh-image-directory relative to that.
(setq
;; Go down 2 levels.
d2ei (expand-file-name
(concat (file-name-directory mh-library-name)
"../../etc/images"))
;; Go down 1 level.
d1ei (expand-file-name
(concat (file-name-directory mh-library-name)
"../etc/images")))
(setq mh-image-directory
(expand-file-name (concat
(file-name-directory mh-library-name)
"../../etc/images")))
(file-exists-p (expand-file-name "mh-logo.xpm" mh-image-directory))))
((mh-image-search-load-path "mh-logo.xpm")
;; Images in image-load-path.
(setq mh-image-directory
(file-name-directory (mh-image-search-load-path "mh-logo.xpm"))))
((locate-library "mh-logo.xpm")
;; Images in load-path.
(setq mh-image-directory
(file-name-directory (locate-library "mh-logo.xpm")))))
(if (not (file-exists-p mh-image-directory))
(error "Directory %s in mh-image-directory does not exist"
mh-image-directory))
(if (not (file-exists-p
(expand-file-name "mh-logo.xpm" mh-image-directory)))
(error "Directory %s in mh-image-directory does not contain MH-E images"
mh-image-directory))
(if (boundp 'image-load-path)
(add-to-list 'image-load-path mh-image-directory)
(add-to-list 'load-path mh-image-directory))
(setq mh-image-load-path-called-flag t)))
;; 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 `mh-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 mh-image-directory dir))))))
;;
(unless (file-exists-p mh-image-directory)
(error "Directory %s in mh-image-directory does not exist"
mh-image-directory))
(unless (file-exists-p (expand-file-name image mh-image-directory))
(error "Directory %s in mh-image-directory does not contain image %s"
mh-image-directory image))
;; Return augmented `image-load-path' or `load-path'.
(cond ((and path (symbolp path))
(nconc (list mh-image-directory)
(delete mh-image-directory
(if (boundp path)
(copy-sequence (symbol-value path))
nil))))
(t
(nconc (list mh-image-directory)
(delete mh-image-directory
(copy-sequence load-path)))))))
;;;###mh-autoload
(defun mh-make-local-vars (&rest pairs)
......@@ -194,23 +202,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 "mh-e" "mh-logo.xpm" 'load-path))
(image-load-path
(mh-image-load-path "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")))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment