重新定义use-package(无意义重复造轮)

要说为什么,因为我 来了 有洁癖。一想到use-package光core就一千多行,我就浑身难受。

(require 'pcase)

(defun luna-installed-p (package)
  "Return t if PACKAGE is installed."
  (and (locate-file (symbol-name package) load-path
                    '(".el" ".el.gz" ".so" ".so.gz"))
       t))

(defun luna-split-command-args (args)
  "Split args into commands and args.
If ARGS is (:command args args args :command args),
return: ((:command . (args args args)) (:command . (args)))."
  (let (ret-list arg-list command)
    (dolist (token (append args '(:finish)))
      (if (keywordp token)
          ;; Finish previous command
          (progn (if command (push (cons command (reverse arg-list))
                                   ret-list))
                 (setq arg-list nil)
                 ;; Start new command
                 (setq command token))
        (push token arg-list)))
    (reverse ret-list)))

(defun luna-load-package--handle-hook (arg-list)
  "Handle hook arguments.
Each ARG in ARG-LIST is a cons (HOOK . FUNCTION).
HOOK can be either a single hook or a list of hooks.
FUNCTION can also be either a single function or a list of them."
  (let (ret-list hook-list func-list)
    (dolist (arg arg-list)
      (let ((hook (car arg))
            (func (cdr arg)))
        ;; Normalize to lists.
        (setq hook-list
              (if (symbolp hook) (list hook) hook))
        (setq func-list
              (if (symbolp func) (list func) func)))
      ;; Produce add-hook forms.
      (dolist (func func-list)
        (dolist (hook hook-list)
          (push `(add-hook ',hook #',func) ret-list))))
    (reverse ret-list)))

(defun luna-load-package--collect-autoload (arg-list package)
  "Collect functions that needs autoload from ARG-LIST.
PACKAGE is the package we are loading.
Return a list of (autoload ...) forms."
  (let ((autoload
          (mapcan (lambda (arg)
                    (let ((command (car arg))
                          (arg-list (cdr arg)))
                      (pcase command
                        ;; ARG is either (hook . fn) or
                        ;;               ((hook ...) . fn) or
                        ;;               (hook . (fn ...))
                        (:hook (mapcan (lambda (arg)
                                         (let ((fn (cdr arg)))
                                           (if (symbolp fn)
                                               (list fn)
                                             fn)))
                                       arg-list))
                        ;; ARG is either ".xxx" or (".xxx" . mode)
                        (:mode (mapcar (lambda (arg)
                                         (if (stringp arg)
                                             package
                                           (cdr arg)))
                                       arg-list)))))
                  arg-list)))
    (mapcar (lambda (fn)
              `(autoload #',fn ,(symbol-name package) nil t))
            autoload)))

(defmacro luna-load-package (package &rest args)
  "Like ‘use-package’.
PACKAGE is the package you are loading.
ARGS contains commands and arguments.
Available commands:

  :init         Run right away.
  :config       Run after package loads.
  :hook         Each arguments is (HOOK . FUNC)
                HOOK and FUNC can be a symbol or a list of symbols.
  :load-path    Add load paths.
  :mode         Add (ARG . PACKAGE) to ‘auto-mode-alist’. If ARG is
                already a cons, add ARG to ‘auto-mode-alist’.
  :commands     Add autoload for this command.
  :after        Require after this package loads.
  :defer        Don’t require the package.

Each command can take zero or more arguments."
  (declare (indent 1))
  ;; Group commands and arguments together.
  (let* ((arg-list (luna-split-command-args args))
         ;; Translate commands & arguments to valid
         ;; config code.
         (body
          (mapcan
           (lambda (arg)
             (let ((command (car arg))
                   (arg-list (cdr arg)))
               (pcase command
                 (:init arg-list)
                 (:config `((with-eval-after-load ',package
                              ,@arg-list)))
                 (:hook (luna-load-package--handle-hook arg-list))
                 (:mode
                  ;; ARG is either ".xxx" or (".xxx" . mode)
                  (mapcar
                   (lambda (arg)
                     (let ((pattern (if (consp arg) (car arg) arg))
                           (mode-fn (if (consp arg) (cdr arg) package)))
                       `(add-to-list 'auto-mode-alist
                                     ',(cons pattern mode-fn))))
                   arg-list))
                 (:commands
                  (mapcar (lambda (cmd)
                            `(autoload ',cmd ,(symbol-name package) nil t))
                          arg-list))
                 (:after
                  (mapcar (lambda (pkg)
                            `(with-eval-after-load ',pkg
                               (require ',package)))
                          arg-list)))))
           arg-list))
         (load-path-form (mapcar (lambda (path)
                                   `(add-to-list 'load-path ,path))
                                 (alist-get :load-path arg-list)))
         (autoload-list (luna-load-package--collect-autoload arg-list
                                                             package))
         ;; In which case we don’t require the package.
         (defer-p (let ((commands (mapcar #'car arg-list)))
                    (or (memq :defer commands)
                        (memq :commands commands)
                        (memq :after commands)
                        (memq :mode commands)
                        (memq :hook commands)))))
    `(condition-case err
         (progn
           ,@load-path-form
           ;; luna-package-list跟我的配置有关
           (add-to-list 'luna-package-list ',package)
           (when (not (luna-installed-p ',package))
             (error "%s not installed" ',package))
           ,@autoload-list
           ,@body
           ,(unless defer-p `(require ',package)))
       ((debug error) (warn "Error when loading %s: %s" ',package
                            (error-message-string err))))))

换上以后似乎没问题,配置正常启动了。

9 个赞

之前写过一个专门处理不规则 plist 的包(包名不甚满意):

实现了读/写/合并/迭代等接口。

在我自己的配置里,又包装了一个转常规 plist 的接口:

(defun dotemacs--normalize-plist (irregular-pl)
  "Convert IRREGULAR-PL to a normal plist.

\(fn '(:prop 1 2 3))
=> (:prop (progn 1 2 3))"
  (let ((normal-pl))
    (irregular-plist-mapc
     (lambda (key &rest vals)
       (let ((new-pl
              (pcase vals
                ((or `nil `((progn))) `(,@normal-pl ,key nil))
                (`((. ,_))            `(,@normal-pl ,key ,(car vals)))
                (_                    `(,@normal-pl ,key (progn ,@vals))))))
         (when new-pl (setq normal-pl new-pl))))
     irregular-pl)
    normal-pl))

应该把这个也整合到包里面去,之前咋就没想到。

EDIT: 上边这个 normalize 的输出结果形式是符合我配置的写法。不过既然有了 -mapc,感觉一个通用的 -normalize 不是很有必要。

或许可以叫flat-plist?

ps: readme里有个地方get写成了gut

pps:为什么多个progn?

(fn '(:prop 1 2 3)) => (:prop (progn 1 2 3))

曾经一度考虑过这个名称:给 ~/.emacs.d 增加 lock 文件

已更正

为了方便写在配置的时候展开生成函数 body,当时也没多想。现在已经改过并整合到包里了。

我走了不一样的路线,毕竟维护一个单独的最小配置还是有些麻烦。我在init.el里加载配置文件的时候,会用condition-case包起来,这样即使一个文件报错也不会影响加载其他配置文件,加载完成后还是有大部分的功能。

(defun luna-safe-load (file &rest args)
  "Load FILE and don’t error out.
If FILE doesn’t exist, create it.
ARGS is as same as in `load'."
  (if (file-exists-p file)
      (condition-case err
          (apply #'load file args)
        ((debug error) (warn "Error when loading %s: %s" file
                             (error-message-string err))))
    ;; Create file.
    (write-region "" nil file)))

或者也可以用with-demoted-errors

(let ((eval-expression-debug-on-error nil)
      (debug-on-error nil))
  (with-demoted-errors "Error when loading: %s"
    (error "oops")))
;; prints: Error when loading: (error oops)