Mercurial > hg > xemacs-beta
annotate lisp/x-select.el @ 5634:2014ff433daf
Support hash COLLECTIONs, #'{all,try}-completion{s,}; add #'test-completion
src/ChangeLog addition:
2012-01-01 Aidan Kehoe <kehoea@parhasard.net>
Add #'test-completion, API from GNU.
Accept hash table COLLECTIONs in it and in the other
completion-oriented functions, #'try-completion,
#'all-completions, and those Lisp functions implemented in terms
of them.
* lisp.h: Update the prototype of map_obarray(), making FN
compatible with the FUNCTION argument of elisp_maphash();
* abbrev.c (abbrev_match_mapper):
* abbrev.c (record_symbol):
* doc.c (verify_doc_mapper):
* symbols.c (mapatoms_1):
* symbols.c (apropos_mapper):
Update these mapper functions to reflect the new argument to
map_obarray().
* symbols.c (map_obarray):
Call FN with two arguments, the string name of the symbol, and the
symbol itself, for API (mapper) compatibility with
elisp_maphash().
* minibuf.c (map_completion): New. Map a maphash_function_t across
a non function COLLECTION, as appropriate for #'try-completion and
friends.
* minibuf.c (map_completion_list): New. Map a maphash_function_t
across a pseudo-alist, as appropriate for the completion
functions.
* minibuf.c (ignore_completion_p): PRED needs to be called with
two args if and only if the collection is a hash table. Implement
this.
* minibuf.c (try_completion_mapper): New. The loop body of
#'try-completion, refactored out.
* minibuf.c (Ftry_completion): Use try_completion_mapper(),
map_completion().
* minibuf.c (all_completions_mapper): New. The loop body of
#'all-completions, refactored out.
* minibuf.c (Fall_completions): Use all_completions_mapper(),
map_completion().
* minibuf.c (test_completion_mapper): New. The loop body of
#'test-completion.
* minibuf.c (Ftest_completion): New, API from GNU.
* minibuf.c (syms_of_minibuf): Make Ftest_completion available.
tests/ChangeLog addition:
2012-01-01 Aidan Kehoe <kehoea@parhasard.net>
* automated/completion-tests.el: New.
Test #'try-completion, #'all-completion and #'test-completion with
list, vector and hash-table COLLECTION arguments.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 01 Jan 2012 15:18:52 +0000 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 428 | 1 ;;; x-select.el --- Lisp interface to X Selections. |
| 2 | |
| 3 ;; Copyright (C) 1990, 1997 Free Software Foundation, Inc. | |
| 4 ;; Copyright (C) 1995 Sun Microsystems. | |
| 5 | |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Keywords: extensions, dumped | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2620
diff
changeset
|
11 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2620
diff
changeset
|
12 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2620
diff
changeset
|
13 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2620
diff
changeset
|
14 ;; option) any later version. |
| 428 | 15 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2620
diff
changeset
|
16 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2620
diff
changeset
|
17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2620
diff
changeset
|
18 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2620
diff
changeset
|
19 ;; for more details. |
| 428 | 20 |
| 21 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2620
diff
changeset
|
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 23 |
| 24 ;;; Synched up with: FSF 19.30 (select.el). | |
| 25 | |
| 26 ;;; Commentary: | |
| 27 | |
| 28 ;; This file is dumped with XEmacs (when X support is compiled in). | |
| 29 | |
| 30 ;; The selection code requires us to use certain symbols whose names are | |
| 31 ;; all upper-case; this may seem tasteless, but it makes there be a 1:1 | |
| 32 ;; correspondence between these symbols and X Atoms (which are upcased). | |
| 33 | |
| 34 ;;; Code: | |
| 35 | |
| 502 | 36 (globally-declare-fboundp |
| 37 '(x-get-cutbuffer-internal | |
| 38 x-rotate-cutbuffers-internal x-store-cutbuffer-internal)) | |
| 39 | |
| 428 | 40 (define-obsolete-function-alias 'x-selection-exists-p 'selection-exists-p) |
| 41 (define-obsolete-function-alias 'x-selection-owner-p 'selection-owner-p) | |
| 42 (define-obsolete-variable-alias 'x-selection-converter-alist 'selection-converter-alist) | |
| 43 (define-obsolete-variable-alias 'x-lost-selection-hooks 'lost-selection-hooks) | |
| 2620 | 44 (define-obsolete-variable-alias 'x-selected-text-type 'selection-preferred-types) |
| 428 | 45 (define-obsolete-function-alias 'x-valid-simple-selection-p 'valid-simple-selection-p) |
| 46 (define-obsolete-function-alias 'x-own-selection 'own-selection) | |
| 47 (define-obsolete-function-alias 'x-disown-selection 'disown-selection) | |
| 48 (define-obsolete-function-alias 'x-delete-primary-selection 'delete-primary-selection) | |
| 49 (define-obsolete-function-alias 'x-copy-primary-selection 'copy-primary-selection) | |
| 50 (define-obsolete-function-alias 'x-kill-primary-selection 'kill-primary-selection) | |
| 51 (define-obsolete-function-alias 'x-select-make-extent-for-selection | |
| 52 'select-make-extent-for-selection) | |
| 53 (define-obsolete-function-alias 'x-cut-copy-clear-internal 'cut-copy-clear-internal) | |
| 54 (define-obsolete-function-alias 'x-get-selection 'get-selection) | |
| 55 (define-obsolete-function-alias 'x-get-clipboard 'get-clipboard) | |
| 444 | 56 (define-obsolete-function-alias 'x-yank-clipboard-selection |
| 428 | 57 'yank-clipboard-selection) |
| 58 (define-obsolete-function-alias 'x-disown-selection-internal | |
| 59 'disown-selection-internal) | |
| 60 | |
| 61 (defun x-get-secondary-selection () | |
| 62 "Return text selected from some X window." | |
| 63 (get-selection 'SECONDARY)) | |
| 64 | |
| 65 (defun x-own-secondary-selection (selection &optional type) | |
| 66 "Make a secondary X Selection of the given argument. The argument may be a | |
| 67 string or a cons of two markers (in which case the selection is considered to | |
| 68 be the text between those markers)." | |
| 69 (interactive (if (not current-prefix-arg) | |
| 70 (list (read-string "Store text for pasting: ")) | |
| 71 (list (cons ;; these need not be ordered. | |
| 72 (copy-marker (point-marker)) | |
| 73 (copy-marker (mark-marker)))))) | |
| 74 (own-selection selection 'SECONDARY)) | |
| 75 | |
| 76 (defun x-notice-selection-requests (selection type successful) | |
| 444 | 77 "for possible use as the value of `x-sent-selection-hooks'." |
| 428 | 78 (if (not successful) |
| 79 (message "Selection request failed to convert %s to %s" | |
| 80 selection type) | |
| 81 (message "Sent selection %s as %s" selection type))) | |
| 82 | |
| 83 (defun x-notice-selection-failures (selection type successful) | |
| 444 | 84 "for possible use as the value of `x-sent-selection-hooks'." |
| 428 | 85 (or successful |
| 86 (message "Selection request failed to convert %s to %s" | |
| 87 selection type))) | |
| 88 | |
| 89 ;(setq x-sent-selection-hooks 'x-notice-selection-requests) | |
| 90 ;(setq x-sent-selection-hooks 'x-notice-selection-failures) | |
| 91 | |
| 92 | |
| 93 ;;; Cut Buffer support | |
| 94 | |
| 95 ;;; FSF name x-get-cut-buffer | |
| 96 (defun x-get-cutbuffer (&optional which-one) | |
| 97 "Return the value of one of the 8 X server cut buffers. | |
| 98 Optional arg WHICH-ONE should be a number from 0 to 7, defaulting to 0. | |
| 99 Cut buffers are considered obsolete; you should use selections instead. | |
| 444 | 100 This function does nothing if cut buffer support was not compiled in." |
| 101 (when (fboundp 'x-get-cutbuffer-internal) | |
| 102 (x-get-cutbuffer-internal | |
| 103 (aref [CUT_BUFFER0 CUT_BUFFER1 CUT_BUFFER2 CUT_BUFFER3 | |
| 104 CUT_BUFFER4 CUT_BUFFER5 CUT_BUFFER6 CUT_BUFFER7] | |
| 105 (or which-one 0))))) | |
| 428 | 106 |
| 107 ;;; FSF name x-set-cut-buffer | |
| 108 (defun x-store-cutbuffer (string &optional push) | |
| 109 "Store STRING into the X server's primary cut buffer. | |
| 444 | 110 If optional arg PUSH is non-nil, also rotate the cut buffers: this |
| 111 means the previous value of the primary cut buffer moves to the second | |
| 428 | 112 cut buffer, and the second to the third, and so on (there are 8 buffers.) |
| 113 Cut buffers are considered obsolete; you should use selections instead. | |
| 444 | 114 This function does nothing if cut buffer support was not compiled in." |
| 115 (when (fboundp 'x-store-cutbuffer-internal) | |
| 116 (when push | |
| 117 (x-rotate-cutbuffers-internal 1)) | |
| 118 (x-store-cutbuffer-internal 'CUT_BUFFER0 string))) | |
| 428 | 119 |
| 120 | |
| 121 ;FSFmacs (provide 'select) | |
| 122 | |
| 123 ;;; x-select.el ends here. |