Mercurial > hg > xemacs-beta
annotate src/src-headers @ 5773:94a6b8fbd56e
Use a face, show more context around open parenthesis, #'blink-matching-open
lisp/ChangeLog addition:
2013-12-17 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (blink-matching-open):
When showing the opening parenthesis in the minibiffer, use the
isearch face for it, in case there are multiple parentheses in the
text shown.
When writing moderately involved macros, it's often not enough
just to show the backquote context before the parenthesis
(e.g. @,.`). Skip over that when searching for useful context in
the same way we skip over space and tab.
* simple.el (message):
* simple.el (lmessage):
If there are no ARGS, don't call #'format. This allows extent
information to be passed through to the minibuffer.
It's probably better still to update #'format to preserve extent
info.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Tue, 17 Dec 2013 20:49:52 +0200 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 428 | 1 : #-*- Perl -*- |
| 2 # Copyright (C) 1998 Free Software Foundation, Inc. | |
| 3 | |
| 4 # This file is part of XEmacs. | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
5 # |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
6 # XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 7 # under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
8 # 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:
428
diff
changeset
|
9 # option) any later version. |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
10 # |
| 428 | 11 # XEmacs is distributed in the hope that it will be useful, but WITHOUT |
| 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 13 # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 14 # for more details. | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
15 # |
| 428 | 16 # 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:
428
diff
changeset
|
17 # along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 18 |
| 19 # Author: Martin Buchholz | |
| 20 eval 'exec perl -w -S $0 ${1+"$@"}' | |
| 21 if 0; | |
| 22 | |
| 23 use strict; | |
| 24 my ($myName, $srcdir); | |
| 25 | |
| 26 ($myName = $0) =~ s@.*/@@; my $usage =" | |
| 27 Usage: $myName | |
| 28 | |
| 29 Generates header file fragments from the Emacs sources | |
| 30 and writes them to stdout.\n"; | |
| 31 | |
| 32 die $usage if @ARGV; | |
| 33 | |
| 34 ($srcdir = $0) =~ s@[^/]+$@@; | |
| 35 chdir $srcdir or die "$srcdir: $!"; | |
| 36 | |
| 37 # Find include dependencies | |
| 38 my (%exists, %uses); | |
| 39 opendir SRCDIR, "." or die "$srcdir: $!"; | |
| 40 for (grep (/\.[ch]$/, readdir (SRCDIR))) { $exists{$_} = 1; } | |
| 41 closedir SRCDIR; | |
| 42 { | |
| 43 my %generated_header; | |
| 44 for (qw (config.h sheap-adjust.h paths.h Emacs.ad.h)) { | |
| 45 $generated_header{$_} = 1; | |
| 46 } | |
| 47 | |
| 48 for my $file (keys %exists) { | |
| 49 open (FILE, $file) or die "$file: $!"; | |
| 50 undef $/; $_ = <FILE>; | |
| 51 RemoveComments ($_); | |
| 52 s/[ \t]+//g; | |
| 53 for (/^\#include([^\n]+)/gmo) { | |
| 54 if (m@^\"([A-Za-z0-9_-]+\.h)\"@) { | |
| 55 $uses{$file}{$1} = 1 if exists $exists{$1}; | |
| 56 } elsif (m@<([A-Za-z0-9_-]+\.h)>@) { | |
| 57 $uses{$file}{$1} = 1 if exists $generated_header{$1}; | |
| 58 } elsif (m@\"../lwlib/([A-Za-z0-9_-]+\.h)\"@) { | |
| 59 $uses{$file}{"\$(LWLIB_SRCDIR)/lwlib.h"} = 1; | |
| 60 } | |
| 61 } | |
| 62 } | |
| 63 | |
| 64 # Make transitive closure of %uses | |
| 65 while (1) { | |
| 66 my $changedP = 0; | |
| 67 for my $x (keys %uses) { | |
| 68 for my $y (keys %{$uses{$x}}) { | |
| 69 for my $z (keys %{$uses{$y}}) { | |
| 70 if (! exists $uses{$x}{$z}) { | |
| 71 $uses{$x}{$z} = 1; | |
| 72 $changedP = 1; | |
| 73 } | |
| 74 } | |
| 75 } | |
| 76 } | |
| 77 last if !$changedP; | |
| 78 } | |
| 79 } # End of finding include dependencies | |
| 80 | |
| 81 my (%used, %maxargs); | |
| 82 my $minargs = '(?:[0-8])'; | |
| 83 my $maxargs = '(?:[0-8]|MANY|UNEVALLED)'; | |
| 84 my $doc = "(?:0|STR)"; | |
| 85 my $fun = '(?:\\bF[a-z0-9_]+X?\\b)'; | |
| 86 my $defun = "^DEFUN\\s*\\(\\s+STR\\s+($fun)\\s+$minargs\\s+($maxargs)\\s+$doc\\s+\\("; | |
| 87 my $var = '(?:\\b(?:Q[KS]?[a-z0-9_]+D?|V(?:[a-z0-9_]+)|Q_TT[A-Z]+)\\b)'; | |
| 88 my $pat = "(?:$var|$fun)"; | |
| 89 my %automagic; | |
| 90 my (%decl_file, %defn_file); | |
| 91 | |
| 92 for my $file (keys %exists) { | |
| 93 open (FILE, $file) or die "$file: $!"; | |
| 94 undef $/; $_ = <FILE>; | |
| 95 RemoveComments($_); | |
| 96 RemoveStrings ($_); | |
| 97 s/,/ /gmo; | |
| 98 s/^\s*EXFUN[^\n]+//gmo; | |
| 99 | |
| 100 # Now search for DECLARE_LRECORD to find types for predicates | |
| 101 for my $sym (/^DECLARE_LRECORD\s*\(\s*([a-z_]+)\s+struct /gmo) { | |
| 102 $automagic{"Q${sym}p"} = 1; | |
| 103 } | |
| 104 | |
| 105 if ($file =~ /\.c$/) { | |
| 106 my @match = (/$defun/gmo); | |
| 107 while (my $fun = shift @match) { | |
| 108 $defn_file{$fun} = $file; | |
| 109 $maxargs{$fun} = shift @match; | |
| 110 } | |
| 111 | |
| 112 # Now do Lisp_Object variables | |
| 113 for my $defs (/^\s*Lisp_Object\s+((?:$var\s*)+)\s*;/gmo) { | |
| 114 for my $var (split (' ',$defs)) { | |
| 115 $defn_file{$var} = $file; | |
| 116 } | |
| 117 } | |
| 118 } | |
| 119 | |
| 120 # Remove declarations of Lisp_Objects | |
| 121 s/^extern\s+Lisp_Object\s+(?:$var\s*)+\s*;//gmo; | |
| 122 | |
| 123 # Remove declarations of functions | |
| 124 s/^Lisp_Object $fun//; | |
| 125 | |
| 126 # Find all uses of symbols | |
| 127 for (/($pat)/gmo) { $used{$_}{$file} = 1; } | |
| 128 } | |
| 129 | |
| 130 my %candidates; | |
| 131 for my $file (keys %exists) { | |
| 132 @{$candidates{$file}} = (); | |
| 133 my $header1 = $file; $header1 =~ s/\.c$/.h/; | |
| 134 my $header2 = $header1; $header2 =~ s/-\w+\././; | |
| 135 push @{$candidates{$file}}, $header1 if exists $exists{$header1}; | |
| 136 push @{$candidates{$file}}, $header2 if exists $exists{$header2} && | |
| 137 $header1 ne $header2; | |
| 138 } | |
| 139 | |
| 140 SYM: for my $sym (keys %used) { | |
| 141 next SYM unless my $defn_file = $defn_file{$sym}; | |
| 142 my @users = keys %{$used{$sym}}; | |
| 143 if (@users == 1) { | |
| 144 die "$sym\n" unless $defn_file eq $users[0]; | |
| 145 next SYM; | |
| 146 } | |
| 147 for my $candidate (@{$candidates{$defn_file}}) { | |
| 148 if (!grep (!exists $uses{$_}{$candidate}, @users)) { | |
| 149 $decl_file{$sym} = $candidate; | |
| 150 next SYM; | |
| 151 } | |
| 152 } | |
| 153 $decl_file{$sym} = 'lisp.h'; | |
| 154 } | |
| 155 | |
| 156 # Print global Lisp_Objects | |
| 157 { | |
| 158 my $line; | |
| 159 sub flushvars { | |
| 160 if (defined $line) { | |
| 161 print "extern Lisp_Object $line;\n"; | |
| 162 undef $line; | |
| 163 } | |
| 164 } | |
| 165 | |
| 166 sub printvar { | |
| 167 my $var = shift; | |
| 168 if (!defined $line) { $line = $var; return; } | |
| 169 if ($var =~ /^Vcharset_/) { | |
| 170 flushvars (); | |
| 171 $line = $var; | |
| 172 flushvars (); | |
| 173 return; | |
| 174 } | |
| 175 if (length "$line, $var" > 59) { | |
| 176 flushvars (); $line = $var; return; | |
| 177 } | |
| 178 $line = "$line, $var"; | |
| 179 } | |
| 180 END { flushvars (); } | |
| 181 } | |
| 182 | |
| 183 delete @decl_file{ keys %automagic, qw(Qzero Qnull_pointer)}; | |
| 184 | |
| 185 # Print Lisp_Object var declarations | |
| 186 for my $file (keys %exists) { | |
| 187 | |
| 188 # Print EXFUNs | |
| 189 if (my @funs = grep ($decl_file{$_} eq $file && exists $maxargs{$_}, | |
| 190 keys %decl_file)) { | |
| 191 print "\n\n$file:\n\n"; | |
| 192 for $fun (sort @funs) { | |
| 193 print "EXFUN ($fun, $maxargs{$fun});\n"; | |
| 194 } | |
| 195 print "\n"; | |
| 196 } | |
| 197 | |
| 198 if (my @vars = grep ($decl_file{$_} eq $file && /^[QV]/, keys %decl_file)) { | |
| 199 print "\n\n$file:\n\n"; | |
| 200 for $var (sort @vars) { | |
| 201 printvar ($var); | |
| 202 } | |
| 203 flushvars (); | |
| 204 print "\n\n"; | |
| 205 } | |
| 206 } | |
| 207 | |
| 208 #for my $var (sort grep (keys %{$used{$_}} > 1 , keys %defn_file)) { | |
| 209 # printvar ($var); | |
| 210 #} | |
| 211 | |
| 212 sub RemoveComments { | |
| 213 $_[0] =~ | |
| 214 s{ ( | |
| 215 [^\"\'/]+ | | |
| 216 (?:\"[^\"\\]*(?:\\.[^\"\\]*)*\" [^\"\'/]*)+ | | |
| 217 (?:\'[^\'\\]*(?:\\.[^\'\\]*)*\' [^\"\'/]*)+ | |
| 218 ) | |
| 219 | / (?: | |
| 220 \*[^*]*\*+(?:[^/*][^*]*\*+)*/ | |
| 221 | | |
| 222 /[^\n]* | |
| 223 ) | |
| 224 }{defined $1 ? $1 : ""}gsxeo; | |
| 225 } | |
| 226 | |
| 227 sub RemoveStrings { | |
| 228 $_[0] =~ | |
| 229 s{ ( | |
| 230 (?:\"[^\"\\]*(?:\\.[^\"\\]*)*\") | | |
| 231 (?:\'[^\'\\]*(?:\\.[^\'\\]*)*\') | |
| 232 ) | |
| 233 }{ STR }gxo; | |
| 234 } |