From: Paul Eggert Date: Wed, 2 Jan 2013 16:13:04 +0000 (-0800) Subject: Merge from emacs-24; up to 2012-12-06T01:39:03Z!monnier@iro.umontreal.ca X-Git-Tag: emacs-24.3.90~173^2~7^2~424 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=0877d0dc24ee792b9b14592869ea1aa0934aee58;p=emacs.git Merge from emacs-24; up to 2012-12-06T01:39:03Z!monnier@iro.umontreal.ca --- 0877d0dc24ee792b9b14592869ea1aa0934aee58 diff --cc doc/lispref/ChangeLog index 2036831cb89,6884ff943fa..1820f304425 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@@ -1,4 -1,12 +1,12 @@@ + 2012-12-31 Glenn Morris + + * customize.texi (Common Keywords, Type Keywords): + Replace "active field" with "button". (Bug#13310) + + * customize.texi (Common Keywords): Add xref. (Bug#13311) + * tips.texi (Library Headers): Add cindex. + -2012-12-29 Wolfgang Jenkner +2012-12-30 Wolfgang Jenkner * functions.texi (Declare Form): * intro.texi (A Sample Function Description): diff --cc doc/misc/ses.texi index 826fac20c71,f6c35d1de8e..ce75f2ef91e --- a/doc/misc/ses.texi +++ b/doc/misc/ses.texi @@@ -9,9 -9,9 +9,9 @@@ @c %**end of header @copying -This file documents SES: the Simple Emacs Spreadsheet. +This file documents @acronym{SES}: the Simple Emacs Spreadsheet. - Copyright @copyright{} 2002--2012 Free Software Foundation, Inc. + Copyright @copyright{} 2002--2013 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --cc etc/MH-E-NEWS index 4d003378c30,785a856e98c..846504c9014 --- a/etc/MH-E-NEWS +++ b/etc/MH-E-NEWS @@@ -1,70 -1,8 +1,70 @@@ * COPYRIGHT - Copyright (C) 2001-2012 Free Software Foundation, Inc. + Copyright (C) 2001-2013 Free Software Foundation, Inc. See the end of the file for license conditions. +* Changes in MH-E 8.4 + +Version 8.4 postpones junk processing and merges in your components +file when re-editing a draft. A few bugs were also fixed. + +** New Features in MH-E 8.4 + +*** Postpone junk processing + +The `J w' (`mh-junk-whitelist') and `J b' (`mh-junk-blacklist') +commands now mark the message. Like with other marks, this mark can be +removed with `u' (`mh-undo') and processed with `x' +(`mh-execute-commands'). Thanks to Ted Phelps (closes SF #2945712). + +** New Variables in MH-E 8.4 + +*** mh-blacklist-msg-hook + +Hook run by `J b' (`mh-junk-blacklist') after marking each message for blacklisting. + +*** mh-whitelist-msg-hook + +Hook run by `J w' (`mh-junk-whitelist') after marking each message for whitelisting. + +*** mh-whitelist-preserves-sequences-flag + +Non-nil means that sequences are preserved when messages are +whitelisted. + +** New Faces in MH-E 8.4 + +*** mh-folder-blacklisted + +Blacklisted message face. + +*** mh-folder-whitelisted + +Whitelisted message face. + +** Bug Fixes in MH-E 8.4 + +*** mh-edit-again should add Fcc + +More generally, `mh-edit-again' now merges the components file into +the draft (closes SF #1708292). + +*** Loses changes when message column goes from 1 to 2 digits + +Call `mh-process-or-undo-commands' before running inc to insure we do +not lose any pending changes (closes SF #2321115). + +*** mh-yank-cur-msg fails in emacs 23 + +Replace usage of `set-buffer' with `with-current-buffer' (closes SF +#2830504). + +*** Folder pack action (Fp) missing in show mode + +Add missing key binding for `mh-show-pack-folder' (closes SF #3466086). + + + * Changes in MH-E 8.3.1 This version of MH-E fixes typos in the documentation and is packaged diff --cc lisp/ChangeLog index 72e8959d8ef,35fe446f066..00bce0b62b5 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@@ -1,50 -1,44 +1,91 @@@ + 2012-12-31 Andreas Schwab + + * emacs-lisp/byte-run.el (defmacro): Use same argument parsing as + defun. Don't check for DECL if DOCSTRING isn't a string. + (defun): Likewise. + + 2012-12-31 Glenn Morris + + * eshell/em-cmpl.el (eshell-pcomplete): + More thoroughly imitate pcomplete. (Bug#13293) + + * files.el (parse-colon-path): Doc fix. (Bug#12351) + Return nil for empty path elements. (Bug#13296) + + 2012-12-31 Fabián Ezequiel Gallina + + * progmodes/python.el (python-nav-end-of-statement): Rewrite in + order to improve efficiency (Based on Daniel Colascione's + patch). (Bug#13182) + + 2012-12-31 Glenn Morris + + * vc/log-edit.el (log-edit-header-contents-regexp): Add doc string. + + 2012-12-31 Fabián Ezequiel Gallina + + * progmodes/python.el: Support other commands triggering + python-indent-line so indentation cycling continues to work. + (python-indent-trigger-commands): New defcustom. + (python-indent-line): Use it. + + 2012-12-31 Fabián Ezequiel Gallina + + * progmodes/python.el (python-shell-send-region): Add blank lines + for non sent code so backtraces remain correct. + + 2012-12-31 Andreas Schwab + + * emacs-lisp/byte-run.el (defmacro): Don't lose final nil if + neither DOCSTRING nor DECL was given. (Bug#13316) + +2013-01-02 Michael Albinus + + * net/tramp-sh.el (tramp-sh-handle-set-file-acl): Add argument to + `error' call. + (tramp-do-copy-or-rename-file): Ignore errors when calling + `set-file-extended-attributes'. + + * net/tramp-smb.el (tramp-smb-file-name-handler-alist): Add + handler for `file-acl'. + (tramp-smb-handle-file-acl): New defun. + +2013-01-02 Jay Belanger + + * calc/README: Mention ISO 8601 week-numbering dates. + +2013-01-01 Martin Rudalics + + * view.el (view-mode-enable): New argument run-view-mode-hook. + Run view-mode-hook only when it's non-nil (Bug#13315). + (view-mode-enter): Call view-mode-enable with run-view-mode-hook + argument t. + +2012-12-31 Jürgen Hötzel + + * net/tramp-adb.el (tramp-adb-maybe-open-connection): Handle errors + (No device connected, invalid device name). (Bug #13299) + +2012-12-31 Martin Rudalics + + * window.el (window-resizable--p): Rename to window-resizable-p. + (window-resize-no-error): New function. + + * mail/rmail.el (rmail-maybe-display-summary): Restore behavior + broken in fix from 2012-12-28. + +2012-12-31 Stefan Monnier + + * subr.el (special-form-p): Don't signal errors on undef aliases. + +2012-12-31 Jay Belanger + + * calc/calc-forms.el (math-parse-date): Try using + `math-parse-iso-date' when it looks like it might be needed. + Allow times of 24:00. + (math-parse-date-validate, math-parse-iso-date-validate): Allow times + of 24:00. + 2012-12-30 Glenn Morris * net/mairix.el (rmail, rmail-summary-displayed, rmail-summary): diff --cc lisp/dired.el index 93f302329e3,3d01c7b0924..b8b8a7f877c --- a/lisp/dired.el +++ b/lisp/dired.el @@@ -4295,7 -4294,7 +4295,7 @@@ instead ;;;*** ;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump) - ;;;;;; "dired-x" "dired-x.el" "a0a769bf895afcbb6d0e05169ef81923") -;;;;;; "dired-x" "dired-x.el" "ce753ade80ea9f4e64ab3569e3a5421e") ++;;;;;; "dired-x" "dired-x.el" "cdaacce7c861256289ba48493dd6d0ec") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ diff --cc lisp/emacs-lisp/advice.el index a947dceccc9,eb95fae2339..7917b769ab8 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@@ -1,6 -1,6 +1,6 @@@ -;;; advice.el --- An overloading mechanism for Emacs Lisp functions +;;; advice.el --- An overloading mechanism for Emacs Lisp functions -*- lexical-binding: t -*- - ;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc. + ;; Copyright (C) 1993-1994, 2000-2013 Free Software Foundation, Inc. ;; Author: Hans Chalupsky ;; Maintainer: FSF diff --cc lisp/emacs-lisp/cl-loaddefs.el index f699ee7fb8e,4198c0e0063..734975f7f11 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@@ -11,7 -11,7 +11,7 @@@ ;;;;;; cl--map-overlays cl--map-intervals cl--map-keymap-recursively ;;;;;; cl-notevery cl-notany cl-every cl-some cl-mapcon cl-mapcan ;;;;;; cl-mapl cl-mapc cl-maplist cl-map cl--mapcar-many cl-equalp - ;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "3ee58411735a01dd1e1d3964fdcfae70") -;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "6c7926a10c377679687a2ab6a4d1c186") ++;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "c5730f2a706cb1efc5fec0a790d3ca72") ;;; Generated autoloads from cl-extra.el (autoload 'cl-coerce "cl-extra" "\ @@@ -267,7 -267,7 +267,7 @@@ including `cl-block' and `cl-eval-when' ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) - ;;;;;; "cl-macs" "cl-macs.el" "d3af72b1cff3398fa1480065fc2887a2") -;;;;;; "cl-macs" "cl-macs.el" "ad8afd35d8d75f5f22e7547b02bac556") ++;;;;;; "cl-macs" "cl-macs.el" "3b4d4e869f81f0b07ab3aa08f5478c2e") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ @@@ -772,7 -759,7 +772,7 @@@ surrounded by (cl-block NAME ...) ;;;;;; cl-nsubstitute-if cl-nsubstitute cl-substitute-if-not cl-substitute-if ;;;;;; cl-substitute cl-delete-duplicates cl-remove-duplicates cl-delete-if-not ;;;;;; cl-delete-if cl-delete cl-remove-if-not cl-remove-if cl-remove - ;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "4b8ddc5bea2fcc626526ce3644071568") -;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "5ce2761d9a21845a7f6a2da0e4543844") ++;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "51a70dea9cbc225165a50135956609aa") ;;; Generated autoloads from cl-seq.el (autoload 'cl-reduce "cl-seq" "\ diff --cc lisp/emacs-lisp/debug.el index a378941a5a4,472706d886b..0728e86d072 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@@ -1,6 -1,7 +1,7 @@@ -;;; debug.el --- debuggers and related commands for Emacs +;;; debug.el --- debuggers and related commands for Emacs -*- lexical-binding: t -*- - ;; Copyright (C) 1985-1986, 1994, 2001-2012 Free Software Foundation, Inc. + ;; Copyright (C) 1985-1986, 1994, 2001-2013 Free Software Foundation, + ;; Inc. ;; Maintainer: FSF ;; Keywords: lisp, tools, maint diff --cc lisp/emacs-lisp/elp.el index 067b45f5cd8,bc02d9a7551..f1321eb4e6d --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@@ -1,7 -1,7 +1,7 @@@ -;;; elp.el --- Emacs Lisp Profiler +;;; elp.el --- Emacs Lisp Profiler -*- lexical-binding: t -*- - ;; Copyright (C) 1994-1995, 1997-1998, 2001-2012 - ;; Free Software Foundation, Inc. + ;; Copyright (C) 1994-1995, 1997-1998, 2001-2013 Free Software + ;; Foundation, Inc. ;; Author: Barry A. Warsaw ;; Maintainer: FSF diff --cc lisp/emacs-lisp/ert-x.el index 60d74774e87,00100c0f6fb..531e83c1e6a --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@@ -1,6 -1,6 +1,6 @@@ -;;; ert-x.el --- Staging area for experimental extensions to ERT +;;; ert-x.el --- Staging area for experimental extensions to ERT -*- lexical-binding: t -*- - ;; Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc. + ;; Copyright (C) 2008, 2010-2013 Free Software Foundation, Inc. ;; Author: Lennart Borgman (lennart O borgman A gmail O com) ;; Christian Ohler diff --cc lisp/emacs-lisp/ert.el index ab6dcb58143,134dbc1b6a6..70d6a6a4a5f --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@@ -1,6 -1,6 +1,6 @@@ -;;; ert.el --- Emacs Lisp Regression Testing +;;; ert.el --- Emacs Lisp Regression Testing -*- lexical-binding: t -*- - ;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc. + ;; Copyright (C) 2007-2008, 2010-2013 Free Software Foundation, Inc. ;; Author: Christian Ohler ;; Keywords: lisp, tools diff --cc lisp/emacs-lisp/trace.el index 722e6270e95,53d849cf744..d2566b8cb9f --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@@ -1,6 -1,6 +1,6 @@@ -;;; trace.el --- tracing facility for Emacs Lisp functions +;;; trace.el --- tracing facility for Emacs Lisp functions -*- lexical-binding: t -*- - ;; Copyright (C) 1993, 1998, 2000-2012 Free Software Foundation, Inc. + ;; Copyright (C) 1993, 1998, 2000-2013 Free Software Foundation, Inc. ;; Author: Hans Chalupsky ;; Maintainer: FSF diff --cc lisp/hi-lock.el index 2ae328a09e8,476399225f4..e7948614241 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@@ -1,6 -1,6 +1,6 @@@ -;;; hi-lock.el --- minor mode for interactive automatic highlighting +;;; hi-lock.el --- minor mode for interactive automatic highlighting -*- lexical-binding: t -*- - ;; Copyright (C) 2000-2012 Free Software Foundation, Inc. + ;; Copyright (C) 2000-2013 Free Software Foundation, Inc. ;; Author: David M. Koppelman ;; Keywords: faces, minor-mode, matching, display diff --cc lisp/json.el index 8432ba40c12,a0cd116279a..29beaedebe9 --- a/lisp/json.el +++ b/lisp/json.el @@@ -1,9 -1,9 +1,9 @@@ ;;; json.el --- JavaScript Object Notation parser / generator - ;; Copyright (C) 2006-2012 Free Software Foundation, Inc. + ;; Copyright (C) 2006-2013 Free Software Foundation, Inc. ;; Author: Edward O'Connor -;; Version: 1.3 +;; Version: 1.4 ;; Keywords: convenience ;; This file is part of GNU Emacs. diff --cc lisp/mail/rmail.el index 947d8e2cb4c,2524b1939a5..a05cd342862 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@@ -4577,7 -4552,7 +4577,7 @@@ encoded string (and the same mask) wil ;;; Start of automatically extracted autoloads. ;;;### (autoloads (rmail-edit-current-message) "rmailedit" "rmailedit.el" - ;;;;;; "791ea184628feb6335fe3e29f7234934") -;;;;;; "1aec1d54f9767ee0fea557bbfb1d547b") ++;;;;;; "0b056146d4775080a1847b8ce7527bc5") ;;; Generated autoloads from rmailedit.el (autoload 'rmail-edit-current-message "rmailedit" "\ diff --cc lisp/mail/unrmail.el index fd7e49a65d5,f6347d11051..85e8bb4f863 --- a/lisp/mail/unrmail.el +++ b/lisp/mail/unrmail.el @@@ -1,6 -1,6 +1,6 @@@ -;;; unrmail.el --- convert Rmail Babyl files to mailbox files +;;; unrmail.el --- convert Rmail Babyl files to mbox files - ;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc. + ;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail diff --cc lisp/obsolete/longlines.el index 1ae6d1a357e,00000000000..b68a191d55a mode 100644,000000..100644 --- a/lisp/obsolete/longlines.el +++ b/lisp/obsolete/longlines.el @@@ -1,516 -1,0 +1,516 @@@ +;;; longlines.el --- automatically wrap long lines -*- coding:utf-8 -*- + - ;; Copyright (C) 2000-2001, 2004-2012 Free Software Foundation, Inc. ++;; Copyright (C) 2000-2001, 2004-2013 Free Software Foundation, Inc. + +;; Authors: Kai Grossjohann +;; Alex Schroeder +;; Chong Yidong +;; Maintainer: Chong Yidong +;; Obsolete-since: 24.4 +;; Keywords: convenience, wp + +;; 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 of the License, 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. If not, see . + +;;; Commentary: + +;; Some text editors save text files with long lines, and they +;; automatically break these lines at whitespace, without actually +;; inserting any newline characters. When doing `M-q' in Emacs, you +;; are inserting newline characters. Longlines mode provides a file +;; format which wraps the long lines when reading a file and unwraps +;; the lines when saving the file. It can also wrap and unwrap +;; automatically as editing takes place. + +;; Special thanks to Rod Smith for many useful bug reports. + +;;; Code: + +(defgroup longlines nil + "Automatic wrapping of long lines when loading files." + :group 'fill) + +(defcustom longlines-auto-wrap t + "Non-nil means long lines are automatically wrapped after each command. +Otherwise, you can perform filling using `fill-paragraph' or +`auto-fill-mode'. In any case, the soft newlines will be removed +when the file is saved to disk." + :group 'longlines + :type 'boolean) + +(defcustom longlines-wrap-follows-window-size nil + "Non-nil means wrapping and filling happen at the edge of the window. +Otherwise, `fill-column' is used, regardless of the window size. This +does not work well when the buffer is displayed in multiple windows +with differing widths. + +If the value is an integer, that specifies the distance from the +right edge of the window at which wrapping occurs. For any other +non-nil value, wrapping occurs 2 characters from the right edge." + :group 'longlines + :type 'boolean) + +(defcustom longlines-show-hard-newlines nil + "Non-nil means each hard newline is marked on the screen. +\(The variable `longlines-show-effect' controls what they look like.) +You can also enable the display temporarily, using the command +`longlines-show-hard-newlines'." + :group 'longlines + :type 'boolean) + +(defcustom longlines-show-effect (propertize "¶\n" 'face 'escape-glyph) + "A string to display when showing hard newlines. +This is used when `longlines-show-hard-newlines' is on." + :group 'longlines + :type 'string) + +;; Internal variables + +(defvar longlines-wrap-beg nil) +(defvar longlines-wrap-end nil) +(defvar longlines-wrap-point nil) +(defvar longlines-showing nil) +(defvar longlines-decoded nil) + +(make-variable-buffer-local 'longlines-wrap-beg) +(make-variable-buffer-local 'longlines-wrap-end) +(make-variable-buffer-local 'longlines-wrap-point) +(make-variable-buffer-local 'longlines-showing) +(make-variable-buffer-local 'longlines-decoded) + +;; Mode + +(defvar message-indent-citation-function) + +;;;###autoload +(define-minor-mode longlines-mode + "Toggle Long Lines mode in this buffer. +With a prefix argument ARG, enable Long Lines mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil. + +When Long Lines mode is enabled, long lines are wrapped if they +extend beyond `fill-column'. The soft newlines used for line +wrapping will not show up when the text is yanked or saved to +disk. + +If the variable `longlines-auto-wrap' is non-nil, lines are +automatically wrapped whenever the buffer is changed. You can +always call `fill-paragraph' to fill individual paragraphs. + +If the variable `longlines-show-hard-newlines' is non-nil, hard +newlines are indicated with a symbol." + :group 'longlines :lighter " ll" + (if longlines-mode + ;; Turn on longlines mode + (progn + (use-hard-newlines 1 'never) + (set (make-local-variable 'require-final-newline) nil) + (add-to-list 'buffer-file-format 'longlines) + (add-hook 'change-major-mode-hook 'longlines-mode-off nil t) + (add-hook 'before-revert-hook 'longlines-before-revert-hook nil t) + (make-local-variable 'buffer-substring-filters) + (make-local-variable 'longlines-auto-wrap) + (set (make-local-variable 'isearch-search-fun-function) + 'longlines-search-function) + (set (make-local-variable 'replace-search-function) + 'longlines-search-forward) + (set (make-local-variable 'replace-re-search-function) + 'longlines-re-search-forward) + (add-to-list 'buffer-substring-filters 'longlines-encode-string) + (when longlines-wrap-follows-window-size + (let ((dw (if (and (integerp longlines-wrap-follows-window-size) + (>= longlines-wrap-follows-window-size 0) + (< longlines-wrap-follows-window-size + (window-width))) + longlines-wrap-follows-window-size + 2))) + (set (make-local-variable 'fill-column) + (- (window-width) dw))) + (add-hook 'window-configuration-change-hook + 'longlines-window-change-function nil t)) + (let ((buffer-undo-list t) + (inhibit-read-only t) + (after-change-functions nil) + (mod (buffer-modified-p)) + buffer-file-name buffer-file-truename) + ;; Turning off undo is OK since (spaces + newlines) is + ;; conserved, except for a corner case in + ;; longlines-wrap-lines that we'll never encounter from here + (save-restriction + (widen) + (unless longlines-decoded + (longlines-decode-buffer) + (setq longlines-decoded t)) + (longlines-wrap-region (point-min) (point-max))) + (set-buffer-modified-p mod)) + (when (and longlines-show-hard-newlines + (not longlines-showing)) + (longlines-show-hard-newlines)) + + ;; Hacks to make longlines play nice with various modes. + (cond ((eq major-mode 'mail-mode) + (add-hook 'mail-setup-hook 'longlines-decode-buffer nil t) + (or mail-citation-hook + (add-hook 'mail-citation-hook 'mail-indent-citation nil t)) + (add-hook 'mail-citation-hook 'longlines-decode-region nil t)) + ((eq major-mode 'message-mode) + (add-hook 'message-setup-hook 'longlines-decode-buffer nil t) + (make-local-variable 'message-indent-citation-function) + (if (not (listp message-indent-citation-function)) + (setq message-indent-citation-function + (list message-indent-citation-function))) + (add-to-list 'message-indent-citation-function + 'longlines-decode-region t))) + + (add-hook 'after-change-functions 'longlines-after-change-function nil t) + (add-hook 'post-command-hook 'longlines-post-command-function nil t) + (when longlines-auto-wrap + (auto-fill-mode 0))) + ;; Turn off longlines mode + (setq buffer-file-format (delete 'longlines buffer-file-format)) + (if longlines-showing + (longlines-unshow-hard-newlines)) + (let ((buffer-undo-list t) + (after-change-functions nil) + (inhibit-read-only t) + buffer-file-name buffer-file-truename) + (if longlines-decoded + (save-restriction + (widen) + (longlines-encode-region (point-min) (point-max)) + (setq longlines-decoded nil)))) + (remove-hook 'change-major-mode-hook 'longlines-mode-off t) + (remove-hook 'after-change-functions 'longlines-after-change-function t) + (remove-hook 'post-command-hook 'longlines-post-command-function t) + (remove-hook 'before-revert-hook 'longlines-before-revert-hook t) + (remove-hook 'window-configuration-change-hook + 'longlines-window-change-function t) + (when longlines-wrap-follows-window-size + (kill-local-variable 'fill-column)) + (kill-local-variable 'isearch-search-fun-function) + (kill-local-variable 'replace-search-function) + (kill-local-variable 'replace-re-search-function) + (kill-local-variable 'require-final-newline) + (kill-local-variable 'buffer-substring-filters) + (kill-local-variable 'use-hard-newlines))) + +(defun longlines-mode-off () + "Turn off longlines mode. +This function exists to be called by `change-major-mode-hook' when the +major mode changes." + (longlines-mode 0)) + +;; Showing the effect of hard newlines in the buffer + +(defun longlines-show-hard-newlines (&optional arg) + "Make hard newlines visible by adding a face. +With optional argument ARG, make the hard newlines invisible again." + (interactive "P") + (if arg + (longlines-unshow-hard-newlines) + (setq longlines-showing t) + (longlines-show-region (point-min) (point-max)))) + +(defun longlines-show-region (beg end) + "Make hard newlines between BEG and END visible." + (let* ((pmin (min beg end)) + (pmax (max beg end)) + (pos (text-property-not-all pmin pmax 'hard nil)) + (mod (buffer-modified-p)) + (buffer-undo-list t) + (inhibit-read-only t) + (inhibit-modification-hooks t) + buffer-file-name buffer-file-truename) + (while pos + (put-text-property pos (1+ pos) 'display + (copy-sequence longlines-show-effect)) + (setq pos (text-property-not-all (1+ pos) pmax 'hard nil))) + (restore-buffer-modified-p mod))) + +(defun longlines-unshow-hard-newlines () + "Make hard newlines invisible again." + (interactive) + (setq longlines-showing nil) + (let ((pos (text-property-not-all (point-min) (point-max) 'hard nil)) + (mod (buffer-modified-p)) + (buffer-undo-list t) + (inhibit-read-only t) + (inhibit-modification-hooks t) + buffer-file-name buffer-file-truename) + (while pos + (remove-text-properties pos (1+ pos) '(display)) + (setq pos (text-property-not-all (1+ pos) (point-max) 'hard nil))) + (restore-buffer-modified-p mod))) + +;; Wrapping the paragraphs. + +(defun longlines-wrap-region (beg end) + "Wrap each successive line, starting with the line before BEG. +Stop when we reach lines after END that don't need wrapping, or the +end of the buffer." + (let ((mod (buffer-modified-p))) + (setq longlines-wrap-point (point)) + (goto-char beg) + (forward-line -1) + ;; Two successful longlines-wrap-line's in a row mean successive + ;; lines don't need wrapping. + (while (null (and (longlines-wrap-line) + (or (eobp) + (and (>= (point) end) + (longlines-wrap-line)))))) + (goto-char longlines-wrap-point) + (set-buffer-modified-p mod))) + +(defun longlines-wrap-line () + "If the current line needs to be wrapped, wrap it and return nil. +If wrapping is performed, point remains on the line. If the line does +not need to be wrapped, move point to the next line and return t." + (if (longlines-set-breakpoint) + (progn (insert-before-markers-and-inherit ?\n) + (backward-char 1) + (delete-char -1) + (forward-char 1) + nil) + (if (longlines-merge-lines-p) + (progn (end-of-line) + ;; After certain commands (e.g. kill-line), there may be two + ;; successive soft newlines in the buffer. In this case, we + ;; replace these two newlines by a single space. Unfortunately, + ;; this breaks the conservation of (spaces + newlines), so we + ;; have to fiddle with longlines-wrap-point. + (if (or (prog1 (bolp) (forward-char 1)) (eolp)) + (progn + (delete-char -1) + (if (> longlines-wrap-point (point)) + (setq longlines-wrap-point + (1- longlines-wrap-point)))) + (insert-before-markers-and-inherit ?\s) + (backward-char 1) + (delete-char -1) + (forward-char 1)) + nil) + (forward-line 1) + t))) + +(defun longlines-set-breakpoint () + "Place point where we should break the current line, and return t. +If the line should not be broken, return nil; point remains on the +line." + (move-to-column fill-column) + (if (and (re-search-forward "[^ ]" (line-end-position) 1) + (> (current-column) fill-column)) + ;; This line is too long. Can we break it? + (or (longlines-find-break-backward) + (progn (move-to-column fill-column) + (longlines-find-break-forward))))) + +(defun longlines-find-break-backward () + "Move point backward to the first available breakpoint and return t. +If no breakpoint is found, return nil." + (and (search-backward " " (line-beginning-position) 1) + (save-excursion + (skip-chars-backward " " (line-beginning-position)) + (null (bolp))) + (progn (forward-char 1) + (if (and fill-nobreak-predicate + (run-hook-with-args-until-success + 'fill-nobreak-predicate)) + (progn (skip-chars-backward " " (line-beginning-position)) + (longlines-find-break-backward)) + t)))) + +(defun longlines-find-break-forward () + "Move point forward to the first available breakpoint and return t. +If no break point is found, return nil." + (and (search-forward " " (line-end-position) 1) + (progn (skip-chars-forward " " (line-end-position)) + (null (eolp))) + (if (and fill-nobreak-predicate + (run-hook-with-args-until-success + 'fill-nobreak-predicate)) + (longlines-find-break-forward) + t))) + +(defun longlines-merge-lines-p () + "Return t if part of the next line can fit onto the current line. +Otherwise, return nil. Text cannot be moved across hard newlines." + (save-excursion + (end-of-line) + (and (null (eobp)) + (null (get-text-property (point) 'hard)) + (let ((space (- fill-column (current-column)))) + (forward-line 1) + (if (eq (char-after) ? ) + t ; We can always merge some spaces + (<= (if (search-forward " " (line-end-position) 1) + (current-column) + (1+ (current-column))) + space)))))) + +(defun longlines-decode-region (&optional beg end) + "Turn all newlines between BEG and END into hard newlines. +If BEG and END are nil, the point and mark are used." + (if (null beg) (setq beg (point))) + (if (null end) (setq end (mark t))) + (save-excursion + (let ((reg-max (max beg end))) + (goto-char (min beg end)) + (while (search-forward "\n" reg-max t) + (set-hard-newline-properties + (match-beginning 0) (match-end 0)))))) + +(defun longlines-decode-buffer () + "Turn all newlines in the buffer into hard newlines." + (longlines-decode-region (point-min) (point-max))) + +(defun longlines-encode-region (beg end &optional _buffer) + "Replace each soft newline between BEG and END with exactly one space. +Hard newlines are left intact. The optional argument BUFFER exists for +compatibility with `format-alist', and is ignored." + (save-excursion + (let ((reg-max (max beg end)) + (mod (buffer-modified-p))) + (goto-char (min beg end)) + (while (search-forward "\n" reg-max t) + (let ((pos (match-beginning 0))) + (unless (get-text-property pos 'hard) + (goto-char (1+ pos)) + (insert-and-inherit " ") + (delete-region pos (1+ pos)) + (remove-text-properties pos (1+ pos) 'hard)))) + (set-buffer-modified-p mod) + end))) + +(defun longlines-encode-string (string) + "Return a copy of STRING with each soft newline replaced by a space. +Hard newlines are left intact." + (let* ((str (copy-sequence string)) + (pos (string-match "\n" str))) + (while pos + (if (null (get-text-property pos 'hard str)) + (aset str pos ? )) + (setq pos (string-match "\n" str (1+ pos)))) + str)) + +;; Auto wrap + +(defun longlines-auto-wrap (&optional arg) + "Toggle automatic line wrapping. +With optional argument ARG, turn on line wrapping if and only if ARG is positive. +If automatic line wrapping is turned on, wrap the entire buffer." + (interactive "P") + (setq arg (if arg + (> (prefix-numeric-value arg) 0) + (not longlines-auto-wrap))) + (if arg + (progn + (setq longlines-auto-wrap t) + (longlines-wrap-region (point-min) (point-max)) + (message "Auto wrap enabled.")) + (setq longlines-auto-wrap nil) + (message "Auto wrap disabled."))) + +(defun longlines-after-change-function (beg end _len) + "Update `longlines-wrap-beg' and `longlines-wrap-end'. +This is called by `after-change-functions' to keep track of the region +that has changed." + (when (and longlines-auto-wrap (not undo-in-progress)) + (setq longlines-wrap-beg + (if longlines-wrap-beg (min longlines-wrap-beg beg) beg)) + (setq longlines-wrap-end + (if longlines-wrap-end (max longlines-wrap-end end) end)))) + +(defun longlines-post-command-function () + "Perform line wrapping on the parts of the buffer that have changed. +This is called by `post-command-hook' after each command." + (when (and longlines-auto-wrap longlines-wrap-beg) + (if (or (eq this-command 'yank) + (eq this-command 'yank-pop)) + (longlines-decode-region (point) (mark t))) + (if longlines-showing + (longlines-show-region longlines-wrap-beg longlines-wrap-end)) + (unless (or (eq this-command 'fill-paragraph) + (eq this-command 'fill-region)) + (longlines-wrap-region longlines-wrap-beg longlines-wrap-end)) + (setq longlines-wrap-beg nil) + (setq longlines-wrap-end nil))) + +(defun longlines-window-change-function () + "Re-wrap the buffer if the window width has changed. +This is called by `window-configuration-change-hook'." + (let ((dw (if (and (integerp longlines-wrap-follows-window-size) + (>= longlines-wrap-follows-window-size 0) + (< longlines-wrap-follows-window-size (window-width))) + longlines-wrap-follows-window-size + 2))) + (when (/= fill-column (- (window-width) dw)) + (setq fill-column (- (window-width) dw)) + (longlines-wrap-region (point-min) (point-max))))) + +;; Isearch + +(defun longlines-search-function () + (cond + (isearch-word + (if isearch-forward 'word-search-forward 'word-search-backward)) + (isearch-regexp + (if isearch-forward 're-search-forward 're-search-backward)) + (t + (if isearch-forward + 'longlines-search-forward + 'longlines-search-backward)))) + +(defun longlines-search-forward (string &optional bound noerror count) + (let ((search-spaces-regexp " *[ \n]")) + (re-search-forward (regexp-quote string) bound noerror count))) + +(defun longlines-search-backward (string &optional bound noerror count) + (let ((search-spaces-regexp " *[ \n]")) + (re-search-backward (regexp-quote string) bound noerror count))) + +(defun longlines-re-search-forward (string &optional bound noerror count) + (let ((search-spaces-regexp " *[ \n]")) + (re-search-forward string bound noerror count))) + +;; Loading and saving + +(defun longlines-before-revert-hook () + (add-hook 'after-revert-hook 'longlines-after-revert-hook nil t) + (longlines-mode 0)) + +(defun longlines-after-revert-hook () + (remove-hook 'after-revert-hook 'longlines-after-revert-hook t) + (longlines-mode 1)) + +(add-to-list + 'format-alist + (list 'longlines "Automatically wrap long lines." nil nil + 'longlines-encode-region t nil)) + +;; Unloading + +(defun longlines-unload-function () + "Unload the longlines library." + (save-current-buffer + (dolist (buffer (buffer-list)) + (set-buffer buffer) + (longlines-mode-off))) + ;; continue standard unloading + nil) + +(provide 'longlines) + +;;; longlines.el ends here diff --cc lisp/obsolete/terminal.el index 5497a74b32f,00000000000..7f65d336899 mode 100644,000000..100644 --- a/lisp/obsolete/terminal.el +++ b/lisp/obsolete/terminal.el @@@ -1,1339 -1,0 +1,1339 @@@ +;;; terminal.el --- terminal emulator for GNU Emacs + - ;; Copyright (C) 1986-1989, 1993-1994, 2001-2012 - ;; Free Software Foundation, Inc. ++;; Copyright (C) 1986-1989, 1993-1994, 2001-2013 Free Software ++;; Foundation, Inc. + +;; Author: Richard Mlynarik +;; Maintainer: FSF +;; Obsolete-since: 24.4 +;; Keywords: comm, terminals + +;; 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 of the License, 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. If not, see . + +;;; Commentary: + +;; This file has been censored by the Communications Decency Act. +;; That law was passed under the guise of a ban on pornography, but +;; it bans far more than that. This file did not contain pornography, +;; but it was censored nonetheless. + +;; For information on US government censorship of the Internet, and +;; what you can do to bring back freedom of the press, see the web +;; site http://www.vtw.org/ + +;;; Code: + +;;>>TODO +;;>> ** Nothing can be done about emacs' meta-lossage ** +;;>> (without redoing keymaps `sanely' -- ask Mly for details) + +;;>> One probably wants to do setenv MORE -c when running with +;;>> more-processing enabled. + +(require 'ehelp) + +(defgroup terminal nil + "Terminal emulator for Emacs." + :group 'terminals) + + +(defcustom terminal-escape-char ?\C-^ + "All characters except for this are passed verbatim through the +terminal-emulator. This character acts as a prefix for commands +to the emulator program itself. Type this character twice to send +it through the emulator. Type ? after typing it for a list of +possible commands. +This variable is local to each terminal-emulator buffer." + :type 'character + :group 'terminal) + +(defcustom terminal-scrolling t ;;>> Setting this to t sort-of defeats my whole aim in writing this package... + "If non-nil, the terminal-emulator will losingly `scroll' when output occurs +past the bottom of the screen. If nil, output will win and `wrap' to the top +of the screen. +This variable is local to each terminal-emulator buffer." + :type 'boolean + :group 'terminal) + +(defcustom terminal-more-processing t + "If non-nil, do more-processing. +This variable is local to each terminal-emulator buffer." + :type 'boolean + :group 'terminal) + +;; If you are the sort of loser who uses scrolling without more breaks +;; and expects to actually see anything, you should probably set this to +;; around 400 +(defcustom terminal-redisplay-interval 5000 + "Maximum number of characters which will be processed by the +terminal-emulator before a screen redisplay is forced. +Set this to a large value for greater throughput, +set it smaller for more frequent updates but overall slower +performance." + :type 'integer + :group 'terminal) + +(defvar terminal-more-break-insertion + "*** More break -- Press space to continue ***") + +(defvar terminal-meta-map nil) +(if terminal-meta-map + nil + (let ((map (make-sparse-keymap))) + (define-key map [t] 'te-pass-through) + (setq terminal-meta-map map))) + +(defvar terminal-map nil) +(if terminal-map + nil + (let ((map (make-sparse-keymap))) + ;; Prevent defining [menu-bar] as te-pass-through + ;; so we allow the global menu bar to be visible. + (define-key map [menu-bar] (make-sparse-keymap)) + (define-key map [t] 'te-pass-through) + (define-key map [switch-frame] 'handle-switch-frame) + (define-key map "\e" terminal-meta-map) + ;;(define-key map "\C-l" + ;; (lambda () (interactive) (te-pass-through) (redraw-display))) + (setq terminal-map map))) + +(defvar terminal-escape-map nil) +(if terminal-escape-map + nil + (let ((map (make-sparse-keymap))) + (define-key map [t] 'undefined) + (let ((s "0")) + (while (<= (aref s 0) ?9) + (define-key map s 'digit-argument) + (aset s 0 (1+ (aref s 0))))) + (define-key map "b" 'switch-to-buffer) + (define-key map "o" 'other-window) + (define-key map "e" 'te-set-escape-char) + (define-key map "\C-l" 'redraw-display) + (define-key map "\C-o" 'te-flush-pending-output) + (define-key map "m" 'te-toggle-more-processing) + (define-key map "x" 'te-escape-extended-command) + ;;>> What use is this? Why is it in the default terminal-emulator map? + (define-key map "w" 'te-edit) + (define-key map "?" 'te-escape-help) + (define-key map (char-to-string help-char) 'te-escape-help) + (setq terminal-escape-map map))) + +(defvar te-escape-command-alist nil) +(if te-escape-command-alist + nil + (setq te-escape-command-alist + '(("Set Escape Character" . te-set-escape-char) + ;;>> What use is this? Why is it in the default terminal-emulator map? + ("Edit" . te-edit) + ("Refresh" . redraw-display) + ("Record Output" . te-set-output-log) + ("Photo" . te-set-output-log) + ("Tofu" . te-tofu) ;; confuse the uninitiated + ("Stuff Input" . te-stuff-string) + ("Flush Pending Output" . te-flush-pending-output) + ("Enable More Processing" . te-enable-more-processing) + ("Disable More Processing" . te-disable-more-processing) + ("Scroll at end of page" . te-do-scrolling) + ("Wrap at end of page" . te-do-wrapping) + ("Switch To Buffer" . switch-to-buffer) + ("Other Window" . other-window) + ("Kill Buffer" . kill-buffer) + ("Help" . te-escape-help) + ("Set Redisplay Interval" . te-set-redisplay-interval) + ))) + +(defvar terminal-more-break-map nil) +(if terminal-more-break-map + nil + (let ((map (make-sparse-keymap))) + (define-key map [t] 'te-more-break-unread) + (define-key map (char-to-string help-char) 'te-more-break-help) + (define-key map " " 'te-more-break-resume) + (define-key map "\C-l" 'redraw-display) + (define-key map "\C-o" 'te-more-break-flush-pending-output) + ;;>>> this isn't right + ;(define-key map "\^?" 'te-more-break-flush-pending-output) ;DEL + (define-key map "\r" 'te-more-break-advance-one-line) + + (setq terminal-more-break-map map))) + + +;;; Pacify the byte compiler +(defvar te-process nil) +(defvar te-log-buffer nil) +(defvar te-height nil) +(defvar te-width nil) +(defvar te-more-count nil) +(defvar te-redisplay-count nil) +(defvar te-pending-output nil) +(defvar te-saved-point) +(defvar te-more-old-point nil) +(defvar te-more-old-local-map nil) +(defvar te-more-old-filter nil) +(defvar te-more-old-mode-line-format nil) +(defvar te-pending-output-info nil) + +;; Required to support terminfo systems +(defconst te-terminal-name-prefix "emacs-em" + "Prefix used for terminal type names for Terminfo.") +(defconst te-terminfo-directory + (file-name-as-directory + (expand-file-name "emacs-terminfo" temporary-file-directory)) + "Directory used for run-time terminal definition files for Terminfo.") +(defvar te-terminal-name nil) + +;;;; escape map + +(defun te-escape () + (interactive) + (let (s + (local (current-local-map)) + (global (current-global-map))) + (unwind-protect + (progn + (use-global-map terminal-escape-map) + (use-local-map terminal-escape-map) + (setq s (read-key-sequence + (if current-prefix-arg + (format "Emacs Terminal escape[%s for help]> %d " + (substitute-command-keys + "\\\\[te-escape-help]") + (prefix-numeric-value current-prefix-arg)) + (format "Emacs Terminal escape[%s for help]> " + (substitute-command-keys + "\\\\[te-escape-help]")))))) + (use-global-map global) + (use-local-map local)) + + (message "") + + (cond + ;; Certain keys give vector notation, like [escape] when + ;; you hit esc key... + ((and (stringp s) + (string= s (make-string 1 terminal-escape-char))) + (setq last-command-event terminal-escape-char) + (let ((terminal-escape-char -259)) + (te-pass-through))) + + ((setq s (lookup-key terminal-escape-map s)) + (call-interactively s))) + + )) + + +(defun te-escape-help () + "Provide help on commands available after terminal-escape-char is typed." + (interactive) + (message "Terminal emulator escape help...") + (let ((char (single-key-description terminal-escape-char))) + (with-electric-help + (function (lambda () + (princ (format "Terminal-emulator escape, invoked by \"%s\" +Type \"%s\" twice to send a single \"%s\" through. + +Other chars following \"%s\" are interpreted as follows:\n" + char char char char)) + + (princ (substitute-command-keys "\\{terminal-escape-map}\n")) + (princ (format "\nSubcommands of \"%s\" (%s)\n" + (where-is-internal 'te-escape-extended-command + terminal-escape-map t) + 'te-escape-extended-command)) + (let ((l (sort (copy-sequence te-escape-command-alist) + (function (lambda (a b) + (string< (car a) (car b))))))) + (while l + (let ((doc (or (documentation (cdr (car l))) + "Not documented"))) + (if (string-match "\n" doc) + ;; just use first line of documentation + (setq doc (substring doc 0 (match-beginning 0)))) + (princ " \"") + (princ (car (car l))) + (princ "\":\n ") + (princ doc) + (write-char ?\n)) + (setq l (cdr l)))) + nil))))) + + + +(defun te-escape-extended-command () + (interactive) + (let ((c (let ((completion-ignore-case t)) + (completing-read "terminal command: " + te-escape-command-alist + nil t)))) + (if c + (catch 'foo + (setq c (downcase c)) + (let ((l te-escape-command-alist)) + (while l + (if (string= c (downcase (car (car l)))) + (throw 'foo (call-interactively (cdr (car l)))) + (setq l (cdr l))))))))) + +;; not used. +(defun te-escape-extended-command-unread () + (interactive) + (setq unread-command-events (listify-key-sequence (this-command-keys))) + (te-escape-extended-command)) + +(defun te-set-escape-char (c) + "Change the terminal-emulator escape character." + (interactive "cSet escape character to: ") + (let ((o terminal-escape-char)) + (message (if (= o c) + "\"%s\" is the escape char" + "\"%s\" is now the escape; \"%s\" passes through") + (single-key-description c) + (single-key-description o)) + (setq terminal-escape-char c))) + + +(defun te-stuff-string (string) + "Read a string to send to through the terminal emulator +as though that string had been typed on the keyboard. + +Very poor man's file transfer protocol." + (interactive "sStuff string: ") + (process-send-string te-process string)) + +(defun te-set-output-log (name) + "Record output from the terminal emulator in a buffer." + (interactive (list (if te-log-buffer + nil + (read-buffer "Record output in buffer: " + (format "%s output-log" + (buffer-name (current-buffer))) + nil)))) + (if (or (null name) (equal name "")) + (progn (setq te-log-buffer nil) + (message "Output logging off.")) + (if (get-buffer name) + nil + (with-current-buffer (get-buffer-create name) + (fundamental-mode) + (buffer-disable-undo (current-buffer)) + (erase-buffer))) + (setq te-log-buffer (get-buffer name)) + (message "Recording terminal emulator output into buffer \"%s\"" + (buffer-name te-log-buffer)))) + +(defun te-tofu () + "Discontinue output log." + (interactive) + (te-set-output-log nil)) + + +(defun te-toggle (sym arg) + (set sym (cond ((not (numberp arg)) arg) + ((= arg 1) (not (symbol-value sym))) + ((< arg 0) nil) + (t t)))) + +(defun te-toggle-more-processing (arg) + (interactive "p") + (message (if (te-toggle 'terminal-more-processing arg) + "More processing on" "More processing off")) + (if terminal-more-processing (setq te-more-count -1))) + +(defun te-toggle-scrolling (arg) + (interactive "p") + (message (if (te-toggle 'terminal-scrolling arg) + "Scroll at end of page" "Wrap at end of page"))) + +(defun te-enable-more-processing () + "Enable ** MORE ** processing" + (interactive) + (te-toggle-more-processing t)) + +(defun te-disable-more-processing () + "Disable ** MORE ** processing" + (interactive) + (te-toggle-more-processing nil)) + +(defun te-do-scrolling () + "Scroll at end of page (yuck)" + (interactive) + (te-toggle-scrolling t)) + +(defun te-do-wrapping () + "Wrap to top of window at end of page" + (interactive) + (te-toggle-scrolling nil)) + + +(defun te-set-redisplay-interval (arg) + "Set the maximum interval (in output characters) between screen updates. +Set this number to large value for greater throughput, +set it smaller for more frequent updates (but overall slower performance." + (interactive "NMax number of output chars between redisplay updates: ") + (setq arg (max arg 1)) + (setq terminal-redisplay-interval arg + te-redisplay-count 0)) + +;;;; more map + +;; every command -must- call te-more-break-unwind +;; or grave lossage will result + +(put 'te-more-break-unread 'suppress-keymap t) +(defun te-more-break-unread () + (interactive) + (if (eq last-input-event terminal-escape-char) + (call-interactively 'te-escape) + (message "Continuing from more break (\"%s\" typed, %d chars output pending...)" + (single-key-description last-input-event) + (te-pending-output-length)) + (setq te-more-count 259259) + (te-more-break-unwind) + (let ((terminal-more-processing nil)) + (te-pass-through)))) + +(defun te-more-break-resume () + "Proceed past the **MORE** break, +allowing the next page of output to appear" + (interactive) + (message "Continuing from more break") + (te-more-break-unwind)) + +(defun te-more-break-help () + "Provide help on commands available in a terminal-emulator **MORE** break" + (interactive) + (message "Terminal-emulator more break help...") + (sit-for 0) + (with-electric-help + (function (lambda () + (princ "Terminal-emulator more break.\n\n") + (princ (format "Type \"%s\" (te-more-break-resume)\n%s\n" + (where-is-internal 'te-more-break-resume + terminal-more-break-map t) + (documentation 'te-more-break-resume))) + (princ (substitute-command-keys "\\{terminal-more-break-map}\n")) + (princ "Any other key is passed through to the program +running under the terminal emulator and disables more processing until +all pending output has been dealt with.") + nil)))) + + +(defun te-more-break-advance-one-line () + "Allow one more line of text to be output before doing another more break." + (interactive) + (setq te-more-count 1) + (te-more-break-unwind)) + +(defun te-more-break-flush-pending-output () + "Discard any output which has been received by the terminal emulator but +not yet processed and then proceed from the more break." + (interactive) + (te-more-break-unwind) + (te-flush-pending-output)) + +(defun te-flush-pending-output () + "Discard any as-yet-unprocessed output which has been received by +the terminal emulator." + (interactive) + ;; this could conceivably be confusing in the presence of + ;; escape-sequences spanning process-output chunks + (if (null (cdr te-pending-output)) + (message "(There is no output pending)") + (let ((length (te-pending-output-length))) + (message "Flushing %d chars of pending output" length) + (setq te-pending-output + (list 0 (format "\n*** %d chars of pending output flushed ***\n" + length))) + (te-update-pending-output-display) + (te-process-output nil) + (sit-for 0)))) + + +(defun te-pass-through () + "Character is passed to the program running under the terminal emulator. +One characters is treated specially: +the terminal escape character (normally C-^) +lets you type a terminal emulator command." + (interactive) + (cond ((eq last-input-event terminal-escape-char) + (call-interactively 'te-escape)) + (t + ;; Convert `return' to C-m, etc. + (if (and (symbolp last-input-event) + (get last-input-event 'ascii-character)) + (setq last-input-event (get last-input-event 'ascii-character))) + ;; Convert meta characters to 8-bit form for transmission. + (if (and (integerp last-input-event) + (not (zerop (logand last-input-event ?\M-\^@)))) + (setq last-input-event (+ 128 (logand last-input-event 127)))) + ;; Now ignore all but actual characters. + ;; (It ought to be possible to send through function + ;; keys as character sequences if we add a description + ;; to our termcap entry of what they should look like.) + (if (integerp last-input-event) + (progn + (and terminal-more-processing (null (cdr te-pending-output)) + (te-set-more-count nil)) + (process-send-string te-process (make-string 1 last-input-event)) + (te-process-output t)) + (message "Function key `%s' ignored" + (single-key-description last-input-event)))))) + + +(defun te-set-window-start () + (let* ((w (get-buffer-window (current-buffer))) + (h (if w (window-height w)))) + (cond ((not w)) ; buffer not displayed + ((>= h (/ (- (point) (point-min)) (1+ te-width))) + ;; this is the normal case + (set-window-start w (point-min))) + ;; this happens if some vandal shrinks our window. + ((>= h (/ (- (point-max) (point)) (1+ te-width))) + (set-window-start w (- (point-max) (* h (1+ te-width)) -1))) + ;; I give up. + (t nil)))) + +(defun te-pending-output-length () + (let ((length (car te-pending-output)) + (tem (cdr te-pending-output))) + (while tem + (setq length (+ length (length (car tem))) tem (cdr tem))) + length)) + +;;>> What use is this terminal-edit stuff anyway? +;;>> If nothing else, it was written by somebody who didn't +;;>> competently understand the terminal-emulator... + +(defvar terminal-edit-map nil) +(if terminal-edit-map + nil + (setq terminal-edit-map (make-sparse-keymap)) + (define-key terminal-edit-map "\C-c\C-c" 'terminal-cease-edit)) + +;; Terminal Edit mode is suitable only for specially formatted data. +(put 'terminal-edit-mode 'mode-class 'special) + +(defun terminal-edit-mode () + "Major mode for editing the contents of a terminal-emulator buffer. +The editing commands are the same as in Fundamental mode, +together with a command \\to return to terminal emulation: \\[terminal-cease-edit]." + (use-local-map terminal-edit-map) + (setq major-mode 'terminal-edit-mode) + (setq mode-name "Terminal Edit") + (setq mode-line-modified (default-value 'mode-line-modified)) + (setq mode-line-process nil) + (run-mode-hooks 'terminal-edit-mode-hook)) + +(defun te-edit () + "Start editing the terminal emulator buffer with ordinary Emacs commands." + (interactive) + (terminal-edit-mode) + (force-mode-line-update) + ;; Make mode line update. + (if (eq (key-binding "\C-c\C-c") 'terminal-cease-edit) + (message "Editing: Type C-c C-c to return to Terminal") + (message "%s" + (substitute-command-keys + "Editing: Type \\[terminal-cease-edit] to return to Terminal")))) + +(defun terminal-cease-edit () + "Finish editing message; switch back to Terminal proper." + (interactive) + + ;;>> emulator will blow out if buffer isn't exactly te-width x te-height + (let ((buffer-read-only nil)) + (widen) + (let ((opoint (point-marker)) + (width te-width) + (h (1- te-height))) + (goto-char (point-min)) + (while (>= h 0) + (let ((p (point))) + (cond ((search-forward "\n" (+ p width) 'move) + (forward-char -1) + (insert-char ?\s (- width (- (point) p))) + (forward-char 1)) + ((eobp) + (insert-char ?\s (- width (- (point) p)))) + ((= (following-char) ?\n) + (forward-char 1)) + (t + (setq p (point)) + (if (search-forward "\n" nil t) + (delete-region p (1- (point))) + (delete-region p (point-max)))))) + (if (= h 0) + (if (not (eobp)) (delete-region (point) (point-max))) + (if (eobp) (insert ?\n))) + (setq h (1- h))) + (goto-char opoint) + (set-marker opoint nil nil) + (setq te-saved-point (point)) + (setq te-redisplay-count 0) + (setq te-more-count -1))) + + (setq mode-line-modified (default-value 'mode-line-modified)) + (use-local-map terminal-map) + (setq major-mode 'terminal-mode) + (setq mode-name "terminal") + (setq mode-line-process '(":%s"))) + +;;;; more break hair + +(defun te-more-break () + (te-set-more-count t) + (make-local-variable 'te-more-old-point) + (setq te-more-old-point (point)) + (make-local-variable 'te-more-old-local-map) + (setq te-more-old-local-map (current-local-map)) + (use-local-map terminal-more-break-map) + (make-local-variable 'te-more-old-filter) + (setq te-more-old-filter (process-filter te-process)) + (make-local-variable 'te-more-old-mode-line-format) + (setq te-more-old-mode-line-format mode-line-format + mode-line-format (list "-- **MORE** " + mode-line-buffer-identification + "%-")) + (set-process-filter te-process + (function (lambda (process string) + (with-current-buffer (process-buffer process) + (setq te-pending-output (nconc te-pending-output + (list string)))) + (te-update-pending-output-display)))) + (te-update-pending-output-display) + (if (eq (window-buffer (selected-window)) (current-buffer)) + (message "More break ")) + (or (eobp) + (null terminal-more-break-insertion) + (save-excursion + (forward-char 1) + (delete-region (point) (+ (point) te-width)) + (insert terminal-more-break-insertion))) + (run-hooks 'terminal-more-break-hook) + (sit-for 0) ;get display to update + (throw 'te-process-output t)) + +(defun te-more-break-unwind () + (use-local-map te-more-old-local-map) + (set-process-filter te-process te-more-old-filter) + (goto-char te-more-old-point) + (setq mode-line-format te-more-old-mode-line-format) + (force-mode-line-update) + (let ((buffer-read-only nil)) + (cond ((eobp)) + (terminal-more-break-insertion + (forward-char 1) + (delete-region (point) + (+ (point) (length terminal-more-break-insertion))) + (insert-char ?\s te-width) + (goto-char te-more-old-point))) + (setq te-more-old-point nil) + (let ((te-more-count 259259)) + (te-newline))) + ;(sit-for 0) + (te-process-output t)) + +(defun te-set-more-count (newline) + (let ((line (/ (- (point) (point-min)) (1+ te-width)))) + (if newline (setq line (1+ line))) + (cond ((= line te-height) + (setq te-more-count te-height)) + ;>>>> something is strange. Investigate this! + ((= line (1- te-height)) + (setq te-more-count te-height)) + ((or (< line (/ te-height 2)) + (> (- te-height line) 10)) + ;; break at end of this page + (setq te-more-count (- te-height line))) + (t + ;; migrate back towards top (ie bottom) of screen. + (setq te-more-count (- te-height + (if (> te-height 10) 2 1))))))) + + +;;;; More or less straight-forward terminal escapes + +;; ^j, meaning `newline' to non-display programs. +;; (Who would think of ever writing a system which doesn't understand +;; display terminals natively? Un*x: The Operating System of the Future.) +(defun te-newline () + "Move down a line, optionally do more processing, perhaps wrap/scroll, +move to start of new line, clear to end of line." + (end-of-line) + (cond ((not terminal-more-processing)) + ((< (setq te-more-count (1- te-more-count)) 0) + (te-set-more-count t)) + ((eq te-more-count 0) + ;; this doesn't return + (te-more-break))) + (if (eobp) + (progn + (delete-region (point-min) (+ (point-min) te-width)) + (goto-char (point-min)) + (if terminal-scrolling + (progn (delete-char 1) + (goto-char (point-max)) + (insert ?\n)))) + (forward-char 1) + (delete-region (point) (+ (point) te-width))) + (insert-char ?\s te-width) + (beginning-of-line) + (te-set-window-start)) + +; ^p = x+32 y+32 +(defun te-move-to-position () + ;; must offset by #o40 since cretinous unix won't send a 004 char through + (let ((y (- (te-get-char) 32)) + (x (- (te-get-char) 32))) + (if (or (> x te-width) + (> y te-height)) + () + (goto-char (+ (point-min) x (* y (1+ te-width)))) + ;(te-set-window-start?) + )) + (setq te-more-count -1)) + + + +;; ^p c +(defun te-clear-rest-of-line () + (save-excursion + (let ((n (- (point) (progn (end-of-line) (point))))) + (delete-region (point) (+ (point) n)) + (insert-char ?\s (- n))))) + + +;; ^p C +(defun te-clear-rest-of-screen () + (save-excursion + (te-clear-rest-of-line) + (while (progn (end-of-line) (not (eobp))) + (forward-char 1) (end-of-line) + (delete-region (- (point) te-width) (point)) + (insert-char ?\s te-width)))) + + +;; ^p ^l +(defun te-clear-screen () + ;; regenerate buffer to compensate for (nonexistent!!) bugs. + (erase-buffer) + (let ((i 0)) + (while (< i te-height) + (setq i (1+ i)) + (insert-char ?\s te-width) + (insert ?\n))) + (delete-region (1- (point-max)) (point-max)) + (goto-char (point-min)) + (setq te-more-count -1)) + + +;; ^p ^o count+32 +(defun te-insert-lines () + (if (not (bolp)) + ();(error "fooI") + (save-excursion + (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1)) + (n (min (- (te-get-char) ?\s) line)) + (i 0)) + (delete-region (- (point-max) (* n (1+ te-width))) (point-max)) + (if (eq (point) (point-max)) (insert ?\n)) + (while (< i n) + (setq i (1+ i)) + (insert-char ?\s te-width) + (or (eq i line) (insert ?\n)))))) + (setq te-more-count -1)) + + +;; ^p ^k count+32 +(defun te-delete-lines () + (if (not (bolp)) + ();(error "fooD") + (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1)) + (n (min (- (te-get-char) ?\s) line)) + (i 0)) + (delete-region (point) + (min (+ (point) (* n (1+ te-width))) (point-max))) + (save-excursion + (goto-char (point-max)) + (while (< i n) + (setq i (1+ i)) + (insert-char ?\s te-width) + (or (eq i line) (insert ?\n)))))) + (setq te-more-count -1)) + +;; ^p ^a +(defun te-beginning-of-line () + (beginning-of-line)) + +;; ^p ^b +(defun te-backward-char () + (if (not (bolp)) + (backward-char 1))) + +;; ^p ^f +(defun te-forward-char () + (if (not (eolp)) + (forward-char 1))) + + +;; 0177 +(defun te-delete () + (if (bolp) + () + (delete-region (1- (point)) (point)) + (insert ?\s) + (forward-char -1))) + +;; ^p ^g +(defun te-beep () + (beep)) + + +;; ^p _ count+32 +(defun te-insert-spaces () + (let* ((p (point)) + (n (min (- (te-get-char) 32) + (- (progn (end-of-line) (point)) p)))) + (if (<= n 0) + nil + (delete-char (- n)) + (goto-char p) + (insert-char ?\s n)) + (goto-char p))) + +;; ^p d count+32 (should be ^p ^d but cretinous un*x won't send ^d chars!!!) +(defun te-delete-char () + (let* ((p (point)) + (n (min (- (te-get-char) 32) + (- (progn (end-of-line) (point)) p)))) + (if (<= n 0) + nil + (insert-char ?\s n) + (goto-char p) + (delete-char n)) + (goto-char p))) + + + +;; disgusting unix-required excrement +;; Are we living twenty years in the past yet? + +(defun te-losing-unix () + nil) + +;; ^i +(defun te-output-tab () + (let* ((p (point)) + (x (- p (progn (beginning-of-line) (point)))) + (l (min (- 8 (logand x 7)) + (progn (end-of-line) (- (point) p))))) + (goto-char (+ p l)))) + +;; ^p ^j +;; Handle the `do' or `nl' termcap capability. +;;>> I am not sure why this broken, obsolete, capability is here. +;;>> Perhaps it is for VIle. No comment was made about why it +;;>> was added (in "Sun Dec 6 01:22:27 1987 Richard Stallman") +(defun te-down-vertically-or-scroll () + "Move down a line vertically, or scroll at bottom." + (let ((column (current-column))) + (end-of-line) + (if (eobp) + (progn + (delete-region (point-min) (+ (point-min) te-width)) + (goto-char (point-min)) + (delete-char 1) + (goto-char (point-max)) + (insert ?\n) + (insert-char ?\s te-width) + (beginning-of-line)) + (forward-line 1)) + (move-to-column column)) + (te-set-window-start)) + +;; Also: +;; ^m => beginning-of-line (for which it -should- be using ^p ^a, right?!!) +;; ^g => te-beep (for which it should use ^p ^g) +;; ^h => te-backward-char (for which it should use ^p ^b) + + + +(defun te-filter (process string) + (with-current-buffer (process-buffer process) + (goto-char te-saved-point) + (and (bufferp te-log-buffer) + (if (null (buffer-name te-log-buffer)) + ;; killed + (setq te-log-buffer nil) + (set-buffer te-log-buffer) + (goto-char (point-max)) + (insert-before-markers string) + (set-buffer (process-buffer process)))) + (setq te-pending-output (nconc te-pending-output (list string))) + (te-update-pending-output-display) + (te-process-output (eq (current-buffer) + (window-buffer (selected-window)))) + (set-buffer (process-buffer process)) + (setq te-saved-point (point)))) + +;; (A version of the following comment which might be distractingly offensive +;; to some readers has been moved to term-nasty.el.) +;; unix lacks ITS-style tty control... +(defun te-process-output (preemptible) + ;;>> There seems no good reason to ever disallow preemption + (setq preemptible t) + (catch 'te-process-output + (let ((buffer-read-only nil) + (string nil) ostring start char (matchpos nil)) + (while (cdr te-pending-output) + (setq ostring string + start (car te-pending-output) + string (car (cdr te-pending-output)) + char (aref string start)) + (if (eq (setq start (1+ start)) (length string)) + (progn (setq te-pending-output + (cons 0 (cdr (cdr te-pending-output))) + start 0 + string (car (cdr te-pending-output))) + (te-update-pending-output-display)) + (setcar te-pending-output start)) + (if (and (> char ?\037) (< char ?\377)) + (cond ((eolp) + ;; unread char + (if (eq start 0) + (setq te-pending-output + (cons 0 (cons (make-string 1 char) + (cdr te-pending-output)))) + (setcar te-pending-output (1- start))) + (te-newline)) + ((null string) + (delete-char 1) (insert char) + (te-redisplay-if-necessary 1)) + (t + (let ((end (or (and (eq ostring string) matchpos) + (setq matchpos (string-match + "[\000-\037\177-\377]" + string start)) + (length string)))) + (delete-char 1) (insert char) + (setq char (point)) (end-of-line) + (setq end (min end (+ start (- (point) char)))) + (goto-char char) + (if (eq end matchpos) (setq matchpos nil)) + (delete-region (point) (+ (point) (- end start))) + (insert (if (and (eq start 0) + (eq end (length string))) + string + (substring string start end))) + (if (eq end (length string)) + (setq te-pending-output + (cons 0 (cdr (cdr te-pending-output)))) + (setcar te-pending-output end)) + (te-redisplay-if-necessary (1+ (- end start)))))) + ;; I suppose if I split the guts of this out into a separate + ;; function we could trivially emulate different terminals + ;; Who cares in any case? (Apart from stupid losers using rlogin) + (funcall + (if (eq char ?\^p) + (or (cdr (assq (te-get-char) + '((?= . te-move-to-position) + (?c . te-clear-rest-of-line) + (?C . te-clear-rest-of-screen) + (?\C-o . te-insert-lines) + (?\C-k . te-delete-lines) + ;; not necessary, but help sometimes. + (?\C-a . te-beginning-of-line) + (?\C-b . te-backward-char) + ;; should be C-d, but un*x + ;; pty's won't send \004 through! + ;; Can you believe this? + (?d . te-delete-char) + (?_ . te-insert-spaces) + ;; random + (?\C-f . te-forward-char) + (?\C-g . te-beep) + (?\C-j . te-down-vertically-or-scroll) + (?\C-l . te-clear-screen) + ))) + 'te-losing-unix) + (or (cdr (assq char + '((?\C-j . te-newline) + (?\177 . te-delete) + ;; Did I ask to be sent these characters? + ;; I don't remember doing so, either. + ;; (Perhaps some operating system or + ;; other is completely incompetent...) + (?\C-m . te-beginning-of-line) + (?\C-g . te-beep) + (?\C-h . te-backward-char) + (?\C-i . te-output-tab)))) + 'te-losing-unix))) + (te-redisplay-if-necessary 1)) + (and preemptible + (input-pending-p) + ;; preemptible output! Oh my!! + (throw 'te-process-output t))))) + ;; We must update window-point in every window displaying our buffer + (walk-windows (lambda (w) + (when (and (not (eq w (selected-window))) + (eq (window-buffer w) (current-buffer))) + (set-window-point w (point)))))) + +(defun te-get-char () + (if (cdr te-pending-output) + (let ((start (car te-pending-output)) + (string (car (cdr te-pending-output)))) + (prog1 (aref string start) + (if (eq (setq start (1+ start)) (length string)) + (setq te-pending-output (cons 0 (cdr (cdr te-pending-output)))) + (setcar te-pending-output start)))) + (catch 'char + (let ((filter (process-filter te-process))) + (unwind-protect + (progn + (set-process-filter te-process + (function (lambda (_p s) + (or (eq (length s) 1) + (setq te-pending-output (list 1 s))) + (throw 'char (aref s 0))))) + (accept-process-output te-process)) + (set-process-filter te-process filter)))))) + + +(defun te-redisplay-if-necessary (length) + (and (<= (setq te-redisplay-count (- te-redisplay-count length)) 0) + (eq (current-buffer) (window-buffer (selected-window))) + (waiting-for-user-input-p) + (progn (te-update-pending-output-display) + (sit-for 0) + (setq te-redisplay-count terminal-redisplay-interval)))) + +(defun te-update-pending-output-display () + (if (null (cdr te-pending-output)) + (setq te-pending-output-info "") + (let ((length (te-pending-output-length))) + (if (< length 1500) + (setq te-pending-output-info "") + (setq te-pending-output-info (format "(%dK chars output pending) " + (/ (+ length 512) 1024)))))) + (force-mode-line-update)) + + +(defun te-sentinel (process message) + (cond ((eq (process-status process) 'run)) + ((null (buffer-name (process-buffer process)))) ;deleted + (t (let ((b (current-buffer))) + (with-current-buffer (process-buffer process) + (setq buffer-read-only nil) + (fundamental-mode) + (goto-char (point-max)) + (delete-blank-lines) + (delete-horizontal-space) + (insert "\n*******\n" message "*******\n")) + (if (and (eq b (process-buffer process)) + (waiting-for-user-input-p)) + (progn (goto-char (point-max)) + (recenter -1))))))) + +(defvar te-stty-string "stty -nl erase '^?' kill '^u' intr '^c' echo pass8" + "Shell command to set terminal modes for terminal emulator.") +;; This used to have `new' in it, but that loses outside BSD +;; and it's apparently not needed in BSD. + +(defcustom explicit-shell-file-name nil + "If non-nil, is file name to use for explicitly requested inferior shell." + :type '(choice (const :tag "None" nil) + file) + :group 'terminal) + +;;;###autoload +(defun terminal-emulator (buffer program args &optional width height) + "Under a display-terminal emulator in BUFFER, run PROGRAM on arguments ARGS. +ARGS is a list of argument-strings. Remaining arguments are WIDTH and HEIGHT. +BUFFER's contents are made an image of the display generated by that program, +and any input typed when BUFFER is the current Emacs buffer is sent to that +program as keyboard input. + +Interactively, BUFFER defaults to \"*terminal*\" and PROGRAM and ARGS +are parsed from an input-string using your usual shell. +WIDTH and HEIGHT are determined from the size of the current window +-- WIDTH will be one less than the window's width, HEIGHT will be its height. + +To switch buffers and leave the emulator, or to give commands +to the emulator itself (as opposed to the program running under it), +type Control-^. The following character is an emulator command. +Type Control-^ twice to send it to the subprogram. +This escape character may be changed using the variable `terminal-escape-char'. + +`Meta' characters may not currently be sent through the terminal emulator. + +Here is a list of some of the variables which control the behavior +of the emulator -- see their documentation for more information: +terminal-escape-char, terminal-scrolling, terminal-more-processing, +terminal-redisplay-interval. + +This function calls the value of terminal-mode-hook if that exists +and is non-nil after the terminal buffer has been set up and the +subprocess started." + (interactive + (cons (with-current-buffer (get-buffer-create "*terminal*") + (buffer-name (if (or (not (boundp 'te-process)) + (null te-process) + (not (eq (process-status te-process) + 'run))) + (current-buffer) + (generate-new-buffer "*terminal*")))) + (append + (let* ((default-s + ;; Default shell is same thing M-x shell uses. + (or explicit-shell-file-name + (getenv "ESHELL") + (getenv "SHELL") + "/bin/sh")) + (s (read-string + (format "Run program in emulator (default %s): " + default-s)))) + (if (equal s "") + (list default-s '()) + (te-parse-program-and-args s)))))) + (switch-to-buffer buffer) + (if (null width) (setq width (- (window-width (selected-window)) 1))) + (if (null height) (setq height (- (window-height (selected-window)) 1))) + (terminal-mode) + (setq te-width width te-height height) + (setq te-terminal-name (concat te-terminal-name-prefix + (number-to-string te-width) + (number-to-string te-height))) + (setq mode-line-buffer-identification + (list (format "Emacs terminal %dx%d: %%b " te-width te-height) + 'te-pending-output-info)) + (let ((buffer-read-only nil)) + (te-clear-screen)) + (let (process) + (while (setq process (get-buffer-process (current-buffer))) + (if (y-or-n-p (format "Kill process %s? " (process-name process))) + (delete-process process) + (error "Process %s not killed" (process-name process))))) + (condition-case err + (let ((process-environment + (cons (concat "TERM=" te-terminal-name) + (cons (concat "TERMCAP=" (te-create-termcap)) + (cons (concat "TERMINFO=" (te-create-terminfo)) + process-environment))))) + (setq te-process + (start-process "terminal-emulator" (current-buffer) + "/bin/sh" "-c" + ;; Yuck!!! Start a shell to set some terminal + ;; control characteristics. Then start the + ;; "env" program to setup the terminal type + ;; Then finally start the program we wanted. + (format "%s; exec %s" + te-stty-string + (mapconcat 'te-quote-arg-for-sh + (cons program args) " ")))) + (set-process-filter te-process 'te-filter) + (set-process-sentinel te-process 'te-sentinel)) + (error (fundamental-mode) + (signal (car err) (cdr err)))) + (setq inhibit-quit t) ;sport death + (use-local-map terminal-map) + (run-hooks 'terminal-mode-hook) + (message "Entering Emacs terminal-emulator... Type %s %s for help" + (single-key-description terminal-escape-char) + (mapconcat 'single-key-description + (where-is-internal 'te-escape-help terminal-escape-map t) + " "))) + + +(defun te-parse-program-and-args (s) + (cond ((string-match "\\`\\([-a-zA-Z0-9+=_.@/:]+[ \t]*\\)+\\'" s) + (let ((l ()) (p 0)) + (while p + (setq l (cons (if (string-match + "\\([-a-zA-Z0-9+=_.@/:]+\\)\\([ \t]+\\)*" + s p) + (prog1 (substring s p (match-end 1)) + (setq p (match-end 0)) + (if (eq p (length s)) (setq p nil))) + (prog1 (substring s p) + (setq p nil))) + l))) + (setq l (nreverse l)) + (list (car l) (cdr l)))) + ((and (string-match "[ \t]" s) (not (file-exists-p s))) + (list shell-file-name (list "-c" (concat "exec " s)))) + (t (list s ())))) + +(put 'terminal-mode 'mode-class 'special) +;; This is only separated out from function terminal-emulator +;; to keep the latter a little more manageable. +(defun terminal-mode () + "Set up variables for use with the terminal-emulator. +One should not call this -- it is an internal function +of the terminal-emulator" + (kill-all-local-variables) + (buffer-disable-undo (current-buffer)) + (setq major-mode 'terminal-mode) + (setq mode-name "terminal") +; (make-local-variable 'Helper-return-blurb) +; (setq Helper-return-blurb "return to terminal simulator") + (setq mode-line-process '(":%s")) + (setq buffer-read-only t) + (setq truncate-lines t) + (make-local-variable 'terminal-escape-char) + (setq terminal-escape-char (default-value 'terminal-escape-char)) + (make-local-variable 'terminal-scrolling) + (setq terminal-scrolling (default-value 'terminal-scrolling)) + (make-local-variable 'terminal-more-processing) + (setq terminal-more-processing (default-value 'terminal-more-processing)) + (make-local-variable 'terminal-redisplay-interval) + (setq terminal-redisplay-interval (default-value 'terminal-redisplay-interval)) + (make-local-variable 'te-width) + (make-local-variable 'te-height) + (make-local-variable 'te-process) + (make-local-variable 'te-pending-output) + (setq te-pending-output (list 0)) + (make-local-variable 'te-saved-point) + (setq te-saved-point (point-min)) + (make-local-variable 'te-pending-output-info) ;for the mode line + (setq te-pending-output-info "") + (make-local-variable 'inhibit-quit) + ;(setq inhibit-quit t) + (make-local-variable 'te-log-buffer) + (setq te-log-buffer nil) + (make-local-variable 'te-more-count) + (setq te-more-count -1) + (make-local-variable 'te-redisplay-count) + (setq te-redisplay-count terminal-redisplay-interval) + ;(use-local-map terminal-mode-map) + ;; terminal-mode-hook is called above in function terminal-emulator + ) + +;;;; what a complete loss + +(defun te-quote-arg-for-sh (string) + (cond ((string-match "\\`[-a-zA-Z0-9+=_.@/:]+\\'" + string) + string) + ((not (string-match "[$]" string)) + ;; "[\"\\]" are special to sh and the lisp reader in the same way + (prin1-to-string string)) + (t + (let ((harder "") + (start 0) + (end 0)) + (while (cond ((>= start (length string)) + nil) + ;; this is the set of chars magic with "..." in `sh' + ((setq end (string-match "[\"\\$]" + string start)) + t) + (t (setq harder (concat harder + (substring string start))) + nil)) + (setq harder (concat harder (substring string start end) + ;; Can't use ?\\ since `concat' + ;; unfortunately does prin1-to-string + ;; on fixna. Amazing. + "\\" + (substring string + end + (1+ end))) + start (1+ end))) + (concat "\"" harder "\""))))) + +(defun te-create-terminfo () + "Create and compile a terminfo entry for the virtual terminal. This is kept +in the directory specified by `te-terminfo-directory'." + (when (and system-uses-terminfo + (not (file-exists-p (concat te-terminfo-directory + (substring te-terminal-name-prefix 0 1) + "/" te-terminal-name)))) + (let ( (terminfo + (concat + ;; The first newline avoids trouble with ncurses. + (format "%s,\n\tmir, xon,cols#%d, lines#%d," + te-terminal-name te-width te-height) + "bel=^P^G, clear=^P\\f, cr=^P^A, cub1=^P^B, cud1=^P\\n," + "cuf1=^P^F, cup=^P=%p1%'\\s'%+%c%p2%'\\s'%+%c," + "dch=^Pd%p1%'\\s'%+%c, dch1=^Pd!, dl=^P^K%p1%'\\s'%+%c," + "dl1=^P^K!, ed=^PC, el=^Pc, home=^P=\\s\\s," + "ich=^P_%p1%'\\s'%+%c, ich1=^P_!, il=^P^O%p1%'\\s'%+%c," + ;; The last newline avoids trouble with ncurses. + "il1=^P^O!, ind=^P\\n, nel=\\n,\n")) + ;; This is the desired name for the source file. + (file-name (concat te-terminfo-directory te-terminal-name ".tif")) ) + (make-directory te-terminfo-directory t) + (let ((temp-file + (make-temp-file (expand-file-name "tif" te-terminfo-directory)))) + ;; Store the source file under a random temp name. + (with-temp-file temp-file + (insert terminfo)) + ;; Rename it to the desired name. + ;; We use this roundabout approach + ;; to avoid any risk of writing a name that + ;; was mischievously set up as a symlink. + (rename-file temp-file file-name)) + ;; Now compile that source to make the binary that the + ;; programs actually use. + (let ((process-environment + (cons (concat "TERMINFO=" + (directory-file-name te-terminfo-directory)) + process-environment))) + (set-process-sentinel (start-process "tic" nil "tic" file-name) + 'te-tic-sentinel)))) + (directory-file-name te-terminfo-directory)) + +(defun te-create-termcap () + "Create a termcap entry for the virtual terminal" + ;; Because of Unix Brain Death(tm), we can't change + ;; the terminal type of a running process, and so + ;; terminal size and scrollability are wired-down + ;; at this point. ("Detach? What's that?") + (concat (format "%s:co#%d:li#%d:%s" + ;; Sigh. These can't be dynamically changed. + te-terminal-name te-width te-height (if terminal-scrolling + "" "ns:")) + ;;-- Basic things + ;; cursor-motion, bol, forward/backward char + "cm=^p=%+ %+ :cr=^p^a:le=^p^b:nd=^p^f:" + ;; newline, clear eof/eof, audible bell + "nw=^j:ce=^pc:cd=^pC:cl=^p^l:bl=^p^g:" + ;; insert/delete char/line + "IC=^p_%+ :DC=^pd%+ :AL=^p^o%+ :DL=^p^k%+ :" + ;;-- Not-widely-known (ie nonstandard) flags, which mean + ;; o writing in the last column of the last line + ;; doesn't cause idiotic scrolling, and + ;; o don't use idiotische c-s/c-q sogenannte + ;; ``flow control'' auf keinen Fall. + "LP:NF:" + ;;-- For stupid or obsolete programs + "ic=^p_!:dc=^pd!:al=^p^o!:dl=^p^k!:ho=^p= :" + ;;-- For disgusting programs. + ;; (VI? What losers need these, I wonder?) + "im=:ei=:dm=:ed=:mi:do=^p^j:nl=^p^j:bs:") +) + +(defun te-tic-sentinel (_proc state-change) + "If tic has finished, delete the .tif file" + (if (equal state-change "finished +") + (delete-file (concat te-terminfo-directory te-terminal-name ".tif")))) + +(provide 'terminal) + +;;; terminal.el ends here diff --cc lisp/progmodes/perl-mode.el index 46940457d36,2ee7734e40e..bd58a7300ec --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@@ -1,6 -1,6 +1,6 @@@ -;;; perl-mode.el --- Perl code editing commands for GNU Emacs +;;; perl-mode.el --- Perl code editing commands for GNU Emacs -*- coding: utf-8 -*- - ;; Copyright (C) 1990, 1994, 2001-2012 Free Software Foundation, Inc. + ;; Copyright (C) 1990, 1994, 2001-2013 Free Software Foundation, Inc. ;; Author: William F. Mann ;; Maintainer: FSF diff --cc lisp/progmodes/sql.el index 9765b614b96,52d29746edf..453386cdba5 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@@ -1,6 -1,6 +1,6 @@@ -;;; sql.el --- specialized comint.el for SQL interpreters +;;; sql.el --- specialized comint.el for SQL interpreters -*- lexical-binding: t -*- - ;; Copyright (C) 1998-2012 Free Software Foundation, Inc. + ;; Copyright (C) 1998-2013 Free Software Foundation, Inc. ;; Author: Alex Schroeder ;; Maintainer: Michael Mauger diff --cc src/ChangeLog index 183d9728345,ea882770765..d967bebff14 --- a/src/ChangeLog +++ b/src/ChangeLog @@@ -1,58 -1,8 +1,62 @@@ + 2012-12-31 Glenn Morris + + * keymap.c (Fkey_description): Doc fix. (Bug#13323) + -2012-12-29 Andreas Schwab +2013-01-02 Paul Eggert + + Simplify via eabs. + * dired.c (file_name_completion): + * doc.c (get_doc_string): + * floatfns.c (round2): + * font.c (font_score, font_delete_unmatched): + * fringe.c (compute_fringe_widths): + * lread.c (read_list): + * minibuf.c (Ftry_completion): + * term.c (tty_ins_del_lines): + * xterm.c (x_draw_image_foreground, x_draw_image_foreground_1): + Use eabs (x) rather than open-coding it as (x < 0 ? -x : x). + +2012-12-31 Eli Zaretskii + + * w32.c (unsetenv): Set up the string passed to _putenv + correctly. See + http://lists.gnu.org/archive/html/emacs-devel/2012-12/msg00863.html + for the bug this caused. + +2012-12-30 Paul Eggert + + * coding.c (Qmac): Now static. + +2012-12-30 Jan Djärv + + * gtkutil.c (TOOLBAR_TOP_WIDGET): New macro. + (xg_pack_tool_bar): Use TOOLBAR_TOP_WIDGET, condition out use of + handlebox_widget. Set toolbar_in_hbox to false/true, set + toolbar_is_packed to true. + (xg_update_tool_bar_sizes): Use widget returned by TOOLBAR_TOP_WIDGET. + (update_frame_tool_bar): Check toolbar_is_packed for packing. + Show all on TOOLBAR_TOP_WIDGET. + (free_frame_tool_bar): Check toolbar_is_packed. Use widget returned + by TOOLBAR_TOP_WIDGET. + (xg_change_toolbar_position): Use widget returned by TOOLBAR_TOP_WIDGET. + Check toolbar_is_packed. + (xg_have_tear_offs, tearoff_remove, tearoff_activate): Condition on + HAVE_GTK_TEAROFF_MENU_ITEM_NEW. + (xg_have_tear_offs): When ! HAVE_GTK_TEAROFF_MENU_ITEM_NEW, return + false. + (create_menus): Create tearoff only if HAVE_GTK_TEAROFF_MENU_ITEM_NEW. + (xg_update_menubar): Update title only if + HAVE_GTK_TEAROFF_MENU_ITEM_NEW. + (xg_update_submenu): Skip tearoff only if + HAVE_GTK_TEAROFF_MENU_ITEM_NEW. + (xg_initialize): Initialize xg_detached_menus only if + HAVE_GTK_TEAROFF_MENU_ITEM_NEW. + + * xterm.h (struct x_output): Surround handlebox_widget with + #ifdef HAVE_GTK_HANDLE_BOX_NEW. toolbar_is_packed is new, + toolbar_in_hbox is bool. + +2012-12-30 Andreas Schwab * src/Makefile.in (TEMACS_LDFLAGS2): Remove. (LIBS_GNUSTEP): Define. diff --cc test/automated/ert-tests.el index 1aef1921871,6be14f6097e..0c3c3692c1d --- a/test/automated/ert-tests.el +++ b/test/automated/ert-tests.el @@@ -1,6 -1,6 +1,6 @@@ -;;; ert-tests.el --- ERT's self-tests +;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*- - ;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc. + ;; Copyright (C) 2007-2008, 2010-2013 Free Software Foundation, Inc. ;; Author: Christian Ohler