gmane.emacs.sources
http://blog.gmane.org/gmane.emacs.sources
hourly11901-01-01T00:00+00:00Gmanehttp://gmane.org/img/gmane-25t.png
http://gmane.org
highline.el v7.0
http://comments.gmane.org/gmane.emacs.sources/3078
Hi,
highline v7.0 deals with visual line, if line-move-visual is non-nil.
To download:
http://www.emacswiki.org/emacs/highline.el
Vinicius
Vinicius Jose Latorre2008-12-03T00:59:36auto-complete.el: Auto completion with popup menu
http://comments.gmane.org/gmane.emacs.sources/3077
Hi, all.
I have created a extension auto-complete.
auto-complete can show completion candidates with popup menu visually and
users can select a candidate by <up>, <down> and RET.
You can try this extension by executing
M-x auto-complete-mode and typing some characters.
Maybe it seems very good :-)
Please refer the following link if you want to get more information.
http://www.emacswiki.org/emacs/AutoComplete
Enjoy.
MATSUYAMA
_______________________________________________
gnu-emacs-sources mailing list
gnu-emacs-sources< at >gnu.org
http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources
Tomohiro MATSUYAMA2008-11-30T09:28:13whole-line-or-region
http://comments.gmane.org/gmane.emacs.sources/3071
;;; < at >(#) whole-line-or-region.el -- operate on current line if region undefined
;;; < at >(#) $Id: whole-line-or-region.el,v 1.2 2008/11/27 15:52:02 joe Exp $
;; This file is not part of Emacs
;; Copyright (C) 2001 by Joseph L. Casadonte Jr.
;; Author: Joe Casadonte (emacs< at >northbound-train.com)
;; Maintainer: Joe Casadonte (emacs< at >northbound-train.com)
;; Created: July 1, 2001
;; Keywords: kill yank cut copy paste whole lines
;; Latest Version: http://www.northbound-train.com/emacs.html
;; COPYRIGHT NOTICE
;; This program 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 program 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 this program; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;; This minor mode allows functions to operate on the current line if
;; they would normally operate on a region and region is currently
;; undefined.
;;
;; The primary use for this is to kill (cut) the current line if no
;; region is defined, and kill-region is invoked. It basically saves
;; you the effort of going to the begining of the line, selecting the
;; text up to the end of the line, and killing. Similarly, when
;; yanking, it's smart enough to know that the string to be yanked
;; was killed as a whole line, and it should be yanked as one, too.
;; So you don't need to position yourself at the start of the line
;; before yanking. If region *is* defined, though, all functions act
;; as normal.
;;
;; The inspiration for this came from an old editor I used to use
;; (brief maybe?), that did this exact thing for you. It was a handy
;; feature to have, and I definitely wanted it when I moved to Emacs.
;; I've extended the concept slightly, to let you copy N whole lines,
;; using the standard prefix method.
;;
;; NOTE: This package will behave unexpectedly (and indeed is nearly
;; useless) if `transient-mark-mode' is off, as there is then always
;; a region defined.
;;
;; NOTE: I haven't gotten this to work under XEmacs (though I
;; honestly haven't tried real hard).
;;; Usage:
;;
;; M-x `whole-line-or-region-mode'
;; Toggles whole-line-or-region-mode on & off. Optional arg turns
;; whole-line-or-region-mode on iff arg is a positive integer. Then
;; just call functions `copy-region-as-kill', `kill-region',
;; `kill-ring-save' and `yank' as you normally would.
;;
;; To turn the mode on automatically whenever Emacs starts, customize
;; `whole-line-or-region-mode' (which see).
;;; Extending Package:
;;
;; I've tried to make the base functions as generic as possible so
;; that this same concept can be used for other region-based
;; functions. The only function I've thought of to date to extend in
;; this manner is `comment-dwim'. Examples using `comment-dwim'
;; follow.
;;
;; In order to extend this package for additional region-based
;; functions, you must understand how those functions work, and write
;; a new stub function that will be used to replace it. One of two
;; whole-line-or-region functions must be called from within that
;; stub; which one to use depends on whether or not the original
;; function wants region passed into it, or assumes region is defined
;; before being called.
;;
;; Using `kill-region' as an example, looking at its definition we
;; see that it takes two arguments, BEG and END. Looking at it
;; another way, it's interactive declaration is "r", which says to
;; pass in the current region. Because of this, the stub function
;; for it should call `whole-line-or-region-call-with-region':
;;
;; (defun whole-line-or-region-kill-region (prefix)
;; "Kill region or PREFIX whole lines."
;; (interactive "*p")
;; (whole-line-or-region-call-with-region 'kill-region prefix t))
;;
;; The first argument to `whole-line-or-region-call-with-region' is
;; the function being replaced. The second is the value for prefix,
;; so that the stub can operate on more than just one line (e.g. C-u
;; 12 M-w would copy 12 whole lines). Other arguments are explained
;; in the function documentation.
;;
;; The function `comment-dwim', on the other hand, expects region to
;; be defined coming in, so its stub should call into the other
;; whole-line stub, `whole-line-or-region-call-with-prefix'. There are
;; things to consider, though. The original `comment-dwim' wants a
;; raw prefix value, but it doesn't use it to work over a variable
;; number of lines; rather it uses it to signal what DWIM really
;; does. Sort of defeats the purpose of a DWIM command, if you ask
;; me -- it should be simple enough to determine from the current
;; context what DWIMs should do. I digress, however.....
;;
;; The "proper" way to write a whole-line version of `comment-dwim'
;; would be like the following:
;;
;; (defun whole-line-or-region-comment-dwim (raw-prefix)
;; "Call `comment-dwim' on current region or current line."
;; (interactive "*P")
;; (whole-line-or-region-call-with-prefix 'comment-dwim 1 nil t raw-prefix))
;;
;; The arguments for `whole-line-or-region-call-with-prefix' are
;; basically the same as for `whole-line-or-region-call-with-region',
;; but how each of them call the original function differs. The
;; first one calls it with two arguments (i.e. region's BEG & END)
;; and the second one sets mark (i.e. defines region) and passes in
;; prefix (raw or processed, depending).
;;
;; So the above example for `comment-dwim' would call the original
;; function with the current region (if defined) or the current line
;; (the second argument, the number of lines to operate on, being
;; hard-coded to 1), also passing in the raw prefix, for use within
;; the original function. It retains its original semantics and just
;; saves you from having to mark the current line.
;;
;; It could instead be defined like so:
;;
;; (defun whole-line-or-region-comment-dwim-2 (prefix)
;; "Call `comment-dwim' on region or PREFIX whole lines."
;; (interactive "*p")
;; (whole-line-or-region-call-with-prefix 'comment-dwim prefix nil t))
;;
;; What this version does is override the normal behavior of the
;; prefix arg to `comment-dwim', and instead uses it to indicate how
;; many lines the whole-line version will comment out -- no prefix
;; value is passed to the original function in this case. This is
;; the version that I use, as it's just more intuitive for me.
;;
;; After defining the new stub, however you do it, the package needs
;; to know about it so that it can toggle its use on and off as the
;; mode toggles on and off. For that you need to customize the
;; variable `whole-line-or-region-extensions-alist', telling it the
;; original function name (`comment-dwim') and the new one
;; (`whole-line-or-region-comment-dwim-2'). If you want to limit the
;; redefinition to a specific keymap then specify that as well;
;; otherwise, the rebinding will occur in the global keymap.
;; Rebinding occurs via `substitute-key-definition' (which see).
;;; To Do:
;;
;; o Nothing, at the moment.
;;; Comments:
;;
;; Any comments, suggestions, bug reports or upgrade requests are welcome.
;; Please send them to Joe Casadonte (emacs< at >northbound-train.com).
;;
;; This version of whole-line-or-region was developed and tested with NTEmacs
;; 22.2.1 under Windows XP Pro. Please, let me know if it works with
;; other OS and versions of Emacs.
;;; Change Log:
;;
;; see http://www.northbound-train.com/emacs/whole-line-or-region.log
;;; **************************************************************************
;;; **************************************************************************
;;; **************************************************************************
;;; **************************************************************************
;;; **************************************************************************
;;; Code:
(eval-when-compile
;; silence the old byte-compiler
(defvar byte-compile-dynamic nil)
(set (make-local-variable 'byte-compile-dynamic) t))
;;; **************************************************************************
;;; ***** version related routines
;;; **************************************************************************
(defconst whole-line-or-region-version
"$Revision: 1.2 $"
"Version number for 'whole-line-or-region' package.")
;; ---------------------------------------------------------------------------
(defun whole-line-or-region-version-number ()
"Return 'whole-line-or-region' version number."
(string-match "[0123456789.]+" whole-line-or-region-version)
(match-string 0 whole-line-or-region-version))
;; ---------------------------------------------------------------------------
(defun whole-line-or-region-display-version ()
"Display 'whole-line-or-region' version."
(interactive)
(message "whole-line-or-region version <%s>." (whole-line-or-region-version-number)))
;;; **************************************************************************
;;; ***** customization
;;; **************************************************************************
(defgroup whole-line-or-region nil
"Customization group for whole-line-or-region minor mode."
:group 'editing-basics
:group 'convenience)
;; ---------------------------------------------------------------------------
(defun whole-line-or-region-customize ()
"Customization of the group 'whole-line-or-region'."
(interactive)
(customize-group "whole-line-or-region"))
;; ---------------------------------------------------------------------------
(defcustom whole-line-or-region-mode nil
"Non-nil if whole-line-or-region minor mode is enabled.
Setting this variable directly does not take effect; use either
\\[customize] or the function `whole-line-or-region-mode'."
:set (lambda (symbol value)
(whole-line-or-region-mode (or value 0)))
:initialize 'custom-initialize-default
:type 'boolean
:group 'whole-line-or-region)
;; ---------------------------------------------------------------------------
(defcustom whole-line-or-region-extensions-alist '(
(copy-region-as-kill whole-line-or-region-copy-region-as-kill nil)
(kill-region whole-line-or-region-kill-region nil)
(kill-ring-save whole-line-or-region-kill-ring-save nil)
(yank whole-line-or-region-yank nil)
)
"List of functions for whole-line-or-region to swap.
When whole-line-or-region is activated, all original functions will be
replaced with their whole-line counterparts in the global keymap,
unless the optional keymap is specified (in which case it will be
replace in that map only). Similarly, when whole-line-or-region is
de-activated, the functions will be swapped back.
The default is to map the following:
o `copy-region-as-kill' -> `whole-line-or-region-copy-region-as-kill'
o `kill-region' -> `whole-line-or-region-kill-region'
o `kill-ring-save' -> `whole-line-or-region-kill-ring-save'
o `yank' -> `whole-line-or-region-yank'
In addition, the following functions are provided by the package for
your convenience:
o `whole-line-or-region-delete'
o `whole-line-or-region-comment-dwim'
o `whole-line-or-region-comment-dwim-2'
See the individual functions for more information on what they do and
suggested mappings."
:type '(repeat
(list :tag "Function Mappings:"
(function :tag "Original Function")
(function :tag "Whole-line Version")
(variable :tag "Keymap (optional)")
))
:group 'whole-line-or-region
:set (lambda (symbol newval)
(set symbol newval)
(when whole-line-or-region-mode
(whole-line-or-region-bind-keys)))
)
;; ---------------------------------------------------------------------------
(defcustom whole-line-or-region-mode-line-string " WLR"
"String to display in mode-line when 'whole-line-or-region' is active.
Must start with a space. Changes will take effect next time emacs is
started."
:type 'string
:group 'whole-line-or-region)
;; ---------------------------------------------------------------------------
(defcustom whole-line-or-region-load-hook nil
"Hook to run when package is loaded."
:type 'hook
:group 'whole-line-or-region)
;; ---------------------------------------------------------------------------
(defcustom whole-line-or-region-on-hook nil
"Hook called when 'whole-line-or-region' mode is turned on."
:type 'hook
:group 'whole-line-or-region)
;; ---------------------------------------------------------------------------
(defcustom whole-line-or-region-off-hook nil
"Hook called when 'whole-line-or-region' mode is turned off."
:type 'hook
:group 'whole-line-or-region)
;;; **************************************************************************
;;; ***** minor mode functions
;;; **************************************************************************
; (defvar whole-line-or-region-mode nil )
;;; --------------------------------------------------------------------------
;;;###autoload
(defun whole-line-or-region-mode (&optional arg)
"Toggle use of whole-line-or-region minor mode.
This minor mode allows functions to operate on the current line if
they would normally operate on a region and region is currently
undefined.
Optional ARG turns mode on iff ARG is a positive integer."
(interactive "P")
;; toggle on and off
(let ((old-mode whole-line-or-region-mode))
(setq whole-line-or-region-mode
(if arg (or (listp arg)
(> (prefix-numeric-value arg) 0))
(not whole-line-or-region-mode)))
(when (not (equal old-mode whole-line-or-region-mode))
;; enable/disable advice
(if whole-line-or-region-mode
(whole-line-or-region-bind-keys)
(whole-line-or-region-restore-keys))
(run-hooks (if whole-line-or-region-mode
'whole-line-or-region-on-hook
'whole-line-or-region-off-hook))
)))
;; ---------------------------------------------------------------------------
;; add to minor-mode-alist if not there already
(or
(assq 'whole-line-or-region-mode minor-mode-alist)
(setq minor-mode-alist
(cons
(list 'whole-line-or-region-mode whole-line-or-region-mode-line-string)
minor-mode-alist)))
;;; **************************************************************************
;;; ***** interactive functions (used by default)
;;; **************************************************************************
;;;###autoload
(defun whole-line-or-region-copy-region-as-kill (prefix)
"Copy region or PREFIX whole lines."
(interactive "p")
(whole-line-or-region-call-with-region 'copy-region-as-kill prefix t))
;;; --------------------------------------------------------------------------
;; (defalias 'whole-line-or-region-copy 'whole-line-or-region-copy-region-as-kill)
;;; **************************************************************************
;;;###autoload
(defun whole-line-or-region-kill-region (prefix)
"Kill (cut) region or PREFIX whole lines."
(interactive "*p")
(whole-line-or-region-call-with-region 'kill-region prefix t))
;;; **************************************************************************
;;;###autoload
(defun whole-line-or-region-kill-ring-save (prefix)
"Copy region or PREFIX whole lines."
(interactive "p")
(whole-line-or-region-call-with-region 'kill-ring-save prefix t))
;;; **************************************************************************
;;;###autoload
(defun whole-line-or-region-yank (raw-prefix &optional string-in)
"Yank (paste) previously killed text.
If the text to be yanked was killed with a whole-line-or-region
function *as* a whole-line, then paste it as a whole line (i.e. do not
break up the current line, and do not force the user to move point).
RAW-PREFIX is used to determine which string to yank, just as `yank'
would normally use it.
Optionally, pass in string to be \"yanked\" via STRING-IN."
(interactive "*P")
;; figure out what yank would do normally
(let ((string-to-yank (or string-in (current-kill
(cond ((listp raw-prefix) 0)
((eq raw-prefix '-) -1)
(t (1- raw-prefix))) t)))
(saved-column (current-column)))
;; check for whole-line prop in yanked text
(if (get-text-property 0 'whole-line-or-region string-to-yank)
(let ((beg (line-beginning-position)))
;; goto beg of line and yank
(beginning-of-line)
(if string-in
;; insert "manually"
(insert string-in)
;; just yank as normal
(yank raw-prefix))
;; a whole-line killed from end of file may not have a
;; trailing newline -- add one, in these cases
(when (not (string-match "\n$" string-to-yank))
(insert "\n")
(previous-line 1))
;; restore state of being....
(move-to-column saved-column)
(remove-text-properties beg (+ beg 1) '(whole-line-or-region nil)))
;; no whole-line-or-region mark
(if string-in
;; insert "manually"
(progn
(when (and delete-selection-mode
mark-active)
(delete-active-region))
(insert string-in))
;; just yank as normal
(yank raw-prefix)))
))
;;; --------------------------------------------------------------------------
;; in case delete-selection-mode (delsel.el) is being used
(if (string-match "Emacs 21" (emacs-version))
(put 'whole-line-or-region-yank 'delete-selection 'yank)
(put 'whole-line-or-region-yank 'delete-selection t))
;;; **************************************************************************
;;; alternate interactive functions
;;; **************************************************************************
;;;###autoload
(defun whole-line-or-region-delete (prefix)
"Delete region or PREFIX whole lines."
(interactive "*p")
(whole-line-or-region-call-with-region 'delete-region prefix))
;;; **************************************************************************
;;;###autoload
(defun whole-line-or-region-comment-dwim (raw-prefix)
"Call `comment-dwim' on current region or current line.
See `comment-dwim' for details of RAW-PREFIX usage."
(interactive "*P")
(whole-line-or-region-call-with-prefix 'comment-dwim 1 nil t raw-prefix))
;;; **************************************************************************
;;;###autoload
(defun whole-line-or-region-comment-dwim-2 (prefix)
"Call `comment-dwim' on region or PREFIX whole lines."
(interactive "*p")
(whole-line-or-region-call-with-prefix 'comment-dwim prefix nil t))
;;; **************************************************************************
;;; ***** internal functions
;;; **************************************************************************
(defun whole-line-or-region-call-with-region (fn &optional cnt mark-as-whole send-prefix prefix)
"Calls FN on region or CNT whole lines.
If region is defined simply call FN, passing in the start and end of
the current region.
If region is not currently defined, then define it temporarily as the
current line. Additionally, if CNT is set, expand region to cover the
next CNT whole lines (or previous CNT whole lines, if CNT is
negative). Before FN is called, mark the temporary region with a
special property if MARK-AS-WHOLE is non-nil (this is useful if the
text could be worked on with some future whole-line-or-region
function, and it makes sense to understand the context in which FN was
originally called, e.g. killing and yanking text; see
`whole-line-or-region-yank' for an example).
In either case, if SEND-PREFIX is non-nil, then PREFIX is passed into
FN as a third argument."
(whole-line-or-region-base-call fn fn t nil nil cnt mark-as-whole send-prefix prefix))
;;; **************************************************************************
(defun whole-line-or-region-call-with-prefix (fn &optional cnt mark-as-whole send-prefix prefix)
"Calls FN on region or CNT whole lines.
If region is defined simply call FN.
If region is not currently defined, then define it temporarily as the
current line. Additionally, if CNT is set, expand region to cover the
next CNT whole lines (or previous CNT whole lines, if CNT is
negative). Before FN is called, mark the temporary region with a
special property if MARK-AS-WHOLE is non-nil (this is useful if the
text could be worked on with some future whole-line-or-region
function, and it makes sense to understand the context in which FN was
originally called, e.g. killing and yanking text; see
`whole-line-or-region-yank' for an example).
In either case, if SEND-PREFIX is non-nil, then PREFIX is passed into
FN as the sole argument."
(whole-line-or-region-base-call fn fn nil nil nil cnt mark-as-whole send-prefix prefix))
;;; **************************************************************************
(defun whole-line-or-region-base-call (norm-fn wlr-fn
&optional beg-end pre-args post-args
cnt mark-as-whole send-prefix prefix)
"Calls FN on region or CNT whole lines.
If region is defined simply call NORM-FN.
If region is not currently defined, then define it temporarily as the
current line. Additionally, if CNT is set, expand region to cover the
next CNT whole lines (or previous CNT whole lines, if CNT is
negative). Before WLR-FN is called, mark the temporary region with a
special property if MARK-AS-WHOLE is non-nil (this is useful if the
text could be worked on with some future whole-line-or-region
function, and it makes sense to understand the context in which WLR-FN was
originally called, e.g. killing and yanking text; see
`whole-line-or-region-yank' for an example).
In either case, if BEG-END is non-nil, then pass into FN the start and
end of the current region. PRE-ARGS and POST-ARGS are lists of
arguments to be passed into FN before \(PRE-ARGS) and/or after
\(POST-ARGS) the start and end of the current region (but only if
BEG-END is non-nil). Finally, if SEND-PREFIX is non-nil, then PREFIX
is passed into FN before POST-ARGS."
;; region is defined, so just do what should normally be done
(if (and mark-active
(/= (point) (mark)))
;; just call it, but make sure to pass all of the arguments....
(let (args)
(when pre-args
(whole-line-or-region-append-to-list 'args pre-args))
(when beg-end
(whole-line-or-region-append-to-list 'args (point))
(whole-line-or-region-append-to-list 'args (mark)))
(when send-prefix
(whole-line-or-region-append-to-list 'args (list prefix)))
(when post-args
(whole-line-or-region-append-to-list 'args post-args))
(apply 'funcall norm-fn args))
;; no region defined, act on whole line
(let ((saved-column (current-column))
(current-mod-state (buffer-modified-p))
beg end)
(save-excursion
(setq beg (line-beginning-position))
(set-mark beg)
;; add whole-line property, sometimes
(when mark-as-whole
(let ((inhibit-read-only t))
(put-text-property beg (+ beg 1) 'whole-line-or-region t)
(set-buffer-modified-p current-mod-state)))
(setq end (line-beginning-position (+ (or cnt 1) 1)))
(goto-char end)
(let (args)
(when pre-args
(whole-line-or-region-append-to-list 'args pre-args))
(when beg-end
(whole-line-or-region-append-to-list 'args beg)
(whole-line-or-region-append-to-list 'args end))
(when send-prefix
(whole-line-or-region-append-to-list 'args (list prefix)))
(when post-args
(whole-line-or-region-append-to-list 'args post-args))
(apply 'funcall wlr-fn args))
;; remove whole-line property, sometimes
(when mark-as-whole
;; assume state has not changed -- probably a bad assumption
;; to make, and this should be another arg passed in as to
;; whether or not to recheck state on restore. Alternately,
;; copy whole line to a temp buffer and apply properties there.
(let ((inhibit-read-only t))
(remove-text-properties beg (+ beg 1) '(whole-line-or-region nil))
(set-buffer-modified-p current-mod-state)))
)
(move-to-column saved-column))
))
;;; **************************************************************************
(defun whole-line-or-region-bind-keys (&optional switch)
"Bind keys according to `whole-line-or-region-extensions-alist'.
With optional SWITCH, restore keys instead."
(let ((gmap (current-global-map))
(ext-alist whole-line-or-region-extensions-alist)
elem orig wlr map)
(while ext-alist
(setq elem (car ext-alist))
(setq ext-alist (cdr ext-alist))
(setq orig (nth 0 elem))
(setq wlr (nth 1 elem))
(setq map (nth 2 elem))
(if switch
(substitute-key-definition wlr orig (or map gmap))
(substitute-key-definition orig wlr (or map gmap)))
)))
;;; **************************************************************************
(defun whole-line-or-region-restore-keys ()
"Restore keys according to `whole-line-or-region-extensions-alist'."
(whole-line-or-region-bind-keys t))
;;; **************************************************************************
(defun whole-line-or-region-append-to-list (list-var element)
"Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
The test for presence of ELEMENT is done with `equal'.
If ELEMENT is added, it is added at the beginning of the list,
unless the optional argument APPEND is non-nil, in which case
ELEMENT is added at the end.
If you want to use `whole-line-or-region-append-to-list' on a variable that is not defined
until a certain package is loaded, you should put the call to `whole-line-or-region-append-to-list'
into a hook function that will be run only after loading the package.
`eval-after-load' provides one way to do this. In some cases
other hooks, such as major mode hooks, can do the job."
(set list-var
(append (symbol-value list-var) (if (listp element) element (list element)))
))
;;; **************************************************************************
;;; ***** we're done
;;; **************************************************************************
(provide 'whole-line-or-region)
(run-hooks 'whole-line-or-region-load-hook)
;;; whole-line-or-region.el ends here
;;; **************************************************************************
;;;; ***** EOF ***** EOF ***** EOF ***** EOF ***** EOF *************
Joe Casadonte2008-11-27T16:01:27java tools
http://comments.gmane.org/gmane.emacs.sources/3068
_______________________________________________
gnu-emacs-sources mailing list
gnu-emacs-sources< at >gnu.org
http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources
Halil Özdemir2008-11-24T22:12:28cal-china-plus.el
http://comments.gmane.org/gmane.emacs.sources/3066
Hi there,
This is not another package to customise the appearance of Emacs
calendar for Chinese taste. Instead, it provides the following essential
features:
Key Command
------------------------------------------------
iCa diary-chinese-insert-anniversary-entry
iCd diary-chinese-insert-entry
iCm diary-chinese-insert-monthly-entry
iCy diary-chinese-insert-yearly-entry
------------------------------------------------
In Chinese Culture, birthday is celebrated on the Chinese date and
usually not on the gregorian date. Thus, when in 08 Nov 2008 Emacs
calendar failed utterly to notify me the birthday of one of my best
friends while I was travelling in China, I realised the practical
importance of such a package.
To use this package:
(require 'cal-china-plus)
(add-hook 'diary-nongregorian-listing-hook 'diary-chinese-list-entries)
(add-hook 'diary-nongregorian-marking-hook 'diary-chinese-mark-entries)
An example of diary entries:
C1 一月 2009 enquire after every family member
C15 * Telephone Mom
%%(diary-chinese-anniversary 11 3 2006) Grandma died
Bye,
Leo2008-11-21T17:05:34blog.el - 0.1 - WordPress client for Emacs
http://comments.gmane.org/gmane.emacs.sources/3064
Hi all,
I'm a new Emacs LISP programmer, and I've created a blog client similar
to weblogger-mode, but it allows one to type posts in muse-mode. The
client is still in primitive stage but at least it allows one to post to
web-log. It requires muse-mode{,-html}.el and xml-rpc.el Emacs LISP
libraries to be present somewhere in load-path.
To use it, follow the instructions below:
* Copy blog.el and metaweblog.el to some location present in load-path.
* Now load them:
(require 'blog)
* And, now login to your blog by invoking 'M-x blog-login RET'
command. This will ask following information:
Weblog XML-RPC URL ? http://wahjava.wordpress.com/xmlrpc.php
Weblog User ID ? wahjava
Weblog ID ? wahjava.wordpress.com
Weblog Password ? secret
Please substitute wajava.wordpress.com, wahjava, and secret with your
blog URL, blog user, and password respectively. During this login
process, the list of categories will get downloaded.
* Now to start new post, execute 'M-x blog-new-entry RET' . This will
bring a new *blog* buffer, where you can type your post in Muse syntax
below the line "--[post] Type your post below this line [post]--". The
title of the post and list of the categories needs to be filled in
'Subject' and 'Categories' fields respectively. The 'Categories' field
supports completion with TAB key.
* To publish your post, press C-c C-c and to save your post press C-c
C-d . To cancel the simply kill the buffer.
* To clear blog information from the memory, invoke 'M-x blog-logout
RET' command.
There is a customization group named 'blog' is also provided for you to
customize blog.el settings.
The code might look childish in nature so please point out any silly
mistakes or bugs in the code. Any improvements, coding conventions are
welcome too.
Thanks in advance for your feedback.
Happy blogging :)
Ashish Shukla
- --=-=-=
Content-Type: application/emacs-lisp
Content-Disposition: attachment; filename=blog.el
Content-Transfer-Encoding: quoted-printable
Content-Description: blog.el
;; blog.el -- a wordpress posting client
;; Copyright (C) 2008 Ashish Shukla
;; This program 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
;; of the License, or (at your option) any later version.
;; This program 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 this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-130=
1, USA.
(require 'muse-mode)
(require 'muse-html)
(require 'metaweblog)
(defgroup blog nil "Post to weblogs from Emacs" :group 'emacs)
(defcustom blog-server-url nil "Weblog XML-RPC URL" :group 'blog :type 'str=
ing)
(defcustom blog-server-user nil "Weblog server username" :group 'blog :type=
'string)
(defcustom blog-server-pass nil "Weblog server password. If this is
nil you'll be prompted." :group 'blog :type 'string)=20
(defcustom blog-server-weblog-id nil "Weblog ID" :group 'blog :type 'string)
(defcustom blog-default-categories '("Uncategorized") "Default list of cate=
gories" :group 'blog :type '(repeat string))
(defcustom blog-default-title "Hello, World" "Title of the new post" :group=
'blog :type 'string)
(defvar blog-categories-list nil "List of weblog categories")
(defvar blog-server-xmlrpc-url nil "Weblog server XML-RPC URL")
(defvar blog-server-userid nil "Weblog server user id")
(defvar blog-server-blogid nil "Weblog ID")
(defvar blog-entry-mode-map nil "Keymap for blog entry buffer")
(defvar blog-logged-in nil "Flag whether user is logged-in or not")
(defvar blog-buffer-name "*blog*" "Name of the blog buffer")
(defconst blog-version "0.1" "Current version of blog.el")
(unless blog-entry-mode-map
(setq blog-entry-mode-map
(let ((blog-map (make-sparse-keymap)))
(set-keymap-parent blog-map muse-mode-map)
(define-key blog-map (kbd "C-c C-c") (lambda() (interactive) (blog-post-=
entry t)))
(define-key blog-map "\t" 'blog-complete-category)
(define-key blog-map (kbd "<tab>") 'blog-complete-category)
(define-key blog-map (kbd "C-c C-s") 'blog-post-entry)
blog-map)))
(defun blog-login()
"Logs into the blog. Initializes the internal data structures."
(interactive)
(setq blog-server-xmlrpc-url (or blog-server-url
(read-no-blanks-input "Weblog XML-RPC URL ? ")))
(setq blog-server-userid (or blog-server-user
(read-no-blanks-input "Weblog User ID ? ")))
(setq blog-server-blogid (or blog-server-weblog-id
(read-no-blanks-input "Weblog ID ? ")))
(setq blog-categories-list
(mapcar (lambda (category) (cdr (assoc "categoryName" category)))
(metaweblog-get-categories blog-server-xmlrpc-url
blog-server-userid
(or blog-server-pass
(read-passwd "Weblog Password ? "))
blog-server-weblog-id)))
(setq blog-logged-in t))
(defun blog-logout()
"Logs out from the blog and clears. Clears the internal data structures."
(interactive)
(setq blog-server-xmlrpc-url nil
blog-server-userid nil
blog-server-blogid nil
blog-categories-list nil
blog-logged-in nil))
(defun blog-new-entry()
"Creates a new blog entry"
(interactive)
(unless blog-logged-in
(error "Please log-in to the blog first"))
(let ((blog-buffer (generate-new-buffer blog-buffer-name)))
(switch-to-buffer blog-buffer)
(muse-mode)
(mapc
(lambda (header)
(let ((p1 (point))
(p2 0))
(insert (format "**%s**: %s"
(car header)
(if (stringp (cdr header))
(cdr header)
(let* (cats not-first-element)
(dolist (val (cdr header) cats)
(setq cats
(concat
val
(if not-first-element
", " (progn (setq not-first-element t) ""))
cats))))))) (newline)))
`(("Date" . ,(format-time-string "%Y-%m-%dT%T%z" (current-time)))
("Subject" . ,(or blog-default-title ""))
("Categories" . ,blog-default-categories)))
(newline)
(insert "--[post] Type your post below this line [post]--")
(newline)
(use-local-map blog-entry-mode-map)))
(defun blog-post-entry(&optional publish)
"Posts blog entry to the blog. If PUBLISH is not-nil, then publishes entr=
y"
(interactive)
(unless blog-logged-in (error "Please log-in to the blog first"))
(let* (r1 r2 html-text list-headers)
(save-excursion
(setq list-headers '())
(goto-char (point-min))
(dolist (item '("Date" "Subject" "Categories"))
(when (looking-at (concat "**" item))
(add-to-list 'list-headers (cons item (buffer-substring-no-properties=20
(search-forward ": ")
(point-at-eol))))
(forward-line)))
(setcdr (assoc "Categories" list-headers)
(split-string (cdr (assoc "Categories" list-headers)) ", " t))
(search-forward "--[post] Type your post below this line [post]--")
(forward-line)
(setq r1 (point))
(setq r2 (point-max))
(end-of-line)
(muse-publish-region r1 r2 (cdr (assoc "Subject" list-headers)) (muse=
- -style "xhtml"))
(search-forward "<!-- Page published by Emacs Muse begins here -->")
(forward-line)
(setq r1 (point))
(search-forward "<!-- Page published by Emacs Muse ends here -->")
(forward-line -1)
(end-of-line)
(setq r2 (point))
(setq html-text (buffer-substring-no-properties r1 r2))
(kill-buffer))
(goto-char (point-max))
(metaweblog-new-post blog-server-xmlrpc-url
blog-server-userid
(or blog-server-pass
(read-passwd "Weblog Password ? "))
blog-server-blogid
`(("description" . ,html-text)
("title" . ,(cdr (assoc "Subject" list-headers)))
("categories" . ,(cdr (assoc "Categories" list-headers))))
publish)
(kill-buffer)))
(defun blog-complete-category()
(interactive)
(let* (current-pos)
(setq current-pos (point))
(forward-line 0)
(if (looking-at "**Categories")
(progn
(goto-char current-pos)
(let ((word-match (or (current-word t) ""))
(completion-match nil))
(when word-match
(setq completion-match (completing-read "Category ? " blog-categorie=
s-list nil nil word-match))
(when (stringp completion-match)
(search-backward word-match nil t)
(replace-match (concat completion-match ", ") nil t)))))
(progn
(goto-char current-pos)
(command-execute (lookup-key muse-mode-map "\t"))))))
(provide 'blog)
- --=-=-=
Content-Type: application/emacs-lisp
Content-Disposition: attachment; filename=metaweblog.el
Content-Transfer-Encoding: quoted-printable
Content-Description: metaweblog.el
;; metaweblog.el -- an emacs library to access metaweblog based weblogs
;; Copyright (C) 2008 Ashish Shukla
;; This program 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
;; of the License, or (at your option) any later version.
;; This program 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 this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-130=
1, USA.
(require 'xml-rpc)
(defun metaweblog-get-categories(blog-xmlrpc user-name password blog-id)
"Retrieves list of categories from the weblog system"
(xml-rpc-method-call blog-xmlrpc
"metaWeblog.getCategories"
blog-id
user-name
password))
(defun metaweblog-new-post(blog-xmlrpc user-name password blog-id content p=
ublish)
"Sends a new post to the blog. If PUBLISH is non-nil, the post is
published, otherwise it is saved as draft. CONTENT will be an alist
title, description, categories, and date as keys (string-ified) mapped to t=
he
title of the post, post contents, list of categories, and date respectively=
."=20
(let ((post-title (cdr (assoc "title" content)))
(post-description (cdr (assoc "description" content)))
(post-categories (cdr (assoc "categories" content)))
(post-date (cdr (assoc "date" content))))
;;; since xml-rpc-method-call entitifies the HTML text in the post
;;; we've to use raw
(xml-rpc-xml-to-response (xml-rpc-request
blog-xmlrpc
`((methodCall
nil
(methodName nil "metaWeblog.newPost")=20
(params nil=20
(param nil (value nil (string nil ,blog-id)))
(param nil (value nil (string nil ,user-name)))
(param nil (value nil (string nil ,password)))
(param nil (value nil
(struct
nil
(member nil
(name nil "title")
(value nil ,post-title))
(member nil
(name nil "description")
(value nil ,post-description))
(member nil
(name nil "dateCreated")
(value nil ,post-date))
,(when post-categories
`(member nil=20
(name nil "categories")
(value nil
(array
nil
,(append=20
'(data nil)
(mapcar
(lambda(f)
`(value nil (string nil ,f)))
post-categories)))))))))
(param nil (value nil (boolean nil ,(if publish "1" "0")))))))))))
(defun metaweblog-get-post(blog-xmlrpc user-name password post-id)
"Retrieves a post from the weblog. POST-ID is the id of the post
which is to be returned"
(xml-rpc-method-call blog-xmlrpc
"metaWeblog.getPost"
post-id
user-name
password))
(defun metaweblog-get-recent-posts(blog-xmlrpc blog-id user-name password n=
umber-of-posts)
"Fetches the recent posts from the weblog. NUMBER-OF-POSTS is the
no. of posts that should be returned."
(xml-rpc-method-call blog-xmlrpc
"metaWeblog.getRecentPosts"
blog-id
user-name
password
number-of-posts))
(provide 'metaweblog)
- --=-=-=--
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v2.0.9 (GNU/Linux)
iEYEARECAAYFAkkYR6UACgkQHy+EEHYuXnSAIwCghvDDDt6gIKvQHFqmKHkPCgZn
giAAoKcGYzpoA7qzbCzvEyGEhNXAKfqa
=GAcp
-----END PGP SIGNATURE-----
_______________________________________________
gnu-emacs-sources mailing list
gnu-emacs-sources< at >gnu.org
http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources
Ashish Shukla आशीष शुक्ल2008-11-10T14:39:28thingatpt-utils_1.11, highlight-thing minor-mode
http://comments.gmane.org/gmane.emacs.sources/3063
Hi all,
someone wanted to have a mode, where chars within
braces are highlighted, if point is there.
As "highlight-current-line.el" already knows how to do
that kind of work, I took some forms from there and
employed it to all available kind of things: words,
bracketed's , braced etc.
Maybe turn transient-mark-mode off, if it interfers.
For the moment, THING remains highlighted if the
cursor leaves, until a new THING, where the mode is
instrumented for, is found.
Andreas Röhler
_______________________________________________
gnu-emacs-sources mailing list
gnu-emacs-sources< at >gnu.org
http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources
Andreas Roehler2008-11-10T09:55:11babel.el 0.7
http://comments.gmane.org/gmane.emacs.sources/3062
I received a lot of feedback (including bug reports) after releasing
0.6. Thanks! This release should fix most issues.
Major changes:
- Increased chunk size for better performance
- Error handling if no backend is available for translating
- Support for all Google languages
;;; babel.el --- interface to web translation services such as Babelfish
;; $Id: babel.el,v 1.22 2008/11/09 19:49:35 juergen Exp $
;;;
;;; Author: Eric Marsden <emarsden< at >laas.fr>
;;; Juergen Hoetzel <juergen< at >hoetzel.info>
;;; Keywords: translation, web
;;; Copyright: (C) 1999-2001 Eric Marsden
;;; 2005-2008 Juergen Hoetzel
;;
;; This program 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 of
;; the License, or (at your option) any later version.
;;
;; This program 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 this program; if not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA.
;;
;; Please send suggestions and bug reports to <emarsden< at >laas.fr>.
;; The latest version of this package should be available at
;;
;; <URL:http://www.hoetzel.info/Hacking/emacs/babel.el>
;;; Commentary:
;;; Overview ==========================================================
;;
;; This module provides an Emacs interface to different translation
;; services available on the Internet. You give it a word or paragraph
;; to translate and select the source and destination languages, and
;; it connects to the translation server, retrieves the data, and
;; presents it in a special *babel* buffer. Currently the following
;; backends are available:
;;
;; * the Babelfish service at babelfish.yahoo.com
;; * the Google service at translate.google.com
;; * the Transparent Language motor at FreeTranslation.com
;;
;; Entry points: either 'M-x babel', which prompts for a phrase, a
;; language pair and a backend, or 'M-x babel-region', which prompts
;; for a language pair and backend, then translates the currently
;; selected region, and 'M-x babel-buffer' to translate the current
;; buffer.
;;
;; If you ask for a language combination which several backends could
;; translate, babel.el will allow you to choose which backend to
;; use. Since most servers have limits on the quantity of text
;; translated, babel.el will split long requests into translatable
;; chunks and submit them sequentially.
;;
;; Please note that the washing process (which takes the raw HTML
;; returned by a translation server and attempts to extract the useful
;; information) is fragile, and can easily be broken by a change in
;; the server's output format. In that case, check whether a new
;; version is available (and if not, warn me; I don't translate into
;; Welsh very often).
;;
;; Also note that by accessing an online translation service you are
;; bound by its Terms and Conditions; in particular
;; FreeTranslation.com is for "personal, non-commercial use only".
;;
;;
;; Installation ========================================================
;;
;; Place this file in a directory in your load-path (to see a list of
;; appropriate directories, type 'C-h v load-path RET'). Optionally
;; byte-compile the file (for example using the 'B' key when the
;; cursor is on the filename in a dired buffer). Then add the
;; following lines to your ~/.emacs.el initialization file:
;;
;; (autoload 'babel "babel"
;; "Use a web translation service to translate the message MSG." t)
;; (autoload 'babel-region "babel"
;; "Use a web translation service to translate the current region." t)
;; (autoload 'babel-as-string "babel"
;; "Use a web translation service to translate MSG, returning a string." t)
;; (autoload 'babel-buffer "babel"
;; "Use a web translation service to translate the current buffer." t)
;;
;; babel.el requires emacs >= 22
;;
;;
;; Backend information =================================================
;;
;; A babel backend named <zob> must provide three functions:
;;
;; (babel-<zob>-translation from to)
;;
;; where FROM and TO are three-letter language abbreviations from
;; the alist `babel-languages'. This should return non-nil if the
;; backend is capable of translating between these two languages.
;;
;; (babel-<zob>-fetch msg from to)
;;
;; where FROM and TO are as above, and MSG is the text to
;; translate. Connect to the appropriate server and fetch the raw
;; HTML corresponding to the request.
;;
;; (babel-<zob>-wash)
;;
;; When called on a buffer containing the raw HTML provided by the
;; server, remove all the uninteresting text and HTML markup.
;;
;; I would be glad to incorporate backends for new translation servers
;; which are accessible to the general public. List of translation
;; engines and multilingual dictionaries at
;; <URL:http://funsan.biomed.mcgill.ca/~funnell/language.html>.
;;
;;
;; <URL:http://www.xmethods.net/sd/BabelFishService.wsdl>
;;
;; babel.el was inspired by a posting to the ding list by Steinar Bang
;; <sb< at >metis.no>. Morten Eriksen <mortene< at >sim.no> provided several
;; patches to improve InterTrans washing. Thanks to Per Abrahamsen and
;; Thomas Lofgren for pointing out a bug in the keymap code. Matt
;; Hodges <pczmph< at >unix.ccc.nottingham.ac.uk> suggested ignoring case
;; on completion. Colin Marquardt suggested
;; `babel-preferred-to-language'. David Masterson suggested adding a
;; menu item.
;;
;; User quotes: Dieses ist die größte Sache seit geschnittenem Brot.
;; -- Stainless Steel Rat <ratinox< at >peorth.gweep.net>
;;; History
;; 0.7 * error handling if no backend is available for translating
;; the supplied languages
;; * rely on url-* functions (for charset decoding) on GNU emacs
;; * increased chunk size for better performance
;; * added support for all Google languages
;; * `babel-region' with prefix argument inserts the translation
;; output at point.
;; 0.6 * get rid of w3-region (implementend basic html entity parsing)
;; * get rid of w3-form-encode-xwfu (using mm-url-form-encode-xwfu)
;; * no character classes in regex (for xemacs compatibility)
;; * default backend: Google
;; 0.5: * Fixed Google and Babelfish backends
;; 0.4: * revised FreeTranslation backend
;;; 0.3: * removed non-working backends: systran, intertrans, leo, e-PROMPT
;;; * added Google backend
;;; * revised UTF-8 handling
;;; * Added customizable variables: babel-preferred-to-language, babel-preferred-from-language
;;; * revised history handling
;;; * added helper function: babel-wash-regex
;;; Code:
(require 'cl)
(require 'mm-url)
(require 'easymenu)
;; xemacs compatibility
(eval-and-compile
(when (featurep 'xemacs)
(defun url-retrieve-synchronously (url)
(save-excursion
(cdr (url-retrieve url))))))
;; ======================================================================
;;; Customizables
;; ======================================================================
(defgroup babel nil
"provides an Emacs interface to different translation services available on the Internet"
:group 'applications)
(defconst babel-version 0.7
"The version number of babel.el")
(defconst babel-languages
'(("Arabic" . "ar")
("Bulgarian" . "bg")
("Catalan" . "ca")
("Czech" . "cs")
("Danish" . "da")
("German" . "de")
("Greek" . "el")
("English" . "en")
("Spanish" . "es")
("Finnish" . "fi")
("French" . "fr")
("Hindi" . "hi")
("Croatian" . "hr")
("Indonesian" . "id")
("Italian" . "it")
("Hebrew" . "iw")
("ja" . "Japanese")
("Korean" . "ko")
("lt" . "Lithuanian")
("Latvian" . "lv")
("nl" . "Dutch")
("Norwegian" . "no")
("pl" . "Polish")
("Portuguese" . "pt")
("ro" . "Romanian")
("Russian" . "ru")
("sk" . "Slovak")
("Slovenian" . "sl")
("sr" . "Serbian")
("Swedish" . "sv")
("tl" . "Filipino")
("Ukrainian" . "uk")
("Vietnamese" . "vi")
("Chinese (Simplified)" . "zh-CN")
("Chinese" . "zh-CN")
("Chinese (Traditional)" . "zh-TW")))
(defcustom babel-preferred-to-language "German"
"*Default target translation language.
This must be the long name of one of the languages in the alist"
:type `(choice ,< at >(mapcar (lambda (s) `(const ,(car s))) babel-languages))
:set (lambda (symbol value)
(set-default symbol value)
(setq babel-to-history (list value)))
:group 'babel)
(defcustom babel-preferred-from-language "English"
"*Default target translation language.
This must be the long name of one of the languages in the alist"
:type `(choice ,< at >(mapcar (lambda (s) `(const ,(car s))) babel-languages))
:set (lambda (symbol value)
(set-default symbol value)
(setq babel-from-history (list value)))
:group 'babel)
(defvar babel-to-history (list babel-preferred-to-language))
(defvar babel-from-history (list babel-preferred-to-language))
(defvar babel-backend-history (list))
(defvar babel-mode-hook nil)
(defvar babel-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "q") #'bury-buffer)
(define-key map (kbd "SPC") #'scroll-up)
(define-key map (kbd "DEL") #'scroll-down)
(define-key map (kbd "<") #'beginning-of-buffer)
(define-key map (kbd ">") #'end-of-buffer)
(define-key map (kbd "s") #'isearch-forward)
(define-key map (kbd "r") #'isearch-backward)
(define-key map (kbd "h") #'describe-mode)
map)
"Keymap used in Babel mode.")
(defvar babel-backends
'(("Google" . google)
("Babelfish at Yahoo" . fish)
("FreeTranslation" . free))
"List of backends for babel translations.")
(defun babel-sentence-end()
"portability function. emacs 22.0.50 introduced sentence-end
function, not available on other emacsen"
(if (fboundp 'sentence-end)
(sentence-end)
sentence-end))
;; xemacs compatibility
(eval-and-compile
(if (featurep 'xemacs)
;; XEmacs
(defun babel-url-retrieve (url)
"Retrieve URL and decode"
(let ((current (current-buffer))
(tmp (url-retrieve-synchronously url)))
(with-current-buffer tmp
;;shrug: we asume utf8
;; (mm-decode-coding-region (point-min) (point-max) 'utf-8)
(copy-to-buffer current (point-min) (point-max)))))
;; GNUs Emacs
(require 'url-handlers)
(defun babel-url-retrieve (url)
(let ((tmp (url-retrieve-synchronously url)))
(url-insert tmp)))))
(defun babel-wash-regex (regex)
"Extract the useful information from the HTML returned by fetch function
translated text should be inside parenthesized expression in regex"
(goto-char (point-min))
(if (search-forward-regexp regex (point-max) t)
(progn
(delete-region (match-end 1) (point-max))
(delete-region (point-min) (match-beginning 1))
t)))
;;;###autoload
(defun babel (msg &optional no-display)
"Use a web translation service to translate the message MSG.
Display the result in a buffer *babel* unless the optional argument
NO-DISPLAY is nil."
(interactive "sTranslate phrase: ")
(let* ((completion-ignore-case t)
(from-suggest (or (first babel-from-history) (caar babel-languages)))
(from-long
(completing-read "Translate from: "
babel-languages nil t
(cons from-suggest 0)
'babel-from-history))
(to-avail (remove* from-long babel-languages
:test #'(lambda (a b) (string= a (car b)))))
(to-suggest (or (first
(remove* from-long babel-to-history
:test #'string=))
(caar to-avail)))
(to-long
(completing-read "Translate to: " to-avail nil t
(cons to-suggest 0)
'babel-to-history))
(from (cdr (assoc from-long babel-languages)))
(to (cdr (assoc to-long babel-languages)))
(backends (babel-get-backends from to)))
(if (not backends)
(error "No Backend available for translating %s to %s"
from-long to-long)
(let* ((backend-str
(completing-read "Using translation service: "
backends nil t
(cons (or (member (first babel-backend-history)
backends) (caar backends)) 0)
'babel-backend-history))
(backend (symbol-name (cdr (assoc backend-str babel-backends))))
(fetcher (intern (concat "babel-" backend "-fetch")))
(washer (intern (concat "babel-" backend "-wash")))
(chunks (babel-chunkify msg 7000))
(translated-chunks '())
(view-read-only nil))
(loop for chunk in chunks
do (push (babel-work chunk from to fetcher washer)
translated-chunks))
(if no-display
(apply #'concat (nreverse translated-chunks))
(with-output-to-temp-buffer "*babel*"
(message "Translating...")
(loop for tc in (nreverse translated-chunks)
do (princ tc))
(save-excursion
(set-buffer "*babel*")
(babel-mode))
(message "Translating...done")))))))
;;;###autoload
(defun babel-region (start end &optional arg)
"Use a web translation service to translate the current region.
With prefix argument, insert the translation output at point."
(interactive "r\nP")
(if arg
(insert (babel (buffer-substring-no-properties start end) t))
(babel (buffer-substring-no-properties start end))))
;;;###autoload
(defun babel-as-string (msg)
"Use a web translation service to translate MSG, returning a string."
(interactive "sTranslate phrase: ")
(babel msg t))
;; suggested by Djalil Chafai <djalil< at >free.fr>
;;
;;;###autoload
(defun babel-buffer ()
"Use a web translation service to translate the current buffer.
Default is to present the translated text in a *babel* buffer.
With a prefix argument, replace the current buffer contents by the
translated text."
(interactive)
(let (pos)
(cond (prefix-arg
(setq pos (point-max))
(goto-char pos)
(insert
(babel-as-string
(buffer-substring-no-properties (point-min) (point-max))))
(delete-region (point-min) pos))
(t
(babel-region (point-min) (point-max))))))
(defun babel-work (msg from to fetcher washer)
(save-excursion
(set-buffer (get-buffer-create " *babelurl*"))
(erase-buffer)
(funcall fetcher (babel-preprocess msg) from to)
(funcall washer)
(babel-postprocess)
(babel-simple-html-parse)
(babel-display)
(buffer-substring-no-properties (point-min) (point-max))))
(defun babel-get-backends (from to)
"Return a list of those backends which are capable of translating
language FROM into language TO."
(loop for b in babel-backends
for name = (symbol-name (cdr b))
for translator = (intern (concat "babel-" name "-translation"))
for translatable = (funcall translator from to)
if translatable collect b))
(defconst babel-html-entity-regex
"&\\(#\\([0-9]+\\)\\|\\([a-zA-Z]+\\)\\);")
(defun babel-decode-html-entitiy (str)
(if (and str (string-match babel-html-entity-regex
str))
(if (string= (substring str 1 2) "#")
;TODO: xemacs
(if (not (featurep 'xemacs))
(let ((number (match-string-no-properties 2 str)))
(decode-char 'ucs (string-to-number number)))
str)
(let ((letter (match-string-no-properties 3 str)))
(cond ((string= "gt" letter) ">")
((string= "lt" letter) "<")
(t "?"))))))
(defun babel-display ()
"Parse and display the region of this for basic HTML entities."
(save-excursion
(goto-char (point-min))
(while (and (< (point) (point-max)) (search-forward-regexp
babel-html-entity-regex
(point-max) t))
(let* ((start (match-beginning 0))
(end (match-end 0))
(entity (buffer-substring start end))
(replacement (babel-decode-html-entitiy entity)))
(delete-region start end)
(insert replacement)))))
(defun babel-mode ()
(interactive)
(use-local-map babel-mode-map)
(setq major-mode 'babel-mode
mode-name "Babel")
(run-hooks 'babel-mode-hook))
(cond ((fboundp 'string-make-unibyte)
(fset 'babel-make-unibyte #'string-make-unibyte))
((fboundp 'string-as-unibyte)
(fset 'babel-make-unibyte #'string-as-unibyte))
(t
(fset 'babel-make-unibyte #'identity)))
;; from nnweb.el, with added `string-make-unibyte'.
(defun babel-form-encode (pairs)
"Return PAIRS encoded for forms."
(mapconcat
(lambda (data)
(concat (mm-url-form-encode-xwfu (babel-make-unibyte (car data))) "="
(mm-url-form-encode-xwfu (babel-make-unibyte (cdr data)))))
pairs "&"))
;; We mark paragraph endings with a special token, so that we can
;; recover a little information on the original message's format after
;; translation and washing and rendering. Should really be using
;; `paragraph-start' and `paragraph-separate' here, but we no longer
;; have any information on the major-mode of the buffer that STR was
;; ripped from.
;;
;; This kludge depends on the fact that all the translation motors
;; seem to leave words they don't know how to translate alone, passing
;; them through untouched.
(defun babel-preprocess (str)
(while (string-match "\n\n\\|^\\s-+$" str)
(setq str (replace-match " FLOBSiCLE " nil t str)))
str)
;; decode paragraph endings in current buffer
(defun babel-postprocess ()
(goto-char (point-min))
(while (search-forward "FLOBSiCLE" nil t)
(replace-match "\n<p>" nil t)))
(defun babel-simple-html-parse ()
"Replace basic html markup"
(goto-char (point-min))
(while (re-search-forward "<\\(br\\|p\\)/?>" nil t)
(replace-match "\n"))
(goto-char (point-min))
(while (re-search-forward "^[ \t]+" nil t)
(replace-match "")))
;; split STR into chunks of around LENGTH characters, trying to
;; maintain sentence structure (this is used to send big requests in
;; several batches, because otherwise the motors cut off the
;; translation).
(defun babel-chunkify (str chunksize)
(let ((start 0)
(pos 0)
(chunks '()))
(while (setq pos (string-match (babel-sentence-end) str pos))
(incf pos)
(when (> (- pos start) chunksize)
(push (substring str start pos) chunks)
(setq start pos)))
(when (/= start (length str))
(push (substring str start) chunks))
(nreverse chunks)))
;;;###autoload
(defun babel-version (&optional here)
"Show the version number of babel in the minibuffer.
If optional argument HERE is non-nil, insert version number at point."
(interactive "P")
(let ((version-string
(format "Babel version %s" babel-version)))
(if here
(insert version-string)
(if (interactive-p)
(message "%s" version-string)
version-string))))
;; Babelfish-specific functions ================================================
;;
;; Babelfish (which uses the SysTran engine) is only able to translate
;; between a limited number of languages.
;; translation from generic names to Babelfish 2-letter names
(defconst babel-fish-languages
'(("en" . "en")
("de" . "de")
("it" . "it")
("pt" . "pt")
("es" . "es")
("fr" . "fr")))
;; those inter-language translations that Babelfish is capable of
(defconst babel-fish-translations
'("en_fr" "en_de" "en_it" "en_pt" "en_es" "fr_en" "de_en" "it_en"
"es_en" "pt_en"))
;; if Babelfish is able to translate from language FROM to language
;; TO, then return the corresponding string, otherwise return nil
(defun babel-fish-translation (from to)
(let* ((fromb (cdr (assoc from babel-fish-languages)))
(tob (cdr (assoc to babel-fish-languages)))
(comb (and fromb tob (concat fromb "_" tob))))
(find comb babel-fish-translations :test #'string=)))
(defun babel-fish-fetch (msg from to)
"Connect to the Babelfish server and request the translation."
(let ((translation (babel-fish-translation from to)))
(unless translation
(error "Babelfish can't translate from %s to %s" from to))
(let* ((pairs `(("trtext" . ,(mm-encode-coding-string msg 'utf-8))
("lp" . ,translation)
("ei" . "UTF-8")
("doit" . "done")
("fr" . "bf-res")
("intl" . "1")
("tt" . "urltext")
("btnTrTxt" . "Translate")))
(url-request-data (babel-form-encode pairs))
(url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded"))))
(babel-url-retrieve "http://babelfish.yahoo.com/translate_txt" ))))
(defun babel-fish-wash ()
"Extract the useful information from the HTML returned by Babelfish."
(if (not (babel-wash-regex "<div id=\"result\"><div style=\"padding:[0-9.]*em;\">\\([^<]*\\)</div></div>"))
(error "Babelfish HTML has changed ; please look for a new version of babel.el")))
;; FreeTranslation.com stuff ===========================================
;; translation from generic letter names to FreeTranslation names
(defconst babel-free-languages
'(("en" . "English")
("de" . "German")
("it" . "Italian")
("nl" . "Dutch")
("pt" . "Portuguese")
("es" . "Spanish")
("no" . "Norwegian")
("ru" . "Russian")
("zh-CN" . "SimplifiedChinese")
("zh-TW" . "TraditionalChinese")
("fr" . "French")))
;; those inter-language translations that FreeTranslation is capable of
(defconst babel-free-translations
'("English/Spanish" "English/French" "English/German" "English/Italian" "English/Dutch" "English/Portuguese"
"English/Russian" "English/Norwegian" "English/SimplifiedChinese" "English/TraditionalChinese" "Spanish/English"
"French/English" "German/English" "Italian/English" "Dutch/English" "Portuguese/English"))
(defun babel-free-translation (from to)
(let* ((ffrom (cdr (assoc from babel-free-languages)))
(fto (cdr (assoc to babel-free-languages)))
(trans (concat ffrom "/" fto)))
(find trans babel-free-translations :test #'string=)))
(defun babel-free-fetch (msg from to)
"Connect to the FreeTranslation server and request the translation."
(let ((coding-system-for-read 'utf-8)
(translation (babel-free-translation from to))
(url "http://ets.freetranslation.com/"))
(unless translation
(error "FreeTranslation can't translate from %s to %s" from to))
(let* ((pairs `(("sequence" . "core")
("mode" . "html")
("template" . "results_en-us.htm")
("srctext" . ,msg)
("charset" . "UTF-8")
("language" . ,translation)))
(url-request-data (babel-form-encode pairs))
(url-mime-accept-string "text/html")
(url-request-method "POST")
(url-privacy-level '(email agent))
(url-mime-charset-string "utf-8")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded")
("Referer" . "http://ets.freetranslation.com/"))))
(babel-url-retrieve url))))
(defun babel-free-wash ()
"Extract the useful information from the HTML returned by FreeTranslation."
;;; <textarea name="dsttext" cols="40" rows="6">hello together</textarea><br />
(if (not (babel-wash-regex "<textarea name=\"dsttext\"[^>]+>\\([^<]*\\)</textarea>"))
(error "FreeTranslations HTML has changed ; please look for a new version of babel.el")))
;; Google stuff ===========================================
;; Google supports all languages
(defconst babel-google-languages
babel-languages)
(defun babel-google-translation (from to)
;; Google can always translate in both directions
(find to babel-google-languages
:test '(lambda (st el)
(string= (cdr el) st))))
(defun babel-google-fetch (msg from to)
"Connect to google server and request the translation."
;; Google can always translate in both directions
(if (not (find to babel-google-languages
:test '(lambda (st el)
(string= (cdr el) st))))
(error "Google can't translate from %s to %s" from to)
(let* ((pairs `(("text" . ,(mm-encode-coding-string msg 'utf-8))
("hl" . "en")
("Language" . "English")
("ie" . "UTF-8")
("oe" . "UTF-8")
("sl" . ,from)
("tl" . ,to)))
(url-request-data (babel-form-encode pairs))
(url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded"))))
(babel-url-retrieve "http://translate.google.com/translate_t" ))))
(defun babel-google-wash ()
"Extract the useful information from the HTML returned by google."
(if (not (babel-wash-regex "<div id=result_box dir=\"[^\"]*\">\\(.*\\)</div></td></tr><tr><td[ \t]*class=submitcell>"))
(error "Google HTML has changed ; please look for a new version of babel.el")))
;; TODO: ecs.freetranslation.com
;; (defun babel-debug ()
;; (let ((buf (get-buffer-create "*babel-debug*")))
;; (set-buffer buf)
;; (babel-free-fetch "state mechanisms are too busy" "eng" "ger")))
(easy-menu-add-item nil '("tools") ["Babel Translation" babel t])
(provide 'babel)
;; babel.el ends here
_______________________________________________
gnu-emacs-sources mailing list
gnu-emacs-sources< at >gnu.org
http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources
Jürgen Hötzel2008-11-09T20:13:13peg.el --- Parsing Expression Grammars in Emacs Lisp
http://comments.gmane.org/gmane.emacs.sources/3061
These days, PEGs seems to be in fashion. Here's an implementation for
your favorite editor.
Helmut.
;;; peg.el --- Parsing Expression Grammars in Emacs Lisp
;;
;; Copyright 2008 Helmut Eller <eller.helmut< at >gmail.com>.
;;
;; This file is licensed under the terms of the GNU General Public
;; License as distributed with Emacs (press C-h C-c for details).
;;
;;; Commentary:
;;
;; Parsing Expression Grammars (PEG) are a formalism in the spirit of
;; Context Free Grammars (CFG) with some simplifications which makes
;; the implementation of PEGs as top-down parser particularly simple
;; and easy to understand [**].
;;
;; This file implements a macro `peg-parse' which parses the current
;; buffer according to a PEG. E.g. we can match integers with a PEG
;; like this:
;;
;; (peg-parse (number sign digit (* digit))
;; (sign (or "+" "-" ""))
;; (digit '"09")))
;;
;; In contrast to regexps, PEGs allow us to define recursive rules. A
;; PEG is a list of rules. A rule is written as (NAME . PE).
;; E.g. (sign (or "+" "-" "")) is a rule with the name "sign". For
;; convenience, PE is implicitly wrappend in a and. The syntax for
;; Parsing Expression (PE) is a follows:
;;
;; Description LispHaskell as in [*]
;; Sequence (and e1 e2) e1 e2
;; Prioritized Choice (or e1 e2)e1 / e2
;; Not-predicate (not e)!e
;; And-predictate(if e)&e
;; Any character(any).
;; Literal string"abc"'abc'
;; Characater C(char c)
;; Zero-or-more (* e)e*
;; One-or-more (+ e)e+
;; Optional(or e "")e?
;; Character range(range a b)[a-b]
;; Character range(2)'"ab" [a-b]
;;
;; `peg-parse' also support parsing actions, i.e. Lisp snippets which
;; are exectued when a PE matches. This can be used to construct
;; syntax trees or similar tasks. Actions are written as
;;
;; (action FORM) ; evaluate FORM
;; (VAR... -- FORM...) ; stack action
;;
;; Actions don't consume input, but are executed at the point of
;; match. A "stack action" takes VARs from the "value stack" and
;; pushes the result of evaluating FORMs to that stack. See
;; `peg-ex-parse-int' for an example.
;;
;; References:
;;
;; [*] Bryan Ford. Parsing Expression Grammars: a Recognition-Based
;; Syntactic Foundation. In POPL'04: Proceedings of the 31st ACM
;; SIGPLAN-SIGACT symposium on Principles of Programming Languages,
;; pages 111-122, New York, NY, USA, 2004. ACM Press.
;;
;; [**] Baker, Henry G. "Pragmatic Parsing in Common Lisp". ACM Lisp
;; Pointers 4(2), April--June 1991, pp. 3--15.
;;
;;; Code:
(defmacro peg-parse (&rest rules)
"Match RULES at point.
Return (T STACK) if the match succeed and nil on failure."
(peg-translate-rules rules))
(defmacro peg-parse-exp (exp)
"Match the parsing expression EXP at point.
Note: a PE can't \"call\" rules by name."
(peg-translate-exp exp))
;; A table of the PEG rules. Used during compilation to resolve
;; references to named rules.
(defvar peg-rules)
;; used at runtime for backtracking. It's a list ((POS . THUNK)...).
;; Each THUNK is executed at the corresponing POS. Thunks are
;; executed in a postprocessing step, not during parsing.
(defvar peg-thunks)
;; The basic idea is to translate each rule to a lisp function.
;; The result looks like
;; (let ((rule1 (lambda () code-for-rule1))
;; ...
;; (ruleN (lambda () code-for-ruleN)))
;; (funcall rule1))
;;
;; code-for-ruleX returns t if the rule matches and nil otherwise.
;;
(defun peg-translate-rules (rules)
"Translate the PEG RULES, to a top-down parser."
(let ((peg-rules (make-hash-table :size 20)))
(dolist (rule rules)
(puthash (car rule) 'defer peg-rules))
(dolist (rule rules)
(puthash (car rule) (peg-normalize `(and . ,(cdr rule))) peg-rules))
(peg-check-cycles peg-rules)
`(let ((peg-thunks '()))
(let ,(mapcar (lambda (rule)
(let ((name (car rule)))
`(,name
(lambda ()
,(peg-translate-exp (gethash name peg-rules))))))
rules)
(when (funcall ,(car (car rules)))
(peg-postprocess peg-thunks))))))
(defvar peg-normalizers)
(setq peg-normalizers (make-hash-table :size 2))
;; Internaly we use a regularized syntax, e.g. we only have binary OR
;; nodes. Regularized nodes are lists of the form (OP ARGS...).
(defun peg-normalize (exp)
"Return a \"normalized\" form of EXP."
(cond ((consp exp)
(let ((fun (gethash (car exp) peg-normalizers)))
(cond (fun (apply fun (cdr exp)))
(t (error "Invalid PEG exp: %S" exp)))))
((stringp exp)
(let ((len (length exp)))
(cond ((zerop len) '(null))
((= len 1) `(char ,(aref exp 0)))
(t `(str ,exp)))))
((and (symbolp exp) exp)
(when (not (gethash exp peg-rules))
(error "Reference to undefined PEG rule: %S" exp))
`(call ,exp))))
(defmacro peg-define-normalizer (name args &rest body)
(declare (indent defun))
`(puthash ',name (lambda ,args . ,body) peg-normalizers))
(dolist (name '(null fail any action char range str eob))
(puthash name (lambda (x) (cons name x)) peg-normalizers))
(peg-define-normalizer or (&rest args)
(cond ((null args) '(fail))
((null (cdr args)) (peg-normalize (car args)))
(t `(or ,(peg-normalize (car args))
,(peg-normalize `(or . ,(cdr args)))))))
(peg-define-normalizer and (&rest args)
(cond ((null args) '(null))
((null (cdr args)) (peg-normalize (car args)))
(t `(and ,(peg-normalize (car args))
,(peg-normalize `(and . ,(cdr args)))))))
(peg-define-normalizer * (&rest args)
`(* ,(peg-normalize `(and . ,args))))
(peg-define-normalizer + (&rest args)
(let ((e (peg-normalize `(and . ,args))))
`(and ,e (* ,e))))
(peg-define-normalizer opt (&rest args)
(let ((e (peg-normalize `(and . ,args))))
`(or ,e (null))))
(peg-define-normalizer \` (form)
(unless (member '-- form)
(error "Malformed stack action: %S" form))
(let ((args (cdr (member '-- (reverse form))))
(values (cdr (member '-- form))))
(let ((form `(let ,(mapcar (lambda (var) `(,var (pop peg-stack)))
args)
(setq peg-stack
(append (list . ,values) peg-stack)))))
`(action ,form))))
(peg-define-normalizer quote (form)
(cond ((and (stringp form) (= (length form) 2))
`(range ,(aref form 0) ,(aref form 1)))
(t (error "Invalid PEG exp: %S" `(quote ,form)))))
(defvar peg-translators)
(setq peg-translators (make-hash-table :size 20))
;; This is the main translation function.
(defun peg-translate-exp (exp)
"Return the ELisp code to match the PE EXP."
(let ((translator (or (gethash (car exp) peg-translators)
(error "Unknown PEG operator: %S" (car exp)))))
(apply translator (cdr exp))))
(defmacro peg-define-translator (name args &rest body)
(declare (indent defun))
`(puthash ',name (lambda ,args . ,body) peg-translators))
(peg-define-translator and (e1 e2)
`(and ,(peg-translate-exp e1)
,(peg-translate-exp e2)))
(peg-define-translator or (e1 e2)
(let ((cp (peg-make-choicepoint)))
`(,< at >(peg-save-choicepoint cp)
(or ,(peg-translate-exp e1)
(,< at >(peg-restore-choicepoint cp)
,(peg-translate-exp e2))))))
;; Choicepoints are used for backtracking. At a choicepoint we save
;; enough state, so that we can continue from there if needed.
(defun peg-make-choicepoint ()
(cons (make-symbol "point") (make-symbol "thunks")))
(defun peg-save-choicepoint (choicepoint)
`(let ((,(car choicepoint) (point))
(,(cdr choicepoint) peg-thunks))))
(defun peg-restore-choicepoint (choicepoint)
`(progn
(goto-char ,(car choicepoint))
(setq peg-thunks ,(cdr choicepoint))))
(peg-define-translator null ()
`t)
(peg-define-translator any ()
'(not (eobp)))
(peg-define-translator eob ()
'(eobp))
(peg-define-translator * (e)
`(progn (while ,(peg-translate-exp e))
t))
(peg-define-translator if (e)
(let ((cp (peg-make-choicepoint)))
`(,< at >(peg-save-choicepoint cp)
(when ,(peg-translate-exp e)
(,< at >(peg-restore-choicepoint cp))
t))))
(peg-define-translator char (c)
`(when (eq (char-after) ',c)
(forward-char)
t))
(peg-define-translator range (from to)
`(when (and (<= ',from (char-after))
(<= (char-after) ',to))
(forward-char)
t))
(peg-define-translator str (str)
`(when (looking-at ',(regexp-quote str))
(goto-char (match-end 0))
t))
(peg-define-translator call (name)
(or (gethash name peg-rules)
(error "Reference to unkown rule: %S" name))
`(funcall ,name))
(peg-define-translator action (form)
`(progn
(push (cons (point) (lambda () ,form)) peg-thunks)
t))
(defvar peg-stack)
(defun peg-postprocess (thunks)
"Execute \"actions\"."
(let ((peg-stack '()))
(dolist (thunk (reverse thunks))
(goto-char (car thunk))
(funcall (cdr thunk)))
(list t peg-stack)))
;; Left recursion is presumably a common mistate when using PEGs.
;; Here we try to detect such mistakes. Essentailly we traverse the
;; graph as long as we can without consuming input. When we find a
;; recursive call we signal an error.
(defun peg-check-cycles (peg-rules)
(maphash (lambda (name exp)
(peg-detect-cycles exp (list name)))
peg-rules))
(defvar peg-detect-cycles-methods)
(setq peg-detect-cycles-methods (make-hash-table :size 20))
(defun peg-detect-cycles (exp path)
"Signal an error on a cycle.
Otherwise traverse EXP recursively and return T if EXP can match
without consuming input. Return nil if EXP definetly consumes
input. PATH is the list of rules that we have visited so far."
(apply (or (gethash (car exp) peg-detect-cycles-methods)
(error "No detect-cycle method for: %S" exp))
path (cdr exp)))
(defmacro peg-define-detect-cycles (name args &rest body)
(declare (indent defun))
`(puthash ',name (lambda ,args . ,body) peg-detect-cycles-methods))
(peg-define-detect-cycles call (path name)
(cond ((member name path)
(error "Possible left recursion: %s"
(mapconcat #'symbol-name (reverse (cons name path)) " -> ")))
(t
(peg-detect-cycles (gethash name peg-rules) (cons name path)))))
(peg-define-detect-cycles and (path &rest args)
(let ((nullable t))
(while (and nullable args)
(setq nullable (peg-detect-cycles (pop args) path)))
nullable))
(peg-define-detect-cycles or (path &rest args)
(let ((nullable nil))
(while (and (not nullable) args)
(setq nullable (peg-detect-cycles (pop args) path)))
nullable))
(peg-define-detect-cycles * (path e) (peg-unary-nullable e path))
(peg-define-detect-cycles if (path e) (peg-unary-nullable e path))
(peg-define-detect-cycles not (path e) (peg-unary-nullable e path))
(defun peg-unary-nullable (exp path)
(peg-detect-cycles exp path)
t)
(peg-define-detect-cycles any (path) nil)
(peg-define-detect-cycles char (path c) nil)
(peg-define-detect-cycles range (path c1 c2) nil)
(peg-define-detect-cycles str (path s) (equal s ""))
(peg-define-detect-cycles null (path) t)
(peg-define-detect-cycles eob (path) t)
(peg-define-detect-cycles action (path form) t)
;;; Helpers
;; Similar to (CL's) position.
(defun peg-position (elt list)
"Return the index of ELT in LIST.
Compare with `equal'."
(let ((i 0)
(result nil))
(while (and list (not result))
(cond ((equal elt (pop list))
(setq result i))
(t (setq i (1+ i)))))
result))
;;; Examples:
;; peg-ex-recognize-int recognizes integers. An integer begins with a
;; optional sign, then follows one or more digits. Digits are all
;; characters in from 0 to 9.
;;
;; Notes:
;; 1) "" matches the empty sequence, i.e. matches without
;; consuming input.
;; 2) '"09" is the character range from 0 to 9. This can also be
;; written as (range ?0 ?9). Traditionally this would be written as
;; [0-9].
(defun peg-ex-recognize-int ()
(peg-parse (number sign digit (* digit))
(sign (or "+" "-" ""))
(digit '"09")))
;; peg-ex-parse-int recognizes integers and computes the corresponding
;; value. The grammer is the same as for `peg-ex-recognize-int' added
;; with parsing actions. Unfortunaletly, the actions add quite a bit
;; of clutter.
;;
;; The action for the sign rule pushes t on the stack for a minus sign
;; and nil for plus or no sign.
;;
;; The action for the digit rule pushes the value for a single digit.
;;
;; The action `(a b -- (+ (* a 10) b)), takes two items from the stack
;; and pushes the first digit times 10 added to second digit.
;;
;; The action `(sign val -- (if sign (- val) val)), negates the
;; value if the sign flag is true.
(defun peg-ex-parse-int ()
(peg-parse (number sign
digit
(* digit `(a b -- (+ (* a 10) b)))
`(sign val -- (if sign (- val) val)))
(sign (or (and "+" `(-- nil))
(and "-" `(-- t))
(and "" `(-- nil))))
(digit '"09" `(-- (- (char-before) ?0)))))
;; Put point after the ) and press C-x C-e
;; (peg-ex-parse-int)-234234
;; We try to detect left recursions.
(defun peg-ex-left-recursion ()
(eval '(peg-parse (exp (or term
(and exp "+" exp)))
(term (or digit
(and term "*" term)))
(digit '"09"))))
(provide 'peg)
;;; peg.el ends here
Helmut Eller2008-11-05T12:32:28PHP mode version 1.5.0
http://comments.gmane.org/gmane.emacs.sources/3059
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
A new version of PHP mode for Emacs is released. Version
1.5.0 is the follow-up to the major improvements unveiled
for PHP mode in January. There are no major new features in
this release, but many bug fixes.
The mode is only tested in Emacs 22 with CC Mode 5.31.
There are still no plans to support Emacs 21 and earlier
versions, nor XEmacs. Patches against the source code or
detailed bug reports for supporting these and other emacsen
are gladly accepted, however.
NEWS for version 1.5.0
* Additions and improvements to the GNU Info (Texinfo)
manual.
* Add date and time constants of PHP as suggested by Dias
Badekas.
* Make values used by M-x php-mode-version literal values
rather than computed ones.
* Change HTML indentation warning to match only HTML at the
beginning of the line.
* Use font-lock-preprocessor-face for PHP and ASP tags.
* The Emacs Lisp source code has had significant whitespace
and style consistency changes.
* Remove conditional bindings and XEmacs-specific code that
likely does nothing.
* Bug fixes:
** Fix function-based commands for functions using the
keyword modifiers (public, private, ...) and the
ampersand character for function-based commands.
** Fix Imenu-support to thandle abstract, final, static,
public, private and protected keywords.
** Fix reversed order of Imenu entries.
** Fix false syntax highlighting of keywords because of
underscore character.
** Fix byte-compiler warnings.
Download from:
http://php-mode.sourceforge.net/
PHP mode was originally written by Turadg Aleahmad. Version
2 of the PHP programming language first appeared in November
of 1997 (called "PHP/FI"). The first release of PHP 3 was
in 1998. The first release of PHP mode as released by
Aleahmad was on 17 May, 1999. In May of 2000, PHP 4 was
released and the PHP PEAR project had begun. The official
1.0 release of php-mode occurred on 21 October, 2001 with
PHP 4 and PEAR support. The 1.1.0 release of php-mode on 24
January, 2004 had initial support for PHP 5. On 13 July,
PHP 5 was officially released. The final release of
php-mode by Aleahmad, version 1.2.0, occurred on 2 August,
2005. The code languished and was forked by a few
individuals. On 16 January, 2008, Aaron S. Hawley became
the project's new maintainer.
The 1.4.0 release of PHP mode improved support for Emacs 22
and CC Mode 5.31. Major modifications were made to the
library to support the latest major release of Emacs. For
that reason, some user customizations made for previous
versions of of PHP mode are not expected to work properly
without some effort.
NOTE: The NEWS for the 1.4.0 release had a factual error.
The php-mode-user-hook was renamed to php-mode-hook, and not
the other way around as it stated.
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.9 (GNU/Linux)
iEYEARECAAYFAkkQks0ACgkQcIdnYI43KSIv2gCeN9mybIdpsaRUs3o+4Ggv71rJ
AvsAoKljkcjzYE63SORsaZPMzuzqIjc6
=WFqo
-----END PGP SIGNATURE-----
-----BEGIN PGP PUBLIC KEY BLOCK-----
Version: GnuPG v1.4.7 (GNU/Linux)
mQGiBEeaKQARBACiOS349KUOyiDS8f/xjUN1Nj0ibbpuxOv4ukwqgnkRs+49WLL9
IpwGdAM3Zenio/EpErZMr3mcOr+k8WqhUBGzUQ+PRqtYPSsYSNLXL0XjXMkdgtOA
E5FIoRW2iJDK3HTYP+xD+U72dHW9kLtMCBNXXE5YZr18glp7XKKZLiLpXwCgu8Ky
8qYmEbSnlsWFUICd0sLs940D/AmLN3ZgaJn85ZWKgkvrtA/e0p2Jz3nW10G9DJVu
shxdmhx0uAzOR1et5Q4OiMr0XZ3jMOJRVjvxrtdIog+mlmmq0L7FikAgjjEHTPeT
2SpB2TOYMlZOk8Yak/lgU1JuWMEgzeS2/VN+TfXnD9OlnKe0jSnL0tjTqhP0iHQx
leE8A/0TFwfOOUUb2qEuD8c18cwiULCmSu57LjkoLV1yyyeQnQGBxdd0raSfBS0O
8jd/M7dEr5o6zU99MrQqc151qDPaxFDlTDrA0o1IVGIEbMkp1x53FUHLIHU+/taG
3kCWJPYuTFsbsHU86QWvdA7PGk92hpgjGvpFueuDyAG1NPOuS7Q+QWFyb24gUy4g
SGF3bGV5IChTb3VyY2VGb3JnZSkgPGFzaGF3bGV5QHVzZXJzLnNvdXJjZWZvcmdl
Lm5ldD6IZgQTEQIAJgUCR5opAAIbAwUJA6QUgAYLCQgHAwIEFQIIAwQWAgMBAh4B
AheAAAoJEHCHZ2CONykiF2UAoKISKWfMkiqSDk+1wUd0awCVr/W/AKCLt4uuJWQf
UjiDYeHVy7jRs9mswLkCDQRHmikAEAgAyNahWpBrNmqMX1cIDwVNBQzUh8CimDEj
0C1afrFQkOR40U5xkR7gqRJZqM20g0/bTikO3jMCmvYfPO5zLuZ7Ze5S6XH5etoE
u0LViMKuuLwsxROIFcNvXY+qV0L11XoT4ENhYZwQg8hNTrj631s93Hl/EgCtwqhT
FvxKepVJpM/6a4i/6NIztKjPoKFh+z5ABM+XqPsVPNWtTRVuzkxOop16IGlAo7Np
ItgLdb+l5Z0lwMWm4b7UsUdsO/HgShcT2B7HaMIWZzv35tCx04uNYdftt278Q3xU
2/DhPLuTHWGfmTMLSaH5q5N5fx67uwgcfg3xurNlulPED77hc6WrfwADBQf/RMmm
UxBVXgg91oz4mhCKK31jFnVjktx3+0ffFM1aOhgNtmBO+eMjmYlRH/1YAVNvhVfk
Ncj6Me8Ca1tSOtGi27rgwnMiLwdVVbBnIlibKui8BP0UFlcy/OzEioxVbDJV1IBZ
UdJqDV7gGeKYCCL62hkOzWifcfrY5KYgrIelIqeeMomKsIsO7BRLcZf+B6a3TTHR
XfB/1Wenti5eW6W6fsSRowdSyT0+EjZYai2HOaxxb/iBdkIfakL+TVGHb//uZH/x
y/IrLN9Rjh5uaz80WKa/7xpLLsSqxrOsVW3+i1j/wPKtvIoeXi7gXjyrt6I4nxIF
SnL8wdHGE1Q5dGnTt4hPBBgRAgAPBQJHmikAAhsMBQkDpBSAAAoJEHCHZ2CONyki
ycQAn1oOKqi+Ty62PUJ4P5ZKjur2BdPbAJ4muMW0j7zLxjCb0wsFuVFN6pOTkA==
=xcSS
-----END PGP PUBLIC KEY BLOCK-----
_______________________________________________
gnu-emacs-sources mailing list
gnu-emacs-sources< at >gnu.org
http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources
Aaron S. Hawley2008-11-04T18:23:33babel.el 0.6
http://comments.gmane.org/gmane.emacs.sources/3058
babel.el was malfunctioning due to back-end changes.
Major changes:
- removed Emacs/W3 dependency
- fixed Google, Yahoo and Free Translation back-end
- improved XEmacs compatibility
;;; babel.el --- interface to web translation services such as Babelfish
;; $Id: babel.el,v 1.12 2008/11/02 11:55:48 juergen Exp $
;;;
;;; Author: Eric Marsden <emarsden< at >laas.fr>
;;; Juergen Hoetzel <juergen< at >hoetzel.info>
;;; Keywords: translation, web
;;; Copyright: (C) 1999-2001 Eric Marsden
;;; 2005-2008 Juergen Hoetzel
;;
;; This program 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 of
;; the License, or (at your option) any later version.
;;
;; This program 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 this program; if not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA.
;;
;; Please send suggestions and bug reports to <emarsden< at >laas.fr>.
;; The latest version of this package should be available at
;;
;; <URL:http://www.hoetzel.info/Hacking/emacs/babel.el>
;;; Commentary:
;;; Overview ==========================================================
;;
;; This module provides an Emacs interface to different translation
;; services available on the Internet. You give it a word or paragraph
;; to translate and select the source and destination languages, and
;; it connects to the translation server, retrieves the data, and
;; presents it in a special *babel* buffer. Currently the following
;; backends are available:
;;
;; * the Babelfish service at babelfish.yahoo.com
;; * the Google service at translate.google.com
;; * the Transparent Language motor at FreeTranslation.com
;;
;; Entry points: either 'M-x babel', which prompts for a phrase, a
;; language pair and a backend, or 'M-x babel-region', which prompts
;; for a language pair and backend, then translates the currently
;; selected region, and 'M-x babel-buffer' to translate the current
;; buffer.
;;
;; If you ask for a language combination which several backends could
;; translate, babel.el will allow you to choose which backend to
;; use. Since most servers have limits on the quantity of text
;; translated, babel.el will split long requests into translatable
;; chunks and submit them sequentially.
;;
;; Please note that the washing process (which takes the raw HTML
;; returned by a translation server and attempts to extract the useful
;; information) is fragile, and can easily be broken by a change in
;; the server's output format. In that case, check whether a new
;; version is available (and if not, warn me; I don't translate into
;; Welsh very often).
;;
;; Also note that by accessing an online translation service you are
;; bound by its Terms and Conditions; in particular
;; FreeTranslation.com is for "personal, non-commercial use only".
;;
;;
;; Installation ========================================================
;;
;; Place this file in a directory in your load-path (to see a list of
;; appropriate directories, type 'C-h v load-path RET'). Optionally
;; byte-compile the file (for example using the 'B' key when the
;; cursor is on the filename in a dired buffer). Then add the
;; following lines to your ~/.emacs.el initialization file:
;;
;; (autoload 'babel "babel"
;; "Use a web translation service to translate the message MSG." t)
;; (autoload 'babel-region "babel"
;; "Use a web translation service to translate the current region." t)
;; (autoload 'babel-as-string "babel"
;; "Use a web translation service to translate MSG, returning a string." t)
;; (autoload 'babel-buffer "babel"
;; "Use a web translation service to translate the current buffer." t)
;;
;; babel.el requires emacs >= 22
;;
;;
;; Backend information =================================================
;;
;; A babel backend named <zob> must provide three functions:
;;
;; (babel-<zob>-translation from to)
;;
;; where FROM and TO are three-letter language abbreviations from
;; the alist `babel-languages'. This should return non-nil if the
;; backend is capable of translating between these two languages.
;;
;; (babel-<zob>-fetch msg from to)
;;
;; where FROM and TO are as above, and MSG is the text to
;; translate. Connect to the appropriate server and fetch the raw
;; HTML corresponding to the request.
;;
;; (babel-<zob>-wash)
;;
;; When called on a buffer containing the raw HTML provided by the
;; server, remove all the uninteresting text and HTML markup.
;;
;; I would be glad to incorporate backends for new translation servers
;; which are accessible to the general public. List of translation
;; engines and multilingual dictionaries at
;; <URL:http://funsan.biomed.mcgill.ca/~funnell/language.html>.
;;
;;
;; <URL:http://www.xmethods.net/sd/BabelFishService.wsdl>
;;
;; babel.el was inspired by a posting to the ding list by Steinar Bang
;; <sb< at >metis.no>. Morten Eriksen <mortene< at >sim.no> provided several
;; patches to improve InterTrans washing. Thanks to Per Abrahamsen and
;; Thomas Lofgren for pointing out a bug in the keymap code. Matt
;; Hodges <pczmph< at >unix.ccc.nottingham.ac.uk> suggested ignoring case
;; on completion. Colin Marquardt suggested
;; `babel-preferred-to-language'. David Masterson suggested adding a
;; menu item.
;;
;; User quotes: Dieses ist die grte Sache seit geschnittenem Brot.
;; -- Stainless Steel Rat <ratinox< at >peorth.gweep.net>
;;; History
;; 0.6 * get rid of w3-region (implementend basic html entity parsing)
;; * get rid of w3-form-encode-xwfu (using mm-url-form-encode-xwfu)
;; * no character classes in regex (for xemacs compatibility)
;; * default backend: Google
;; 0.5: * Fixed Google and Babelfish backends
;; 0.4: * revised FreeTranslation backend
;;; 0.3: * removed non-working backends: systran, intertrans, leo, e-PROMPT
;;; * added Google backend
;;; * revised UTF-8 handling
;;; * Added customizable variables: babel-preferred-to-language, babel-preferred-from-language
;;; * revised history handling
;;; * added helper function: babel-wash-regex
;;; Code:
(require 'cl)
(require 'mm-url)
(require 'easymenu)
;; xemacs compatibility
(eval-and-compile
(when (featurep 'xemacs)
(defun url-retrieve-synchronously (url)
(save-excursion
(cdr (url-retrieve url))))))
;; ======================================================================
;;; Customizables
;; ======================================================================
(defgroup babel nil
"provides an Emacs interface to different translation services available on the Internet"
:group 'applications)
(defconst babel-version 0.6
"The version number of babel.el")
(defconst babel-languages
'(("English" . "eng")
("Brazilian Portuguese" . "pob")
("German" . "ger")
("Dutch" . "dut")
("Latin American Spanish" . "spl")
("Spanish" . "spa")
("European Spanish" . "spe")
("French" . "fre")
("Japanese (Shift JIS)" . "jpn")
("Danish" . "dan")
("Icelandic" . "ice")
("Finnish" . "fin")
("Italian" . "ita")
("Norwegian" . "nor")
("Swedish" . "swe")
("Portuguese" . "poe")
("Russian" . "rus")
("Croatian (CP 1250)" . "cro")
("Hungarian (CP 1250)" . "hun")
("Polish (CP 1250)" . "pol")
("Czech (CP 1250)" . "che")
("Serbian (Latin)" . "sel")
("Slovenian (CP 1250)" . "slo")
("Greek" . "grk")
("Welsh" . "wel")
("Esperanto" . "esp")
("Lojban" . "loj")
("Simplified Chinese" . "schi")
("Traditional Chinese" . "tchi")
))
(defcustom babel-preferred-to-language "German"
"*Default target translation language.
This must be the long name of one of the languages in the alist"
:type `(choice ,< at >(mapcar (lambda (s) `(const ,(car s))) babel-languages))
:set (lambda (symbol value)
(set-default symbol value)
(setq babel-to-history (list value)))
:group 'babel)
(defcustom babel-preferred-from-language "English"
"*Default target translation language.
This must be the long name of one of the languages in the alist"
:type `(choice ,< at >(mapcar (lambda (s) `(const ,(car s))) babel-languages))
:set (lambda (symbol value)
(set-default symbol value)
(setq babel-from-history (list value)))
:group 'babel)
(defvar babel-to-history (list babel-preferred-to-language))
(defvar babel-from-history (list babel-preferred-to-language))
(defvar babel-backend-history (list))
(defvar babel-mode-hook nil)
(defvar babel-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "q") #'bury-buffer)
(define-key map (kbd "SPC") #'scroll-up)
(define-key map (kbd "DEL") #'scroll-down)
(define-key map (kbd "<") #'beginning-of-buffer)
(define-key map (kbd ">") #'end-of-buffer)
(define-key map (kbd "s") #'isearch-forward)
(define-key map (kbd "r") #'isearch-backward)
(define-key map (kbd "h") #'describe-mode)
map)
"Keymap used in Babel mode.")
(defvar babel-backends
'(("Google" . google)
("Babelfish at Yahoo" . fish)
("FreeTranslation" . free))
"List of backends for babel translations.")
(defun babel-sentence-end()
"portability function. emacs 22.0.50 introduced sentence-end
function, not available on other emacsen"
(if (fboundp 'sentence-end)
(sentence-end)
sentence-end))
(defun babel-url-retrieve (url charset)
"Retrieve URL and decode to charset"
(let ((current (current-buffer))
(tmp (url-retrieve-synchronously url)))
(with-current-buffer tmp
(mm-decode-coding-region (point-min) (point-max) charset)
(set-buffer-file-coding-system charset)
(mm-enable-multibyte)
(copy-to-buffer current (point-min) (point-max)))
(kill-buffer tmp)))
(defun babel-wash-regex (regex)
"Extract the useful information from the HTML returned by fetch function
translated text should be inside parenthesized expression in regex"
(goto-char (point-min))
(if (search-forward-regexp regex (point-max) t)
(progn
(delete-region (match-end 1) (point-max))
(delete-region (point-min) (match-beginning 1))
t)))
;;;###autoload
(defun babel (msg &optional no-display)
"Use a web translation service to translate the message MSG.
Display the result in a buffer *babel* unless the optional argument
NO-DISPLAY is nil."
(interactive "sTranslate phrase: ")
(let* ((completion-ignore-case t)
(from-suggest (or (first babel-from-history) (caar babel-languages)))
(from-long
(completing-read "Translate from: "
babel-languages nil t
(cons from-suggest 0)
'babel-from-history))
(to-avail (remove* from-long babel-languages
:test #'(lambda (a b) (string= a (car b)))))
(to-suggest (or (first
(remove* from-long babel-to-history
:test #'string=))
(caar to-avail)))
(to-long
(completing-read "Translate to: " to-avail nil t
(cons to-suggest 0)
'babel-to-history))
(from (cdr (assoc from-long babel-languages)))
(to (cdr (assoc to-long babel-languages)))
(backends (babel-get-backends from to))
(backend-str
(completing-read "Using translation service: "
backends nil t
(cons (or (member (first babel-backend-history) backends) (caar backends)) 0) ;TOD also check rest of babel-backend-history
'babel-backend-history))
(backend (symbol-name (cdr (assoc backend-str babel-backends))))
(fetcher (intern (concat "babel-" backend "-fetch")))
(washer (intern (concat "babel-" backend "-wash")))
(chunks (babel-chunkify msg 700))
(translated-chunks '())
(view-read-only nil))
(loop for chunk in chunks
do (push (babel-work chunk from to) translated-chunks))
(if no-display
(apply #'concat (nreverse translated-chunks))
(with-output-to-temp-buffer "*babel*"
(message "Translating...")
(loop for tc in (nreverse translated-chunks)
do (princ tc))
(save-excursion
(set-buffer "*babel*")
(babel-mode))
(message "Translating...done")))))
;;;###autoload
(defun babel-region (start end)
"Use a web translation service to translate the current region."
(interactive "r")
(babel (buffer-substring-no-properties start end)))
;;;###autoload
(defun babel-as-string (msg)
"Use a web translation service to translate MSG, returning a string."SysTran
(interactive "sTranslate phrase: ")
(babel msg t))
;; suggested by Djalil Chafai <djalil< at >free.fr>
;;
;;;###autoload
(defun babel-buffer ()
"Use a web translation service to translate the current buffer.
Default is to present the translated text in a *babel* buffer.
With a prefix argument, replace the current buffer contents by the
translated text."
(interactive)
(let (pos)
(cond (prefix-arg
(setq pos (point-max))
(goto-char pos)
(insert
(babel-as-string
(buffer-substring-no-properties (point-min) (point-max))))
(delete-region (point-min) pos))
(t
(babel-region (point-min) (point-max))))))
(defun babel-work (msg from to)
(save-excursion
(set-buffer (get-buffer-create " *babelurl*"))
(erase-buffer)
(funcall fetcher (babel-preprocess msg) from to)
(funcall washer)
(babel-postprocess)
(babel-simple-html-parse)
(babel-display)
(buffer-substring-no-properties (point-min) (point-max))))
(defun babel-get-backends (from to)
"Return a list of those backends which are capable of translating
language FROM into language TO."
(loop for b in babel-backends
for name = (symbol-name (cdr b))
for translator = (intern (concat "babel-" name "-translation"))
for translatable = (funcall translator from to)
if translatable collect b))
(defconst babel-html-entity-regex
"&\\(#\\([0-9]+\\)\\|\\([a-zA-Z]+\\)\\);")
(defun babel-decode-html-entitiy (str)
(if (and str (string-match babel-html-entity-regex
str))
(if (string= (substring str 1 2) "#")
;TODO: xemacs
(if (not (featurep 'xemacs))
(let ((number (match-string-no-properties 2 str)))
(decode-char 'ucs (string-to-number number)))
str)
(let ((letter (match-string-no-properties 3 str)))
(cond ((string= "gt" letter) ">")
((string= "lt" letter) "<")
(t "?"))))))
(defun babel-display ()
"Parse and display the region of this for basic HTML entities."
(save-excursion
(goto-char (point-min))
(while (and (< (point) (point-max)) (search-forward-regexp
babel-html-entity-regex
(point-max) t))
(let* ((start (match-beginning 0))
(end (match-end 0))
(entity (buffer-substring start end))
(replacement (babel-decode-html-entitiy entity)))
(delete-region start end)
(insert-string replacement)))))
(defun babel-mode ()
(interactive)
(use-local-map babel-mode-map)
(setq major-mode 'babel-mode
mode-name "Babel")
(run-hooks 'babel-mode-hook))
(cond ((fboundp 'string-make-unibyte)
(fset 'babel-make-unibyte #'string-make-unibyte))
((fboundp 'string-as-unibyte)
(fset 'babel-make-unibyte #'string-as-unibyte))
(t
(fset 'babel-make-unibyte #'identity)))
;; from nnweb.el, with added `string-make-unibyte'.
(defun babel-form-encode (pairs)
"Return PAIRS encoded for forms."
(mapconcat
(lambda (data)
(concat (mm-url-form-encode-xwfu (babel-make-unibyte (car data))) "="
(mm-url-form-encode-xwfu (babel-make-unibyte (cdr data)))))
pairs "&"))
;; We mark paragraph endings with a special token, so that we can
;; recover a little information on the original message's format after
;; translation and washing and rendering. Should really be using
;; `paragraph-start' and `paragraph-separate' here, but we no longer
;; have any information on the major-mode of the buffer that STR was
;; ripped from.
;;
;; This kludge depends on the fact that all the translation motors
;; seem to leave words they don't know how to translate alone, passing
;; them through untouched.
(defun babel-preprocess (str)
(while (string-match "\n\n\\|^\\s-+$" str)
(setq str (replace-match " FLOBSiCLE " nil t str)))
str)
;; decode paragraph endings in current buffer
(defun babel-postprocess ()
(goto-char (point-min))
(while (search-forward "FLOBSiCLE" nil t)
(replace-match "\n<p>" nil t)))
(defun babel-simple-html-parse ()
"Replace basic html markup"
(goto-char (point-min))
(replace-regexp "<\\(br\\|p\\)/?>" "\n"))
;; split STR into chunks of around LENGTH characters, trying to
;; maintain sentence structure (this is used to send big requests in
;; several batches, because otherwise the motors cut off the
;; translation).
(defun babel-chunkify (str chunksize)
(let ((start 0)
(pos 0)
(chunks '()))
(while (setq pos (string-match (babel-sentence-end) str pos))
(incf pos)
(when (> (- pos start) chunksize)
(push (substring str start pos) chunks)
(setq start pos)))
(when (/= start (length str))
(push (substring str start) chunks))
(nreverse chunks)))
;;;###autoload
(defun babel-version (&optional here)
"Show the version number of babel in the minibuffer.
If optional argument HERE is non-nil, insert version number at point."
(interactive "P")
(let ((version-string
(format "Babel version %s" babel-version)))
(if here
(insert version-string)
(if (interactive-p)
(message "%s" version-string)
version-string))))
;; Babelfish-specific functions ================================================
;;
;; Babelfish (which uses the SysTran engine) is only able to translate
;; between a limited number of languages.
;; translation from 3-letter names to Babelfish 2-letter names
(defconst babel-fish-languages
'(("eng" . "en")
("ger" . "de")
("ita" . "it")
("poe" . "pt")
("spe" . "es")
("fre" . "fr")))
;; those inter-language translations that Babelfish is capable of
(defconst babel-fish-translations
'("en_fr" "en_de" "en_it" "en_pt" "en_es" "fr_en" "de_en" "it_en"
"es_en" "pt_en"))
;; if Babelfish is able to translate from language FROM to language
;; TO, then return the corresponding string, otherwise return nil
(defun babel-fish-translation (from to)
(let* ((fromb (cdr (assoc from babel-fish-languages)))
(tob (cdr (assoc to babel-fish-languages)))
(comb (and fromb tob (concat fromb "_" tob))))
(find comb babel-fish-translations :test #'string=)))
(defun babel-fish-fetch (msg from to)
"Connect to the Babelfish server and request the translation."
(let ((coding-system-for-read 'utf-8)
(translation (babel-fish-translation from to)))
(unless translation
(error "Babelfish can't translate from %s to %s" from to))
(let* ((pairs `(("trtext" . ,(mm-encode-coding-string msg 'utf-8))
("lp" . ,translation)
("ei" . "UTF-8")
("doit" . "done")
("fr" . "bf-res")
("intl" . "1")
("tt" . "urltext")
("btnTrTxt" . "Translate")))
(url-request-data (babel-form-encode pairs))
(url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded"))))
(babel-url-retrieve "http://babelfish.yahoo.com/translate_txt" 'utf-8))))
(defun babel-fish-wash ()
"Extract the useful information from the HTML returned by Babelfish."
(if (not (babel-wash-regex "<div id=\"result\"><div style=\"padding:[0-9.]*em;\">\\([^<]*\\)</div></div>"))
(error "Babelfish HTML has changed ; please look for a new version of babel.el")))
;; FreeTranslation.com stuff ===========================================
;; translation from 3-letter names to FreeTranslation names
(defconst babel-free-languages
'(("eng" . "English")
("ger" . "German")
("ita" . "Italian")
("dut" . "Dutch")
("poe" . "Portuguese")
("spe" . "Spanish")
("nor" . "Norwegian")
("rus" . "Russian")
("schi" . "SimplifiedChinese")
("tchi" . "TraditionalChinese")
("fre" . "French")))
;; those inter-language translations that FreeTranslation is capable of
(defconst babel-free-translations
'("English/Spanish" "English/French" "English/German" "English/Italian" "English/Dutch" "English/Portuguese"
"English/Russian" "English/Norwegian" "English/SimplifiedChinese" "English/TraditionalChinese" "Spanish/English"
"French/English" "German/English" "Italian/English" "Dutch/English" "Portuguese/English"))
(defun babel-free-translation (from to)
(let* ((ffrom (cdr (assoc from babel-free-languages)))
(fto (cdr (assoc to babel-free-languages)))
(trans (concat ffrom "/" fto)))
(find trans babel-free-translations :test #'string=)))
(defun babel-free-fetch (msg from to)
"Connect to the FreeTranslation server and request the translation."
(let ((coding-system-for-read 'utf-8)
(translation (babel-free-translation from to))
url)
(unless translation
(error "FreeTranslation can't translate from %s to %s" from to))
(setq url
(cond ((string= translation "English/Russian") "http://ets6.freetranslation.com/")
((string= translation "English/SimplifiedChinese") "http://ets6.freetranslation.com/")
((string= translation "English/TraditionalChinese") "http://ets6.freetranslation.com/")
(t "http://ets.freetranslation.com/")))
(let* ((pairs `(("sequence" . "core")
("mode" . "html")
("template" . "results_en-us.htm")
("srctext" . ,msg)
("charset" . "UTF-8")
("language" . ,translation)))
(url-request-data (babel-form-encode pairs))
(url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded"))))
(babel-url-retrieve url 'utf-8))))
(defun babel-free-wash ()
"Extract the useful information from the HTML returned by FreeTranslation."
;;; <textarea name="dsttext" cols="40" rows="6">hello together</textarea><br />
(if (not (babel-wash-regex "<textarea name=\"dsttext\"[^>]+>\\([^<]*\\)</textarea>"))
(error "FreeTranslations HTML has changed ; please look for a new version of babel.el")))
;; Google stuff ===========================================
;;
;; Contributed by Juergen Hoetzel <juergen< at >hoetzel.info>
;; translation from 3-letter names to Google 2-letter names
(defconst babel-google-languages
'(("eng" . "en")
("ger" . "de")
("spe" . "es")
("fre" . "fr")
("ita" . "it")
("pob" . "pt")
("jpn" . "ja")
;TODO: "en|ko"English to Korean BETA
;TODO: "en|zh-CN"English to Chinese (Simplified) BETA
))
;; those inter-language translations that Google is capable of
(defconst babel-google-translations
'("en|de" "en|es" "en|fr" "en|it" "en|pt" "en|ja" "en|ko" "en|zh-CN"
"de|en" "de|fr" "es|en" "fr|en" "fr|de" "it|en" "pt|en" "ja|en" "ko|en" "zh-CN|en"))
;; if Google is able to translate from language FROM to language
;; TO, then return the corresponding string, otherwise return nil
(defun babel-google-translation (from to)
(let* ((fromb (cdr (assoc from babel-google-languages)))
(tob (cdr (assoc to babel-google-languages)))
(comb (and fromb tob (concat fromb "|" tob))))
(find comb babel-google-translations :test #'string=)))
(defun babel-google-fetch (msg from to)
"Connect to google server and request the translation."
(let ((coding-system-for-read 'utf-8)
(translation (babel-google-translation from to)))
(unless translation
(error "Google can't translate from %s to %s" from to))
(let* ((pairs `(("text" . ,(mm-encode-coding-string msg 'utf-8))
("hl" . "en")
("Language" . "English")
("ie" . "UTF-8")
("oe" . "UTF-8")
("langpair" . ,translation)))
(url-request-data (babel-form-encode pairs))
(url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded"))))
(babel-url-retrieve "http://translate.google.com/translate_t" 'utf-8))))
(defun babel-google-wash ()
"Extract the useful information from the HTML returned by google."
(if (not (babel-wash-regex "<div id=result_box dir=\"[^\"]*\">\\(.*\\)</div></td></tr><tr><td[ \t]*class=submitcell>"))
(error "Google HTML has changed ; please look for a new version of babel.el")))
;; TODO: ecs.freetranslation.com
;; (defun babel-debug ()
;; (let ((buf (get-buffer-create "*babel-debug*")))
;; (set-buffer buf)
;; (babel-free-fetch "state mechanisms are too busy" "eng" "ger")))
(easy-menu-add-item nil '("tools") ["Babel Translation" babel t])
(provide 'babel)
;; babel.el ends here
_______________________________________________
gnu-emacs-sources mailing list
gnu-emacs-sources< at >gnu.org
http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources
Jürgen Hötzel2008-11-03T20:31:22js-comint.el
http://comments.gmane.org/gmane.emacs.sources/3057
Js-comint.el is a javascript comint mode which lets you run a
javascript interpreter from within emacs. It's hosted on
http://sourceforge.net/projects/js-comint-el and has a web page which
can be found here:
http://js-comint-el.sourceforge.net/
It works really well in conjunction with js2-mode by Steve Yegge for
javascript editing. Questions or comments can be sent to me.
Suggestions for imrpovement are always welcome.
;;; js-comint.el --- Run javascript in an inferior process window.
;;; Copyright (C) 2008 Paul Huff
;;; Author: Paul Huff <paul.huff< at >gmail.com>
;;; Maintainer: Paul Huff <paul.huff< at >gmail.com>
;;; Created: 26 May 2008
;;; Version: 0.0.1
;;; Package-Requires: ()
;;; Keywords: javascript, inferior-mode, convenience
;; js-comint.el 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.
;; js-comint.el 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, or type `C-h C-c'. If
;; not, write to the Free Software Foundation at this address:
;; Free Software Foundation
;; 51 Franklin Street, Fifth Floor
;; Boston, MA 02110-1301
;; USA
;;; Commentary:
;;; js-comint.el let's you run an inferior javascript process in emacs,
;;; and defines a few functions for sending javascript input to it quickly.
;; Usage:
;; Put js-comint.el in your load path
;; Add (require 'js-comint) to your .emacs
;; Set inferior-js-program-command to the execution command for running your javascript REPL
;; (setq inferior-js-program-command "/path/to/executable <args>")
;; Do: M-x run-js
;; Away you go.
;; I've added the following couple of lines to my .emacs to take advantage of
;; cool keybindings for sending things to the javascript interpreter inside
;; of Steve Yegge's most excellent js2-mode.
;; (add-hook 'js2-mode-hook '(lambda ()
;; (local-set-key "\C-x\C-e" 'js-send-last-sexp)
;; (local-set-key "\C-\M-x" 'js-send-last-sexp-and-go)
;; (local-set-key "\C-cb" 'js-send-buffer)
;; (local-set-key "\C-c\C-b" 'js-send-buffer-and-go)
;; (local-set-key "\C-cl" 'js-load-file-and-go)
;; ))
;; This is version 0.0.1, so I've only tested it on my own version of emacs which is currently:
;; GNU Emacs 22.0.90.1 (i386-apple-darwin8.8.1, Carbon Version 1.6.0) of 2006-10-28
;; Not sure if it'll work anywhere else, but it doesn't require anything apple-ish, just emacs-ish.
;; Additionally, I've only tested this with rhino. I'm sure it'll probably work with spidermonkey,
;; though if it barfs let me know, and I'll update it.
;; I'm a newbie elisper, so please let me know if I'm a. doing things the wrong way, b.
;; making things work they way they shouldn't in the elisp world.
;;; History:
;;
;;; Code:
(require 'comint)
(provide 'js-comint)
(defcustom inferior-js-program-command "/usr/bin/java org.mozilla.javascript.tools.shell.Main" "Path to the javascript interpreter")
(defgroup inferior-js nil
"Run a javascript process in a buffer."
:group 'inferior-js)
(defcustom inferior-js-mode-hook nil
"*Hook for customizing inferior-js mode."
:type 'hook
:group 'inferior-js)
;;;###autoload
(defun run-js (cmd &optional dont-switch-p)
"Run an inferior Javascript process, input and output via buffer `*js*'.
If there is a process already running in `*js*', switch to that buffer.
With argument, allows you to edit the command line (default is value
of `inferior-js-program-command').
Runs the hook `inferior-js-mode-hook' \(after the `comint-mode-hook'
is run).
\(Type \\[describe-mode] in the process buffer for a list of commands.)"
(interactive (list (if current-prefix-arg
(read-string "Run js: " inferior-js-program-command)
inferior-js-program-command)))
(if (not (comint-check-proc "*js*"))
(save-excursion (let ((cmdlist (split-string cmd)))
(set-buffer (apply 'make-comint "js" (car cmdlist)
nil (cdr cmdlist)))
(inferior-js-mode))))
(setq inferior-js-program-command cmd)
(setq inferior-js-buffer "*js*")
(if (not dont-switch-p)
(pop-to-buffer "*js*")))
;;;###autoload
(defun js-send-region (start end)
"Send the current region to the inferior Javascript process."
(interactive "r")
(run-js inferior-js-program-command t)
(comint-send-region inferior-js-buffer start end)
(comint-send-string inferior-js-buffer "\n"))
;;;###autoload
(defun js-send-region-and-go (start end)
"Send the current region to the inferior Javascript process."
(interactive "r")
(run-js inferior-js-program-command t)
(comint-send-region inferior-js-buffer start end)
(comint-send-string inferior-js-buffer "\n")
(switch-to-js inferior-js-buffer))
;;;###autoload
(defun js-send-last-sexp-and-go ()
"Send the previous sexp to the inferior Js process."
(interactive)
(js-send-region-and-go (save-excursion (backward-sexp) (point)) (point)))
;;;###autoload
(defun js-send-last-sexp ()
"Send the previous sexp to the inferior Javascript process."
(interactive)
(js-send-region (save-excursion (backward-sexp) (point)) (point)))
;;;###autoload
(defun js-send-buffer ()
"Send the buffer to the inferior Javascript process."
(interactive)
(js-send-region (point-min) (point-max)))
;;;###autoload
(defun js-send-buffer-and-go ()
"Send the buffer to the inferior Javascript process."
(interactive)
(js-send-region-and-go (point-min) (point-max)))
;;;###autoload
(defun js-load-file (filename)
"Load a file in the javascript interpreter."
(interactive "f")
(let ((filename (expand-file-name filename)))
(run-js inferior-js-program-command t)
(comint-send-string inferior-js-buffer (concat "load(\"" filename "\")\n"))))
;;;###autoload
(defun js-load-file-and-go (filename)
"Load a file in the javascript interpreter."
(interactive "f")
(let ((filename (expand-file-name filename)))
(run-js inferior-js-program-command t)
(comint-send-string inferior-js-buffer (concat "load(\"" filename "\")\n"))
(switch-to-js inferior-js-buffer)))
;;;###autoload
(defun switch-to-js (eob-p)
"Switch to the javascript process buffer.
With argument, position cursor at end of buffer."
(interactive "P")
(if (or (and inferior-js-buffer (get-buffer inferior-js-buffer))
(js-interactively-start-process))
(pop-to-buffer inferior-js-buffer)
(error "No current process buffer. See variable `inferior-js-buffer'"))
(when eob-p
(push-mark)
(goto-char (point-max))))
(defvar inferior-js-buffer)
(defvar inferior-js-mode-map
(let ((m (make-sparse-keymap)))
(define-key m "\C-x\C-e" 'js-send-last-sexp)
(define-key m "\C-cl" 'js-load-file)
m))
;;;###autoload
(define-derived-mode inferior-js-mode comint-mode "Inferior Javascript"
"Major mode for interacting with an inferior javascript process.
The following commands are available:
\\{inferior-js-mode-map}
A javascript process can be fired up with M-x run-js.
Customization: Entry to this mode runs the hooks on comint-mode-hook and
inferior-js-mode-hook (in that order).
You can send text to the inferior Javascript process from othber buffers containing
Javascript source.
switch-to-js switches the current buffer to the Javascript process buffer.
js-send-region sends the current region to the Javascript process.
"
(use-local-map inferior-js-mode-map)
)
paul.huff< at >gmail.com2008-10-31T02:55:18lsl-mode_Xah_Lee.el v.1 — major mode for Linden Scripting Language
http://comments.gmane.org/gmane.emacs.sources/3056
lsl-mode_Xah_Lee.el v.1
A major mode for editing LSL (Linden Scripting Language).
Notable Features:
• Support lslint for syntax checking.
• Support reference lookup of current word.
• Keyboard shortcut for copying entire buffer content.
• Support the most up-to-date keywords of lsl for syntax highlighting,
including constants, events, data types.
• Support comment-dwim.
• Support emacs's customize-group.
Download location: http://xahlee.org/sl/ls-emacs.html
This package is actively updated. Please send me comments and
suggestions.
Xah
∑ http://xahlee.org/
☄
Xah2008-10-30T21:24:15etags-table.el v1.0
http://comments.gmane.org/gmane.emacs.sources/3055
This extension sets the tags table(s) based on the current file (inspired
by XEmacs’ etags handling). ‘etags-table-alist’ is a list of lists, where
the car of each sublist is compared to the current filename. If it matches,
all the rest of the list elements are put on ‘tags-table-list’. If
‘etags-table-search-up-depth’ is an integer, the file path will be searched
upwards for a tags file. If one is found, it will be added to the tags table
list; this is actually done first so the local TAGS file is at the head of
the list.
When you switch files and do something tag-related, the tags table list is
automatically recomputed.
;;; etags-table.el --- Set tags table(s) based on current file
;; Copyright (C) 2008 Scott Frazer
;; Author: Scott Frazer <frazer.scott< at >gmail.com>
;; Maintainer: Scott Frazer <frazer.scott< at >gmail.com>
;; Created: 28 Oct 2008
;; Version: 1.0
;; Keywords: etags tags tag
;; 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:
;; This extension sets the tags table(s) based on the current file.
;; `etags-table-alist' is a list of lists, where the car of each sublist is
;; compared to the current filename. If it matches, all the rest of the list
;; elements are put on `tags-table-list'. If `etags-table-search-up-depth' is
;; an integer, the file path will be searched upwards for a tags file. If one
;; is found, it will be added to the tags table list; this is actually done
;; first so the local TAGS file is at the head of the list.
;;
;; When you switch files and do something tag-related, the tags table list is
;; automatically recomputed.
;;; Change log:
;;
;; 28 Oct 2008 -- v1.0
;; Initial release
;;; Code:
(require 'custom)
(require 'etags)
;;;###autoload
(defgroup etags-table nil
"*etags table"
:group 'etags)
;;;###autoload
(defcustom etags-table-alist nil
"*Map filename to tag file(s)
Example:
(setq etags-table-alist
(list
\'(\"/home/me/Projects/foo/.*\\\\.[ch]$\" \"/home/me/Projects/lib1/TAGS\" \"/home/me/Projects/lib2/TAGS\")
\'(\"/home/me/Projects/bar/.*\\\\.py$\" \"/home/me/Projects/python/common/TAGS\")
\'(\".*\\\\.[ch]$\" \"/usr/local/include/TAGS\")
))
A file named, for example, \"/home/me/Projects/foo/main.c\" would set the
`tags-table-list' to a list of:
\"/home/me/Projects/lib1/TAGS\"
\"/home/me/Projects/lib2/TAGS\"
\"/usr/local/include/TAGS\"
and possibly a local tags file at the head of the list if `etags-table-search-up-depth'
is non-nil.
"
:group 'etags-table
:type 'alist)
;;;###autoload
(defcustom etags-table-search-up-depth nil
"*Max depth to search up for a tags file. nil means don't search."
:group 'etags-table
:type 'integer)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun etags-table-build-table-list (filename