annotate tests/Dnd/droptest.el @ 5169:6c6d78781d59

cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2010-03-24 Ben Wing <ben@xemacs.org> * array.h: * array.h (XD_LISP_DYNARR_DESC): * dumper.c (pdump_register_sub): * dumper.c (pdump_store_new_pointer_offsets): * dumper.c (pdump_reloc_one_mc): * elhash.c: * gc.c (lispdesc_one_description_line_size): * gc.c (kkcc_marking): * lrecord.h: * lrecord.h (IF_NEW_GC): * lrecord.h (enum memory_description_type): * lrecord.h (enum data_description_entry_flags): * lrecord.h (struct opaque_convert_functions): Rename XD_LISP_OBJECT_BLOCK_PTR to XD_INLINE_LISP_OBJECT_BLOCK_PTR and document it in lrecord.h. * data.c: * data.c (finish_marking_weak_lists): * data.c (continue_marking_ephemerons): * data.c (finish_marking_ephemerons): * elhash.c (MARK_OBJ): * gc.c: * gc.c (lispdesc_indirect_count_1): * gc.c (struct): * gc.c (kkcc_bt_push): * gc.c (kkcc_gc_stack_push): * gc.c (kkcc_gc_stack_push_lisp_object): * gc.c (kkcc_gc_stack_repush_dirty_object): * gc.c (KKCC_DO_CHECK_FREE): * gc.c (mark_object_maybe_checking_free): * gc.c (mark_struct_contents): * gc.c (mark_lisp_object_block_contents): * gc.c (register_for_finalization): * gc.c (mark_object): * gc.h: * lisp.h: * profile.c: * profile.c (mark_profiling_info_maphash): Clean up KKCC code related to DEBUG_XEMACS. Rename kkcc_backtrace() to kkcc_backtrace_1() and add two params: a `size' arg to control how many stack elements to print and a `detailed' arg to control whether Lisp objects are printed using `debug_print()'. Create front-ends to kkcc_backtrace_1() -- kkcc_detailed_backtrace(), kkcc_short_backtrace(), kkcc_detailed_backtrace_full(), kkcc_short_backtrace_full(), as well as shortened versions kbt(), kbts(), kbtf(), kbtsf() -- to call it with various parameter values. Add an `is_lisp' field to the stack and backtrace structures and use it to keep track of whether an object pushed onto the stack is a Lisp object or a non-Lisp structure; in kkcc_backtrace_1(), don't try to print a non-Lisp structure as a Lisp object. * elhash.c: * extents.c: * file-coding.c: * lrecord.h: * lrecord.h (IF_NEW_GC): * marker.c: * marker.c (Fmarker_buffer): * mule-coding.c: * number.c: * rangetab.c: * specifier.c: New macros IF_OLD_GC(), IF_NEW_GC() to simplify declaration of Lisp objects when a finalizer may exist in one but not the other. Use them appropriately. * extents.c (finalize_extent_info): Don't zero out data->soe and data->extents before trying to free, else we get memory leaks. * lrecord.h (enum lrecord_type): Make the first lrecord type have value 1 not 0 so that 0 remains without implementation and attempts to interpret zeroed memory as a Lisp object will be more obvious. * array.c (Dynarr_free): * device-msw.c (msprinter_delete_device): * device-tty.c (free_tty_device_struct): * device-tty.c (tty_delete_device): * dialog-msw.c (handle_directory_dialog_box): * dialog-x.c: * emacs.c (free_argc_argv): * emodules.c (attempt_module_delete): * file-coding.c (chain_finalize_coding_stream_1): * file-coding.c (chain_finalize_coding_stream): * glyphs-eimage.c: * glyphs-eimage.c (jpeg_instantiate_unwind): * glyphs-eimage.c (gif_instantiate_unwind): * glyphs-eimage.c (png_instantiate_unwind): * glyphs-eimage.c (tiff_instantiate_unwind): * imgproc.c: * imgproc.c (build_EImage_quantable): * insdel.c (uninit_buffer_text): * mule-coding.c (iso2022_finalize_detection_state): * objects-tty.c (tty_finalize_color_instance): * objects-tty.c (tty_finalize_font_instance): * objects-tty.c (tty_font_list): * process.c: * process.c (finalize_process): * redisplay.c (add_propagation_runes): * scrollbar-gtk.c: * scrollbar-gtk.c (gtk_free_scrollbar_instance): * scrollbar-gtk.c (gtk_release_scrollbar_instance): * scrollbar-msw.c: * scrollbar-msw.c (mswindows_free_scrollbar_instance): * scrollbar-msw.c (unshow_that_mofo): * scrollbar-x.c (x_free_scrollbar_instance): * scrollbar-x.c (x_release_scrollbar_instance): * select-x.c: * select-x.c (x_handle_selection_request): * syntax.c: * syntax.c (uninit_buffer_syntax_cache): * text.h (eifree): If possible, whenever we call xfree() on a field in a structure, set the field to 0 afterwards. A lot of code is written so that it checks the value being freed to see if it is non-zero before freeing it -- doing this and setting the value to 0 afterwards ensures (a) we won't try to free twice if the cleanup code is called twice; (b) if the object itself stays around, KKCC won't crash when attempting to mark the freed field. * rangetab.c: Add a finalization method when not NEW_GC to avoid memory leaks. (#### We still get memory leaks when NEW_GC; need to convert gap array to Lisp object).
author Ben Wing <ben@xemacs.org>
date Wed, 24 Mar 2010 01:22:51 -0500
parents bc4f2511bbea
children d88ad9ccfa66
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 ;; a short example how to use the new Drag'n'Drop API in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 ;; combination with extents.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;;
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 (defun dnd-drop-message (event object text)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 (message "Dropped %s with :%s" text object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; signal that we have done something with the data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 t)
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 (defun do-nothing (event object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; signal that the data is still unprocessed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 (defun start-drag (event what &optional typ)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; short drag interface, until the real one is implemented
4790
bc4f2511bbea Remove support for the OffiX drag-and-drop protocol. See xemacs-patches
Jerry James <james@xemacs.org>
parents: 428
diff changeset
16 (cond ((featurep 'cde)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 (if (not typ)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 (funcall (intern "cde-start-drag-internal") event nil (list what))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 (funcall (intern "cde-start-drag-internal") event t what)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 (t display-message 'error "no valid drag protocols implemented")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 (defun start-region-drag (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 (interactive "_e")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 (if (click-inside-extent-p event zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; okay, this is a drag
4790
bc4f2511bbea Remove support for the OffiX drag-and-drop protocol. See xemacs-patches
Jerry James <james@xemacs.org>
parents: 428
diff changeset
26 (cond ((featurep 'cde)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 (cde-start-drag-region event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 (extent-start-position zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 (extent-end-position zmacs-region-extent)))
4790
bc4f2511bbea Remove support for the OffiX drag-and-drop protocol. See xemacs-patches
Jerry James <james@xemacs.org>
parents: 428
diff changeset
30 (t (error "No CDE support compiled in")))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 (defun make-drop-targets ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 (let ((buf (get-buffer-create "*DND misc-user extent test buffer*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 (s nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 (e nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 (set-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 (pop-to-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 (setq s (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 (insert "[ DROP TARGET 1]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 (setq e (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 (setq ext (make-extent s e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 (set-extent-property ext
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 'experimental-dragdrop-drop-functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 '((do-nothing t t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 (dnd-drop-message t t "on target 1")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 (set-extent-property ext 'mouse-face 'highlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 (setq s (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 (insert "[ DROP TARGET 2]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 (setq e (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 (setq ext (make-extent s e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 (set-extent-property ext
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 'experimental-dragdrop-drop-functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 '((dnd-drop-message t t "on target 2")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 (set-extent-property ext 'mouse-face 'highlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 (setq s (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 (insert "[ DROP TARGET 3]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 (setq e (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 (setq ext (make-extent s e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 (set-extent-property ext
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 'experimental-dragdrop-drop-functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 '((dnd-drop-message t t "on target 3")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 (set-extent-property ext 'mouse-face 'highlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 (newline 2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 (defun make-drag-starters ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 (let ((buf (get-buffer-create "*DND misc-user extent test buffer*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (s nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 (e nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (ext nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 (kmap nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 (set-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 (pop-to-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 (erase-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 (insert "Try to drag data from one of the upper extents to one\nof the lower extents. Make sure that your minibuffer is big\ncause it is used to display the data.\n\nYou may also try to select some of this text and drag it with button2.\n\nTo ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 (setq s (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 (insert "EXIT")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (setq e (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 (insert " this demo, press 'q'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 (setq ext (make-extent s e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (setq kmap (make-keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 (define-key kmap [button1] 'end-dnd-demo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (set-extent-property ext 'keymap kmap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 (set-extent-property ext 'mouse-face 'highlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 (newline 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 (setq s (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 (insert "[ TEXT DRAG TEST ]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 (setq e (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 (setq ext (make-extent s e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 (set-extent-property ext 'mouse-face 'isearch)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 (setq kmap (make-keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 (define-key kmap [button1] 'text-drag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 (set-extent-property ext 'keymap kmap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 (setq s (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 (insert "[ FILE DRAG TEST ]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (setq e (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (setq ext (make-extent s e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 (set-extent-property ext 'mouse-face 'isearch)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 (setq kmap (make-keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (if (featurep 'cde)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 (define-key kmap [button1] 'cde-file-drag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 (define-key kmap [button1] 'file-drag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (set-extent-property ext 'keymap kmap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 (setq s (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 (insert "[ FILES DRAG TEST ]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 (setq e (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 (setq ext (make-extent s e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 (set-extent-property ext 'mouse-face 'isearch)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 (setq kmap (make-keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 (define-key kmap [button1] 'files-drag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 (set-extent-property ext 'keymap kmap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 (setq s (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 (insert "[ URL DRAG TEST ]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 (setq e (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 (setq ext (make-extent s e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 (set-extent-property ext 'mouse-face 'isearch)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 (setq kmap (make-keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 (if (featurep 'cde)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 (define-key kmap [button1] 'cde-file-drag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 (define-key kmap [button1] 'url-drag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 (set-extent-property ext 'keymap kmap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 (newline 3)))
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 text-drag (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 (interactive "@e")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 (start-drag event "That's a test"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 (defun file-drag (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 (interactive "@e")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 (start-drag event "/tmp/DropTest.xpm" 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 (defun cde-file-drag (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 (interactive "@e")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 (start-drag event '("/tmp/DropTest.xpm") t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 (defun url-drag (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (interactive "@e")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (start-drag event "http://www.xemacs.org/" 8))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 (defun files-drag (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 (interactive "@e")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 (start-drag event '("/tmp/DropTest.html" "/tmp/DropTest.xpm" "/tmp/DropTest.tex") 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 (setq experimental-dragdrop-drop-functions '((do-nothing t t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 ;; CDE does not have any button info...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (dnd-drop-message 0 t "cde-drop somewhere else")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 (dnd-drop-message 2 t "region somewhere else")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 (dnd-drop-message 1 t "drag-source somewhere else")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (do-nothing t t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (make-drag-starters)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (make-drop-targets)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 (defun end-dnd-demo ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (global-set-key [button2] button2-func)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 (bury-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 (setq lmap (make-keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 (use-local-map lmap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 (local-set-key [q] 'end-dnd-demo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (setq button2-func (lookup-key global-map [button2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 (global-set-key [button2] 'start-region-drag)