home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / w3 / w3-mule.el < prev    next >
Encoding:
Text File  |  1995-07-08  |  5.8 KB  |  161 lines
  1. ;;; w3-mule.el,v --- MULE 18/19 specific functions for emacs-w3
  2. ;; Author: wmperry
  3. ;; Created: 1995/07/01 17:14:23
  4. ;; Version: 1.13
  5. ;; Keywords: faces, help, i18n, mouse, hypermedia
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com)
  9. ;;;
  10. ;;; This file is part of GNU Emacs.
  11. ;;;
  12. ;;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;;; it under the terms of the GNU General Public License as published by
  14. ;;; the Free Software Foundation; either version 2, or (at your option)
  15. ;;; any later version.
  16. ;;;
  17. ;;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;;; GNU General Public License for more details.
  21. ;;;
  22. ;;; You should have received a copy of the GNU General Public License
  23. ;;; along with GNU Emacs; see the file COPYING.  If not, write to
  24. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26.  
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28. ;;; Printing a mule buffer as postscript.  Requires m2ps
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30. (defun w3-m2ps-buffer (&optional buffer)
  31.   "Print a buffer by passing it through m2ps and lpr."
  32.   (or buffer (setq buffer (current-buffer)))
  33.   (let ((x (save-excursion (set-buffer buffer) tab-width)))
  34.     (save-excursion
  35.       (set-buffer (get-buffer-create " *mule-print*"))
  36.       (erase-buffer)
  37.       (insert-buffer buffer)
  38.       (if (/= x tab-width)
  39.       (progn
  40.         (setq tab-width x)
  41.         (message "Converting tabs")
  42.         (untabify (point-min) (point-max))))
  43.       (setq file-coding-system *internal*)
  44.       (shell-command-on-region (point-min) (point-max)
  45.                    "m2ps | lpr" t))))
  46.         
  47. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  48. ;;; Multi-Lingual Emacs (MULE) Specific Functions
  49. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  50. (if w3-running-FSF19
  51.     (progn
  52.       (fset 'w3-create-faces-origunal (symbol-function 'w3-create-faces))
  53.       (defun w3-create-faces ()
  54.     "Create faces, the no-so-dumb MULE 2.x way"
  55.     (w3-create-faces-origunal)
  56.     (setq w3-delimit-emphasis nil)
  57.     (setq w3-delimit-links nil)))
  58.   (defun w3-create-faces ()
  59.     "Create faces, the no-quite-so-dumb MULE 1.x way"
  60.     (setq w3-delimit-links nil))
  61.   )
  62.  
  63. (defvar attributed-region nil
  64.   "Bogus definition to get rid of compile-time warnings.")
  65.  
  66. (defvar w3-mule-marker-attribute-alist 
  67.   '(("SUBMIT"   . 'reverse)
  68.     ("RESET"    . 'reverse)
  69.     ("PASSWORD" . 'underline)
  70.     ("OPTION"   . 'underline)
  71.     (""         . 'underline))
  72.   "Pairs of anchors' TYPEs and their display ATTRIBUTEs. For emacs18.")
  73.  
  74. (defun w3-mule-overlay-attribute (ovl)
  75.   "Return a type of attribute for OVL. If OVL is not for
  76. links/forms/images/headers, nil is returned. For emacs19."
  77.   (let (ovp)
  78.     (cond ((and (setq ovp (overlay-get ovl 'w3))
  79.         (nth 1 ovp)) ;; has a HREF
  80.        'underline)
  81.       ((overlay-get ovl 'w3form) 'underline)
  82.       ((overlay-get ovl 'w3header) 'bold)
  83.       (t nil)
  84.       )))
  85.  
  86. (defun w3-mule-attribute-on-region (attr start end)
  87.   "Turn on ATTR for the characters within the region, but white spaces."
  88.   (save-excursion
  89.     (let ((buffer-read-only nil))
  90.       (goto-char start)
  91.       (skip-chars-forward " \t")
  92.       (setq start (point))
  93.       (end-of-line)
  94.       (while (< (point) end)
  95.     (attribute-on-region attr start (point))
  96.     (forward-line 1)
  97.     (skip-chars-forward " \t")
  98.     (setq start (point))
  99.     (if (= (point) end) t (end-of-line)) )
  100.       (attribute-on-region attr start end))))
  101.  
  102. (defun w3-mule-attribute-zones-19 (&optional zones)
  103.   "Trace overlays in the current buffer and turn on an appropriate
  104. attribute, if necessary. For Mule based on emacs19."
  105.   (let ((pos (point-min)) (pmax (point-max)) l)
  106.     (while (< pos pmax)
  107.       (if (setq l (overlays-at pos))
  108.       (let ((c 0) ovl at)
  109.         (while (setq ovl (nth c l))
  110.           (if (setq at (w3-mule-overlay-attribute ovl))
  111.           (w3-mule-attribute-on-region
  112.            at (overlay-start ovl) (overlay-end ovl)))
  113.           (setq c (1+ c)))))
  114.       (setq pos (next-overlay-change pos)))))
  115.  
  116. (defun w3-mule-attribute-zones-18 (zones)
  117.   "Turn on an appropriate attribute for each marker in ZONES.
  118. For Mule based on emacs18."
  119.   (save-excursion
  120.     (let ((c 0) l z type at beg end)
  121.       (while (setq z (nth c zones))
  122.     (setq type (nth 2 (nth 2 z)))
  123.     (if (null type) t
  124.       (setq at (or (cdr (assoc type w3-mule-marker-attribute-alist)) 
  125.                w3-mule-attribute))
  126.       (w3-mule-attribute-on-region at (nth 0 z) (nth 1 z)))
  127.     (setq c (1+ c))))))
  128.  
  129. (fset 'w3-mule-attribute-zones 
  130.       (if w3-running-FSF19
  131.       'w3-mule-attribute-zones-19 
  132.     'w3-mule-attribute-zones-18))
  133.  
  134. (defun w3-inhibit-code-conversion (proc buf)
  135.   "Inhibit Mule's subprocess PROC from code converting in BUF."
  136.   (save-excursion
  137.     (set-buffer buf)
  138.     (setq mc-flag nil))
  139.   (set-process-coding-system proc *noconv* *noconv*))
  140.  
  141. (defconst w3-mime-list-for-code-conversion
  142.   '("text/plain" "text/html")
  143.   "List of MIME types that require Mules' code conversion.")
  144.  
  145. (defun w3-convert-code-for-mule (mmtype)
  146.   "Convert current data into the appropriate coding system"
  147.   (and (or (not mmtype) (member mmtype w3-mime-list-for-code-conversion))
  148.        (let* ((c (code-detect-region (point-min) (point-max)))
  149.           (code (or (and (listp c) (car c)) c)))
  150.      (setq mc-flag t)
  151.      (code-convert-region (point-min) (point-max) code *internal*)
  152.      (set-file-coding-system code))))
  153.  
  154. (or (fboundp 'attribute-on-region)
  155.     (defun attribute-on-region (attr from to)
  156.       (let ((face (cond ((eq attr 'inverse) 'region)
  157.             (t attr))))
  158.     (add-text-properties from to (list 'face face)))))
  159.  
  160. (provide 'w3-mule)
  161.