A bunch more changes

elisp/ltex-eglot.el

@@ -0,0 +1,345 @@
+;;; ltex-eglot.el --- LTeX support for Eglot. -*- lexical-binding: t -*-
+;;; Commentary:
+;;; Code:
+(require 'eglot)
+
+(defcustom ltex-eglot-server-binary "ltex-ls"
+  "The binary to use for the LTeX LSP server."
+  :group 'ltex-eglot
+  :type 'string)
+
+(defconst ltex-eglot-modes
+  ;; Source:
+  ;; https://github.com/emacs-languagetool/eglot-ltex/blob/master/eglot-ltex.el
+  '((org-mode :language-id "org")
+    (git-commit-elisp-text-mode :language-id "gitcommit")
+    (bibtex-mode :language-id "bibtex")
+    (context-mode :language-id "context")
+    (latex-mode :language-id "latex")
+    (LaTeX-mode :language-id "latex")
+    (markdown-mode :language-id "markdown")
+    (rst-mode :language-id "restructuredtext")
+    (text-mode :language-id "plaintext"))
+  "List of major mode that work with LanguageTool.")
+
+(defcustom ltex-eglot-mother-tounge "en-US"
+  "The user's native language."
+  :group 'ltex-eglot
+  :type '(string :tag "Language Code"))
+
+(defcustom ltex-eglot-language ltex-eglot-mother-tounge
+  "The main language to use when checking documents."
+  :group 'ltex-eglot
+  :type '(choice :tag "Language"
+                 (const :tag "Detect Automatically" "auto")
+                 (string :tag "Language Code"))
+  :set-after '(ltex-eglot-mother-tounge)
+  :safe 'stringp)
+
+(defcustom ltex-eglot-enable-spell-check nil
+  "Weather or not to enable spell checking with LTeX."
+  :group 'ltex-eglot
+  :type '(choice :tag "Status"
+                 (const :tag "Enabled" t)
+                 (const :tag "Disabled" nil)))
+
+(defun ltex-eglot--entry-file-p (entry)
+  "Check if ENTRY would be concidered a file by LTex LSP."
+  (when (stringp entry)
+    (string-prefix-p ":" entry)))
+
+(defun ltex-eglot--non-file-settings-plist-p (plist)
+  "Return non-nil if none of the values of PLIST refer to files.
+This is meant to check file-local saftey for the likes of
+`ltex-eglot-disabled-rules'."
+  (cl-loop for (_ entries) on plist by 'cddr
+           when (cl-some 'ltex-eglot--entry-file-p entries)
+           do (cl-return)
+           finally return t))
+
+(defcustom ltex-eglot-disabled-rules ()
+  "List of diagnostic rules to disable."
+  :group 'ltex-eglot
+  :type '(plist :tag "Entries by language"
+                :key-type (string :tag "Language Code")
+                :value-type (repeat :tag "Rules" string))
+  :safe 'ltex-eglot--non-file-settings-plist-p)
+
+(defcustom ltex-eglot-enabled-rules ()
+  "List of diagnostic rules to enable."
+  :group 'ltex-eglot
+  :type '(plist :tag "Entries by language"
+                :key-type (string :tag "Language Code")
+                :value-type (repeat :tag "Rules" string))
+  :safe 'ltex-eglot--non-file-settings-plist-p)
+
+(defcustom ltex-eglot-dictionary ()
+  "List of words in the LTeX dictionary."
+  :group 'ltex-eglot
+  :type '(plist :tag "Entries by language"
+                :key-type (string :tag "Language Code")
+                :value-type (repeat :tag "Words" string))
+  :safe 'ltex-eglot--non-file-settings-plist-p)
+
+(defun ltex-eglot--valid-latex-plist-p (plist)
+  "Return non-nil if PLIST is an OK value for LaTeX options."
+  (cl-loop for (name handling) on plist by 'cddr
+           unless (and (stringp name)
+                       (member handling '("ignore" "default")))
+           do (cl-return)
+           finally return t))
+
+(defcustom ltex-eglot-latex-environments ()
+  "Plist controlling the handling of LaTeX environments."
+  :group 'ltex-eglot
+  :type '(plist
+          :tag "Environments"
+          :key-type (string :tag "Name")
+          :value-type (choice :tag "Handling"
+                              (const :tag "Ignore" "ignore")
+                              (const :tag "Check" "default")))
+  :safe 'ltex-eglot--valid-latex-plist-p)
+
+(defcustom ltex-eglot-latex-commands ()
+  "Plist controlling the handling of LaTeX commands."
+  :group 'ltex-eglot
+  :type '(plist
+          :tag "Commands"
+          :key-type (string :tag "Name")
+          :value-type (choice :tag "Handling"
+                              (const :tag "Ignore" "ignore")
+                              (const :tag "Check" "default")))
+  :safe 'ltex-eglot--valid-latex-plist-p)
+
+(defun ltex-eglot--valid-bibtex-plist-p (plist)
+  "Return non-nil if PLIST is an OK value for BibTeX options."
+  (cl-loop for (name handling) on plist by 'cddr
+           unless (and (stringp name)
+                       (booleanp handling))
+           do (cl-return)
+           finally return t))
+
+(defcustom ltex-eglot-bibtex-fields ()
+  "Plist controlling the handling of BibTeX fields."
+  :group 'ltex-eglot
+  :type '(plist
+          :tag "Fields"
+          :key-type (string :tag "Name")
+          :value-type (choice :tag "Handling"
+                              (const :tag "Ignore" nil)
+                              (const :tag "Check" t)))
+  :safe 'ltex-eglot--valid-bibtex-plist-p)
+
+(defcustom ltex-eglot-enable-picky-rules nil
+  "Weather or not to enable picky rules."
+  :group 'ltex-eglot
+  :type '(choice :tag "Status"
+                 (const :tag "Enabled" t)
+                 (const :tag "Disabled" nil))
+  :safe 'booleanp)
+
+(defvar ltex-eglot-hidden-false-positives nil
+  "List of hidden false positives.
+This is intented to be set from .dir-locals.el.")
+(put 'ltex-eglot-hidden-false-positives 'safe-local-variable
+     'ltex-eglot--non-file-settings-plist-p)
+
+(defun ltex-eglot--merge-options-plists (value-type &rest lists)
+  "Merge each of the options plist LISTS.
+The values of each of the props can be any sequence, and will be converted to
+VALUE-TYPE.  Any keys will be converted to keyword symbols if they are strings."
+  (let ((output))
+    (dolist (list lists output)
+      (cl-loop for (prop value) on list by 'cddr
+               for norm-prop = (if (stringp prop)
+                                   (intern (concat ":" prop))
+                                 prop)
+               do
+               (setf (plist-get output norm-prop)
+                     (cl-coerce (seq-uniq
+                                 (seq-concatenate 'list
+                                                  (plist-get output norm-prop)
+                                                  value))
+                                value-type))))))
+
+(defun ltex-eglot--process-and-add-global (global &rest lists)
+  "Merge each of LISTS with `ltex-eglot--merge-options-plists'.
+If the result of the merger results in a list with the key t, merge GLOBAL in as
+well."
+  (let ((merged (apply 'ltex-eglot--merge-options-plists 'vector lists)))
+    (cl-loop with found-t = nil
+             for (prop value) on merged by 'cddr
+             when (eq prop t) do
+             (setq found-t t)
+             else collect prop into output
+             and collect value into output
+             finally return
+             (if found-t
+                 (ltex-eglot--merge-options-plists 'vector output global)
+               output))))
+
+(defun ltex-eglot--make-plist-props-symbols (plist)
+  "Make each of PLIST's props a symbol by calling `intern' on it."
+  (cl-loop for (prop value) on plist by 'cddr
+           collect (if (stringp prop)
+                       (intern (concat ":" prop))
+                     prop)
+           collect value))
+
+(defun ltex-eglot--process-bibtex-fields-plist (plist)
+  "Process a PLIST that might be `ltex-eglot-bibtex-fields'."
+  (cl-loop for (prop value) on plist by 'cddr
+           collect (if (stringp prop)
+                       (intern (concat ":" prop))
+                     prop)
+           collect (or value :json-false)))
+
+;; The ltex server doesn't work with eglot when running in standard io mode
+(defclass ltex-eglot-server (eglot-lsp-server)
+  ((setup-done-p :initform nil
+                 :accessor ltex-eglot-server--setup-done-p)
+   (hidden-positives :initform nil
+                     :accessor ltex-eglot-server--hidden-positives)
+   (dictionary :initform nil
+               :accessor ltex-eglot-server--dictionary)
+   (disabled-rules :initform nil
+                   :accessor ltex-eglot-server--disabled-rules))
+  "LTeX server class.")
+
+(cl-defmethod ltex-eglot--disabled-rules-plist ((server ltex-eglot-server))
+  "Create a plist of disabled rules by language.
+SERVER is the server from which to get the rules."
+  (ltex-eglot--process-and-add-global
+   (default-value 'ltex-eglot-disabled-rules)
+   (ltex-eglot-server--disabled-rules server)
+   (and (not ltex-eglot-enable-spell-check)
+        '(:en-US ["EN_CONTRACTION_SPELLING" "MORFOLOGIK_RULE_EN_US"]))))
+
+(cl-defmethod ltex-eglot--setup-server ((server ltex-eglot-server))
+  "Setup up SERVER for the first time."
+  ;; make sure that dir local stuff is picked up
+  (save-current-buffer
+    (when-let ((buf (cl-first (eglot--managed-buffers server))))
+      (set-buffer buf))
+    (setf
+     ;; merger of global values is mediated elsewhere
+     (ltex-eglot-server--hidden-positives server)
+     (if (local-variable-p 'ltex-eglot-hidden-false-positives)
+         ltex-eglot-hidden-false-positives
+       '(t))
+     (ltex-eglot-server--disabled-rules server)
+     (if (local-variable-p 'ltex-eglot-disabled-rules)
+         ltex-eglot-disabled-rules
+       '(t))
+     (ltex-eglot-server--dictionary server)
+     (if (local-variable-p 'ltex-eglot-dictionary)
+         ltex-eglot-dictionary
+       '(t))
+     (ltex-eglot-server--setup-done-p server) t)))
+
+(cl-defmethod ltex-eglot--build-workspace-settings-plist ((server ltex-eglot-server))
+  "Build the workspace settings plist for SERVER."
+  (unless (ltex-eglot-server--setup-done-p server)
+    (ltex-eglot--setup-server server))
+  (list
+   :language ltex-eglot-language
+   :dictionary (ltex-eglot--process-and-add-global
+                (default-value 'ltex-eglot-dictionary)
+                (ltex-eglot-server--dictionary server))
+   :disabledRules (ltex-eglot--disabled-rules-plist server)
+   :enabledRules (ltex-eglot--merge-options-plists
+                  'vector
+                  ltex-eglot-enabled-rules)
+   :hiddenFalsePositives (ltex-eglot--process-and-add-global
+                          (default-value 'ltex-eglot-hidden-false-positives)
+                          (ltex-eglot-server--hidden-positives server))
+   :latex (list :commands (ltex-eglot--make-plist-props-symbols
+                           ltex-eglot-latex-commands)
+                :environments (ltex-eglot--make-plist-props-symbols
+                               ltex-eglot-latex-environments))
+   :bibtex (list :fields (ltex-eglot--process-bibtex-fields-plist
+                          ltex-eglot-bibtex-fields))
+   :additionalRules (list :motherTongue ltex-eglot-mother-tounge
+                          :enablePickyRules
+                          (or ltex-eglot-enabled-rules :json-false))))
+
+(defun ltex-eglot--cleanup-plist-for-dir-locals (plist)
+  "Cleanup PLIST for use in a .dir-locals.el file."
+  (cl-loop with has-global = nil
+           for (prop value) on plist by 'cddr
+           when (eq prop t) do
+           (setq has-global t)
+           else collect prop into output
+           and collect value into output
+           finally
+           (when has-global
+             (cl-callf nconc output (list t)))
+           finally return output))
+
+(defun ltex-eglot--handle-client-action (server command slot)
+  "Handle the client side action COMMAND for SERVER.
+SLOT is a slot in SERVER."
+  (let* ((arg (cl-case slot
+                (disabled-rules :ruleIds)
+                (hidden-positives :falsePositives)
+                (dictionary :words)))
+         (local-var (cl-case slot
+                      (disabled-rules 'ltex-eglot-disabled-rules)
+                      (hidden-positives 'ltex-eglot-hidden-false-positives)
+                      (dictionary 'ltex-eglot-dictionary)))
+         (args (elt (plist-get command :arguments) 0))
+         (newval (ltex-eglot--merge-options-plists
+                  'list
+                  (slot-value server slot) (plist-get args arg))))
+    (add-dir-local-variable nil local-var
+                            (ltex-eglot--cleanup-plist-for-dir-locals newval))
+    (setf (slot-value server slot) newval)
+    (dolist (buf (eglot--managed-buffers server))
+      (setf (buffer-local-value local-var buf) newval))
+    (eglot-signal-didChangeConfiguration server)))
+
+(cl-defmethod eglot-execute ((server ltex-eglot-server) action)
+  "Handelr for LTeX actions.
+ACTION is the action which to run on SERVER."
+  (let ((kind (plist-get action :kind)))
+    (pcase kind
+      ("quickfix.ltex.disableRules"
+       (ltex-eglot--handle-client-action server (plist-get action :command)
+                                         'disabled-rules))
+      ("quickfix.ltex.hideFalsePositives"
+       (ltex-eglot--handle-client-action server (plist-get action :command)
+                                         'hidden-positives))
+      ("quickfix.ltex.addToDictionary"
+       (ltex-eglot--handle-client-action server (plist-get action :command)
+                                         'dictionary))
+      (_ (cl-call-next-method)))))
+
+(defun ltex-eglot--hack-server-config (oldfun server &optional path)
+  "Hack the config for SERVER into the return of ODLFUN.
+PATH is the same as for OLDFUN, which is probably
+`eglot--workspace-configuration-plist'."
+  (let ((conf (funcall oldfun server path)))
+    (when (object-of-class-p server 'ltex-eglot-server)
+      (let ((ltex-conf (plist-get conf :ltex)))
+        (cl-loop for (prop val) on
+                 (ltex-eglot--build-workspace-settings-plist server)
+                 by 'cddr
+                 unless (plist-member ltex-conf prop)
+                 do (setf (plist-get ltex-conf prop) val))
+        (setf (plist-get conf :ltex) ltex-conf)))
+    conf))
+
+;;;###autoload
+(add-to-list 'eglot-server-programs
+             (cons ltex-eglot-modes
+                   (list
+                    'ltex-eglot-server
+                    ltex-eglot-server-binary "--server-type" "TcpSocket"
+                    "--port" :autoport)))
+
+;;;###autoload
+(advice-add 'eglot--workspace-configuration-plist :around
+            'ltex-eglot--hack-server-config)
+
+(provide 'ltex-eglot)
+;;; ltex-eglot.el ends here

init.el

@@ -474,13 +474,34 @@ With NO-EDGE, return nil if beg or end fall on the edge of the range."
                           (< beg (cdr sb))
                           (/= end (car sb))
                           (< end (cdr sb))))))
-        ;; if the error happens, we aren't in as string
+        ;; if the error happens, we aren't in a string
         (wrong-type-argument nil))))
   (defun my/-evil-cp-region-ok-p-no-string (oldfun beg end)
-    (or (my/range-inside-thing-p 'string beg end t)
+    (or
-        (funcall oldfun beg end)))
+     (my/range-inside-thing-p 'string beg end t)
+     (funcall oldfun beg end)))
+  (defun my/column-num-at-pos (pos)
+    "Return the column number at POS."
+    (save-excursion
+      (goto-char pos)
+      (current-column)))
+  (defun my/-evil-cp-block-ok-p-no-string (oldfun beg end)
+    (when (> beg end) (cl-rotatef beg end))
+    (or
+     (funcall oldfun beg end)
+     (save-excursion
+       (goto-char beg)
+       (let ((start-off (current-column))
+             (end-off (my/column-num-at-pos end)))
+         (cl-block nil
+           (dotimes (_ (count-lines beg end) t)
+             (let ((bol (pos-bol)))
+               (unless (sp-region-ok-p (+ bol start-off)
+                                       (+ bol end-off))
+                 (cl-return))
+               (forward-line))))))))
   (advice-add 'sp-region-ok-p :around 'my/-evil-cp-region-ok-p-no-string)
-  (advice-add 'evil-cp--balanced-block-p :around 'my/-evil-cp-region-ok-p-no-string))
+  (advice-add 'evil-cp--balanced-block-p :around 'my/-evil-cp-block-ok-p-no-string))
 
 ;; make lisp editing nicer
 (use-package aggressive-indent
@@ -826,61 +847,125 @@ to `posframe-show' if the display is graphical."
 
 ;; flymake
 (use-package flymake
-  :bind (:map flymake-mode-map
+  :config
-         ("C-c e" . my/flymake-show-diagnostic-at-point)
+  (require 'consult-flymake))
-         ("C-c C-e" . consult-flymake)
-         ("C-x c e" . consult-flymake))
-  ;; :hook (emacs-lisp-mode . flymake-mode)
-  :init
-  (defun my/flymake-show-diagnostic-at-point ()
-    (interactive)
-    (when flymake-mode
-      (let* ((diag (get-char-property (point) 'flymake-diagnostic))
-             (diag-msg (when diag
-                         (apply 'concat
-                                (mapcar
-                                 (lambda (msg)
-                                   (concat "•" msg "\n"))
-                                 (split-string (flymake--diag-text diag)
-                                               "\n")))))
-             (jinx-msg (when (jinx--get-overlays (point) (1+ (point)))
-                         "•misspelled word\n")))
-        (unless (and (zerop (length diag-msg))
-                     (zerop (length jinx-msg)))
-          (my/floating-tooltip " *flymake-error-posframe*"
-                               (concat diag-msg jinx-msg)))))))
 
 ;; flycheck
 (use-package flycheck
   :hook (emacs-lisp-mode . flycheck-mode)
-  :bind (:map flycheck-mode-map
-         ("C-c e" . my/flycheck-show-diagnostic-at-point))
   :custom
   (flycheck-indication-mode 'left-margin)
   :init
-  (setq flycheck-display-errors-function nil)
+  (setq flycheck-display-errors-function nil))
-  (defun my/flycheck-show-diagnostic-at-point ()
+(use-package consult-flycheck)
-    (interactive)
+
-    (if-let ((flycheck-mode)
+(defun my/diagnostic-at-point ()
-             (message
+  "Show the diagnostics under point."
-              (apply 'concat
+  (interactive)
-                     (nconc (mapcar
+  (let ((message))
-                             (lambda (error)
+    (when-let ((flymake-mode)
-                               (concat "•" (flycheck-error-message error) "\n"))
+               (diag (get-char-property (point) 'flymake-diagnostic)))
-                             (flycheck-overlay-errors-at (point)))
+      (cl-callf nconc message (string-split (flymake--diag-text diag) "\n" t)))
-                            (when (jinx--get-overlays (point) (1+ (point)))
+    (when flycheck-mode
-                              '("•misspelled word\n")))))
+      (cl-callf nconc message
-             ((not (zerop (length message)))))
+        (mapcar 'flycheck-error-message (flycheck-overlay-errors-at (point)))))
-        (my/floating-tooltip " *flycheck-error-posframe*"
+    ;; jinx
-                             (substring message 0 (1- (length message)))))))
+    (when-let ((jinx-msg (jinx--get-overlays (point) (1+ (point)))))
-(use-package consult-flycheck
+      (push "misspelled word" message))
-  :defer nil
+    (when message
-  :bind (:map flycheck-mode-map
+      (my/floating-tooltip " *my-diagnostic-posframe*"
-         ("C-c C-e" . consult-flycheck)
+                           (mapconcat (lambda (msg)
-         ("C-x c e" . consult-flycheck)
+                                        (concat "•" msg))
-         :map emacs-lisp-mode-map
+                                      message "\n")))))
-         ("C-c C-e" . consult-flycheck)
+
-         ("C-x c e" . consult-flycheck)))
+(defconst my/consult-flymake-flycheck-narrow
+  '((?e . "Error")
+    (?w . "Warning")
+    (?i . "Info")
+    (?n . "Info")))
+
+(defun my/-consult-replace-flymake-error-level (candidates)
+  "Return CANDIDATES with the flymake error level note replaced with info."
+  (cl-loop for cand in candidates
+           collect
+           (cl-loop
+            with start = nil
+            for i below (length cand)
+            for props = (text-properties-at i cand)
+            for face = (plist-get props 'face)
+            when (eq face 'compilation-info) do
+            (setq start (or start i))
+            else when start do
+            (setf (substring cand start i)
+                  (propertize (string-pad "info" (- i start))
+                              'face (flycheck-error-level-error-list-face
+                                     'info)))
+            (cl-return cand)
+            finally return cand)))
+
+(defun my/consult-flymake-flycheck-candidates (&optional project)
+  "Return combined candidate list for flymake and flycheck.
+With PROJECT, return the candiadeets for that project."
+  (let ((had-errors))
+    (prog1
+        (seq-uniq
+         (append
+          (when-let (((bound-and-true-p flymake-mode))
+                     (diags (if project (flymake--project-diagnostics
+                                         project)
+                              (flymake-diagnostics))))
+            (setq had-errors t)
+            (my/-consult-replace-flymake-error-level
+             (consult-flymake--candidates diags)))
+          (when (boundp 'flycheck-mode)
+            (if project
+                (cl-loop for buf in (project-buffers project)
+                         append
+                         (with-current-buffer buf
+                           (when (and flycheck-mode flycheck-current-errors)
+                             (setq had-errors t)
+                             (consult-flycheck--candidates))))
+              (when (and flycheck-mode flycheck-current-errors)
+                (setq had-errors t)
+                (consult-flycheck--candidates))))))
+      (unless had-errors
+        (user-error "No errors (Flymake: %s | Flycheck: %s)"
+                    (cond
+                     ((not (bound-and-true-p flymake-mode))
+                      "not running")
+                     ((seq-difference (flymake-running-backends)
+                                      (flymake-reporting-backends))
+                      "running")
+                     (t "finished"))
+                    (if (boundp 'flycheck-last-status-change)
+                        flycheck-last-status-change
+                      "not running"))))))
+
+(defun my/consult-flymake-flycheck (&optional project)
+  "Jump to flymake or flycheck error.
+With PROJECT, give diagnostics for all buffers in the current project."
+  (interactive "P")
+  (consult--read
+   (consult--with-increased-gc
+    (my/consult-flymake-flycheck-candidates
+     (and project (project-current))))
+   :prompt "Error: "
+   :category 'flymake-flycheck-error
+   :history t
+   :require-match t
+   :sort nil
+   :narrow (consult--type-narrow my/consult-flymake-flycheck-narrow)
+   :group (consult--type-group my/consult-flymake-flycheck-narrow)
+   :lookup #'consult--lookup-candidate
+   :state (consult--jump-state)))
+(with-eval-after-load 'flymake
+  (define-key flymake-mode-map (kbd "C-c e") 'my/diagnostic-at-point)
+  (define-key flymake-mode-map (kbd "C-c C-e") 'my/consult-flymake-flycheck))
+(with-eval-after-load 'flycheck
+  (define-key flycheck-mode-map (kbd "C-c e") 'my/diagnostic-at-point)
+  (define-key flycheck-mode-map (kbd "C-c C-e") 'my/consult-flymake-flycheck))
+(with-eval-after-load 'jinx
+  (define-key jinx-mode-map (kbd "C-c e") 'my/diagnostic-at-point))
 
 ;; eldoc
 (use-package eldoc
@@ -948,6 +1033,9 @@ to `posframe-show' if the display is graphical."
                        "--header-insertion=never" "--pch-storage=memory"
                        "--function-arg-placeholders"))))
 
+;; LTeX (languagetool)
+(require 'ltex-eglot)
+
 ;; gud
 (use-package gud
   :demand t
@@ -1226,7 +1314,8 @@ otherwise, call `bibtex-find-text'."
   :hook ((LaTeX-mode . turn-on-reftex)
          (LaTeX-mode . LaTeX-math-mode)
          (LaTeX-mode . my/-setup-LaTeX-mode)
-         (LaTeX-mode . flycheck-mode))
+         (LaTeX-mode . flycheck-mode)
+         (LaTeX-mode . eglot-ensure))
   :bind (:map TeX-mode-map
          ("C-c ?" . latex-help))
   :init
@@ -1237,6 +1326,7 @@ otherwise, call `bibtex-find-text'."
   (add-to-list 'major-mode-remap-alist '(texinfo-mode . Texinfo-mode))
   (add-to-list 'major-mode-remap-alist '(doctex-mode . docTeX-mode))
   (add-to-list 'auto-mode-alist '("/\\.latexmkrc\\'" . perl-mode))
+  (add-to-list 'auto-mode-alist '("\\.[tT]e[xX]\\'" . LaTeX-mode))
   :config
   (defun my/-auctex-texdoc-setup-env (oldfun &rest args)
     (let ((process-environment process-environment)