future-proof against obsoleting of `flet'

flet will be marked obsolete starting in Emacs 24.3
This commit is contained in:
Roland Walker 2012-11-05 11:09:25 -05:00
parent 42ed181f4a
commit 32e56098fb

View File

@ -136,6 +136,12 @@
(require 'easymenu) (require 'easymenu)
(require 'help-mode) (require 'help-mode)
(eval-and-compile
(unless (fboundp 'cl-flet)
(defalias 'cl-flet 'flet)
(put 'cl-flet 'lisp-indent-function 1)
(put 'cl-flet 'edebug-form-spec '((&rest (defun*)) cl-declarations body))))
;;; User customizable variables ;;; User customizable variables
@ -1843,48 +1849,48 @@ foo\"bar\\! -> \"foo\\\"bar\\\\!\""
This works by stubbing a few functions, then calling This works by stubbing a few functions, then calling
`yas-load-directory'." `yas-load-directory'."
(interactive "DTop level snippet directory?") (interactive "DTop level snippet directory?")
(flet ((yas--load-yas-setup-file (cl-flet ((yas--load-yas-setup-file
(file) (file)
(let ((elfile (concat file ".el"))) (let ((elfile (concat file ".el")))
(when (file-exists-p elfile) (when (file-exists-p elfile)
(insert ";;; .yas-setup.el support file if any:\n;;;\n") (insert ";;; .yas-setup.el support file if any:\n;;;\n")
(insert-file-contents elfile) (insert-file-contents elfile)
(end-of-buffer) (end-of-buffer)
))) )))
(yas-define-snippets (yas-define-snippets
(mode snippets) (mode snippets)
(insert ";;; Snippet definitions:\n;;;\n") (insert ";;; Snippet definitions:\n;;;\n")
(let ((literal-snippets (list)) (let ((literal-snippets (list))
(print-length nil)) (print-length nil))
(dolist (snippet snippets) (dolist (snippet snippets)
(let ((key (first snippet)) (let ((key (first snippet))
(template-content (second snippet)) (template-content (second snippet))
(name (third snippet)) (name (third snippet))
(condition (fourth snippet)) (condition (fourth snippet))
(group (fifth snippet)) (group (fifth snippet))
(expand-env (sixth snippet)) (expand-env (sixth snippet))
(file nil) ;; (seventh snippet)) ;; omit on purpose (file nil) ;; (seventh snippet)) ;; omit on purpose
(binding (eighth snippet)) (binding (eighth snippet))
(uuid (ninth snippet))) (uuid (ninth snippet)))
(push `(,key (push `(,key
,template-content ,template-content
,name ,name
,condition ,condition
,group ,group
,expand-env ,expand-env
,file ,file
,binding ,binding
,uuid) ,uuid)
literal-snippets))) literal-snippets)))
(insert (pp-to-string `(yas-define-snippets ',mode ',literal-snippets))) (insert (pp-to-string `(yas-define-snippets ',mode ',literal-snippets)))
(insert "\n\n"))) (insert "\n\n")))
(yas--load-directory-1 (yas--load-directory-1
(dir mode parents &rest ignore) (dir mode parents &rest ignore)
(let ((output-file (concat (file-name-as-directory dir) ".yas-compiled-snippets.el"))) (let ((output-file (concat (file-name-as-directory dir) ".yas-compiled-snippets.el")))
(with-temp-file output-file (with-temp-file output-file
(insert (format ";;; Compiled snippets and support files for `%s'\n" mode)) (insert (format ";;; Compiled snippets and support files for `%s'\n" mode))
(yas--load-directory-2 dir mode) (yas--load-directory-2 dir mode)
(insert (format ";;; Do not edit! File generated at %s\n" (current-time-string))))))) (insert (format ";;; Do not edit! File generated at %s\n" (current-time-string)))))))
(yas-load-directory top-level-dir nil))) (yas-load-directory top-level-dir nil)))
(defun yas-recompile-all () (defun yas-recompile-all ()
@ -3685,19 +3691,19 @@ Returns the newly created snippet."
This is according to their relative positions in the buffer, and This is according to their relative positions in the buffer, and
has to be called before the $-constructs are deleted." has to be called before the $-constructs are deleted."
(flet ((yas--fom-set-next-fom (fom nextfom) (cl-flet ((yas--fom-set-next-fom (fom nextfom)
(cond ((yas--field-p fom) (cond ((yas--field-p fom)
(setf (yas--field-next fom) nextfom)) (setf (yas--field-next fom) nextfom))
((yas--mirror-p fom) ((yas--mirror-p fom)
(setf (yas--mirror-next fom) nextfom)) (setf (yas--mirror-next fom) nextfom))
(t (t
(setf (yas--exit-next fom) nextfom)))) (setf (yas--exit-next fom) nextfom))))
(yas--compare-fom-begs (fom1 fom2) (yas--compare-fom-begs (fom1 fom2)
(if (= (yas--fom-start fom2) (yas--fom-start fom1)) (if (= (yas--fom-start fom2) (yas--fom-start fom1))
(yas--mirror-p fom2) (yas--mirror-p fom2)
(>= (yas--fom-start fom2) (yas--fom-start fom1)))) (>= (yas--fom-start fom2) (yas--fom-start fom1))))
(yas--link-foms (fom1 fom2) (yas--link-foms (fom1 fom2)
(yas--fom-set-next-fom fom1 fom2))) (yas--fom-set-next-fom fom1 fom2)))
;; make some yas--field, yas--mirror and yas--exit soup ;; make some yas--field, yas--mirror and yas--exit soup
(let ((soup)) (let ((soup))
(when (yas--snippet-exit snippet) (when (yas--snippet-exit snippet)