12486: new completion caching layer

ChangeLog

@@ -1,3 +1,10 @@
+2000-08-02  Adam Spiers  <adam@spiers.net>
+
+	* 12486: Completion/Base/{.distfiles,_cache_invalid,_retrieve_cache,
+	_store_cache}, Completion/Builtins/_zstyle, Completion/Linux/_rpm,
+	Completion/User/_perl_modules, Doc/Zsh/compsys.yo: new completion
+	caching layer
+
 2000-08-02  Sven Wischnowsky  <wischnow@zsh.org>
 
 	* 12483: Completion/Base/_arguments, Completion/Core/_complete,

Completion/Base/.distfiles

@@ -1,7 +1,7 @@
 DISTFILES_SRC='
     .distfiles 
-    _arg_compile _arguments _brace_parameter _combination
+    _arg_compile _arguments _brace_parameter _cache_invalid _combination
     _command_names _condition _default _describe _equal _first _in_vared
-    _jobs _math _parameter _precommand _redirect _regex_arguments _subscript
+    _jobs _math _parameter _precommand _redirect _regex_arguments
-    _tilde _value _values
+    _retrieve_cache _store_cache _subscript _tilde _value _values
 '

Completion/Base/_cache_invalid

@@ -0,0 +1,21 @@
+#autoload
+#
+# Function to decide whether a completions cache needs rebuilding
+
+local _cache_ident _cache_dir _cache_path _cache_policy
+_cache_ident="$1"
+
+# If the cache is disabled, we never want to rebuild it, so pretend
+# it's valid.
+zstyle -t ":completion:${curcontext}:" use-cache || return 1
+
+zstyle -s ":completion:${curcontext}:" cache-path _cache_dir
+: ${_cache_dir:=${ZDOTDIR:-$HOME}/.zcompcache}
+_cache_path="$_cache_dir/$_cache_ident"
+
+# See whether the caching policy says that the cache needs rebuilding
+# (the policy will return 0 if it does).
+zstyle -s ":completion:${curcontext}:" cache-policy _cache_policy
+[[ -n "$_cache_policy" ]] && "$_cache_policy" "$_cache_path" && return 0
+
+return 1

Completion/Base/_retrieve_cache

@@ -0,0 +1,31 @@
+#autoload
+#
+# Retrieval component of completions caching layer
+
+local _cache_ident _cache_dir _cache_path _cache_policy
+_cache_ident="$1"
+
+if zstyle -t ":completion:${curcontext}:" use-cache; then
+  # Decide which directory to retrieve cache from, and ensure it exists
+  zstyle -s ":completion:${curcontext}:" cache-path _cache_dir
+  : ${_cache_dir:=${ZDOTDIR:-HOME}/.zcompcache}
+  if [[ ! -d "$_cache_dir" ]]; then
+    [[ -e "$_cache_dir" ]] &&
+      _message "cache-dir ($_cache_dir) isn't a directory\!"
+    return 1
+  fi
+
+  _cache_path="$_cache_dir/$_cache_ident"
+
+  if [[ -e "$_cache_path" ]]; then
+    _cache_invalid "$_cache_ident" && return 1
+
+    . "$_cache_path"
+    return 0
+  else
+    return 1
+  fi
+else
+  return 1
+fi
+

Completion/Base/_store_cache

@@ -0,0 +1,36 @@
+#autoload
+#
+# Storage component of completions caching layer
+
+local _cache_ident
+_cache_ident="$1"
+
+if zstyle -t ":completion:${curcontext}:" use-cache; then
+  # Decide which directory to cache to, and ensure it exists
+  zstyle -s ":completion:${curcontext}:" cache-path _cache_dir
+  : ${_cache_dir:=${ZDOTDIR:-$HOME}/.zcompcache}
+  if [[ ! -d "$_cache_dir" ]]; then
+    if [[ -e "$_cache_dir" ]]; then
+      _message "cache-dir style points to a non-directory\!"
+    else
+      mkdir -p "$_cache_dir"
+      if [[ ! -d "$_cache_dir" ]]; then
+        _message "Couldn't create cache-dir $_cache_dir"
+        return 1
+      fi
+    fi
+  fi
+
+  shift
+  for var; do
+    case ${(Pt)var} in
+    (*readonly*) ;;
+    (*(association|array)*) print -r "$var=( ${(kv@Pqq)^^var} )";;
+    (*)                     print -r "$var=${(Pqq)^^var}";;
+    esac
+  done >! "$_cache_dir/$_cache_ident"
+else
+  return 1
+fi
+
+return 0

