Mercurial > hg > xemacs-beta
annotate lisp/page.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 |
|---|---|
| 2510 | 1 ;;; page.el --- page motion commands for Emacs |
| 209 | 2 |
| 3 ;; Copyright (C) 1985, 1997 Free Software Foundation, Inc. | |
| 4 | |
| 5 ;; Maintainer: FSF | |
| 6 ;; Keywords: extensions, dumped | |
| 2510 | 7 ;; Keywords: wp convenience |
| 209 | 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:
2510
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:
2510
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:
2510
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:
2510
diff
changeset
|
14 ;; option) any later version. |
| 209 | 15 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2510
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:
2510
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:
2510
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:
2510
diff
changeset
|
19 ;; for more details. |
| 209 | 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:
2510
diff
changeset
|
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 209 | 23 |
| 2510 | 24 ;;; Synched up with: FSF 21.3. |
| 209 | 25 |
| 26 ;;; Commentary: | |
| 27 | |
| 28 ;; This file is dumped with XEmacs. | |
| 29 | |
| 30 ;; This code provides the page-oriented movement and selection commands | |
| 31 ;; documented in the XEmacs Reference Manual. | |
| 32 | |
| 33 ;;; Code: | |
| 34 | |
| 35 (defun forward-page (&optional count) | |
| 36 "Move forward to page boundary. With arg, repeat, or go back if negative. | |
| 37 A page boundary is any line whose beginning matches the regexp | |
| 38 `page-delimiter'." | |
| 39 (interactive "_p") ; XEmacs | |
| 40 (or count (setq count 1)) | |
| 41 (while (and (> count 0) (not (eobp))) | |
| 42 ;; In case the page-delimiter matches the null string, | |
| 43 ;; don't find a match without moving. | |
| 44 (if (bolp) (forward-char 1)) | |
| 45 (if (re-search-forward page-delimiter nil t) | |
| 46 nil | |
| 47 (goto-char (point-max))) | |
| 48 (setq count (1- count))) | |
| 49 (while (and (< count 0) (not (bobp))) | |
| 50 ;; In case the page-delimiter matches the null string, | |
| 51 ;; don't find a match without moving. | |
| 52 (and (save-excursion (re-search-backward page-delimiter nil t)) | |
| 53 (= (match-end 0) (point)) | |
| 54 (goto-char (match-beginning 0))) | |
| 446 | 55 (backward-char 1) |
| 209 | 56 (if (re-search-backward page-delimiter nil t) |
| 57 ;; We found one--move to the end of it. | |
| 58 (goto-char (match-end 0)) | |
| 59 ;; We found nothing--go to beg of buffer. | |
| 60 (goto-char (point-min))) | |
| 61 (setq count (1+ count)))) | |
| 62 | |
| 63 (defun backward-page (&optional count) | |
| 64 "Move backward to page boundary. With arg, repeat, or go fwd if negative. | |
| 65 A page boundary is any line whose beginning matches the regexp | |
| 66 `page-delimiter'." | |
| 67 (interactive "_p") ; XEmacs | |
| 68 (or count (setq count 1)) | |
| 69 (forward-page (- count))) | |
| 70 | |
| 71 (defun mark-page (&optional arg) | |
| 72 "Put mark at end of page, point at beginning. | |
| 73 A numeric arg specifies to move forward or backward by that many pages, | |
| 74 thus marking a page other than the one point was originally in." | |
| 75 (interactive "P") | |
| 76 (setq arg (if arg (prefix-numeric-value arg) 0)) | |
| 77 (if (> arg 0) | |
| 78 (forward-page arg) | |
| 79 (if (< arg 0) | |
| 80 (forward-page (1- arg)))) | |
| 81 (forward-page) | |
| 82 (push-mark nil t t) | |
| 83 (forward-page -1)) | |
| 84 | |
| 85 (defun narrow-to-page (&optional arg) | |
| 86 "Make text outside current page invisible. | |
| 87 A numeric arg specifies to move forward or backward by that many pages, | |
| 88 thus showing a page other than the one point was originally in." | |
| 89 (interactive "P") | |
| 90 (setq arg (if arg (prefix-numeric-value arg) 0)) | |
| 91 (save-excursion | |
| 92 (widen) | |
| 93 (if (> arg 0) | |
| 94 (forward-page arg) | |
| 95 (if (< arg 0) | |
| 2510 | 96 (let ((adjust 0) |
| 97 (opoint (point))) | |
| 98 ;; If we are not now at the beginning of a page, | |
| 99 ;; move back one extra time, to get to the start of this page. | |
| 100 (save-excursion | |
| 101 (beginning-of-line) | |
| 102 (or (and (looking-at page-delimiter) | |
| 103 (eq (match-end 0) opoint)) | |
| 104 (setq adjust 1))) | |
| 105 (forward-page (- arg adjust))))) | |
| 209 | 106 ;; Find the end of the page. |
| 2510 | 107 (set-match-data nil) |
| 209 | 108 (forward-page) |
| 109 ;; If we stopped due to end of buffer, stay there. | |
| 110 ;; If we stopped after a page delimiter, put end of restriction | |
| 111 ;; at the beginning of that line. | |
| 2510 | 112 ;; Before checking the match that was found, |
| 113 ;; verify that forward-page actually set the match data. | |
| 114 (if (and (match-beginning 0) | |
| 115 (save-excursion | |
| 116 (goto-char (match-beginning 0)) ; was (beginning-of-line) | |
| 117 (looking-at page-delimiter))) | |
| 209 | 118 (beginning-of-line)) |
| 119 (narrow-to-region (point) | |
| 120 (progn | |
| 121 ;; Find the top of the page. | |
| 122 (forward-page -1) | |
| 123 ;; If we found beginning of buffer, stay there. | |
| 124 ;; If extra text follows page delimiter on same line, | |
| 125 ;; include it. | |
| 126 ;; Otherwise, show text starting with following line. | |
| 127 (if (and (eolp) (not (bobp))) | |
| 128 (forward-line 1)) | |
| 129 (point))))) | |
| 130 (put 'narrow-to-page 'disabled t) | |
| 131 | |
| 132 (defun count-lines-page () | |
| 133 "Report number of lines on current page, and how many are before or after point." | |
| 134 (interactive "_") ; XEmacs | |
| 135 (save-excursion | |
| 136 (let ((opoint (point)) beg end | |
| 137 total before after) | |
| 138 (forward-page) | |
| 139 (beginning-of-line) | |
| 140 (or (looking-at page-delimiter) | |
| 141 (end-of-line)) | |
| 142 (setq end (point)) | |
| 143 (backward-page) | |
| 144 (setq beg (point)) | |
| 145 (setq total (count-lines beg end) | |
| 146 before (count-lines beg opoint) | |
| 147 after (count-lines opoint end)) | |
| 148 (message "Page has %d lines (%d + %d)" total before after)))) | |
| 149 | |
| 150 (defun what-page () | |
| 151 "Print page and line number of point." | |
| 152 (interactive "_") ; XEmacs | |
| 153 (save-restriction | |
| 154 (widen) | |
| 155 (save-excursion | |
| 156 (beginning-of-line) | |
| 157 (let ((count 1) | |
| 158 (opoint (point))) | |
| 159 (goto-char 1) | |
| 160 (while (re-search-forward page-delimiter opoint t) | |
| 161 (setq count (1+ count))) | |
| 162 (message "Page %d, line %d" | |
| 163 count | |
| 164 (1+ (count-lines (point) opoint))))))) | |
| 165 | |
| 166 ;;; Place `provide' at end of file. | |
| 167 (provide 'page) | |
| 168 | |
| 169 ;;; page.el ends here |