annotate lisp/dragdrop.el @ 826:6728e641994e

[xemacs-hg @ 2002-05-05 11:30:15 by ben] syntax cache, 8-bit-format, lots of code cleanup README.packages: Update info about --package-path. i.c: Create an inheritable event and pass it on to XEmacs, so that ^C can be handled properly. Intercept ^C and signal the event. "Stop Build" in VC++ now works. bytecomp-runtime.el: Doc string changes. compat.el: Some attempts to redo this to make it truly useful and fix the "multiple versions interacting with each other" problem. Not yet done. Currently doesn't work. files.el: Use with-obsolete-variable to avoid warnings in new revert-buffer code. xemacs.mak: Split up CFLAGS into a version without flags specifying the C library. The problem seems to be that minitar depends on zlib, which depends specifically on libc.lib, not on any of the other C libraries. Unless you compile with libc.lib, you get errors -- specifically, no _errno in the other libraries, which must make it something other than an int. (#### But this doesn't seem to obtain in XEmacs, which also uses zlib, and can be linked with any of the C libraries. Maybe zlib is used differently and doesn't need errno, or maybe XEmacs provides an int errno; ... I don't understand. Makefile.in.in: Fix so that packages are around when testing. abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, callint.c, casefiddle.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.h, console-stream.c, console-x.c, console.c, console.h, data.c, device-msw.c, device.c, device.h, dialog-msw.c, dialog-x.c, dired-msw.c, dired.c, doc.c, doprnt.c, dumper.c, editfns.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, events.h, extents.c, extents.h, faces.c, file-coding.c, file-coding.h, fileio.c, fns.c, font-lock.c, frame-gtk.c, frame-msw.c, frame-x.c, frame.c, frame.h, glade.c, glyphs-gtk.c, glyphs-msw.c, glyphs-msw.h, glyphs-x.c, glyphs.c, glyphs.h, gui-msw.c, gui-x.c, gui.h, gutter.h, hash.h, indent.c, insdel.c, intl-win32.c, intl.c, keymap.c, lisp-disunion.h, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, marker.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, mule-ccl.c, mule-charset.c, mule-coding.c, mule-wnnfns.c, nas.c, objects-msw.c, objects-x.c, opaque.c, postgresql.c, print.c, process-nt.c, process-unix.c, process.c, process.h, profile.c, rangetab.c, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-x.c, redisplay.c, redisplay.h, regex.c, regex.h, scrollbar-msw.c, search.c, select-x.c, specifier.c, specifier.h, symbols.c, symsinit.h, syntax.c, syntax.h, syswindows.h, tests.c, text.c, text.h, tooltalk.c, ui-byhand.c, ui-gtk.c, unicode.c, win32.c, window.c: Another big Ben patch. -- FUNCTIONALITY CHANGES: add partial support for 8-bit-fixed, 16-bit-fixed, and 32-bit-fixed formats. not quite done yet. (in particular, needs functions to actually convert the buffer.) NOTE: lots of changes to regex.c here. also, many new *_fmt() inline funs that take an Internal_Format argument. redo syntax cache code. make the cache per-buffer; keep the cache valid across calls to functions that use it. also keep it valid across insertions/deletions and extent changes, as much as is possible. eliminate the junky regex-reentrancy code by passing in the relevant lisp info to the regex routines as local vars. add general mechanism in extents code for signalling extent changes. fix numerous problems with the case-table implementation; yoshiki never properly transferred many algorithms from old-style to new-style case tables. redo char tables to support a default argument, so that mapping only occurs over changed args. change many chartab functions to accept Lisp_Object instead of Lisp_Char_Table *. comment out the code in font-lock.c by default, because font-lock.el no longer uses it. we should consider eliminating it entirely. Don't output bell as ^G in console-stream when not a TTY. add -mswindows-termination-handle to interface with i.c, so we can properly kill a build. add more error-checking to buffer/string macros. add some additional buffer_or_string_() funs. -- INTERFACE CHANGES AFFECTING MORE CODE: switch the arguments of write_c_string and friends to be consistent with write_fmt_string, which must have printcharfun first. change BI_* macros to BYTE_* for increased clarity; similarly for bi_* local vars. change VOID_TO_LISP to be a one-argument function. eliminate no-longer-needed CVOID_TO_LISP. -- char/string macro changes: rename MAKE_CHAR() to make_emchar() for slightly less confusion with make_char(). (The former generates an Emchar, the latter a Lisp object. Conceivably we should rename make_char() -> wrap_char() and similarly for make_int(), make_float().) Similar changes for other *CHAR* macros -- we now consistently use names with `emchar' whenever we are working with Emchars. Any remaining name with just `char' always refers to a Lisp object. rename macros with XSTRING_* to string_* except for those that reference actual fields in the Lisp_String object, following conventions used elsewhere. rename set_string_{data,length} macros (the only ones to work with a Lisp_String_* instead of a Lisp_Object) to set_lispstringp_* to make the difference clear. try to be consistent about caps vs. lowercase in macro/inline-fun names for chars and such, which wasn't the case before. we now reserve caps either for XFOO_ macros that reference object fields (e.g. XSTRING_DATA) or for things that have non-function semantics, e.g. directly modifying an arg (BREAKUP_EMCHAR) or evaluating an arg (any arg) more than once. otherwise, use lowercase. here is a summary of most of the macros/inline funs changed by all of the above changes: BYTE_*_P -> byte_*_p XSTRING_BYTE -> string_byte set_string_data/length -> set_lispstringp_data/length XSTRING_CHAR_LENGTH -> string_char_length XSTRING_CHAR -> string_emchar INTBYTE_FIRST_BYTE_P -> intbyte_first_byte_p INTBYTE_LEADING_BYTE_P -> intbyte_leading_byte_p charptr_copy_char -> charptr_copy_emchar LEADING_BYTE_* -> leading_byte_* CHAR_* -> EMCHAR_* *_CHAR_* -> *_EMCHAR_* *_CHAR -> *_EMCHAR CHARSET_BY_ -> charset_by_* BYTE_SHIFT_JIS* -> byte_shift_jis* BYTE_BIG5* -> byte_big5* REP_BYTES_BY_FIRST_BYTE -> rep_bytes_by_first_byte char_to_unicode -> emchar_to_unicode valid_char_p -> valid_emchar_p Change intbyte_strcmp -> qxestrcmp_c (duplicated functionality). -- INTERFACE CHANGES AFFECTING LESS CODE: use DECLARE_INLINE_HEADER in various places. remove '#ifdef emacs' from XEmacs-only files. eliminate CHAR_TABLE_VALUE(), which duplicated the functionality of get_char_table(). add BUFFER_TEXT_LOOP to simplify iterations over buffer text. define typedefs for signed and unsigned types of fixed sizes (INT_32_BIT, UINT_32_BIT, etc.). create ALIGN_FOR_TYPE as a higher-level interface onto ALIGN_SIZE; fix code to use it. add charptr_emchar_len to return the text length of the character pointed to by a ptr; use it in place of charcount_to_bytecount(..., 1). add emchar_len to return the text length of a given character. add types Bytexpos and Charxpos to generalize Bytebpos/Bytecount and Charbpos/Charcount, in code (particularly, the extents code and redisplay code) that works with either kind of index. rename redisplay struct params with names such as `charbpos' to e.g. `charpos' when they are e.g. a Charxpos, not a Charbpos. eliminate xxDEFUN in place of DEFUN; no longer necessary with changes awhile back to doc.c. split up big ugly combined list of EXFUNs in lisp.h on a file-by-file basis, since other prototypes are similarly split. rewrite some "*_UNSAFE" macros as inline funs and eliminate the _UNSAFE suffix. move most string code from lisp.h to text.h; the string code and text.h code is now intertwined in such a fashion that they need to be in the same place and partially interleaved. (you can't create forward references for inline funs) automated/lisp-tests.el, automated/symbol-tests.el, automated/test-harness.el: Fix test harness to output FAIL messages to stderr when in batch mode. Fix up some problems in lisp-tests/symbol-tests that were causing spurious failures.
author ben
date Sun, 05 May 2002 11:33:57 +0000
parents 79940b592197
children bc4f2511bbea
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)
536
8f3fb4fd879b [xemacs-hg @ 2001-05-14 05:05:09 by mta]
mta
parents: 502
diff changeset
232 (let* ((data (cdr object))
8f3fb4fd879b [xemacs-hg @ 2001-05-14 05:05:09 by mta]
mta
parents: 502
diff changeset
233 (frame (event-channel event))
8f3fb4fd879b [xemacs-hg @ 2001-05-14 05:05:09 by mta]
mta
parents: 502
diff changeset
234 (x pop-up-windows)
8f3fb4fd879b [xemacs-hg @ 2001-05-14 05:05:09 by mta]
mta
parents: 502
diff changeset
235 (window (or (event-window event)
8f3fb4fd879b [xemacs-hg @ 2001-05-14 05:05:09 by mta]
mta
parents: 502
diff changeset
236 (frame-selected-window frame)
8f3fb4fd879b [xemacs-hg @ 2001-05-14 05:05:09 by mta]
mta
parents: 502
diff changeset
237 (frame-highest-window frame 0))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 (setq pop-up-windows nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 (while (not (eq data ()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 (cond ((dragdrop-is-some-url "file" (car data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 ;; if it is some file, pop it to a buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (cond (window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 (select-window window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (switch-to-buffer (find-file-noselect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (substring (car data) 5))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 ;; to-do: open ftp URLs with efs...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 ;; some other URL, try to fire up some browser for it
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 536
diff changeset
249 (if-fboundp 'browse-url
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
250 (browse-url (car data))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 (display-message 'error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 "Can't show URL, no browser selected"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (undo-boundary)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 (setq data (cdr data)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 (make-frame-visible frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 (setq pop-up-windows x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 (defun experimental-dragdrop-drop-mime-default (event object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 "*{EXPERIMENTAL} Default handler for dropped MIME data.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 Inserts text into buffer, creates MIME buffers for other types.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 Returns nil if object does not contain MIME data."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 (cond ((eq (car object) 'dragdrop-MIME)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 (let ((ldata (cdr object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (frame (event-channel event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 (x pop-up-windows)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 (data nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 ;; how should this be handled???
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 ;; insert drops of text/* into buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 ;; create new buffer if pointer is outside buffer...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 ;; but there are many other ways...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 ;; first thing: check if it's only text/plain and if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 ;; drop happened inside some buffer. if yes insert it into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 ;; this buffer (hope it is not encoded in some MIME way)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 ;; Remember: ("text/plain" "dosnotmatter" "somedata")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 ;; drops are inserted at mouse-point, if inside a buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 (while (not (eq ldata ()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 (setq data (car ldata))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 (if (and (listp data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 (= (length data) 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 (listp (car data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (stringp (caar data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (string= (caar data) "text/plain")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (event-over-text-area-p event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 (let ((window (event-window event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 (and window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (select-window window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 (and (not dragdrop-drop-at-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 (mouse-set-point event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (insert (caddr data)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 (let ((buf (get-buffer-create "*MIME-Drop data*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (set-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 (pop-to-buffer buf nil frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (or (featurep 'tm-view)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 (and dragdrop-autoload-tm-view
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (require 'tm-view)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (cond ((stringp data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 ;; this is some raw MIME stuff
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 ;; create some buffer and let tm do the job
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 ;; this is always the same buffer!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 ;; change?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 (insert data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 (and (featurep 'tm-view)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
309 (declare-fboundp (mime/viewer-mode buf))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 ((and (listp data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (= (length data) 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 ;; change the internal content-type representation to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 ;; way tm does it ("content/type" (key . value)*)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 ;; but for now list will do the job
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 ;; this is always the same buffer!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 ;; change?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 (insert (caddr data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 (and (featurep 'tm-view)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 ;; this list of (car data) should be done before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 ;; enqueing the event
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
323 (declare-fboundp
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
324 (mime/viewer-mode buf (car data) (cadr data)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 (display-message 'error "Wrong drop data")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 (undo-boundary)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 (setq ldata (cdr ldata)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 (make-frame-visible frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 (setq pop-up-windows x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 (defun dragdrop-is-some-url (method url)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 "Returns true if method equals the start of url.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 If method does not end into ':' this is appended before the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 compare."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 (cond ((and (stringp url)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 (stringp method)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 (> (length url) (length method)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 ;; is this ?: check efficient enough?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (if (not (string= (substring method -1) ":"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (setq method (concat method ":")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 (string= method (substring url 0 (length method))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346
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 ;; Drag API
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (defun experimental-dragdrop-drag (event object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 "*{EXPERIMENTAL} The generic drag function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 Tries to do the best with object in the selected protocol.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 Object must comply to the standart drag'n'drop object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 format."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 (error "Not implemented"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (defun experimental-dragdrop-drag-region (event begin end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 "*{EXPERIMENTAL} Drag a region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 This function uses special data types if the low-level
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 protocol requires it. It does so by calling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 dragdrop-drag-pure-text."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (experimental-dragdrop-drag-pure-text event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (buffer-substring-no-properties begin end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 (defun experimental-dragdrop-drag-pure-text (event text)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 "*{EXPERIMENTAL} Drag text-only data.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 Takes care of special low-level protocol data types.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 Text must be a list of strings."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (error "Not implemented"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 (defun experimental-dragdrop-drag-pure-file (event file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 "*{EXPERIMENTAL} Drag filepath-only data.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 Takes care of special low-level protocol data types.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 file must be a list of strings."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (error "Not implemented"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 ;; The following ones come from frame.el but the better belong here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 ;; until changed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 (defun cde-start-drag (event type data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 "Implement the CDE drag operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 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
384 (interactive "_eXX")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (if (featurep 'cde)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 ;; Avoid build-time doc string warning by calling the function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 ;; in the following roundabout way:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (funcall (intern "cde-start-drag-internal")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 event type data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (error "CDE functionality not compiled in.")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 (defun cde-start-drag-region (event begin end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 "Implement the CDE drag operation for a region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 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
395 This always does buffer transfers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 ;; Oliver Graf <ograf@fga.de>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (interactive "_er")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (if (featurep 'cde)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (funcall (intern "cde-start-drag-internal")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 event nil (list (buffer-substring-no-properties begin end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (error "CDE functionality not compiled in.")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 ;; the OffiX drag stuff will soon move also (perhaps mouse.el)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 ;; if the drag event is done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (defun offix-start-drag (event data &optional type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 "Implement the OffiX drag operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 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
408 If type is not given, DndText is assumed."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 ;; Oliver Graf <ograf@fga.de>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 (interactive "esi")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (if (featurep 'offix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 (funcall (intern "offix-start-drag-internal") event data type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (error "OffiX functionality not compiled in.")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 (defun offix-start-drag-region (event begin end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 "Implement the OffiX drag operation for a region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 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
418 This always assumes DndText as type."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 ;; Oliver Graf <ograf@fga.de>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 (interactive "_er")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 (if (featurep 'offix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (funcall (intern "offix-start-drag-internal")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 event (buffer-substring-no-properties begin end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 (error "OffiX functionality not compiled in.")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
426 (defun gtk-start-drag (event data &optional type)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
427 (interactive "esi")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
428 (if (featurep 'gtk)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
429 (declare-fboundp (gtk-start-drag-internal event data type))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
430 (error "GTK functionality not compiled in.")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
431
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
432 (defun gtk-start-drag-region (event begin end)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
433 (interactive "_er")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 442
diff changeset
434 (if (featurep 'gtk)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
435 (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
436 (error "GTK functionality not compiled in.")))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 ;;; dragdrop.el ends here