Completion/Builtins/_zstyle

@@ -15,6 +15,7 @@ styles=(
   assign-list            c:
   auto-description	 c:
   break-keys             c:
+  cache-path		 'c:_wanted directories expl directory _path_files -/'
   command                c:command
   completer		 c:completer
   completions		 c:bool
@@ -80,6 +81,7 @@ styles=(
   suffix		 c:bool
   tag-order		 c:tag
   try-to-use-pminst	 c:bool
+  use-cache		 c:bool
   use-compctl		 c:urgh
   users			 c:_users
   users-hosts		 c:user-host

Completion/Linux/_rpm

@@ -41,213 +41,238 @@
 
 # Used by `_arguments', made local here.
 
-local curcontext="$curcontext" state lstate line nm="$compstate[nmatches]"
+_rpm () {
-typeset -A opt_args
+  local curcontext="$curcontext" state lstate line nm="$compstate[nmatches]"
-
+  typeset -A opt_args
-state=''
+  
-
-local ret=1
-local -a tmp expl commonopts packageopts
-commonopts=(
-  '*-v[verbose mode]'
-  '--rcfile:resource file:_files'
-  '--ftpproxy:FTP proxy server:_hosts'
-  '--ftpport:FTP port number:'
-  '--httpproxy:HTTP proxy server:_hosts'
-  '--httpport:HTTP port number:'
-)
-packageopts=(
-  '-a[query all packages]'
-  '-p+[query uninstalled package file]:*:RPM package file:->package_file'
-  '-f[specify file to query owner of]:file:_files'
-  '--triggeredby:RPM package:->package'
-  '--whatprovides:RPM capability:->capability'
-  '--whatrequires:RPM capability:->capability'
-)
-pathopts=(
-  '--root:RPM root directory:_files -/'
-  '--dbpath:RPM database path:_files -/'
-)
-
-# Do simple completions or get the first state.
-
-_arguments -C -s \
-  '--help[print help message]' \
-  '--version[print version number]' \
-  "${commonopts[@]}" \
-  '-q+[query mode]:*:query:->query' \
-  --{querytags,initdb,showrc} \
-  '--pipe:pipe command:_command_names -e' \
-  -{V,y}'[verify mode]:*:verify:->verify' \
-  '--verify[verify mode]:*:verify:->verify' \
-  '--setperms[set file permissions]:*:package:->setattrs' \
-  '--setugids[set file owner/group]:*:package:->setattrs' \
-  '(--install)-i+[install mode]:*:install:->install' \
-  '(-i)--install:*:install:->install' \
-  '(--upgrade)-U+[upgrade mode]:*:upgrade:->upgrade' \
-  '(-U)--upgrade:*:upgrade:->upgrade' \
-  '(--freshen)-F+[freshen mode]:*:upgrade:->upgrade' \
-  '(-F)--freshen:*:upgrade:->upgrade' \
-  '(--erase)-e+[uninstall mode]:*:uninstall:->uninstall' \
-  '(-e)--erase:*:uninstall:->uninstall' \
-  '-b+[build mode (spec file)]:build stage:((p\:execute\ \%prep\ stage l\:do\ a\ list\ check c\:execute\ build\ stage i\:execute\ install\ stage b\:build\ a\ binary\ package a\:build\ binary\ and\ source\ packages)):*:build:->build_b' \
-  '(-b)-t+[build mode (tar file)]:build stage:((p\:execute\ \%prep\ stage l\:do\ a\ list\ check c\:execute\ build\ stage i\:execute\ install\ stage b\:build\ a\ binary\ package a\:build\ binary\ and\ source\ packages)):*:build:->build_t' \
-  --{resign,addsign}':*:RPM package:->package_file' \
-  '--rmsource:*:spec file:->spec_file' \
-  --{rebuild,recompile}':*:Src RPM files:->package_src' \
-  '(--checksig)-K+[signature check mode]:*:sigcheck:->sigcheck' \
-  '(-K)--checksig:*:sigcheck:->sigcheck' \
-  '--rebuilddb:*:rebuild:->rebuild' && ret=0
-
-# As long as we have a state name...
-
-while [[ -n "$state" ]]; do
-
-  # First try to call a user-defined function.
-
-  _funcall ret _rpm_$state && return ret
-
-  # Copy the state and reset `state', to simplify the test above.
-
-  lstate="$state"
   state=''
-  tmp=()
+  
+  local ret=1
+  local -a tmp expl commonopts packageopts
+  commonopts=(
+    '*-v[verbose mode]'
+    '--rcfile:resource file:_files'
+    '--ftpproxy:FTP proxy server:_hosts'
+    '--ftpport:FTP port number:'
+    '--httpproxy:HTTP proxy server:_hosts'
+    '--httpport:HTTP port number:'
+  )
+  packageopts=(
+    '-a[query all packages]'
+    '-p+[query uninstalled package file]:*:RPM package file:->package_file'
+    '-f[specify file to query owner of]:file:_files'
+    '--triggeredby:RPM package:->package'
+    '--whatprovides:RPM capability:->capability'
+    '--whatrequires:RPM capability:->capability'
+  )
+  pathopts=(
+    '--root:RPM root directory:_files -/'
+    '--dbpath:RPM database path:_files -/'
+  )
+  
+  # Do simple completions or get the first state.
+  
+  _arguments -C -s \
+    '--help[print help message]' \
+    '--version[print version number]' \
+    "${commonopts[@]}" \
+    '-q+[query mode]:*:query:->query' \
+    --{querytags,initdb,showrc} \
+    '--pipe:pipe command:_command_names -e' \
+    -{V,y}'[verify mode]:*:verify:->verify' \
+    '--verify[verify mode]:*:verify:->verify' \
+    '--setperms[set file permissions]:*:package:->setattrs' \
+    '--setugids[set file owner/group]:*:package:->setattrs' \
+    '(--install)-i+[install mode]:*:install:->install' \
+    '(-i)--install:*:install:->install' \
+    '(--upgrade)-U+[upgrade mode]:*:upgrade:->upgrade' \
+    '(-U)--upgrade:*:upgrade:->upgrade' \
+    '(--freshen)-F+[freshen mode]:*:upgrade:->upgrade' \
+    '(-F)--freshen:*:upgrade:->upgrade' \
+    '(--erase)-e+[uninstall mode]:*:uninstall:->uninstall' \
+    '(-e)--erase:*:uninstall:->uninstall' \
+    '-b+[build mode (spec file)]:build stage:((p\:execute\ \%prep\ stage l\:do\ a\ list\ check c\:execute\ build\ stage i\:execute\ install\ stage b\:build\ a\ binary\ package a\:build\ binary\ and\ source\ packages)):*:build:->build_b' \
+    '(-b)-t+[build mode (tar file)]:build stage:((p\:execute\ \%prep\ stage l\:do\ a\ list\ check c\:execute\ build\ stage i\:execute\ install\ stage b\:build\ a\ binary\ package a\:build\ binary\ and\ source\ packages)):*:build:->build_t' \
+    --{resign,addsign}':*:RPM package:->package_file' \
+    '--rmsource:*:spec file:->spec_file' \
+    --{rebuild,recompile}':*:Src RPM files:->package_src' \
+    '(--checksig)-K+[signature check mode]:*:sigcheck:->sigcheck' \
+    '(-K)--checksig:*:sigcheck:->sigcheck' \
+    '--rebuilddb:*:rebuild:->rebuild' && ret=0
+  
+  # As long as we have a state name...
+  
+  while [[ -n "$state" ]]; do
+  
+    # First try to call a user-defined function.
+  
+    _funcall ret _rpm_$state && return ret
+  
+    # Copy the state and reset `state', to simplify the test above.
+  
+    lstate="$state"
+    state=''
+    tmp=()
+  
+    # Dispatch...
+  
+    case "$lstate" in
+    query)
+      # --dump requires on of -{l,c,d}
+      # --triggers requires --script
+      _arguments -s \
+        -q "${commonopts[@]}" "${packageopts[@]}" "${pathopts[@]}" \
+        '--queryformat:RPM query format:->tags' \
+        '-i[display package information]' \
+        '--changelog[display change log]' \
+        '-l[display package file list]' \
+        '-s[show file states]' \
+        '-d[documentation files only]' \
+        '-c[configuration files only]' \
+        '--dump[show all information]' \
+        --provides \
+        -{R,-requires}'[list dependencies]' \
+        '--scripts[show (un)install scripts]' \
+        '--triggers[show trigger scripts]' \
+        '*:RPM package:->package_or_file' && ret=0
+      ;;
+    setattrs)
+      _arguments -s --set{perm,ugids} "${packageopts[@]}" && ret = 0
+      ;;
+    verify)
+      _arguments -s \
+        '(-y --verify)-V' '(-V --verify)-y' '(-y -V)--verify' \
+        "${commonopts[@]}" "${pathopts[@]}" \
+        --no{deps,md5,files} \
+        '*:RPM package:->package' && ret=0
+      ;;
+    upgrade)
+      tmp=( '(--upgrade)-U' '(-U)--upgrade' '(--force)--oldpackage' )
+      ;&
+    install)
+      (( $#tmp )) || tmp=( '(--install)-i' '(-i)--install' )
+      _arguments -s "$tmp[@]" \
+        "${commonopts[@]}" "${pathopts[@]}" \
+        '--excludepath:exclude files in following path:_files -/' \
+        '--relocate:relocate:->relocate' \
+        '--prefix:package prefix directory:_files -/' \
+        '(-h)--hash' '(--hash)-h' \
+        '(--replacepkgs --replacefiles --oldpackage)--force' \
+        '(--force)--'{replacefiles,replacepkgs} \
+        --{badreloc,excludedocs,allfiles,ignorearch,ignoreos,includedocs,justdb,nodeps,noorder,noscripts,notriggers,percent,test} \
+        '*:pkg file:->package_file' && ret=0
+      ;;
+    uninstall)
+      _arguments -s \
+        '(-e)--erase' '(--erase)-e' \
+        "${commonopts[@]}" "${pathopts[@]}" \
+        --{allmatches,justdb,nodeps,noorder,noscripts,notriggers} \
+        '*:RPM package:->package' && ret=0
+      ;;
+    build_b)
+      tmp=( '*:spec file:_files -g \*.spec' )
+      ;&
+    build_t)
+      (( $#tmp )) || tmp=( '*:tar file:_files -g \*.\(\#i\)tar\(.\*\|\)' )
+  
+      _arguments -s \
+        "${commonopts[@]}" "${pathopts[@]}" \
+        --{short-circuit,clean,rmsource,sign,test} \
+        '--target:specify a build target:->target'\
+        '--buildroot:build root directory:_files -/' \
+        '--buildarch:architecture for which to build:->target' \
+        '--buildos:ositecture for which to build:' \
+        '--timecheck:time check (seconds):' "$tmp[1]" && ret=0
+      ;;
+    sigcheck)
+      _arguments -s \
+        '(-K)--checksig' '(--checksig)-K' \
+        "${commonopts[@]}" \
+        --no{pgp,md5} \
+        '*:RPM package file:->package_file' && ret=0
+      ;;
+    rebuild)
+      _arguments -s \
+        "${commonopts[@]}" "${pathopts[@]}" \
+        '*:RPM source package file:->package_file' && ret=0
+      ;;
+    target)
+      _wanted target expl 'Target platforms' \
+          compadd $(_call target rpm --showrc 2> /dev/null |grep 'compatible archs'|sed 's/.*: //') && ret=0
+      ;;
+    package_or_file)
+      state=package_file
+      ;&
+    package)
+      if ( [[ ${+_rpms} -eq 0 ]] || _cache_invalid RPMs ) &&
+         ! _retrieve_cache RPMs;
+      then
+        _rpms=( $(_call packages rpm -qa 2>/dev/null) )
+        _store_cache RPMs _rpms
+      fi
+      _wanted packages expl 'RPM package' \
+          compadd -M 'r:|-=* r:|=*' - "$_rpms[@]" && ret=0
+      ;;
+    spec_file)
+      _wanted specfiles expl 'spec file' \
+          _files -g \*.spec && ret=0
+      ;;
+    package_file)
+      _wanted files expl 'RPM package file' \
+          _files -g '*.(#i)rpm' && ret=0
+      if [[ -prefix 1 (f|ht)tp:// ]]; then
+        _wanted urls expl 'URL of RPM package file' \
+            _urls -f -g '*.(#i)rpm' "${expl[@]}" && ret=0
+      else
+        _wanted urls expl 'URL of RPM package file' \
+            compadd -S '' "${expl[@]}" ftp:// http:// && ret=0
+      fi
+      ;;
+    package_src)
+      _files -g \*.src\(\#i\).rpm
+     ;&
+    tags)
+      if compset -P '*%*\{'; then
+        _wanted tags expl 'RPM tag' \
+            compadd -M 'm:{a-z}={A-Z}' -S '\}' - \
+                    "${(@)${(@f)$(_call tags rpm --querytags 2> /dev/null)}#RPMTAG_}" && ret=0
+      else
+        _message 'RPM format'
+      fi
+      ;;
+    capability)
+      _message 'RPM capability'
+      ;;
+    relocate)
+      if compset -P '*='; then
+        _description directories expl 'new path'
+      else
+        _description directories expl 'old path'
+      fi
+  
+      _files "$expl[@]" -/ && ret=0
+      ;;
+    esac
+  
+    [[ ret -eq 0 || $nm -ne $compstate[nmatches] ]] && return 0
+  done
+  
+  return ret
+}
 
