cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/mew-xemacs.el

   1 ;;; mew-xemacs.el --- Environment of XEmacs for Mew
   2
   3 ;; Author:  Kazu Yamamoto <Kazu@Mew.org>
   4 ;; Created: Mar 20, 1997
   5 ;; Revised: Aug 30, 1999
   6
   7 ;;; Code:
   8
   9 (defconst mew-xemacs-version "mew-xemacs.el version 0.09")
  10
  11 ;;
  12 ;; Common
  13 ;;
  14
  15 (cond
  16  ((not mew-icon-p)
  17   (defvar mew-icon-directory nil)
  18   (defvar mew-icon-separate-spec nil)
  19   (defvar mew-icon-blank nil)
  20   (defvar mew-icon-audio nil)
  21   (defvar mew-icon-image nil)
  22   (defvar mew-icon-video nil)
  23   (defvar mew-icon-application/postscript nil)
  24   (defvar mew-icon-application/octet-stream nil)
  25   (defvar mew-icon-message/rfc822 nil)
  26   (defvar mew-icon-message/external-body nil)
  27   (defvar mew-icon-text nil)
  28   (defvar mew-icon-multipart nil)
  29   (defvar mew-icon-unknown nil)
  30   (defvar mew-summary-toolbar nil)
  31   (defvar mew-draft-toolbar nil))
  32  (t
  33   (defvar mew-icon-directory (locate-data-directory "mew"))
  34
  35   (defvar mew-icon-separate
  36     (toolbar-make-button-list
  37      (expand-file-name "mew-sep.xpm" mew-icon-directory)))
  38
  39   (defvar mew-icon-separate-spec
  40     (list [mew-icon-separate nil nil ""]))
  41
  42   (defvar mew-icon-blank
  43     (toolbar-make-button-list
  44      (expand-file-name "mew-Blank.xpm" mew-icon-directory)))
  45
  46   (defvar mew-icon-audio
  47     (toolbar-make-button-list
  48      (expand-file-name "mew-Audio.xpm" mew-icon-directory)))
  49
  50   (defvar mew-icon-image
  51     (toolbar-make-button-list
  52      (expand-file-name "mew-Image.xpm" mew-icon-directory)))
  53
  54   (defvar mew-icon-video
  55     (toolbar-make-button-list
  56      (expand-file-name "mew-Video.xpm" mew-icon-directory)))
  57
  58   (defvar mew-icon-application/postscript
  59     (toolbar-make-button-list
  60      (expand-file-name "mew-Postscript.xpm" mew-icon-directory)))
  61
  62   (defvar mew-icon-application/octet-stream
  63     (toolbar-make-button-list
  64      (expand-file-name "mew-Octet-Stream.xpm" mew-icon-directory)))
  65
  66   (defvar mew-icon-message/rfc822
  67     (toolbar-make-button-list
  68      (expand-file-name "mew-Rfc822.xpm" mew-icon-directory)))
  69
  70   (defvar mew-icon-message/external-body
  71     (toolbar-make-button-list
  72      (expand-file-name "mew-External.xpm" mew-icon-directory)))
  73
  74   (defvar mew-icon-text
  75     (toolbar-make-button-list
  76      (expand-file-name "mew-Text.xpm" mew-icon-directory)))
  77
  78   (defvar mew-icon-multipart
  79     (toolbar-make-button-list
  80      (expand-file-name "mew-Folder.xpm" mew-icon-directory)))
  81
  82   (defvar mew-icon-unknown
  83     (toolbar-make-button-list
  84      (expand-file-name "mew-Unknown.xpm" mew-icon-directory)))
  85
  86   ;;
  87   ;; Summary mode
  88   ;;
  89
  90   (defvar mew-summary-toolbar-icon-show
  91     (toolbar-make-button-list
  92      (expand-file-name "mew-show.xpm" mew-icon-directory)))
  93
  94   (defvar mew-summary-toolbar-icon-next
  95     (toolbar-make-button-list
  96      (expand-file-name "mew-next.xpm" mew-icon-directory)))
  97
  98   (defvar mew-summary-toolbar-icon-prev
  99     (toolbar-make-button-list
 100      (expand-file-name "mew-prev.xpm" mew-icon-directory)))
 101
 102   (defvar mew-summary-toolbar-icon-inc
 103     (toolbar-make-button-list
 104      (expand-file-name "mew-inc.xpm" mew-icon-directory)))
 105
 106   (defvar mew-summary-toolbar-icon-write
 107     (toolbar-make-button-list
 108      (expand-file-name "mew-write.xpm" mew-icon-directory)))
 109
 110   (defvar mew-summary-toolbar-icon-reply
 111     (toolbar-make-button-list
 112      (expand-file-name "mew-reply.xpm" mew-icon-directory)))
 113
 114   (defvar mew-summary-toolbar-icon-forward
 115     (toolbar-make-button-list
 116      (expand-file-name "mew-forward.xpm" mew-icon-directory)))
 117
 118   (defvar mew-summary-toolbar-icon-refile
 119     (toolbar-make-button-list
 120      (expand-file-name "mew-refile.xpm" mew-icon-directory)))
 121
 122   (defvar mew-summary-toolbar
 123     '(
 124       [mew-summary-toolbar-icon-show
 125        mew-summary-show
 126        t
 127        "Read Forward"]
 128       [mew-summary-toolbar-icon-next
 129        mew-summary-display-down
 130        t
 131        "Show Next Message"]
 132       [mew-summary-toolbar-icon-prev
 133        mew-summary-display-up
 134        t
 135        "Show Previous Message"]
 136       [mew-summary-toolbar-icon-inc
 137        mew-summary-get
 138        t
 139        "Check New Messages"]
 140       [mew-summary-toolbar-icon-write
 141        mew-summary-send
 142        t
 143        "Write Message"]
 144       [mew-summary-toolbar-icon-reply
 145        mew-summary-reply
 146        t
 147        "Reply to This Message"]
 148       [mew-summary-toolbar-icon-forward
 149        mew-summary-forward
 150        t
 151        "Forward This Message"]
 152       [mew-summary-toolbar-icon-refile
 153        mew-summary-refile
 154        t
 155        "Refile This Message"]
 156       ))
 157
 158   ;;
 159   ;; Draft mode
 160   ;;
 161
 162   (defvar mew-draft-toolbar-icon-comp
 163     (toolbar-make-button-list
 164      (expand-file-name "mew-comp.xpm" mew-icon-directory)))
 165
 166   (defvar mew-draft-toolbar-icon-send
 167     (toolbar-make-button-list
 168      (expand-file-name "mew-send.xpm" mew-icon-directory)))
 169
 170   (defvar mew-draft-toolbar-icon-attach
 171     (toolbar-make-button-list
 172      (expand-file-name "mew-attach.xpm" mew-icon-directory)))
 173
 174   (defvar mew-draft-toolbar-icon-cite
 175     (toolbar-make-button-list
 176      (expand-file-name "mew-cite.xpm" mew-icon-directory)))
 177
 178   (defvar mew-draft-toolbar-icon-yank
 179     (toolbar-make-button-list
 180      (expand-file-name "mew-yank.xpm" mew-icon-directory)))
 181
 182   (defvar mew-draft-toolbar-icon-pgp-sign
 183     (toolbar-make-button-list
 184      (expand-file-name "mew-pgp-sign.xpm" mew-icon-directory)))
 185
 186   (defvar mew-draft-toolbar-icon-pgp-enc
 187     (toolbar-make-button-list
 188      (expand-file-name "mew-pgp-enc.xpm" mew-icon-directory)))
 189
 190   (defvar mew-draft-toolbar-icon-pgp-sigenc
 191     (toolbar-make-button-list
 192      (expand-file-name "mew-pgp-sigenc.xpm" mew-icon-directory)))
 193
 194   (defvar mew-draft-toolbar
 195     '(
 196       [mew-draft-toolbar-icon-comp
 197        mew-draft-make-message
 198        (mew-header-p)
 199        "Compose Message"]
 200       [mew-draft-toolbar-icon-send
 201        mew-draft-send-letter
 202        (not (mew-header-p))
 203        "Send Message"]
 204       [mew-draft-toolbar-icon-cite
 205        mew-draft-cite
 206        (mew-header-p)
 207        "Cite Message"]
 208       [mew-draft-toolbar-icon-yank
 209        mew-draft-yank
 210        (mew-header-p)
 211        "Cite Message without Label"]
 212       [mew-draft-toolbar-icon-attach
 213        mew-draft-prepare-attachments
 214        (and (mew-header-p) (not (mew-attach-p)))
 215        "Prepare Attachments"]
 216       [mew-draft-toolbar-icon-pgp-sign
 217        mew-pgp-sign-letter
 218        (mew-header-p)
 219        "Sign Message with PGP"]
 220       [mew-draft-toolbar-icon-pgp-enc
 221        mew-pgp-encrypt-letter
 222        (mew-header-p)
 223        "Encrypt Message with PGP"]
 224       [mew-draft-toolbar-icon-pgp-sigenc
 225        mew-pgp-sign-encrypt-letter
 226        (mew-header-p)
 227        "Sign Then Encrypt Message with PGP"]
 228       ))
 229
 230   ;;
 231   ;; Button
 232   ;;
 233
 234   (define-key toolbar-map 'button3   'pressed-and-activate-toolbar-button)
 235   (define-key toolbar-map 'button3up 'release-and-activate-toolbar-button)
 236
 237   (defun mew-summary-button ()
 238     "Call back function for toolbar of Summary mode.
 239 If event is button 1, show a part.
 240 If event is button 3, show a menu."
 241     (interactive)
 242     (let* ((msg (mew-summary-message-number))
 243            (part (mew-syntax-number))
 244            (nums (mew-syntax-number-to-nums part))
 245            (button (event-button last-command-event)))
 246       (mew-summary-goto-part msg part)
 247       (mew-summary-recenter)
 248       (cond
 249        ((eq button 1)
 250         (mew-summary-show-part msg nums))
 251        ((eq button 3)
 252         (popup-menu mew-summary-mode-toolbar-menu)))))
 253
 254   (defun mew-summary-show-part (msg nums)
 255     "Show a part according to the clicked icon."
 256     (interactive)
 257     (let ((fld (mew-summary-folder-name))
 258           (ofld-msg (mew-current-get 'message))
 259           (buf (buffer-name)))
 260       (if (null nums)
 261           (message "No message")
 262         (mew-summary-toggle-disp-msg 'on)
 263         (unwind-protect
 264             (progn
 265               (mew-window-configure buf 'message)
 266               ;; message buffer
 267               (mew-summary-display-part
 268                (mew-cache-decode-syntax (mew-cache-hit ofld-msg)) nums))
 269           (mew-pop-to-buffer buf)))))
 270
 271   (defun mew-draft-button ()
 272     "Call back function for toolbar of Draft mode.
 273 If event is button 1, show a part.
 274 If event is button 3, show a menu."
 275     (interactive)
 276     (let ((nums (mew-syntax-nums))
 277           (button (event-button last-command-event)))
 278       (mew-attach-goto-number 'here nums)
 279       (cond
 280        ((eq button 1)
 281         (mew-draft-show-attach nums))
 282        ((eq button 3)
 283         (popup-menu mew-draft-mode-toolbar-menu)))))
 284
 285   ;; This is a toy at present. Support only CT: Image/*.
 286   ;; To make Summary and Draft symmetric, left button click on icon
 287   ;; should display the attachment.
 288   (defun mew-draft-show-attach (nums)
 289     "Show a part according to the clicked icon."
 290     (interactive)
 291     (let ((case-fold-search t)
 292           (str (toolbar-button-help-string last-pressed-toolbar-button))
 293           (image-extent (extent-at (point-max) nil nil nil 'at))
 294           ct)
 295       (if (and image-extent (glyphp image-extent))
 296           (mew-overlay-delete image-extent))
 297       (if (null (string-match "(\\(.*\\))" str))
 298           ()
 299         (setq ct (mew-match 1 str))
 300         (if (string-match "^Image/" ct)
 301             (let* ((subdir (mew-attach-expand-path mew-encode-syntax nums))
 302                    (syntax (mew-syntax-get-entry mew-encode-syntax nums))
 303                    (name (mew-syntax-get-file syntax))
 304                    (ename (if (equal subdir "") name (concat subdir name)))
 305                    (file (expand-file-name ename (mew-attachdir)))
 306                    (attr (mew-attr-by-ct ct))
 307                    (program (mew-attr-get-prog attr))
 308                    (options (mew-attr-get-opt attr))
 309                    (async   (mew-attr-get-async attr))
 310                    (zmacs-regions nil) ;; for XEmacs
 311                    (format (cond
 312                             ((and (string-match "jpeg" ct)
 313                                   (valid-image-instantiator-format-p 'jpeg))
 314                              'jpeg)
 315                             ((and (string-match "gif" ct)
 316                                   (valid-image-instantiator-format-p 'gif))
 317                              'gif)
 318                             ((and (string-match "xbm" ct)
 319                                   (valid-image-instantiator-format-p 'xbm))
 320                              'xbm)
 321                             ((and (string-match "xpm" ct)
 322                                   (valid-image-instantiator-format-p 'xpm))
 323                              'xpm)
 324                             ((and (string-match "png" ct)
 325                                   (valid-image-instantiator-format-p 'png))
 326                              'png)
 327                             (t nil)))
 328                    glyph)
 329               (if format
 330                   (progn
 331                     (message "Loading image...")
 332                     (setq glyph (make-glyph (vector format :file file)))
 333                     (if (eq format 'xbm)
 334                         (set-glyph-property glyph 'face 'x-face))
 335                     (set-extent-begin-glyph
 336                      (mew-overlay-make (point-max) (point-max)) glyph)
 337                     (message "Loading image...done."))
 338                 (if (and (stringp program) (mew-which program exec-path))
 339                     (if async
 340                         (mew-mime-start-process program options file)
 341                       (mew-mime-call-process program options file)))))))))
 342
 343   (defun pressed-and-activate-toolbar-button (event)
 344     "A replacement function 'press-toolbar-button' so that
 345 popup menu can be implemented."
 346     (interactive "_e")
 347     (or (button-press-event-p event)
 348         (error "%s must be invoked by a mouse-press" this-command))
 349     (let ((button (event-toolbar-button event)) callback)
 350       (if (null (toolbar-button-p button))
 351           ()
 352         (setq last-pressed-toolbar-button button)
 353         (if (and (setq callback (toolbar-button-callback button))
 354                  (or (equal callback 'mew-summary-button)
 355                      (equal callback 'mew-draft-button)))
 356             (if (null (toolbar-button-enabled-p button))
 357                 ()
 358               ;; (setq toolbar-active t) is meaningless... why?
 359               (setq this-command callback)
 360               (if (symbolp callback)
 361                   (call-interactively callback)
 362                 (eval callback)))
 363           ;; emulate press-toolbar-button
 364           (setq this-command last-command)
 365           (setq toolbar-active t)
 366           (set-toolbar-button-down-flag button t)))))
 367
 368   )) ;; end of cond
 369
 370
 371 (defmacro mew-summary-toolbar-update ()
 372   '(if mew-icon-p
 373        (set-specifier default-toolbar
 374                       (cons (current-buffer) mew-summary-toolbar))))
 375
 376 (defmacro mew-draft-toolbar-update ()
 377   '(if mew-icon-p
 378        (set-specifier default-toolbar
 379                       (cons (current-buffer) mew-draft-toolbar))))
 380
 381 (defvar mew-x-emacs-end-of-message nil)
 382 (defvar mew-x-emacs-end-of-part nil)
 383
 384 (defmacro mew-message-set-end-of-message ()
 385   '(progn
 386      (if (not (glyphp mew-x-emacs-end-of-message))
 387          (setq mew-x-emacs-end-of-message
 388                (make-glyph
 389                 (vector 'string :data mew-end-of-message-string))))
 390      (mew-overlay-put mew-message-overlay
 391                       'begin-glyph
 392                       mew-x-emacs-end-of-message)))
 393
 394 (defmacro mew-message-set-end-of-part ()
 395   '(progn
 396      (if (not (glyphp mew-x-emacs-end-of-part))
 397          (setq mew-x-emacs-end-of-part
 398                (make-glyph
 399                 (vector 'string :data mew-end-of-part-string))))
 400      (mew-overlay-put mew-message-overlay
 401                       'begin-glyph
 402                       mew-x-emacs-end-of-part)))
 403
 404 (defmacro mew-message-set-end-of-nil ()
 405   '(mew-overlay-put mew-message-overlay 'begin-glyph nil))
 406
 407 (provide 'mew-xemacs)
 408
 409 ;;; Copyright Notice:
 410
 411 ;; Copyright (C) 1997, 1998, 1999 Mew developing team.
 412 ;; All rights reserved.
 413
 414 ;; Redistribution and use in source and binary forms, with or without
 415 ;; modification, are permitted provided that the following conditions
 416 ;; are met:
 417 ;;
 418 ;; 1. Redistributions of source code must retain the above copyright
 419 ;;    notice, this list of conditions and the following disclaimer.
 420 ;; 2. Redistributions in binary form must reproduce the above copyright
 421 ;;    notice, this list of conditions and the following disclaimer in the
 422 ;;    documentation and/or other materials provided with the distribution.
 423 ;; 3. Neither the name of the team nor the names of its contributors
 424 ;;    may be used to endorse or promote products derived from this software
 425 ;;    without specific prior written permission.
 426 ;;
 427 ;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
 428 ;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 429 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 430 ;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
 431 ;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 432 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 433 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 434 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 435 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 436 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
 437 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 438
 439 ;;; mew-xemacs.el ends here