annotate lisp/dragdrop.el @ 502:7039e6323819

[xemacs-hg @ 2001-05-04 22:41:46 by ben] ----------------------- byte-comp warning fixes ----------------- New functions for cleanly eliminating byte-compiler warnings. Their definitions require no changes at all in bytecomp.el, meaning that any package that wants to use them and be compatible with older versions of XEmacs need only copy the code and rename the functions (i.e. prefix them with the package name). Eliminate byte-compiler warnings using the new functions in bytecomp-runtime.el. Move coding-system-put,get,category, since they're not Mule-specific and are used in prefer-coding-system. font.el was incredibly ugly. Clean it up. Avoid using defsubst for any exported functions, to avoid possible compatibility problems if we later change the internal interface. (It happened before, with face accessors, between 19.8 and 19.9). Fix tons of warnings. Clean up (new function gpm-is-supported-p eliminates duplicate code in gpm-create/delete-device-hook) and eliminate warnings. ---------- make byte-recompile-directory work in the --------- core `lisp' dir, even in the absence of a Mule XEmacs (i.e. make it skip the Mule files rather than trying to compile them). now you should be able to do `touch *.el' in the `lisp' dir, then M-x byte-recompile-directory, and get no warnings. Avoid trying to compile Mule files in byte-recompile-directory when we're not in a Mule XEmacs, since we're highly likely to get syntax errors. Add a coding-system cookie to all Mule files so that byte-recompile-directory ignores them. Magic cookie function moved to files.el from code-files.el (for use by bytecomp even in a non-coding-system XEmacs), and changed names and semantics for use by bytecomp. NOTE: IMO this is an internal function that we can change as we like (and there is absolutely no code anywhere else using the function). ---------------- GUI improvements: menus, help ------------------- Rearrange order of keymap declarations to be alphabetical. Improve help on help to include all bindings, and group by category. Add bindings for new Info commands. Remove warnings. Use command-hyper-apropos in place of command-apropos. Add a function to do the equivalent of command-apropos. Evals its help-text argument so you can put expressions there. Used now by help-for-help. Add binding to continue text searches. Expand index searches to work over multiple info documents. Add commands to search text/index in User and Lispref. Add new entry, "Uncomment Region" (parallels "Comment Out Region"). Redo Help menu; add bindings for new Info commands to search the index or text of the User and Lispref manuals. Add command for mark-paragraph, activate-region. Make Edit->R accelerator be rectangle, not register (more commonly used), and put rectangle first. Fix the Edit Init File entry to never load the .elc file. Simplify the default-popup-menu. Add Cmds->Tabs menu. Use kp-left not kp_left, etc. ---------------- Miscellaneous bug fixes/cleanup ------------------- byte-compiler-options: Correct doc string. easy-menu-do-define: fix extra quote. fill-paragraph-or-region:Rewrite to be more correct -- use call-interactively so that we always get exactly the same behavior as if the functions were called directly. No need to fiddle with zmacs-region-stays, now that bogus clearing of it (2001-04-28 src/ChangeLog) is removed. Put dialog titles back in -- this time correctly. Fix various other problems with leaks and such. key-sequence-list-description: Clean up fun to always correctly canonicalize. Clean up Kinsoku comments, synch comment-region with FSF 20.7. * simple.el (region-exists-p): * simple.el (region-active-p): Add comment about which one is correct to use in menu specs. * sound.el (load-sound-file): Minor code clean up. * startup.el: * startup.el (command-line-early): * startup.el (initial-scratch-message): Comment changes. Add info about sample.init.el to splash screen. Improve initial-scratch-message and clarify purpose of Scratch buffer. Fix byte-compile warning. ------------------------ Added features ------------------------- Add new variable to control whether etags checks all parent directories for tag files. (On by default.) * hash-table.el: New file, useful utility functions. * dumped-lisp.el (preloaded-file-list): Dump hash-table.el. ------------ notable bug fix: Windows event code -------------- Get critical quit working. ------------ notable bug fix and new feature: regex code -------------- Shy groups were implemented in a horrible, half-assed way that would cause them to screw up regex searching in most cases. Fixed to work correctly. Also extended back-reference syntax past 9. Only is recognized as such if there are at least that many non-shy groups; and optionally will warn about such uses, to catch old code that might be using them differently. (Added variable to control this in search.c -- `warn-about-possibly-incompatible-back- references', on by default for the moment. Declared in lisp.h. ---------------- process/SIGIO improvements ------------------- define USE_GETADDRINFO to replace more complex conditional, and use it. the code conditionalized on this in unix_open_network_stream had *serious* problems handling errors. it's now fixed, and major amounts of duplicate code between the two versions were combined. don't disable SIGIO and other interrupts unless CONNECT_NEEDS_SLOWED_INTERRUPTS is defined -- don't penalize OS's without bugs. similarly for a freebsd bug that was affecting all OS's. * s\ultrix.h: define CONNECT_NEEDS_SLOWED_INTERRUPTS, since that's the OS mentioned as having a kernel bug. * sysdep.c (request_sigio_on_device): * sysdep.c (unrequest_sigio_on_device): fix SIGIO problems on Linux. add check for O_ASYNC in case it's defined and FASYNC isn't. add comment about other ways to do SIGIO on Linux. * callproc.c (Fold_call_process_internal): * process.c (Fstart_process_internal): Deal with the possibility that `default-directory' doesn't have terminating slash. Correct comments about vfork. ---------------- Miscellaneous bug fixes/cleanup ------------------- * callint.c (Finteractive): Add lots of documentation -- exactly what the Lisp equivalents of all the interactive specs are. * console.h (struct console): change type of quit_char to Emchar. * event-msw.c (lstream_type_create_mswindows_selectable): spacing change. Eliminate events-mod.h and combine into events.h. * emacs.c: * emacs.c (make_arg_list_1): * emacs.c (main_1): A couple of char->Extbyte changes, add a comment. * glyphs-msw.c: Correct indentation of function defns to not exceed 80 cols. Try (sort of) to fix some code that sets the colors of the progress gauge. (Commented out) * keymap.c (syms_of_keymap): use DEFSYMBOL. * process.c (read_process_output): No need to fiddle with zmacs_region_stays, now that bogus clearing of it (see below) is removed. * search.c (Freplace_match): warning fix.
author ben
date Fri, 04 May 2001 22:42:35 +0000
parents 0784d089fdc9
children 8f3fb4fd879b
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; dragdrop.el --- window system-independent Drag'n'Drop support.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1998 Oliver Graf <ograf@fga.de>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Maintainer: XEmacs Development Team, Oliver Graf <ograf@fga.de>
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
6 ;; Keywords: mouse, gui, dumped
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; along with XEmacs; see the file COPYING. If not, write to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; Free Software Foundation, 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;;; Synched up with: Not in FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;; This file is dumped with XEmacs (when drag'n'drop support is compiled in).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; we need mouse-set-point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 (require 'mouse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 (provide 'dragdrop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;; I think this is a better name for the custom group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; looks better in the menu and the group display as dragdrop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;; Anyway: is dragdrop- a good prefix for all this?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; What if someone trys drop<TAB> in the minibuffer?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 (defgroup drag-n-drop nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 "*{EXPERIMENTAL} Window system-independent drag'n'drop support."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 (defcustom dragdrop-drop-at-point nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 "*{EXPERIMENTAL} If non-nil, drop text at the cursor location.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 Otherwise, the cursor will be moved to the location of the pointer drop before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 text is inserted."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 :group 'drag-n-drop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 (defcustom dragdrop-autoload-tm-view nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 "*{EXPERIMENTAL} If non-nil, autoload tm-view to decode MIME data.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 Otherwise, the buffer is only decoded if tm-view is already available."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 :group 'drag-n-drop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ;; the widget for editing the drop-functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 (define-widget 'dragdrop-function-widget 'list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 "*{EXPERIMENTAL} Widget for editing drop dispatch functions."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 :args `((choice :tag "Function"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 (function-item experimental-dragdrop-drop-url-default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 (function-item experimental-dragdrop-drop-mime-default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 (function-item experimental-dragdrop-drop-log-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 (function :tag "Other" nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 (choice :tag "Button" :value t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 (choice-item :tag "Ignore" t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 (choice-item 0) (choice-item 1) (choice-item 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (choice-item 3) (choice-item 4) (choice-item 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 (choice-item 6) (choice-item 7))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (radio-button-choice :tag "Modifiers"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 (const :tag "Ignore Modifier Keys" t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 (checklist :greedy t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 :format "Modifier Keys:\n%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 :extra-offset 6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 (const shift)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 (const control)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 (const meta)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (const alt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 (const hyper)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 (const super)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (repeat :inline t :value nil :tag "Extra Function Arguments"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 (sexp :tag "Arg" :value nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 :value '(nil t t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 (defcustom experimental-dragdrop-drop-functions '((experimental-dragdrop-drop-url-default t t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 (experimental-dragdrop-drop-mime-default t t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 "*{EXPERIMENTAL} This is the standart drop function search list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 Each element is a list of a function, a button selector, a modifier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 selector and optional argumets to the function call.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 The function must accept at least two arguments: first is the event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 of the drop, second the object data, followed by any of the optional
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 arguments provided in this list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 The functions are called in order, until one returns t."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 :group 'drag-n-drop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 :type '(repeat dragdrop-function-widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (defgroup dnd-debug nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 "*{EXPERIMENTAL} Drag'n'Drop debugging options."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 :group 'drag-n-drop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (defcustom dragdrop-drop-log nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 "*{EXPERIMENTAL} If non-nil, every drop is logged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 The name of the buffer is set in the custom 'dragdrop-drop-log-name"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 :group 'dnd-debug
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 :type 'boolean)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 (defcustom dragdrop-drop-log-name "*drop log buffer*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 "*{EXPERIMENTAL} The name of the buffer used to log drops.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 Set dragdrop-drop-log to non-nil to enable this feature."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 :group 'dnd-debug
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 :type 'string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 (defvar dragdrop-drop-log-buffer nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 "*{EXPERIMENTAL} Buffer to log drops in debug mode.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 ;; Drop API
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 (defun dragdrop-drop-dispatch (object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 "*{EXPERIMENTAL} This function identifies DROP type misc-user-events.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 It calls functions which will handle the drag."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 (let ((event current-mouse-event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 (and dragdrop-drop-log
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 (experimental-dragdrop-drop-log-function event object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 (dragdrop-drop-find-functions event object)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 (defun dragdrop-drop-find-functions (event object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 "Finds valid drop-handle functions and executes them to dispose the drop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 It does this by looking for extent-properties called
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 'experimental-dragdrop-drop-functions and for variables named like this."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 (catch 'dragdrop-drop-is-done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 (and (event-over-text-area-p event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 ;; let's search the extents
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 (catch 'dragdrop-extents-done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 (let ((window (event-window event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 (pos (event-point event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 (cpos (event-closest-point event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 (buffer nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 (or window (throw 'dragdrop-extents-done nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (or pos (setq pos cpos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (select-window window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 (setq buffer (window-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 (let ((ext (extent-at pos buffer 'experimental-dragdrop-drop-functions)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 (while (not (eq ext nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 (dragdrop-drop-do-functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 (extent-property ext 'experimental-dragdrop-drop-functions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (setq ext (extent-at pos buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 'experimental-dragdrop-drop-functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 ext)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 ;; now look into the variable experimental-dragdrop-drop-functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 (dragdrop-drop-do-functions experimental-dragdrop-drop-functions event object)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (defun dragdrop-compare-mods (first-mods second-mods)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 "Returns t if both first-mods and second-mods contain the same elements.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 Order is not important."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (let ((moda (copy-sequence first-mods))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (modb (copy-sequence second-mods)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 (while (and (not (eq moda ()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 (not (eq modb ())))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 (setq modb (delete (car moda) modb))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 (setq moda (delete (car moda) moda)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 (and (eq moda ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (eq modb ()))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 (defun dragdrop-drop-do-functions (drop-funs event object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 "Calls all functions in drop-funs with object until one returns t.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 Returns t if one of drop-funs returns t. Otherwise returns nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (let ((flist nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (button (event-button event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 (mods (event-modifiers event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 (while (not (eq drop-funs ()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 (setq flist (car drop-funs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 (and (or (eq (cadr flist) t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 (= (cadr flist) button))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 (or (eq (caddr flist) t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 (dragdrop-compare-mods (caddr flist) mods))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 (apply (car flist) `(,event ,object ,@(cdddr flist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 ;; (funcall (car flist) event object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 (throw 'dragdrop-drop-is-done t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 (setq drop-funs (cdr drop-funs))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 (defun experimental-dragdrop-drop-log-function (event object &optional message buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 "*{EXPERIMENTAL} Logs any drops into a buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 If buffer is nil, it inserts the data into a buffer called after
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 dragdrop-drop-log-name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 If dragdrop-drop-log is non-nil, this is done automatically for each drop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 The function always returns nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 (cond ((buffer-live-p buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (set-buffer buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 ((stringp buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (set-buffer (get-buffer-create buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 ((buffer-live-p dragdrop-drop-log-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 (set-buffer dragdrop-drop-log-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 (setq dragdrop-drop-log-buffer (get-buffer-create dragdrop-drop-log-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 (set-buffer dragdrop-drop-log-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 (insert (format "* %s: %s\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (current-time-string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 (if message message "received a drop")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (insert (format " at %d,%d (%d,%d) with button %d and mods %s\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (event-x event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 (event-y event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 (event-x-pixel event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 (event-y-pixel event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 (event-button event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 (event-modifiers event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 (insert (format " data is of type %s (%d %s)\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 (cond ((eq (car object) 'dragdrop-URL) "URL")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 ((eq (car object) 'dragdrop-MIME) "MIME")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 (t "UNKNOWN"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 (length (cdr object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 (if (= (length (cdr object)) 1) "element" "elements")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 (let ((i 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (data (cdr object)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 (while (not (eq data ()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 (insert (format " Element %d: %S\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 i (car data)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 (setq i (1+ i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 (setq data (cdr data))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 (insert "----------\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (defun experimental-dragdrop-drop-url-default (event object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 "*{EXPERIMENTAL} Default handler for dropped URL data.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 Finds files and URLs. Returns nil if object does not contain URL data."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 (cond ((eq (car object) 'dragdrop-URL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 (let ((data (cdr object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 (frame (event-channel event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 (x pop-up-windows)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 (window (event-window event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 (setq pop-up-windows nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 (while (not (eq data ()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 (cond ((dragdrop-is-some-url "file" (car data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 ;; if it is some file, pop it to a buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 (cond (window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 (select-window window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (switch-to-buffer (find-file-noselect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 (substring (car data) 5))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 ;; to-do: open ftp URLs with efs...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 ;; some other URL, try to fire up some browser for it
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
247 (if (fboundp 'browse-url)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
248 (browse-url (car data))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 (display-message 'error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 "Can't show URL, no browser selected"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 (undo-boundary)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 (setq data (cdr data)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (make-frame-visible frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 (setq pop-up-windows x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 (defun experimental-dragdrop-drop-mime-default (event object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 "*{EXPERIMENTAL} Default handler for dropped MIME data.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 Inserts text into buffer, creates MIME buffers for other types.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 Returns nil if object does not contain MIME data."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 (cond ((eq (car object) 'dragdrop-MIME)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 (let ((ldata (cdr object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 (frame (event-channel event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 (x pop-up-windows)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (data nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 ;; how should this be handled???
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 ;; insert drops of text/* into buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 ;; create new buffer if pointer is outside buffer...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 ;; but there are many other ways...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 ;; first thing: check if it's only text/plain and if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 ;; drop happened inside some buffer. if yes insert it into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 ;; this buffer (hope it is not encoded in some MIME way)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 ;; Remember: ("text/plain" "dosnotmatter" "somedata")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 ;; drops are inserted at mouse-point, if inside a buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 (while (not (eq ldata ()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 (setq data (car ldata))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 (if (and (listp data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 (= (length data) 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 (listp (car data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 (stringp (caar data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 (string= (caar data) "text/plain")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (event-over-text-area-p event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (let ((window (event-window event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (and window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 (select-window window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 (and (not dragdrop-drop-at-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (mouse-set-point event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 (insert (caddr data)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 (let ((buf (get-buffer-create "*MIME-Drop data*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (set-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 (pop-to-buffer buf nil frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (or (featurep 'tm-view)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 (and dragdrop-autoload-tm-view
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (require 'tm-view)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 (cond ((stringp data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 ;; this is some raw MIME stuff
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 ;; create some buffer and let tm do the job
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 ;; this is always the same buffer!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 ;; change?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (insert data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 (and (featurep 'tm-view)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
307 (declare-fboundp (mime/viewer-mode buf))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 ((and (listp data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (= (length data) 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 ;; change the internal content-type representation to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 ;; way tm does it ("content/type" (key . value)*)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 ;; but for now list will do the job
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 ;; this is always the same buffer!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 ;; change?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (insert (caddr data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 (and (featurep 'tm-view)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 ;; this list of (car data) should be done before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 ;; enqueing the event
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
321 (declare-fboundp
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
322 (mime/viewer-mode buf (car data) (cadr data)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 (display-message 'error "Wrong drop data")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 (undo-boundary)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 (setq ldata (cdr ldata)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 (make-frame-visible frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 (setq pop-up-windows x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 (defun dragdrop-is-some-url (method url)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 "Returns true if method equals the start of url.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 If method does not end into ':' this is appended before the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 compare."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 (cond ((and (stringp url)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 (stringp method)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 (> (length url) (length method)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 ;; is this ?: check efficient enough?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 (if (not (string= (substring method -1) ":"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 (setq method (concat method ":")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (string= method (substring url 0 (length method))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 ;; Drag API
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (defun experimental-dragdrop-drag (event object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 "*{EXPERIMENTAL} The generic drag function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 Tries to do the best with object in the selected protocol.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 Object must comply to the standart drag'n'drop object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 format."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (error "Not implemented"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 (defun experimental-dragdrop-drag-region (event begin end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 "*{EXPERIMENTAL} Drag a region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 This function uses special data types if the low-level
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 protocol requires it. It does so by calling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 dragdrop-drag-pure-text."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (experimental-dragdrop-drag-pure-text event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (buffer-substring-no-properties begin end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (defun experimental-dragdrop-drag-pure-text (event text)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 "*{EXPERIMENTAL} Drag text-only data.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 Takes care of special low-level protocol data types.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 Text must be a list of strings."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (error "Not implemented"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (defun experimental-dragdrop-drag-pure-file (event file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 "*{EXPERIMENTAL} Drag filepath-only data.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 Takes care of special low-level protocol data types.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 file must be a list of strings."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 (error "Not implemented"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 ;; The following ones come from frame.el but the better belong here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 ;; until changed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 (defun cde-start-drag (event type data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 "Implement the CDE drag operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 Calls the internal function cde-start-drag-internal to do the actual work."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 (interactive "_eXX")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 (if (featurep 'cde)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 ;; Avoid build-time doc string warning by calling the function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 ;; in the following roundabout way:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (funcall (intern "cde-start-drag-internal")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 event type data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (error "CDE functionality not compiled in.")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (defun cde-start-drag-region (event begin end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 "Implement the CDE drag operation for a region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 Calls the internal function CDE-start-drag-internal to do the actual work.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 This always does buffer transfers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 ;; Oliver Graf <ograf@fga.de>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 (interactive "_er")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (if (featurep 'cde)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (funcall (intern "cde-start-drag-internal")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 event nil (list (buffer-substring-no-properties begin end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (error "CDE functionality not compiled in.")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 ;; the OffiX drag stuff will soon move also (perhaps mouse.el)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 ;; if the drag event is done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (defun offix-start-drag (event data &optional type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 "Implement the OffiX drag operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 Calls the internal function offix-start-drag-internal to do the actual work.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 If type is not given, DndText is assumed."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 ;; Oliver Graf <ograf@fga.de>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 (interactive "esi")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 (if (featurep 'offix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 (funcall (intern "offix-start-drag-internal") event data type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (error "OffiX functionality not compiled in.")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (defun offix-start-drag-region (event begin end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 "Implement the OffiX drag operation for a region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 Calls the internal function offix-start-drag-internal to do the actual work.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 This always assumes DndText as type."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 ;; Oliver Graf <ograf@fga.de>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (interactive "_er")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 (if (featurep 'offix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 (funcall (intern "offix-start-drag-internal")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 event (buffer-substring-no-properties begin end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (error "OffiX functionality not compiled in.")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
424 (defun gtk-start-drag (event data &optional type)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
425 (interactive "esi")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
426 (if (featurep 'gtk)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
427 (declare-fboundp (gtk-start-drag-internal event data type))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
428 (error "GTK functionality not compiled in.")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
429
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
430 (defun gtk-start-drag-region (event begin end)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
431 (interactive "_er")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
432 (if (featurep 'gtk)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
433 (declare-fboundp (gtk-start-drag-internal event (buffer-substring-no-properties begin end) "text/plain"))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
434 (error "GTK functionality not compiled in.")))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 ;;; dragdrop.el ends here