[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/vm b42345ac0e 6/6: Merge branch 'fix-version-warnings' int
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/vm b42345ac0e 6/6: Merge branch 'fix-version-warnings' into 'main' |
|
Date: |
Wed, 17 Jul 2024 13:01:49 -0400 (EDT) |
branch: elpa/vm
commit b42345ac0eca4f0b9bd76465285cf5572d458d8f
Merge: 9aa3a94cd3 35d7b1d4ab
Author: Mark Diekhans <markd@ucsc.edu>
Commit: Mark Diekhans <markd@ucsc.edu>
Merge branch 'fix-version-warnings' into 'main'
Fix some warnings related to Emacs versions
See merge request emacs-vm/vm!10
---
contrib/vm-sumurg.el | 69 ++--
lisp/vm-avirtual.el | 4 +-
lisp/vm-biff.el | 14 +-
lisp/vm-edit.el | 2 +-
lisp/vm-grepmail.el | 4 +-
lisp/vm-imap.el | 2 +-
lisp/vm-macro.el | 8 +-
lisp/vm-menu.el | 785 ++++++++++++++++++++-------------------------
lisp/vm-message-history.el | 7 +-
lisp/vm-mime.el | 488 +++++++++++++---------------
lisp/vm-minibuf.el | 12 +-
lisp/vm-misc.el | 90 +++---
lisp/vm-mouse.el | 40 +--
lisp/vm-page.el | 98 ++----
lisp/vm-pcrisis.el | 16 +-
lisp/vm-pgg.el | 4 +-
lisp/vm-pine.el | 8 +-
lisp/vm-pop.el | 4 +-
lisp/vm-reply.el | 12 +-
lisp/vm-rfaddons.el | 8 +-
lisp/vm-save.el | 2 +-
lisp/vm-serial.el | 14 +-
lisp/vm-summary-faces.el | 2 +-
lisp/vm-summary.el | 17 +-
lisp/vm-toolbar.el | 6 +-
lisp/vm-undo.el | 4 +-
lisp/vm-vars.el | 59 +---
lisp/vm-version.el | 83 +----
lisp/vm-window.el | 12 +-
lisp/vm.el | 30 +-
30 files changed, 799 insertions(+), 1105 deletions(-)
diff --git a/contrib/vm-sumurg.el b/contrib/vm-sumurg.el
index 6fd4875683..054f23cd87 100644
--- a/contrib/vm-sumurg.el
+++ b/contrib/vm-sumurg.el
@@ -179,7 +179,7 @@
;; this fails with virtual folders: the modeline in the frame
;; of the original folder isn't updated.
;; I can see absolutely no non-horrible solution to this.
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(set-face-foreground 'modeline
(aref vm-sumurg-colarray maxl)
(selected-frame)))))
@@ -193,7 +193,7 @@
(if (> level 0)
(progn
(aset vm-sumurg-counter level (1+ (aref vm-sumurg-counter level)))
- (cond (vm-xemacs-p
+ (cond ((featurep 'xemacs)
;; re-use extents, and delete them when not required
(let ((e (extent-at (/ (+ start end))
(current-buffer) 'vm-sumurg)))
@@ -210,14 +210,14 @@
)
(set-extent-property e 'face
(aref vm-sumurg-facearray level))))
- (vm-fsfemacs-p
+ ((not (featurep 'xemacs))
;; why 1- ? Because then the overlay gets deleted by
;; the process of summary update.
(let ((e (make-overlay start (1- end))))
(overlay-put e 'evaporate t)
(overlay-put e 'face (aref vm-sumurg-facearray level))))))
;; level 0: emacs, delete the extent
- (cond (vm-xemacs-p
+ (cond ((featurep 'xemacs)
(let ((e (extent-at (/ (+ start end))
(current-buffer) 'vm-sumurg)))
(if e (delete-extent e))))))
@@ -316,34 +316,33 @@
(if (> time (* 7 86400)) (setq time (* 7 86400)))
(message "setting timer on msg %s in %.0f seconds"
(vm-su-message-id m) time)
- (add-timeout time
- (lambda (arg)
- (when (buffer-live-p (car arg))
- (save-excursion
- (set-buffer (car arg))
- (let ((mp vm-message-list))
- (while (and mp
- (not (equal
- (vm-message-id-of
- (car mp))
- (cadr arg))))
- (setq mp (cdr mp)))
- (if mp
- (vm-sumurg-check-future (car mp))))
- (vm-follow-summary-cursor)
- (vm-select-folder-buffer)
- (intern (buffer-name)
-
vm-buffers-needing-display-update)
- (vm-update-summary-and-mode-line))))
- (list (current-buffer) (vm-su-message-id m)))
- ))
+ (run-with-timer
+ time nil
+ (lambda (buf msg-id)
+ (when (buffer-live-p buf)
+ (with-current-buffer buf
+ (let ((mp vm-message-list))
+ (while (and mp
+ (not (equal
+ (vm-message-id-of
+ (car mp))
+ msg-id)))
+ (setq mp (cdr mp)))
+ (if mp
+ (vm-sumurg-check-future (car mp))))
+ (vm-follow-summary-cursor)
+ (vm-select-folder-buffer)
+ (intern (buffer-name)
+ vm-buffers-needing-display-update)
+ (vm-update-summary-and-mode-line))))
+ (current-buffer) (vm-su-message-id m))))
)))
(vm-labels-of m))
)
(defconst vm-sumurg-pending-extent
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(let ((e (make-extent nil nil))
(k (make-sparse-keymap)))
(set-extent-face e 'vm-sumurg-pending-face)
@@ -355,7 +354,7 @@
)))
(defconst vm-sumurg-urgent-extent
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(let ((e (make-extent nil nil))
(k (make-sparse-keymap)))
(set-extent-face e 'vm-sumurg-urgent-face)
@@ -367,7 +366,7 @@
)))
(defconst vm-sumurg-veryurgent-extent
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(let ((e (make-extent nil nil))
(k (make-sparse-keymap)))
(set-extent-face e 'vm-sumurg-veryurgent-face)
@@ -381,7 +380,7 @@
(defconst vm-sumurg-rightnow-extent
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(let ((e (make-extent nil nil))
(k (make-sparse-keymap)))
(set-extent-face e 'vm-sumurg-rightnow-face)
@@ -395,7 +394,7 @@
(defconst vm-sumurg-comp-extent
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(let ((e (make-extent nil nil))
(k (make-sparse-keymap)))
(set-extent-face e 'vm-sumurg-comp-face)
@@ -410,7 +409,7 @@
; modeline element for xemacs
(defvar vm-sumurg-modeline-element
- (cond (vm-xemacs-p
+ (cond ((featurep 'xemacs)
(list
(list 'vm-sumurg-modeline-comp
(list vm-sumurg-comp-extent ""
@@ -427,7 +426,7 @@
(list 'vm-sumurg-modeline-rightnow
(list vm-sumurg-rightnow-extent ""
'vm-sumurg-modeline-rightnow))))
- (vm-fsfemacs-p
+ ((not (featurep 'xemacs))
(list
(list 'vm-sumurg-modeline-comp
(list "" 'vm-sumurg-modeline-comp))
@@ -444,7 +443,7 @@
; stick it at the end
(add-hook 'vm-summary-mode-hook
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(lambda ()
(setq vm-sumurg-counter (vector 0 0 0 0 0))
(if (memq vm-sumurg-modeline-element modeline-format)
@@ -551,7 +550,7 @@
(set-face-background 'vm-sumurg-rightnow-face "magenta"))
(setq vm-sumurg-blinker-blink t)
(set-face-background 'vm-sumurg-rightnow-face "cyan"))
- (disable-timeout vm-sumurg-blinker-timeout-id)
+ (cancel-timer vm-sumurg-blinker-timeout-id)
(setq vm-sumurg-blinker-timeout-id nil)
(setq vm-sumurg-blinker-blink nil)
(set-face-background 'vm-sumurg-rightnow-face "magenta")))
@@ -561,7 +560,7 @@
(if (and vm-sumurg-blinker-in-focus
(null vm-sumurg-blinker-timeout-id))
(setq vm-sumurg-blinker-timeout-id
- (add-timeout 1 'vm-sumurg-blinker-callback nil 1))))
+ (run-with-timer 1 1 #'vm-sumurg-blinker-callback))))
(defun vm-sumurg-blinker-deselect-frame-hook ()
(setq vm-sumurg-blinker-in-focus nil))
(defun vm-sumurg-blinker-enable ()
diff --git a/lisp/vm-avirtual.el b/lisp/vm-avirtual.el
index 4d8d8f5335..509f8a5c51 100644
--- a/lisp/vm-avirtual.el
+++ b/lisp/vm-avirtual.el
@@ -94,7 +94,7 @@
;; ;; HTML only messages
;; (header "^Content-Type: text/html")
;; ;; for 8bit encoding "chinese" spam
-;; (header "[�-�][�-�][�-�][�-�]")
+;; (header "[¡-ÿ][¡-ÿ][¡-ÿ][¡-ÿ]")
;; ;; for qp-encoding "chinese" spam
;; (header
"=[A-F][0-9A-F]=[A-F][0-9A-F]=[A-F][0-9A-F]=[A-F][0-9A-F]=[A-F][0-9A-F]")
;; ))))))
@@ -717,7 +717,7 @@ format:
(setq selector (vm-virtual-get-selector
(vm-read-string "Virtual folder: "
vm-virtual-folder-alist)))
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(setq function
(key-or-menu-binding (read-key-sequence "VM command: ")))
(setq function
diff --git a/lisp/vm-biff.el b/lisp/vm-biff.el
index fb40f5596f..39558533c7 100644
--- a/lisp/vm-biff.el
+++ b/lisp/vm-biff.el
@@ -65,10 +65,10 @@
(start end &optional overlay))
(declare-function vm-summary-faces-add "vm-summary-faces" (message))
-(when vm-xemacs-p
+(when (featurep 'xemacs)
(require 'overlay))
-(when vm-fsfemacs-p
+(when (not (featurep 'xemacs))
(defvar horizontal-scrollbar-visible-p nil))
; group already defined in vm-vars.el
@@ -246,12 +246,12 @@ folder selectors work."
(defvar vm-biff--folder-window nil)
(defun vm-biff-x-p ()
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(memq (console-type) '(x mswindows))
t))
(defun vm-biff-get-buffer-window (buf)
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(vm-get-buffer-window buf (vm-biff-x-p) (frame-device))
(vm-get-buffer-window buf (vm-biff-x-p))))
@@ -464,7 +464,7 @@ AddToFunc SelectWindow
(cons (cons 'popup ff)
vm-biff-frame-properties)
vm-biff-frame-properties))
- (mf (or (and (if vm-xemacs-p
+ (mf (or (and (if (featurep 'xemacs)
(vm-get-buffer-window buf t
(frame-device))
(vm-get-buffer-window buf t))
@@ -474,7 +474,7 @@ AddToFunc SelectWindow
(select-frame mf)
(switch-to-buffer buf)
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(set-specifier horizontal-scrollbar-visible-p nil))
(if (functionp vm-biff-place-frame-function)
@@ -498,7 +498,7 @@ AddToFunc SelectWindow
(switch-to-buffer buf)
(if (> h vm-biff-max-height)
(setq h vm-biff-max-height))
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(setq h (- (window-displayed-height) h))
(setq h (- (window-height) h)))
(if (not (one-window-p))
diff --git a/lisp/vm-edit.el b/lisp/vm-edit.el
index 7e2acaface..de65f6008f 100644
--- a/lisp/vm-edit.el
+++ b/lisp/vm-edit.el
@@ -80,7 +80,7 @@ replace the original, use C-c C-] and the edit will be
aborted."
(format "edit of %s's note re: %s"
(vm-su-full-name (car vm-message-pointer))
(vm-su-subject (car vm-message-pointer)))))
- (if vm-fsfemacs-mule-p
+ (if (not (featurep 'xemacs))
(set-buffer-multibyte nil)) ; for new buffer
(vm-set-edit-buffer-of (car mp) edit-buf)
(copy-to-buffer edit-buf
diff --git a/lisp/vm-grepmail.el b/lisp/vm-grepmail.el
index 26a4261914..45d73c3238 100644
--- a/lisp/vm-grepmail.el
+++ b/lisp/vm-grepmail.el
@@ -89,7 +89,7 @@
(defvar vm-grepmail-folder-buffer nil)
-(if vm-fsfemacs-p
+(if (not (featurep 'xemacs))
;; For sixth arg of read-file-name in Emacs 21. cf vm-folder-history.
(defun vm-grepmail-folders-history (&rest ignored) t))
@@ -185,7 +185,7 @@ FOLDERS should be a list of files/directories to search in."
(if (null process)
(error "Cannot start grepmail"))
;; set the send-filter
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix))
(set-process-filter process 'vm-grepmail-process-filter)
(set-process-sentinel process 'vm-grepmail-process-done)
diff --git a/lisp/vm-imap.el b/lisp/vm-imap.el
index 81d483b395..d5c6f207be 100644
--- a/lisp/vm-imap.el
+++ b/lisp/vm-imap.el
@@ -200,7 +200,7 @@ using cached data."
(defun vm-imap-start-status-timer ()
(let ((blob (make-vector 12 nil))
timer)
- (setq timer (add-timeout 2 'vm-imap-report-retrieval-status blob 2))
+ (setq timer (run-with-timer 2 2 #'vm-imap-report-retrieval-status blob))
(vm-set-imap-status-timer blob timer)
blob ))
diff --git a/lisp/vm-macro.el b/lisp/vm-macro.el
index 2edea5bbdf..c1a82d78e6 100644
--- a/lisp/vm-macro.el
+++ b/lisp/vm-macro.el
@@ -174,13 +174,13 @@ current-buffer in `vm-user-interaction-buffer'."
(vm-build-threads nil)))
(defsubst vm-binary-coding-system ()
- (cond (vm-xemacs-mule-p 'binary)
- (vm-xemacs-file-coding-p 'binary)
+ (cond ((featurep 'xemacs) 'binary)
+ ((featurep 'xemacs) 'binary)
(t 'no-conversion)))
(defsubst vm-line-ending-coding-system ()
- (cond (vm-xemacs-mule-p 'no-conversion)
- (vm-xemacs-file-coding-p 'no-conversion)
+ (cond ((featurep 'xemacs) 'no-conversion)
+ ((featurep 'xemacs) 'no-conversion)
(t 'raw-text)))
;;; can't use defsubst where quoting is needed in some places but
diff --git a/lisp/vm-menu.el b/lisp/vm-menu.el
index 14d7adfebf..1b91dbd146 100644
--- a/lisp/vm-menu.el
+++ b/lisp/vm-menu.el
@@ -59,8 +59,6 @@
(require 'vm-mime)
(require 'vm-delete)
- (defvar current-menubar nil))
-
(declare-function event-window "vm-xemacs" (event))
(declare-function event-point "vm-xemacs" (event))
(declare-function popup-mode-menu "vm-xemacs" (&optional event))
@@ -102,7 +100,7 @@
(defconst vm-menu-folder-menu
`("Folder"
- ,(if vm-fsfemacs-p
+ ,(if (not (featurep 'xemacs))
["Manipulate Folders" ignore (ignore)]
vm-menu-folders-menu)
"---"
@@ -139,39 +137,33 @@
))
(defconst vm-menu-dispose-menu
- (let ((title (if (vm-menu-fsfemacs19-menus-p)
- (list "Dispose"
- "Dispose"
- "---"
- "---")
- (list "Dispose"))))
- `(,@title
- ["Reply to Author" vm-reply vm-message-list]
- ["Reply to All" vm-followup vm-message-list]
- ["Reply to Author (citing original)" vm-reply-include-text
- vm-message-list]
- ["Reply to All (citing original)" vm-followup-include-text
- vm-message-list]
- ["Forward" vm-forward-message vm-message-list]
- ["Forward in Plain Text" vm-forward-message-plain vm-message-list]
- ["Resend" vm-resend-message vm-message-list]
- ["Retry Bounce" vm-resend-bounced-message vm-message-list]
- "---"
- ["File" vm-save-message vm-message-list]
- ["Delete" vm-delete-message vm-message-list]
- ["Undelete" vm-undelete-message vm-message-list]
- ["Flag/Unflag" vm-toggle-flag-message]
- ["Kill Current Subject" vm-kill-subject vm-message-list]
- ["Mark Unread" vm-mark-message-unread vm-message-list]
- ["Edit" vm-edit-message vm-message-list]
- ["Print" vm-print-message vm-message-list]
- ["Pipe to Command" vm-pipe-message-to-command vm-message-list]
- ["Attach to Message Composition"
- vm-attach-message-to-composition vm-message-list]
- "---"
- ["Burst Message as Digest" (vm-burst-digest "guess") vm-message-list]
- ["Decode MIME" vm-decode-mime-message (vm-menu-can-decode-mime-p)]
- )))
+ '("Dispose"
+ ["Reply to Author" vm-reply vm-message-list]
+ ["Reply to All" vm-followup vm-message-list]
+ ["Reply to Author (citing original)" vm-reply-include-text
+ vm-message-list]
+ ["Reply to All (citing original)" vm-followup-include-text
+ vm-message-list]
+ ["Forward" vm-forward-message vm-message-list]
+ ["Forward in Plain Text" vm-forward-message-plain vm-message-list]
+ ["Resend" vm-resend-message vm-message-list]
+ ["Retry Bounce" vm-resend-bounced-message vm-message-list]
+ "---"
+ ["File" vm-save-message vm-message-list]
+ ["Delete" vm-delete-message vm-message-list]
+ ["Undelete" vm-undelete-message vm-message-list]
+ ["Flag/Unflag" vm-toggle-flag-message]
+ ["Kill Current Subject" vm-kill-subject vm-message-list]
+ ["Mark Unread" vm-mark-message-unread vm-message-list]
+ ["Edit" vm-edit-message vm-message-list]
+ ["Print" vm-print-message vm-message-list]
+ ["Pipe to Command" vm-pipe-message-to-command vm-message-list]
+ ["Attach to Message Composition"
+ vm-attach-message-to-composition vm-message-list]
+ "---"
+ ["Burst Message as Digest" (vm-burst-digest "guess") vm-message-list]
+ ["Decode MIME" vm-decode-mime-message (vm-menu-can-decode-mime-p)]
+ ))
(defconst vm-menu-motion-menu
'("Motion"
@@ -358,188 +350,154 @@ do not allow menubar buttons.")
)
(defconst vm-menu-mail-menu
- (let ((title (if (vm-menu-fsfemacs19-menus-p)
- (list "Mail Commands"
- "Mail Commands"
- "---"
- "---")
- (list "Mail Commands"))))
- `(,@title
- ["Send and Exit" vm-mail-send-and-exit (vm-menu-can-send-mail-p)]
- ["Send, Keep Composing" vm-mail-send (vm-menu-can-send-mail-p)]
- ["Cancel" kill-buffer t]
- "----"
- ["Yank Original" vm-menu-yank-original vm-reply-list]
- "----"
- (
- ,@(if (vm-menu-fsfemacs19-menus-p)
- (list "Send Using MIME..."
- "Send Using MIME..."
- "---"
- "---")
- (list "Send Using MIME..."))
- ["Use MIME"
- (progn (set (make-local-variable 'vm-send-using-mime) t)
- (vm-mail-mode-remove-tm-hooks))
- :active t
- :style radio
- :selected vm-send-using-mime]
- ["Don't use MIME"
- (set (make-local-variable 'vm-send-using-mime) nil)
- :active t
- :style radio
- :selected (not vm-send-using-mime)])
- (
- ,@(if (vm-menu-fsfemacs19-menus-p)
- (list "Fragment Messages Larger Than ..."
- "Fragment Messages Larger Than ..."
- "---"
- "---")
- (list "Fragment Messages Larger Than ..."))
- ["Infinity, i.e., don't fragment"
- (set (make-local-variable 'vm-mime-max-message-size) nil)
- :active vm-send-using-mime
- :style radio
- :selected (eq vm-mime-max-message-size nil)]
- ["50000 bytes"
- (set (make-local-variable 'vm-mime-max-message-size)
- 50000)
- :active vm-send-using-mime
- :style radio
- :selected (eq vm-mime-max-message-size 50000)]
- ["100000 bytes"
- (set (make-local-variable 'vm-mime-max-message-size)
- 100000)
- :active vm-send-using-mime
- :style radio
- :selected (eq vm-mime-max-message-size 100000)]
- ["200000 bytes"
- (set (make-local-variable 'vm-mime-max-message-size)
- 200000)
- :active vm-send-using-mime
- :style radio
- :selected (eq vm-mime-max-message-size 200000)]
- ["500000 bytes"
- (set (make-local-variable 'vm-mime-max-message-size)
- 500000)
- :active vm-send-using-mime
- :style radio
- :selected (eq vm-mime-max-message-size 500000)]
- ["1000000 bytes"
- (set (make-local-variable 'vm-mime-max-message-size)
- 1000000)
- :active vm-send-using-mime
- :style radio
- :selected (eq vm-mime-max-message-size 1000000)]
- ["2000000 bytes"
- (set (make-local-variable 'vm-mime-max-message-size)
- 2000000)
- :active vm-send-using-mime
- :style radio
- :selected (eq vm-mime-max-message-size 2000000)])
- (
- ,@(if (vm-menu-fsfemacs19-menus-p)
- (list "Encode 8-bit Characters Using ..."
- "Encode 8-bit Characters Using ..."
- "---"
- "---")
- (list "Encode 8-bit Characters Using ..."))
- ["Nothing, i.e., send unencoded"
- (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
- '8bit)
- :active vm-send-using-mime
- :style radio
- :selected (eq vm-mime-8bit-text-transfer-encoding '8bit)]
- ["Quoted-Printable"
- (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
- 'quoted-printable)
- :active vm-send-using-mime
- :style radio
- :selected (eq vm-mime-8bit-text-transfer-encoding
- 'quoted-printable)]
- ["BASE64"
- (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
- 'base64)
- :active vm-send-using-mime
- :style radio
- :selected (eq vm-mime-8bit-text-transfer-encoding 'base64)])
- "----"
- ["Attach File..." vm-attach-file vm-send-using-mime]
- ["Attach MIME Message..." vm-attach-mime-file vm-send-using-mime]
- ["Encode MIME, But Don't Send" vm-mime-encode-composition
- (and vm-send-using-mime
- (null (vm-mail-mode-get-header-contents "MIME-Version:")))]
- ["Preview MIME Before Sending" vm-preview-composition
- vm-send-using-mime]
- )))
+ '("Mail Commands"
+ ["Send and Exit" vm-mail-send-and-exit (vm-menu-can-send-mail-p)]
+ ["Send, Keep Composing" vm-mail-send (vm-menu-can-send-mail-p)]
+ ["Cancel" kill-buffer t]
+ "----"
+ ["Yank Original" vm-menu-yank-original vm-reply-list]
+ "----"
+ ("Send Using MIME..."
+ ["Use MIME"
+ (progn (set (make-local-variable 'vm-send-using-mime) t)
+ (vm-mail-mode-remove-tm-hooks))
+ :active t
+ :style radio
+ :selected vm-send-using-mime]
+ ["Don't use MIME"
+ (set (make-local-variable 'vm-send-using-mime) nil)
+ :active t
+ :style radio
+ :selected (not vm-send-using-mime)])
+ (
+ "Fragment Messages Larger Than ..."
+ ["Infinity, i.e., don't fragment"
+ (set (make-local-variable 'vm-mime-max-message-size) nil)
+ :active vm-send-using-mime
+ :style radio
+ :selected (eq vm-mime-max-message-size nil)]
+ ["50000 bytes"
+ (set (make-local-variable 'vm-mime-max-message-size)
+ 50000)
+ :active vm-send-using-mime
+ :style radio
+ :selected (eq vm-mime-max-message-size 50000)]
+ ["100000 bytes"
+ (set (make-local-variable 'vm-mime-max-message-size)
+ 100000)
+ :active vm-send-using-mime
+ :style radio
+ :selected (eq vm-mime-max-message-size 100000)]
+ ["200000 bytes"
+ (set (make-local-variable 'vm-mime-max-message-size)
+ 200000)
+ :active vm-send-using-mime
+ :style radio
+ :selected (eq vm-mime-max-message-size 200000)]
+ ["500000 bytes"
+ (set (make-local-variable 'vm-mime-max-message-size)
+ 500000)
+ :active vm-send-using-mime
+ :style radio
+ :selected (eq vm-mime-max-message-size 500000)]
+ ["1000000 bytes"
+ (set (make-local-variable 'vm-mime-max-message-size)
+ 1000000)
+ :active vm-send-using-mime
+ :style radio
+ :selected (eq vm-mime-max-message-size 1000000)]
+ ["2000000 bytes"
+ (set (make-local-variable 'vm-mime-max-message-size)
+ 2000000)
+ :active vm-send-using-mime
+ :style radio
+ :selected (eq vm-mime-max-message-size 2000000)])
+ (
+ "Encode 8-bit Characters Using ..."
+ ["Nothing, i.e., send unencoded"
+ (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
+ '8bit)
+ :active vm-send-using-mime
+ :style radio
+ :selected (eq vm-mime-8bit-text-transfer-encoding '8bit)]
+ ["Quoted-Printable"
+ (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
+ 'quoted-printable)
+ :active vm-send-using-mime
+ :style radio
+ :selected (eq vm-mime-8bit-text-transfer-encoding
+ 'quoted-printable)]
+ ["BASE64"
+ (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
+ 'base64)
+ :active vm-send-using-mime
+ :style radio
+ :selected (eq vm-mime-8bit-text-transfer-encoding 'base64)])
+ "----"
+ ["Attach File..." vm-attach-file vm-send-using-mime]
+ ["Attach MIME Message..." vm-attach-mime-file vm-send-using-mime]
+ ["Encode MIME, But Don't Send" vm-mime-encode-composition
+ (and vm-send-using-mime
+ (null (vm-mail-mode-get-header-contents "MIME-Version:")))]
+ ["Preview MIME Before Sending" vm-preview-composition
+ vm-send-using-mime]
+ ))
(defconst vm-menu-mime-dispose-menu
- (let ((title (if (vm-menu-fsfemacs19-menus-p)
- (list "Take Action on MIME body ..."
- "Take Action on MIME body ..."
- "---"
- "---")
- (list "Take Action on MIME body ..."))))
- `(,@title
- ["Display as Text (in default face)"
- vm-mime-reader-map-display-using-default t]
- ["Display using External Viewer"
- vm-mime-reader-map-display-using-external-viewer t]
- ["Convert to Text and Display"
- vm-mime-reader-map-convert-then-display
- (vm-menu-can-convert-to-text/plain (vm-mime-get-button-layout))]
- ;; FSF Emacs does not allow a non-string menu element name.
- ;; This is not working on XEmacs either. USR, 2011-03-05
- ;; ,@(if (vm-menu-can-eval-item-name)
- ;; (list [(format "Convert to %s and Display"
- ;; (or (nth 1 (vm-mime-can-convert
- ;; (car
- ;; (vm-mm-layout-type
- ;; (vm-mime-get-button-layout)))))
- ;; "different type"))
- ;; (vm-mime-run-display-function-at-point
- ;; 'vm-mime-convert-body-then-display)
- ;; (vm-mime-can-convert
- ;; (car (vm-mm-layout-type
- ;; (vm-mime-get-button-layout))))]))
- "---"
- ["Undo"
- vm-undo]
- "---"
- ["Save to File"
- vm-mime-reader-map-save-file t]
- ["Save to Folder"
- vm-mime-reader-map-save-message
- (let ((layout (vm-mime-get-button-layout)))
- (if (null layout)
- nil
- (or (vm-mime-types-match "message/rfc822"
- (car (vm-mm-layout-type layout)))
- (vm-mime-types-match "message/news"
- (car (vm-mm-layout-type layout))))))]
- ["Send to Printer"
- vm-mime-reader-map-pipe-to-printer t]
- ["Pipe to Shell Command (display output)"
- vm-mime-reader-map-pipe-to-command t]
- ["Pipe to Shell Command (discard output)"
- vm-mime-reader-map-pipe-to-command-discard-output t]
- ["Attach to Message Composition Buffer"
- vm-mime-reader-map-attach-to-composition t]
- ["Delete" vm-delete-mime-object t])))
+ '("Take Action on MIME body ..."
+ ["Display as Text (in default face)"
+ vm-mime-reader-map-display-using-default t]
+ ["Display using External Viewer"
+ vm-mime-reader-map-display-using-external-viewer t]
+ ["Convert to Text and Display"
+ vm-mime-reader-map-convert-then-display
+ (vm-menu-can-convert-to-text/plain (vm-mime-get-button-layout))]
+ ;; FSF Emacs does not allow a non-string menu element name.
+ ;; This is not working on XEmacs either. USR, 2011-03-05
+ ;; ,@(if (vm-menu-can-eval-item-name)
+ ;; (list [(format "Convert to %s and Display"
+ ;; (or (nth 1 (vm-mime-can-convert
+ ;; (car
+ ;; (vm-mm-layout-type
+ ;; (vm-mime-get-button-layout)))))
+ ;; "different type"))
+ ;; (vm-mime-run-display-function-at-point
+ ;; 'vm-mime-convert-body-then-display)
+ ;; (vm-mime-can-convert
+ ;; (car (vm-mm-layout-type
+ ;; (vm-mime-get-button-layout))))]))
+ "---"
+ ["Undo"
+ vm-undo]
+ "---"
+ ["Save to File"
+ vm-mime-reader-map-save-file t]
+ ["Save to Folder"
+ vm-mime-reader-map-save-message
+ (let ((layout (vm-mime-get-button-layout)))
+ (if (null layout)
+ nil
+ (or (vm-mime-types-match "message/rfc822"
+ (car (vm-mm-layout-type layout)))
+ (vm-mime-types-match "message/news"
+ (car (vm-mm-layout-type layout))))))]
+ ["Send to Printer"
+ vm-mime-reader-map-pipe-to-printer t]
+ ["Pipe to Shell Command (display output)"
+ vm-mime-reader-map-pipe-to-command t]
+ ["Pipe to Shell Command (discard output)"
+ vm-mime-reader-map-pipe-to-command-discard-output t]
+ ["Attach to Message Composition Buffer"
+ vm-mime-reader-map-attach-to-composition t]
+ ["Delete" vm-delete-mime-object t]))
(defconst vm-menu-url-browser-menu
- (let ((title (if (vm-menu-fsfemacs19-menus-p)
- (list "Send URL to ..."
- "Send URL to ..."
- "---"
- "---")
- (list "Send URL to ...")))
- (w3 (cond ((fboundp 'w3-fetch-other-frame)
+ (let ((w3 (cond ((fboundp 'w3-fetch-other-frame)
'w3-fetch-other-frame)
((fboundp 'w3-fetch)
'w3-fetch)
(t 'w3-fetch-other-frame))))
- `(,@title
+ `("Send URL to ..."
["Window system (Copy)"
(vm-mouse-send-url-at-position
(point) 'vm-mouse-send-url-to-window-system)
@@ -586,206 +544,152 @@ do not allow menubar buttons.")
vm-opera-program])))
(defconst vm-menu-mailto-url-browser-menu
- (let ((title (if (vm-menu-fsfemacs19-menus-p)
- (list "Send Mail using ..."
- "Send Mail using ..."
- "---"
- "---")
- (list "Send Mail using ..."))))
- `(,@title
- ["VM" (vm-mouse-send-url-at-position (point) 'ignore) t])))
+ `("Send Mail using ..."
+ ["VM" (vm-mouse-send-url-at-position (point) 'ignore) t]))
(defconst vm-menu-subject-menu
- (let ((title (if (vm-menu-fsfemacs19-menus-p)
- (list "Take Action on Subject..."
- "Take Action on Subject..."
- "---"
- "---")
- (list "Take Action on Subject..."))))
- `(,@title
- ["Kill Subject" vm-kill-subject vm-message-list]
- ["Next Message, Same Subject" vm-next-message-same-subject
- vm-message-list]
- ["Previous Message, Same Subject" vm-previous-message-same-subject
- vm-message-list]
- ["Mark Messages, Same Subject" vm-mark-messages-same-subject
- vm-message-list]
- ["Unmark Messages, Same Subject" vm-unmark-messages-same-subject
- vm-message-list]
- ["Virtual Folder, Matching Subject" vm-menu-create-subject-virtual-folder
- vm-message-list]
- )))
+ '("Take Action on Subject..."
+ ["Kill Subject" vm-kill-subject vm-message-list]
+ ["Next Message, Same Subject" vm-next-message-same-subject
+ vm-message-list]
+ ["Previous Message, Same Subject" vm-previous-message-same-subject
+ vm-message-list]
+ ["Mark Messages, Same Subject" vm-mark-messages-same-subject
+ vm-message-list]
+ ["Unmark Messages, Same Subject" vm-unmark-messages-same-subject
+ vm-message-list]
+ ["Virtual Folder, Matching Subject" vm-menu-create-subject-virtual-folder
+ vm-message-list]
+ ))
(defconst vm-menu-author-menu
- (let ((title (if (vm-menu-fsfemacs19-menus-p)
- (list "Take Action on Author..."
- "Take Action on Author..."
- "---"
- "---")
- (list "Take Action on Author..."))))
- `(,@title
- ["Mark Messages, Same Author" vm-mark-messages-same-author
- vm-message-list]
- ["Unmark Messages, Same Author" vm-unmark-messages-same-author
- vm-message-list]
- ["Virtual Folder, Matching Author" vm-menu-create-author-virtual-folder
- vm-message-list]
- ["Send a message" vm-menu-mail-to
- vm-message-list]
- )))
+ '("Take Action on Author..."
+ ["Mark Messages, Same Author" vm-mark-messages-same-author
+ vm-message-list]
+ ["Unmark Messages, Same Author" vm-unmark-messages-same-author
+ vm-message-list]
+ ["Virtual Folder, Matching Author" vm-menu-create-author-virtual-folder
+ vm-message-list]
+ ["Send a message" vm-menu-mail-to
+ vm-message-list]
+ ))
(defconst vm-menu-attachment-menu
- (let ((title (if (vm-menu-fsfemacs19-menus-p)
- (list "Fiddle With Attachment"
- "Fiddle With Attachment"
- "---"
- "---")
- (list "Fiddle With Attachment"))))
- `(,@title
- (
- ,@(if (vm-menu-fsfemacs19-menus-p)
- (list "Set Content Disposition..."
- "Set Content Disposition..."
- "---"
- "---")
- (list "Set Content Disposition..."))
- ["Unspecified"
- (vm-mime-set-attachment-disposition-at-point 'unspecified)
- :active vm-send-using-mime
- :style radio
- :selected (eq (vm-mime-attachment-disposition-at-point)
- 'unspecified)]
- ["Inline"
- (vm-mime-set-attachment-disposition-at-point 'inline)
- :active vm-send-using-mime
- :style radio
- :selected (eq (vm-mime-attachment-disposition-at-point) 'inline)]
- ["Attachment"
- (vm-mime-set-attachment-disposition-at-point 'attachment)
- :active vm-send-using-mime
- :style radio
- :selected (eq (vm-mime-attachment-disposition-at-point)
- 'attachment)])
- (
- ,@(if (vm-menu-fsfemacs19-menus-p)
- (list "Set Content Encoding..."
- "Set Content Encoding..."
- "---"
- "---")
- (list "Set Content Encoding..."))
- ["Guess"
- (vm-mime-set-attachment-encoding-at-point "guess")
- :active vm-send-using-mime
- :style radio
- :selected (eq (vm-mime-attachment-encoding-at-point) nil)]
- ["Binary"
- (vm-mime-set-attachment-encoding-at-point "binary")
- :active vm-send-using-mime
- :style radio
- :selected (string= (vm-mime-attachment-encoding-at-point) "binary")]
- ["7bit"
- (vm-mime-set-attachment-encoding-at-point "7bit")
- :active vm-send-using-mime
- :style radio
- :selected (string= (vm-mime-attachment-encoding-at-point) "7bit")]
- ["8bit"
- (vm-mime-set-attachment-encoding-at-point "8bit")
- :active vm-send-using-mime
- :style radio
- :selected (string= (vm-mime-attachment-encoding-at-point) "8bit")]
- ["quoted-printable"
- (vm-mime-set-attachment-encoding-at-point "quoted-printable")
- :active vm-send-using-mime
- :style radio
- :selected (string= (vm-mime-attachment-encoding-at-point)
"quoted-printable")]
- )
- (
- ,@(if (vm-menu-fsfemacs19-menus-p)
- (list "Saved attachments"
- "Saved attachments"
- "---"
- "---")
- (list "Saved attachments"))
- ["Include references"
- (vm-mime-set-attachment-forward-local-refs-at-point t)
- :active vm-send-using-mime
- :style radio
- :selected (vm-comp-comp-forward-local-refs-at-point)]
- ["Include objects"
- (vm-mime-set-attachment-forward-local-refs-at-point nil)
- :active vm-send-using-mime
- :style radio
- :selected (not (vm-mime-attachment-forward-local-refs-at-point))])
- ["Delete"
- (vm-mime-delete-attachment-button)
- :style button]
- ["Delete, but keep infos"
- (vm-mime-delete-attachment-button-keep-infos)
- :style button]
- )))
+ `("Fiddle With Attachment"
+ ("Set Content Disposition..."
+ ["Unspecified"
+ (vm-mime-set-attachment-disposition-at-point 'unspecified)
+ :active vm-send-using-mime
+ :style radio
+ :selected (eq (vm-mime-attachment-disposition-at-point)
+ 'unspecified)]
+ ["Inline"
+ (vm-mime-set-attachment-disposition-at-point 'inline)
+ :active vm-send-using-mime
+ :style radio
+ :selected (eq (vm-mime-attachment-disposition-at-point) 'inline)]
+ ["Attachment"
+ (vm-mime-set-attachment-disposition-at-point 'attachment)
+ :active vm-send-using-mime
+ :style radio
+ :selected (eq (vm-mime-attachment-disposition-at-point)
+ 'attachment)])
+ ("Set Content Encoding..."
+ ["Guess"
+ (vm-mime-set-attachment-encoding-at-point "guess")
+ :active vm-send-using-mime
+ :style radio
+ :selected (eq (vm-mime-attachment-encoding-at-point) nil)]
+ ["Binary"
+ (vm-mime-set-attachment-encoding-at-point "binary")
+ :active vm-send-using-mime
+ :style radio
+ :selected (string= (vm-mime-attachment-encoding-at-point) "binary")]
+ ["7bit"
+ (vm-mime-set-attachment-encoding-at-point "7bit")
+ :active vm-send-using-mime
+ :style radio
+ :selected (string= (vm-mime-attachment-encoding-at-point) "7bit")]
+ ["8bit"
+ (vm-mime-set-attachment-encoding-at-point "8bit")
+ :active vm-send-using-mime
+ :style radio
+ :selected (string= (vm-mime-attachment-encoding-at-point) "8bit")]
+ ["quoted-printable"
+ (vm-mime-set-attachment-encoding-at-point "quoted-printable")
+ :active vm-send-using-mime
+ :style radio
+ :selected (string= (vm-mime-attachment-encoding-at-point)
"quoted-printable")]
+ )
+ ("Saved attachments"
+ ["Include references"
+ (vm-mime-set-attachment-forward-local-refs-at-point t)
+ :active vm-send-using-mime
+ :style radio
+ :selected (vm-comp-comp-forward-local-refs-at-point)]
+ ["Include objects"
+ (vm-mime-set-attachment-forward-local-refs-at-point nil)
+ :active vm-send-using-mime
+ :style radio
+ :selected (not (vm-mime-attachment-forward-local-refs-at-point))])
+ ["Delete"
+ (vm-mime-delete-attachment-button)
+ :style button]
+ ["Delete, but keep infos"
+ (vm-mime-delete-attachment-button-keep-infos)
+ :style button]
+ ))
(defconst vm-menu-image-menu
- (let ((title (if (vm-menu-fsfemacs19-menus-p)
- (list "Redisplay Image"
- "Redisplay Image"
- "---"
- "---")
- (list "Redisplay Image"))))
- `(,@title
- ["4x Larger"
- (vm-mime-run-display-function-at-point 'vm-mime-larger-image)
- (stringp vm-imagemagick-convert-program)]
- ["4x Smaller"
- (vm-mime-run-display-function-at-point 'vm-mime-smaller-image)
- (stringp vm-imagemagick-convert-program)]
- ["Rotate Left"
- (vm-mime-run-display-function-at-point 'vm-mime-rotate-image-left)
- (stringp vm-imagemagick-convert-program)]
- ["Rotate Right"
- (vm-mime-run-display-function-at-point 'vm-mime-rotate-image-right)
- (stringp vm-imagemagick-convert-program)]
- ["Mirror"
- (vm-mime-run-display-function-at-point 'vm-mime-mirror-image)
- (stringp vm-imagemagick-convert-program)]
- ["Brighter"
- (vm-mime-run-display-function-at-point 'vm-mime-brighten-image)
- (stringp vm-imagemagick-convert-program)]
- ["Dimmer"
- (vm-mime-run-display-function-at-point 'vm-mime-dim-image)
- (stringp vm-imagemagick-convert-program)]
- ["Monochrome"
- (vm-mime-run-display-function-at-point 'vm-mime-monochrome-image)
- (stringp vm-imagemagick-convert-program)]
- ["Revert to Original"
- (vm-mime-run-display-function-at-point 'vm-mime-revert-image)
- (get
- (vm-mm-layout-cache
- (vm-extent-property (vm-find-layout-extent-at-point) 'vm-mime-layout))
- 'vm-image-modified)]
- )))
+ `("Redisplay Image"
+ ["4x Larger"
+ (vm-mime-run-display-function-at-point 'vm-mime-larger-image)
+ (stringp vm-imagemagick-convert-program)]
+ ["4x Smaller"
+ (vm-mime-run-display-function-at-point 'vm-mime-smaller-image)
+ (stringp vm-imagemagick-convert-program)]
+ ["Rotate Left"
+ (vm-mime-run-display-function-at-point 'vm-mime-rotate-image-left)
+ (stringp vm-imagemagick-convert-program)]
+ ["Rotate Right"
+ (vm-mime-run-display-function-at-point 'vm-mime-rotate-image-right)
+ (stringp vm-imagemagick-convert-program)]
+ ["Mirror"
+ (vm-mime-run-display-function-at-point 'vm-mime-mirror-image)
+ (stringp vm-imagemagick-convert-program)]
+ ["Brighter"
+ (vm-mime-run-display-function-at-point 'vm-mime-brighten-image)
+ (stringp vm-imagemagick-convert-program)]
+ ["Dimmer"
+ (vm-mime-run-display-function-at-point 'vm-mime-dim-image)
+ (stringp vm-imagemagick-convert-program)]
+ ["Monochrome"
+ (vm-mime-run-display-function-at-point 'vm-mime-monochrome-image)
+ (stringp vm-imagemagick-convert-program)]
+ ["Revert to Original"
+ (vm-mime-run-display-function-at-point 'vm-mime-revert-image)
+ (get
+ (vm-mm-layout-cache
+ (vm-extent-property (vm-find-layout-extent-at-point) 'vm-mime-layout))
+ 'vm-image-modified)]
+ ))
(defvar vm-menu-vm-menubar nil)
(defconst vm-menu-vm-menu
- (let ((title (if (vm-menu-fsfemacs19-menus-p)
- (list "VM"
- "VM"
- "---"
- "---")
- (list "VM"))))
- `(,@title
- ,vm-menu-folder-menu
- ,vm-menu-motion-menu
- ,vm-menu-send-menu
- ,vm-menu-mark-menu
- ,vm-menu-label-menu
- ,vm-menu-sort-menu
- ,vm-menu-virtual-menu
-;; ,vm-menu-undo-menu
- ,vm-menu-dispose-menu
- "---"
- "---"
- ,vm-menu-help-menu)))
+ `("VM"
+ ,vm-menu-folder-menu
+ ,vm-menu-motion-menu
+ ,vm-menu-send-menu
+ ,vm-menu-mark-menu
+ ,vm-menu-label-menu
+ ,vm-menu-sort-menu
+ ,vm-menu-virtual-menu
+ ;; ,vm-menu-undo-menu
+ ,vm-menu-dispose-menu
+ "---"
+ "---"
+ ,vm-menu-help-menu))
(defvar vm-mode-menu-map nil
"If running in FSF Emacs, this variable stores the standard
@@ -914,13 +818,12 @@ set to the command name so that window configuration will
be done."
(vm-mail (vm-get-header-contents (car vm-message-pointer) "From:")))
-(defun vm-menu-xemacs-global-menubar ()
- (save-excursion
- (set-buffer (get-buffer-create "*scratch*"))
- current-menubar))
-
-(defun vm-menu-fsfemacs-global-menubar ()
- (lookup-key (current-global-map) [menu-bar]))
+(defun vm-menu--global-menubar ()
+ (if (featurep 'xemacs)
+ (save-excursion
+ (set-buffer (get-buffer-create "*scratch*"))
+ current-menubar)
+ (lookup-key (current-global-map) [menu-bar])))
(defun vm-menu-initialize-vm-mode-menu-map ()
(if (null vm-mode-menu-map)
@@ -1078,11 +981,11 @@ set to the command name so that window configuration
will be done."
(defun vm-menu-popup-mode-menu (event)
(interactive "e")
- (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
+ (cond ((and (featurep 'xemacs) vm-use-menus)
(set-buffer (window-buffer (event-window event)))
(and (event-point event) (goto-char (event-point event)))
(popup-mode-menu))
- ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
+ ((and (not (featurep 'xemacs)) vm-use-menus)
(set-buffer (window-buffer (posn-window (event-start event))))
(goto-char (posn-point (event-start event)))
(vm-menu-popup-fsfemacs-menu event))))
@@ -1097,7 +1000,7 @@ set to the command name so that window configuration will
be done."
;; support for extents. Any context sensitive area should be
;; contained in an extent with a keymap that has mouse-3 bound
;; to a function that will pop up a context sensitive menu.
- (cond ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
+ (cond ((and (not (featurep 'xemacs)) vm-use-menus)
(set-buffer (window-buffer (posn-window (event-start event))))
(goto-char (posn-point (event-start event)))
(if (get-text-property (point) 'vm-mime-object)
@@ -1127,7 +1030,7 @@ set to the command name so that window configuration will
be done."
(defvar vm-menu-fsfemacs-mime-dispose-menu)
(defun vm-menu-goto-event (event)
- (cond ((vm-menu-xemacs-menus-p)
+ (cond ((featurep 'xemacs)
;; Must select window instead of just set-buffer because
;; popup-menu returns before the user has made a
;; selection. This will cause the command loop to
@@ -1135,43 +1038,43 @@ set to the command name so that window configuration
will be done."
(select-window (event-window event))
(and (event-closest-point event)
(goto-char (event-closest-point event))))
- ((vm-menu-fsfemacs-menus-p)
+ ((not (featurep 'xemacs))
(set-buffer (window-buffer (posn-window (event-start event))))
(goto-char (posn-point (event-start event))))))
(defun vm-menu-popup-url-browser-menu (event)
(interactive "e")
(vm-menu-goto-event event)
- (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
+ (cond ((and (featurep 'xemacs) vm-use-menus)
(popup-menu vm-menu-url-browser-menu))
- ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
+ ((and (not (featurep 'xemacs)) vm-use-menus)
(vm-menu-popup-fsfemacs-menu
event vm-menu-fsfemacs-url-browser-menu))))
(defun vm-menu-popup-mailto-url-browser-menu (event)
(interactive "e")
(vm-menu-goto-event event)
- (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
+ (cond ((and (featurep 'xemacs) vm-use-menus)
(popup-menu vm-menu-mailto-url-browser-menu))
- ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
+ ((and (not (featurep 'xemacs)) vm-use-menus)
(vm-menu-popup-fsfemacs-menu
event vm-menu-fsfemacs-mailto-url-browser-menu))))
(defun vm-menu-popup-mime-dispose-menu (event)
(interactive "e")
(vm-menu-goto-event event)
- (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
+ (cond ((and (featurep 'xemacs) vm-use-menus)
(popup-menu vm-menu-mime-dispose-menu))
- ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
+ ((and (not (featurep 'xemacs)) vm-use-menus)
(vm-menu-popup-fsfemacs-menu
event vm-menu-fsfemacs-mime-dispose-menu))))
(defun vm-menu-popup-attachment-menu (event)
(interactive "e")
(vm-menu-goto-event event)
- (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
+ (cond ((and (featurep 'xemacs) vm-use-menus)
(popup-menu vm-menu-attachment-menu))
- ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
+ ((and (not (featurep 'xemacs)) vm-use-menus)
(vm-menu-popup-fsfemacs-menu
event vm-menu-fsfemacs-attachment-menu))))
@@ -1179,9 +1082,9 @@ set to the command name so that window configuration will
be done."
(defun vm-menu-popup-image-menu (event)
(interactive "e")
(vm-menu-goto-event event)
- (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
+ (cond ((and (featurep 'xemacs) vm-use-menus)
(popup-menu vm-menu-image-menu))
- ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
+ ((and (not (featurep 'xemacs)) vm-use-menus)
(vm-menu-popup-fsfemacs-menu
event vm-menu-fsfemacs-image-menu))))
@@ -1208,7 +1111,7 @@ set to the command name so that window configuration will
be done."
(call-interactively command)))))
(defun vm-menu-mode-menu ()
- (if (vm-menu-xemacs-menus-p)
+ (if (featurep 'xemacs)
(cond ((eq major-mode 'mail-mode)
vm-menu-mail-menu)
((memq major-mode '(vm-mode vm-presentation-mode
@@ -1222,9 +1125,9 @@ set to the command name so that window configuration will
be done."
(t vm-menu-fsfemacs-vm-menu))))
(defun vm-menu-set-menubar-dirty-flag ()
- (cond ((vm-menu-xemacs-menus-p)
+ (cond ((featurep 'xemacs)
(set-menubar-dirty-flag))
- ((vm-menu-fsfemacs-menus-p)
+ ((not (featurep 'xemacs))
;; force-mode-line-update seems to have been buggy in Emacs
;; 21, 22, and 23. So we do it ourselves. USR, 2011-02-26
;; (force-mode-line-update t)
@@ -1252,13 +1155,13 @@ menu bar.
USR, 2011-02-27"
(if buffer
(set-buffer buffer)
(vm-select-folder-buffer-and-validate 0 (vm-interactive-p)))
- (cond ((vm-menu-xemacs-menus-p)
+ (cond ((featurep 'xemacs)
(if (null (car (find-menu-item current-menubar '("[Emacs Menubar]"))))
(set-buffer-menubar vm-menu-vm-menubar)
;; copy the current menubar in case it has been changed.
(make-local-variable 'vm-menu-vm-menubar)
(setq vm-menu-vm-menubar (copy-sequence current-menubar))
- (set-buffer-menubar (copy-sequence (vm-menu-xemacs-global-menubar)))
+ (set-buffer-menubar (copy-sequence (vm-menu--global-menubar)))
(condition-case nil
(add-menu-button nil vm-menu-vm-button nil)
(void-function
@@ -1272,7 +1175,7 @@ menu bar.
USR, 2011-02-27"
(and vm-presentation-buffer-handle
(save-excursion
(vm-menu-toggle-menubar vm-presentation-buffer-handle))))
- ((vm-menu-fsfemacs-menus-p)
+ ((not (featurep 'xemacs))
(if (not (eq (lookup-key vm-mode-map [menu-bar])
(lookup-key vm-mode-menu-map [rootmenu vm])))
(define-key vm-mode-map [menu-bar]
@@ -1284,12 +1187,12 @@ menu bar.
USR, 2011-02-27"
(defun vm-menu-install-menubar ()
"Install the dedicated menu bar of VM. USR, 2011-02-27"
- (cond ((vm-menu-xemacs-menus-p)
+ (cond ((featurep 'xemacs)
(setq vm-menu-vm-menubar (vm-menu-make-xemacs-menubar))
(set-buffer-menubar vm-menu-vm-menubar)
(run-hooks 'vm-menu-setup-hook)
(setq vm-menu-vm-menubar current-menubar))
- ((and (vm-menu-fsfemacs-menus-p)
+ ((and (not (featurep 'xemacs))
;; menus only need to be installed once for FSF Emacs
(not (fboundp 'vm-menu-undo-menu)))
(vm-menu-initialize-vm-mode-menu-map)
@@ -1299,10 +1202,10 @@ menu bar.
USR, 2011-02-27"
(defun vm-menu-install-menubar-item ()
"Install VM's menu on the current - presumably the standard - menu
bar. USR, 2011-02-27"
- (cond ((and (vm-menu-xemacs-menus-p) (vm-menu-xemacs-global-menubar))
- (set-buffer-menubar (copy-sequence (vm-menu-xemacs-global-menubar)))
+ (cond ((and (featurep 'xemacs) (vm-menu--global-menubar))
+ (set-buffer-menubar (copy-sequence (vm-menu--global-menubar)))
(add-menu nil "VM" (cdr vm-menu-vm-menu)))
- ((and (vm-menu-fsfemacs-menus-p)
+ ((and (not (featurep 'xemacs))
;; menus only need to be installed once for FSF Emacs
(not (fboundp 'vm-menu-undo-menu)))
(vm-menu-initialize-vm-mode-menu-map)
@@ -1313,25 +1216,25 @@ bar.
USR, 2011-02-27"
"This function strangely does nothing! USR, 2011-02-27."
;; nothing to do here.
;; handled in vm-mouse.el
- (cond ((vm-menu-xemacs-menus-p)
+ (cond ((featurep 'xemacs)
t )
- ((vm-menu-fsfemacs-menus-p)
+ ((not (featurep 'xemacs))
t )))
(defun vm-menu-install-mail-mode-menu ()
- (cond ((vm-menu-xemacs-menus-p)
+ (cond ((featurep 'xemacs)
;; mail-mode doesn't have mode-popup-menu bound to
;; mouse-3 by default. fix that.
(if vm-popup-menu-on-mouse-3
(define-key vm-mail-mode-map 'button3 'popup-mode-menu))
;; put menu on menubar also.
- (if (vm-menu-xemacs-global-menubar)
+ (if (vm-menu--global-menubar)
(progn
(set-buffer-menubar
- (copy-sequence (vm-menu-xemacs-global-menubar)))
+ (copy-sequence (vm-menu--global-menubar)))
(add-menu nil "Mail" (cdr vm-menu-mail-menu))))
t )
- ((vm-menu-fsfemacs-menus-p)
+ ((not (featurep 'xemacs))
;; I'd like to do this, but the result is a combination
;; of the Emacs and VM Mail menus glued together.
;; Poorly.
@@ -1379,7 +1282,7 @@ separate dedicated menu bar, depending on the value of
(progn
(setcdr tail menu)
(vm-menu-set-menubar-dirty-flag)
- (cond ((vm-menu-fsfemacs-menus-p)
+ (cond ((not (featurep 'xemacs))
(makunbound 'vm-menu-fsfemacs-virtual-menu)
(easy-menu-define vm-menu-fsfemacs-virtual-menu
(list (make-sparse-keymap))
@@ -1442,7 +1345,7 @@ separate dedicated menu bar, depending on the value of
(progn
(setcdr tail menu)
(vm-menu-set-menubar-dirty-flag)
- (cond ((vm-menu-fsfemacs-menus-p)
+ (cond ((not (featurep 'xemacs))
(makunbound 'vm-menu-fsfemacs-folder-menu)
(easy-menu-define vm-menu-fsfemacs-folder-menu
(list (make-sparse-keymap))
@@ -1601,7 +1504,7 @@ separate dedicated menu bar, depending on the value of
(vm-menu-hm-install-menu))
(defun vm-menu-hm-install-menu ()
- (cond ((vm-menu-xemacs-menus-p)
+ (cond ((featurep 'xemacs)
(cond ((car (find-menu-item current-menubar '("VM")))
(add-menu '("VM") "Folders"
(cdr vm-menu-folders-menu) "Motion"))
@@ -1609,7 +1512,7 @@ separate dedicated menu bar, depending on the value of
'("Folder" "Manipulate Folders")))
(add-menu '("Folder") "Manipulate Folders"
(cdr vm-menu-folders-menu) "Motion"))))
- ((vm-menu-fsfemacs-menus-p)
+ ((not (featurep 'xemacs))
(easy-menu-define vm-menu-fsfemacs-folders-menu
(list (make-sparse-keymap))
nil
diff --git a/lisp/vm-message-history.el b/lisp/vm-message-history.el
index bc8b8f7d74..5e1f8ed267 100644
--- a/lisp/vm-message-history.el
+++ b/lisp/vm-message-history.el
@@ -212,12 +212,7 @@ With prefix ARG, select the ARG'th next message."
(abbrev-mode 0)
(auto-fill-mode 0)
(vm-fsfemacs-nonmule-display-8bit-chars)
- (if (fboundp 'buffer-disable-undo)
- (buffer-disable-undo (current-buffer))
- ;; obfuscation to make the v19 compiler not whine
- ;; about obsolete functions.
- (let ((x 'buffer-flush-undo))
- (funcall x (current-buffer))))
+ (buffer-disable-undo (current-buffer))
(setq vm-mail-buffer folder
mode-name "VM Message History"
major-mode 'vm-message-history-mode
diff --git a/lisp/vm-mime.el b/lisp/vm-mime.el
index c6e8df6d65..449f00f838 100644
--- a/lisp/vm-mime.el
+++ b/lisp/vm-mime.el
@@ -130,7 +130,7 @@ default for it if it's nil. "
;; We can depend on the fact that, in FSF Emacsen, coding systems
;; have aliases that correspond to MIME charset names.
(let ((tmp nil))
- (cond (vm-fsfemacs-mule-p
+ (cond ((not (featurep 'xemacs))
(cond ((vm-coding-system-p (setq tmp (intern (downcase charset))))
tmp)
((equal charset "us-ascii")
@@ -199,10 +199,10 @@ configuration. "
'(iso-8859-1 "iso-8859-1")))
(eval-when-compile
- (when vm-fsfemacs-p
+ (when (not (featurep 'xemacs))
(defvar latin-unity-character-sets nil)))
-(when vm-xemacs-mule-p
+(when (featurep 'xemacs)
(require 'vm-vars)
(vm-update-mime-charset-maps)
;; If the user loads Mule-UCS, re-evaluate the MIME charset maps.
@@ -546,7 +546,7 @@ same effect."
(insert-buffer-substring b b-start b-end)
(setq retval (apply 'decode-coding-region (point-min) (point-max)
coding-system foo))
- (and vm-fsfemacs-p (set-buffer-multibyte t)) ; is this safe?
+ (and (not (featurep 'xemacs)) (set-buffer-multibyte t)) ; is this
safe?
(setq start (point-min) end (point-max))
(save-excursion
(set-buffer b)
@@ -563,40 +563,20 @@ same effect."
(defun vm-mime-charset-decode-region (charset start end)
(or (markerp end) (setq end (vm-marker end)))
- (cond ((or vm-xemacs-mule-p vm-fsfemacs-mule-p)
- (if (or (and vm-xemacs-p (memq (vm-device-type) '(x gtk mswindows)))
- vm-fsfemacs-p
- (vm-mime-tty-can-display-mime-charset charset)
- nil)
- (let ((buffer-read-only nil)
- (coding (vm-mime-charset-to-coding charset))
- (opoint (point)))
- ;; decode 8-bit indeterminate char to correct
- ;; char in correct charset.
- (vm-decode-coding-region start end coding)
- (put-text-property start end 'vm-string t)
- (put-text-property start end 'vm-charset charset)
- (put-text-property start end 'vm-coding coding)
- ;; In XEmacs 20.0 beta93 decode-coding-region moves point.
- (goto-char opoint))))
- ((not (vm-multiple-fonts-possible-p)) nil)
- ((vm-mime-default-face-charset-p charset) nil)
- (t
- (let ((font (cdr (vm-string-assoc
- charset
- vm-mime-charset-font-alist)))
- (face (make-face (make-symbol "temp-face")))
- (e (vm-make-extent start end)))
- (put-text-property start end 'vm-string t)
- (put-text-property start end 'vm-charset charset)
- (if font
- (condition-case data
- (progn (set-face-font face font)
- (if vm-fsfemacs-p
- (put-text-property start end 'face face)
- (vm-set-extent-property e 'duplicable t)
- (vm-set-extent-property e 'face face)))
- (error nil)))))))
+ (if (or (and (featurep 'xemacs) (memq (vm-device-type) '(x gtk mswindows)))
+ (not (featurep 'xemacs))
+ (vm-mime-tty-can-display-mime-charset charset))
+ (let ((buffer-read-only nil)
+ (coding (vm-mime-charset-to-coding charset))
+ (opoint (point)))
+ ;; decode 8-bit indeterminate char to correct
+ ;; char in correct charset.
+ (vm-decode-coding-region start end coding)
+ (put-text-property start end 'vm-string t)
+ (put-text-property start end 'vm-charset charset)
+ (put-text-property start end 'vm-coding coding)
+ ;; In XEmacs 20.0 beta93 decode-coding-region moves point.
+ (goto-char opoint))))
(defun vm-mime-transfer-decode-region (layout start end)
"Decode the body of a mime part given by LAYOUT at positions START
@@ -637,7 +617,7 @@ out includes base-64, quoted-printable, uuencode and CRLF
conversion."
;; of errors, which is not in the spirit of the
;; MIME spec, so avoid using it. - Kyle Jones
;; Let us try it out now. USR, 2012-10-19
- ;; (not vm-fsfemacs-p)
+ ;; (not (not (featurep 'xemacs)))
)
(condition-case data
(base64-decode-region start end)
@@ -1585,12 +1565,7 @@ a string denoting the folder name."
(concat name " Presentation"))))
(save-excursion
(set-buffer pres-buf)
- (if (fboundp 'buffer-disable-undo)
- (buffer-disable-undo (current-buffer))
- ;; obfuscation to make the v19 compiler not whine
- ;; about obsolete functions.
- (let ((x 'buffer-flush-undo))
- (funcall x (current-buffer))))
+ (buffer-disable-undo (current-buffer))
(setq mode-name "VM Presentation"
major-mode 'vm-presentation-mode
vm-message-pointer (list nil)
@@ -1958,168 +1933,155 @@ that recipient is outside of East Asia."
(save-excursion
(save-restriction
(narrow-to-region beg end)
- (if (or vm-xemacs-mule-p
- (and vm-fsfemacs-mule-p enable-multibyte-characters))
- ;; Okay, we're on a MULE build.
- (if (and vm-fsfemacs-mule-p
- (fboundp 'check-coding-systems-region))
- ;; check-coding-systems-region appeared in GNU Emacs 23.
- (let* ((preapproved (vm-get-coding-system-priorities))
- (ucs-list (vm-get-mime-ucs-list))
- (cant-encode (check-coding-systems-region
- (point-min) (point-max)
- (cons 'us-ascii preapproved))))
- (if (not (assq 'us-ascii cant-encode))
- ;; If there are only ASCII chars, we're done.
- "us-ascii"
- (while (and preapproved
- (assq (car preapproved) cant-encode)
- (not (memq (car preapproved) ucs-list)))
- (setq preapproved (cdr preapproved)))
- (if preapproved
- (cadr (assq (car preapproved)
- vm-mime-mule-coding-to-charset-alist))
- ;; None of the entries in vm-coding-system-priorities
- ;; can be used. This can only happen if no universal
- ;; coding system is included. Fall back to utf-8.
- "utf-8")))
-
- (let ((charsets (delq 'ascii
- (vm-charsets-in-region (point-min)
- (point-max)))))
- (cond
- ;; No non-ASCII chars? Right, that makes it easy for us.
- ((null charsets) "us-ascii")
-
- ;; Check whether the buffer can be encoded using one of the
- ;; vm-coding-system-priorities coding systems.
- ((catch 'done
-
- ;; We can't really do this intelligently unless latin-unity
- ;; is available.
- (if (featurep 'latin-unity)
- (let ((csetzero charsets)
- ;; Check what latin character sets are in the
- ;; buffer.
- (csets (latin-unity-representations-feasible-region
- beg end))
- (psets (latin-unity-representations-present-region
- beg end))
- (systems (vm-get-coding-system-priorities)))
-
- ;; If one of the character sets is outside of latin
- ;; unity's remit, check for a universal character
- ;; set in vm-coding-system-priorities, and pass back
- ;; the first one.
+ (if (not (featurep 'xemacs))
+ (let* ((preapproved (vm-get-coding-system-priorities))
+ (ucs-list (vm-get-mime-ucs-list))
+ (cant-encode (check-coding-systems-region
+ (point-min) (point-max)
+ (cons 'us-ascii preapproved))))
+ (if (not (assq 'us-ascii cant-encode))
+ ;; If there are only ASCII chars, we're done.
+ "us-ascii"
+ (while (and preapproved
+ (assq (car preapproved) cant-encode)
+ (not (memq (car preapproved) ucs-list)))
+ (setq preapproved (cdr preapproved)))
+ (if preapproved
+ (cadr (assq (car preapproved)
+ vm-mime-mule-coding-to-charset-alist))
+ ;; None of the entries in vm-coding-system-priorities
+ ;; can be used. This can only happen if no universal
+ ;; coding system is included. Fall back to utf-8.
+ "utf-8")))
+
+ (let ((charsets (delq 'ascii
+ (vm-charsets-in-region (point-min)
+ (point-max)))))
+ (cond
+ ;; No non-ASCII chars? Right, that makes it easy for us.
+ ((null charsets) "us-ascii")
+
+ ;; Check whether the buffer can be encoded using one of the
+ ;; vm-coding-system-priorities coding systems.
+ ((catch 'done
+
+ ;; We can't really do this intelligently unless latin-unity
+ ;; is available.
+ (if (featurep 'latin-unity)
+ (let ((csetzero charsets)
+ ;; Check what latin character sets are in the
+ ;; buffer.
+ (csets (latin-unity-representations-feasible-region
+ beg end))
+ (psets (latin-unity-representations-present-region
+ beg end))
+ (systems (vm-get-coding-system-priorities)))
+
+ ;; If one of the character sets is outside of latin
+ ;; unity's remit, check for a universal character
+ ;; set in vm-coding-system-priorities, and pass back
+ ;; the first one.
+ ;;
+ ;; Otherwise, there's no remapping that latin unity
+ ;; can do for us, and we should default to something
+ ;; iso-2022 based. (Since we're not defaulting to
+ ;; Unicode, at the moment.)
+
+ (while csetzero
+ (if (not (memq
+ (car csetzero) latin-unity-character-sets))
+ (let ((ucs-list (vm-get-mime-ucs-list))
+ (preapproved
+ (vm-get-coding-system-priorities)))
+ (while preapproved
+ (if (memq (car preapproved) ucs-list)
+ (throw 'done
+ (car (cdr (assq (car preapproved)
+
vm-mime-mule-coding-to-charset-alist)))))
+ (setq preapproved (cdr preapproved)))
+ ;; Nothing universal in the preapproved list.
+ (throw 'done nil)))
+ (setq csetzero (cdr csetzero)))
+
+ ;; Okay, we're able to remap using latin-unity. Do so.
+ (while systems
+ (let ((sys (latin-unity-massage-name (car systems)
+ 'buffer-default)))
+ (when (latin-unity-maybe-remap (point-min)
+ (point-max) sys
+ csets psets t)
+ (throw 'done
+ (second (assq sys
+
vm-mime-mule-coding-to-charset-alist)))))
+ (setq systems (cdr systems)))
+ (throw 'done nil))
+
+ ;; Right, latin-unity isn't available. If there's only
+ ;; one non-ASCII character set in the region, and the
+ ;; corresponding coding system is on the preapproved
+ ;; list before the first universal character set, pass
+ ;; it back. Otherwise, if a universal character set is
+ ;; on the preapproved list, pass the first one of them
+ ;; back. Otherwise, pass back nil and use the
+ ;; "iso-2022-jp" entry below.
+
+ (let ((csetzero charsets)
+ (preapproved (vm-get-coding-system-priorities))
+ (ucs-list (vm-get-mime-ucs-list)))
+ (if (null (cdr csetzero))
+ (while preapproved
+ ;; If we encounter a universal character set on
+ ;; the preapproved list, pass it back.
+ (if (memq (car preapproved) ucs-list)
+ (throw 'done
+ (second (assq (car preapproved)
+
vm-mime-mule-coding-to-charset-alist))))
+
+ ;; The preapproved entry isn't universal. Check if
+ ;; it's related to the single non-ASCII MULE
+ ;; charset in the buffer (that is, if the
+ ;; conceptually unordered MULE list of characters
+ ;; is based on a corresponding ISO character set,
+ ;; and thus the ordered ISO character set can
+ ;; encode all the characters in the MIME charset.)
;;
- ;; Otherwise, there's no remapping that latin unity
- ;; can do for us, and we should default to something
- ;; iso-2022 based. (Since we're not defaulting to
- ;; Unicode, at the moment.)
-
- (while csetzero
- (if (not (memq
- (car csetzero) latin-unity-character-sets))
- (let ((ucs-list (vm-get-mime-ucs-list))
- (preapproved
- (vm-get-coding-system-priorities)))
- (while preapproved
- (if (memq (car preapproved) ucs-list)
- (throw 'done
- (car (cdr (assq (car preapproved)
- vm-mime-mule-coding-to-charset-alist)))))
- (setq preapproved (cdr preapproved)))
- ;; Nothing universal in the preapproved list.
- (throw 'done nil)))
- (setq csetzero (cdr csetzero)))
-
- ;; Okay, we're able to remap using latin-unity. Do so.
- (while systems
- (let ((sys (latin-unity-massage-name (car systems)
- 'buffer-default)))
- (when (latin-unity-maybe-remap (point-min)
- (point-max) sys
- csets psets t)
- (throw 'done
- (second (assq sys
- vm-mime-mule-coding-to-charset-alist)))))
- (setq systems (cdr systems)))
- (throw 'done nil))
-
- ;; Right, latin-unity isn't available. If there's only
- ;; one non-ASCII character set in the region, and the
- ;; corresponding coding system is on the preapproved
- ;; list before the first universal character set, pass
- ;; it back. Otherwise, if a universal character set is
- ;; on the preapproved list, pass the first one of them
- ;; back. Otherwise, pass back nil and use the
- ;; "iso-2022-jp" entry below.
-
- (let ((csetzero charsets)
- (preapproved (vm-get-coding-system-priorities))
- (ucs-list (vm-get-mime-ucs-list)))
- (if (null (cdr csetzero))
- (while preapproved
- ;; If we encounter a universal character set on
- ;; the preapproved list, pass it back.
- (if (memq (car preapproved) ucs-list)
- (throw 'done
- (second (assq (car preapproved)
- vm-mime-mule-coding-to-charset-alist))))
-
- ;; The preapproved entry isn't universal. Check if
- ;; it's related to the single non-ASCII MULE
- ;; charset in the buffer (that is, if the
- ;; conceptually unordered MULE list of characters
- ;; is based on a corresponding ISO character set,
- ;; and thus the ordered ISO character set can
- ;; encode all the characters in the MIME charset.)
- ;;
- ;; The string equivalence test is used because we
- ;; don't have another mapping that is useful
- ;; here. Nnngh.
-
- (if (string=
- (car (cdr (assoc (car csetzero)
- vm-mime-mule-charset-to-charset-alist)))
- (car (cdr (assoc (car preapproved)
- vm-mime-mule-coding-to-charset-alist))))
- (throw 'done
- (car (cdr (assoc (car csetzero)
- vm-mime-mule-charset-to-charset-alist)))))
- (setq preapproved (cdr preapproved)))
-
- ;; Okay, there's more than one MULE character set in
- ;; the buffer. Check for a universal entry in the
- ;; preapproved list; if it exists pass it back,
- ;; otherwise fall through to the iso-2022-jp below,
- ;; because nothing on the preapproved list is
- ;; appropriate.
-
- (while preapproved
- ;; If we encounter a universal character set on
- ;; the preapproved list, pass it back.
- (when (memq (car preapproved) ucs-list)
- (throw 'done
- (second (assq (car preapproved)
- vm-mime-mule-coding-to-charset-alist))))
- (setq preapproved (cdr preapproved)))))
- (throw 'done nil))))
- ;; Couldn't do any magic with vm-coding-system-priorities. Pass
- ;; back a Japanese iso-2022 MIME character set.
- (t "iso-2022-jp")
- ;; Undo the change made in revisin 493
- ;; (t (or vm-mime-8bit-composition-charset "iso-2022-jp"))
- ;; --
- )))
- ;; If we're non-MULE and there are eight bit characters, use a
- ;; sensible default.
- (goto-char (point-min))
- (if (re-search-forward "[^\000-\177]" nil t)
- (or vm-mime-8bit-composition-charset "iso-8859-1")
- ;; We're non-MULE and there are purely 7bit characters in the
- ;; region. Return vm-mime-7bit-c-c.
- vm-mime-7bit-composition-charset)))))
+ ;; The string equivalence test is used because we
+ ;; don't have another mapping that is useful
+ ;; here. Nnngh.
+
+ (if (string=
+ (car (cdr (assoc (car csetzero)
+
vm-mime-mule-charset-to-charset-alist)))
+ (car (cdr (assoc (car preapproved)
+
vm-mime-mule-coding-to-charset-alist))))
+ (throw 'done
+ (car (cdr (assoc (car csetzero)
+
vm-mime-mule-charset-to-charset-alist)))))
+ (setq preapproved (cdr preapproved)))
+
+ ;; Okay, there's more than one MULE character set in
+ ;; the buffer. Check for a universal entry in the
+ ;; preapproved list; if it exists pass it back,
+ ;; otherwise fall through to the iso-2022-jp below,
+ ;; because nothing on the preapproved list is
+ ;; appropriate.
+
+ (while preapproved
+ ;; If we encounter a universal character set on
+ ;; the preapproved list, pass it back.
+ (when (memq (car preapproved) ucs-list)
+ (throw 'done
+ (second (assq (car preapproved)
+
vm-mime-mule-coding-to-charset-alist))))
+ (setq preapproved (cdr preapproved)))))
+ (throw 'done nil))))
+ ;; Couldn't do any magic with vm-coding-system-priorities. Pass
+ ;; back a Japanese iso-2022 MIME character set.
+ (t "iso-2022-jp")
+ ;; Undo the change made in revisin 493
+ ;; (t (or vm-mime-8bit-composition-charset "iso-2022-jp"))
+ ;; --
+ ))))))
(defun vm-determine-proper-content-transfer-encoding (beg end)
(save-excursion
@@ -2197,7 +2159,7 @@ that recipient is outside of East Asia."
((vm-mime-types-match "image/xbm" type)
(and (vm-image-type-available-p 'xbm) (vm-images-possible-here-p)))
((vm-mime-types-match "audio/basic" type)
- (and vm-xemacs-p
+ (and (featurep 'xemacs)
(or (featurep 'native-sound)
(featurep 'nas-sound))
(or (device-sound-enabled-p)
@@ -2463,7 +2425,7 @@ assuming that it is text."
(vm-warn 0 1 "Conversion from %s to %s signalled exit code %s"
(nth 0 ooo) (nth 1 ooo) ex))
;; This cannot possibly safe. USR, 2011-02-11
- ;; (if vm-fsfemacs-mule-p
+ ;; (if (not (featurep 'xemacs))
;; (set-buffer-multibyte t))
(setq start (point-min) end (point-max))
(with-current-buffer b
@@ -3675,7 +3637,7 @@ button that this LAYOUT comes from."
(lambda (extent)
;; reuse the internal display code, but make sure that no new
;; buttons will be created for the external-body content.
- (let ((layout (if vm-xemacs-p
+ (let ((layout (if (featurep 'xemacs)
(vm-extent-property extent 'vm-mime-layout)
(overlay-get extent 'vm-mime-layout)))
(vm-mime-auto-displayed-content-types t)
@@ -3934,9 +3896,9 @@ it to an internal object by retrieving the body.
USR, 2011-03-28"
IMAGE-TYPE is its image type (png, jpeg etc.). NAME is a string
describing the image type. USR, 2011-03-25"
(cond
- (vm-xemacs-p
+ ((featurep 'xemacs)
(vm-mime-display-internal-image-xemacs-xxxx layout image-type name))
- ((and vm-fsfemacs-p (fboundp 'image-type-available-p))
+ ((and (not (featurep 'xemacs)) (fboundp 'image-type-available-p))
(vm-mime-display-internal-image-fsfemacs-xxxx layout image-type name))
(t
(vm-inform 0 "Unsupported Emacs version"))
@@ -4618,7 +4580,7 @@ image when possible."
vm-mime-thumbnail-max-geometry))
;; extract image data, don't need the image itself!
;; if the display was not successful, glyph will be nil
- (setq glyph (if vm-xemacs-p
+ (setq glyph (if (featurep 'xemacs)
(let ((e1 (vm-extent-at start))
(e2 (vm-extent-at (1+ start))))
(or (and e1 (extent-begin-glyph e1))
@@ -4629,7 +4591,7 @@ image when possible."
(setq start (point))
(vm-mime-display-button-xxxx layout t)
(when glyph
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(set-extent-begin-glyph (vm-extent-at start) glyph)
(put-text-property start (1+ start) 'display glyph)))
;; remove the cached thumb so that full sized image will be shown
@@ -4643,7 +4605,7 @@ image when possible."
(vm-mime-display-button-image layout))
(defun vm-mime-display-internal-audio/basic (layout)
- (if (and vm-xemacs-p
+ (if (and (featurep 'xemacs)
(or (featurep 'native-sound)
(featurep 'nas-sound))
(or (device-sound-enabled-p)
@@ -5200,9 +5162,9 @@ confirmed before creating a new directory."
"Set an image stamp for MIME button extent E as appropriate for
TYPE. USR, 2011-03-25"
(cond
- (vm-xemacs-p
+ ((featurep 'xemacs)
(vm-mime-xemacs-set-image-stamp-for-type e type))
- (vm-fsfemacs-p
+ ((not (featurep 'xemacs))
(vm-mime-fsfemacs-set-image-stamp-for-type e type))))
(defconst vm-mime-type-images
@@ -5298,7 +5260,7 @@ be removed when it is expanded to display the mime
object."
(insert caption "\n")
;; we must use the same interface that the vm-extent functions
;; use. if they use overlays, then we call make-overlay.
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
;; we MUST have the five arg make-overlay. overlays must
;; advance when text is inserted at their start position or
;; inline text and graphics will seep into the button
@@ -5308,9 +5270,9 @@ be removed when it is expanded to display the mime
object."
(vm-set-extent-property e 'start-open t)
(vm-set-extent-property e 'end-open t))
(vm-mime-set-image-stamp-for-type e (car (vm-mm-layout-type layout)))
- (when vm-fsfemacs-p
+ (when (not (featurep 'xemacs))
(vm-set-extent-property e 'local-map keymap))
- (when vm-xemacs-p
+ (when (featurep 'xemacs)
(vm-set-extent-property e 'highlight t)
(vm-set-extent-property e 'keymap keymap)
(vm-set-extent-property e 'balloon-help 'vm-mouse-3-help))
@@ -5322,9 +5284,9 @@ be removed when it is expanded to display the mime
object."
(vm-set-extent-property e 'vm-mime-layout layout)
(vm-set-extent-property e 'vm-mime-function action)
;; for vm-continue-postponed-message
- (when vm-xemacs-p
+ (when (featurep 'xemacs)
(vm-set-extent-property e 'duplicable t))
- (when vm-fsfemacs-p
+ (when (not (featurep 'xemacs))
(put-text-property (overlay-start e)
(overlay-end e)
'vm-mime-layout layout))
@@ -5777,17 +5739,14 @@ Returns non-NIL value M is a plain message."
(defun vm-mime-charset-internally-displayable-p (name)
"Can the given MIME charset be displayed within emacs by VM?"
- (cond ((and vm-xemacs-mule-p (memq (vm-device-type) '(x gtk mswindows)))
+ (cond ((and (featurep 'xemacs) (memq (vm-device-type) '(x gtk mswindows)))
(or (vm-mime-charset-to-coding name)
(vm-mime-default-face-charset-p name)))
;; vm-mime-tty-can-display-mime-charset (called below) fails
;; for GNU Emacs. So keep things simple, since there's no harm
;; if replacement characters are displayed.
- (vm-fsfemacs-mule-p)
- ((vm-multiple-fonts-possible-p)
- (or (vm-mime-default-face-charset-p name)
- (vm-string-assoc name vm-mime-charset-font-alist)))
+ ((not (featurep 'xemacs)))
;; If the terminal-coding-system variable is set to something that
;; can encode all the characters of the given MIME character set,
@@ -6468,7 +6427,7 @@ there is no file name for this object. USR,
2011-03-07"
(setq end (1- (point)))
- (cond (vm-fsfemacs-p
+ (cond ((not (featurep 'xemacs))
(put-text-property start end 'front-sticky nil)
(put-text-property start end 'rear-nonsticky t)
;; can't be intangible because menu clicking at a position
@@ -6490,7 +6449,7 @@ there is no file name for this object. USR,
2011-03-07"
(put-text-property start end 'vm-mime-encoded mimed)
;; (put-text-property start end 'duplicable t)
)
- (vm-xemacs-p
+ ((featurep 'xemacs)
(setq e (vm-make-extent start end))
(vm-mime-set-image-stamp-for-type e (or type "text/plain"))
(vm-set-extent-property e 'start-open t)
@@ -6515,37 +6474,37 @@ there is no file name for this object. USR,
2011-03-07"
(defalias 'vm-mime-attach-object 'vm-attach-object)
(defun vm-mime-attachment-forward-local-refs-at-point ()
- (cond (vm-fsfemacs-p
+ (cond ((not (featurep 'xemacs))
(let ((fb (get-text-property (point) 'vm-mime-forward-local-refs)))
(car fb) ))
- (vm-xemacs-p
+ ((featurep 'xemacs)
(let* ((e (vm-extent-at (point) 'vm-mime-type))
(fb (vm-extent-property e 'vm-mime-forward-local-refs)))
(car fb) ))))
(defun vm-mime-set-attachment-forward-local-refs-at-point (val)
- (cond (vm-fsfemacs-p
+ (cond ((not (featurep 'xemacs))
(let ((fb (get-text-property (point) 'vm-mime-forward-local-refs)))
(setcar fb val) ))
- (vm-xemacs-p
+ ((featurep 'xemacs)
(let* ((e (vm-extent-at (point) 'vm-mime-type))
(fb (vm-extent-property e 'vm-mime-forward-local-refs)))
(setcar fb val) ))))
(defun vm-mime-delete-attachment-button ()
- (cond (vm-fsfemacs-p
+ (cond ((not (featurep 'xemacs))
;; TODO
)
- (vm-xemacs-p
+ ((featurep 'xemacs)
(let ((e (vm-extent-at (point) 'vm-mime-type)))
(delete-region (vm-extent-start-position e)
(vm-extent-end-position e))))))
(defun vm-mime-delete-attachment-button-keep-infos ()
- (cond (vm-fsfemacs-p
+ (cond ((not (featurep 'xemacs))
;; TODO
)
- (vm-xemacs-p
+ ((featurep 'xemacs)
(let ((e (vm-extent-at (point) 'vm-mime-type)))
(save-excursion
(goto-char (1+ (vm-extent-start-position e)))
@@ -6568,40 +6527,40 @@ there is no file name for this object. USR,
2011-03-07"
nil t))))
(defun vm-mime-attachment-disposition-at-point ()
- (cond (vm-fsfemacs-p
+ (cond ((not (featurep 'xemacs))
(let ((disp (get-text-property (point) 'vm-mime-disposition)))
(intern (car disp))))
- (vm-xemacs-p
+ ((featurep 'xemacs)
(let* ((e (vm-extent-at (point) 'vm-mime-disposition))
(disp (vm-extent-property e 'vm-mime-disposition)))
(intern (car disp))))))
(defun vm-mime-set-attachment-disposition-at-point (sym)
- (cond (vm-fsfemacs-p
+ (cond ((not (featurep 'xemacs))
(let ((disp (get-text-property (point) 'vm-mime-disposition)))
(setcar disp (symbol-name sym))))
- (vm-xemacs-p
+ ((featurep 'xemacs)
(let* ((e (vm-extent-at (point) 'vm-mime-disposition))
(disp (vm-extent-property e 'vm-mime-disposition)))
(setcar disp (symbol-name sym))))))
(defun vm-mime-attachment-encoding-at-point ()
- (cond (vm-fsfemacs-p
+ (cond ((not (featurep 'xemacs))
(let ((enc (get-text-property (point) 'vm-mime-encoding)))
(car enc)))
- (vm-xemacs-p
+ ((featurep 'xemacs)
(let* ((e (vm-extent-at (point) 'vm-mime-encoding))
(enc (vm-extent-property e 'vm-mime-encoding)))
(if e (car enc))))))
(defun vm-mime-set-attachment-encoding-at-point (sym)
- (cond (vm-fsfemacs-p
+ (cond ((not (featurep 'xemacs))
;; (set-text-property (point) 'vm-mime-encoding sym)
;; (put-text-property (point) (point) 'vm-mime-encoding sym)
(let ((enc (get-text-property (point) 'vm-mime-encoding)))
(setcar enc sym)))
- (vm-xemacs-p
+ ((featurep 'xemacs)
(let* ((e (vm-extent-at (point) 'vm-mime-disposition))
(enc (vm-extent-property e 'vm-mime-encoding)))
(setcar enc sym)))))
@@ -6631,7 +6590,7 @@ extents that have the property are returned.
In GNU Emacs version of this function, attachment buttons are expected
to be denoted by text-properties rather than extents. \"Fake\"
extents are created for the purpose of this function. USR, 2011-03-27"
- (let ((e-list (if vm-xemacs-p
+ (let ((e-list (if (featurep 'xemacs)
(vm-extent-list start end prop)
(vm-mime-fake-attachment-overlays start end prop))))
(sort e-list (function
@@ -6977,7 +6936,7 @@ respectively). If none is specified, quoted-printbale is
used."
coding (vm-mime-charset-to-coding charset))
;; encode coding system body
(when (and coding (not (eq coding 'no-conversion)))
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(vm-encode-coding-region start end coding)
;; using vm-encode-coding-region causes wrong encoding in GNU Emacs
(encode-coding-region start end coding)))
@@ -7104,7 +7063,7 @@ and the approriate content-type and boundary markup
information is added."
forward-local-refs already-mimed layout e e-list boundary
type encoding charset params description disposition object
opoint-min encoded-attachment message-smimed)
- (when vm-xemacs-p
+ (when (featurep 'xemacs)
;;Make sure we don't double encode UTF-8 (for example) text.
(setq buffer-file-coding-system (vm-binary-coding-system)))
(goto-char (mail-text-start))
@@ -7415,7 +7374,7 @@ WHOLE-MESSAGE is true then nil is returned."
;; support enriched-mode for text/enriched composition
(when enriched
(let ((enriched-initial-annotation ""))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(save-excursion
;; insert/delete trick needed to avoid
;; enriched-mode tags from seeping into the
@@ -7430,7 +7389,7 @@ WHOLE-MESSAGE is true then nil is returned."
(enriched-encode (point-min) (point-max)))))
(setq charset (vm-determine-proper-charset (point-min) (point-max)))
- (when (vm-emacs-mule-p)
+ (when t
(let ((coding-system
(vm-mime-charset-to-coding charset)))
(unless coding-system
@@ -7448,7 +7407,7 @@ WHOLE-MESSAGE is true then nil is returned."
coding-system)))
;; not clear why this is needed. USR, 2011-03-27
- (when vm-xemacs-p
+ (when (featurep 'xemacs)
(when whole-message (enriched-mode -1)))
(setq encoding (vm-determine-proper-content-transfer-encoding
(point-min) (point-max))
@@ -7770,7 +7729,7 @@ Returns marker pointing to the start of the encoded MIME
part."
(delete-char -1))))
(setq charset (vm-determine-proper-charset (point-min) (point-max)))
- (when vm-fsfemacs-mule-p
+ (when (not (featurep 'xemacs))
(let ((coding-system
(vm-mime-charset-to-coding charset)))
(unless coding-system
@@ -8267,7 +8226,7 @@ This is a destructive operation and cannot be undone!"
"Replace all mime buttons in the current buffer by attachment buttons."
;; called vm-mime-encode-mime-attachments in vm-pine.el
(interactive)
- (cond (vm-xemacs-p
+ (cond ((featurep 'xemacs)
(let ((e-list (vm-extent-list
(point-min) (point-max) 'vm-mime-layout)))
(setq e-list
@@ -8280,7 +8239,7 @@ This is a destructive operation and cannot be undone!"
(while e-list
(vm-mime-replace-by-attachment-button (car e-list))
(setq e-list (cdr e-list)))))
- (vm-fsfemacs-p
+ ((not (featurep 'xemacs))
(let ((e-list (vm-mime-attachment-button-extents
(point-min) (point-max) 'vm-mime-layout)))
(while e-list
@@ -8363,7 +8322,7 @@ This is a destructive operation and cannot be undone!"
(defun vm-mime-insert-file-contents (file type)
"Safely insert the contents of FILE of TYPE into the current
buffer."
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(let ((coding-system-for-read
(if (vm-mime-text-type-p type)
(vm-line-ending-coding-system)
@@ -8420,26 +8379,9 @@ buffer."
(goto-char (point-max))
(delete-char -1))))
-(defun vm-mime-insert-buffer-substring (buffer type)
+(defun vm-mime-insert-buffer-substring (buffer _type)
"Safe insert the contents of BUFFER of TYPE into the current buffer."
- (if vm-xemacs-p
- (insert-buffer-substring buffer)
- ;; Under Emacs 20.7 inserting a unibyte buffer
- ;; contents that contain 8-bit characters into a
- ;; multibyte buffer causes the inserted data to be
- ;; corrupted with the dreaded \201 corruption. So
- ;; we write the data out to disk and let the file
- ;; be inserted, which gets aoround the problem.
- (let ((tempfile (vm-make-tempfile)))
- ;; make note to delete the tempfile after insertion
- (with-current-buffer buffer
- (let ((buffer-file-coding-system
- (vm-binary-coding-system)))
- (write-region (point-min) (point-max) tempfile nil 0)))
- (unwind-protect
- (vm-mime-insert-file-contents
- tempfile type)
- (vm-error-free-call 'delete-file tempfile)))))
+ (insert-buffer-substring buffer))
;;; vm-mime.el ends here
diff --git a/lisp/vm-minibuf.el b/lisp/vm-minibuf.el
index 55d99a3782..941759ed44 100644
--- a/lisp/vm-minibuf.el
+++ b/lisp/vm-minibuf.el
@@ -220,10 +220,10 @@ default the local keymap of the current buffer is used."
(list 'and 'string (list function 'string)))))
(while keymaps
(setq keymap (car keymaps))
- (cond ((vm-mouse-xemacs-mouse-p)
+ (cond ((featurep 'xemacs)
(define-key keymap 'button1 command)
(define-key keymap 'button2 command))
- ((vm-mouse-fsfemacs-mouse-p)
+ ((not (featurep 'xemacs))
(define-key keymap [down-mouse-1] 'ignore)
(define-key keymap [drag-mouse-1] 'ignore)
(define-key keymap [mouse-1] command)
@@ -311,12 +311,12 @@ default the local keymap of the current buffer is used."
(if (consp (car completion-list))
(setq completion-list (nreverse (mapcar 'car completion-list))))
(if (and completion-list (vm-mouse-support-possible-here-p))
- (cond ((and (vm-mouse-xemacs-mouse-p)
+ (cond ((and (featurep 'xemacs)
(or (button-press-event-p last-command-event)
(button-release-event-p last-command-event)
(menu-event-p last-command-event)))
(vm-mouse-read-string prompt completion-list multi-word))
- ((and (vm-mouse-fsfemacs-mouse-p)
+ ((and (not (featurep 'xemacs))
(listp last-nonmenu-event))
(vm-mouse-read-string prompt completion-list multi-word))
(t
@@ -354,13 +354,13 @@ default the local keymap of the current buffer is used."
"Like `read-file-name', except a mouse interface is used if a mouse
click mouse triggered the current command."
(if (vm-mouse-support-possible-here-p)
- (cond ((and (vm-mouse-xemacs-mouse-p)
+ (cond ((and (featurep 'xemacs)
(or (button-press-event-p last-command-event)
(button-release-event-p last-command-event)
(menu-event-p last-command-event)))
(vm-mouse-read-file-name prompt dir default
must-match initial history))
- ((and (vm-mouse-fsfemacs-mouse-p)
+ ((and (not (featurep 'xemacs))
(listp last-nonmenu-event))
(vm-mouse-read-file-name prompt dir default
must-match initial history))
diff --git a/lisp/vm-misc.el b/lisp/vm-misc.el
index ef8d2b2bfb..01c3fd1638 100644
--- a/lisp/vm-misc.el
+++ b/lisp/vm-misc.el
@@ -610,8 +610,8 @@ LIST2 satisfying PRED and return the position"
;; 'interactive-p))
(fset 'vm-device-type
- (cond (vm-xemacs-p 'device-type)
- (vm-fsfemacs-p 'vm-fsfemacs-device-type)))
+ (cond ((featurep 'xemacs) 'device-type)
+ ((not (featurep 'xemacs)) 'vm-fsfemacs-device-type)))
(defun vm-fsfemacs-device-type (&optional _device)
"An FSF Emacs emulation for XEmacs `device-type' function. Returns
@@ -622,7 +622,7 @@ the type of the current screen device: one of 'x, 'gtk,
'w32, 'ns and
window-system))
(defun vm-generate-new-unibyte-buffer (name)
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(generate-new-buffer name)
(let* (;; (default-enable-multibyte-characters nil)
;; don't need this because of set-buffer-multibyte below
@@ -633,7 +633,7 @@ the type of the current screen device: one of 'x, 'gtk,
'w32, 'ns and
buffer)))
(defun vm-generate-new-multibyte-buffer (name)
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(generate-new-buffer name)
(let* (;; (default-enable-multibyte-characters t)
;; don't need this because of set-buffer-multibyte below
@@ -654,7 +654,7 @@ the type of the current screen device: one of 'x, 'gtk,
'w32, 'ns and
(fset 'xemacs-abbreviate-file-name 'abbreviate-file-name)
(defun vm-abbreviate-file-name (path)
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(xemacs-abbreviate-file-name path t)
(abbreviate-file-name path)))
@@ -992,7 +992,7 @@ If HACK-ADDRESSES is t, then the strings are considered to
be mail addresses,
;; The following function is not working correctly on Gnu Emacs 23.
;; So we do it ourselves.
(defun vm-delete-auto-save-file-if-necessary ()
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(delete-auto-save-file-if-necessary)
(when (and buffer-auto-save-file-name delete-auto-save-files
(not (string= buffer-file-name buffer-auto-save-file-name))
@@ -1045,7 +1045,7 @@ If HACK-ADDRESSES is t, then the strings are considered
to be mail addresses,
(fset 'vm-buffer-substring-no-properties
(cond ((fboundp 'buffer-substring-no-properties)
(function buffer-substring-no-properties))
- (vm-xemacs-p
+ ((featurep 'xemacs)
(function buffer-substring))
(t (function vm-default-buffer-substring-no-properties))))
@@ -1070,64 +1070,64 @@ If HACK-ADDRESSES is t, then the strings are considered
to be mail addresses,
(set-buffer target-buffer)))
(if (not (fboundp 'vm-extent-property))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(fset 'vm-extent-property 'overlay-get)
(fset 'vm-extent-property 'extent-property)))
(if (not (fboundp 'vm-extent-object))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(fset 'vm-extent-object 'overlay-buffer)
(fset 'vm-extent-object 'extent-object)))
(if (not (fboundp 'vm-set-extent-property))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(fset 'vm-set-extent-property 'overlay-put)
(fset 'vm-set-extent-property 'set-extent-property)))
(if (not (fboundp 'vm-set-extent-endpoints))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(fset 'vm-set-extent-endpoints 'move-overlay)
(fset 'vm-set-extent-endpoints 'set-extent-endpoints)))
(if (not (fboundp 'vm-make-extent))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(fset 'vm-make-extent 'make-overlay)
(fset 'vm-make-extent 'make-extent)))
(if (not (fboundp 'vm-extent-end-position))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(fset 'vm-extent-end-position 'overlay-end)
(fset 'vm-extent-end-position 'extent-end-position)))
(if (not (fboundp 'vm-extent-start-position))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(fset 'vm-extent-start-position 'overlay-start)
(fset 'vm-extent-start-position 'extent-start-position)))
(if (not (fboundp 'vm-next-extent-change))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(fset 'vm-next-extent-change 'next-overlay-change)
(fset 'vm-next-extent-change 'next-extent-change)))
(if (not (fboundp 'vm-previous-extent-change))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(fset 'vm-previous-extent-change 'previous-overlay-change)
(fset 'vm-previous-extent-change 'previous-extent-change)))
(if (not (fboundp 'vm-detach-extent))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(fset 'vm-detach-extent 'delete-overlay)
(fset 'vm-detach-extent 'detach-extent)))
(if (not (fboundp 'vm-delete-extent))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
;; This doesn't actually destroy the overlay, but it is the
;; best there is.
(fset 'vm-delete-extent 'delete-overlay)
(fset 'vm-delete-extent 'delete-extent)))
(if (not (fboundp 'vm-disable-extents))
- (if (and vm-fsfemacs-p (fboundp 'remove-overlays))
+ (if (and (not (featurep 'xemacs)) (fboundp 'remove-overlays))
(fset 'vm-disable-extents 'remove-overlays)
;; XEamcs doesn't need to disable extents because they don't
;; slow things down
@@ -1135,7 +1135,7 @@ If HACK-ADDRESSES is t, then the strings are considered
to be mail addresses,
(lambda (&optional _beg _end _name _val) nil))))
(if (not (fboundp 'vm-extent-properties))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(fset 'vm-extent-properties 'overlay-properties)
(fset 'vm-extent-properties 'extent-properties)))
@@ -1164,7 +1164,7 @@ which should be ignored. (This is included for
compatibility with XEmacs)."
(setq p (cdr p)))))
(if (not (fboundp 'vm-map-extents))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(fset 'vm-map-extents 'vm-fsfemacs-map-extents)
(fset 'vm-map-extents 'vm-xemacs-map-extents)))
@@ -1389,9 +1389,9 @@ encoding/decoding, conversions, subprocess communication
etc."
;; the GNU Emacs function expects a symbol.
;; In the non-MULE case, return nil (is this the right fallback?).
(defun vm-coding-system-p (name)
- (cond (vm-xemacs-mule-p
+ (cond ((featurep 'xemacs)
(coding-system-p (find-coding-system name)))
- (vm-fsfemacs-mule-p
+ ((not (featurep 'xemacs))
(coding-system-p name))))
(cond ((fboundp 'coding-system-name)
@@ -1407,34 +1407,32 @@ encoding/decoding, conversions, subprocess
communication etc."
(coding-system-change-eol-conversion coding-system nil)))
(defun vm-get-file-line-ending-coding-system (file)
- (if (not (or vm-fsfemacs-mule-p vm-xemacs-mule-p vm-xemacs-file-coding-p))
- nil
- (let ((coding-system-for-read (vm-binary-coding-system))
- (work-buffer (vm-make-work-buffer)))
- (unwind-protect
- (with-current-buffer work-buffer
- (condition-case nil
- (insert-file-contents file nil 0 4096)
- (error nil))
- (goto-char (point-min))
- (cond ((re-search-forward "[^\r]\n" nil t)
- (if vm-fsfemacs-mule-p 'raw-text-unix 'no-conversion-unix))
- ((re-search-forward "\r[^\n]" nil t)
- (if vm-fsfemacs-mule-p 'raw-text-mac 'no-conversion-mac))
- ((search-forward "\r\n" nil t)
- (if vm-fsfemacs-mule-p 'raw-text-dos 'no-conversion-dos))
- (t (vm-line-ending-coding-system))))
- (and work-buffer (kill-buffer work-buffer))))))
+ (let ((coding-system-for-read (vm-binary-coding-system))
+ (work-buffer (vm-make-work-buffer)))
+ (unwind-protect
+ (with-current-buffer work-buffer
+ (condition-case nil
+ (insert-file-contents file nil 0 4096)
+ (error nil))
+ (goto-char (point-min))
+ (cond ((re-search-forward "[^\r]\n" nil t)
+ (if (not (featurep 'xemacs)) 'raw-text-unix
'no-conversion-unix))
+ ((re-search-forward "\r[^\n]" nil t)
+ (if (not (featurep 'xemacs)) 'raw-text-mac 'no-conversion-mac))
+ ((search-forward "\r\n" nil t)
+ (if (not (featurep 'xemacs)) 'raw-text-dos 'no-conversion-dos))
+ (t (vm-line-ending-coding-system))))
+ (and work-buffer (kill-buffer work-buffer)))))
(defun vm-new-folder-line-ending-coding-system ()
(cond ((eq vm-default-new-folder-line-ending-type nil)
(vm-line-ending-coding-system))
((eq vm-default-new-folder-line-ending-type 'lf)
- (if vm-fsfemacs-mule-p 'raw-text-unix 'no-conversion-unix))
+ (if (not (featurep 'xemacs)) 'raw-text-unix 'no-conversion-unix))
((eq vm-default-new-folder-line-ending-type 'crlf)
- (if vm-fsfemacs-mule-p 'raw-text-dos 'no-conversion-dos))
+ (if (not (featurep 'xemacs)) 'raw-text-dos 'no-conversion-dos))
((eq vm-default-new-folder-line-ending-type 'cr)
- (if vm-fsfemacs-mule-p 'raw-text-mac 'no-conversion-mac))
+ (if (not (featurep 'xemacs)) 'raw-text-mac 'no-conversion-mac))
(t
(vm-line-ending-coding-system))))
@@ -1633,8 +1631,8 @@ front before adding it to the RING-VARIABLE."
(defvar enable-multibyte-characters)
(defvar buffer-display-table)
(defun vm-fsfemacs-nonmule-display-8bit-chars ()
- (cond ((and vm-fsfemacs-p
- (or (not vm-fsfemacs-mule-p)
+ (cond ((and (not (featurep 'xemacs))
+ (or (not (not (featurep 'xemacs)))
(and (boundp 'enable-multibyte-characters)
(not enable-multibyte-characters))))
(let* (tab (i 160))
diff --git a/lisp/vm-mouse.el b/lisp/vm-mouse.el
index ddd6529834..ec27d6ae82 100644
--- a/lisp/vm-mouse.el
+++ b/lisp/vm-mouse.el
@@ -45,19 +45,19 @@ END. If the optional argument OVERLAY is provided then
that that
overlay is moved to cover START to END. No new overlay is created in
that case. USR, 2010-08-01"
(if (null overlay)
- (cond (vm-fsfemacs-p
+ (cond ((not (featurep 'xemacs))
(let ((o (make-overlay start end)))
(overlay-put o 'mouse-face 'highlight)
o ))
- (vm-xemacs-p
+ ((featurep 'xemacs)
(let ((o (vm-make-extent start end)))
(vm-set-extent-property o 'start-open t)
(vm-set-extent-property o 'priority 10)
(vm-set-extent-property o 'highlight t)
o )))
- (cond (vm-fsfemacs-p
+ (cond ((not (featurep 'xemacs))
(move-overlay overlay start end))
- (vm-xemacs-p
+ ((featurep 'xemacs)
(vm-set-extent-endpoints overlay start end)))))
;;;###autoload
@@ -66,10 +66,10 @@ that case. USR,
2010-08-01"
mouse is clicked. See Info node `(VM) Using the Mouse'."
(interactive "e")
;; go to where the event occurred
- (cond ((vm-mouse-xemacs-mouse-p)
+ (cond ((featurep 'xemacs)
(set-buffer (window-buffer (event-window event)))
(and (event-point event) (goto-char (event-point event))))
- ((vm-mouse-fsfemacs-mouse-p)
+ ((not (featurep 'xemacs))
(set-buffer (window-buffer (posn-window (event-start event))))
(goto-char (posn-point (event-start event)))))
;; now dispatch depending on where we are
@@ -97,10 +97,10 @@ Mouse'."
(if vm-use-menus
(progn
;; go to where the event occurred
- (cond ((vm-mouse-xemacs-mouse-p)
+ (cond ((featurep 'xemacs)
(set-buffer (window-buffer (event-window event)))
(and (event-point event) (goto-char (event-point event))))
- ((vm-mouse-fsfemacs-mouse-p)
+ ((not (featurep 'xemacs))
(set-buffer (window-buffer (posn-window (event-start event))))
(goto-char (posn-point (event-start event)))))
;; now dispatch depending on where we are
@@ -122,13 +122,13 @@ Mouse'."
(defun vm-mouse-get-mouse-track-string (event)
(save-excursion
;; go to where the event occurred
- (cond ((vm-mouse-xemacs-mouse-p)
+ (cond ((featurep 'xemacs)
(set-buffer (window-buffer (event-window event)))
(and (event-point event) (goto-char (event-point event))))
- ((vm-mouse-fsfemacs-mouse-p)
+ ((not (featurep 'xemacs))
(set-buffer (window-buffer (posn-window (event-start event))))
(goto-char (posn-point (event-start event)))))
- (cond (vm-fsfemacs-p
+ (cond ((not (featurep 'xemacs))
(let ((o-list (overlays-at (point)))
(string nil))
(while o-list
@@ -139,7 +139,7 @@ Mouse'."
o-list nil)
(setq o-list (cdr o-list))))
string ))
- (vm-xemacs-p
+ ((featurep 'xemacs)
(let ((e (vm-extent-at (point) 'highlight)))
(if e
(buffer-substring (vm-extent-start-position e)
@@ -150,7 +150,7 @@ Mouse'."
;;;###autoload
(defun vm-mouse-popup-or-select (event)
(interactive "e")
- (cond ((vm-mouse-fsfemacs-mouse-p)
+ (cond ((not (featurep 'xemacs))
(set-buffer (window-buffer (posn-window (event-start event))))
(goto-char (posn-point (event-start event)))
(let (o-list (found nil))
@@ -170,7 +170,7 @@ Mouse'."
;; binding that points to a more specific function. But
;; this might come in handy later if I want selectable
;; objects that don't have an extent keymap attached.
- ((vm-mouse-xemacs-mouse-p)
+ ((featurep 'xemacs)
(set-buffer (window-buffer (event-window event)))
(and (event-point event) (goto-char (event-point event)))
(let (e)
@@ -183,11 +183,11 @@ Mouse'."
;;;###autoload
(defun vm-mouse-send-url-at-event (event)
(interactive "e")
- (cond ((vm-mouse-xemacs-mouse-p)
+ (cond ((featurep 'xemacs)
(set-buffer (window-buffer (event-window event)))
(and (event-point event) (goto-char (event-point event)))
(vm-mouse-send-url-at-position (event-point event)))
- ((vm-mouse-fsfemacs-mouse-p)
+ ((not (featurep 'xemacs))
(set-buffer (window-buffer (posn-window (event-start event))))
(goto-char (posn-point (event-start event)))
(vm-mouse-send-url-at-position (posn-point (event-start event))))))
@@ -195,7 +195,7 @@ Mouse'."
(defun vm-mouse-send-url-at-position (pos &optional browser)
(save-restriction
(widen)
- (cond ((vm-mouse-xemacs-mouse-p)
+ (cond ((featurep 'xemacs)
(let ((e (vm-extent-at pos 'vm-url))
url)
(if (null e)
@@ -203,7 +203,7 @@ Mouse'."
(setq url (buffer-substring (vm-extent-start-position e)
(vm-extent-end-position e)))
(vm-mouse-send-url url browser))))
- ((vm-mouse-fsfemacs-mouse-p)
+ ((not (featurep 'xemacs))
(let (o-list url o)
(setq o-list (overlays-at pos))
(while (and o-list (null (overlay-get (car o-list) 'vm-url)))
@@ -398,10 +398,10 @@ Mouse'."
;;;###autoload
(defun vm-mouse-install-mouse ()
- (cond ((vm-mouse-xemacs-mouse-p)
+ (cond ((featurep 'xemacs)
(if (null (lookup-key vm-mode-map 'button2))
(define-key vm-mode-map 'button2 'vm-mouse-button-2)))
- ((vm-mouse-fsfemacs-mouse-p)
+ ((not (featurep 'xemacs))
(if (null (lookup-key vm-mode-map [mouse-2]))
(define-key vm-mode-map [mouse-2] 'vm-mouse-button-2))
(if vm-popup-menu-on-mouse-3
diff --git a/lisp/vm-page.el b/lisp/vm-page.el
index 9eef8875fa..8cf4d389f1 100644
--- a/lisp/vm-page.el
+++ b/lisp/vm-page.el
@@ -318,14 +318,14 @@ Negative arg means scroll forward."
(defun vm-highlight-headers ()
(cond
- ((and vm-xemacs-p vm-use-lucid-highlighting)
+ ((and (featurep 'xemacs) vm-use-lucid-highlighting)
(require 'highlight-headers)
;; disable the url marking stuff, since VM has its own interface.
(let ((highlight-headers-mark-urls nil)
(highlight-headers-regexp (or vm-highlighted-header-regexp
highlight-headers-regexp)))
(highlight-headers (point-min) (point-max) t)))
- (vm-xemacs-p
+ ((featurep 'xemacs)
(let (e)
(map-extents (function
(lambda (e ignore)
@@ -341,7 +341,7 @@ Negative arg means scroll forward."
(vm-set-extent-property e 'face vm-highlighted-header-face)
(vm-set-extent-property e 'vm-highlight t)))
(goto-char (vm-matched-header-end)))))
- (vm-fsfemacs-p
+ ((not (featurep 'xemacs))
(let (o-lists p)
(setq o-lists (overlay-lists)
p (car o-lists))
@@ -377,18 +377,16 @@ Negative arg means scroll forward."
(cons (- (point-max) (/ search-limit 2))
(point-max))))
(setq search-pairs (list (cons (point-min) (point-max)))))
- (cond
- ((or vm-xemacs-p vm-fsfemacs-p) ; should work for both cases
- (let (e)
- (vm-map-extents (function
- (lambda (e ignore)
- (when (vm-extent-property e 'vm-url)
- (vm-delete-extent e))
- nil))
- (current-buffer)
- ;; (point-min) (point-max)
- )
- (if clean-only (vm-inform 1 "Energy from urls removed!")
+ (let (e)
+ (vm-map-extents (function
+ (lambda (e ignore)
+ (when (vm-extent-property e 'vm-url)
+ (vm-delete-extent e))
+ nil))
+ (current-buffer)
+ ;; (point-min) (point-max)
+ )
+ (if clean-only (vm-inform 1 "Energy from urls removed!")
(while search-pairs
(goto-char (car (car search-pairs)))
(while (re-search-forward vm-url-regexp (cdr (car search-pairs)) t)
@@ -407,19 +405,19 @@ Negative arg means scroll forward."
(looking-at "mailto:";))
'vm-menu-popup-mailto-url-browser-menu
'vm-menu-popup-url-browser-menu)))
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(setq keymap (nconc keymap (current-local-map))))
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(define-key keymap 'button2 'vm-mouse-send-url-at-event)
;; nothing for fsfemacs?
)
(when vm-popup-menu-on-mouse-3
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(define-key keymap 'button3 popup-function)
(define-key keymap [mouse-3] popup-function)))
(define-key keymap "\r"
- (function (lambda () (interactive)
- (vm-mouse-send-url-at-position (point)))))
+ (function (lambda () (interactive)
+ (vm-mouse-send-url-at-position
(point)))))
(vm-set-extent-property e 'vm-button t)
;; for xemacs
(vm-set-extent-property e 'keymap keymap)
@@ -433,49 +431,11 @@ Negative arg means scroll forward."
;; for vm-continue-postponed-message
(vm-set-extent-property e 'duplicable t)
)))
- (setq search-pairs (cdr search-pairs))))))
- (vm-fsfemacs-p
- (let (e)
- (vm-map-extents (function
- (lambda (e ignore)
- (when (vm-extent-property e 'vm-url)
- (vm-delete-extent e))
- nil))
- (current-buffer))
- (while search-pairs
- (goto-char (car (car search-pairs)))
- (while (re-search-forward vm-url-regexp (cdr (car search-pairs)) t)
- (setq n 1)
- (while (null (match-beginning n))
- (vm-increment n))
- (setq e (vm-make-extent (match-beginning n) (match-end n)))
- (vm-set-extent-property e 'vm-url t)
- (if vm-highlight-url-face
- (vm-set-extent-property e 'face vm-highlight-url-face))
- (if vm-url-browser
- (let ((keymap (make-sparse-keymap))
- (popup-function
- (if (save-excursion
- (goto-char (match-beginning n))
- (looking-at "mailto:";))
- 'vm-menu-popup-mailto-url-browser-menu
- 'vm-menu-popup-url-browser-menu)))
- (setq keymap (nconc keymap (current-local-map)))
- (if vm-popup-menu-on-mouse-3
- (define-key keymap [mouse-3] popup-function))
- (define-key keymap "\r"
- (function (lambda () (interactive)
- (vm-mouse-send-url-at-position (point)))))
- (vm-set-extent-property e 'vm-button t)
- (vm-set-extent-property e 'local-map keymap)
- (vm-set-extent-property e 'balloon-help 'vm-url-help)
- (vm-set-extent-property e 'mouse-face 'highlight)
- )))
- (setq search-pairs (cdr search-pairs))))))))
+ (setq search-pairs (cdr search-pairs)))))))
(defun vm-energize-headers ()
(cond
- (vm-xemacs-p
+ ((featurep 'xemacs)
(let ((search-tuples '(("^From:" vm-menu-author-menu)
("^Subject:" vm-menu-subject-menu)))
regexp menu keymap e)
@@ -509,7 +469,7 @@ Negative arg means scroll forward."
(vm-set-extent-property e 'balloon-help 'vm-mouse-3-help)
(vm-set-extent-property e 'highlight t))
(setq search-tuples (cdr search-tuples)))))
- ((and vm-fsfemacs-p
+ ((and (not (featurep 'xemacs))
(fboundp 'overlay-put))
(let ((search-tuples '(("^From:" vm-menu-fsfemacs-author-menu)
("^Subject:" vm-menu-fsfemacs-subject-menu)))
@@ -540,8 +500,8 @@ Negative arg means scroll forward."
(setq search-tuples (cdr search-tuples)))))))
(defun vm-display-xface ()
- (cond (vm-xemacs-p (vm-display-xface-xemacs))
- ((and vm-fsfemacs-p
+ (cond ((featurep 'xemacs) (vm-display-xface-xemacs))
+ ((and (not (featurep 'xemacs))
(and (stringp vm-uncompface-program)
(fboundp 'create-image)))
(vm-display-xface-fsfemacs))))
@@ -694,7 +654,7 @@ Use mouse button 3 to choose a Web browser for the URL."
(defun vm-highlight-headers-maybe ()
;; highlight the headers
(if (or vm-highlighted-header-regexp
- (and vm-xemacs-p vm-use-lucid-highlighting))
+ (and (featurep 'xemacs) vm-use-lucid-highlighting))
(save-restriction
(widen)
(narrow-to-region (vm-headers-of (car vm-message-pointer))
@@ -711,8 +671,8 @@ Use mouse button 3 to choose a Web browser for the URL."
(vm-energize-headers)))
;; display xfaces, if we can
(if (and vm-display-xfaces
- (or (and vm-xemacs-p (featurep 'xface))
- (and vm-fsfemacs-p (fboundp 'create-image)
+ (or (and (featurep 'xemacs) (featurep 'xface))
+ (and (not (featurep 'xemacs)) (fboundp 'create-image)
(stringp vm-uncompface-program))))
(save-restriction
(widen)
@@ -743,7 +703,7 @@ is necessary."
;; cutoff line one character forward, but only if
;; we're doing MIME decode for preview.
(if (and (not just-passing-through)
- vm-xemacs-p
+ (featurep 'xemacs)
vm-mail-buffer ; in presentation buffer
vm-auto-decode-mime-messages
vm-mime-decode-for-preview
@@ -1043,7 +1003,7 @@ is done if necessary. (USR, 2010-01-14)"
(vm-text-end-of (car vm-message-pointer))))))
(defun vm-narrow-to-page ()
- (cond (vm-fsfemacs-p
+ (cond ((not (featurep 'xemacs))
(if (not (and vm-page-end-overlay
(overlay-buffer vm-page-end-overlay)))
(let ((g vm-page-continuation-glyph))
@@ -1051,7 +1011,7 @@ is done if necessary. (USR, 2010-01-14)"
(vm-set-extent-property vm-page-end-overlay 'vm-glyph g)
(vm-set-extent-property vm-page-end-overlay 'before-string g)
(overlay-put vm-page-end-overlay 'evaporate nil))))
- (vm-xemacs-p
+ ((featurep 'xemacs)
(if (not (and vm-page-end-overlay
(vm-extent-end-position vm-page-end-overlay)))
(let ((g vm-page-continuation-glyph))
diff --git a/lisp/vm-pcrisis.el b/lisp/vm-pcrisis.el
index e3141defc4..8a0a3638fe 100644
--- a/lisp/vm-pcrisis.el
+++ b/lisp/vm-pcrisis.el
@@ -393,7 +393,7 @@ This is the XEmacs version of
`vmpc-set-overlay-insertion-types'."
In other words, EXERLAY is the name of the overlay or extent with a quote in
front. START and END are the equivalent of the marker insertion types for the
start and end of the overlay/extent."
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(vmpc-set-extent-insertion-types (symbol-value exerlay) start end)
(set exerlay (vmpc-set-overlay-insertion-types (symbol-value exerlay)
start end))))
@@ -401,35 +401,35 @@ start and end of the overlay/extent."
(defun vmpc-exerlay-start (exerlay)
"Return buffer position of the start of EXERLAY."
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(vm-extent-start-position exerlay)
(overlay-start exerlay)))
(defun vmpc-exerlay-end (exerlay)
"Return buffer position of the end of EXERLAY."
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(vm-extent-end-position exerlay)
(overlay-end exerlay)))
(defun vmpc-move-exerlay (exerlay new-start new-end)
"Change EXERLAY to cover region from NEW-START to NEW-END."
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(vm-set-extent-endpoints exerlay new-start new-end (current-buffer))
(move-overlay exerlay new-start new-end (current-buffer))))
(defun vmpc-set-exerlay-detachable-property (exerlay newval)
"Set the 'detachable or 'evaporate property for EXERLAY to NEWVAL."
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(vm-set-extent-property exerlay 'detachable newval)
(overlay-put exerlay 'evaporate newval)))
(defun vmpc-set-exerlay-intangible-property (exerlay newval)
"Set the 'intangible or 'atomic property for EXERLAY to NEWVAL."
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(progn
(require 'atomic-extents)
(vm-set-extent-property exerlay 'atomic newval))
@@ -438,14 +438,14 @@ start and end of the overlay/extent."
(defun vmpc-set-exerlay-face (exerlay newface)
"Set the face used by EXERLAY to NEWFACE."
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(set-extent-face exerlay newface)
(overlay-put exerlay 'face newface)))
(defun vmpc-forcefully-detach-exerlay (exerlay)
"Leave EXERLAY in memory but detaches it from the buffer."
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(vm-detach-extent exerlay)
(delete-overlay exerlay)))
diff --git a/lisp/vm-pgg.el b/lisp/vm-pgg.el
index 5cd6c48144..e988d503a7 100644
--- a/lisp/vm-pgg.el
+++ b/lisp/vm-pgg.el
@@ -949,7 +949,7 @@ cleanup here after verification and decoding took place."
(insert-buffer-substring pgg-errors-buffer))
(vm-pgg-state-set 'verified)
(insert-buffer-substring
- (if vm-fsfemacs-p pgg-errors-buffer pgg-output-buffer))
+ (if (not (featurep 'xemacs)) pgg-errors-buffer
pgg-output-buffer))
(vm-pgg-crlf-cleanup start (point)))
(setq end (point))
(put-text-property start end 'face
@@ -1022,7 +1022,7 @@ cleanup here after verification and decoding took place."
(unless (pgg-snarf-keys)
(error "Snarfing failed"))
(save-excursion
- (set-buffer (if vm-fsfemacs-p pgg-errors-buffer pgg-output-buffer))
+ (set-buffer (if (not (featurep 'xemacs)) pgg-errors-buffer
pgg-output-buffer))
(message (buffer-substring (point-min) (point-max))))))
;;; ###autoload
diff --git a/lisp/vm-pine.el b/lisp/vm-pine.el
index 7f48cadff9..677e0699dc 100644
--- a/lisp/vm-pine.el
+++ b/lisp/vm-pine.el
@@ -496,7 +496,7 @@ creation). If DRAFT is non-nil, then do not delete the
draft message."
;; in the postponded folder expunge them right now
(when (string= (buffer-name buffer)
(file-name-nondirectory vm-postponed-folder))
- (if (and vm-xemacs-p (frames-of-buffer buffer t))
+ (if (and (featurep 'xemacs) (frames-of-buffer buffer t))
(iconify-frame (car (frames-of-buffer buffer))))
(when vm-auto-expunge-postponed-folder
(save-excursion
@@ -750,7 +750,7 @@ Drafts in other folders are not recognized!"
(not (vm-deleted-flag (car vm-message-pointer))))
(message "Please select a draft!")
(select-window (car (get-buffer-window-list buffer nil 0)))
- (if (and vm-xemacs-p (frames-of-buffer buffer))
+ (if (and (featurep 'xemacs) (frames-of-buffer buffer))
(deiconify-frame (car (frames-of-buffer buffer))))
(setq action 'none))
(setq action 'visit)))
@@ -930,7 +930,7 @@ See the variable `vm-mail-priority'."
(insert "\n" vm-mail-priority)))))
;;-----------------------------------------------------------------------------
-(if (not vm-xemacs-p)
+(if (not (featurep 'xemacs))
(defun user-home-directory ()
(getenv "HOME")))
@@ -1051,7 +1051,7 @@ This function is a slightly changed version of
`vm-auto-select-folder'."
;; match data.
(save-excursion
(set-buffer buf)
- (if vm-fsfemacs-mule-p
+ (if (not (featurep 'xemacs))
(set-buffer-multibyte nil)) ; for empty buffer
(widen)
(erase-buffer)
diff --git a/lisp/vm-pop.el b/lisp/vm-pop.el
index 48f5482f92..e03cf6c67b 100644
--- a/lisp/vm-pop.el
+++ b/lisp/vm-pop.el
@@ -737,7 +737,7 @@ killed as well."
(defun vm-pop-start-status-timer ()
(let ((blob (make-vector 12 nil))
timer)
- (setq timer (add-timeout 5 'vm-pop-report-retrieval-status blob 5))
+ (setq timer (run-with-timer 5 5 #'vm-pop-report-retrieval-status blob))
(vm-set-pop-stat-timer blob timer)
blob ))
@@ -1014,7 +1014,7 @@ popdrop
(setq end (vm-marker end))
(save-excursion
;; CRLF -> LF
- (if vm-xemacs-mule-p
+ (if (featurep 'xemacs)
(progn
;; we need this otherwise the end marker gets corrupt and
;; unfortunately decode-coding-region does not return the
diff --git a/lisp/vm-reply.el b/lisp/vm-reply.el
index 65265f09fc..92e264ec12 100644
--- a/lisp/vm-reply.el
+++ b/lisp/vm-reply.el
@@ -803,7 +803,7 @@ This function is a variant of `vm-get-header-contents'."
(defvar vm-dont-ask-coding-system-question nil)
-(cond ((and vm-fsfemacs-mule-p
+(cond ((and (not (featurep 'xemacs))
(fboundp 'select-message-coding-system)
(not (fboundp 'vm-old-select-message-coding-system)))
(fset 'vm-old-select-message-coding-system
@@ -1199,7 +1199,7 @@ See `vm-forward-message-plain' for forwarding messages in
plain text."
(insert "Content-Description: forwarded message\n")
;; eight bit chars will get \201 prepended if we
;; don't do this.
- (when vm-fsfemacs-mule-p
+ (when (not (featurep 'xemacs))
(set-buffer-multibyte t))) ; is this safe?
((equal vm-forwarding-digest-type "rfc934")
(vm-rfc934-encapsulate-messages
@@ -1341,7 +1341,7 @@ You may also create a Resent-Cc header."
(insert "Resent-To: \n")
(if mail-self-blind
(insert "Bcc: "
- (cond ((and vm-xemacs-p (fboundp 'user-mail-address))
+ (cond ((and (featurep 'xemacs) (fboundp 'user-mail-address))
(user-mail-address))
((and (boundp 'user-mail-address)
(stringp user-mail-address))
@@ -1695,7 +1695,7 @@ Binds the `vm-mail-mode-map' and hooks"
(set-buffer (generate-new-buffer buffer-name))
;; FSF Emacs: try to prevent write-region (called to handle FCC) from
;; asking the user to choose a safe coding system.
- (if (and vm-fsfemacs-mule-p (fboundp 'set-buffer-file-coding-system))
+ (if (and (not (featurep 'xemacs)) (fboundp 'set-buffer-file-coding-system))
(set-buffer-file-coding-system 'raw-text))
;; avoid trying to write auto-save files in potentially
;; unwritable directories.
@@ -1767,7 +1767,7 @@ Binds the `vm-mail-mode-map' and hooks"
(insert "Reply-To: " mail-default-reply-to "\n"))
(when mail-self-blind
(insert "Bcc: "
- (cond ((and vm-xemacs-p (fboundp 'user-mail-address))
+ (cond ((and (featurep 'xemacs) (fboundp 'user-mail-address))
(user-mail-address))
((and (boundp 'user-mail-address)
(stringp user-mail-address))
@@ -1846,7 +1846,7 @@ Binds the `vm-mail-mode-map' and hooks"
(mail-position-on-field "To" t))
((null subject)
(mail-position-on-field "Subject" t)))
- (cond ((and vm-xemacs-p
+ (cond ((and (featurep 'xemacs)
(fboundp 'start-itimer)
(null (get-itimer "vm-rename-mail"))
(start-itimer "vm-rename-mail"
diff --git a/lisp/vm-rfaddons.el b/lisp/vm-rfaddons.el
index 360c96b447..4ae8b5f4ed 100644
--- a/lisp/vm-rfaddons.el
+++ b/lisp/vm-rfaddons.el
@@ -109,7 +109,7 @@
(require 'sendmail)
(vm-load-features '(bbdb))
-(if vm-xemacs-p (require 'overlay))
+(if (featurep 'xemacs) (require 'overlay))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -617,7 +617,7 @@ buffer. (Rob F)"
;; predicate, require-match
nil t)
current-prefix-arg))
- (if (or vm-xemacs-mule-p vm-fsfemacs-p)
+ (if (or (featurep 'xemacs) (not (featurep 'xemacs)))
(error "vm-mime-8bit-composition-charset has no effect in XEmacs/MULE"))
(if buffer-local
(set (make-local-variable 'vm-mime-8bit-composition-charset) charset)
@@ -1177,9 +1177,9 @@ headers. (Rob F)"
:group 'vm-rfaddons)
(defconst vm-shrunken-headers-keymap
- (let ((map (if vm-xemacs-p (make-keymap) (copy-keymap vm-mode-map))))
+ (let ((map (if (featurep 'xemacs) (make-keymap) (copy-keymap vm-mode-map))))
(define-key map [(return)] 'vm-shrunken-headers-toggle-this)
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(define-key map [(button2)] 'vm-shrunken-headers-toggle-this-mouse)
(define-key map [(mouse-2)] 'vm-shrunken-headers-toggle-this-mouse))
map)
diff --git a/lisp/vm-save.el b/lisp/vm-save.el
index be514f9671..cde3230d08 100644
--- a/lisp/vm-save.el
+++ b/lisp/vm-save.el
@@ -79,7 +79,7 @@ specified, use `vm-auto-folder-alist'."
;; match data.
(save-excursion
(set-buffer buf)
- (if vm-fsfemacs-mule-p
+ (if (not (featurep 'xemacs))
(set-buffer-multibyte nil)) ; for empty buffer
(widen)
(erase-buffer)
diff --git a/lisp/vm-serial.el b/lisp/vm-serial.el
index 44686f9d3e..da3c81b29a 100644
--- a/lisp/vm-serial.el
+++ b/lisp/vm-serial.el
@@ -190,16 +190,16 @@
"a randomly selected your-style greeting")
;; german
("hallo" ("Hi" "Griass di" "Servus" "Hallo")
- "ein Hallo-Gru�")
+ "ein Hallo-Gruß")
("mausl" ("Mausl" "Liebling" "Schatzi" "Hallo")
"die Freundin")
- ("ciao" ("" "Ciao " "Tsch�� " "Servus " "Mach's gut " "Bis denn "
+ ("ciao" ("" "Ciao " "Tschüß " "Servus " "Mach's gut " "Bis denn "
"Bis die Tage mal ")
"Verabschiedung")
("sg" ("Sehr geehrte Frau/Herr")
- "f�rmliche Anrede")
- ("mfg" ("Mit freundlichen Gr��en")
- "f�rmliche Verabschiedung")
+ "förmliche Anrede")
+ ("mfg" ("Mit freundlichen Grüßen")
+ "förmliche Verabschiedung")
;; french
("salut" ("Salut" "Bonjour")
"Une salutation au hasard")
@@ -687,9 +687,9 @@ a warning."
(let ((token-regexp (concat (regexp-quote vm-serial-cookie)
"\\(" (regexp-quote vm-serial-cookie) "\\)*"
- "[{\(a-zA-Z]"))
+ "[{(a-zA-Z]"))
start end expr result vm-serial-point)
- (if (and vm-xemacs-p
+ (if (and (featurep 'xemacs)
(region-exists-p)
(eq (zmacs-region-buffer) (current-buffer)))
(setq rstart (goto-char (region-beginning)) rend (region-end))
diff --git a/lisp/vm-summary-faces.el b/lisp/vm-summary-faces.el
index 3ffb27a37a..855f75ad5a 100644
--- a/lisp/vm-summary-faces.el
+++ b/lisp/vm-summary-faces.el
@@ -42,7 +42,7 @@
(require 'vm-virtual))
;; (eval-and-compile
-;; (if vm-xemacs-p (require 'overlay)))
+;; (if (featurep 'xemacs) (require 'overlay)))
(declare-function vm-extent-property "vm-misc.el" (overlay prop) t)
(declare-function vm-set-extent-property "vm-misc.el" (overlay prop value) t)
diff --git a/lisp/vm-summary.el b/lisp/vm-summary.el
index 8a3bbd4f4e..40126f59d8 100644
--- a/lisp/vm-summary.el
+++ b/lisp/vm-summary.el
@@ -145,7 +145,7 @@ marked as modified."
bidi-paragraph-direction 'left-to-right)
;; horizontal scrollbar off by default
;; user can turn it on in summary hook if desired.
- (when (and vm-xemacs-p (featurep 'scrollbar))
+ (when (and (featurep 'xemacs) (featurep 'scrollbar))
(set-specifier scrollbar-height (cons (current-buffer) 0)))
(use-local-map vm-summary-mode-map)
(when (vm-menu-support-possible-p)
@@ -153,7 +153,7 @@ marked as modified."
;; using the 'mouse-face property gives faster highlighting than this.
;; (and vm-mouse-track-summary
;; (vm-mouse-support-possible-p)
-;; (vm-mouse-xemacs-mouse-p)
+;; (featurep 'xemacs)
;; (add-hook 'mode-motion-hook 'mode-motion-highlight-line))
(when (and vm-mutable-frame-configuration
(or vm-frame-per-folder vm-frame-per-summary))
@@ -189,12 +189,7 @@ mandatory."
;; (setq bufer-face-mode-face vm-summary-face)
;; (buffer-face-mode 1))
(vm-fsfemacs-nonmule-display-8bit-chars)
- (if (fboundp 'buffer-disable-undo)
- (buffer-disable-undo (current-buffer))
- ;; obfuscation to make the v19 compiler not whine
- ;; about obsolete functions.
- (let ((x 'buffer-flush-undo))
- (funcall x (current-buffer))))
+ (buffer-disable-undo (current-buffer))
(setq vm-mail-buffer b
vm-folder-read-only read-only)
(vm-summary-mode-internal))
@@ -693,14 +688,14 @@ Also move the cursor (point and window-point)."
(defun vm-summary-xxxx-highlight-region (start end face var)
(let ((ooo (symbol-value var)))
- (cond (vm-fsfemacs-p
+ (cond ((not (featurep 'xemacs))
(if (and ooo (overlay-buffer ooo))
(move-overlay ooo start end)
(setq ooo (make-overlay start end))
(set var ooo)
(overlay-put ooo 'evaporate nil)
(overlay-put ooo 'face face)))
- (vm-xemacs-p
+ ((featurep 'xemacs)
(if (and ooo (vm-extent-end-position ooo))
(vm-set-extent-endpoints ooo start end)
(setq ooo (vm-make-extent start end))
@@ -2366,7 +2361,7 @@ Call this function if you made changes to
`vm-summary-format'."
buffer-read-only t
buffer-offer-save nil
truncate-lines t)
- (when (and vm-xemacs-p (featurep 'scrollbar))
+ (when (and (featurep 'xemacs) (featurep 'scrollbar))
(set-specifier scrollbar-height (cons (current-buffer) 0)))
(use-local-map vm-folders-summary-mode-map)
(when (vm-menu-support-possible-p)
diff --git a/lisp/vm-toolbar.el b/lisp/vm-toolbar.el
index 6e9db1623d..edda1173c4 100644
--- a/lisp/vm-toolbar.el
+++ b/lisp/vm-toolbar.el
@@ -388,7 +388,7 @@ s-expression like this one in your .vm file:
(defun vm-toolbar-install-or-uninstall-toolbar ()
(and (vm-toolbar-support-possible-p) vm-use-toolbar
(vm-toolbar-install-toolbar))
- (if (and vm-fsfemacs-p (not vm-use-toolbar))
+ (if (and (not (featurep 'xemacs)) (not vm-use-toolbar))
(vm-toolbar-fsfemacs-uninstall-toolbar)))
(defcustom vm-toolbar-height nil
@@ -403,7 +403,7 @@ s-expression like this one in your .vm file:
;; save file is newer..."
(require 'vm-save)
(require 'vm-summary)
- (if vm-fsfemacs-p
+ (if (not (featurep 'xemacs))
(if (not vm-fsfemacs-toolbar-installed-p)
(vm-toolbar-fsfemacs-install-toolbar))
(if (not (vm-toolbar-pixmap-directory))
@@ -494,7 +494,7 @@ s-expression like this one in your .vm file:
(defun vm-toolbar-initialize ()
(cond
- (vm-fsfemacs-p nil)
+ ((not (featurep 'xemacs)) nil)
((null vm-toolbar-help-icon)
(let ((tuples
(list
diff --git a/lisp/vm-undo.el b/lisp/vm-undo.el
index 8d26e85609..370d15f10a 100644
--- a/lisp/vm-undo.el
+++ b/lisp/vm-undo.el
@@ -113,14 +113,14 @@
;; for the Undo button on the menubar, if present
(when (and (null vm-undo-record-list)
(vm-menu-support-possible-p)
- (vm-menu-xemacs-menus-p))
+ (featurep 'xemacs))
(vm-menu-set-menubar-dirty-flag)))
(defun vm-undo-record (sexp)
;; for the Undo button on the menubar, if present
(when (and (null vm-undo-record-list)
(vm-menu-support-possible-p)
- (vm-menu-xemacs-menus-p))
+ (featurep 'xemacs))
(vm-menu-set-menubar-dirty-flag))
(setq vm-undo-record-list (cons sexp vm-undo-record-list)))
diff --git a/lisp/vm-vars.el b/lisp/vm-vars.el
index 3d21b527aa..de5657bb6d 100644
--- a/lisp/vm-vars.el
+++ b/lisp/vm-vars.el
@@ -1850,7 +1850,7 @@ and when you read an email."
regexp))
(defcustom vm-mime-default-face-charsets
- (if vm-fsfemacs-mule-p
+ (if (not (featurep 'xemacs))
(if (eq window-system nil)
'("us-ascii" "ansi_x3.4-1968" "iso-8859-1")
'("us-ascii" "ansi_x3.4-1968"))
@@ -1878,10 +1878,7 @@ default face. This should only be used in combination
with
the mail you receive is displayable using your default face and
its associated font, even though the messages might arrive with
unknown or unregistered character sets specified in the MIME
-Content-Type header.
-
-To tell VM how to display other character sets, see
-`vm-mime-charset-font-alist'."
+Content-Type header."
:group 'vm-mime
:type '(choice (const t) (repeat string)))
@@ -1893,42 +1890,6 @@ default face even if they are also listed in
`vm-mime-default-face-charsets'."
:group 'vm-mime
:type '(repeat string))
-(defcustom vm-mime-charset-font-alist nil
- "*Assoc list of character sets and fonts that can be used to display them.
-The format of the list is:
-
- ( (CHARSET . FONT) ...)
-
-CHARSET is a string naming a MIME registered character set such
-as \"iso-8859-5\". Character set names should be specified in
-lower case.
-
-FONT is a string naming a font that can be used to display CHARSET.
-
-An example setup might be:
-
- (setq vm-mime-charset-font-alist
- '(
- (\"iso-8859-7\" . \"-*-*-medium-r-normal-*-16-160-72-72-c-80-iso8859-7\")
- )
- )
-
-This variable is only useful for character sets whose characters
-can all be encoded in single 8-bit bytes. Also multiple fonts
-can only be displayed if you're running under a window system
-e.g. X windows. So this variable will have no effect if you're
-running Emacs on a tty.
-
-If you're using FSF Emacs 20 or later, or you're using XEmacs with
-compiled in MULE support, this value of this variable is ignored.
-
-Note that under FSF Emacs 19, any fonts you use must be the
-same height as your default font. XEmacs does not have this
-limitation."
- :group 'vm-mime
- :type '(choice (const nil)
- (repeat (cons string string))))
-
(defcustom vm-mime-use-image-strips t
"*Non-nil means chop an image into horizontal strip for display.
Emacs treats a displayed image as a single large character and cannot
@@ -4397,7 +4358,7 @@ older VM installation."
(expand-file-name vm-configure-datadir))
(expand-file-name "pixmaps" vm-dir)
(expand-file-name "../pixmaps" vm-dir)
- (let ((d (and vm-xemacs-p
+ (let ((d (and (featurep 'xemacs)
(xemacs-locate-data-directory "vm"))))
(and d (expand-file-name "pixmaps" d)))))
image-dir)
@@ -5114,7 +5075,7 @@ decide the face."
(put 'vm-summary-marked-face 'face-alias 'vm-summary-marked)
(make-obsolete 'vm-summary-marked-face 'vm-summary-marked "8.2.0")
-(if vm-xemacs-p
+(if (featurep 'xemacs)
(defface vm-summary-deleted
'(
(((class color) (background light))
@@ -5892,7 +5853,7 @@ The default should work on UNIX systems."
:group 'vm-helpers
:type '(string :tag "Shell command"))
-(defcustom vm-uncompface-program (and vm-fsfemacs-p
+(defcustom vm-uncompface-program (and (not (featurep 'xemacs))
(fboundp 'image-type-available-p)
(vm-locate-executable-file "uncompface"))
"*Program used to convert X-Face data to Sun icon format.
@@ -5903,7 +5864,7 @@ display of X-Faces under Emacs 21."
:type '(choice (const :tag "None" nil)
file))
-(defcustom vm-icontopbm-program (and vm-fsfemacs-p
+(defcustom vm-icontopbm-program (and (not (featurep 'xemacs))
(fboundp 'image-type-available-p)
(vm-locate-executable-file "icontopbm"))
"*Program to convert Sun icon data to a PBM file.
@@ -5915,7 +5876,7 @@ data to XBM data."
file))
(defvar vm-uncompface-accepts-dash-x
- (and vm-fsfemacs-p (fboundp 'image-type-available-p)
+ (and (not (featurep 'xemacs)) (fboundp 'image-type-available-p)
(stringp vm-uncompface-program)
(eq 0 (string-match "#define"
(shell-command-to-string
@@ -6337,7 +6298,7 @@ Its parent keymap is mail-mode-map.")
(define-key map "$|" 'vm-mime-reader-map-pipe-to-command)
(define-key map "$a" 'vm-mime-reader-map-attach-to-composition)
(define-key map "$d" 'vm-delete-mime-object)
- (cond ((vm-mouse-xemacs-mouse-p)
+ (cond ((featurep 'xemacs)
(define-key map 'button3 'vm-menu-popup-mime-dispose-menu)))
(cond ((fboundp 'set-keymap-name)
(set-keymap-name map 'vm-mime-reader-map)))
@@ -7384,7 +7345,7 @@ actions to be taken to destroy them.")
(defconst vm-mime-header-list '("MIME-Version:" "Content-"))
(defconst vm-mime-header-regexp "\\(MIME-Version:\\|Content-\\)")
(defconst vm-mime-mule-charset-to-coding-alist
- (cond (vm-fsfemacs-mule-p
+ (cond ((not (featurep 'xemacs))
(let ((coding-systems (coding-system-list))
(alist nil)
val)
@@ -7448,7 +7409,7 @@ default alist is used.")
"Alist that maps MULE character sets to matching MIME character sets.")
(defconst vm-mime-mule-coding-to-charset-alist
- (cond (vm-fsfemacs-mule-p
+ (cond ((not (featurep 'xemacs))
(let ((coding-systems (coding-system-list))
(alist nil)
val)
diff --git a/lisp/vm-version.el b/lisp/vm-version.el
index adffd47263..d4bfbed23f 100644
--- a/lisp/vm-version.el
+++ b/lisp/vm-version.el
@@ -47,85 +47,36 @@
(message "VM version is: %s" vm-version))
vm-version)
-(defconst vm-xemacs-p
- (featurep 'xemacs))
-(defconst vm-xemacs-mule-p
- (and vm-xemacs-p (featurep 'mule)))
-(defconst vm-xemacs-file-coding-p
- (and vm-xemacs-p (featurep 'file-coding)
- ;; paranoia
- (fboundp
- 'set-buffer-file-coding-system)))
-(defconst vm-fsfemacs-p
- (not vm-xemacs-p))
-(defconst vm-fsfemacs-mule-p
- (and (not vm-xemacs-mule-p) (featurep 'mule)
- (fboundp 'set-buffer-file-coding-system)))
-
-(defconst vm-fsf-threads-p
- (and vm-fsfemacs-p
- (string-greaterp (emacs-version) "26.0")))
-
-(defun vm-xemacs-p () vm-xemacs-p)
-(defun vm-xemacs-mule-p () vm-xemacs-mule-p)
-(defun vm-xemacs-file-coding-p () vm-xemacs-file-coding-p)
-(defun vm-fsfemacs-p () vm-fsfemacs-p)
-(defun vm-fsfemacs-mule-p () vm-fsfemacs-mule-p)
-
-(defun vm-emacs-mule-p ()
- (or vm-xemacs-mule-p vm-fsfemacs-mule-p))
-
-(defun vm-mouse-fsfemacs-mouse-p ()
- (and vm-fsfemacs-p
- (fboundp 'set-mouse-position)))
-
-(defun vm-mouse-xemacs-mouse-p ()
- (and vm-xemacs-p
- (fboundp 'set-mouse-position)))
-
-(defun vm-menu-fsfemacs-menus-p ()
- (and vm-fsfemacs-p
- (fboundp 'menu-bar-mode)))
-
-(defun vm-menu-fsfemacs19-menus-p ()
- (and vm-fsfemacs-p
- (fboundp 'menu-bar-mode)
- (= emacs-major-version 19)))
-
-(defun vm-menu-xemacs-menus-p ()
- (and vm-xemacs-p
- (fboundp 'set-buffer-menubar)))
-
(defun vm-menu-can-eval-item-name ()
- (and vm-xemacs-p
+ (and (featurep 'xemacs)
(fboundp 'check-menu-syntax)
(condition-case nil
(check-menu-syntax '("bar" ((identity "foo") 'ding t)))
(error nil))))
(defun vm-multiple-frames-possible-p ()
- (cond (vm-xemacs-p
+ (cond ((featurep 'xemacs)
(or (memq 'win (device-matching-specifier-tag-list))
(featurep 'tty-frames)))
- (vm-fsfemacs-p
+ ((not (featurep 'xemacs))
(fboundp 'make-frame))))
(defun vm-mouse-support-possible-p ()
- (cond (vm-xemacs-p
+ (cond ((featurep 'xemacs)
(featurep 'window-system))
- (vm-fsfemacs-p
+ ((not (featurep 'xemacs))
(fboundp 'track-mouse))))
(defun vm-mouse-support-possible-here-p ()
- (cond (vm-xemacs-p
+ (cond ((featurep 'xemacs)
(memq 'win (device-matching-specifier-tag-list)))
- (vm-fsfemacs-p
+ ((not (featurep 'xemacs))
(memq window-system '(x mac w32 win32)))))
(defun vm-menu-support-possible-p ()
- (cond (vm-xemacs-p
+ (cond ((featurep 'xemacs)
(featurep 'menubar))
- (vm-fsfemacs-p
+ ((not (featurep 'xemacs))
(fboundp 'menu-bar-mode))))
(defun vm-menubar-buttons-possible-p ()
@@ -133,23 +84,23 @@
Windowing toolkits do not allow such buttons. This says whether such
buttons are possible under the current windowing system."
(not
- (cond (vm-xemacs-p (memq (device-type) '(gtk ns)))
- (vm-fsfemacs-p (or (and (eq window-system 'x) (featurep 'gtk))
+ (cond ((featurep 'xemacs) (memq (device-type) '(gtk ns)))
+ ((not (featurep 'xemacs)) (or (and (eq window-system 'x) (featurep
'gtk))
(eq window-system 'ns))))))
(defun vm-toolbar-support-possible-p ()
- (or (and vm-xemacs-p (featurep 'toolbar))
- (and vm-fsfemacs-p (fboundp 'tool-bar-mode) (boundp 'tool-bar-map))))
+ (or (and (featurep 'xemacs) (featurep 'toolbar))
+ (and (not (featurep 'xemacs)) (fboundp 'tool-bar-mode) (boundp
'tool-bar-map))))
(defun vm-multiple-fonts-possible-p ()
- (cond (vm-xemacs-p
+ (cond ((featurep 'xemacs)
(memq (device-type) '(x gtk mswindows)))
- (vm-fsfemacs-p
+ ((not (featurep 'xemacs))
(memq window-system '(x mac w32 win32)))))
(defun vm-images-possible-here-p ()
- (or (and vm-xemacs-p (memq (device-type) '(x gtk mswindows)))
- (and vm-fsfemacs-p window-system
+ (or (and (featurep 'xemacs) (memq (device-type) '(x gtk mswindows)))
+ (and (not (featurep 'xemacs)) window-system
(or (fboundp 'image-type-available-p)
(and (stringp vm-imagemagick-convert-program)
(stringp vm-imagemagick-identify-program))))))
diff --git a/lisp/vm-window.el b/lisp/vm-window.el
index d2963251b2..54971c8d94 100644
--- a/lisp/vm-window.el
+++ b/lisp/vm-window.el
@@ -147,7 +147,7 @@
(unwind-protect
(progn
(set-buffer (setq work-buffer (get-buffer-create "*vm-wconfig*")))
- (if vm-fsfemacs-mule-p
+ (if (not (featurep 'xemacs))
(set-buffer-multibyte nil)) ; for empty buffer
(erase-buffer)
(setq vm-window-configurations
@@ -166,7 +166,7 @@
(unwind-protect
(progn
(set-buffer (setq work-buffer (get-buffer-create "*vm-wconfig*")))
- (if vm-fsfemacs-mule-p
+ (if (not (featurep 'xemacs))
(set-buffer-multibyte nil)) ; for empty buffer
;; for MULE
(if (fboundp 'set-buffer-file-coding-system)
@@ -486,7 +486,7 @@ Run the hooks in vm-iconify-frame-hook before doing so."
(defun vm-bury-buffer (&optional buffer)
(or buffer (setq buffer (current-buffer)))
- (if vm-xemacs-p
+ (if (featurep 'xemacs)
(if (vm-multiple-frames-possible-p)
(vm-frame-loop 'bury buffer)
(bury-buffer buffer))
@@ -598,7 +598,7 @@ Run the hooks in vm-iconify-frame-hook before doing so."
(defun vm-warp-mouse-to-frame-maybe (&optional frame)
(or frame (setq frame (vm-selected-frame)))
(if (vm-mouse-support-possible-here-p)
- (cond ((vm-mouse-xemacs-mouse-p)
+ (cond ((featurep 'xemacs)
(cond ((fboundp 'mouse-position);; XEmacs 19.12 and up
(let ((mp (mouse-position)))
(if (and (car mp)
@@ -626,7 +626,7 @@ Run the hooks in vm-iconify-frame-hook before doing so."
;; (/ (apply 'screen-width frame) 2)
;; (/ (apply 'screen-height frame) 2))))
)))
- ((vm-fsfemacs-p)
+ (t
(let ((mp (mouse-position)))
(if (and (eq (car mp) frame)
;; nil coordinates mean that the mouse
@@ -694,7 +694,7 @@ Run the hooks in vm-iconify-frame-hook before doing so."
;; 2 April 1997, frame-totally-visible-p apparently still broken
;; under 19.15. I give up for now.
;;(if (and (fboundp 'frame-totally-visible-p)
-;; vm-xemacs-p
+;; (featurep 'xemacs)
;; (or (>= emacs-major-version 20)
;; (>= emacs-minor-version 15)))
;; (fset 'vm-frame-totally-visible-p 'frame-totally-visible-p)
diff --git a/lisp/vm.el b/lisp/vm.el
index 8d6a5226a7..2e045f73c8 100644
--- a/lisp/vm.el
+++ b/lisp/vm.el
@@ -224,12 +224,12 @@ deleted messages. Use `###' to expunge deleted messages."
;; [5] Prepare the folder buffer for MULE
- (if (and vm-fsfemacs-mule-p enable-multibyte-characters)
+ (if (and (not (featurep 'xemacs)) enable-multibyte-characters)
(set-buffer-multibyte nil)) ; is this safe?
(defvar buffer-file-coding-system)
- (if (or vm-xemacs-mule-p vm-xemacs-file-coding-p)
+ (if (featurep 'xemacs)
(vm-setup-xemacs-folder-coding-system))
- (if vm-fsfemacs-mule-p
+ (if (not (featurep 'xemacs))
(vm-setup-fsfemacs-folder-coding-system))
;; [6] Safeguards
@@ -1050,12 +1050,7 @@ virtual folder buffer."
default-directory))
(setq first-time (not (eq major-mode 'vm-virtual-mode)))
(when first-time
- (if (fboundp 'buffer-disable-undo)
- (buffer-disable-undo (current-buffer))
- ;; obfuscation to make the v19 compiler not whine
- ;; about obsolete functions.
- (let ((x 'buffer-flush-undo))
- (funcall x (current-buffer))))
+ (buffer-disable-undo (current-buffer))
(abbrev-mode 0)
(auto-fill-mode 0)
(vm-fsfemacs-nonmule-display-8bit-chars)
@@ -1277,12 +1272,7 @@ summary buffer to select a folder."
(abbrev-mode 0)
(auto-fill-mode 0)
(vm-fsfemacs-nonmule-display-8bit-chars)
- (if (fboundp 'buffer-disable-undo)
- (buffer-disable-undo (current-buffer))
- ;; obfuscation to make the v19 compiler not whine
- ;; about obsolete functions.
- (let ((x 'buffer-flush-undo))
- (funcall x (current-buffer))))
+ (buffer-disable-undo (current-buffer))
(vm-folders-summary-mode-internal))
(vm-make-folders-summary-associative-hashes)
(vm-do-folders-summary)))
@@ -1528,10 +1518,10 @@ summary buffer to select a folder."
(defun vm-check-emacs-version ()
"Checks the version of Emacs and gives an error if it is unsupported."
- (cond ((and vm-xemacs-p (< emacs-major-version 21))
+ (cond ((and (featurep 'xemacs) (< emacs-major-version 21))
(error "VM %s must be run on XEmacs 21 or a later version."
(vm-version)))
- ((and vm-fsfemacs-p (< emacs-major-version 21))
+ ((and (not (featurep 'xemacs)) (< emacs-major-version 21))
(error "VM %s must be run on GNU Emacs 21 or a later version."
(vm-version)))))
@@ -1631,14 +1621,14 @@ draft messages."
(setq vm-buffers-needing-display-update (make-vector 29 0))
(setq vm-buffers-needing-undo-boundaries (make-vector 29 0))
(add-hook 'post-command-hook 'vm-add-undo-boundaries)
- (if (if vm-xemacs-p
+ (if (if (featurep 'xemacs)
(find-face 'vm-monochrome-image)
(facep 'vm-monochrome-image))
nil
(make-face 'vm-monochrome-image)
(set-face-background 'vm-monochrome-image "white")
(set-face-foreground 'vm-monochrome-image "black"))
- (if (or (not vm-fsfemacs-p)
+ (if (or (not (not (featurep 'xemacs)))
;; don't need this face under Emacs 21.
(fboundp 'image-type-available-p)
(facep 'vm-image-placeholder))
@@ -1654,7 +1644,7 @@ draft messages."
(vm-mouse-install-mouse))
(and (vm-menu-support-possible-p)
vm-use-menus
- (vm-menu-fsfemacs-menus-p)
+ (not (featurep 'xemacs))
(vm-menu-initialize-vm-mode-menu-map))
(setq vm-session-beginning nil)))
;; check for postponed messages
- [nongnu] elpa/vm updated (9aa3a94cd3 -> b42345ac0e), ELPA Syncer, 2024/07/17
- [nongnu] elpa/vm b42345ac0e 6/6: Merge branch 'fix-version-warnings' into 'main',
ELPA Syncer <=
- [nongnu] elpa/vm 7e60631248 4/6: Remove support for `buffer-flush-undo` (Emacs<19.23), ELPA Syncer, 2024/07/17
- [nongnu] elpa/vm 1128dbf4d1 1/6: Simplify version tests, ELPA Syncer, 2024/07/17
- [nongnu] elpa/vm 2d88e30263 3/6: vm-mime|vars.el: Remove support for non-Mule emacsen, ELPA Syncer, 2024/07/17
- [nongnu] elpa/vm e2ca7cb77f 2/6: Avoid obsolete `add-timeout` and `disable-timeout`, ELPA Syncer, 2024/07/17
- [nongnu] elpa/vm 35d7b1d4ab 5/6: lisp/vm-menu.el (vm-menu--global-menubar): Consolidate (X)Emacs code paths, ELPA Syncer, 2024/07/17