- 论坛徽章:
- 0
|
version: 0.3
自己完成了点emacs的小功能
1：自动的添加本地变量的定义，不需要在编写函数的时候从函数的一个地方跳到函数的开始部分然后在跳回来。
2：自动的添加头包含
3：窗口漂移，buffer漂移，非常实用
4：触发窗口最大化，非常实用（有点bug，不影响正常使用，修补中）
5：一键插入if for while等block。
注释：非常感谢楼下的支持。这是这个程序的第二版本，让程序更具有函数式的风格，我刚开始学习emacs和lisp，其中的设计风格不怎么好，希望大家多指正。完全不是谦虚：感谢有lisp这门语言。
关于解释器：我用的开发环境比较混乱elisp, slime, clisp, emacs-lisp，可能有的代码在别的emacs中不能执行，但是我敢肯定在emacs23/gentoo 中绝对可以使用。
;; toggle max window.
(setq window-min-heigh 1)
(setq window-min-width 1)
(setf (symbol-function 'toggle-window-max)
(lexical-let ((toggle-done nil)
(increament-width 0)
(increament-height 0))
(lambda ()
(interactive)
(if toggle-done
(progn
(shrink-window increament-height)
(shrink-window-horizontally increament-width)
(setf increament-height 0)
(setf increament-width 0)
(setf toggle-done (not toggle-done)))
(progn
(setf increament-width (- (frame-width) (window-width) (+ window-min-width 2)))
(setf increament-height (- (frame-height) (window-height) (+ window-min-height 2)))
(setf toggle-done (not toggle-done))
(enlarge-window-horizontally increament-width)
(enlarge-window increament-height))))))
(global-set-key (kbd "M-l") 'toggle-window-max)
;; end toggle max window.
;; fly in buffers.
(setq *toggle-fly-all-buffers* nil)
(defun toggle-fly-all-buffers ()
(interactive)
(setq *toggle-fly-all-buffers* (not *toggle-fly-all-buffers*)))
(defconst +common-system-buffers+ '("*shell*" "*Message*" "*slime-repl clisp*" "*scratch*" "terminal"))
(defun user-bufferp (buffer)
(if (not (string-match "^[[:space:]]*?\\*.*?\\*[[:space:]]*$" (buffer-name buffer)))
t))
(defun all-bufferp (buffer)
(if (or (member (buffer-name buffer) +common-system-buffers+)
(user-bufferp buffer))
t))
(defun %get-all-buffers% (buffers)
(remove-if-not #'all-bufferp buffers))
(defun %get-user-buffers% (buffers)
(remove-if-not #'user-bufferp buffers))
(defun get-all-buffers (all)
(interactive)
(if all (funcall #'%get-all-buffers% (buffer-list))
(funcall #'%get-user-buffers% (buffer-list))))
(defun switch-buffer-to-current-window (&optional buffer)
(if (not buffer) (return))
(bury-buffer (buffer-name (current-buffer)))
(switch-to-buffer (buffer-name buffer)))
(defun fly-in-buffers ()
(interactive)
(switch-buffer-to-current-window
(car (remove (current-buffer) (get-all-buffers *toggle-fly-all-buffers*)))))
(global-set-key (kbd "M-q") 'fly-in-buffers)
;; end fly in buffers.
(defun fly-in-windows ()
(interactive)
(other-window 1))
(global-set-key (kbd "M-j") 'fly-in-windows)
;; newline.
(defun add-newline ()
(interactive)
(move-end-of-line 1)
(newline-and-indent)
)
(global-set-key "\M-o" 'add-newline)
;; prev newline.
(global-set-key (kbd "M-i") 'upto-create-newline)
(defun upto-add-newline ()
(interactive)
(previous-line 1)
(add-newline)
)
(defun find-next-blank-line ()
(loop
while (split-string (thing-at-point 'line) split-string-default-separators t)
do (next-line)))
(defun goto-first-blank-line ()
(goto-char (point-min))
(find-next-blank-line))
(defun c-goto-function-first-blank-line ()
(interactive)
(c-beginning-of-defun)
(find-next-blank-line))
(defun c-prompt-function (prompt func)
(let ((variable (read-string prompt)))
(multiple-value-bind (start end)
(values (string-match "\\w.*\\w[[:space:]]*$" variable) (match-end 0))
(if (> (length (substring variable start end)) 0)
(funcall func (substring variable start end))))))
(defun c-insert-control ()
(insert "(")
(save-excursion
(insert ")")
(add-newline)
(insert "{")
(add-newline)
(insert "}")
(indent-for-tab-command)
(upto-add-newline)))
;; insert variable.
(defun %c-insert-statement-variable% (variable)
(save-excursion
(c-goto-function-first-blank-line)
(c-indent-line-or-region)
(insert (format "%s;\n" (substring variable start end)))))
(defun c-insert-statement-variable ()
(c-prompt-function "variable define: " '%c-insert-statement-variable%))
;; end insert variable
;; insert header file.
(defconst +c-common-header+ "stdio stdlib string unistd sys/types errno")
(defun c-insert-statement-header ()
(c-prompt-function "header files: " '%c-insert-statement-header%))
(defun %c-insert-statement-header% (header-files)
(save-excursion
(goto-first-blank-line)
(mapcar (lambda (header-file) (insert (format "#include <%s.h>\n" header-file)))
(split-string header-files split-string-default-separators t))))
(defun c-insert-common-header-files ()
(interactive)
(%c-insert-statement-header% +c-common-header+))
;; end insert header file.
;; insert control
(defconst +c-statement-control+ '("if" "for" "while"))
(defconst +c-statement-control-prefix+ "c-insert-statement-")
(defun %c-insert-statement-control% (control)
(let ((x (read-from-string (concat +c-statement-control-prefix+ control))))
(eval `(setf (symbol-function ',(car x))
'(lambda () (progn
(add-newline)
(insert (concat ,control " "))
(c-insert-control)))))))
;; end insert control
(defun c-insert-statement-setup ()
(interactive)
(mapcar #'(lambda (control) (%c-insert-statement-control% control)) +c-statement-control+)
(define-prefix-command 'c-insert-statement-map)
(local-set-key "\M-u" 'c-insert-statement-map)
(local-set-key "\M-ui" (lambda () (interactive) (c-insert-statement 'if)))
(local-set-key "\M-uf" (lambda () (interactive) (c-insert-statement 'for)))
(local-set-key "\M-uw" (lambda () (interactive) (c-insert-statement 'while)))
(local-set-key "\M-uv" (lambda () (interactive) (c-insert-statement 'variable)))
(local-set-key "\M-uh" (lambda () (interactive) (c-insert-statement 'header))))
(defconst c-insert-statement-category
'((if . c-insert-statement-if)
(while . c-insert-statement-while)
(header . c-insert-statement-header)
(variable . c-insert-statement-variable)
(for . c-insert-statement-for)))
(defun c-insert-statement (category)
(let ((pair (assoc category c-insert-statement-category)))
(when pair (funcall (cdr pair)))))
[ 本帖最后由 wojiaohesen 于 2009-11-9 13:26 编辑 ] |
|
免费注册
发表于 2009-10-19 09:06
