Mercurial > emacs
view lisp/gnus/uudecode.el @ 82396:71b7e41a7415
(initialization): Change parent group from `internal'
to `environment'.
(initial-buffer-choice): New variable.
(command-line): Revert 2007-07-02 change that sets
buffer-offer-save in *scratch* and enables auto-save in it.
(fancy-splash-text): Add links to existing items. Add new items
with links for useful tasks. Move information about Control-g to
fancy-splash-head. Move "Emacs Guided Tour" to the end.
(fancy-splash-keymap): New variable.
(fancy-splash-last-input-event): Remove variable.
(fancy-splash-insert): Add processing of `:link' element.
(fancy-splash-head): Replace "Type Control-l to begin editing"
with "Type `q' to exit".
(fancy-splash-screens-1): Let-bind inhibit-read-only to t.
(fancy-splash-default-action, fancy-splash-special-event-action):
Remove functions.
(fancy-splash-quit): New function.
(fancy-splash-screens): Rename input arg from `hide-on-input' to
`static' and reverse the condition of its usage. Don't preserve
original values of `minor-mode-map-alist',
`emulation-mode-map-alists', `special-event-map'.
Rename startup-buffer from "*About GNU Emacs*" to " GNU Emacs".
Rename about-buffer from " GNU Emacs" to " About GNU Emacs".
Remove processing of special events. Use local key map
`fancy-splash-keymap'. Set buffer to read-only.
(normal-splash-screen): Rename input arg from `hide-on-input' to
`static' and reverse the condition of its usage.
Rename startup-buffer from "*About GNU Emacs*" to " GNU Emacs".
Rename about-buffer from " GNU Emacs" to " About GNU Emacs".
Add links to existing items. Add new items with links for useful
tasks. Use local key map `fancy-splash-keymap'.
(display-splash-screen): Rename input arg from `hide-on-input' to
`static'.
(about-emacs): Add alias to display-splash-screen.
(command-line-1): Use `initial-buffer-choice'.
author | Juri Linkov <juri@jurta.org> |
---|---|
date | Wed, 15 Aug 2007 23:22:43 +0000 |
parents | 24202b793a08 |
children | 1cb31606209f a3c27999decb f55f9811f5d7 |
line wrap: on
line source
;;; uudecode.el -- elisp native uudecode ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, ;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> ;; Keywords: uudecode news ;; This file is part of GNU Emacs. ;; GNU Emacs 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 3, or (at your option) ;; any later version. ;; GNU Emacs 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: ;;; Code: (autoload 'executable-find "executable") (eval-when-compile (require 'cl)) (eval-and-compile (defalias 'uudecode-char-int (if (fboundp 'char-int) 'char-int 'identity))) (defcustom uudecode-decoder-program "uudecode" "*Non-nil value should be a string that names a uu decoder. The program should expect to read uu data on its standard input and write the converted data to its standard output." :type 'string :group 'gnus-extract) (defcustom uudecode-decoder-switches nil "*List of command line flags passed to `uudecode-decoder-program'." :group 'gnus-extract :type '(repeat string)) (defcustom uudecode-use-external (executable-find uudecode-decoder-program) "*Use external uudecode program." :version "22.1" :group 'gnus-extract :type 'boolean) (defconst uudecode-alphabet "\040-\140") (defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") (defconst uudecode-end-line "^end[ \t]*$") (defconst uudecode-body-line (let ((i 61) (str "^M")) (while (> (setq i (1- i)) 0) (setq str (concat str "[^a-z]"))) (concat str ".?$"))) (defvar uudecode-temporary-file-directory (cond ((fboundp 'temp-directory) (temp-directory)) ((boundp 'temporary-file-directory) temporary-file-directory) ("/tmp"))) ;;;###autoload (defun uudecode-decode-region-external (start end &optional file-name) "Uudecode region between START and END using external program. If FILE-NAME is non-nil, save the result to FILE-NAME. The program used is specified by `uudecode-decoder-program'." (interactive "r\nP") (let ((cbuf (current-buffer)) tempfile firstline status) (save-excursion (goto-char start) (when (re-search-forward uudecode-begin-line nil t) (forward-line 1) (setq firstline (point)) (cond ((null file-name)) ((stringp file-name)) (t (setq file-name (read-file-name "File to Name:" nil nil nil (match-string 1))))) (setq tempfile (if file-name (expand-file-name file-name) (if (fboundp 'make-temp-file) (let ((temporary-file-directory uudecode-temporary-file-directory)) (make-temp-file "uu")) (expand-file-name (make-temp-name "uu") uudecode-temporary-file-directory)))) (let ((cdir default-directory) (default-process-coding-system (if (featurep 'xemacs) ;; In XEmacs, `nil' is not a valid coding system. '(binary . binary) nil))) (unwind-protect (with-temp-buffer (insert "begin 600 " (file-name-nondirectory tempfile) "\n") (insert-buffer-substring cbuf firstline end) (cd (file-name-directory tempfile)) (apply 'call-process-region (point-min) (point-max) uudecode-decoder-program nil nil nil uudecode-decoder-switches)) (cd cdir) (set-buffer cbuf))) (if (file-exists-p tempfile) (unless file-name (goto-char start) (delete-region start end) (let (format-alist) (insert-file-contents-literally tempfile))) (message "Can not uudecode"))) (ignore-errors (or file-name (delete-file tempfile)))))) (eval-and-compile (defalias 'uudecode-string-to-multibyte (cond ((featurep 'xemacs) 'identity) ((fboundp 'string-to-multibyte) 'string-to-multibyte) (t (lambda (string) "Return a multibyte string with the same individual chars as string." (mapconcat (lambda (ch) (string-as-multibyte (char-to-string ch))) string "")))))) ;;;###autoload (defun uudecode-decode-region-internal (start end &optional file-name) "Uudecode region between START and END without using an external program. If FILE-NAME is non-nil, save the result to FILE-NAME." (interactive "r\nP") (let ((done nil) (counter 0) (remain 0) (bits 0) (lim 0) inputpos result (non-data-chars (concat "^" uudecode-alphabet))) (save-excursion (goto-char start) (when (re-search-forward uudecode-begin-line nil t) (cond ((null file-name)) ((stringp file-name)) (t (setq file-name (expand-file-name (read-file-name "File to Name:" nil nil nil (match-string 1)))))) (forward-line 1) (skip-chars-forward non-data-chars end) (while (not done) (setq inputpos (point)) (setq remain 0 bits 0 counter 0) (cond ((> (skip-chars-forward uudecode-alphabet end) 0) (setq lim (point)) (setq remain (logand (- (uudecode-char-int (char-after inputpos)) 32) 63)) (setq inputpos (1+ inputpos)) (if (= remain 0) (setq done t)) (while (and (< inputpos lim) (> remain 0)) (setq bits (+ bits (logand (- (uudecode-char-int (char-after inputpos)) 32) 63))) (if (/= counter 0) (setq remain (1- remain))) (setq counter (1+ counter) inputpos (1+ inputpos)) (cond ((= counter 4) (setq result (cons (concat (char-to-string (lsh bits -16)) (char-to-string (logand (lsh bits -8) 255)) (char-to-string (logand bits 255))) result)) (setq bits 0 counter 0)) (t (setq bits (lsh bits 6))))))) (cond (done) ((> 0 remain) (error "uucode line ends unexpectly") (setq done t)) ((and (= (point) end) (not done)) ;;(error "uucode ends unexpectly") (setq done t)) ((= counter 3) (setq result (cons (concat (char-to-string (logand (lsh bits -16) 255)) (char-to-string (logand (lsh bits -8) 255))) result))) ((= counter 2) (setq result (cons (char-to-string (logand (lsh bits -10) 255)) result)))) (skip-chars-forward non-data-chars end)) (if file-name (let (default-enable-multibyte-characters) (with-temp-file file-name (insert (apply 'concat (nreverse result))))) (or (markerp end) (setq end (set-marker (make-marker) end))) (goto-char start) (if enable-multibyte-characters (mapc #'(lambda (x) (insert (uudecode-string-to-multibyte x))) (nreverse result)) (insert (apply 'concat (nreverse result)))) (delete-region (point) end)))))) ;;;###autoload (defun uudecode-decode-region (start end &optional file-name) "Uudecode region between START and END. If FILE-NAME is non-nil, save the result to FILE-NAME." (if uudecode-use-external (uudecode-decode-region-external start end file-name) (uudecode-decode-region-internal start end file-name))) (provide 'uudecode) ;;; arch-tag: e1f09ed5-62b4-4677-9f13-4e81c4fe8ce3 ;;; uudecode.el ends here