1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

;; -*- Emacs-Lisp -*-

;; Time-stamp: <2010-04-17 20:42:39 Saturday by ahei>

;; 使用
;; (require 'find-symbol)
;; (dolist (map (list emacs-lisp-mode-map lisp-interaction-mode-map completion-list-mode-map help-mode-map))
;;   (define-key map (kbd "C-c .") 'find-symbol-at-point)
;;   (define-key map (kbd "C-c ,") 'find-symbol-go-back)
;;   (define-key map (kbd "C-c V") 'find-symbol-var-at-point)
;;   (define-key map (kbd "C-c F") 'find-symbol-fun-at-point)
;;   (define-key map (kbd "C-c S") 'find-symbol-face-at-point))
;; (define-key global-map (kbd "C-x .") 'find-symbol)
;; (define-key global-map (kbd "C-x K") 'find-symbol-fun-on-key)

(require 'find-func)
(require 'describe-symbol)

;; 可以使用recent-jump,这样就可以把`fs-is-record-point'设为nil了
(defvar fs-is-record-point t "是否记录`find-symbol'到过的位置")
(defvar fs-point-ring nil "存放`find-symbol'到过的位置的环")
(defvar fs-point-ring-size 200 "The size of ring `fs-point-ring'")
(defvar fs-last-symbol 0 "`find-symbol'最后查看的symbol")

;;;###autoload
(defun fs-push-point ()
  (if (eq (length fs-point-ring) fs-point-ring-size)
      (setq fs-point-ring (but fs-point-ring)))
  (let ((file (buffer-file-name)) element)
    (if file
        (setq element (list file -1 (point)))
      (setq element (list -1 (current-buffer) (point))))
    (push element fs-point-ring)))

;;;###autoload
(defun fs-pop-point ()
  (let ((val (pop fs-point-ring)))
    (if (not val)
        (message "reach buttom of ring")
      (let ((file (car val)) (buffer (nth 1 val)))
        (if (integerp file)
            (progn
              (assert (not (integerp buffer)))
              (switch-to-buffer buffer))
          (find-file file))
        (goto-char (nth 2 val))))))

;;;###autoload
(defun find-symbol (symbol)
  "查看symbol SYMBOL的源码"
  (interactive
   (let* ((def-symbol (valid-symbol-at-point)) (input "") second have-default)
     (setq have-default (symbolp def-symbol))
     (unless have-default
       (setq have-default (symbolp fs-last-symbol))
       (setq def-symbol fs-last-symbol))
     (while (string= input "")
       (setq input
             (completing-read
              (if have-default (format "待查看源码的symbol(缺省为%s): " def-symbol) "待查看源码的symbol: ")
              obarray 'valid-symbol-p t nil nil (if have-default (symbol-name def-symbol)))))
     (list (intern-soft input))))
  (setq fs-last-symbol symbol)
  (if fs-is-record-point (fs-push-point))
  (describe-symbol symbol t))

;;;###autoload
(defun find-symbol-at-point ()
  "对当前单词进行`find-symbol'"
  (interactive)
  (let ((word (current-word)) (symbol (valid-symbol-at-point)))
    (if (not (symbolp symbol))
        (cond
         ((equal symbol 0) (message "当前光标下无单词"))
         ((equal symbol 1) (message "`%s'不是symbol" word))
         ((equal symbol 2) (message "`%s'不是有效的symbol" word)))
      (if fs-is-record-point (fs-push-point))
      (describe-symbol symbol t))))

;;;###autoload
(defun find-symbol-fun-at-point ()
  "对当前单词进行`find-function'"
  (interactive)
  (let ((word (current-word)) (symbol (valid-symbol-at-point 'fboundp)))
    (if (not (symbolp symbol))
        (cond
         ((equal symbol 0) (message "当前光标下无单词"))
         ((equal symbol 1) (message "`%s'不是symbol" word))
         ((equal symbol 2) (message "`%s'不是function" word)))
      (if fs-is-record-point (fs-push-point))
      (find-function symbol))))

;;;###autoload
(defun find-symbol-var-at-point ()
  "对当前单词进行`find-variable'"
  (interactive)
  (let ((word (current-word)) (symbol (valid-symbol-at-point 'boundp)))
    (if (not (symbolp symbol))
        (cond
         ((equal symbol 0) (message "当前光标下无单词"))
         ((equal symbol 1) (message "`%s'不是symbol" word))
         ((equal symbol 2) (message "`%s'不是variable" word)))
      (if fs-is-record-point (fs-push-point))
      (find-variable symbol))))

;;;###autoload
(defun find-symbol-face-at-point ()
  "对当前单词进行`find-face'"
  (interactive)
  (let ((word (current-word)) (symbol (valid-symbol-at-point 'facep)))
    (if (not (symbolp symbol))
        (cond
         ((equal symbol 0) (message "当前光标下无单词"))
         ((equal symbol 1) (message "`%s'不是symbol" word))
         ((equal symbol 2) (message "`%s'不是face" word)))
      (if fs-is-record-point (fs-push-point))
      (find-face-definition symbol))))

;;;###autoload
(defun find-symbol-go-back ()
  (interactive)
  (fs-pop-point))

;;;###autoload
(defun find-symbol-fun-on-key (key)
  "跳到按键KEY对应的命令的源码处"
  (interactive "kFind command on key: ")
  (let ((bind (key-binding key)) (key-desc (key-description key)))
    (if (or (null bind) (integerp bind))
        (message "没有任何命令绑定在按键`%s'上" key-desc)
      (if (consp bind)
          (message "按键`%s'运行`%s'" key-desc (prin1-to-string bind))
        (if fs-is-record-point (fs-push-point))
        (describe-symbol bind t)))))

(require 'post-command-hook)

(dolist (command '(find-symbol find-symbol-at-point find-symbol-fun-at-point
                               find-symbol-var-at-point find-symbol-face-at-point
                               find-symbol-fun-on-key))
  (add-to-list 'commands-with-recenter command))

(provide 'find-symbol)