summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog91
-rw-r--r--lisp/abbrev.el51
-rw-r--r--lisp/allout-widgets.el16
-rw-r--r--lisp/allout.el5
-rw-r--r--lisp/ansi-color.el20
-rw-r--r--lisp/cus-start.el1
-rw-r--r--lisp/generic-x.el2
-rw-r--r--lisp/gnus/ChangeLog116
-rw-r--r--lisp/gnus/gnus-agent.el7
-rw-r--r--lisp/gnus/gnus-registry.el40
-rw-r--r--lisp/gnus/gnus-score.el2
-rw-r--r--lisp/gnus/gnus-sum.el45
-rw-r--r--lisp/gnus/gnus.el25
-rw-r--r--lisp/gnus/gssapi.el14
-rw-r--r--lisp/gnus/message.el33
-rw-r--r--lisp/gnus/mm-view.el3
-rw-r--r--lisp/gnus/nnimap.el60
-rw-r--r--lisp/gnus/nntp.el73
-rw-r--r--lisp/gnus/proto-stream.el317
-rw-r--r--lisp/ido.el2
-rw-r--r--lisp/loadup.el2
-rw-r--r--lisp/minibuffer.el152
-rw-r--r--lisp/net/imap.el3
-rw-r--r--lisp/net/rcirc.el10
-rw-r--r--lisp/progmodes/f90.el2
-rw-r--r--lisp/progmodes/python.el161
-rw-r--r--lisp/vc/add-log.el4
27 files changed, 771 insertions, 486 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f1b53619268..32e9c92a255 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,94 @@
+2011-03-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * loadup.el: Load minibuffer after loaddefs, to use define-minor-mode.
+
+2011-03-31 Tassilo Horn <tassilo@member.fsf.org>
+
+ * net/rcirc.el (rcirc-handler-001): Only authenticate, if there's
+ an entry for that server in rcirc-authinfo. (Bug#8385)
+
+2011-03-31 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/f90.el (f90-find-tag-default): Handle multiple `%'.
+
+ * generic-x.el (etc-fstab-generic-mode): Add ext4, sysfs keywords.
+
+2011-03-30 Christoph Scholtes <cschol2112@googlemail.com>
+
+ * progmodes/python.el (python-default-interpreter)
+ (python-python-command-args, python-jython-command-args)
+ (python-which-shell, python-which-args, python-which-bufname)
+ (python-file-queue, python-comint-output-filter-function)
+ (python-toggle-shells, python-shell): Remove obsolete defcustoms,
+ variables and functions.
+
+2011-03-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion-table-dynamic): Optimize `boundaries'.
+ (completion-in-region-mode): New minor mode.
+ (completion-in-region): Use it.
+ (completion-in-region--data, completion-in-region-mode-map): New vars.
+ (completion-in-region--postch): New function.
+ (completion--capf-misbehave-funs, completion--capf-safe-funs):
+ New vars.
+ (completion--capf-wrapper): New function.
+ (completion-at-point): Use it to track well-behavedness of
+ hook functions.
+ (completion-help-at-point): New command.
+
+2011-03-30 Jason Merrill <jason@redhat.com> (tiny change)
+
+ * vc/add-log.el (add-change-log-entry): Don't use whitespace
+ syntax class to search for whitespace on a single line
+ (Message-ID: <4D938140.4030905@redhat.com>).
+
+2011-03-30 Leo Liu <sdl.web@gmail.com>
+
+ * abbrev.el (abbrev-edit-save-to-file, abbrev-edit-save-buffer):
+ New commands.
+ (edit-abbrevs-map): Bind them here.
+ (write-abbrev-file): New optinal arg VERBOSE. (Bug#5937)
+
+2011-03-29 Ken Manheimer <ken.manheimer@gmail.com>
+
+ * allout.el (allout-hide-by-annotation, allout-flag-region):
+ Reduce possibility of overlay leakage by making them volatile.
+
+ * allout-widgets.el (allout-widgets-tally): Define as nil so the
+ hash is not shared between buffers. Mode initialization is
+ responsible for giving it a useful starting value.
+ (allout-item-span): Reduce possibility of overlay leakage by
+ making them volatile.
+ (allout-widgets-count-buttons-in-region): Add diagnostic function
+ for tracking down button overlay leaks.
+
+2011-03-29 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-read-internal): Use the default history var
+ minibuffer-history if no HISTORY is specified.
+
+2011-03-28 Brian T. Sniffen <bsniffen@akamai.com> (tiny change)
+
+ * net/imap.el (imap-shell-open, imap-process-connection-type): Use
+ imap-process-connection-type for 'shell' streams as well as
+ Kerberos, SSL, other subprocesses.
+
+2011-03-28 Leo Liu <sdl.web@gmail.com>
+
+ * abbrev.el (abbrev-table-empty-p): New function.
+ (prepare-abbrev-list-buffer): Place empty abbrev tables after
+ nonempty ones. (Bug#5937)
+
+2011-03-27 Jan Djärv <jan.h.d@swipnet.se>
+
+ * cus-start.el (all): Add boolean ns-auto-hide-menu-bar.
+
+2011-03-27 Leo Liu <sdl.web@gmail.com>
+
+ * ansi-color.el (ansi-color-names-vector): Allow cons cell value
+ for foreground and background colors.
+ (ansi-color-make-color-map): Adapt.
+
2011-03-25 Leo Liu <sdl.web@gmail.com>
* midnight.el (midnight-time-float): Remove. Note it calculates
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 3b383a5f5b8..ddf37aff58f 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -65,7 +65,8 @@ abbreviation causes it to expand and be replaced by its expansion."
(defvar edit-abbrevs-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-x\C-s" 'edit-abbrevs-redefine)
+ (define-key map "\C-x\C-s" 'abbrev-edit-save-buffer)
+ (define-key map "\C-x\C-w" 'abbrev-edit-save-to-file)
(define-key map "\C-c\C-c" 'edit-abbrevs-redefine)
map)
"Keymap used in `edit-abbrevs'.")
@@ -123,8 +124,13 @@ Otherwise display all abbrevs."
(if local
(insert-abbrev-table-description
(abbrev-table-name local-table) t)
- (dolist (table abbrev-table-name-list)
- (insert-abbrev-table-description table t)))
+ (let (empty-tables)
+ (dolist (table abbrev-table-name-list)
+ (if (abbrev-table-empty-p (symbol-value table))
+ (push table empty-tables)
+ (insert-abbrev-table-description table t)))
+ (dolist (table (nreverse empty-tables))
+ (insert-abbrev-table-description table t))))
(goto-char (point-min))
(set-buffer-modified-p nil)
(edit-abbrevs-mode)
@@ -211,13 +217,15 @@ Does not display any message."
;(interactive "fRead abbrev file: ")
(read-abbrev-file file t))
-(defun write-abbrev-file (&optional file)
+(defun write-abbrev-file (&optional file verbose)
"Write all user-level abbrev definitions to a file of Lisp code.
This does not include system abbrevs; it includes only the abbrev tables
listed in listed in `abbrev-table-name-list'.
The file written can be loaded in another session to define the same abbrevs.
The argument FILE is the file name to write. If omitted or nil, the file
-specified in `abbrev-file-name' is used."
+specified in `abbrev-file-name' is used.
+If VERBOSE is non-nil, display a message indicating where abbrevs
+have been saved."
(interactive
(list
(read-file-name "Write abbrev file: "
@@ -247,7 +255,25 @@ specified in `abbrev-file-name' is used."
'emacs-mule)))
(goto-char (point-min))
(insert (format ";;-*-coding: %s;-*-\n" coding-system-for-write))
- (write-region nil nil file nil 0))))
+ (write-region nil nil file nil (and (not verbose) 0)))))
+
+(defun abbrev-edit-save-to-file (file)
+ "Save all user-level abbrev definitions in current buffer to FILE."
+ (interactive
+ (list (read-file-name "Save abbrevs to file: "
+ (file-name-directory
+ (expand-file-name abbrev-file-name))
+ abbrev-file-name)))
+ (edit-abbrevs-redefine)
+ (write-abbrev-file file t))
+
+(defun abbrev-edit-save-buffer ()
+ "Save all user-level abbrev definitions in current buffer.
+The saved abbrevs are written to the file specified by
+`abbrev-file-name'."
+ (interactive)
+ (abbrev-edit-save-to-file abbrev-file-name))
+
(defun add-mode-abbrev (arg)
"Define mode-specific abbrev for last word(s) before point.
@@ -420,6 +446,19 @@ PROPS is a list of properties."
(and (vectorp object)
(numberp (abbrev-table-get object :abbrev-table-modiff))))
+(defun abbrev-table-empty-p (object &optional ignore-system)
+ "Return nil if there are no abbrev symbols in OBJECT.
+If IGNORE-SYSTEM is non-nil, system definitions are ignored."
+ (unless (abbrev-table-p object)
+ (error "Non abbrev table object"))
+ (not (catch 'some
+ (mapatoms (lambda (abbrev)
+ (unless (or (zerop (length (symbol-name abbrev)))
+ (and ignore-system
+ (abbrev-get abbrev :system)))
+ (throw 'some t)))
+ object))))
+
(defvar global-abbrev-table (make-abbrev-table)
"The abbrev table whose abbrevs affect all buffers.
Each buffer may also have a local abbrev table.
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index 47f181ab76b..ae4265bda1f 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -238,7 +238,7 @@ buffer, and tracking increases as new widgets are added and
decreases as obsolete widgets are garbage collected."
:type 'boolean
:group 'allout-widgets-developer)
-(defvar allout-widgets-tally (make-hash-table :test 'eq :weakness 'key)
+(defvar allout-widgets-tally nil
"Hash-table of existing allout widgets, for debugging.
Table is maintained iff `allout-widgets-maintain-tally' is non-nil.
@@ -2100,6 +2100,7 @@ previously established or is not moved."
(cond ((not overlay) (when start
(setq overlay (make-overlay start end nil t nil))
(overlay-put overlay 'button item-widget)
+ (overlay-put overlay 'evaporate t)
(widget-put item-widget :span-overlay overlay)
t))
;; report:
@@ -2343,6 +2344,19 @@ The elements of LIST are not copied, just the list structure itself."
(while (consp list) (push (pop list) res))
(prog1 (nreverse res) (setcdr res list)))
(car list)))
+;;;_ . allout-widgets-count-buttons-in-region (start end)
+(defun allout-widgets-count-buttons-in-region (start end)
+ "Debugging/diagnostic tool - count overlays with 'button' property in region."
+ (interactive "r")
+ (setq start (or start (point-min))
+ end (or end (point-max)))
+ (if (> start end) (let ((interim start)) (setq start end end interim)))
+ (let ((button-overlays (delq nil
+ (mapcar (function (lambda (o)
+ (if (overlay-get o 'button)
+ o)))
+ (overlays-in start end)))))
+ (length button-overlays)))
;;;_ : Run unit tests:
(defun allout-widgets-run-unit-tests ()
diff --git a/lisp/allout.el b/lisp/allout.el
index 3fb8ed7ccd5..736ec42718b 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -4489,8 +4489,9 @@ Topic exposure is marked with text-properties, to be used by
;; advance to just after end of this annotation:
(setq next (allout-next-single-char-property-change
(point) 'allout-was-hidden nil end))
- (overlay-put (make-overlay prev next nil 'front-advance)
- 'category 'allout-exposure-category)
+ (let ((o (make-overlay prev next nil 'front-advance)))
+ (overlay-put o 'category 'allout-exposure-category)
+ (overlay-put o 'evaporate t))
(allout-deannotate-hidden prev next)
(setq prev next)
(if next (goto-char next)))))
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 2b43940c1bd..ff7edf40dcb 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -132,8 +132,18 @@ Parameter Color
37 47 white
This vector is used by `ansi-color-make-color-map' to create a color
-map. This color map is stored in the variable `ansi-color-map'."
- :type '(vector string string string string string string string string)
+map. This color map is stored in the variable `ansi-color-map'.
+
+Each element may also be a cons cell where the car and cdr specify the
+foreground and background colors, respectively."
+ :type '(vector (choice color (cons color color))
+ (choice color (cons color color))
+ (choice color (cons color color))
+ (choice color (cons color color))
+ (choice color (cons color color))
+ (choice color (cons color color))
+ (choice color (cons color color))
+ (choice color (cons color color)))
:set 'ansi-color-map-update
:initialize 'custom-initialize-default
:group 'ansi-colors)
@@ -528,7 +538,8 @@ The face definitions are based upon the variables
(mapc
(function (lambda (e)
(aset ansi-color-map index
- (ansi-color-make-face 'foreground e))
+ (ansi-color-make-face 'foreground
+ (if (consp e) (car e) e)))
(setq index (1+ index)) ))
ansi-color-names-vector)
;; background attributes
@@ -536,7 +547,8 @@ The face definitions are based upon the variables
(mapc
(function (lambda (e)
(aset ansi-color-map index
- (ansi-color-make-face 'background e))
+ (ansi-color-make-face 'background
+ (if (consp e) (cdr e) e)))
(setq index (1+ index)) ))
ansi-color-names-vector)
ansi-color-map))
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 788731e4dbc..1188d37150a 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -356,6 +356,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(const alt) (const hyper)
(const super)) "23.1")
(ns-antialias-text ns boolean "23.1")
+ (ns-auto-hide-menu-bar ns boolean "24.0")
;; process.c
(delete-exited-processes processes-basics boolean)
;; syntax.c
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index bce03331a29..37819599f62 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -1705,6 +1705,7 @@ like an INI file. You can add this hook to `find-file-hook'."
"efs"
"ext2"
"ext3"
+ "ext4"
"hfs"
"hpfs"
"iso9660"
@@ -1722,6 +1723,7 @@ like an INI file. You can add this hook to `find-file-hook'."
"cifs"
"usbdevfs"
"sysv"
+ "sysfs"
"tmpfs"
"udf"
"ufs"
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index ddc946383b6..2496453dd89 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,119 @@
+2011-03-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-update-marks): Revert intersection change, which
+ made marks not propagate, again.
+
+2011-03-30 Chong Yidong <cyd@stupidchicken.com>
+
+ * proto-stream.el (open-protocol-stream): Bring back `network' type.
+ Make this the default type.
+ (proto-stream-open-plain): Rename from proto-stream-open-default.
+ (open-protocol-stream, proto-stream-open-starttls)
+ (proto-stream-open-tls, proto-stream-open-shell): Replace `default'
+ with `plain'.
+
+ * nnimap.el (nnimap-stream, nnimap-open-connection-1): Accept `network'
+ value.
+
+ * nntp.el (nntp-open-connection-function): Document the fact that some
+ values are not functions but are instead handled specially. Recognize
+ nntp-open-plain-stream value.
+ (nntp-open-connection): Recognize that value.
+
+2011-03-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gssapi.el (open-gssapi-stream): Remove the last mentions of the IMAP
+ stuff.
+
+ * gnus-score.el (gnus-score-string): Fix calling convention of
+ `gnus-simplify-buffer-fuzzy' after last patches.
+
+ * gnus-sum.el (gnus-update-marks): Don't send any marks updates to the
+ server for articles we didn't get any headers for. This is a sanity
+ check.
+
+2011-03-29 Michael Welsh Duggan <md5i@md5i.com>
+
+ * nnimap.el (nnimap-open-connection-1): Is the login responds with a
+ new CAPABILITY, use it.
+
+2011-03-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-fetch-headers): Don't message if we're not
+ downloading anything.
+
+ * gnus.el (gnus-splash-svg-color-symbols): Removed superfluous `and'.
+
+2011-03-29 Adam Sjøgren <asjo@koldfront.dk>
+
+ * gnus.el (gnus-group-startup-message): Prefer svg file and replace
+ colors.
+ (gnus-splash-svg-color-symbols): New function.
+
+2011-03-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-simplify-buffer-fuzzy): Take the regexp explicitly
+ instead of using the global gnus-simplify-subject-fuzzy-regexp.
+ (gnus-simplify-subject-fuzzy): Use the local
+ gnus-simplify-subject-fuzzy-regex instead of the global one. This
+ makes using this variable in group parameters work.
+
+2011-03-29 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-unfollowed-groups): Add
+ "archive:sent" to the unfollowed group regex (for the recent Gnus
+ archive:sent-YYYY-MM-DD groups).
+ (gnus-registry-split-fancy-with-parent): Bail out early in sender
+ tracking if there are more than `gnus-registry-max-track-groups'
+ matches.
+
+2011-03-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * message.el (message--yank-original-internal): New function to do the
+ insertion cleanly inside eval in `message-yank-original'.
+ (message-yank-original): Use it.
+
+2011-03-29 Julien Danjou <julien@danjou.info>
+
+ * mm-view.el (mm-display-inline-fontify): Use `set-normal-mode' with
+ local variables disabled rather than `normal-mode'.
+
+2011-03-26 Chong Yidong <cyd@stupidchicken.com>
+
+ * proto-stream.el: Changes preparatory to merging open-protocol-stream
+ with open-network-stream.
+ (proto-stream-always-use-starttls): Option removed.
+ (open-protocol-stream): Return a process object by default. Provide a
+ new parameter :return-list specifying a list-type return value, which
+ now has the form (PROP . PLIST) instead of a fixed-length list. Change
+ :type `network' to `try-starttls', and `network-only' to `default'.
+ Make `default' the default, for compatibility with open-network-stream.
+ Handle the no-parameter case exactly as open-network-stream, with no
+ additional stream processing. Search plists using plist-get.
+ Explicitly add :end-of-commend parameter if it is missing.
+ (proto-stream-open-default): Renamed from
+ proto-stream-open-network-only. Return 'default as the type.
+ (proto-stream-open-starttls): Rename from proto-stream-open-network.
+ Use plist-get. Don't return `tls' as the type if STARTTLS negotiation
+ failed. Always return a list with a (possibly dead) process as the
+ first element, for compatibility with open-network-stream.
+ (proto-stream-open-tls): Use plist-get. Always return a list.
+ (proto-stream-open-shell): Return `default' as connection type.
+ (proto-stream-capability-open): Use plist-get.
+ (proto-stream-eoc): Function deleted.
+
+ * nnimap.el (nnimap-stream, nnimap-open-connection)
+ (nnimap-open-connection-1): Handle renaming of :type parameter for
+ open-protocol-stream.
+ (nnimap-open-connection-1): Pass a :return-list parameter
+ open-protocol-stream to obtain a list return value. Parse this list
+ using plist-get.
+
+ * nntp.el (nntp-open-connection): Handle renaming of :type parameter
+ for open-protocol-stream. Accept open-protocol-stream return value
+ that is a subprocess object instead of a list. Handle the case of a
+ dead returned process.
+
2011-03-25 Teodor Zlatanov <tzz@lifelogs.com>
* mm-util.el (mm-handle-filename): Move to mm-decode.el (bug#8330).
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 989488c0995..52fbe9da11f 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -1925,9 +1925,10 @@ article numbers will be returned."
(setq articles (gnus-list-range-intersection
articles (list (cons low high)))))))
- (gnus-message
- 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'"
- (gnus-compress-sequence articles t))
+ (when articles
+ (gnus-message
+ 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'"
+ (gnus-compress-sequence articles t)))
(with-current-buffer nntp-server-buffer
(if articles
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index cef173ce1ec..db3cc06e9aa 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -124,7 +124,7 @@ display."
:type 'symbol)
(defcustom gnus-registry-unfollowed-groups
- '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:")
+ '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:" "archive")
"List of groups that gnus-registry-split-fancy-with-parent won't return.
The group names are matched, they don't have to be fully
qualified. This parameter tells the Registry 'never split a
@@ -541,24 +541,26 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
user-mail-address)))
(maphash
(lambda (key value)
- (let ((this-sender (cdr
- (gnus-registry-fetch-extra key 'sender)))
- matches)
- (when (and this-sender
- (equal sender this-sender))
- (let ((groups (gnus-registry-fetch-groups
- key
- gnus-registry-max-track-groups)))
- (dolist (group groups)
- (when (and group (gnus-registry-follow-group-p group))
- (push group found-full)
- (setq found (append (list group) (delete group found))))))
- (push key matches)
- (gnus-message
- ;; raise level of messaging if gnus-registry-track-extra
- (if gnus-registry-track-extra 7 9)
- "%s (extra tracking) traced sender %s to groups %s (keys %s)"
- log-agent sender found matches))))
+ ;; don't use more than gnus-registry-max-track-groups
+ (when (< (length found-full) gnus-registry-max-track-groups)
+ (let ((this-sender
+ (cdr (gnus-registry-fetch-extra key 'sender)))
+ matches)
+ (when (and this-sender
+ (equal sender this-sender))
+ (let ((groups (gnus-registry-fetch-groups
+ key
+ gnus-registry-max-track-groups)))
+ (dolist (group groups)
+ (when (and group (gnus-registry-follow-group-p group))
+ (push group found-full)
+ (setq found (append (list group) (delete group found))))))
+ (push key matches)
+ (gnus-message
+ ;; raise level of messaging if gnus-registry-track-extra
+ (if gnus-registry-track-extra 7 9)
+ "%s (extra tracking) traced sender %s to groups %s (keys %s)"
+ log-agent sender found matches)))))
gnus-registry-hashtb)
;; filter the found groups and return them
;; the found groups are NOT the full groups
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index e376b7a7b6e..9bbfbfb057e 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -2151,7 +2151,7 @@ score in `gnus-newsgroup-scored' by SCORE."
;; Find fuzzy matches.
(when fuzzies
;; Simplify the entire buffer for easy matching.
- (gnus-simplify-buffer-fuzzy)
+ (gnus-simplify-buffer-fuzzy gnus-simplify-subject-fuzzy-regexp)
(while (setq kill (cadaar fuzzies))
(let* ((match (nth 0 kill))
(type (nth 3 kill))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 9b22bbe39da..10aa4e12dcf 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1734,7 +1734,7 @@ If RE-ONLY is non-nil, strip leading `Re:'s only."
(while (re-search-forward regexp nil t)
(replace-match (or newtext ""))))
-(defun gnus-simplify-buffer-fuzzy ()
+(defun gnus-simplify-buffer-fuzzy (regexp)
"Simplify string in the buffer fuzzily.
The string in the accessible portion of the current buffer is simplified.
It is assumed to be a single-line subject.
@@ -1748,11 +1748,10 @@ matter is removed. Additional things can be deleted by setting
(while (not (eq modified-tick (buffer-modified-tick)))
(setq modified-tick (buffer-modified-tick))
(cond
- ((listp gnus-simplify-subject-fuzzy-regexp)
- (mapc 'gnus-simplify-buffer-fuzzy-step
- gnus-simplify-subject-fuzzy-regexp))
- (gnus-simplify-subject-fuzzy-regexp
- (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp)))
+ ((listp regexp)
+ (mapc 'gnus-simplify-buffer-fuzzy-step regexp))
+ (regexp
+ (gnus-simplify-buffer-fuzzy-step regexp)))
(gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *")
(gnus-simplify-buffer-fuzzy-step
"^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
@@ -1767,15 +1766,16 @@ matter is removed. Additional things can be deleted by setting
"Simplify a subject string fuzzily.
See `gnus-simplify-buffer-fuzzy' for details."
(save-excursion
- (gnus-set-work-buffer)
- (let ((case-fold-search t))
- ;; Remove uninteresting prefixes.
- (when (and gnus-simplify-ignored-prefixes
- (string-match gnus-simplify-ignored-prefixes subject))
- (setq subject (substring subject (match-end 0))))
- (insert subject)
- (inline (gnus-simplify-buffer-fuzzy))
- (buffer-string))))
+ (let ((regexp gnus-simplify-subject-fuzzy-regexp))
+ (gnus-set-work-buffer)
+ (let ((case-fold-search t))
+ ;; Remove uninteresting prefixes.
+ (when (and gnus-simplify-ignored-prefixes
+ (string-match gnus-simplify-ignored-prefixes subject))
+ (setq subject (substring subject (match-end 0))))
+ (insert subject)
+ (inline (gnus-simplify-buffer-fuzzy regexp))
+ (buffer-string)))))
(defsubst gnus-simplify-subject-fully (subject)
"Simplify a subject string according to `gnus-summary-gather-subject-limit'."
@@ -6068,14 +6068,19 @@ If SELECT-ARTICLES, only select those articles from GROUP."
'request-set-mark gnus-newsgroup-name)
(not (gnus-article-unpropagatable-p (cdr type))))
(let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
- (del (gnus-remove-from-range (gnus-copy-sequence old) list))
- (add (gnus-remove-from-range
- (gnus-copy-sequence list) old)))
+ ;; Don't do anything about marks for articles we
+ ;; didn't actually get any headers for.
+ (existing (gnus-compress-sequence gnus-newsgroup-articles))
+ (del
+ (gnus-remove-from-range (gnus-copy-sequence old) list))
+ (add
+ (gnus-remove-from-range
+ (gnus-copy-sequence list) old)))
(when add
(push (list add 'add (list (cdr type))) delta-marks))
(when del
- ;; Don't delete marks from outside the active range. This
- ;; shouldn't happen, but is a sanity check.
+ ;; Don't delete marks from outside the active range.
+ ;; This shouldn't happen, but is a sanity check.
(setq del (gnus-sorted-range-intersection
(gnus-active gnus-newsgroup-name) del))
(push (list del 'del (list (cdr type))) delta-marks))))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 57d085a0380..d4ecd89db92 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1043,12 +1043,15 @@ be set in `.emacs' instead."
((boundp 'image-load-path)
(symbol-value 'image-load-path))
(t load-path)))
- (image (find-image
- `((:type xpm :file "gnus.xpm"
+ (image (gnus-splash-svg-color-symbols (find-image
+ `((:type svg :file "gnus.svg"
+ :color-symbols
+ (("#bf9900" . ,(car gnus-logo-colors))
+ ("#ffcc00" . ,(cadr gnus-logo-colors))))
+ (:type xpm :file "gnus.xpm"
:color-symbols
(("thing" . ,(car gnus-logo-colors))
("shadow" . ,(cadr gnus-logo-colors))))
- (:type svg :file "gnus.svg")
(:type png :file "gnus.png")
(:type pbm :file "gnus.pbm"
;; Account for the pbm's background.
@@ -1057,7 +1060,7 @@ be set in `.emacs' instead."
(:type xbm :file "gnus.xbm"
;; Account for the xbm's background.
:background ,(face-foreground 'gnus-splash)
- :foreground ,(face-background 'default))))))
+ :foreground ,(face-background 'default)))))))
(when image
(let ((size (image-size image)))
(insert-char ?\n (max 0 (round (- (window-height)
@@ -1103,6 +1106,20 @@ be set in `.emacs' instead."
(setq mode-line-buffer-identification (concat " " gnus-version))
(set-buffer-modified-p t)))
+(defun gnus-splash-svg-color-symbols (list)
+ "Do color-symbol search-and-replace in svg file"
+ (let ((type (plist-get (cdr list) :type))
+ (file (plist-get (cdr list) :file))
+ (color-symbols (plist-get (cdr list) :color-symbols)))
+ (if (string= type "svg")
+ (let ((data (with-temp-buffer (insert-file file) (buffer-string))))
+ (mapc (lambda (rule)
+ (setq data (replace-regexp-in-string
+ (concat "fill:" (car rule))
+ (concat "fill:" (cdr rule)) data))) color-symbols)
+ (cons (car list) (list :type type :data data)))
+ list)))
+
(eval-when (load)
(let ((command (format "%s" this-command)))
(when (string-match "gnus" command)
diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el
index 3765fb84ee8..e96c23b14ac 100644
--- a/lisp/gnus/gssapi.el
+++ b/lisp/gnus/gssapi.el
@@ -33,14 +33,14 @@
"--authentication-id %l")
"imtest -m gssapi -u %l -p %p %s")
"List of strings containing commands for GSSAPI (krb5) authentication.
-%s is replaced with server hostname, %p with port to connect to, and
-%l with the value of `imap-default-user'. The program should accept
-IMAP commands on stdin and return responses to stdout. Each entry in
-the list is tried until a successful connection is made."
+%s is replaced with server hostname, %p with port to connect to,
+and %l with the user name. The program should accept commands on
+stdin and return responses to stdout. Each entry in the list is
+tried until a successful connection is made."
:group 'network
:type '(repeat string))
-(defun open-gssapi-stream (name buffer server port)
+(defun open-gssapi-stream (name buffer server port user)
(let ((cmds gssapi-program)
cmd done)
(with-current-buffer buffer
@@ -57,7 +57,7 @@ the list is tried until a successful connection is made."
(format-spec-make
?s server
?p (number-to-string port)
- ?l imap-default-user))))
+ ?l user))))
response)
(when process
(while (and (memq (process-status process) '(open run))
@@ -92,7 +92,7 @@ the list is tried until a successful connection is made."
(accept-process-output process 1)
(sit-for 1))
(erase-buffer)
- (message "GSSAPI IMAP connection: %s" (or response "failed"))
+ (message "GSSAPI connection: %s" (or response "failed"))
(if (and response (let ((case-fold-search nil))
(not (string-match "failed" response))))
(setq done process)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index bb9215aca7c..6d9fd712c33 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -3712,22 +3712,9 @@ To use this automatically, you may add this function to
(while (re-search-forward citexp nil t)
(replace-match (if remove "" "\n"))))))
-(defun message-yank-original (&optional arg)
- "Insert the message being replied to, if any.
-Puts point before the text and mark after.
-Normally indents each nonblank line ARG spaces (default 3). However,
-if `message-yank-prefix' is non-nil, insert that prefix on each line.
-
-This function uses `message-cite-function' to do the actual citing.
-
-Just \\[universal-argument] as argument means don't indent, insert no
-prefix, and don't delete any headers."
- (interactive "P")
+(defun message--yank-original-internal (arg)
(let ((modified (buffer-modified-p))
body-text)
- ;; eval the let forms contained in message-cite-style
- (eval
- `(let ,message-cite-style
(when (and message-reply-buffer
message-cite-function)
(when (equal message-cite-reply-position 'above)
@@ -3767,7 +3754,23 @@ prefix, and don't delete any headers."
;; Add a `message-setup-very-last-hook' here?
;; Add `gnus-article-highlight-citation' here?
(unless modified
- (setq message-checksum (message-checksum))))))))
+ (setq message-checksum (message-checksum))))))
+
+(defun message-yank-original (&optional arg)
+ "Insert the message being replied to, if any.
+Puts point before the text and mark after.
+Normally indents each nonblank line ARG spaces (default 3). However,
+if `message-yank-prefix' is non-nil, insert that prefix on each line.
+
+This function uses `message-cite-function' to do the actual citing.
+
+Just \\[universal-argument] as argument means don't indent, insert no
+prefix, and don't delete any headers."
+ (interactive "P")
+ ;; eval the let forms contained in message-cite-style
+ (eval
+ `(let ,message-cite-style
+ (message--yank-original-internal ',arg))))
(defun message-yank-buffer (buffer)
"Insert BUFFER into the current buffer and quote it."
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 39d49af0600..abd78b8de02 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -603,9 +603,10 @@ If MODE is not set, try to find mode automatically."
;; I find font-lock a bit too verbose.
(font-lock-verbose nil))
(setq buffer-file-name (mm-handle-filename handle))
+ (set (make-local-variable 'enable-local-variables) nil)
(if mode
(funcall mode)
- (normal-mode))
+ (set-auto-mode))
;; The mode function might have already turned on font-lock.
(unless (symbol-value 'font-lock-mode)
(font-lock-fontify-buffer)))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index bcbe7b678d5..fa09c7ff165 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -61,10 +61,12 @@ If nnimap-stream is `ssl', this will default to `imaps'. If not,
it will default to `imap'.")
(defvoo nnimap-stream 'undecided
- "How nnimap will talk to the IMAP server.
-Values are `ssl', `network', `network-only, `starttls' or
-`shell'. The default is to try `ssl' first, and then
-`network'.")
+ "How nnimap talks to the IMAP server.
+The value should be either `undecided', `ssl' or `tls',
+`network', `starttls', `plain', or `shell'.
+
+If the value is `undecided', nnimap tries `ssl' first, then falls
+back on `network'.")
(defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
(if (listp imap-shell-program)
@@ -339,9 +341,7 @@ textual parts.")
(port nil)
(ports
(cond
- ((or (eq nnimap-stream 'network)
- (eq nnimap-stream 'network-only)
- (eq nnimap-stream 'starttls))
+ ((memq nnimap-stream '(network plain starttls))
(nnheader-message 7 "Opening connection to %s..."
nnimap-address)
'("imap" "143"))
@@ -355,21 +355,28 @@ textual parts.")
'("imaps" "imap" "993" "143"))
(t
(error "Unknown stream type: %s" nnimap-stream))))
- (proto-stream-always-use-starttls t)
login-result credentials)
(when nnimap-server-port
(push nnimap-server-port ports))
- (destructuring-bind (stream greeting capabilities stream-type)
- (open-protocol-stream
- "*nnimap*" (current-buffer) nnimap-address (car ports)
- :type nnimap-stream
- :shell-command nnimap-shell-program
- :capability-command "1 CAPABILITY\r\n"
- :success " OK "
- :starttls-function
- (lambda (capabilities)
- (when (gnus-string-match-p "STARTTLS" capabilities)
- "1 STARTTLS\r\n")))
+ (let* ((stream-list
+ (open-protocol-stream
+ "*nnimap*" (current-buffer) nnimap-address (car ports)
+ :type nnimap-stream
+ :return-list t
+ :shell-command nnimap-shell-program
+ :capability-command "1 CAPABILITY\r\n"
+ :success " OK "
+ :starttls-function
+ (lambda (capabilities)
+ (when (gnus-string-match-p "STARTTLS" capabilities)
+ "1 STARTTLS\r\n"))))
+ (stream (car stream-list))
+ (props (cdr stream-list))
+ (greeting (plist-get props :greeting))
+ (capabilities (plist-get props :capabilities))
+ (stream-type (plist-get props :type)))
+ (when (and stream (not (memq (process-status stream) '(open run))))
+ (setq stream nil))
(setf (nnimap-process nnimap-object) stream)
(setf (nnimap-stream-type nnimap-object) stream-type)
(if (not stream)
@@ -403,11 +410,18 @@ textual parts.")
(setq login-result
(nnimap-login (car credentials) (cadr credentials))))
(if (car login-result)
- ;; save the credentials if a save function exists
+ (progn
+ ;; Save the credentials if a save function exists
;; (such a function will only be passed if a new
- ;; token was created)
- (when (functionp (nth 2 credentials))
- (funcall (nth 2 credentials)))
+ ;; token was created).
+ (when (functionp (nth 2 credentials))
+ (funcall (nth 2 credentials)))
+ ;; See if CAPABILITY is set as part of login
+ ;; response.
+ (dolist (response (cddr login-result))
+ (when (string= "CAPABILITY" (upcase (car response)))
+ (setf (nnimap-capabilities nnimap-object)
+ (mapcar #'upcase (cdr response))))))
;; If the login failed, then forget the credentials
;; that are now possibly cached.
(dolist (host (list (nnoo-current-server 'nnimap)
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 66a6365cb3b..fa765e17463 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -76,27 +76,27 @@ to innd, you could say something like:
You probably don't want to do that, though.")
(defvoo nntp-open-connection-function 'nntp-open-network-stream
- "*Function used for connecting to a remote system.
-It will be called with the buffer to output in as argument.
-
-Currently, five such functions are provided (please refer to their
-respective doc string for more information), three of them establishing
-direct connections to the nntp server, and two of them using an indirect
-host.
-
-Direct connections:
-- `nntp-open-network-stream' (the default),
-- `network-only' (the same as the above, but don't do automatic
- STARTTLS upgrades).
-- `nntp-open-ssl-stream',
-- `nntp-open-tls-stream',
-- `nntp-open-netcat-stream'.
-- `nntp-open-telnet-stream'.
-
-Indirect connections:
-- `nntp-open-via-rlogin-and-netcat',
-- `nntp-open-via-rlogin-and-telnet',
-- `nntp-open-via-telnet-and-telnet'.")
+ "Method for connecting to a remote system.
+It should be a function, which is called with the output buffer
+as its single argument, or one of the following special values:
+
+- `nntp-open-network-stream' specifies a network connection,
+ upgrading to a TLS connection via STARTTLS if possible.
+- `nntp-open-plain-stream' specifies an unencrypted network
+ connection (no STARTTLS upgrade is attempted).
+- `nntp-open-ssl-stream' or `nntp-open-tls-stream' specify a TLS
+ network connection.
+
+Apart from the above special values, valid functions are as
+follows; please refer to their respective doc string for more
+information.
+For direct connections:
+- `nntp-open-netcat-stream'
+- `nntp-open-telnet-stream'
+For indirect connections:
+- `nntp-open-via-rlogin-and-netcat'
+- `nntp-open-via-rlogin-and-telnet'
+- `nntp-open-via-telnet-and-telnet'")
(defvoo nntp-never-echoes-commands nil
"*Non-nil means the nntp server never echoes commands.
@@ -1340,25 +1340,25 @@ password contained in '~/.nntp-authinfo'."
(let ((coding-system-for-read nntp-coding-system-for-read)
(coding-system-for-write nntp-coding-system-for-write)
(map '((nntp-open-network-stream network)
- (network-only network-only)
+ (network-only plain) ; compat
+ (nntp-open-plain-stream plain)
(nntp-open-ssl-stream tls)
(nntp-open-tls-stream tls))))
(if (assoc nntp-open-connection-function map)
- (car (open-protocol-stream
- "nntpd" pbuffer nntp-address nntp-port-number
- :type (cadr
- (assoc nntp-open-connection-function map))
- :end-of-command "^\\([2345]\\|[.]\\).*\n"
- :capability-command "CAPABILITIES\r\n"
- :success "^3"
- :starttls-function
- (lambda (capabilities)
- (if (not (string-match "STARTTLS" capabilities))
- nil
- "STARTTLS\r\n"))))
+ (open-protocol-stream
+ "nntpd" pbuffer nntp-address nntp-port-number
+ :type (cadr (assoc nntp-open-connection-function map))
+ :end-of-command "^\\([2345]\\|[.]\\).*\n"
+ :capability-command "CAPABILITIES\r\n"
+ :success "^3"
+ :starttls-function
+ (lambda (capabilities)
+ (if (not (string-match "STARTTLS" capabilities))
+ nil
+ "STARTTLS\r\n")))
(funcall nntp-open-connection-function pbuffer)))
(error
- (nnheader-report 'nntp "%s" err))
+ (nnheader-report 'nntp ">>> %s" err))
(quit
(message "Quit opening connection to %s" nntp-address)
(nntp-kill-buffer pbuffer)
@@ -1366,6 +1366,9 @@ password contained in '~/.nntp-authinfo'."
nil))))
(when timer
(nnheader-cancel-timer timer))
+ (when (and process
+ (not (memq (process-status process) '(open run))))
+ (setq process nil))
(unless process
(nntp-kill-buffer pbuffer))
(when (and (buffer-name pbuffer)
diff --git a/lisp/gnus/proto-stream.el b/lisp/gnus/proto-stream.el
index fdf2abfea05..45cc974e7a9 100644
--- a/lisp/gnus/proto-stream.el
+++ b/lisp/gnus/proto-stream.el
@@ -48,171 +48,162 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
(require 'tls)
(require 'starttls)
-(require 'format-spec)
-
-(defcustom proto-stream-always-use-starttls (fboundp 'open-gnutls-stream)
- "If non-nil, always try to upgrade network connections with STARTTLS."
- :version "24.1"
- :type 'boolean
- :group 'comm)
(declare-function gnutls-negotiate "gnutls"
(proc type &optional priority-string trustfiles keyfiles))
;;;###autoload
(defun open-protocol-stream (name buffer host service &rest parameters)
- "Open a network stream to HOST, upgrading to STARTTLS if possible.
-The first four parameters have the same meaning as in
-`open-network-stream'. The function returns a list where the
-first element is the stream, the second element is the greeting
-the server replied with after connecting, and the third element
-is a string representing the capabilities of the server (if any).
-
-The PARAMETERS is a keyword list that can have the following
-values:
-
-:type -- either `network', `network-only, `tls', `shell' or
-`starttls'. If omitted, the default is `network'. `network'
-will be opportunistically upgraded to STARTTLS if both the server
-and Emacs supports it. If you don't want STARTTLS upgrades, use
-`network-only'.
-
-:end-of-command -- a regexp saying what the end of a command is.
-This defaults to \"\\n\".
-
-:success -- a regexp saying whether the STARTTLS command was
-successful or not. For instance, for NNTP this is \"^3\".
-
-:capability-command -- a string representing the command used to
-query server for capabilities. For instance, for IMAP this is
-\"1 CAPABILITY\\r\\n\".
-
-:starttls-function -- a function that takes one parameter, which
-is the response to the capaibility command. It should return nil
-if it turns out that the server doesn't support STARTTLS, or the
-command to switch on STARTTLS otherwise.
-
-The return value from this function is a four-element list, where
-the first element is the stream (if connection was successful);
-the second element is the \"greeting\", i. e., the string the
-server sent over on initial contact; the third element is the
-capability string; and the fourth element is either `network' or
-`tls', depending on whether the connection ended up being
-encrypted or not."
- (let ((type (or (cadr (memq :type parameters)) 'network)))
- (cond
- ((eq type 'starttls)
- (setq type 'network))
- ((eq type 'ssl)
- (setq type 'tls)))
- (let ((open-result
- (funcall (intern (format "proto-stream-open-%s" type) obarray)
- name buffer host service parameters)))
- (if (null open-result)
- (list nil nil nil type)
- (let ((stream (car open-result)))
- (list (and stream
- (memq (process-status stream)
- '(open run))
- stream)
- (nth 1 open-result)
- (nth 2 open-result)
- (nth 3 open-result)))))))
-
-(defun proto-stream-open-network-only (name buffer host service parameters)
+ "Open a network stream to HOST, possibly with encryption.
+Normally, return a network process object; with a non-nil
+:return-list parameter, return a list instead (see below).
+
+The first four parameters, NAME, BUFFER, HOST, and SERVICE, have
+the same meanings as in `open-network-stream'. The remaining
+PARAMETERS should be a sequence of keywords and values:
+
+:type specifies the connection type, one of the following:
+ nil or `network'
+ -- Begin with an ordinary network connection, and if
+ the parameters :success and :capability-command
+ are also supplied, try to upgrade to an encrypted
+ connection via STARTTLS. Even if that
+ fails (e.g. if HOST does not support TLS), retain
+ an unencrypted connection.
+ `plain' -- An ordinary, unencrypted network connection.
+ `starttls' -- Begin with an ordinary connection, and try
+ upgrading via STARTTLS. If that fails for any
+ reason, drop the connection; in that case the
+ returned object is a killed process.
+ `tls' -- A TLS connection.
+ `ssl' -- Equivalent to `tls'.
+ `shell' -- A shell connection.
+
+:return-list specifies this function's return value.
+ If omitted or nil, return a process object. A non-nil means to
+ return (PROC . PROPS), where PROC is a process object and PROPS
+ is a plist of connection properties, with these keywords:
+ :greeting -- the greeting returned by HOST (a string), or nil.
+ :capabilities -- a string representing HOST's capabilities,
+ or nil if none could be found.
+ :type -- the resulting connection type; `plain' (unencrypted)
+ or `tls' (TLS-encrypted).
+
+:end-of-command specifies a regexp matching the end of a command.
+ If non-nil, it defaults to \"\\n\".
+
+:success specifies a regexp matching a message indicating a
+ successful STARTTLS negotiation. For instance, the default
+ should be \"^3\" for an NNTP connection.
+
+:capability-command specifies a command used to query the HOST
+ for its capabilities. For instance, for IMAP this should be
+ \"1 CAPABILITY\\r\\n\".
+
+:starttls-function specifies a function for handling STARTTLS.
+ This function should take one parameter, the response to the
+ capability command, and should return the command to switch on
+ STARTTLS if the server supports STARTTLS, and nil otherwise."
+ (let ((type (plist-get parameters :type))
+ (return-list (plist-get parameters :return-list)))
+ (if (and (not return-list)
+ (or (eq type 'plain)
+ (and (memq type '(nil network))
+ (not (and (plist-get parameters :success)
+ (plist-get parameters :capability-command))))))
+ ;; The simplest case is equivalent to `open-network-stream'.
+ (open-network-stream name buffer host service)
+ ;; For everything else, refer to proto-stream-open-*.
+ (unless (plist-get parameters :end-of-command)
+ (setq parameters (append '(:end-of-command "\r\n") parameters)))
+ (let* ((connection-function
+ (cond
+ ((eq type 'plain) 'proto-stream-open-plain)
+ ((memq type '(nil network starttls))
+ 'proto-stream-open-starttls)
+ ((memq type '(tls ssl)) 'proto-stream-open-tls)
+ ((eq type 'shell) 'proto-stream-open-shell)
+ (t (error "Invalid connection type %s" type))))
+ (result (funcall connection-function
+ name buffer host service parameters)))
+ (if return-list
+ (list (car result)
+ :greeting (nth 1 result)
+ :capabilities (nth 2 result)
+ :type (nth 3 result))
+ (car result))))))
+
+(defun proto-stream-open-plain (name buffer host service parameters)
(let ((start (with-current-buffer buffer (point)))
(stream (open-network-stream name buffer host service)))
(list stream
- (proto-stream-get-response
- stream start (proto-stream-eoc parameters))
+ (proto-stream-get-response stream start
+ (plist-get parameters :end-of-command))
nil
- 'network)))
+ 'plain)))
-(defun proto-stream-open-network (name buffer host service parameters)
+(defun proto-stream-open-starttls (name buffer host service parameters)
(let* ((start (with-current-buffer buffer (point)))
+ (require-tls (eq (plist-get parameters :type) 'starttls))
+ (starttls-function (plist-get parameters :starttls-function))
+ (success-string (plist-get parameters :success))
+ (capability-command (plist-get parameters :capability-command))
+ (eoc (plist-get parameters :end-of-command))
+ ;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE)
(stream (open-network-stream name buffer host service))
- (capability-command (cadr (memq :capability-command parameters)))
- (eoc (proto-stream-eoc parameters))
- (type (cadr (memq :type parameters)))
(greeting (proto-stream-get-response stream start eoc))
- success)
- (if (not capability-command)
- (list stream greeting nil 'network)
- (let* ((capabilities
- (proto-stream-command stream capability-command eoc))
- (starttls-command
- (funcall (cadr (memq :starttls-function parameters))
- capabilities)))
- (cond
- ;; If this server doesn't support STARTTLS, but we have
- ;; requested it explicitly, then close the connection and
- ;; return nil.
- ((or (not starttls-command)
- (and (not (eq type 'starttls))
- (not proto-stream-always-use-starttls)))
- (if (eq type 'starttls)
- (progn
- (delete-process stream)
- nil)
- ;; Otherwise, just return this plain network connection.
- (list stream greeting capabilities 'network)))
- ;; We have some kind of STARTTLS support, so we try to
- ;; upgrade the connection opportunistically.
- ((or (fboundp 'open-gnutls-stream)
- (executable-find "gnutls-cli"))
- (unless (fboundp 'open-gnutls-stream)
- (delete-process stream)
- (setq start (with-current-buffer buffer (point-max)))
- (let* ((starttls-use-gnutls t)
- (starttls-extra-arguments
- (if (not (eq type 'starttls))
- ;; When doing opportunistic TLS upgrades we
- ;; don't really care about the identity of the
- ;; peer.
- (cons "--insecure" starttls-extra-arguments)
- starttls-extra-arguments)))
- (setq stream (starttls-open-stream name buffer host service)))
- (proto-stream-get-response stream start eoc))
- (if (not
- (string-match
- (cadr (memq :success parameters))
- (proto-stream-command stream starttls-command eoc)))
- ;; We got an error back from the STARTTLS command.
- (progn
- (if (eq type 'starttls)
- (progn
- (delete-process stream)
- nil)
- (list stream greeting capabilities 'network)))
- ;; The server said it was OK to start doing STARTTLS negotiations.
- (if (fboundp 'open-gnutls-stream)
- (gnutls-negotiate stream nil)
- (unless (starttls-negotiate stream)
- (delete-process stream)
- (setq stream nil)))
- (when (or (null stream)
- (not (memq (process-status stream)
- '(open run))))
- ;; It didn't successfully negotiate STARTTLS, so we reopen
- ;; the connection.
- (setq stream (open-network-stream name buffer host service))
- (proto-stream-get-response stream start eoc))
- ;; Re-get the capabilities, since they may have changed
- ;; after switching to TLS.
- (list stream greeting
- (proto-stream-command stream capability-command eoc) 'tls)))
- ;; We don't have STARTTLS support available, but the caller
- ;; requested a STARTTLS connection, so we give up.
- ((eq (cadr (memq :type parameters)) 'starttls)
- (delete-process stream)
- nil)
- ;; Fall back on using a plain network stream.
- (t
- (list stream greeting capabilities 'network)))))))
+ (capabilities (when capability-command
+ (proto-stream-command stream
+ capability-command eoc)))
+ (resulting-type 'plain)
+ starttls-command)
+
+ ;; If we have STARTTLS support, try to upgrade the connection.
+ (when (and (or (fboundp 'open-gnutls-stream)
+ (executable-find "gnutls-cli"))
+ capabilities success-string starttls-function
+ (setq starttls-command
+ (funcall starttls-function capabilities)))
+ ;; If using external STARTTLS, drop this connection and start
+ ;; anew with `starttls-open-stream'.
+ (unless (fboundp 'open-gnutls-stream)
+ (delete-process stream)
+ (setq start (with-current-buffer buffer (point-max)))
+ (let* ((starttls-use-gnutls t)
+ (starttls-extra-arguments
+ (if require-tls
+ starttls-extra-arguments
+ ;; For opportunistic TLS upgrades, we don't really
+ ;; care about the identity of the peer.
+ (cons "--insecure" starttls-extra-arguments))))
+ (setq stream (starttls-open-stream name buffer host service)))
+ (proto-stream-get-response stream start eoc))
+ (when (string-match success-string
+ (proto-stream-command stream starttls-command eoc))
+ ;; The server said it was OK to begin STARTTLS negotiations.
+ (if (fboundp 'open-gnutls-stream)
+ (gnutls-negotiate stream nil)
+ (unless (starttls-negotiate stream)
+ (delete-process stream)))
+ (if (memq (process-status stream) '(open run))
+ (setq resulting-type 'tls)
+ ;; We didn't successfully negotiate STARTTLS; if TLS
+ ;; isn't demanded, reopen an unencrypted connection.
+ (unless require-tls
+ (setq stream (open-network-stream name buffer host service))
+ (proto-stream-get-response stream start eoc)))
+ ;; Re-get the capabilities, which may have now changed.
+ (setq capabilities
+ (proto-stream-command stream capability-command eoc))))
+
+ ;; If TLS is mandatory, close the connection if it's unencrypted.
+ (and require-tls
+ (eq resulting-type 'plain)
+ (delete-process stream))
+ ;; Return value:
+ (list stream greeting capabilities resulting-type)))
(defun proto-stream-command (stream command eoc)
(let ((start (with-current-buffer (process-buffer stream) (point-max))))
@@ -241,47 +232,43 @@ encrypted or not."
(funcall (if (fboundp 'open-gnutls-stream)
'open-gnutls-stream
'open-tls-stream)
- name buffer host service)))
+ name buffer host service))
+ (eoc (plist-get parameters :end-of-command)))
(if (null stream)
- nil
+ (list nil nil nil 'plain)
;; If we're using tls.el, we have to delete the output from
;; openssl/gnutls-cli.
(unless (fboundp 'open-gnutls-stream)
- (proto-stream-get-response
- stream start (proto-stream-eoc parameters))
+ (proto-stream-get-response stream start eoc)
(goto-char (point-min))
- (when (re-search-forward (proto-stream-eoc parameters) nil t)
+ (when (re-search-forward eoc nil t)
(goto-char (match-beginning 0))
(delete-region (point-min) (line-beginning-position))))
(proto-stream-capability-open start stream parameters 'tls)))))
(defun proto-stream-open-shell (name buffer host service parameters)
+ (require 'format-spec)
(proto-stream-capability-open
(with-current-buffer buffer (point))
(let ((process-connection-type nil))
(start-process name buffer shell-file-name
shell-command-switch
(format-spec
- (cadr (memq :shell-command parameters))
+ (plist-get parameters :shell-command)
(format-spec-make
?s host
?p service))))
- parameters 'network))
+ parameters 'plain))
(defun proto-stream-capability-open (start stream parameters stream-type)
- (let ((capability-command (cadr (memq :capability-command parameters)))
- (greeting (proto-stream-get-response
- stream start (proto-stream-eoc parameters))))
+ (let* ((capability-command (plist-get parameters :capability-command))
+ (eoc (plist-get parameters :end-of-command))
+ (greeting (proto-stream-get-response stream start eoc)))
(list stream greeting
(and capability-command
- (proto-stream-command
- stream capability-command (proto-stream-eoc parameters)))
+ (proto-stream-command stream capability-command eoc))
stream-type)))
-(defun proto-stream-eoc (parameters)
- (or (cadr (memq :end-of-command parameters))
- "\r\n"))
-
(provide 'proto-stream)
;;; proto-stream.el ends here
diff --git a/lisp/ido.el b/lisp/ido.el
index 177f9338870..0ce83d9b88c 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -2151,7 +2151,7 @@ If INITIAL is non-nil, it specifies the initial input string."
(t
(setq done t))))))
- (and history (add-to-history history ido-selected))
+ (add-to-history (or history 'minibuffer-history) ido-selected)
ido-selected))
(defun ido-edit-input ()
diff --git a/lisp/loadup.el b/lisp/loadup.el
index b884adb5b1e..8a11a6e3e06 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -106,7 +106,6 @@
(load "cus-face")
(load "faces") ; after here, `defface' may be used.
-(load "minibuffer")
(load "button")
(load "startup")
@@ -117,6 +116,7 @@
;; In case loaddefs hasn't been generated yet.
(file-error (load "ldefs-boot.el")))
+(load "minibuffer")
(load "abbrev") ;lisp-mode.el and simple.el use define-abbrev-table.
(load "simple")
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index f1bc9f2d6d5..4aa34698809 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -173,10 +173,14 @@ that can be used as the COLLECTION argument to `try-completion' and
`all-completions'. See Info node `(elisp)Programmed Completion'."
(lexical-let ((fun fun))
(lambda (string pred action)
- (with-current-buffer (let ((win (minibuffer-selected-window)))
- (if (window-live-p win) (window-buffer win)
- (current-buffer)))
- (complete-with-action action (funcall fun string) string pred)))))
+ (if (eq (car-safe action) 'boundaries)
+ ;; `fun' is not supposed to return another function but a plain old
+ ;; completion table, whose boundaries are always trivial.
+ nil
+ (with-current-buffer (let ((win (minibuffer-selected-window)))
+ (if (window-live-p win) (window-buffer win)
+ (current-buffer)))
+ (complete-with-action action (funcall fun string) string pred))))))
(defmacro lazy-completion-table (var fun)
"Initialize variable VAR as a lazy completion table.
@@ -240,6 +244,10 @@ in which case TERMINATOR-REGEXP is a regular expression whose submatch
number 1 should match TERMINATOR. This is used when there is a need to
distinguish occurrences of the TERMINATOR strings which are really terminators
from others (e.g. escaped)."
+ ;; FIXME: This implementation is not right since it only adds the terminator
+ ;; in try-completion, so any completion-style that builds the completion via
+ ;; all-completions won't get the terminator, and selecting an entry in
+ ;; *Completions* won't get the terminator added either.
(cond
((eq (car-safe action) 'boundaries)
(let* ((suffix (cdr action))
@@ -716,6 +724,8 @@ scroll the window of possible completions."
(< (or s1 (length c1))
(or s2 (length c2))))))))
;; Prefer recently used completions.
+ ;; FIXME: Additional sorting ideas:
+ ;; - for M-x, prefer commands that have no key binding.
(let ((hist (symbol-value minibuffer-history-variable)))
(setq all (sort all (lambda (c1 c2)
(> (length (member c1 hist))
@@ -1008,8 +1018,8 @@ It also eliminates runs of equal strings."
;; a space displayed.
(set-text-properties (- (point) 1) (point)
;; We can't just set tab-width, because
- ;; completion-setup-function will kill all
- ;; local variables :-(
+ ;; completion-setup-function will kill
+ ;; all local variables :-(
`(display (space :align-to ,column)))
nil))))
(if (not (consp str))
@@ -1237,6 +1247,8 @@ the ones passed to `completion-in-region'. The functions on this hook
are expected to perform completion on START..END using COLLECTION
and PREDICATE, either by calling NEXT-FUN or by doing it themselves.")
+(defvar completion-in-region--data nil)
+
(defun completion-in-region (start end collection &optional predicate)
"Complete the text between START and END using COLLECTION.
Return nil if there is no valid completion, else t.
@@ -1251,15 +1263,78 @@ Point needs to be somewhere between START and END."
(minibuffer-completion-predicate predicate)
(ol (make-overlay start end nil nil t)))
(overlay-put ol 'field 'completion)
+ (completion-in-region-mode 1)
+ (setq completion-in-region--data
+ (list (current-buffer) start end collection))
(unwind-protect
(call-interactively 'minibuffer-complete)
(delete-overlay ol)))))
+(defvar completion-in-region-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "?" 'completion-help-at-point)
+ (define-key map "\t" 'completion-at-point)
+ map)
+ "Keymap activated during `completion-in-region'.")
+
+;; It is difficult to know when to exit completion-in-region-mode (i.e. hide
+;; the *Completions*).
+;; - lisp-mode: never.
+;; - comint: only do it if you hit SPC at the right time.
+;; - pcomplete: pop it down on SPC or after some time-delay.
+;; - semantic: use a post-command-hook check similar to this one.
+(defun completion-in-region--postch ()
+ (message "completion-in-region--postch: cmd=%s" this-command)
+ (or unread-command-events ;Don't pop down the completions in the middle of
+ ;mouse-drag-region/mouse-set-point.
+ (and completion-in-region--data
+ (and (eq (car completion-in-region--data)
+ (current-buffer))
+ (>= (point) (nth 1 completion-in-region--data))
+ (<= (point)
+ (save-excursion
+ (goto-char (nth 2 completion-in-region--data))
+ (line-end-position)))
+ (let ((comp-data (run-hook-wrapped
+ 'completion-at-point-functions
+ ;; Only use the known-safe functions.
+ #'completion--capf-wrapper 'safe)))
+ (eq (car comp-data)
+ ;; We're still in the same completion field.
+ (nth 1 completion-in-region--data)))))
+ (completion-in-region-mode -1)))
+
+;; (defalias 'completion-in-region--prech 'completion-in-region--postch)
+
+(define-minor-mode completion-in-region-mode
+ "Transient minor mode used during `completion-in-region'."
+ :global t
+ (setq completion-in-region--data nil)
+ ;; (remove-hook 'pre-command-hook #'completion-in-region--prech)
+ (remove-hook 'post-command-hook #'completion-in-region--postch)
+ (setq minor-mode-overriding-map-alist
+ (delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist)
+ minor-mode-overriding-map-alist))
+ (if (null completion-in-region-mode)
+ (progn
+ (unless (equal "*Completions*" (buffer-name (window-buffer)))
+ (minibuffer-hide-completions))
+ (message "Leaving completion-in-region-mode"))
+ ;; (add-hook 'pre-command-hook #'completion-in-region--prech)
+ (add-hook 'post-command-hook #'completion-in-region--postch)
+ (push `(completion-in-region-mode . ,completion-in-region-mode-map)
+ minor-mode-overriding-map-alist)))
+
+;; Define-minor-mode added our keymap to minor-mode-map-alist, but we want it
+;; on minor-mode-overriding-map-alist instead.
+(setq minor-mode-map-alist
+ (delq (assq 'completion-in-region-mode minor-mode-map-alist)
+ minor-mode-map-alist))
+
(defvar completion-at-point-functions '(tags-completion-at-point-function)
"Special hook to find the completion table for the thing at point.
Each function on this hook is called in turns without any argument and should
return either nil to mean that it is not applicable at point,
-or t to mean that it already performed completion (discouraged),
or a function of no argument to perform completion (discouraged),
or a list of the form (START END COLLECTION &rest PROPS) where
START and END delimit the entity to complete and should include point,
@@ -1269,12 +1344,34 @@ Currently supported properties are:
`:predicate' a predicate that completion candidates need to satisfy.
`:annotation-function' the value to use for `completion-annotate-function'.")
+(defvar completion--capf-misbehave-funs nil
+ "List of functions found on `completion-at-point-functions' that misbehave.")
+(defvar completion--capf-safe-funs nil
+ "List of well-behaved functions found on `completion-at-point-functions'.")
+
+(defun completion--capf-wrapper (fun which)
+ (if (case which
+ (all t)
+ (safe (member fun completion--capf-safe-funs))
+ (optimist (not (member fun completion--capf-misbehave-funs))))
+ (let ((res (funcall fun)))
+ (cond
+ ((consp res)
+ (unless (member fun completion--capf-safe-funs)
+ (push fun completion--capf-safe-funs)))
+ ((not (or (listp res) (functionp res)))
+ (unless (member fun completion--capf-misbehave-funs)
+ (message
+ "Completion function %S uses a deprecated calling convention" fun)
+ (push fun completion--capf-misbehave-funs))))
+ res)))
+
(defun completion-at-point ()
"Perform completion on the text around point.
The completion method is determined by `completion-at-point-functions'."
(interactive)
- (let ((res (run-hook-with-args-until-success
- 'completion-at-point-functions)))
+ (let ((res (run-hook-wrapped 'completion-at-point-functions
+ #'completion--capf-wrapper 'all)))
(cond
((functionp res) (funcall res))
((consp res)
@@ -1288,6 +1385,37 @@ The completion method is determined by `completion-at-point-functions'."
(plist-get plist :predicate))))
(res)))) ;Maybe completion already happened and the function returned t.
+(defun completion-help-at-point ()
+ "Display the completions on the text around point.
+The completion method is determined by `completion-at-point-functions'."
+ (interactive)
+ (let ((res (run-hook-wrapped 'completion-at-point-functions
+ ;; Ignore misbehaving functions.
+ #'completion--capf-wrapper 'optimist)))
+ (cond
+ ((functionp res)
+ (message "Don't know how to show completions for %S" res))
+ ((consp res)
+ (let* ((plist (nthcdr 3 res))
+ (minibuffer-completion-table (nth 2 res))
+ (minibuffer-completion-predicate (plist-get plist :predicate))
+ (completion-annotate-function
+ (or (plist-get plist :annotation-function)
+ completion-annotate-function))
+ (ol (make-overlay (nth 0 res) (nth 1 res) nil nil t)))
+ ;; FIXME: We should somehow (ab)use completion-in-region-function or
+ ;; introduce a corresponding hook (plus another for word-completion,
+ ;; and another for force-completion, maybe?).
+ (overlay-put ol 'field 'completion)
+ (unwind-protect
+ (call-interactively 'minibuffer-completion-help)
+ (delete-overlay ol))))
+ (res
+ ;; The hook function already performed completion :-(
+ ;; Not much we can do at this point.
+ nil)
+ (t (message "Nothing to complete at point")))))
+
;;; Key bindings.
(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map
@@ -1910,9 +2038,9 @@ or a symbol chosen among `any', `star', `point', `prefix'."
(append (completion-pcm--string->pattern prefix)
'(point)
(completion-pcm--string->pattern suffix)))
- (let ((pattern nil)
- (p 0)
- (p0 0))
+ (let* ((pattern nil)
+ (p 0)
+ (p0 p))
(while (and (setq p (string-match completion-pcm--delim-wild-regex
string p))
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index 6d80b97fd23..f4af03f100f 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -211,7 +211,7 @@ until a successful connection is made."
:type '(repeat string))
(defcustom imap-process-connection-type nil
- "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL.
+ "*Value for `process-connection-type' to use for Kerberos4, GSSAPI, shell, and SSL.
The `process-connection-type' variable controls the type of device
used to communicate with subprocesses. Values are nil to use a
pipe, or t or `pty' to use a pty. The value has no effect if the
@@ -770,6 +770,7 @@ sure of changing the value of `foo'."
(let* ((port (or port imap-default-port))
(coding-system-for-read imap-coding-system-for-read)
(coding-system-for-write imap-coding-system-for-write)
+ (process-connection-type imap-process-connection-type)
(process (start-process
name buffer shell-file-name shell-command-switch
(format-spec
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index eb4ad01ecd7..5822fc3cf32 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -2454,7 +2454,15 @@ keywords when no KEYWORD is given."
(setq rcirc-nick (car args))
(rcirc-update-prompt)
(if rcirc-auto-authenticate-flag
- (if rcirc-authenticate-before-join
+ (if (and rcirc-authenticate-before-join
+ ;; We have to ensure that there's an authentication
+ ;; entry for that server. Else,
+ ;; rcirc-authenticated-hook won't be triggered, and
+ ;; autojoin won't happen at all.
+ (let (auth-required)
+ (dolist (s rcirc-authinfo auth-required)
+ (when (string-match (car s) rcirc-server-name)
+ (setq auth-required t)))))
(progn
(add-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t t)
(rcirc-authenticate))
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
index ed745ae784e..232299da4db 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -2203,7 +2203,7 @@ CHANGE-WORD should be one of 'upcase-word, 'downcase-word, 'capitalize-word."
(let ((tag (find-tag-default)))
(or (and tag
;; See bug#7919. TODO I imagine there are other cases...?
- (string-match "%\\(.+\\)" tag)
+ (string-match "%\\([^%]+\\)\\'" tag)
(match-string-no-properties 1 tag))
tag)))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 4246177495c..0cbb8c186cc 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -499,44 +499,6 @@ statement."
:type 'integer)
-(defcustom python-default-interpreter 'cpython
- "*Which Python interpreter is used by default.
-The value for this variable can be either `cpython' or `jpython'.
-
-When the value is `cpython', the variables `python-python-command' and
-`python-python-command-args' are consulted to determine the interpreter
-and arguments to use.
-
-When the value is `jpython', the variables `python-jpython-command' and
-`python-jpython-command-args' are consulted to determine the interpreter
-and arguments to use.
-
-Note that this variable is consulted only the first time that a Python
-mode buffer is visited during an Emacs session. After that, use
-\\[python-toggle-shells] to change the interpreter shell."
- :type '(choice (const :tag "Python (a.k.a. CPython)" cpython)
- (const :tag "JPython" jpython))
- :group 'python)
-
-(defcustom python-python-command-args '("-i")
- "*List of string arguments to be used when starting a Python shell."
- :type '(repeat string)
- :group 'python)
-
-(defcustom python-jython-command-args '("-i")
- "*List of string arguments to be used when starting a Jython shell."
- :type '(repeat string)
- :group 'python
- :tag "JPython Command Args")
-
-;; for toggling between CPython and JPython
-(defvar python-which-shell nil)
-(defvar python-which-args python-python-command-args)
-(defvar python-which-bufname "Python")
-(make-variable-buffer-local 'python-which-shell)
-(make-variable-buffer-local 'python-which-args)
-(make-variable-buffer-local 'python-which-bufname)
-
(defcustom python-pdbtrack-do-tracking-p t
"*Controls whether the pdbtrack feature is enabled or not.
@@ -562,11 +524,6 @@ having to restart the program."
(push '(python-pdbtrack-is-tracking-p python-pdbtrack-minor-mode-string)
minor-mode-alist))
-;; Bind python-file-queue before installing the kill-emacs-hook.
-(defvar python-file-queue nil
- "Queue of Python temp files awaiting execution.
-Currently-active file is at the head of the list.")
-
(defcustom python-shell-prompt-alist
'(("ipython" . "^In \\[[0-9]+\\]: *")
(t . "^>>> "))
@@ -2584,20 +2541,6 @@ Runs `jython-mode-hook' after `python-mode-hook'."
;; pdbtrack features
-(defun python-comint-output-filter-function (string)
- "Watch output for Python prompt and exec next file waiting in queue.
-This function is appropriate for `comint-output-filter-functions'."
- ;; TBD: this should probably use split-string
- (when (and (string-match python--prompt-regexp string)
- python-file-queue)
- (condition-case nil
- (delete-file (car python-file-queue))
- (error nil))
- (setq python-file-queue (cdr python-file-queue))
- (if python-file-queue
- (let ((pyproc (get-buffer-process (current-buffer))))
- (python-execute-file pyproc (car python-file-queue))))))
-
(defun python-pdbtrack-overlay-arrow (activation)
"Activate or deactivate arrow at beginning-of-line in current buffer."
(if activation
@@ -2742,45 +2685,6 @@ problem."
(setq got buf)))
got))
-(defun python-toggle-shells (arg)
- "Toggles between the CPython and JPython shells.
-
-With positive argument ARG (interactively \\[universal-argument]),
-uses the CPython shell, with negative ARG uses the JPython shell, and
-with a zero argument, toggles the shell.
-
-Programmatically, ARG can also be one of the symbols `cpython' or
-`jpython', equivalent to positive arg and negative arg respectively."
- (interactive "P")
- ;; default is to toggle
- (if (null arg)
- (setq arg 0))
- ;; preprocess arg
- (cond
- ((equal arg 0)
- ;; toggle
- (if (string-equal python-which-bufname "Python")
- (setq arg -1)
- (setq arg 1)))
- ((equal arg 'cpython) (setq arg 1))
- ((equal arg 'jpython) (setq arg -1)))
- (let (msg)
- (cond
- ((< 0 arg)
- ;; set to CPython
- (setq python-which-shell python-python-command
- python-which-args python-python-command-args
- python-which-bufname "Python"
- msg "CPython"
- mode-name "Python"))
- ((> 0 arg)
- (setq python-which-shell python-jython-command
- python-which-args python-jython-command-args
- python-which-bufname "JPython"
- msg "JPython"
- mode-name "JPython")))
- (message "Using the %s shell" msg)))
-
;; Python subprocess utilities and filters
(defun python-execute-file (proc filename)
"Send to Python interpreter process PROC \"execfile('FILENAME')\".
@@ -2801,71 +2705,6 @@ comint believe the user typed this string so that
(set-buffer curbuf))
(process-send-string proc cmd)))
-;;;###autoload
-(defun python-shell (&optional argprompt)
- "Start an interactive Python interpreter in another window.
-This is like Shell mode, except that Python is running in the window
-instead of a shell. See the `Interactive Shell' and `Shell Mode'
-sections of the Emacs manual for details, especially for the key
-bindings active in the `*Python*' buffer.
-
-With optional \\[universal-argument], the user is prompted for the
-flags to pass to the Python interpreter. This has no effect when this
-command is used to switch to an existing process, only when a new
-process is started. If you use this, you will probably want to ensure
-that the current arguments are retained (they will be included in the
-prompt). This argument is ignored when this function is called
-programmatically.
-
-Note: You can toggle between using the CPython interpreter and the
-JPython interpreter by hitting \\[python-toggle-shells]. This toggles
-buffer local variables which control whether all your subshell
-interactions happen to the `*JPython*' or `*Python*' buffers (the
-latter is the name used for the CPython buffer).
-
-Warning: Don't use an interactive Python if you change sys.ps1 or
-sys.ps2 from their default values, or if you're running code that
-prints `>>> ' or `... ' at the start of a line. `python-mode' can't
-distinguish your output from Python's output, and assumes that `>>> '
-at the start of a line is a prompt from Python. Similarly, the Emacs
-Shell mode code assumes that both `>>> ' and `... ' at the start of a
-line are Python prompts. Bad things can happen if you fool either
-mode.
-
-Warning: If you do any editing *in* the process buffer *while* the
-buffer is accepting output from Python, do NOT attempt to `undo' the
-changes. Some of the output (nowhere near the parts you changed!) may
-be lost if you do. This appears to be an Emacs bug, an unfortunate
-interaction between undo and process filters; the same problem exists in
-non-Python process buffers using the default (Emacs-supplied) process
-filter."
- (interactive "P")
- (require 'ansi-color) ; For ipython
- ;; Set the default shell if not already set
- (when (null python-which-shell)
- (python-toggle-shells python-default-interpreter))
- (let ((args python-which-args))
- (when (and argprompt
- (called-interactively-p 'interactive)
- (fboundp 'split-string))
- ;; TBD: Perhaps force "-i" in the final list?
- (setq args (split-string
- (read-string (concat python-which-bufname
- " arguments: ")
- (concat
- (mapconcat 'identity python-which-args " ") " ")
- ))))
- (switch-to-buffer-other-window
- (apply 'make-comint python-which-bufname python-which-shell nil args))
- (set-process-sentinel (get-buffer-process (current-buffer))
- 'python-sentinel)
- (python--set-prompt-regexp)
- (add-hook 'comint-output-filter-functions
- 'python-comint-output-filter-function nil t)
- ;; pdbtrack
- (set-syntax-table python-mode-syntax-table)
- (use-local-map python-shell-map)))
-
(defun python-pdbtrack-toggle-stack-tracking (arg)
(interactive "P")
(if (not (get-buffer-process (current-buffer)))
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index d75fcb5f4f1..e9fbdb91e97 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -886,7 +886,7 @@ non-nil, otherwise in local time."
(point))))
;; Now insert the new line for this item.
- (cond ((re-search-forward "^\\s *\\*\\s *$" bound t)
+ (cond ((re-search-forward "^\\s *\\* *$" bound t)
;; Put this file name into the existing empty item.
(if item
(insert item)))
@@ -928,7 +928,7 @@ non-nil, otherwise in local time."
;; No function name, so put in a colon unless we have just a star.
(unless (save-excursion
(beginning-of-line 1)
- (looking-at "\\s *\\(\\*\\s *\\)?$"))
+ (looking-at "\\s *\\(\\* *\\)?$"))
(insert ": ")
(if version (insert version ?\s)))
;; Make it easy to get rid of the function name.
generated by cgit v1.2.3 (git 2.39.1) at 2025-06-05 09:38:59 +0000