home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / w3 / w3-emacs.el < prev    next >
Encoding:
Text File  |  1995-06-16  |  9.4 KB  |  308 lines
  1. ;;; w3-emacs.el,v --- Emacs 18.xx specific functions for emacs-w3
  2. ;; Author: wmperry
  3. ;; Created: 1995/06/14 23:09:05
  4. ;; Version: 1.19
  5. ;; Keywords: faces, help, 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. ;;; Normal Emacs Specific Functions
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30. (defun face-list () nil)
  31.  
  32. (defun w3-create-faces ()
  33.   "Create faces, the dumb emacs 18 way"
  34.   nil)
  35.  
  36. (defun w3-find-specific-link (link)
  37.   "Find LINK in the current document"
  38.   (let* ((thezones w3-zones-list))
  39.     (while (and thezones
  40.         (not
  41.          (equal link
  42.             (car-safe (cdr (car (cdr (cdr (car thezones)))))))))
  43.       (setq thezones (cdr thezones)))
  44.     (if thezones (goto-char (car (car thezones)))
  45.       (message "Link %s was not found." link))))
  46.  
  47. (fset 'w3-zone-eq 'eq)
  48. (defun w3-zone-hidden-p (start end)
  49.   "Return t iff the region from start to end is invisible."
  50.   nil)
  51.  
  52. (defun w3-unhide-zone (start end)
  53.   "Make a region from START TO END visible. (emacs18-unfunctional)"
  54.   nil)
  55.  
  56. (defun w3-hide-zone (start end)
  57.   "Make a region from START to END invisible. (emacs18-nonfunctional)"
  58.   nil)
  59.  
  60. (defun w3-add-zone (start end style data &optional highlight)
  61.   "Add a zone (normal emacs)"
  62.   (if (memq (car data) '(w3 w3form w3graphic))
  63.       (cond
  64.        ((or (null w3-zones-list)
  65.         (< start (car (car w3-zones-list))))
  66.     (setq w3-zones-list (cons (list (copy-marker start)
  67.                     (copy-marker end)
  68.                     data) w3-zones-list)))
  69.        (t
  70.     (let ((zones w3-zones-list))
  71.       (while (and (cdr zones)
  72.               (< (car (car (cdr zones))) start))
  73.         (setq zones (cdr zones)))
  74.       (setcdr zones (cons (list
  75.                    (copy-marker start)
  76.                    (copy-marker end)
  77.                    data)
  78.                   (cdr zones))))))))
  79.  
  80. (defun w3-extend-zone (zone new-end)
  81.   (set-marker (nth 1 (car zone)) new-end))
  82.  
  83. (defun w3-all-zones ()
  84.   "Return all the zones in this buffer."
  85.   w3-zones-list)
  86.  
  87. (defun w3-zones-list ()
  88.   "Return a list of zones for this buffer"
  89.   w3-zones-list)
  90.  
  91. (defun w3-zone-at (pt)
  92.   "Return zone (if any) at buffer position PT"
  93.   (let ((zones w3-zones-list))
  94.     (while (and zones
  95.         (not (and
  96.               (>= (car (cdr (car zones))) pt)
  97.               (<= (car (car zones)) pt))))
  98.       (setq zones (cdr zones)))
  99.     (if zones (car zones)
  100.       nil)))
  101.  
  102. (defun w3-delete-zone (zone)
  103.   "Delete zone ZONE in this buffer."
  104.   (let ((tmp w3-zones-list)
  105.     (val '()))
  106.     (while tmp
  107.       (if (not (eq (car tmp) zone))
  108.       (setq val (append val (list (car tmp)))))
  109.       (setq tmp (cdr tmp)))
  110.     (setq w3-zones-list val)))
  111.  
  112. (defun w3-zone-end (zone)
  113.   "Return the ending position of zone ZONE"
  114.   (marker-position (car (cdr zone))))
  115.  
  116. (defun w3-zone-start (zone)
  117.   "Return the starting position of zone ZONE"
  118.   (marker-position (car zone)))
  119.  
  120. (defun w3-fix-extent-endpoints ()
  121.   "Not done yet"
  122.   (let ((x (w3-all-zones))
  123.         st nd ch st-marker nd-marker)
  124.     (while x
  125.       (setq st-marker (car (car x))
  126.             nd-marker (car (cdr (car x)))
  127.             st (marker-position st-marker)
  128.             nd (marker-position nd-marker))
  129.       (while (memq (char-after (1- nd)) '(9 13 10 32))
  130.         (setq nd (1- nd)
  131.               ch t))
  132.       (if ch (set-marker nd-marker nd))
  133.       (setq ch nil)
  134.       (while (memq (char-after st) '(9 13 10 32))
  135.     (setq st (1+ st)
  136.           ch t))
  137.       (if ch (set-marker st-marker st))
  138.       (setq x (cdr x)))))
  139.  
  140. (defun w3-next-zone (zone)
  141.   "Return zone (if any) after ZONE"
  142.   (let ((zones w3-zones-list))
  143.     (while (and zones
  144.         (not (and (equal (car (cdr (car zones)))
  145.                  (car (cdr zone)))
  146.               (equal (car (car zones))
  147.                  (car zone)))))
  148.       (setq zones (cdr zones)))
  149.     (while (eq (car (nth 2 (car zones))) 'w3graphic)
  150.       (setq zones (cdr zones)))
  151.     (if (cdr zones)
  152.     (car (cdr zones))
  153.       nil)))
  154.  
  155. (defun w3-previous-zone (zone)
  156.   "Return zone (if any) before ZONE"
  157.   (let ((zones w3-zones-list)
  158.     (last nil))
  159.     (while (not (eql (car zones) zone))    ; Get to current zone
  160.       (if (eq (car (nth 2 (car zones))) 'w3graphic)
  161.       nil                ; Don't keep track of graphic zones
  162.     (setq last (car zones)))
  163.       (setq zones (cdr zones)))
  164.     (if zones
  165.     last
  166.       nil)))
  167.  
  168. (defun w3-zone-data (zone)
  169.   "Return the data segment from zone ZONE"
  170.   (car (cdr (cdr zone))))
  171.  
  172. (defvar w3-ignore-links '(w3graphic)
  173.   "*List of link types to skip when w3-forward-link or
  174. w3-backward-link is called.")
  175.  
  176. (defun w3-forward-link (p)
  177.   "Go forward 1 link"
  178.   (interactive "P")
  179.   (setq p (or p 1))
  180.   (if (< p 0)
  181.       (w3-back-link (- p))
  182.     (if (/= 1 p)
  183.     (w3-forward-link (1- p)))
  184.     (let ((zones w3-zones-list))
  185.       (while (and zones
  186.           (or (<= (car (car zones)) (point))
  187.               (memq (car (w3-zone-data (car zones)))
  188.                 w3-ignore-links)))
  189.     (setq zones (cdr zones)))
  190.       (if zones
  191.       (progn
  192.         (goto-char (car (car zones)))
  193.         (while (looking-at "[ \t\n]+") (forward-char 1)))
  194.     (error "No more links.")))))
  195.  
  196. (defun w3-back-link (p)
  197.   "Go back 1 link"
  198.   (interactive "P")
  199.   (setq p (or p 1))
  200.   (if (< p 0)
  201.       (w3-forward-link (- p))
  202.     (if (/= 1 p)
  203.     (w3-back-link (1- p)))
  204.     (cond
  205.      ((null w3-zones-list)
  206.       (error "No links in this document."))
  207.      ((> (car (cdr (car w3-zones-list))) (point))
  208.       (error "No previous link"))
  209.      (t
  210.       (let* ((zones w3-zones-list)
  211.          (last-zone (if (memq (car (w3-zone-data (car zones)))
  212.                        w3-ignore-links)
  213.                 nil
  214.               zones)))
  215.     (while (and (cdr zones)
  216.             (< (car (cdr (car (cdr zones)))) (point)))
  217.       (if (not (memq (car (w3-zone-data (car (cdr zones))))
  218.              w3-ignore-links))
  219.           (setq last-zone (cdr zones)))
  220.       (setq zones (cdr zones)))
  221.     (if (null last-zone)
  222.         (error "No previous link"))
  223.     (goto-char (car (car last-zone)))
  224.     (while (looking-at "[ \t\n]+") (forward-char 1)))))))
  225.  
  226. (defun w3-follow-inlined-image ()
  227.   "Follow an inlined image, regardless of whether its a link or not."
  228.   (interactive)
  229.   (let* ((zn (w3-zone-at (point))))
  230.     (cond
  231.      ((null zn) (error "Not on a link!"))
  232.      ((eq (car zn) 'w3graphic) (url-maybe-relative (nth 1 zn)))
  233.      (t (error "No inlined image at point.")))))
  234.  
  235. (defvar w3-old-mouse-function-cm nil "Old Ctrl-middle mouse binding.")
  236. (defvar w3-old-mouse-function-m nil "Old Ctrl-middle mouse binding.")
  237.  
  238. (defun w3-follow-inlined-image-mouse (arg)
  239.   "Follow a mouse over an inlined image.  If buffer is not in w3-mode, then
  240. call function 'w3-fold-mouse-function-cm"
  241.   (x-mouse-set-point arg)
  242.   (if (eq major-mode 'w3-mode)
  243.       (w3-follow-inlined-image)
  244.     (funcall w3-old-mouse-function-cm arg)))
  245.  
  246. (defun w3-follow-mouse (arg)
  247.   "Follow a mouse key in emacs 18, if buffer is not in W3-mode, then
  248. call function 'w3-old-mouse-function-m"
  249.   (x-mouse-set-point arg)
  250.   (if (eq major-mode 'w3-mode)
  251.       (w3-follow-link)
  252.     (funcall w3-old-mouse-function-m arg)))
  253.  
  254. (defun w3-setup-version-specifics ()
  255.   "Set up routine for emacs 18/NeXTemacs"
  256.   (fset 'w3-insert 'insert-before-markers)
  257.   (cond
  258.    ((and (fboundp 'define-mouse)
  259.      (eq system-type 'next-mach))
  260.     (require 'w3-next))
  261.    ((eq system-type 'Apple-Macintosh) (require 'w3-mac))
  262.    ((eq (device-type) 'x)        ; Xwindows specific stuff
  263.     (and (fboundp 'x-popup-menu)
  264.      (fset 'w3-x-popup-menu 'x-popup-menu))
  265.     (require 'x-mouse)
  266.     (fset 'w3-old-mouse-function-m (lookup-key mouse-map x-button-middle))
  267.     (fset 'w3-old-mouse-function-cm (lookup-key mouse-map x-button-c-middle))
  268.     (define-key mouse-map x-button-middle 'w3-follow-mouse)
  269.     (define-key mouse-map x-button-c-middle 'w3-follow-inlined-image-mouse)
  270.     )
  271.    ((eq (device-type) 'intuition)    ; Amiga specific stuff
  272.     ;; Need anything here?
  273.     )
  274.    (t nil)))
  275.  
  276. (defun w3-store-in-x-clipboard (str)
  277.   "Store string STR in the window systems cut buffer"
  278.   (cond
  279.    ((and (eq (device-type) 'x) (fboundp 'x-store-cut-buffer))
  280.     (x-store-cut-buffer str))
  281.    ((eq (device-type) 'intuition)
  282.     )
  283.    (t
  284.     )))
  285.  
  286. (defun w3-mode-version-specifics ()
  287.   "Emacs 18 specific stuff for w3-mode"
  288.   nil)
  289.  
  290. (defun w3-map-links (function &optional buffer from to maparg)
  291.   "Map FUNCTION over the hypertext links which overlap region in BUFFER,
  292. starting at FROM and ending at TO.  FUNCTION is called with the arguments
  293. linkdata, START, END, and MAPARG.
  294. The arguments FROM, TO, MAPARG, and BUFFER default to the beginning of
  295. BUFFER, the end of BUFFER, nil, and (current-buffer), respectively.
  296.  
  297. In emacs17, FROM, TO, and BUFFER are ignored.... working on it."
  298.   (mapcar (function (lambda (x)
  299.               (if (eq (car (w3-zone-data x)) 'w3)
  300.               (funcall function (w3-zone-data x)
  301.                    (w3-zone-start x)
  302.                    (w3-zone-end x)
  303.                    maparg))
  304.               nil)) (w3-all-zones))
  305.   nil)
  306.  
  307. (provide 'w3-emacs)
  308.