[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
aliator.el
From: |
Andreas Roehler |
Subject: |
aliator.el |
Date: |
Thu, 25 May 2006 17:07:43 +0200 |
User-agent: |
KNode/0.9.2 |
;;; aliator.el ---
;; Copyright (C) 2006 Andreas Roehler
;; Author: Andreas Roehler <address@hidden>
;; Keywords: convenience, docs
;; This file is free software; you can redistribute it and/or
modify
;; it under the terms of the GNU General Public License as
published by
;; the Free Software Foundation; either version 2, or (at your
option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public
License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Defines aliases from given command prefix names, in
;; order to enable listing of the (now) expanded names
;; together with the others (more regular named, ie
;; starting with the mode-name).
;; Example for the created list of aliases:
;;
;; (defalias 'outline-hide-entry' hide-entry)
;; (defalias 'outline-show-entry' show-entry)
;; Edit `newalias-list' according to your needs (all
;; four slots are necessary)
;; ToDo: Provide customization facility and menu
;; FixMe: Probably all the stuff might be better
;; written in order to enhance usability, ease
;; maintenance etc. Please send your suggestions. Is
;; the name ok in English? Dangers anticipated?
;;; Code:
(defvar newalias-list
(list
"~/emacs/lisp/outline.el" "outline" nil nil
;; "~/progarbeit/emacs/test-mode.el" "xml" "html" nil
"~/emacs/lisp/abbrev.el" "abbrev" nil nil
"~/emacs/lisp/find-dired.el" "dired" nil nil
"~/emacs/lisp/textmodes/sgml-mode.el" "xml" "html" t
)
"A list of files to process in order to get aliases.
Edit the list according to your needs. It has the following form:
\"file to process\" \"prefix\" \"no-alias\" \"replace-prefix\"
where \n`prefix' indicates the new name-prefix where from
expansion will work, \n`no-alias' the exception, where no alias
should be defined - i.e. functions start with `html-' in
sgml-mode.el - and \n`replace-prefix' cases where it seems
appropriate to provide an `alias' replacing the first part of
the function-name concerned, as `xml-' instead of `sgml-'"
)
;; to change `newalias-list', as `defvar'
;; just once reads it in
(setq newalias-list
(list
"~/emacs/lisp/outline.el" "outline" nil nil
;; "~/progarbeit/emacs/test-mode.el" "xml" "html" nil
"~/emacs/lisp/abbrev.el" "abbrev" nil nil
"~/emacs/lisp/find-dired.el" "dired" nil nil
"~/emacs/lisp/textmodes/sgml-mode.el" "xml" "html" t))
(defun aliator (&optional arg)
"Provides an `alias' following a given PREFIX.
Works at function names not starting already with that prefix.
In order to normalizes commands as `M-x mode-name- TAB' - now
lists all functions available, even if they don't start with
that PREFIX originally"
(interactive "P")
(when arg
(setq new-list
(list (read-from-minibuffer "File name: ")
(read-from-minibuffer "Prefix: ")))
(setcar new-list (progn
(string-match (concat "\\`" "\\s-*"
"\\(.*?\\)"
"\\s-*\n?"
"\\'") (car new-list))
(match-string 1 (car new-list))))
(if (and (not (string= "" (car new-list)))
(not (string= "" (cadr new-list))))
(setq newalias-list new-list)
(error "Error: no file or prefix found %s " new-list)))
(set-buffer (get-buffer-create "neualias"))
(switch-to-buffer (current-buffer))
(erase-buffer)
(let ((newalias-list newalias-list))
(while newalias-list
(setq file (car newalias-list) prefix (cadr newalias-list)
no-alias (car (nthcdr 2 newalias-list)) replace-prefix (car
(nthcdr 3 newalias-list)))
(message "%s %s" no-alias replace-prefix)
(find-file file)
(goto-char (point-min))
(setq old-buf (current-buffer))
(eval-buffer)
;; old fork to get the prefix from mode-name
;; (let ((prefix (substring arg 0 (string-match "-"
arg))))
(while (re-search-forward "(defun \\([A-Za-z0-9\-]+\\)" nil
t 1)
(let ((akt-fn (match-string 1))
(fn-first-part (substring (match-string 1) 0 (string-match
"-" (match-string 1)))))
;; if the function name already starts with the
;; wished name or `no-alias' is set, do nothing
(unless (or (string= fn-first-part prefix)
(string= fn-first-part no-alias))
;; avoid repeats in names as dired-look-dired
(if replace-prefix
(setq neualias (concat prefix (substring akt-fn (string-match
"-" akt-fn))))
(let*
((alt-alias (split-string akt-fn "-"))
(alias-ohne-neualias (remove prefix alt-alias))
(alias-ohne-doppel (delete-dups alias-ohne-neualias))
alias-verkettet)
(dolist (teil alias-ohne-doppel)
(setq alias-verkettet (concat alias-verkettet "-"(format "%s"
teil))))
(setq neualias (concat prefix alias-verkettet))))
(if (functionp neualias)
(message "Bereits als Funktion vorhanden; %s")
(save-excursion
(set-buffer "neualias")
(switch-to-buffer (current-buffer))
(insert "(defalias '"neualias "'\t"akt-fn")""\n"))
(switch-to-buffer old-buf)))))
(kill-buffer (current-buffer))
(setq newalias-list (nthcdr 4 newalias-list)))
(switch-to-buffer "neualias")
(message "%s" "`M-x eval-buffer' to install these aliases")))
(provide 'aliator)
;;; aliator.el ends here
- aliator.el,
Andreas Roehler <=