-  # Dispatch...
+# set a sensible default caching policy
+local update_policy
+zstyle -s ":completion:*:*:rpm:*" cache-policy update_policy
+if [[ -z "$update_policy" ]]; then
+  zstyle ":completion:*:*:rpm:*" cache-policy _rpms_caching_policy
+fi
 
-  case "$lstate" in
+_rpms_caching_policy () {
-  query)
+  # rebuild if cache is more than a week old
-    # --dump requires on of -{l,c,d}
+  oldp=( "$1"(Nmw+1) )
-    # --triggers requires --script
+  (( $#oldp )) && return 0
-    _arguments -s \
-      -q "${commonopts[@]}" "${packageopts[@]}" "${pathopts[@]}" \
-      '--queryformat:RPM query format:->tags' \
-      '-i[display package information]' \
-      '--changelog[display change log]' \
-      '-l[display package file list]' \
-      '-s[show file states]' \
-      '-d[documentation files only]' \
-      '-c[configuration files only]' \
-      '--dump[show all information]' \
-      --provides \
-      -{R,-requires}'[list dependencies]' \
-      '--scripts[show (un)install scripts]' \
-      '--triggers[show trigger scripts]' \
-      '*:RPM package:->package_or_file' && ret=0
-    ;;
-  setattrs)
-    _arguments -s --set{perm,ugids} "${packageopts[@]}" && ret = 0
-    ;;
-  verify)
-    _arguments -s \
-      '(-y --verify)-V' '(-V --verify)-y' '(-y -V)--verify' \
-      "${commonopts[@]}" "${pathopts[@]}" \
-      --no{deps,md5,files} \
-      '*:RPM package:->package' && ret=0
-    ;;
-  upgrade)
-    tmp=( '(--upgrade)-U' '(-U)--upgrade' '(--force)--oldpackage' )
-    ;&
-  install)
-    (( $#tmp )) || tmp=( '(--install)-i' '(-i)--install' )
-    _arguments -s "$tmp[@]" \
-      "${commonopts[@]}" "${pathopts[@]}" \
-      '--excludepath:exclude files in following path:_files -/' \
-      '--relocate:relocate:->relocate' \
-      '--prefix:package prefix directory:_files -/' \
-      '(-h)--hash' '(--hash)-h' \
-      '(--replacepkgs --replacefiles --oldpackage)--force' \
-      '(--force)--'{replacefiles,replacepkgs} \
-      --{badreloc,excludedocs,allfiles,ignorearch,ignoreos,includedocs,justdb,nodeps,noorder,noscripts,notriggers,percent,test} \
-      '*:pkg file:->package_file' && ret=0
-    ;;
-  uninstall)
-    _arguments -s \
-      '(-e)--erase' '(--erase)-e' \
-      "${commonopts[@]}" "${pathopts[@]}" \
-      --{allmatches,justdb,nodeps,noorder,noscripts,notriggers} \
-      '*:RPM package:->package' && ret=0
-    ;;
-  build_b)
-    tmp=( '*:spec file:_files -g \*.spec' )
-    ;&
-  build_t)
-    (( $#tmp )) || tmp=( '*:tar file:_files -g \*.\(\#i\)tar\(.\*\|\)' )
 
-    _arguments -s \
+  [[ /var/lib/rpm/packages.rpm -nt "$1" ]]
-      "${commonopts[@]}" "${pathopts[@]}" \
+}
-      --{short-circuit,clean,rmsource,sign,test} \
-      '--target:specify a build target:->target'\
-      '--buildroot:build root directory:_files -/' \
-      '--buildarch:architecture for which to build:->target' \
-      '--buildos:ositecture for which to build:' \
-      '--timecheck:time check (seconds):' "$tmp[1]" && ret=0
-    ;;
-  sigcheck)
-    _arguments -s \
-      '(-K)--checksig' '(--checksig)-K' \
-      "${commonopts[@]}" \
-      --no{pgp,md5} \
-      '*:RPM package file:->package_file' && ret=0
-    ;;
-  rebuild)
-    _arguments -s \
-      "${commonopts[@]}" "${pathopts[@]}" \
-      '*:RPM source package file:->package_file' && ret=0
-    ;;
-  target)
-    _wanted target expl 'Target platforms' \
-        compadd $(_call target rpm --showrc 2> /dev/null |grep 'compatible archs'|sed 's/.*: //') && ret=0
-    ;;
-  package_or_file)
-    state=package_file
-    ;&
-  package)
-    _wanted packages expl 'RPM package' \
-        compadd -M 'r:|-=* r:|=*' - $(_call packages rpm -qa 2> /dev/null) && ret=0
-    ;;
-  spec_file)
-    _wanted specfiles expl 'spec file' \
-        _files -g \*.spec && ret=0
-    ;;
-  package_file)
-    _wanted files expl 'RPM package file' \
-        _files -g '*.(#i)rpm' && ret=0
-    if [[ -prefix 1 (f|ht)tp:// ]]; then
-      _wanted urls expl 'URL of RPM package file' \
-          _urls -f -g '*.(#i)rpm' "${expl[@]}" && ret=0
-    else
-      _wanted urls expl 'URL of RPM package file' \
-          compadd -S '' "${expl[@]}" ftp:// http:// && ret=0
-    fi
-    ;;
-  package_src)
-    _files -g \*.src\(\#i\).rpm
-   ;&
-  tags)
-    if compset -P '*%*\{'; then
-      _wanted tags expl 'RPM tag' \
-          compadd -M 'm:{a-z}={A-Z}' -S '\}' - \
-                  "${(@)${(@f)$(_call tags rpm --querytags 2> /dev/null)}#RPMTAG_}" && ret=0
-    else
-      _message 'RPM format'
-    fi
-    ;;
-  capability)
-    _message 'RPM capability'
-    ;;
-  relocate)
-    if compset -P '*='; then
-      _description directories expl 'new path'
-    else
-      _description directories expl 'old path'
-    fi
 
