Mercurial > hg > xemacs-beta
annotate src/src-headers @ 5518:3cc7470ea71c
gnuclient: if TMPDIR was set and connect failed, try again with /tmp
2011-06-03 Aidan Kehoe <kehoea@parhasard.net>
* gnuslib.c (connect_to_unix_server):
Retry with /tmp as a directory in which to search for Unix sockets
if an attempt to connect with some other directory failed (which
may be because gnuclient and gnuserv don't share an environment
value for TMPDIR, or because gnuserv was compiled with USE_TMPDIR
turned off).
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Fri, 03 Jun 2011 18:40:57 +0100 |
| 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 } |