completion.pl (5842B)
1 #!/usr/bin/env perl 2 #*************************************************************************** 3 # _ _ ____ _ 4 # Project ___| | | | _ \| | 5 # / __| | | | |_) | | 6 # | (__| |_| | _ <| |___ 7 # \___|\___/|_| \_\_____| 8 # 9 # Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al. 10 # 11 # This software is licensed as described in the file COPYING, which 12 # you should have received as part of this distribution. The terms 13 # are also available at https://curl.se/docs/copyright.html. 14 # 15 # You may opt to use, copy, modify, merge, publish, distribute and/or sell 16 # copies of the Software, and permit persons to whom the Software is 17 # furnished to do so, under the terms of the COPYING file. 18 # 19 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY 20 # KIND, either express or implied. 21 # 22 # SPDX-License-Identifier: curl 23 # 24 ########################################################################### 25 26 use strict; 27 use warnings; 28 use Getopt::Long(); 29 use Pod::Usage(); 30 31 my $opts_dir = '../docs/cmdline-opts'; 32 my $shell = 'zsh'; 33 my $help = 0; 34 Getopt::Long::GetOptions( 35 'opts-dir=s' => \$opts_dir, 36 'shell=s' => \$shell, 37 'help' => \$help, 38 ) or Pod::Usage::pod2usage(); 39 Pod::Usage::pod2usage() if $help; 40 41 my @opts = parse_main_opts($opts_dir); 42 43 if($shell eq 'fish') { 44 print "# curl fish completion\n\n"; 45 print "# Complete file paths after @\n"; 46 print q(complete -c curl -n 'string match -qr "^@" -- (commandline -ct)' -k -xa "(printf '%s\n' -- @(__fish_complete_suffix --complete=(commandline -ct | string replace -r '^@' '') ''))"); 47 print "\n\n"; 48 print qq{$_ \n} foreach (@opts); 49 } elsif($shell eq 'zsh') { 50 my $opts_str; 51 52 $opts_str .= qq{ $_ \\\n} foreach (@opts); 53 chomp $opts_str; 54 55 my $tmpl = <<"EOS"; 56 #compdef curl 57 58 # curl zsh completion 59 60 local curcontext="\$curcontext" state state_descr line 61 typeset -A opt_args 62 63 local rc=1 64 65 _arguments -C -S \\ 66 $opts_str 67 '*:URL:_urls' && rc=0 68 69 return rc 70 EOS 71 72 print $tmpl; 73 } else { 74 die("Unsupported shell: $shell"); 75 } 76 77 sub parse_main_opts { 78 my ($opts_dir) = @_; 79 80 my (@files, @list); 81 my ($dir_handle, $file_content); 82 83 opendir($dir_handle, $opts_dir) || die "Unable to open dir: $opts_dir due to error: $!"; 84 @files = readdir($dir_handle); 85 closedir($dir_handle) || die "Unable to close handle on dir: $opts_dir due to error: $!"; 86 87 # We want regular files that end with .md and don't start with an underscore 88 # Edge case: MANPAGE.md doesn't start with an underscore but also isn't documentation for an option 89 @files = grep { $_ =~ /\.md$/i && !/^_/ && -f "$opts_dir/$_" && $_ ne "MANPAGE.md" } @files; 90 91 for my $file (@files) { 92 open(my $doc_handle, '<', "$opts_dir/$file") || die "Unable to open file: $file due to error: $!"; 93 $file_content = join('', <$doc_handle>); 94 close($doc_handle) || die "Unable to close file: $file due to error: $!"; 95 96 # Extract the curldown header section demarcated by --- 97 $file_content =~ /^---\s*\n(.*?)\n---\s*\n/s || die "Unable to parse file $file"; 98 99 $file_content = $1; 100 my ($short, $long, $arg, $desc); 101 102 if($file_content =~ /^Short:\s+(.*)\s*$/im) {$short = "-$1";} 103 if($file_content =~ /^Long:\s+(.*)\s*$/im) {$long = "--$1";} 104 if($file_content =~ /^Arg:\s+(.*)\s*$/im) {$arg = $1;} 105 if($file_content =~ /^Help:\s+(.*)\s*$/im) {$desc = $1;} 106 107 $arg =~ s/\:/\\\:/g if defined $arg; 108 $desc =~ s/'/'\\''/g if defined $desc; 109 $desc =~ s/\[/\\\[/g if defined $desc; 110 $desc =~ s/\]/\\\]/g if defined $desc; 111 $desc =~ s/\:/\\\:/g if defined $desc; 112 113 my $option = ''; 114 115 if($shell eq 'fish') { 116 $option .= "complete --command curl"; 117 $option .= " --short-option '" . strip_dash(trim($short)) . "'" 118 if defined $short; 119 $option .= " --long-option '" . strip_dash(trim($long)) . "'" 120 if defined $long; 121 $option .= " --description '" . strip_dash(trim($desc)) . "'" 122 if defined $desc; 123 } elsif($shell eq 'zsh') { 124 $option .= '{' . trim($short) . ',' if defined $short; 125 $option .= trim($long) if defined $long; 126 $option .= '}' if defined $short; 127 $option .= '\'[' . trim($desc) . ']\'' if defined $desc; 128 129 if(defined $arg) { 130 $option .= ":'$arg'"; 131 if($arg =~ /<file ?(name)?>|<path>/) { 132 $option .= ':_files'; 133 } elsif($arg =~ /<dir>/) { 134 $option .= ":'_path_files -/'"; 135 } elsif($arg =~ /<url>/i) { 136 $option .= ':_urls'; 137 } elsif($long =~ /ftp/ && $arg =~ /<method>/) { 138 $option .= ":'(multicwd nocwd singlecwd)'"; 139 } elsif($arg =~ /<method>/) { 140 $option .= ":'(DELETE GET HEAD POST PUT)'"; 141 } 142 } 143 } 144 145 push(@list, $option); 146 } 147 148 # Sort longest first, because zsh won't complete an option listed 149 # after one that's a prefix of it. When length is equal, fall back 150 # to stringwise cmp. 151 @list = sort { 152 $a =~ /([^=]*)/; my $ma = $1; 153 $b =~ /([^=]*)/; my $mb = $1; 154 155 length($mb) <=> length($ma) || $ma cmp $mb 156 } @list; 157 158 return @list; 159 } 160 161 sub trim { my $s = shift; $s =~ s/^\s+|\s+$//g; return $s }; 162 sub strip_dash { my $s = shift; $s =~ s/^-+//g; return $s }; 163 164 __END__ 165 166 =head1 NAME 167 168 completion.pl - Generates tab-completion files for various shells 169 170 =head1 SYNOPSIS 171 172 completion.pl [options...] 173 174 --opts-dir path to cmdline-opts directory 175 --shell zsh/fish 176 --help prints this help 177 178 =cut