-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathdiogenes-perl-interface.elc
117 lines (83 loc) · 16 KB
/
diogenes-perl-interface.elc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
;ELC
;;; Compiled
;;; in Emacs version 29.4
;;; with all optimizations.
(byte-code "\300\301!\210\300\302!\210\300\303!\207" [require cl-lib seq diogenes-lisp-utils] 2)#@77 Switch to easily debug perl scripts generated by `diogenes-perl-interface'.
(defvar diogenes--debug-perl nil (#$ . 180))#@165 Output a script generated by a diognes--*script function in a new buffer.
It can then be edited, saved to file and called directly for better testing.
(fn SCRIPT)
(defalias 'diogenes--debug-perl #[257 "\300\301\302!!\210\211c\210\303 \207" [switch-to-buffer generate-new-buffer "*diogenes-perldebug*" cperl-mode] 4 (#$ . 307)])#@68 Execute the contents of a buffer as a perl program
(fn IN-BUFFER)
(defalias 'diogenes--perl-execute-current-buffer #[257 "r\211q\210\301\302!\303\304\302\305\306\307\310 \311 \312 \257\313\314&\210\315!)\207" [diogenes-perl-executable diogenes--get-fresh-buffer "perl-run" make-process :name :buffer :command "-e" buffer-string diogenes--include-server diogenes--include-cpan :coding utf-8 pop-to-buffer] 13 (#$ . 641) "b"])#@20
(fn &rest LINES)
(defalias 'diogenes--perl-script '(macro . #[128 "\300\301\302\303\304BBBB\305BB\207" [string-join list (format "use v%.2f;" diogenes-perl-min-version) "use strict;" "use warnings;" ("\n")] 7 (#$ . 1077)]))#@66 Source for a perl sub that prints perl data for the LISP reader.
(defconst diogenes--perl-to-lisp-sub "sub perl_to_lisp {\n my $elt = shift;\n my $arr = shift; # lisp arrays\n unless ($elt) {}\n elsif (ref $elt eq 'ARRAY') {\n my $str = join ' ', map { perl_to_lisp($_, $arr) } @$elt;\n if ($arr) { '['. $str . ']' }\n else { '('. $str . ')' }\n }\n elsif (ref $elt eq 'HASH') {\n my $str = join ' ',\n map { ':' . $_ . perl_to_lisp($elt->{$_}, $arr) } sort keys %$elt;\n '(' . $str . ')';\n }\n elsif (ref $elt) {\n die 'No rule for ', ref $elt, 'defined!';\n }\n # elsif ($elt =~ /^\\d+$/) { $elt }\n else { '\"' . $elt . '\"' }\n}" (#$ . 1309))#@66 Perl source that discards all output to STDERR in current scope.
(defconst diogenes--discard-perl-stderr "local *STDERR;\nmy $junk = '';\nopen *STDERR, '>', \\$junk;" (#$ . 2002))#@156 Transform lisp data structures to analogous perl ones.
An ordinary list becomes a arrayref, a plist with keywords at odd
positions an arrayref.
(fn ELT)
(defalias 'diogenes--elt->perl #[257 "\211<\203\n \300\301\"\207\302!\203 \300\301\"\207\303!\203% \304\305\306\307\310!#!\207\304!\207" [diogenes--list->perl t vectorp keywordp prin1-to-string replace-regexp-in-string "-" "_" diogenes--keyword->string] 7 (#$ . 2188)])#@146 Transform a lisp list (or vector) into a perl list/array.
If ref is non-nil, make the list into a hash- or an arrayref.
(fn LST &optional REF)
(defalias 'diogenes--list->perl #[513 "\300!\203\f \301\302\"\262<\204 \303\304\"\210\203/ \305!\203/ \306\203) \307\202* \310\311!\"\207\306\2038 \312\2029 \310\313\314\315#\"\207" [vectorp mapcar identity error "Not a list: %s" diogenes--plist-keyword-keys-p format "{ %s }" "%s" diogenes--plist->perlpairs "[ %s ]" mapconcat diogenes--elt->perl ", "] 8 (#$ . 2626)])#@14
(fn PLIST)
(defalias 'diogenes--plist->perlpairs #[257 "\211\205 \300@!\301\300A@!\302AA!\211\205 \303P\262R\207" [diogenes--elt->perl " => " diogenes--plist->perlpairs ", "] 7 (#$ . 3158)])#@155 Starts and a perl process named diogenes-type.
It is associated with a buffer with the same name, in asterisks.
(fn TYPE CODE &optional FILTER SENTINEL)
(defalias 'diogenes--start-perl #[1026 "\203 \300!\210\302!\303\304\305\306\"\307\310 \311 \312 \313 \257\314\315\316\317\320\321\322\323&\210\324!\207" [diogenes--debug-perl diogenes-perl-executable diogenes--get-fresh-buffer make-process :name format "diogenes-%s" :buffer :command "-e" diogenes--include-server diogenes--include-cpan :coding utf-8 :stderr " *diogenes-warnings*" :noquery t :filter :sentinel pop-to-buffer] 22 (#$ . 3364)])#@56 Returns a fresh buffer for the mode to use.
(fn TYPE)
(defalias 'diogenes--get-fresh-buffer #[257 "\300\301\302\"!\2032 \303\304\211\300\301\305#!\204* \306\301\305#!\262\304\211\262\2031 T\262\202\f \207\306\301\302\"!\207" [get-buffer format "*diogenes-%s*" 1 nil "*diogenes-%s<%d>*" get-buffer-create] 9 (#$ . 3981)])#@54 Returns a fresh buffer for comint to use.
(fn MODE)
(defalias 'diogenes--get-comint-buffer #[257 "\300\301\302\"!\2032 \303\304\211\300\301\305#!\204* \306\301\305#!\262\304\211\262\2031 T\262\202\f \207\306\301\302\"!\207" [get-buffer format "*%s*" 1 nil "*%s<%d>*" get-buffer-create] 9 (#$ . 4322)])#@124 Make a new buffer and connect it to a perl script.
Mode should be a maior mode derived from comint-mode.
(fn MODE SCRIPT)
(defalias 'diogenes--make-comint #[514 "\300\301\302\303!#\304!\305\306\307\310\311 \312 &\210\313!\210 \207" [replace-regexp-in-string "-mode$" "" symbol-name diogenes--get-comint-buffer make-comint-in-buffer "perl" nil "-e" diogenes--include-server diogenes--include-cpan pop-to-buffer] 13 (#$ . 4645)])#@15
(fn SCRIPT)
(defalias 'diogenes--read-info #[257 "\203 \300!\210\302\303\304\305\"r\211q\210\306\307\"\216\310 \311\312\311\313\314 \315 &\316U\204- \317\320!\210\321 *\262!\207" [diogenes--debug-perl diogenes-perl-executable read generate-new-buffer " *temp*" t make-closure #[0 "\301\300!\205 \302\300!\207" [V0 buffer-name kill-buffer] 2] call-process nil (t nil) "-e" diogenes--include-server diogenes--include-cpan 0 error "Perl exited with errors, no data received!" buffer-string] 12 (#$ . 5088)])
(byte-code "\300\301\302\"\303\304\305\306\"\"\210\207" [make-hash-table :test equal defalias diogenes--get-info make-closure #[769 "E\301\300\"\206 \302\303\304!\210\305\"!\303\306!\210\300#\207" [V0 gethash puthash message "Retrieving information from Diogenes..." diogenes--read-info ""] 10 "\n\n(fn SCRIPT &optional OPTIONS1 OPTIONS2)"]] 6)#@39
(fn OPTIONS &optional AUTHOR-REGEX)
(defalias 'diogenes--get-author-list #[513 "\300\301#\207" [diogenes--get-info diogenes--list-authors-script] 6 (#$ . 5967)])#@23
(fn OPTIONS AUTHOR)
(defalias 'diogenes--get-works-list #[514 "\300\301#\207" [diogenes--get-info diogenes--list-works-script] 6 (#$ . 6138)])#@32
(fn OPTIONS AUTHOR-AND-WORK)
(defalias 'diogenes--get-work-labels #[514 "\300\301#\207" [diogenes--get-info diogenes--list-work-labels-script] 6 (#$ . 6290)])
(defalias 'diogenes--get-tlg-categories #[0 "\300\301!\207" [diogenes--get-info diogenes--get-tlg-categories-script] 2])#@24
(fn OPTIONS PATTERN)
(defalias 'diogenes--get-wordlist-matches #[514 "\300\301#\207" [diogenes--get-info diogenes--get-wordlist-matches-script] 6 (#$ . 6579)])
(defalias 'diogenes--get-filter-file #[0 "\300\301!\207" [diogenes--get-info diogenes--get-filter-file-script] 2])#@294 Return a perl script that executes a Diogenes search.
option-plist is an plist that will be converted into a perl hash
accepted by the Diogenes::Search constructor. authors-plist, when supplied,
contains the arguments for the select_authors method.
(fn OPTION-PLIST &optional AUTHORS-PLIST)
(defalias 'diogenes--search-script #[513 "\301\302\303#\210\304\305\"\306\307\310\311\312\304\313\314\n!\"\205\" \304\315\314\n!\"\316\257 \317\320\321#\207" [diogenes-perl-min-version plist-put :chunk-size "inf" format "use v%.2f;" "use strict;" "use warnings;" "use Diogenes::Search;" "use Diogenes::Indexed;" "use utf8;" "my $q = Diogenes::Search->new(%s);" diogenes--list->perl "$q->select_authors(%s);" "$q->do_search" "\n" mapconcat identity] 13 (#$ . 6864)])#@367 Return a perl script that executes an indexed Diogenes search.
option-plist is an plist that will be converted into a perl hash
accepted by the Diogenes::Indexed constructor, wordlist is the list of words that will be searched.
authors-plist, when supplied, contains the arguments for the select_authors method.
(fn OPTION-PLIST WORD-LIST &optional AUTHORS-PLIST)
(defalias 'diogenes--indexed-search-script #[770 "\301\302\303#\210\304\305\"\306\307\310\311\312\304\313\314 !\"\304\315\314 !\"\205) \304\316\314 !\"\317\320\321\322\323\324\325\326\327\330\257\331\332\333#\207" [diogenes-perl-min-version plist-put :chunk-size "inf" format "use v%.2f;" "use strict;" "use warnings;" "use Diogenes::Search;" "use Diogenes::Indexed;" "use utf8;" "my $q = Diogenes::Indexed->new(%s);" diogenes--list->perl "my @words = (%s);" "$q->select_authors(%s);" "my %seen;" "for my $uc ( @words ) {" " $uc =~ tr/a-z/A-Z/;" " next if $seen{$uc};" " $q->{input_raw} = 1;" " my ($ref, @wlist) = $q->read_index( $uc =~ s/[^ A-Z]//gr );" " warn qq{$uc is not in the word-list!\\n} unless exists $ref->{$uc};" " $seen{$_}++ for @wlist;" "}" "$q->do_search( map [$_], @words );" "\n" mapconcat identity] 22 (#$ . 7637)])#@112 Return a perl script that returns a list of all authors in a corpus.
(fn OPTION-PLIST &optional AUTHOR-REGEX)
(defalias 'diogenes--list-authors-script #[513 "\302\303\"\304\305\306 \302\307\310 !\"\302\311\206 \312\"\313\257\314\315\316#\207" [diogenes-perl-min-version diogenes--perl-to-lisp-sub format "use v%.2f;" "use strict;" "use warnings;" "use Diogenes::Browser;" "my $q = Diogenes::Browser->new(%s);" diogenes--list->perl "my %%a = $q->browse_authors(\"%s\");" "" "print perl_to_lisp([ map {[ $a{$_}, $_ ]} sort keys %a ]);" "\n" mapconcat identity] 11 (#$ . 8862)])#@107 Return a perl script that returns a list of all works of an
author in a corpus.
(fn OPTION-PLIST AUTHOR)
(defalias 'diogenes--list-works-script #[514 "\302\303\"\304\305\306 \302\307\310 !\"\302\311\"\312\257\313\314\315#\207" [diogenes-perl-min-version diogenes--perl-to-lisp-sub format "use v%.2f;" "use strict;" "use warnings;" "use Diogenes::Browser;" "my $q = Diogenes::Browser->new(%s);" diogenes--list->perl "my %%w = $q->browse_works(\"%s\");" "print perl_to_lisp([ map {[ \"$w{$_} ($_)\", $_ ]} sort keys %w ]);" "\n" mapconcat identity] 11 (#$ . 9453)])#@111 Return a perl script that returns a list of the defined labels for a work.
(fn OPTION-PLIST AUTHOR-AND-WORK)
(defalias 'diogenes--list-work-labels-script #[514 "\302\303\"\304\305\306 \302\307\310 !\"\302\311\310 !\"\312\257\313\314\315#\207" [diogenes-perl-min-version diogenes--perl-to-lisp-sub format "use v%.2f;" "use strict;" "use warnings;" "use Diogenes::Browser;" "my $q = Diogenes::Browser->new(%s);" diogenes--list->perl "my @l = $q->browse_location(%s);" "print perl_to_lisp(\\@l);" "\n" mapconcat identity] 12 (#$ . 10031)])#@89 Return a perl script that returns a list of all categories in the tlg.
(fn &rest JUNK)
(defalias 'diogenes--get-tlg-categories-script #[128 "\302\303\"\304\305\306 \307\310\311\257\312\313\314#\207" [diogenes-perl-min-version diogenes--perl-to-lisp-sub format "use v%.2f;" "use strict;" "use warnings;" "use Diogenes::Search;" "my $q = Diogenes::Search->new(type => 'tlg');" "my $c = $q->select_authors(get_tlg_categories => 1);" "print perl_to_lisp($c);" "\n" mapconcat identity] 9 (#$ . 10580)])#@101 Return a perl script that returns a corpus matching authors-plist.
(fn OPTION-PLIST AUTHORS-PLIST)
(defalias 'diogenes--define-corpus-script #[514 "\302\303\"\304\305\306 \302\307\310 !\"\302\311\310 !\"\312\313\314\315\316\317\320\321\322\320\323\324\320\257\325\326\327#\207" [diogenes-perl-min-version diogenes--perl-to-lisp-sub format "use v%.2f;" "use strict;" "use warnings;" "use Diogenes::Base;" "my $q = Diogenes::Base->new(%s);" diogenes--list->perl "() = $q->select_authors(%s);" "my %auths = %{ $q->{req_authors} };" "my %wks = %{ $q->{req_auth_wk} };" "if (%wks) {" " $auths{$_} = [ sort keys %{ $wks{$_} } ]" " for keys %wks;" " print perl_to_lisp \\%auths, 1;" "}" "elsif (%auths) {" " print perl_to_lisp $q->{prev_list}, 1;" "else {" " print 'nil';" "\n" mapconcat identity] 22 (#$ . 11089)])#@116 Returns a perl script that prints the path of the file where the user defined
corpora are saved.
(fn &rest JUNK)
(defalias 'diogenes--get-filter-file-script #[128 "\301\302\"\303\304\305\306\257\307\310\311#\207" [diogenes-perl-min-version format "use v%.2f;" "use strict;" "use warnings;" "use Diogenes::Base;" "print '\"', Diogenes::Base->new()->{filter_file}, '\"';" "\n" mapconcat identity] 7 (#$ . 11920)])#@168 Return a perl script that returns a alist of all word that match
PATTERN in a wordlist and the frequency of their occurrence in the corpus.
(fn OPTION-PLIST PATTERN)
(defalias 'diogenes--get-wordlist-matches-script #[514 "\302\303\"\304\305\306\307 \302\310\311\n!\"\302\312 \"\313\314\315\316\317\320\257\321\322\323#\207" [diogenes-perl-min-version diogenes--perl-to-lisp-sub format "use v%.2f;" "use strict;" "use warnings;" "use Diogenes::Search;" "use Diogenes::Indexed;" "my $q = Diogenes::Indexed->new(%s);" diogenes--list->perl "my $pat = \"%s\";" "$pat =~ tr/a-z/A-Z/;" "$pat =~ s/[^ A-Z]//g;" "$q->{input_raw} = 1;" "my ($ref, @wlist) = $q->read_index($pat);" "my @results = map { [$_, $ref->{$_}] } @wlist;" "print perl_to_lisp( \\@results );" "\n" mapconcat identity] 16 (#$ . 12344)])#@94 Return a perl script that opens a work with the Diogenes Browser.
(fn OPTION-PLIST PASSAGE)
(defalias 'diogenes--browser-script #[514 "\301\302\"\303\304\305\301\306\307!\"\301\310\307!\"\311\257\312\313\314#\207" [diogenes-perl-min-version format "use v%.2f;" "use strict;" "use warnings;" "use Diogenes::Browser;" "my $q = Diogenes::Browser->new(%s);" diogenes--list->perl "$q->seek_passage(%s);" "$q->browse_forward();" "\n" mapconcat identity] 11 (#$ . 13154)])#@260 Source code for a perl sub that captures and parses the browser output.
It addes the missing line numbers and prints a LISP list
containing the header as a string an a series of a-lists whose keys are a
lists of the citations and whose values are the lines.
(defconst diogenes--browse-interactively-parse-capture-sub "my $capture = '';\nopen my $fh, '>', \\$capture;\nselect $fh;\nsub parse_capture {\n my $out = '';\n $capture =~ s/([()\"])/\\\\$1/g;\n $capture =~ s/\\0\\n?//g;\n my @parts = split /\\n\\n/, $capture;\n my $header = shift @parts;\n my $body = pop @parts;\n my @header_lines = split /\\n/, $header;\n my $last_header_line = @parts \n ? shift @parts\n : pop @header_lines;\n die \"Too many parts in:\\n $capture\"\n if @parts;\n my @levels = $last_header_line =~ /(\\S+)(?:,|$)/g;\n $out .= qq#(\"$last_header_line\" #;\n $out .= '(';\n $out .= join ' ', map qq#\"$_\"#, @header_lines;\n $out .= ') ';\n for my $line (split /\\n/, $body) {\n my ($label, $text) = $line =~ /^(\\S*)(.*)$/g;\n next unless $text && $text =~ /\\S/;\n $text = substr $text, 14 - length $label;\n if ($label and not $label =~ /^\\D/) {\n @levels = split /\\./, $label \n }\n $out .= qq#((@levels) . \"$text\")#;\n if ( $levels[-1] eq 't' ) { $levels[-1] = 1 }\n else { $levels[-1]++ }\n }\n $out .= qq#)\\n#;\n $capture = '';\n print STDOUT $out;\n STDOUT->eof();\n}\n" (#$ . 13635))#@98 Return a perl script that browses a work form a corpus interactively.
(fn OPTION-PLIST PASSAGE)
(defalias 'diogenes--browse-interactively-script #[514 "\302\303\"\304\305\306\307 \310\302\311 @\nA@#\302\312\313\f!\"\302\314\313\f!\"\315\316\317\320\321\322\323\324\325\326\327\330\331\332\327\330\333\257\334\335\336#\207" [diogenes-perl-min-version diogenes--browse-interactively-parse-capture-sub format "use v%.2f;" "use strict;" "use warnings;" "use Diogenes::Browser;" "STDOUT->autoflush(1);" "my ($beg, $end);" "my ($author, $work) = ( \"%s\", \"%s\" );" "my $b = Diogenes::Browser::Stateless->new(%s);" diogenes--list->perl "($beg, $end) = $b->seek_passage(%s);" "(undef, $end) = $b->browse_forward( $beg, $end, $author, $work );" "parse_capture;" "# When type is `phi', read_phi_biblio resets $/, so we have to correct it" "$/ = \"\\n\";" "while (<STDIN>) {" " chomp;" " if (s/^(\\d+)//) { $b->{browse_lines} = $1 - 1 }" " if (/^q$/) { last }" " elsif (/^[nf]$/) {" " (undef, $end) = $b->browse_forward( $beg, $end, $author, $work );" " parse_capture;" " }" " elsif (/^[pb]$/) {" " ($beg, undef) = $b->browse_backward( $beg, $end, $author, $work );" "}" "\n" mapconcat identity] 29 (#$ . 15101)])
(provide 'diogenes-perl-interface)