;;;###mh-autoload
(defmacro mh-do-in-xemacs (&rest body)
"Execute BODY if in XEmacs."
- (declare (debug t) (indent defun))
+ (declare (obsolete nil "29.1") (debug t) (indent defun))
(when (featurep 'xemacs) `(progn ,@body)))
;;;###mh-autoload
(mh-do-in-gnu-emacs
(defalias 'mh-require #'require))
-(mh-do-in-xemacs
- (defun mh-require (feature &optional filename noerror)
- "If feature FEATURE is not loaded, load it from FILENAME.
-If FEATURE is not a member of the list `features', then the feature
-is not loaded; so load the file FILENAME.
-If FILENAME is omitted, the printname of FEATURE is used as the file name.
-If the optional third argument NOERROR is non-nil,
-then return nil if the file is not found instead of signaling an error.
-
-Simulate NOERROR argument in XEmacs which lacks it."
- (if (not (featurep feature))
- (if filename
- (load filename noerror t)
- (load (format "%s" feature) noerror t)))))
-
(defun-mh mh-assoc-string assoc-string (key list case-fold)
"Like `assoc' but specifically for strings.
Case is ignored if CASE-FOLD is non-nil.
(require 'mh-buffers)
(require 'mh-compat)
-(mh-do-in-xemacs
- (require 'mh-xemacs))
-
(mh-font-lock-add-keywords
'emacs-lisp-mode
(eval-when-compile
;; The bug wasn't seen in emacs21 but still occurred in XEmacs21.4.
(mh-exchange-point-and-mark-preserving-active-mark))
-;; Shush compiler.
-(mh-do-in-xemacs
- (defvar mark-active))
-
(defun mh-exchange-point-and-mark-preserving-active-mark ()
"Put the mark where point is now, and point where the mark is now.
This command works even when the mark is not active, and
:group 'mh-tool-bar
:package-version '(MH-E . "7.0"))
-;; XEmacs has a couple of extra customizations...
-(mh-do-in-xemacs
- (defcustom-mh mh-xemacs-use-tool-bar-flag mh-xemacs-has-tool-bar-flag
- "If non-nil, use tool bar.
-
-This option controls whether to show the MH-E icons at all. By
-default, this option is turned on if the window system supports
-tool bars. If your system doesn't support tool bars, then you
-won't be able to turn on this option."
- :type 'boolean
- :group 'mh-tool-bar
- :set (lambda (symbol value)
- (if (and (eq value t)
- (not mh-xemacs-has-tool-bar-flag))
- (error "Tool bar not supported"))
- (set-default symbol value))
- :package-version '(MH-E . "7.3"))
-
- (defcustom-mh mh-xemacs-tool-bar-position nil
- "Tool bar location.
-
-This option controls the placement of the tool bar along the four
-edges of the frame. You can choose from one of \"Same As Default
-Tool Bar\", \"Top\", \"Bottom\", \"Left\", or \"Right\". If this
-variable is set to anything other than \"Same As Default Tool
-Bar\" and the default tool bar is in a different location, then
-two tool bars will be displayed: the MH-E tool bar and the
-default tool bar."
- :type '(radio (const :tag "Same As Default Tool Bar" :value nil)
- (const :tag "Top" :value top)
- (const :tag "Bottom" :value bottom)
- (const :tag "Left" :value left)
- (const :tag "Right" :value right))
- :group 'mh-tool-bar
- :package-version '(MH-E . "7.3")))
-
\f
;;; Hooks (:group 'mh-hooks + group where hook described)
;; Shush compiler.
(defvar desktop-save-buffer)
(defvar font-lock-auto-fontify)
-(mh-do-in-xemacs
- (defvar font-lock-defaults))
;; Ensure new buffers won't get this mode if default major-mode is nil.
(put 'mh-folder-mode 'mode-class 'special)
(mh-tool-bar-folder-buttons-init))
(if (boundp 'tool-bar-map)
(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)
(mh-funcall-if-exists hl-line-mode 1)
(setq revert-buffer-function #'mh-undo-folder)
(add-to-list 'minor-mode-alist '(mh-showing-mode " Show"))
- (mh-do-in-xemacs
- (easy-menu-add mh-folder-sequence-menu)
- (easy-menu-add mh-folder-message-menu)
- (easy-menu-add mh-folder-folder-menu))
(mh-inc-spool-make)
(mh-set-help mh-folder-mode-help-messages)
(if (and (featurep 'xemacs)
(defun mh-identity-add-menu ()
"Add the current Identity menu.
See `mh-identity-make-menu'."
- (if mh-identity-menu
- (mh-do-in-xemacs (easy-menu-add mh-identity-menu))))
+ (declare (obsolete nil "29.1"))
+ nil)
(defvar mh-identity-local nil
"Buffer-local variable that holds the identity currently in use.")
;;; MH-Letter Mode
-;; Shush compiler.
-(mh-do-in-xemacs
- (defvar font-lock-defaults))
-
;; Ensure new buffers won't get this mode if default major-mode is nil.
(put 'mh-letter-mode 'mode-class 'special)
(mh-tool-bar-letter-buttons-init))
(if (boundp 'tool-bar-map)
(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)
(t
;; ...or the header only
(setq font-lock-defaults '((mh-show-font-lock-keywords) t))))
- (mh-do-in-xemacs (easy-menu-add mh-letter-menu))
;; Maybe we want to use the existing Mail menu from mail-mode in
;; 9.0; in the mean time, let's remove it since the redundancy will
;; only produce confusion.
(define-key mh-letter-mode-map [menu-bar mail] #'undefined)
- (mh-do-in-xemacs (easy-menu-remove mail-menubar-menu))
(setq fill-column mh-letter-fill-column)
(add-hook 'completion-at-point-functions
#'mh-letter-completion-at-point nil 'local)
(set-keymap-parent map mh-show-mode-map))
(mh-do-in-gnu-emacs
(define-key map [mouse-2] #'mh-push-button))
- (mh-do-in-xemacs
- (define-key map '(button2) #'mh-push-button))
(dolist (c mh-mime-button-commands)
(define-key map (cadr c) (car c)))
map))
(define-key map "\r" #'mh-press-button)
(mh-do-in-gnu-emacs
(define-key map [mouse-2] #'mh-push-button))
- (mh-do-in-xemacs
- (define-key map '(button2) #'mh-push-button))
map))
\f
; this only tells us if the image is
; something that emacs can display
(let ((image (mm-get-image handle)))
- (or (mh-do-in-xemacs
- (and (mh-funcall-if-exists glyphp image)
- (< (glyph-width image)
- (or mh-max-inline-image-width (window-pixel-width)))
- (< (glyph-height image)
- (or mh-max-inline-image-height
- (window-pixel-height)))))
- (mh-do-in-gnu-emacs
- (let ((size (and (fboundp 'image-size) (image-size image))))
- (and size
- (< (cdr size) (or mh-max-inline-image-height
- (1- (window-height))))
- (< (car size) (or mh-max-inline-image-width
- (window-width)))))))))))
+ (mh-do-in-gnu-emacs
+ (let ((size (and (fboundp 'image-size) (image-size image))))
+ (and size
+ (< (cdr size) (or mh-max-inline-image-height
+ (1- (window-height))))
+ (< (car size) (or mh-max-inline-image-width
+ (window-width))))))))))
(defun mh-inline-vcard-p (handle)
"Decide if HANDLE is a vcard that must be displayed inline."
(mh-do-in-gnu-emacs
(let ((ov (make-overlay (point) (point-max))))
(overlay-put ov 'face 'mh-show-signature)
- (overlay-put ov 'evaporate t)))
- (mh-do-in-xemacs
- (set-extent-property (make-extent (point) (point-max))
- 'face 'mh-show-signature))))))
+ (overlay-put ov 'evaporate t)))))))
\f
;;; Button Display
-;; Shush compiler.
-(mh-do-in-xemacs
- (defvar ov))
-
(defun mh-insert-mime-button (handle index displayed)
"Insert MIME button for HANDLE.
INDEX is the part number that will be DISPLAYED. It is also used
(cl-loop for msg-hash being the hash-values of mh-index-data
count (> (hash-table-count msg-hash) 0)))))))
-;; Shush compiler.
-(mh-do-in-xemacs
- (defvar pick-folder)) ;FIXME: Why?
-
(defun mh-search-folder (folder window-config)
"Search FOLDER for messages matching a pattern.
\\{mh-search-mode-map}"
- (mh-do-in-xemacs (easy-menu-add mh-pick-menu))
(mh-set-help mh-search-mode-help-messages))
\f
" "))))
;; Shush compiler.
-(mh-do-in-xemacs
- (defvar tool-bar-mode))
(defvar tool-bar-map)
;;;###mh-autoload
(mh-do-in-gnu-emacs
(if (boundp 'tool-bar-map)
(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))
(setq buffer-invisibility-spec '((vanish . t) t))
(when mh-decode-mime-flag
(mh-make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook #'mh-mime-cleanup nil t))
- (mh-do-in-xemacs
- (easy-menu-add mh-show-sequence-menu)
- (easy-menu-add mh-show-message-menu)
- (easy-menu-add mh-show-folder-menu))
(make-local-variable 'mh-show-folder-buffer)
(buffer-disable-undo)
(use-local-map mh-show-mode-map))
(require 'mh-e)
(mh-do-in-gnu-emacs
(require 'tool-bar))
-(mh-do-in-xemacs
- (require 'toolbar))
;;; Tool Bar Commands
(let* ((name (nth 0 button))
(name-str (symbol-name name))
(icon (nth 2 button))
- (xemacs-icon (mh-do-in-xemacs
- `(cdr (assoc (quote ,(intern icon)) mh-xemacs-icon-map))))
(full-doc (nth 3 button))
(doc (if (string-match "\\(.*\\)\n" full-doc)
(match-string 1 full-doc)
(t 'folder-buttons)))
(docs (cond ((eq mbuttons 'letter-buttons) 'letter-docs)
((eq mbuttons 'folder-buttons) 'folder-docs))))
- (add-to-list vector-list `(vector ,xemacs-icon ',function t ,full-doc))
+ (add-to-list vector-list `(vector nil ',function t ,full-doc))
(add-to-list
setter `(when (member ',name ,list)
(mh-funcall-if-exists
(mh-tool-bar-letter-buttons-init)
(mh-tool-bar-update 'mh-letter-mode mh-letter-tool-bar-map
mh-letter-tool-bar-map)))
- ;; XEmacs specific code
- (mh-do-in-xemacs
- (defvar mh-tool-bar-folder-vector-map
- (list ,@(cl-loop for button in folder-buttons
- for vector in folder-vectors
- collect `(cons ',button ,vector))))
- (defvar mh-tool-bar-show-vector-map
- (list ,@(cl-loop for button in show-buttons
- for vector in show-vectors
- collect `(cons ',button ,vector))))
- (defvar mh-tool-bar-letter-vector-map
- (list ,@(cl-loop for button in letter-buttons
- for vector in letter-vectors
- collect `(cons ',button ,vector))))
- (defvar mh-tool-bar-folder-buttons)
- (defvar mh-tool-bar-show-buttons)
- (defvar mh-tool-bar-letter-buttons)
- ;; Custom setter functions
- (defun mh-tool-bar-letter-buttons-set (symbol value)
- (set-default symbol value)
- (when mh-xemacs-has-tool-bar-flag
- (setq mh-tool-bar-letter-buttons
- (cl-loop
- for b in value
- collect (cdr (assoc b mh-tool-bar-letter-vector-map))))))
- (defun mh-tool-bar-folder-buttons-set (symbol value)
- (set-default symbol value)
- (when mh-xemacs-has-tool-bar-flag
- (setq mh-tool-bar-folder-buttons
- (cl-loop
- for b in value
- collect (cdr (assoc b mh-tool-bar-folder-vector-map))))
- (setq mh-tool-bar-show-buttons
- (cl-loop
- for b in value
- collect (cdr (assoc b mh-tool-bar-show-vector-map))))))
- (defun mh-tool-bar-init (mode)
- "Install tool bar in MODE."
- (when mh-xemacs-use-tool-bar-flag
- (let ((tool-bar (cond ((eq mode :folder)
- mh-tool-bar-folder-buttons)
- ((eq mode :letter)
- mh-tool-bar-letter-buttons)
- ((eq mode :show)
- mh-tool-bar-show-buttons)))
- (height 37)
- (width 40)
- (buffer (current-buffer)))
- (cond
- ((eq mh-xemacs-tool-bar-position 'top)
- (set-specifier top-toolbar tool-bar buffer)
- (set-specifier top-toolbar-visible-p t)
- (set-specifier top-toolbar-height height))
- ((eq mh-xemacs-tool-bar-position 'bottom)
- (set-specifier bottom-toolbar tool-bar buffer)
- (set-specifier bottom-toolbar-visible-p t)
- (set-specifier bottom-toolbar-height height))
- ((eq mh-xemacs-tool-bar-position 'left)
- (set-specifier left-toolbar tool-bar buffer)
- (set-specifier left-toolbar-visible-p t)
- (set-specifier left-toolbar-width width))
- ((eq mh-xemacs-tool-bar-position 'right)
- (set-specifier right-toolbar tool-bar buffer)
- (set-specifier right-toolbar-visible-p t)
- (set-specifier right-toolbar-width width))
- (t (set-specifier default-toolbar tool-bar buffer)))))))
;; Declare customizable tool bars
(custom-declare-variable
'mh-tool-bar-folder-buttons
;;:package-version '(MH-E "7.1")
))))
-;; The icon names are duplicated in the Makefile and mh-xemacs.el.
(mh-tool-bar-define
((:folder mh-inc-folder mh-mime-save-parts
mh-previous-undeleted-msg mh-page-msg
(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")))))
+ (car mode-line-buffer-identification)))))
\f
(let ((map (make-sparse-keymap)))
(mh-do-in-gnu-emacs
(define-key map [mouse-2] #'mh-letter-toggle-header-field-display-button))
- (mh-do-in-xemacs
- (define-key map '(button2)
- #'mh-letter-toggle-header-field-display-button))
map))
;;;###mh-autoload
(mh-face-foreground 'mh-show-xface nil t)
:background
(mh-face-background 'mh-show-xface nil t))
- " ")))
- ;; XEmacs
- (mh-do-in-xemacs
- (cond
- ((eq type 'url)
- (mh-x-image-url-display url))
- ((eq type 'png)
- (when (featurep 'png)
- (set-extent-begin-glyph
- (make-extent (point) (point))
- (make-glyph (vector 'png ':data (mh-face-to-png face))))))
- ;; Try internal xface support if available...
- ((and (eq type 'pbm) (featurep 'xface))
- (set-glyph-face
- (set-extent-begin-glyph
- (make-extent (point) (point))
- (make-glyph (vector 'xface ':data (concat "X-Face: " x-face))))
- 'mh-show-xface))
- ;; Otherwise try external support with x-face...
- ((and (eq type 'pbm)
- (fboundp 'x-face-xmas-wl-display-x-face)
- (fboundp 'executable-find) (executable-find "uncompface"))
- (mh-funcall-if-exists x-face-xmas-wl-display-x-face))
- ;; Picon display
- ((and raw (member type '(xpm xbm gif)))
- (when (featurep type)
- (set-extent-begin-glyph
- (make-extent (point) (point))
- (make-glyph (vector type ':data raw))))))
- (when raw (insert " "))))))))
+ " "))))))))
(defun mh-face-to-png (data)
"Convert base64 encoded DATA to png image."
(cl-loop for type in '(xpm xbm gif)
when (or (mh-do-in-gnu-emacs
(ignore-errors
- (mh-funcall-if-exists image-type-available-p type)))
- (mh-do-in-xemacs (featurep type)))
+ (mh-funcall-if-exists image-type-available-p type))))
collect type))
(autoload 'message-tokenize-header "sendmail")
(eq marker mh-x-image-marker))
(goto-char marker)
(mh-do-in-gnu-emacs
- (mh-funcall-if-exists insert-image (create-image image 'png)))
- (mh-do-in-xemacs
- (when (featurep 'png)
- (set-extent-begin-glyph
- (make-extent (point) (point))
- (make-glyph
- (vector 'png ':data (with-temp-buffer
- (insert-file-contents-literally image)
- (buffer-string))))))))
+ (mh-funcall-if-exists insert-image (create-image image 'png))))
(set-buffer-modified-p buffer-modified-flag)))))
(defun mh-x-image-url-fetch-image (url cache-file marker sentinel)
projects / emacs.git / commitdiff