-    _files "$expl[@]" -/ && ret=0
+_rpm "$@"
-    ;;
-  esac
-
-  [[ ret -eq 0 || $nm -ne $compstate[nmatches] ]] && return 0
-done
-
-return ret

Completion/User/_perl_modules

@@ -17,49 +17,85 @@
 #   algorithm (the zsh code does almost the same, but only misses
 #   modules which don't begin with an uppercase letter).
 
-local opts
+_perl_modules () {
-zparseopts -D -a opts S: q
+  local opts
-
+  zparseopts -D -a opts S: q
-if [[ ${+_perl_modules} -eq 0 ]]; then
+  
-  if zstyle -t ":completion:${curcontext}:modules" try-to-use-pminst \
+  # Set a sensible default caching policy.  This has to be done inside
-     && (( ${+commands[pminst]} )); then
+  # this function otherwise we wouldn't know the context for the style.
-    _perl_modules=( $(pminst) )
+  local update_policy
-  else
+  zstyle -s ":completion:${curcontext}:" cache-policy update_policy
-    local inc libdir new_pms
+  if [[ -z "$update_policy" ]]; then
-    if (( ${+commands[perl]} )); then
+    zstyle ":completion:${curcontext}:" cache-policy \
-      inc=( $( perl -e 'print "@INC"' ) )
+      _perl_modules_caching_policy
+  fi
+  
+  if ( [[ ${+_perl_modules} -eq 0 ]] || _cache_invalid perl_modules ) &&
+     ! _retrieve_cache perl_modules;
+  then
+    if zstyle -t ":completion:${curcontext}:modules" try-to-use-pminst &&
+       (( ${+commands[pminst]} ));
+    then
+      _perl_modules=( $(pminst) )
     else
-      # If perl isn't there, one wonders why the user's trying to
+      local inc libdir new_pms
-      # complete Perl modules.  Maybe her $path is wrong?
+      if (( ${+commands[perl]} )); then
-      _message "Didn't find perl on \$PATH; guessing @INC ..."
+        inc=( $( perl -e 'print "@INC"' ) )
-
+      else
-      setopt localoptions extendedglob
+        # If perl isn't there, one wonders why the user's trying to
-      inc=( /usr/lib/perl5{,/{site_perl/,}<5->.([0-9]##)}(N) 
+        # complete Perl modules.  Maybe her $path is wrong?
-            ${(s.:.)PERL5LIB} )
+        _message "Didn't find perl on \$PATH; guessing @INC ..."
-    fi
+  
-
+        setopt localoptions extendedglob
-    typeset -agU _perl_modules  # _perl_modules is global, no duplicates
+        inc=( /usr/lib/perl5{,/{site_perl/,}<5->.([0-9]##)}(N) 
-    _perl_modules=( )
+              ${(s.:.)PERL5LIB} )
-
-    for libdir in $inc; do
-      # Ignore cwd - could be too expensive e.g. if we're near /
-      if [[ $libdir == '.' ]]; then break; fi
-
-      # Find all modules
-      if [[ -d $libdir && -x $libdir ]]; then
-      cd $libdir
-      new_pms=( {[A-Z]*/***/,}*.pm~*blib*(N) )
-      cd $OLDPWD
       fi
+  
+      typeset -agU _perl_modules  # _perl_modules is global, no duplicates
+      _perl_modules=( )
+  
+      for libdir in $inc; do
+        # Ignore cwd - could be too expensive e.g. if we're near /
+        if [[ $libdir == '.' ]]; then break; fi
+  
+        # Find all modules
+        if [[ -d $libdir && -x $libdir ]]; then
+        cd $libdir
+        new_pms=( {[A-Z]*/***/,}*.pm~*blib*(N) )
+        cd $OLDPWD
+        fi
+  
+        # Convert to Perl nomenclature
+        new_pms=( ${new_pms:r:fs#/#::#} )
+  
+        _perl_modules=( $new_pms $_perl_modules )
+      done
+    fi
+  
+    _store_cache perl_modules _perl_modules
+  fi
+  
+  local expl
+  
+  _wanted modules expl 'Perl modules' compadd "$opts[@]" -a _perl_modules
+}
 
-      # Convert to Perl nomenclature
+_perl_modules_caching_policy () {
-      new_pms=( ${new_pms:r:fs#/#::#} )
+  local _perllocals
 
-      _perl_modules=( $new_pms $_perl_modules )
+  # rebuild if cache is more than a week old
+  oldp=( "$1"(Nmw+1) )
+  (( $#oldp )) && return 0
+
+  _perllocals=( /usr/lib/perl5/**/perllocal.pod(N) )
+
+  if (( $#_perllocals )); then
+    for pod in $_perllocals; do
+      [[ "$pod" -nt "$1" ]] && return 0
     done
   fi
-fi
 
-local expl
+  return 1
+}
 
-_wanted modules expl 'Perl modules' compadd "$opts[@]" -a _perl_modules
+_perl_modules "$@"

Doc/Zsh/compsys.yo

@@ -914,6 +914,13 @@ should be a pattern and all keys matching this pattern will cause the
 widget to stop incremental completion without the key having any
 further effect.
 )
+kindex(cache-path, completion style)
+item(tt(cache-path))(
+This style defines the path where any cache files containing dumped
+completion data are stored.  Defaults to `tt($DOTDIR/.zcompcache)', or
+`tt($HOME/.zcompcache)' if tt($DOTDIR) is not defined.  The completion
+layer will not be used unless the tt(use-cache) style is set.
+)
 kindex(command, completion style)
 item(tt(command))(
 In many places, completion functions need to call external commands to
@@ -2083,6 +2090,13 @@ sensible default behavior that causes arguments (whether normal command
 arguments or arguments of options) to be completed before option names for
 most commands.
 )
+kindex(use-cache, completion style)
+item(tt(use-cache))(
+If this is set, the completion caching layer is activated for any completions
+which use it (via the tt(_store_cache), tt(_retrieve_cache), and
+tt(_cache_invalid) functions).  The directory containing the cache
+files can be changed with the tt(cache-path) style.
+)
 kindex(use-compctl, completion style)
 item(tt(use-compctl))(
 If this style is set to a string em(not) equal to tt(false), tt(0),
@@ -3189,6 +3203,22 @@ arguments. The first one describes the first argument as a
 be completed. The last description says that all other arguments are
 `var(page numbers)' but does not give possible completions.
 )
+findex(_cache_invalid)
+item(tt(_cache_invalid) var(cache_identifier))(
+This function returns 0 if the completions cache corresponding to the
+given cache identifier needs rebuilding.  It determines this by
+looking up the tt(cache-policy) style for the current context, and
+if it exists, runs the function of the same name, supplying the full
+path to the relevant cache file as the only argument.
+
+Example:
+
+example(_example_caching_policy () {
+    # rebuild if cache is more than a week old
+    oldp=( "$1"(Nmw+1) )
+    (( $#oldp ))
+})
+)
 findex(_call)
 item(tt(_call) var(tag) var(string) ...)(
 This function is used in places where a command is called, making it
@@ -3595,6 +3625,18 @@ while _tags; do
   (( ret )) || break
 done)
 )
+findex(_retrieve_cache)
+item(tt(_retrieve_cache) var(cache_identifier))(
+This function retrieves completion information from the file given by
+var(cache_identifier), stored in a directory specified by the
+tt(cache-path) style (defaults to tt(~/.zsh/cache)).  The return value
+is zero if retrieval was successful.  It will only attempt retrieval
+if the tt(use-cache) style is set, so you can call this function
+without worrying about whether the user wanted to use the caching
+layer.
+
+See tt(_store_cache) below for more details.
+)
 findex(_sep_parts)
 item(tt(_sep_parts))(
 This function is passed alternating arrays and separators as arguments.
@@ -3718,6 +3760,36 @@ separate set. With the tt(-m) option, the arguments are treated in the
 same way as the the values for the tt(tag-order) style (except for the 
 `tt(!...)', `tt(-)' and `tt(foo())' forms).
 )
+findex(_store_cache)
+item(tt(_store_cache) var(cache_identifier) var(vars) ...)(
+This function, when combined with tt(_retrieve_cache) and
+tt(_cache_invalid), makes it easy to implement a caching layer for
+your completion functions.  If a completion function needs to perform
+a costly operation in order to generate data which is used to
+calculate completions, you can store that data in variables, and use
+this function to dump the values of those variables to a file.  Then,
+if they are needed in subsequent shell invocations, they can be
+retrieved quickly from that file via tt(_retrieve_cache), avoiding the
+needly for repeating the costly operation.
+
+The var(cache_identifier) specifies the file which the data should be
+dumped to, and is stored in a directory specified by the
+tt(cache-path) style (defaults to tt(~/.zsh/cache)).  The remaining
+var(vars) arguments are the variables to dump to the file.
+
+The return value is zero if storage was successful.  The function will
+only attempt storage if the tt(use-cache) style is set, so you can
+call this function without worrying about whether the user wanted to
+use the caching layer.
+
+If your completion function avoids calling _retrieve_cache when it
+already has the completion data in the environment, it should probably
+at least call tt(_cache_invalid) to check whether this data and the
+data cached on disk is still valid.
+
+See the _perl_modules completion function for a simple example of
+usage of this caching layer.
+)
 findex(_tags)
 item(tt(_tags) [ tt(-C) var(name) [ var(tags) ... ] ])(
 If called with arguments, these are taken as the names of the tags for