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-wemac.el < prev    next >
Encoding:
Text File  |  1995-07-08  |  18.8 KB  |  554 lines
  1. ;;; w3-wemac.el,v --- WinEmacs specific functions for emacs-w3
  2. ;; Author: wmperry
  3. ;; Created: 1995/06/26 02:29:33
  4. ;; Version: 1.22
  5. ;; Keywords: faces, help, hypermedia, mouse
  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. ;;; Enhancements For Lucid Emacs
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30.  
  31. (defvar w3-main-menu 
  32.   '("WWW"
  33.     ["Open Local File" w3-open-local t]
  34.     ["Open URL" w3-fetch t]
  35.     ["Show document's address" url-view-url t]
  36.     ["Copy document's address into cut buffer" w3-save-url t]
  37.     "---"
  38.     ["View Source" w3-source-document t]
  39.     ["Edit Document Source" w3-find-this-file t]
  40.     ["Reload Current Document" w3-reload-document t]
  41.     "---"
  42.     ("Mail document..."
  43.      ["HTML Source" (w3-mail-current-document nil "HTML Source") t]
  44.      ["Formatted Text" (w3-mail-current-document nil "Formatted Text") t]
  45.      ["PostScript" (w3-mail-current-document nil "PostScript") t]
  46.      ["LaTeX Source" (w3-mail-current-document nil "LaTeX Source") t])
  47.     ("Print..."
  48.      ["HTML Source" (w3-print-this-url nil "HTML Source") t]
  49.      ["Formatted Text" (w3-print-this-url nil "Formatted Text") t]
  50.      ["PostScript" (w3-print-this-url nil "PostScript") t]
  51.      ["LaTeX'd" (w3-print-this-url nil "LaTeX'd") t])
  52.     "---"
  53.     ["Add annotation" w3-annotation-add t]
  54.     "---"
  55.     ["Leave & Bury Buffer" w3-leave-buffer t]
  56.     ["Leave & Kill Buffer" w3-quit t]
  57.     )
  58.   "The main w3 menu"
  59.   )
  60.  
  61. (defvar w3-view-menu
  62.   '("View"
  63.     ["Reload" w3-reload-document t]
  64.     ["Load Delayed Images" w3-load-delayed-images w3-delayed-images]
  65.     ["Load Delayed MPEGs" w3-load-delayed-mpegs w3-delayed-movies]
  66.     ["Refresh" w3-refresh-buffer t]
  67.     ["Document Source" w3-source-document t]
  68.     ["Document Information" w3-document-information t]
  69.     )
  70.   "The top level 'View' menu.")
  71.  
  72. (defvar w3-help-menu
  73.   (list
  74.    "WWW"
  75.    (vector "About" '(w3-fetch "about:") t)
  76.    (vector "Manual"
  77.        (list 'w3-fetch (concat w3-documentation-root "docs/w3_toc.html")) t)
  78.    "---"
  79.    (vector (concat "Help on v" w3-version-number)
  80.        (list 'w3-fetch (concat w3-documentation-root "help_on_" 
  81.                    w3-version-number ".html")) t)
  82.    (vector "On Window" (list 'w3-fetch (concat w3-documentation-root
  83.                            "window-help.html")) t)
  84.    (vector "On FAQ" (list 'w3-fetch (concat w3-documentation-root
  85.                         "FAQ.html")) t)
  86.    "---"
  87.    ["On HTML" (w3-fetch "http://www.ncsa.uiuc.edu/General/Internet/WWW/HTMLPrimer.html") t]
  88.    ["On URLs" (w3-fetch "http://www.ncsa.uiuc.edu/demoweb/url-primer.html") t]
  89.    ["Mail Developer(s)" w3-submit-bug t])
  90.   "The help menu for w3.")
  91.  
  92. (defconst w3-navigate-menu
  93.   '("Go"
  94.     ["Back" w3-backward-in-history t]
  95.     ["Forward" w3-forward-in-history t]
  96.     "---"
  97.     ["Goto Home Document" w3 t]
  98.     ["Stop Loading" w3-cancel-current-download (get-buffer url-working-buffer)]
  99.     ["Show History" w3-show-history-list url-keep-history]
  100.     ["Show Hotlist" w3-show-hotlist w3-hotlist]
  101.     ("Hotlist Maintenance"
  102.      ["Add this document to hotlist" w3-hotlist-add-document t]
  103.      ["Delete item from hotlist" w3-hotlist-delete t]
  104.      ["Rename item in hotlist" w3-hotlist-rename-entry t]
  105.      ["Append new hotlist file" w3-hotlist-append t])
  106.     "---")
  107.   "The navigation menu.")
  108.  
  109. (defvar w3-links-menu nil "Menu for w3-mode in lemacs")
  110. (defvar w3-image-type-restriction nil)
  111. (defvar w3-image-size-restriction nil)
  112. (make-variable-buffer-local 'w3-links-menu)
  113.  
  114. (or (boundp 'emacs-major-version)
  115.     (defconst emacs-major-version
  116.       (progn (or (string-match "^[0-9]+" emacs-version)
  117.          (error "emacs-version unparsable"))
  118.          (string-to-int (substring emacs-version
  119.                       (match-beginning 0) (match-end 0))))
  120.       "Major version number of this version of Emacs, as an integer.
  121. Warning, this variable did not exist in emacs versions earlier than:
  122.   FSF Emacs:   19.23
  123.   Lucid Emacs: 19.10"))
  124.  
  125. (or (boundp 'emacs-minor-version)
  126.     (defconst emacs-minor-version
  127.       (progn (or (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version)
  128.          (error "emacs-version unparsable"))
  129.          (string-to-int (substring emacs-version
  130.                       (match-beginning 1) (match-end 1))))
  131.       "Minor version number of this version of Emacs, as an integer.
  132. Warning, this variable did not exist in emacs versions earlier than:
  133.   FSF Emacs:   19.23
  134.   Lucid Emacs: 19.10"))
  135.  
  136. (cond
  137.  ((= emacs-minor-version 9)
  138.   (defvar w3-options-menu
  139.     '("Options"
  140.       ["Delay Image Load"
  141.        (setq w3-delay-image-loads (not w3-delay-image-loads)) t]
  142.       ["Flush Image Cache" (setq w3-graphics-list nil) w3-graphics-list]
  143.       ["Flush Disk Cache" (url-flush-cache) t]
  144.       ("Hypertext Gopher Mode"
  145.        ["Turn On" (setq url-use-hypertext-gopher t)
  146.     (not url-use-hypertext-gopher)]
  147.        ["Turn Off" (setq url-use-hypertext-gopher nil)
  148.     url-use-hypertext-gopher])
  149.       ("Hypertext Dired Mode"
  150.        ["Turn On" (setq url-use-hypertext-dired t)
  151.     (not url-use-hypertext-dired)]
  152.        ["Turn Off" (setq url-use-hypertext-dired nil) url-use-hypertext-dired]
  153.        )
  154.       ["Clear History" (setq url-history-list nil) url-history-list])
  155.     "The options menu for w3"))
  156.  (t
  157.   (defvar w3-options-menu
  158.   '("Options"
  159.     ["Delay Image Load" (setq w3-delay-image-loads (not w3-delay-image-loads))
  160.      nil]
  161.     ["Flush Image Cache" (setq w3-graphics-list nil) t]
  162.     ["Flush Disk Cache" (url-flush-cache) t]
  163.     ("Hypertext Gopher Mode"
  164.      ["Turn On" (setq url-use-hypertext-gopher t) t]
  165.      ["Turn Off" (setq url-use-hypertext-gopher nil) t])
  166.     ("Hypertext Dired Mode"
  167.      ["Turn On" (setq url-use-hypertext-dired t) t]
  168.      ["Turn Off" (setq url-use-hypertext-dired nil) t])
  169.     ["Clear History" (progn
  170.                (setq url-history-list nil)
  171.                (disable-menu-item '("Options" "Clear History"))) t])
  172.   "The options menu for w3")))
  173.  
  174. (defun w3-create-faces ()
  175.   "Create faces, the lucid way"
  176.   (make-face w3-node-style)
  177.   (make-face w3-visited-node-style)
  178.   (if (not (face-differs-from-default-p w3-node-style))
  179.       (copy-face 'bold w3-node-style))
  180.   (if (not (face-differs-from-default-p w3-visited-node-style))
  181.       (copy-face 'bold-italic w3-visited-node-style)))
  182.  
  183. (fset 'w3-delete-zone 'delete-extent)
  184. (fset 'w3-zone-end 'extent-end-position)
  185. (fset 'w3-zone-start 'extent-start-position)
  186. (fset 'w3-zone-eq 'eq)
  187. ;(fset 'w3-insert 'insert)
  188.  
  189. (defun w3-insert (&rest args)
  190.   (let ((start (point))
  191.     (zones nil))
  192.     (map-extents (function
  193.           (lambda (x y)
  194.             (setq zones (cons x zones))
  195.             nil)) nil start (if (eobp) start (1+ start)))
  196.     (apply 'insert-before-markers args)
  197.     (mapcar (function
  198.          (lambda (zone)
  199.            (cond
  200.         ((= (point) (extent-end-position zone)) nil)
  201.         ((< (extent-end-position zone) (point))
  202.          (set-extent-endpoints zone (extent-end-position zone)
  203.                        (point)))
  204.         ((= (extent-start-position zone) start)
  205.          (set-extent-endpoints zone (point)
  206.                        (extent-end-position zone))))))
  207.         zones)))
  208.  
  209. (defun w3-zone-hidden-p (start end)
  210.   "Return t iff the region from start to end is invisible."
  211.   (and (extent-at (1+ start))
  212.        (extent-property (extent-at (1+ start)) 'invisible)))
  213.  
  214. (defun w3-unhide-zone (start end)
  215.   "Make a region from START TO END visible. (lemacs)"
  216.   (map-extents
  217.    (function
  218.     (lambda (ext)
  219.       (if (and (= start (extent-start-position ext))
  220.            (= end   (extent-end-position ext))
  221.            (extent-property ext 'invisible))
  222.       (progn (delete-extent ext) t)
  223.     nil))) start end))
  224.  
  225. (defun w3-hide-zone (start end)
  226.   "Make a region from START to END invisible. (lemacs)"
  227.   (set-extent-property (make-extent start end) 'invisible t))
  228.  
  229. (defun w3-fix-extent-endpoints ()
  230.   "Make sure no extents contain trailing whitespace/newlines"
  231.   (let ((skip-chars (list ?\t ?\r ?\n ?\ )))
  232.     (map-extents (function
  233.           (lambda (ext maparg)
  234.             (if (or (and (fboundp 'annotationp)
  235.                  (annotationp ext))
  236.                 (memq (car (extent-data ext))
  237.                   '(w3graphic w3delayed))
  238.                 ) nil
  239.               (let ((st (extent-start-position ext))
  240.                 (nd (extent-end-position ext))
  241.                 (ch nil))
  242.             (while (memq (char-after (1- nd)) skip-chars)
  243.               (setq nd (1- nd)
  244.                 ch t))
  245.             (while (memq (char-after st) skip-chars)
  246.               (setq st (1+ st)
  247.                 ch t))
  248.             (if ch
  249.                 (if (<= nd st)
  250.                 (delete-extent ext)
  251.                   (set-extent-endpoints ext st nd)))))
  252.             nil)))))
  253.  
  254. (defun w3-all-zones ()
  255.   (let ((cur (next-extent (current-buffer)))
  256.     (all nil))
  257.     (while cur
  258.       (setq all (cons cur all))
  259.       (setq cur (next-extent cur)))
  260.     all))
  261.  
  262. (defun w3-add-hotlist-menu ()
  263.   (if (eq major-mode 'w3-mode)
  264.       (let ((hot-menu nil)
  265.         (hot w3-hotlist))
  266.     (while hot
  267.       (setq hot-menu (cons (vector
  268.                 (w3-truncate-menu-item (car (car hot)))
  269.                 (list 'w3-fetch (car (cdr (car hot))))
  270.                 t) hot-menu)
  271.         hot (cdr hot)))
  272.     (if (cdr w3-links-menu)
  273.         (add-submenu '("Go") (cons "Links" (w3-breakup-menu
  274.                         (cdr w3-links-menu)
  275.                         w3-max-menu-length)))
  276.       (condition-case ()
  277.           (delete-menu-item '("Go" "Links"))
  278.         (error nil)))
  279.     (if hot-menu (add-submenu '("Go")
  280.                   (cons "Hotlist"
  281.                     (w3-breakup-menu hot-menu
  282.                              w3-max-menu-length)))
  283.       (condition-case ()
  284.           (delete-menu-item '("Go" "Hotlist")))))))
  285.  
  286. (defun w3-find-specific-link (link)
  287.   "Find LINK in the current document"
  288.   (let ((dat (map-extents
  289.           (function
  290.            (lambda (ext maparg)
  291.          (if (and (stringp (nth 1 (extent-data ext)))
  292.               (string= (nth 1 (extent-data ext)) link))
  293.              (cons ext (extent-start-position ext))
  294.            nil))))))
  295.     (cond
  296.      (dat
  297.       (goto-char (cdr dat))
  298.       (message "Found link %s" link)
  299.       (force-highlight-extent (car dat) t)
  300.       (while (not (input-pending-p))
  301.     (sit-for 1))
  302.       (force-highlight-extent (car dat) nil)))))     
  303.  
  304. (defun w3-zone-data (zone)
  305.   "Return the data associated with zone"
  306.   (let ((link (extent-data zone)))
  307.     (if (memq (car link) '(w3 w3graphic w3form w3expandlist w3mpeg w3delayed))
  308.     link
  309.       nil)))
  310.  
  311. (defun w3-zone-at (pt)
  312.   "Return the extent at point PT that is either a link or a forms area."
  313.   (let* ((ext  (extent-at pt (current-buffer)))
  314.      (dat  (and ext (extent-data ext))))
  315.     (cond
  316.      ((null dat) nil)
  317.      ((memq (car dat) '(w3 w3form w3delayed)) ext)
  318.      (t nil))))
  319.  
  320. (defun w3-mouse-handler (e)
  321.   "Function to message the url under the mouse cursor"
  322.   (let* ((pt (event-point e))
  323.      (ext (and pt (extent-at pt)))
  324.      (dat (and ext (extent-data ext))))
  325.     (cond
  326.      ((null dat) (message ""))
  327.      ((eq (car dat) 'w3)     (message "%s" (nth 1 (cdr dat))))
  328.      ((eq (car dat) 'w3form)
  329.       (let ((args (nth 0 (nth 1 dat)))
  330.         (form (cdr dat)))
  331.     (cond
  332.      ((string= "SUBMIT" (nth 1 form))
  333.       (message "Submit form to %s" (cdr-safe (assoc "action" args))))
  334.      ((string= "RESET" (nth 1 form))
  335.       (message "Reset form contents"))
  336.      (t
  337.       (message "Form entry (name=%s, type=%s)" (nth 2 form)
  338.            (if (equal "" (nth 1 form))
  339.                "text"
  340.              (downcase (nth 1 form))))))))
  341.      (t (message "")))))
  342.  
  343. (defun w3-next-extent (xt)
  344.   "Return the next extent after XT that is a link or a forms area."
  345.   (let ((x nil))
  346.     (map-extents (function
  347.           (lambda (extent maparg)
  348.             (if (memq (car (extent-data extent)) '(w3 w3form))
  349.             (setq x extent) nil)))
  350.          (current-buffer)
  351.          (if xt (1+ (extent-end-position xt)) (point))
  352.          (point-max))
  353.     x))
  354.  
  355. (defun w3-forward-link (p)
  356.   "Move forward to the next link in the document.  Error if no more links."
  357.   (interactive "P")
  358.   (setq p (or p 1))
  359.   (if (< p 0)
  360.       (w3-back-link (- p))
  361.     (if (/= 1 p)
  362.     (w3-forward-link (1- p)))
  363.     (let* ((extent (extent-at (point)))
  364.        (data (and extent (extent-data extent)))
  365.        (x (w3-next-extent (if (memq (car-safe data) '(w3 w3form))
  366.                   extent))))
  367.       (if x (goto-char (extent-start-position x))
  368.     (error "No more links.")))))
  369.  
  370. (defun w3-previous-extent (xt)
  371.   (let ((x nil))
  372.     (map-extents (function (lambda (extent maparg)
  373.                  (if (memq (car (extent-data extent)) '(w3 w3form))
  374.                  (setq x extent)) nil))
  375.          (current-buffer) (point-min)
  376.          (if xt (extent-start-position xt) (point)))
  377.     x))
  378.  
  379. (defun w3-back-link (p)
  380.   "Go back link"
  381.   (interactive "P")
  382.   (setq p (or p 1))
  383.   (if (< p 0)
  384.       (w3-forward-link (- p))
  385.     (if (/= 1 p)
  386.     (w3-back-link (1- p)))
  387.     (let ((x (w3-previous-extent (extent-at (point)))))
  388.       (if x (goto-char (extent-start-position x))
  389.     (error "No previous link.")))))
  390.  
  391. (defun w3-extend-zone (zone new-end)
  392.   (let ((beg (extent-start-position zone)))
  393.     (set-extent-endpoints zone beg new-end)))
  394.  
  395. (defun w3-add-zone (start end style data &optional highlight)
  396.   "Add highlighting (lucid)"
  397.   (let ((ext))
  398.     (if (markerp start)
  399.     (setq ext (make-extent (marker-position start) (marker-position end)))
  400.       (setq ext (make-extent start end)))
  401.     (if style     (set-extent-face ext style))
  402.     (if highlight (set-extent-attribute ext 'highlight))
  403.     (set-extent-data ext data)
  404.     (if (eq (car data) 'w3) (set-extent-priority ext 2))
  405.     ext))
  406.  
  407. (defun w3-follow-mouse (e)
  408.   (interactive "e")
  409.   (mouse-set-point e)
  410.   (w3-follow-link))
  411.  
  412. (define-key w3-mode-map 'button2 'w3-follow-mouse)
  413. (define-key w3-mode-map '(control button2) 'w3-follow-inlined-image-mouse)
  414. (define-key w3-mode-map 'button3 'w3-popup-menu)
  415.  
  416. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  417. ;;; Functions to build menus of urls
  418. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  419. (defun w3-toplevel-menu-exists-p (name)
  420.   "Search for a top level menu called NAME.  Return non-nil iff it exists"
  421.   (assoc name current-menubar))
  422.  
  423. (defun w3-build-lemacs-menu ()
  424.   "Build lemacs menus from w3-links-list"
  425.   (let* ((hot w3-hotlist)
  426.      (hot-menu nil))
  427.     (or current-menubar
  428.     (set-menubar default-menubar))
  429.     (map-extents 'w3-build-links-helper)
  430.     (setq w3-links-menu (cons "Links" w3-links-menu))
  431.     (while hot
  432.       (setq hot-menu
  433.         (cons (vector (car (car hot))
  434.               (list 'url-maybe-relative (car (cdr (car hot))))
  435.               t) hot-menu))
  436.       (setq hot (cdr hot)))
  437.     (setq hot-menu (cons "Hotlist" hot-menu))
  438.     (set-buffer-menubar (copy-sequence current-menubar))
  439.     (add-submenu '("Help") (cons "WWW" (cdr w3-help-menu)))
  440.     (add-submenu nil (cons "WWW" (cdr w3-main-menu)))
  441.     (add-submenu nil (cons "View" (cdr w3-view-menu)))
  442.     (add-submenu nil (cons "Go" (cdr w3-navigate-menu)))
  443.     (if (cdr hot-menu)
  444.     (add-submenu '("Go")
  445.              (cons "Hotlist"
  446.                (w3-breakup-menu (cdr hot-menu)
  447.                         w3-max-menu-length))))
  448.     (if (cdr w3-links-menu)
  449.     (add-submenu '("Go")
  450.              (cons "Links"
  451.                (w3-breakup-menu (cdr w3-links-menu)
  452.                         w3-max-menu-length))))
  453.     (if (w3-toplevel-menu-exists-p "Options")
  454.     (add-submenu '("Options") (cons "WWW"  (cdr w3-options-menu))
  455.              "Save Options")
  456.       (add-submenu nil (cons "Options" (cdr w3-options-menu))))))
  457.  
  458. (defun w3-build-links-helper (extent maparg)
  459.   "Build a list of links using map-extents for lucid"
  460.   (let ((x (if (eq (extent-data extent) 'w3) (extent-data extent))))
  461.     (if (and x (not (null (nth 1 x))))
  462.     (setq w3-links-menu
  463.           (nconc w3-links-menu
  464.              (list
  465.               (vector (w3-truncate-menu-item
  466.                    (w3-fix-spaces (nth 2 x)))
  467.                   (list 'url-maybe-relative (nth 1 x)) t)))))
  468.     nil))
  469.  
  470. (defun w3-popup-menu (e)
  471.   "Pop up a menu of common w3 commands"
  472.   (interactive "e")
  473.   (mouse-set-point e)
  474.   (popup-menu w3-popup-menu))
  475.       
  476. (defun w3-x-popup-menu (pos menudesc)
  477.   "If last command was a mouse command use a popup-menu, otherwise do a
  478. completing read"
  479.   (if (or (button-press-event-p last-command-event)
  480.       (button-release-event-p last-command-event)
  481.       (misc-user-event-p last-command-event))
  482.       (w3-x-really-popup-menu pos menudesc)
  483.     (completing-read "Please choose: " (cdr (cdr (car (cdr menudesc))))
  484.              nil t)))
  485.  
  486. (defun w3-x-really-popup-menu (pos menudesc)
  487.   "My hacked up function to do a blocking popup menu..."
  488.   (let ((echo-keystrokes 0)
  489.     event menu)
  490.     (setq menudesc (cdr (car (cdr menudesc)))) ; remove the title
  491.     (while menudesc
  492.       (setq menu (cons (vector (car (car menudesc))
  493.                    (list (car (car menudesc))) t) menu)
  494.         menudesc (cdr menudesc)))
  495.     (setq menu (cons "WWW" menu))
  496.     (popup-menu menu)
  497.     (catch 'popup-done
  498.       (while t
  499.     (setq event (next-command-event event))
  500.     (cond ((and (misc-user-event-p event) (stringp (car-safe
  501.                            (event-object event))))
  502.            (throw 'popup-done (event-object event)))
  503.           ((and (misc-user-event-p event)
  504.             (or (eq (event-object event) 'abort)
  505.             (eq (event-object event) 'menu-no-selection-hook)))
  506.            (signal 'quit nil))
  507.           ((button-release-event-p event);; don't beep twice
  508.            nil)
  509.           (t
  510.            (beep)
  511.            (message "please make a choice from the menu.")))))))
  512.  
  513. (defun w3-setup-version-specifics ()
  514.   "Set up routine for WinEmacs"
  515.   (setq w3-temporary-directory
  516.     (or (and w3-temporary-directory
  517.          (stringp w3-temporary-directory)
  518.          (file-exists-p w3-temporary-directory)
  519.          w3-temporary-directory)
  520.         (getenv "TEMP") (getenv "TMP") (getenv "temp") (getenv "tmp")
  521.         (getenv "EMACSTMP"))
  522.     url-temporary-directory w3-temporary-directory))
  523.  
  524. (defun w3-store-in-x-clipboard (str)
  525.   "Store string STR into the clipboard in X"
  526.   (x-own-selection str 'PRIMARY)
  527.   (x-selection-owner-p 'PRIMARY))  
  528.  
  529. (if (not (and (boundp 'emacs-major-version) (>= emacs-major-version 10)))
  530.     (message "Image handling ignored"))
  531.  
  532. (defun w3-mode-version-specifics ()
  533.   "Lucid emacs specific stuff for w3-mode"
  534.   (w3-build-lemacs-menu)
  535.   (if w3-track-mouse (setq mode-motion-hook 'w3-mouse-handler))
  536.   (add-hook 'activate-menubar-hook 'w3-add-hotlist-menu)
  537.   (setq mode-popup-menu w3-popup-menu))
  538.  
  539. (defun w3-map-links (function &optional buffer from to maparg)
  540.   "Map FUNCTION over the hypertext links which overlap region in BUFFER,
  541. starting at FROM and ending at TO.  FUNCTION is called with the arguments
  542. linkdata, START, END, and MAPARG.
  543. The arguments FROM, TO, MAPARG, and BUFFER default to the beginning of
  544. BUFFER, the end of BUFFER, nil, and (current-buffer), respectively."
  545.   (map-extents (function (lambda (x y)
  546.                (if (eq (car-safe (extent-data x)) 'w3)
  547.                    (funcall function (w3-zone-data x)
  548.                     (extent-start-position x)
  549.                     (extent-end-position x) y))
  550.                nil)) buffer from to maparg))
  551.  
  552. (provide 'w3-wemacs)
  553. (provide 'w3-wemac)
  554.