Emacs Lisp

https://github.com/kd-collective/emacs/blob/30cf1f34c583d6ed16bdc5b9578370f30c95fe1b/src/callint.c#L37

(defun interactive-test (select)
  (interactive '("test"))
  (insert select))

(define-symbol-prop 'test-symbol 'test-group '(1 2 3))

(get 'test-symbol 'test-group)

https://github.com/kd-collective/emacs/blob/30cf1f34c583d6ed16bdc5b9578370f30c95fe1b/lisp/emacs-lisp/byte-run.el#L401-L442

(defmacro cask--shut-up-unless-debug (&rest body)
  "The shut-up module is singularly designed to defeat *every*
 attempt at making your elisp package tractable."
  (declare (indent defun))
  `(if debug-on-error
       (cl-flet ((shut-up-current-output () (ignore)))
         ,@body)
     (shut-up ,@body)))

https://github.com/cask/cask/blob/bc168a11d7881a62657cdf19bab2e7966033ec2c/test/cask-cli-test.el#L48-L58

https://github.com/kd-collective/org-roam/blob/abe63b436035049923ae96639b9b856697047779/org-roam-node.el#L454-L458

major-mode

(format-spec
     magit-buffer-name-format ;; "%x%M%v: %t%x"
     `((?m . ,m)
       (?M . ,(if (eq mode 'magit-status-mode) "magit" m))
       (?v . ,(or v ""))
       (?V . ,(if v (concat " " v) ""))
       (?t . ,n)
       (?x . ,(if magit-uniquify-buffer-names "" "*"))
       (?T . ,(if magit-uniquify-buffer-names n (concat n "*")))))

(defun ace-link-info ()
  "Open a visible link in an `Info-mode' buffer."
  (interactive)
  (let ((pt (avy-with ace-link-info
              (avy-process
               (mapcar #'cdr
                       (ace-link--info-collect))
               (avy--style-fn avy-style)))))
    (ace-link--info-action pt)))

(defun ace-link--info-action (pt)
  (when (numberp pt)
    (push-mark)
    (goto-char pt)
    (let ((we (window-end)))
      (while (not (ignore-errors
                    (Info-follow-nearest-node)))
        (forward-char 1)
        (when (> (point) we)
          (error "Could not follow link"))))))

(declare-function Info-follow-nearest-node "info")
(declare-function Info-next-reference "info")
(declare-function Info-try-follow-nearest-node "info")
(declare-function Info-goto-node "info")

(defun ace-link--info-current ()
  "Return the node at point."
  (cons (cl-letf (((symbol-function #'Info-goto-node)
                   (lambda (node _) node))
                  (browse-url-browser-function
                   (lambda (url &rest _) url)))
          (Info-try-follow-nearest-node))
        (point)))

(defun ace-link--info-collect ()
  "Collect the positions of visible links in the current `Info-mode' buffer."
  (let ((end (window-end))
        points)
    (save-excursion
      (goto-char (window-start))
      (when (ignore-errors (Info-next-reference) t)
        (push (ace-link--info-current) points)
        (Info-next-reference)
        (while (and (< (point) end)
                    (> (point) (cdar points)))
          (push (ace-link--info-current) points)
          (Info-next-reference))
        (nreverse points)))))

(defun all-the-icons--data-name (name)
  "Get the symbol for an icon family function for icon set NAME."
  (intern (concat "all-the-icons-" (downcase (symbol-name name)) "-data")))

(funcall (all-the-icons--data-name family))

Function: mapcar function sequence

この関数は、sequence の各要素に function を適用(訳注：apply)し、その結果のリストを返します。sequence が nil で終るリストでない場合、エラーになります。

(mapcar (function car) '((a b) (c d) (e f)))
=> (a c e)

(let ((pt (avy-with ace-link-custom
            (avy-process
             (ace-link--custom-collect) ; 元バッファからリンクを収集して((名前1 . 位置1) (名前2 . 位置2)...)リストにする
             (avy--style-fn avy-style))))) ; リンク文字を表示して操作を待つ。
  (ace-link--custom-action pt)) ; アクション

(defcustom devdocs-alist
  '((c-mode           . "c")
    (c++-mode         . "c++")
    (clojure-mode     . "clojure")
    (coffee-mode      . "CoffeeScript")
    (common-lisp-mode . "lisp")
    (cperl-mode       . "perl")
    (css-mode         . "css")
    (elixir-mode      . "elixir")
    (enh-ruby-mode    . "ruby")
    (erlang-mode      . "erlang")
    (gfm-mode         . "markdown")
    (go-mode          . "go")
    (groovy-mode      . "groovy")
    (haskell-mode     . "haskell")
    (html-mode        . "html")
    (java-mode        . "java")
    (js2-mode         . "javascript")
    (js3-mode         . "javascript")
    (less-css-mode    . "less")
    (lua-mode         . "lua")
    (markdown-mode    . "markdown")
    (perl-mode        . "perl")
    (php-mode         . "php")
    (processing-mode  . "processing")
    (puppet-mode      . "puppet")
    (python-mode      . "python")
    (ruby-mode        . "ruby")
    (sass-mode        . "sass")
    (scala-mode       . "scala")
    (tcl-mode         . "tcl"))
  "Alist which maps major modes to names of DevDocs documentations."
  :type '(repeat (cons (symbol :tag "Major mode")
                       (string :tag "DevDocs documentation")))
  :group 'devdocs)

(defcustom devdocs-build-search-pattern-function
  'devdocs-build-search-pattern-function
  "A function to be called by `devdocs-search'.
It builds search pattern base on some context."
  :type 'function
  :group 'devdocs)

(cl-defun eshell-git-prompt--git-root-dir
    (&optional (directory default-directory))
  "Return Git root directory name if exist, otherwise, return nil."
  (let ((root (locate-dominating-file directory ".git")))
    (and root (file-name-as-directory root))))

(defun eshell-git-prompt-last-command-status ()
  "Return Eshell last command execution status.
When Eshell just launches, `eshell-last-command-status' is not defined yet,
return 0 (i.e., success)."
  (if (not (boundp 'eshell-last-command-status))
      0
    eshell-last-command-status))

https://github.com/kijimaD/emacs/blob/master/lisp/emacs-lisp/ring.el#L48-L52

(type-of 42)
=>integer
(type-of 3.14)
=> float
(type-of "foo")
=> string
(type-of '(1 2))
=> cons
(type-of '[1 2])
=> vector
(type-of 'foo)
=> symbol
(type-of ?a)  ; Cの'a'相当。内部的には数値
=> integer

// lisp.h
struct Lisp_Symbol
{
  struct Lisp_String *name;  => "foo"
    Lisp_Object value;  => "FOO"の値を持つ文字列オブジェクトを指す
    Lisp_Object function;  => 空
    略
    };

(symbolp 'foo)    ; シンボルか否かの判定。tが真。nilが偽。(後述)
=> t
(symbol-name 'foo)
=> "foo"
(symbol-value 'foo)
=> "FOO"
(boundp 'foo)   ; 値セルに値があればt、なければnil
=> t
(fboundp 'foo)  ; 関数セルに関数があればt、なければnil
=> nil
(symbol-function 'foo)
                                        ; まだ設定していないので、今はエラー

(type-of 'foo)
=> symbol
(type-of foo)
=> string   ; 評価後、つまり値セルの指すオブジェクトの型が出力されます

struct Lisp_Cons
{
  union
  {
    struct
    {
      /* Car of this cons cell.  */
      Lisp_Object car;

      union
      {
        /* Cdr of this cons cell.  */
        Lisp_Object cdr;

        /* Used to chain conses on a free list.  */
        struct Lisp_Cons *chain;
      } u;
    } s;
    GCALIGNED_UNION_MEMBER
  } u;
};

struct Lisp_Cons
{
  Lisp_Object car;  => "foo"文字列オブジェクトを指す
    Lisp_Object cdr;  => "bar"文字列オブジェクトを指す
    };

(cons "foo" "bar")
=> ("foo" . "bar")

(car '("foo" . "bar"))
=> "foo"
(cdr '("foo" . "bar"))
=> "bar"

(setq foo '("foo" . 42))  ; carに文字列、cdrに数値のコンスセルを指すシンボルfoo
=> ("foo" . 42)
(setq bar '(foo . foo))   ; quoteは全体に効いているので、carとcdrの両方がシンボルfoo
=> (foo . foo)
(symbol-value (car bar))
=> ("foo" . 42)
(symbol-value (cdr bar))
=> ("foo" . 42)
(setq bar `(,foo . foo))  ; backquoteの例
=> (("foo" . 42) . foo)   ; ,のついたオブジェクトは評価。そうでないオブジェクトは未評価

(cons "foo" '("bar" . "baz"))
=> ("foo" "bar" . "baz")

'("foo" . ("bar" . "baz"))
;; => ("foo" "bar" . "baz")

(cons "foo" '("bar" . nil))
;; => ("foo" "bar")

(cons "foo" '("bar" . "aaa"))
("foo" "bar" . "aaa")

(car '("foo" "bar" "baz"))
=> "foo"
(cdr '("foo" "bar" "baz"))
=> ("bar" "baz")
(cdr (cdr '("foo" "bar" "baz")))
=> ("baz")    ; dotted pair notationで書けば ("baz" . nil)
(cdr (cdr (cdr '("foo" "bar" "baz"))))
=> nil

(setq foo "a")
(setq foo (cons "value" foo))   ; リストfooに要素をprepend
;; => ("value" . "a")
(setq foo (cons "value" foo))   ; さらにprepend
;; => ("value" "value" . "a")
(setq load-path (cons (expand-file-name "~/elisp") load-path))

(list "foo" "bar" "baz")  ; 引数を要素に持つリストを生成
=> ("foo" "bar" "baz")

(append '("foo" "bar") '("baz"))  ; 連接したリストを生成
=> ("foo" "bar" "baz")
(setq load-path (append load-path (list (expand-file-name "~/elisp"))))

(car (nthcdr 1 '("foo" "bar" "baz")))   ; N番目の要素の取得
=> "bar"

(defun plus1 (n)
  (+ n 1))
=> plus1
(plus1 10)
=> 11
(defun my-plus (m n)
  (+ m n))
=> my-plus
(my-plus 2 5)
=> 7

// lisp.h
struct Lisp_Symbol
{
  struct Lisp_String *name;  => "foo"
    Lisp_Object value;  => "FOO"の値を持つ文字列オブジェクトを指す
    Lisp_Object function;  => 空
    略
    };

(defun foo () (message "a"))
(symbolp 'foo)
=> t
(symbol-name 'foo)
=> "foo"
(symbol-value 'foo)
=> error: (void-variable foo)
(symbol-function 'foo)
=> (lambda nil (message "a"))
(boundp 'foo)
=> nil
(fboundp 'foo) ; 関数定義
=> t

(symbol-function 'car)
=> #<subr car>
(symbol-function 'defun)
=> #<subr defun>
(symbol-function '+)
=> #<subr +>

(fset 'my-plus2
      '(lambda (n) (+ n 2)))   ; defunと同じ
=> (lambda (n) (+ n 2))
(my-plus2 10)
=> 12

(setq foo "foo")
=> "foo"
(fset 'foo '(lambda (s) (concat s "bar"))) ; 名前とリストの組み合わせ。どちらも未評価で渡す。
=> (lambda (s) (concat s "bar"))
(foo foo)
=> "foobar"

(lambda (引数 ...) (関数本体))

((lambda (m n) (+ m n)) 2 5)
=> 7

(defmacro lambda (&rest cdr)
  (list 'function (cons 'lambda cdr)))

                                        ; subr.el
(defun functionp (object)
  "Non-nil if OBJECT is a type of object that can be called as a function."
  (or (subrp object) (byte-code-function-p object)
      (eq (car-safe object) 'lambda)
      (and (symbolp object) (fboundp object))))

(my-plus 1 3)   ; シンボルであれば関数セルの指す関数を呼び出す
=> 4
((lambda (m n) (+ m n)) 1 3)   ; シンボルlambdaで始まるリストも「関数」
=> 4

(funcall 'my-plus 1 3)
=> 4
(funcall '(lambda (m n) (+ m n)) 1 3)
=> 4

(funcall '(lambda () (+ 1 2)))
(if (eq 1 (+ 1)) 1) ; 1
(if (eq 1 '(+ 1)) 1) ; nil

(+ (+ 1) 1) ; 2
(+ '(+ 1) 1) ; (wrong-type-argument number-or-marker-p (+ 1))

(setq foo '(lambda (m n) (+ m n)))
=> (lambda (m n) (+ m n))
(funcall foo 2 5)
=> 7

'(("foo" . "FOO") ("bar" . "BAR") ("baz" . "BAZ"))

// data.c
DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, "Return t if OBJECT is an array (string or vector).")
  (object)
  Lisp_Object object;
{
  if (VECTORP (object) || STRINGP (object)
      || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object))
    return Qt;
  return Qnil;
}

(arrayp '(1 2)) ; nil
(arrayp "aaa")  ; t

[1 3 5]
=> [1 3 5]
(vectorp [1 3 5])
=> t
(setq foo [1 3 5])    ; quoteしてもしなくても同じ
=> [1 3 5]
(vectorp foo)
=> t

(cons 1 (cons 2 nil))
=> (1 2)

(cons 1 2)
=> (1 . 2)

(quote (1 2))
=> (1 2)

同じ意味:
'(1 2)

(setq dog 5)
dog
=> 5   ; 評価結果
'dog
=> dog ; シンボル自身を表現する

(setq x 'dog)
(setq y 'dog)
(eq x y)
=> t
(setq z y)
(eq y z)
=> t

(setq x "dog")
(setq y "dog")
(eq x y)
=> nil ; 同じ中身の文字列だが、指しているポインタが異なるため。
(setq z y)
(eq y z)
=> t   ; 指しているポインタが同じため

(defun double (x) (* x 2))
#'double ; 関数オブジェクトを得る

#'(lambda (x) (* x 2))

(setq x #'append)

(defun double (x) (* x 2))

(setf (symbol-function 'double)
      #'(lambda (x) (* x 2)))

(+ 1 2)
(apply #'+ '(1 2))
(apply (symbol-function '+) '(1 2))
(apply #'(lambda (x y) (+ x y)) '(1 2))

(defun make-adder (n)
  #'(lambda (x) (+ x n)))

> (setq add2 (make-adder 2)
        add10 (make-adder 10))
#<Interpreted-Function BF162E>
> (funcall add2 5)
7
> (funcall add10 3)
13

(defun make-dbms (db)
  (list
   #'(lambda (key)
       (cdr (assoc key db)))
   #'(lambda (key val)
       (push (cons key val) db)
       key)
   #'(lambda (key)
       (setf db (delete key db :key #'car))
       key)))

(defun our-length (lst)
  (if (null lst)
      0
    (1+ (our-length (cdr lst)))))

(defun our-find-if (fn lst)
  (if (funcall fn (car lst))
      (car lst)
    (our-find-if fn (cdr lst))))

(defun 1st (exp) (car exp))
(defun 2nd (exp) (car (cdr exp)))
(defun 3rd (exp) (car (cdr (cdr exp))))

(setq order-func1 '((OP . 2nd) (ARG1 . 1st) (ARG2 . 3rd)))
(setq order-func2 '((OP . 1st) (ARG1 . 2nd) (ARG2 . 3rd)))

(defun order-func (sym odr-db)
  (cdr (assq sym odr-db)))

(defun op (exp order-db)
  (funcall (order-func 'OP order-db) exp))
(defun arg1 (exp order-db)
  (funcall (order-func 'ARG1 order-db) exp))
(defun arg2 (exp order-db)
  (funcall (order-func 'ARG2 order-db) exp))

(setq op-func1 '((+ . +) (- . -) (* . *)))
(setq op-func2 '((add . +) (sub . -) (mul . *)))

(defun op-func (sym op-db)
  (cdr (assq sym op-db)))

(defun calc (exp op-db odr-db)
  (cond
   ((atom exp) exp)
   (t (funcall
       (op-func (op exp odr-db) op-db)
       (calc (arg1 exp odr-db) op-db odr-db)
       (calc (arg2 exp odr-db) op-db odr-db)))))

(calc '(1 + (2 * 3)) op-func1 order-func1)
(calc '(add 1 (mul 2 3)) op-func2 order-func2)

> (multiple-value-bind (int frac) (truncate 26.21875)
    (list int frac))
(26 0.21875)

(defun fun (x)
  (list 'a (expt (car x) 2)))

(defun imp (x)
  (let (y sqr)
    (setq y (car x))
    (setq sqr (expt y 2))
    (list 'a sqr)))

(defun find-books (towns)
  (if (null towns)
      nil
    (let ((shops (bookshops (car towns))))
      (if shops
          (values (car towns) shops)
        (find-books (cdr towns))))))

(defun find2 (fn lst)
  (if (null lst)
      nil
    (let ((val (funcall fn (car lst))))
      (if val
          (values (car lst) val)
        (find2 fn (cdr lst))))))

> (filter #'(lambda (x) (if (numberp x) (1+ x)))
          '(a 1 2 b 3 c d 4))
(2 3 4 5)

(defun longer (x y)
  (labels ((compare (x y)
                    (and (consp x)
                         (or (null y)
                             (compare (cdr x) (cdr y))))))
    (if (and (listp x) (listp y))
        (compare x y)
      (> (length x) (length y)))))

(defun filter (fn lst)
  (let ((acc nil))
    (dolist (x lst)
      (let ((val (funcall fn x)))
        (if val (push val acc))))
    (nreverse acc)))

(defun group (source n)
  (if (zerop n) (error "zero length"))
  (labels ((rec (source acc)
                (let ((rest (nthcdr n source)))
                  (if (consp rest)
                      (rec rest (cons (subseq source 0 n) acc))
                    (nreverse (cons source acc))))))
    (if source (rec source nil) nil)))

> (split-if #'(lambda (x) (> x 4))
            '(1 2 3 4 5 6 7 8 9 10))
(1 2 3 4)
(5 6 7 8 9 10)

(defun mapa-b (fn a b &optional (step 1)
                  (map-> fn
                         a
                         #'(lambda (x) (> x b))
                         #'(lambda (x) (+ x step)))

(defun map-> (fn start test-fn succ-fn)
  (do ((i start (funcall succ-fn i))
       (result nil))
      ((funcall test-fn i) (nreverse result))
    (push (funcall fn i) result)))

(defun joiner (obj)
  (typecase obj
    (cons #'append)
    (number #'+)))

(defun complement (fn)
  #'(lambda (&rest args) (not (apply fn args))))
> (remove-if (complement #'oddp) '(1 2 3 4 5 6))
(1 3 5)

(--map (* 10 it) '(1 2 3 4 5))

(seq-some 'oddp '(1 2 3 4))

(seq-some 'oddp '(2 4))

(macroexp-progn '(1
                  2
                  3
                  (* 2 2)))

(eval (macroexp-progn '(1
                        2
                        3
                        (* 2 2))))

(--some (evenp it) '(2 4))  ;; => t
(--some (evenp it) '(1 3)) ;; => nil
(--some (evenp it) '(1 3 2)) ;; => t

(defmacro --some (form list)
  "Return non-nil if FORM evals to non-nil for at least one item in LIST.
If so, return the first such result of FORM.
Each element of LIST in turn is bound to `it' and its index
within LIST to `it-index' before evaluating FORM.
This is the anaphoric counterpart to `-some'."
  (declare (debug (form form)))
  (let ((n (make-symbol "needle")))
    `(let (,n)
       (--each-while ,list (not (setq ,n ,form)))
       ,n)))

(apropos "apply-partially")

(defun my-apply-partially (fun &rest args)
  (lambda (&rest args2)
    (apply fun (append args args2))))

(magit-blame-mode
 (when (called-interactively-p 'any)
   (setq magit-blame-mode nil)
   (user-error
    (concat "Don't call `magit-blame-mode' directly; "
            "instead use `magit-blame'"))))

(apropos "declare")

(declare (indent 2))

(let ((nums '(1 2 3 4 5))
      (sum 0))
      (dolist (num nums)
            (setq sum (+ sum num)))
      sum)

(setq my-format "%h:%m")
(defun my-format-time (hour minute)
  (format-spec my-format
               `((?h . ,hour)
                 (?m . ,minute))))

(my-format-time 12 59)

(line-number-at-pos)

(looking-at ".")

(apropos "open-line")

(open-line 1)

(let ((l '(a b c)))
  (push 'new l))

(user-error "this is error!")

(apropos "with-demoted-errors")

(with-demoted-errors "これはエラー %S" (/ 1 0))